Merge branch 'master' of git://factorcode.org/git/factor

core/classes/tuple/parser/parser-tests.factor

@@ -96,3 +96,16 @@ TUPLE: syntax-test bar baz ;
 [ T{ syntax-test } ] [ T{ syntax-test } ] unit-test
 [ T{ syntax-test f { 2 3 } { 4 { 5 } } } ]
 [ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test
+
+! Corner case
+TUPLE: parsing-corner-case x ;
+
+[ T{ parsing-corner-case f 3 } ] [
+    {
+        "USE: classes.tuple.parser.tests"
+        "T{ parsing-corner-case"
+        "    f"
+        "    3"
+        "}"
+    } "\n" join eval
+] unit-test

core/classes/tuple/parser/parser.factor

@@ -86,6 +86,7 @@ ERROR: bad-literal-tuple ;
 
 : parse-tuple-literal ( -- tuple )
     scan-word scan {
+        { f [ unexpected-eof ] }
         { "f" [ \ } parse-until boa>tuple ] }
         { "{" [ parse-slot-values assoc>tuple ] }
         { "}" [ new ] }

unfinished/compiler/alien/alien.factor

@@ -1,15 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces make math sequences layouts
-alien.c-types alien.structs compiler.backend ;
+alien.c-types alien.structs cpu.architecture ;
 IN: compiler.alien
 
-! Common utilities
-
 : large-struct? ( ctype -- ? )
-    dup c-struct? [
+    dup c-struct? [ struct-small-enough? not ] [ drop f ] if ;
-        heap-size struct-small-enough? not
-    ] [ drop f ] if ;
 
 : alien-parameters ( params -- seq )
     dup parameters>>
@@ -31,16 +27,3 @@ IN: compiler.alien
             [ parameter-align drop dup , ] keep stack-size +
         ] reduce cell align
     ] { } make ;
-
-: return-size ( ctype -- n )
-    #! Amount of space we reserve for a return value.
-    dup large-struct? [ heap-size ] [ drop 0 ] if ;
-
-: alien-stack-frame ( params -- n )
-    alien-parameters parameter-sizes drop ;
-    
-: alien-invoke-frame ( params -- n )
-    #! One cell is temporary storage, temp@
-    dup return>> return-size
-    swap alien-stack-frame +
-    cell + ;

unfinished/compiler/backend/backend.factor

@@ -33,10 +33,7 @@ GENERIC# load-literal 1 ( obj reg -- )
 
 HOOK: load-indirect cpu ( obj reg -- )
 
-HOOK: stack-frame cpu ( frame-size -- n )
+HOOK: stack-frame-size cpu ( frame-size -- n )
-
-: stack-frame* ( -- n )
-    \ stack-frame get stack-frame ;
 
 ! Set up caller stack frame
 HOOK: %prologue cpu ( n -- )

unfinished/compiler/cfg/builder/builder.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators hashtables kernel
 math fry namespaces make sequences words byte-arrays
-locals layouts
+locals layouts alien.c-types alien.structs
 stack-checker.inlining
 compiler.intrinsics
 compiler.tree
@@ -107,7 +107,7 @@ SYMBOL: +if-intrinsics+
 : emit-call ( word -- next )
     finalize-phantoms
     {
-        { [ tail-call? not ] [ 0 ##frame-required ##call iterate-next ] }
+        { [ tail-call? not ] [ ##simple-stack-frame ##call iterate-next ] }
         { [ dup loops get key? ] [ loops get at local-recursive-call ] }
         [ ##epilogue ##jump stop-iterating ]
     } cond ;
@@ -235,7 +235,7 @@ M: #dispatch emit-node
     (write-barrier)
 } [ t "intrinsic" set-word-prop ] each
 
-: allot-size ( #call -- n )
+: allot-size ( -- n )
     1 phantom-datastack get phantom-input first value>> ;
 
 :: emit-allot ( size type tag -- )
@@ -306,21 +306,41 @@ M: #return-recursive emit-node
 M: #terminate emit-node drop stop-iterating ;
 
 ! FFI
+: return-size ( ctype -- n )
+    #! Amount of space we reserve for a return value.
+    {
+        { [ dup c-struct? not ] [ drop 0 ] }
+        { [ dup large-struct? not ] [ drop 2 cells ] }
+        [ heap-size ]
+    } cond ;
+
+: <alien-stack-frame> ( params -- stack-frame )
+    stack-frame new
+        swap
+        [ return>> return-size >>return ]
+        [ alien-parameters parameter-sizes drop >>params ] bi
+        dup [ params>> ] [ return>> ] bi + >>size ;
+
+: alien-stack-frame ( node -- )
+    params>> <alien-stack-frame> ##stack-frame ;
+
+: emit-alien-node ( node quot -- next )
+    [ drop alien-stack-frame ]
+    [ [ params>> ] dip call ] 2bi
+    iterate-next ; inline
+
 M: #alien-invoke emit-node
-    params>>
+    [ ##alien-invoke ] emit-alien-node ;
-    [ alien-invoke-frame ##frame-required ]
-    [ ##alien-invoke iterate-next ]
-    bi ;
 
 M: #alien-indirect emit-node
-    params>>
+    [ ##alien-indirect ] emit-alien-node ;
-    [ alien-invoke-frame ##frame-required ]
-    [ ##alien-indirect iterate-next ]
-    bi ;
 
 M: #alien-callback emit-node
     params>> dup xt>> dup
-    [ init-phantoms ##alien-callback ] with-cfg-builder
+    [
+        init-phantoms
+        [ ##alien-callback ] emit-alien-node drop
+    ] with-cfg-builder
     iterate-next ;
 
 ! No-op nodes

unfinished/compiler/cfg/cfg.factor

@@ -19,7 +19,7 @@ successors ;
         V{ } clone >>instructions
         V{ } clone >>successors ;
 
-TUPLE: mr instructions word label frame-size spill-counts ;
+TUPLE: mr instructions word label ;
 
 : <mr> ( instructions word label -- mr )
     mr new

unfinished/compiler/cfg/instructions/instructions.factor

@@ -17,12 +17,19 @@ INSN: ##replace src loc ;
 INSN: ##inc-d n ;
 INSN: ##inc-r n ;
 
-! Calling convention
-INSN: ##return ;
-
 ! Subroutine calls
+TUPLE: stack-frame
+{ size integer }
+{ params integer }
+{ return integer }
+{ total-size integer } ;
+
+INSN: ##stack-frame stack-frame ;
+ : ##simple-stack-frame ( -- ) T{ stack-frame } ##stack-frame ;
 INSN: ##call word ;
 INSN: ##jump word ;
+INSN: ##return ;
+
 INSN: ##intrinsic quot defs-vregs uses-vregs ;
 
 ! Jump tables
@@ -87,7 +94,6 @@ M: ##intrinsic uses-vregs intrinsic-uses-vregs ;
 ! Instructions used by CFG IR only.
 INSN: ##prologue ;
 INSN: ##epilogue ;
-INSN: ##frame-required n ;
 
 INSN: ##branch ;
 INSN: ##branch-f < ##cond-branch ;
@@ -100,8 +106,8 @@ M: ##if-intrinsic defs-vregs intrinsic-defs-vregs ;
 M: ##if-intrinsic uses-vregs intrinsic-uses-vregs ;
 
 ! Instructions used by machine IR only.
-INSN: _prologue ;
+INSN: _prologue stack-frame ;
-INSN: _epilogue ;
+INSN: _epilogue stack-frame ;
 
 INSN: _label id ;
 

unfinished/compiler/cfg/stack-frame/stack-frame.factor

@@ -7,40 +7,47 @@ IN: compiler.cfg.stack-frame
 
 SYMBOL: frame-required?
 
-SYMBOL: frame-size
-
 SYMBOL: spill-counts
 
 : init-stack-frame-builder ( -- )
     frame-required? off
-    0 frame-size set ;
+    T{ stack-frame } clone stack-frame set ;
 
-GENERIC: compute-frame-size* ( insn -- )
+GENERIC: compute-stack-frame* ( insn -- )
 
-M: ##frame-required compute-frame-size*
+: max-stack-frame ( frame1 frame2 -- frame3 )
+    {
+        [ [ size>> ] bi@ max ]
+        [ [ params>> ] bi@ max ]
+        [ [ return>> ] bi@ max ]
+        [ [ total-size>> ] bi@ max ]
+    } cleave
+    stack-frame boa ;
+
+M: ##stack-frame compute-stack-frame*
     frame-required? on
-    n>> frame-size [ max ] change ;
+    stack-frame>> stack-frame [ max-stack-frame ] change ;
 
-M: _spill-integer compute-frame-size*
+M: _spill-integer compute-stack-frame*
     drop frame-required? on ;
 
-M: _spill-float compute-frame-size*
+M: _spill-float compute-stack-frame*
     drop frame-required? on ;
 
-M: insn compute-frame-size* drop ;
+M: insn compute-stack-frame* drop ;
 
-: compute-frame-size ( insns -- )
+: compute-stack-frame ( insns -- )
-    [ compute-frame-size* ] each ;
+    [ compute-stack-frame* ] each ;
 
 GENERIC: insert-pro/epilogues* ( insn -- )
 
-M: ##frame-required insert-pro/epilogues* drop ;
+M: ##stack-frame insert-pro/epilogues* drop ;
 
 M: ##prologue insert-pro/epilogues*
-    drop frame-required? get [ _prologue ] when ;
+    drop frame-required? get [ stack-frame get _prologue ] when ;
 
 M: ##epilogue insert-pro/epilogues*
-    drop frame-required? get [ _epilogue ] when ;
+    drop frame-required? get [ stack-frame get _epilogue ] when ;
 
 M: insn insert-pro/epilogues* , ;
 
@@ -51,9 +58,8 @@ M: insn insert-pro/epilogues* , ;
     [
         init-stack-frame-builder
         [
-            [ compute-frame-size ]
+            [ compute-stack-frame ]
             [ insert-pro/epilogues ]
             bi
         ] change-instructions
-        frame-size get >>frame-size
     ] with-scope ;

unfinished/compiler/cfg/stacks/stacks.factor

@@ -312,7 +312,7 @@ M: loc lazy-store
     finalize-contents
     finalize-heights
     fresh-objects get [
-        empty? [ 0 ##frame-required ##gc ] unless
+        empty? [ ##simple-stack-frame ##gc ] unless
     ] [ delete-all ] bi ;
 
 : init-phantoms ( -- )

unfinished/compiler/cfg/templates/templates.factor

@@ -28,13 +28,10 @@ TUPLE: template input output scratch clobber gc ;
 
 : lazy-load ( specs -- seq )
     [ length phantom-datastack get phantom-input ] keep
-    [ drop ] [
+    [
-        [
+        2dup second clobbered?
-            2dup second clobbered?
+        [ first (eager-load) ] [ first (lazy-load) ] if
-            [ first (eager-load) ] [ first (lazy-load) ] if
+    ] 2map ;
-        ] 2map
-    ] 2bi
-    [ substitute-vregs ] keep ;
 
 : load-inputs ( template -- assoc )
     [

unfinished/compiler/codegen/codegen.factor

@@ -10,7 +10,8 @@ compiler.backend
 compiler.codegen.fixup
 compiler.cfg
 compiler.cfg.instructions
-compiler.cfg.registers ;
+compiler.cfg.registers
+compiler.cfg.builder ;
 IN: compiler.codegen
 
 GENERIC: generate-insn ( insn -- )
@@ -71,10 +72,14 @@ M: _label generate-insn
     id>> lookup-label , ;
 
 M: _prologue generate-insn
-    drop %prologue ;
+    stack-frame>>
+    [ stack-frame set ]
+    [ dup size>> stack-frame-size >>total-size drop ]
+    [ total-size>> %prologue ]
+    tri ;
 
 M: _epilogue generate-insn
-    drop %epilogue ;
+    stack-frame>> total-size>> %epilogue ;
 
 M: ##load-literal generate-insn
     [ obj>> ] [ dst>> v>operand ] bi load-literal ;
@@ -276,8 +281,8 @@ M: long-long-type flatten-value-type ( type -- types )
     #! parameters. If the C function is returning a structure,
     #! the first parameter is an implicit target area pointer,
     #! so we need to use a different offset.
-    return>> dup large-struct?
+    return>> large-struct?
-    [ heap-size %prepare-box-struct cell ] [ drop 0 ] if ;
+    [ %prepare-box-struct cell ] [ 0 ] if ;
 
 : objects>registers ( params -- )
     #! Generate code for unboxing a list of C types, then
@@ -413,7 +418,7 @@ TUPLE: callback-context ;
 
 : callback-unwind ( params -- n )
     {
-        { [ dup abi>> "stdcall" = ] [ alien-stack-frame ] }
+        { [ dup abi>> "stdcall" = ] [ <alien-stack-frame> size>> ] }
         { [ dup return>> large-struct? ] [ drop 4 ] }
         [ drop 0 ]
     } cond ;

vm/debug.c

@@ -325,6 +325,12 @@ void find_code_references(CELL look_for_)
 
 void factorbug(void)
 {
+	if(fep_disabled)
+	{
+		printf("Low level debugger disabled\n");
+		exit(1);
+	}
+
 	open_console();
 
 	printf("Starting low level debugger...\n");
@@ -366,6 +372,8 @@ void factorbug(void)
 				dump stacks. This is useful for builder and
 				other cases where Factor is run with stdin
 				redirected to /dev/null */
+				fep_disabled = true;
+
 				print_datastack();
 				print_retainstack();
 				print_callstack();

vm/debug.h

@@ -4,4 +4,6 @@ void dump_generations(void);
 void factorbug(void);
 void dump_zone(F_ZONE *z);
 
+bool fep_disabled;
+
 DECLARE_PRIMITIVE(die);

vm/errors.c

@@ -57,10 +57,10 @@ void throw_error(CELL error, F_STACK_FRAME *callstack_top)
 	crash. */
 	else
 	{
-		fprintf(stderr,"You have triggered a bug in Factor. Please report.\n");
+		printf("You have triggered a bug in Factor. Please report.\n");
-		fprintf(stderr,"early_error: ");
+		printf("early_error: ");
 		print_obj(error);
-		fprintf(stderr,"\n");
+		printf("\n");
 		factorbug();
 	}
 }