diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 17376a594f..6b9a953ab9 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/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 diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index dd78b4ba3e..7888635641 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/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 ] } diff --git a/unfinished/compiler/alien/alien.factor b/unfinished/compiler/alien/alien.factor index 1d63a06057..e414d6e29b 100644 --- a/unfinished/compiler/alien/alien.factor +++ b/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? [ - heap-size struct-small-enough? not - ] [ drop f ] if ; + dup c-struct? [ 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 + ; diff --git a/unfinished/compiler/backend/backend.factor b/unfinished/compiler/backend/backend.factor index 2efd22610e..2a516c6ec4 100644 --- a/unfinished/compiler/backend/backend.factor +++ b/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 ) - -: stack-frame* ( -- n ) - \ stack-frame get stack-frame ; +HOOK: stack-frame-size cpu ( frame-size -- n ) ! Set up caller stack frame HOOK: %prologue cpu ( n -- ) diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor index ff1ddd9747..c8add3ca09 100755 --- a/unfinished/compiler/cfg/builder/builder.factor +++ b/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 ; + +: ( 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>> ##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-frame ##frame-required ] - [ ##alien-invoke iterate-next ] - bi ; + [ ##alien-invoke ] emit-alien-node ; M: #alien-indirect emit-node - params>> - [ alien-invoke-frame ##frame-required ] - [ ##alien-indirect iterate-next ] - bi ; + [ ##alien-indirect ] emit-alien-node ; 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 diff --git a/unfinished/compiler/cfg/cfg.factor b/unfinished/compiler/cfg/cfg.factor index 140d406c4c..e32ad47890 100644 --- a/unfinished/compiler/cfg/cfg.factor +++ b/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 ; : ( instructions word label -- mr ) mr new diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor index 9bb576dcb3..3014587edd 100644 --- a/unfinished/compiler/cfg/instructions/instructions.factor +++ b/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: _epilogue ; +INSN: _prologue stack-frame ; +INSN: _epilogue stack-frame ; INSN: _label id ; diff --git a/unfinished/compiler/cfg/stack-frame/stack-frame.factor b/unfinished/compiler/cfg/stack-frame/stack-frame.factor index 56282cfb09..6ec34d37c2 100644 --- a/unfinished/compiler/cfg/stack-frame/stack-frame.factor +++ b/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-frame-size* ] each ; +: compute-stack-frame ( insns -- ) + [ 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 ; diff --git a/unfinished/compiler/cfg/stacks/stacks.factor b/unfinished/compiler/cfg/stacks/stacks.factor index 39cd942bb2..56be18c107 100755 --- a/unfinished/compiler/cfg/stacks/stacks.factor +++ b/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 ( -- ) diff --git a/unfinished/compiler/cfg/templates/templates.factor b/unfinished/compiler/cfg/templates/templates.factor index 12a56704d0..72e092ad68 100644 --- a/unfinished/compiler/cfg/templates/templates.factor +++ b/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? - [ first (eager-load) ] [ first (lazy-load) ] if - ] 2map - ] 2bi - [ substitute-vregs ] keep ; + [ + 2dup second clobbered? + [ first (eager-load) ] [ first (lazy-load) ] if + ] 2map ; : load-inputs ( template -- assoc ) [ diff --git a/unfinished/compiler/codegen/codegen.factor b/unfinished/compiler/codegen/codegen.factor index 15ebd691bf..fe6b45e88a 100644 --- a/unfinished/compiler/codegen/codegen.factor +++ b/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? - [ heap-size %prepare-box-struct cell ] [ drop 0 ] if ; + return>> large-struct? + [ %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" = ] [ size>> ] } { [ dup return>> large-struct? ] [ drop 4 ] } [ drop 0 ] } cond ; diff --git a/vm/debug.c b/vm/debug.c index b374aceb9f..0869d6a885 100755 --- a/vm/debug.c +++ b/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(); diff --git a/vm/debug.h b/vm/debug.h index 2ca6f8944c..547fdba436 100755 --- a/vm/debug.h +++ b/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); diff --git a/vm/errors.c b/vm/errors.c index f2147041a2..7a23e3e53f 100755 --- a/vm/errors.c +++ b/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"); - fprintf(stderr,"early_error: "); + printf("You have triggered a bug in Factor. Please report.\n"); + printf("early_error: "); print_obj(error); - fprintf(stderr,"\n"); + printf("\n"); factorbug(); } }