diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 4aa2088143..4f215f1dc8 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -16,6 +16,9 @@ ERROR: last-insn-not-a-jump insn ; [ ##return? ] [ ##callback-return? ] [ ##jump? ] + [ ##fixnum-add-tail? ] + [ ##fixnum-sub-tail? ] + [ ##fixnum-mul-tail? ] [ ##call? ] } 1|| [ drop ] [ last-insn-not-a-jump ] if ; diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index fa10ecfca4..f8258039e1 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -264,7 +264,7 @@ SYMBOL: spill-counts ] if ; ! Main loop -: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline +CONSTANT: reg-classes { int-regs double-float-regs } : reg-class-assoc ( quot -- assoc ) [ reg-classes ] dip { } map>assoc ; inline diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 4a9b0b231d..6fcd6e7570 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -1,11 +1,12 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel math assocs namespaces sequences heaps -fry make combinators +fry make combinators sets cpu.architecture compiler.cfg.def-use compiler.cfg.registers compiler.cfg.instructions +compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.live-intervals ; IN: compiler.cfg.linear-scan.assignment @@ -30,25 +31,44 @@ SYMBOL: unhandled-intervals : init-unhandled ( live-intervals -- ) [ add-unhandled ] each ; +! Mapping spill slots to vregs +SYMBOL: spill-slots + +: spill-slots-for ( vreg -- assoc ) + reg-class>> spill-slots get at ; + +: record-spill ( live-interval -- ) + [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi + 2dup key? [ "BUG: Already spilled" throw ] [ set-at ] if ; + : insert-spill ( live-interval -- ) - [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri - dup [ _spill ] [ 3drop ] if ; + [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ; + +: handle-spill ( live-interval -- ) + dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ; : expire-old-intervals ( n -- ) active-intervals get [ swap '[ end>> _ = ] partition ] change-seq drop - [ insert-spill ] each ; + [ handle-spill ] each ; + +: record-reload ( live-interval -- ) + [ reload-from>> ] [ vreg>> spill-slots-for ] bi + 2dup key? [ delete-at ] [ "BUG: Already reloaded" throw ] if ; : insert-reload ( live-interval -- ) - [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri - dup [ _reload ] [ 3drop ] if ; + [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ; + +: handle-reload ( live-interval -- ) + dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ; : activate-new-intervals ( n -- ) #! Any live intervals which start on the current instruction #! are added to the active set. unhandled-intervals get dup heap-empty? [ 2drop ] [ 2dup heap-peek drop start>> = [ - heap-pop drop [ add-active ] [ insert-reload ] bi + heap-pop drop + [ add-active ] [ handle-reload ] bi activate-new-intervals ] [ 2drop ] if ] if ; @@ -71,8 +91,7 @@ M: insn assign-before drop ; active-intervals get seq>> [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ; : compute-live-spill-slots ( -- spill-slots ) - unhandled-intervals get - heap-values [ reload-from>> ] filter + spill-slots get values [ values ] map concat [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ; M: ##gc assign-after @@ -88,6 +107,7 @@ M: insn assign-after drop ; : init-assignment ( live-intervals -- ) active-intervals set unhandled-intervals set + [ H{ } clone ] reg-class-assoc spill-slots set init-unhandled ; : assign-registers-in-block ( bb -- ) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index cf4daa3ab0..e4510e884e 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1290,3 +1290,28 @@ USING: math.private compiler.cfg.debugger ; { { int-regs { 0 1 2 3 } } } allocate-registers drop ] unit-test + +! Spill slot liveness was computed incorrectly, leading to a FEP +! early in bootstrap on x86-32 +[ t ] [ + T{ basic-block + { instructions + V{ + T{ ##gc f V int-regs 6 V int-regs 7 } + T{ ##peek f V int-regs 0 D 0 } + T{ ##peek f V int-regs 1 D 1 } + T{ ##peek f V int-regs 2 D 2 } + T{ ##peek f V int-regs 3 D 3 } + T{ ##peek f V int-regs 4 D 4 } + T{ ##peek f V int-regs 5 D 5 } + T{ ##replace f V int-regs 0 D 1 } + T{ ##replace f V int-regs 1 D 2 } + T{ ##replace f V int-regs 2 D 3 } + T{ ##replace f V int-regs 3 D 4 } + T{ ##replace f V int-regs 4 D 5 } + T{ ##replace f V int-regs 5 D 0 } + } + } + } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan) + instructions>> first live-spill-slots>> empty? +] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor index 1e6b9d02c8..ffa356bfc2 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan.factor @@ -25,13 +25,15 @@ IN: compiler.cfg.linear-scan ! by Omri Traub, Glenn Holloway, Michael D. Smith ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435 -: (linear-scan) ( rpo -- ) - dup number-instructions - dup compute-live-intervals - machine-registers allocate-registers assign-registers ; +: (linear-scan) ( rpo machine-registers -- ) + [ + dup number-instructions + dup compute-live-intervals + ] dip + allocate-registers assign-registers ; : linear-scan ( cfg -- cfg' ) [ - dup reverse-post-order (linear-scan) + dup reverse-post-order machine-registers (linear-scan) spill-counts get >>spill-counts ] with-scope ; diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index 8ceafd1693..9d481ef1d2 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -11,9 +11,17 @@ compiler.cfg.dce compiler.cfg.write-barrier compiler.cfg.liveness compiler.cfg.rpo -compiler.cfg.phi-elimination ; +compiler.cfg.phi-elimination +compiler.cfg.checker ; IN: compiler.cfg.optimizer +SYMBOL: check-optimizer? + +: ?check ( cfg -- cfg' ) + check-optimizer? get [ + dup check-cfg + ] when ; + : optimize-cfg ( cfg -- cfg' ) [ compute-predecessors @@ -27,4 +35,5 @@ IN: compiler.cfg.optimizer eliminate-dead-code eliminate-write-barriers eliminate-phis + ?check ] with-scope ; diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 7527f6b339..6d0f6f3ace 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -193,7 +193,8 @@ M: optimizing-compiler recompile ( words -- alist ) ] each compile-queue get compile-loop compiled get >alist - ] with-scope ; + ] with-scope + "trace-compilation" get [ "--- compile done" print flush ] when ; : with-optimizer ( quot -- ) [ optimizing-compiler compiler-impl ] dip with-variable ; inline diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index ca783c13e6..5f393ed65d 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -127,7 +127,10 @@ TUPLE: no-current-vocab ; ] [ drop ] if ; : only-use-vocabs ( vocabs -- ) - clear-manifest [ vocab ] filter [ use-vocab ] each ; + clear-manifest + [ vocab ] filter + [ vocab source-loaded?>> +done+ eq? ] filter + [ use-vocab ] each ; TUPLE: qualified vocab prefix words ;