diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index d948fe37ff..4a58064582 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -25,7 +25,7 @@ IN: compiler.cfg.linear-scan.allocation _ add-use-position ] each ; -: compute-free-pos ( new -- free-pos ) +: register-status ( new -- free-pos ) dup free-positions [ inactive-positions ] [ active-positions ] [ nip ] 2tri >alist alist-max ; @@ -45,7 +45,7 @@ IN: compiler.cfg.linear-scan.allocation : assign-register ( new -- ) dup coalesce? [ coalesce ] [ - dup compute-free-pos { + dup register-status { { [ dup no-free-registers? ] [ drop assign-blocked-register ] } { [ 2dup register-available? ] [ register-available ] } [ register-partially-available ] diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index 2f4130e9ad..8a671d4455 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators fry hints kernel locals -math sequences sets sorting splitting compiler.utilities +math sequences sets sorting splitting compiler.utilities namespaces compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.allocation.splitting compiler.cfg.linear-scan.live-intervals ; @@ -10,42 +10,79 @@ IN: compiler.cfg.linear-scan.allocation.spilling : find-use ( live-interval n quot -- elt ) [ uses>> ] 2dip curry find nip ; inline -: spill-existing? ( new existing -- ? ) - #! Test if 'new' will be used before 'existing'. - over start>> '[ _ [ > ] find-use -1 or ] bi@ < ; - : interval-to-spill ( active-intervals current -- live-interval ) #! We spill the interval with the most distant use location. - start>> '[ dup _ [ >= ] find-use ] { } map>assoc + #! If an active interval has no more use positions, find-use + #! returns f. This occurs if the interval is a split. In + #! this case, we prefer to spill this interval always. + start>> '[ dup _ [ >= ] find-use 1/0. or ] { } map>assoc alist-max first ; +ERROR: bad-live-ranges interval ; + +: check-ranges ( live-interval -- ) + check-allocation? get [ + dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all? + [ drop ] [ bad-live-ranges ] if + ] [ drop ] if ; + +: trim-before-ranges ( live-interval n -- ) + [ ranges>> ] [ uses>> last ] bi + [ '[ from>> _ <= ] filter-here ] + [ swap last (>>to) ] + 2bi ; + +: trim-after-ranges ( live-interval n -- ) + [ ranges>> ] [ uses>> first ] bi + [ '[ to>> _ >= ] filter-here ] + [ swap first (>>from) ] + 2bi ; + : split-for-spill ( live-interval n -- before after ) split-interval - [ - [ [ ranges>> last ] [ uses>> last ] bi >>to drop ] - [ [ ranges>> first ] [ uses>> first ] bi >>from drop ] bi* - ] - [ [ compute-start/end ] bi@ ] - [ ] - 2tri ; + { + [ [ trim-before-ranges ] [ trim-after-ranges ] bi* ] + [ [ compute-start/end ] bi@ ] + [ [ check-ranges ] bi@ ] + [ ] + } 2cleave ; -: assign-spill ( before after -- before after ) - #! If it has been spilled already, reuse spill location. - over reload-from>> - [ over vreg>> reg-class>> next-spill-location ] unless* - [ >>spill-to ] [ >>reload-from ] bi-curry bi* ; +: assign-spill ( live-interval -- live-interval ) + dup reload-from>> + [ dup vreg>> reg-class>> next-spill-location ] unless* + >>spill-to ; + +: assign-reload ( before after -- before after ) + over spill-to>> >>reload-from ; : split-and-spill ( new existing -- before after ) - swap start>> split-for-spill assign-spill ; + swap start>> split-for-spill assign-spill assign-reload ; + +: reuse-register ( new existing -- ) + [ nip delete-active ] + [ reg>> >>reg add-active ] 2bi ; + +: spill-existing? ( new existing -- ? ) + #! Test if 'new' will be used before 'existing'. + over start>> '[ _ [ > ] find-use -1 or ] bi@ < ; : spill-existing ( new existing -- ) #! Our new interval will be used before the active interval #! with the most distant use location. Spill the existing #! interval, then process the new interval and the tail end #! of the existing interval again. - [ nip delete-active ] - [ reg>> >>reg add-active ] - [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ; + [ reuse-register ] + [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2bi ; + +: spill-live-out? ( new existing -- ? ) + [ start>> ] [ uses>> last ] bi* > ; + +: spill-live-out ( new existing -- ) + #! The existing interval is never used again. Spill it and + #! re-use the register. + assign-spill + [ reuse-register ] + [ nip add-handled ] 2bi ; : spill-new ( new existing -- ) #! Our new interval will be used after the active interval @@ -55,6 +92,9 @@ IN: compiler.cfg.linear-scan.allocation.spilling [ dup split-and-spill add-unhandled ] dip spill-existing ; : assign-blocked-register ( new -- ) - [ dup vreg>> active-intervals-for ] keep interval-to-spill - 2dup spill-existing? [ spill-existing ] [ spill-new ] if ; + [ dup vreg>> active-intervals-for ] keep interval-to-spill { + { [ 2dup spill-live-out? ] [ spill-live-out ] } + { [ 2dup spill-existing? ] [ spill-existing ] } + [ spill-new ] + } cond ; diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index ab03882757..745146b56e 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -50,8 +50,11 @@ ERROR: already-spilled ; : handle-spill ( live-interval -- ) dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ; +: first-split ( live-interval -- live-interval' ) + dup split-before>> [ first-split ] [ ] ?if ; + : next-interval ( live-interval -- live-interval' ) - split-next>> dup split-before>> [ next-interval ] [ ] ?if ; + split-next>> first-split ; : insert-copy ( live-interval -- ) { diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 5d11e2a5a0..65778a3e7b 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -156,6 +156,31 @@ check-assignment? on } 0 split-for-spill [ f >>split-next ] bi@ ] unit-test +[ + T{ live-interval + { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { start 0 } + { end 0 } + { uses V{ 0 } } + { ranges V{ T{ live-range f 0 0 } } } + } + T{ live-interval + { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { start 20 } + { end 30 } + { uses V{ 20 30 } } + { ranges V{ T{ live-range f 20 30 } } } + } +] [ + T{ live-interval + { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { start 0 } + { end 30 } + { uses V{ 0 20 30 } } + { ranges V{ T{ live-range f 0 8 } T{ live-range f 10 18 } T{ live-range f 20 30 } } } + } 10 split-for-spill [ f >>split-next ] bi@ +] unit-test + [ T{ live-interval { vreg T{ vreg { reg-class int-regs } { n 1 } } } @@ -1419,7 +1444,7 @@ USING: math.private ; relevant-ranges intersect-live-ranges ] unit-test -! compute-free-pos had problems because it used map>assoc where the sequence +! register-status had problems because it used map>assoc where the sequence ! had multiple keys [ { 0 10 } ] [ H{ { int-regs { 0 1 } } } registers set @@ -1468,7 +1493,7 @@ USING: math.private ; { ranges V{ T{ live-range f 8 10 } } } { uses V{ 8 10 } } } - compute-free-pos + register-status ] unit-test ! Bug in live spill slots calculation @@ -1531,18 +1556,16 @@ V{ SYMBOL: linear-scan-result :: test-linear-scan-on-cfg ( regs -- ) - [ ] [ - cfg new 0 get >>entry - compute-predecessors - compute-liveness - dup reverse-post-order - { { int-regs regs } } (linear-scan) - flatten-cfg 1array mr. - ] unit-test ; + cfg new 0 get >>entry + compute-predecessors + compute-liveness + dup reverse-post-order + { { int-regs regs } } (linear-scan) + flatten-cfg 1array mr. ; ! This test has a critical edge -- do we care about these? -! { 1 2 } test-linear-scan-on-cfg +! [ { 1 2 } test-linear-scan-on-cfg ] unit-test ! Bug in inactive interval handling ! [ rot dup [ -rot ] when ] @@ -1619,7 +1642,7 @@ V{ test-diamond -{ 1 2 3 4 } test-linear-scan-on-cfg +[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test ! Similar to the above ! [ swap dup [ rot ] when ] @@ -1705,7 +1728,7 @@ V{ test-diamond -{ 1 2 3 4 } test-linear-scan-on-cfg +[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test ! compute-live-registers was inaccurate since it didn't take ! lifetime holes into account @@ -1758,7 +1781,7 @@ V{ test-diamond -{ 1 2 3 4 } test-linear-scan-on-cfg +[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test ! Inactive interval handling: splitting active interval ! if it fits in lifetime hole only partially @@ -1791,7 +1814,7 @@ V{ test-diamond -{ 1 2 } test-linear-scan-on-cfg +[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test USING: classes ; @@ -1830,7 +1853,7 @@ V{ test-diamond -{ 1 2 } test-linear-scan-on-cfg +[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test [ _spill ] [ 2 get instructions>> first class ] unit-test diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index c67a7bb021..ca8140f1c6 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs accessors sequences math math.order fry -binary-search combinators compiler.cfg.instructions compiler.cfg.registers +combinators compiler.cfg.instructions compiler.cfg.registers compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ; IN: compiler.cfg.linear-scan.live-intervals diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor index feb9ac2504..f2d71691aa 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor @@ -40,11 +40,11 @@ T{ live-interval } [ f ] [ - 0 get test-live-interval-1 spill-to + test-live-interval-1 0 get spill-to ] unit-test [ 0 ] [ - 1 get test-live-interval-1 spill-to + test-live-interval-1 1 get spill-to ] unit-test CONSTANT: test-live-interval-2 @@ -58,11 +58,11 @@ T{ live-interval } [ 0 ] [ - 0 get test-live-interval-2 reload-from + test-live-interval-2 0 get reload-from ] unit-test [ f ] [ - 1 get test-live-interval-2 reload-from + test-live-interval-2 1 get reload-from ] unit-test [ @@ -136,10 +136,14 @@ T{ live-interval ] unit-test [ - { T{ _spill { src 4 } { class int-regs } { n spill-temp } } } + { + T{ _spill { src 3 } { class int-regs } { n 4 } } + T{ _reload { dst 2 } { class int-regs } { n 1 } } + } ] [ { - T{ register->memory { from 4 } { to 4 } { reg-class int-regs } } + T{ register->memory { from 3 } { to 4 } { reg-class int-regs } } + T{ memory->register { from 1 } { to 2 } { reg-class int-regs } } } mapping-instructions ] unit-test diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index bd7528291d..7681b811c4 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -25,13 +25,16 @@ SYNTAX: OPERATION: >> -: reload-from ( bb live-interval -- n/f ) - 2dup [ block-from ] [ start>> ] bi* = - [ nip reload-from>> ] [ 2drop f ] if ; +: insn-in-block? ( insn# bb -- ? ) + [ block-from ] [ block-to ] bi between? ; -: spill-to ( bb live-interval -- n/f ) - 2dup [ block-to ] [ end>> ] bi* = - [ nip spill-to>> ] [ 2drop f ] if ; +: reload-from ( live-interval bb -- n/f ) + 2dup [ start>> ] dip insn-in-block? + [ drop reload-from>> ] [ 2drop f ] if ; + +: spill-to ( live-interval bb -- n/f ) + 2dup [ end>> ] dip insn-in-block? + [ drop spill-to>> ] [ 2drop f ] if ; OPERATION: memory->memory spill-to>> reload-from>> OPERATION: register->memory reg>> reload-from>> @@ -39,12 +42,12 @@ OPERATION: memory->register spill-to>> reg>> OPERATION: register->register reg>> reg>> :: add-mapping ( bb1 bb2 li1 li2 -- ) - bb2 li2 reload-from [ - bb1 li1 spill-to + li2 bb2 reload-from [ + li1 bb1 spill-to [ li1 li2 memory->memory ] [ li1 li2 register->memory ] if ] [ - bb1 li1 spill-to + li1 bb1 spill-to [ li1 li2 memory->register ] [ li1 li2 register->register ] if ] if ; @@ -68,10 +71,10 @@ M: memory->memory >insn [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ; M: register->memory >insn - [ from>> ] [ reg-class>> ] bi spill-temp _spill ; + [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ; M: memory->register >insn - [ to>> ] [ reg-class>> ] bi spill-temp _reload ; + [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ; M: register->register >insn [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ; @@ -82,10 +85,10 @@ M: memory->memory >collision-table [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ; M: register->memory >collision-table - [ from>> ] [ reg-class>> ] bi spill-temp _spill ; + [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ; M: memory->register >collision-table - [ to>> ] [ reg-class>> ] bi spill-temp _reload ; + [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ; M: register->register >collision-table [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;