diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 868beee160..3dcc925d7c 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs heaps kernel namespaces sequences fry math -combinators arrays sorting +combinators arrays sorting compiler.utilities compiler.cfg.linear-scan.allocation.coalescing compiler.cfg.linear-scan.allocation.spilling compiler.cfg.linear-scan.allocation.splitting @@ -39,7 +39,7 @@ IN: compiler.cfg.linear-scan.allocation [ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ] [ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ] 2tri 3array assoc-combine - >alist sort-values ; + >alist alist-max ; : no-free-registers? ( result -- ? ) second 0 = ; inline @@ -56,7 +56,7 @@ IN: compiler.cfg.linear-scan.allocation : assign-register ( new -- ) dup coalesce? [ coalesce ] [ - dup compute-free-pos last { + dup compute-free-pos { { [ 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 caef971ab9..2f4130e9ad 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -1,12 +1,24 @@ ! 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 +math sequences sets sorting splitting compiler.utilities compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.allocation.splitting compiler.cfg.linear-scan.live-intervals ; 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 + alist-max first ; + : split-for-spill ( live-interval n -- before after ) split-interval [ @@ -17,14 +29,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling [ ] 2tri ; -: find-use ( live-interval n quot -- i elt ) - [ uses>> ] 2dip curry find ; inline - -: interval-to-spill ( active-intervals current -- live-interval ) - #! We spill the interval with the most distant use location. - start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc - [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ; - : assign-spill ( before after -- before after ) #! If it has been spilled already, reuse spill location. over reload-from>> @@ -39,8 +43,8 @@ IN: compiler.cfg.linear-scan.allocation.spilling #! 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 ] - [ [ add-handled ] [ delete-active ] bi* ] [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ; : spill-new ( new existing -- ) @@ -50,10 +54,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling #! again. [ dup split-and-spill add-unhandled ] dip spill-existing ; -: spill-existing? ( new existing -- ? ) - #! Test if 'new' will be used before 'existing'. - over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ; - : assign-blocked-register ( new -- ) [ dup vreg>> active-intervals-for ] keep interval-to-spill 2dup spill-existing? [ spill-existing ] [ spill-new ] if ; diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 072da88c07..b43294818b 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -79,7 +79,7 @@ check-allocation? on { end 10 } { uses V{ 0 1 3 7 10 } } } - 4 [ >= ] find-use nip + 4 [ >= ] find-use ] unit-test [ 4 ] [ @@ -89,7 +89,7 @@ check-allocation? on { end 10 } { uses V{ 0 1 3 4 10 } } } - 4 [ >= ] find-use nip + 4 [ >= ] find-use ] unit-test [ f ] [ @@ -99,7 +99,7 @@ check-allocation? on { end 10 } { uses V{ 0 1 3 4 10 } } } - 100 [ >= ] find-use nip + 100 [ >= ] find-use ] unit-test [ @@ -1324,7 +1324,7 @@ USING: math.private compiler.cfg.debugger ; ! Spill slot liveness was computed incorrectly, leading to a FEP ! early in bootstrap on x86-32 -[ t ] [ +[ t t ] [ [ H{ } clone live-ins set H{ } clone live-outs set @@ -1349,7 +1349,9 @@ USING: math.private compiler.cfg.debugger ; } } } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan) - instructions>> first live-spill-slots>> empty? + instructions>> first + [ live-spill-slots>> empty? ] + [ live-registers>> empty? ] bi ] with-scope ] unit-test diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor index 31faaef480..ac276b6e41 100644 --- a/basis/compiler/utilities/utilities.factor +++ b/basis/compiler/utilities/utilities.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private arrays vectors fry -math.order namespaces assocs ; +math math.order namespaces assocs ; IN: compiler.utilities : flattener ( seq quot -- seq vector quot' ) @@ -25,3 +25,6 @@ IN: compiler.utilities SYMBOL: yield-hook yield-hook [ [ ] ] initialize + +: alist-max ( alist -- pair ) + [ ] [ [ [ second ] bi@ > ] most ] map-reduce ; \ No newline at end of file