diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 42b38e6260..c197da9814 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -28,16 +28,30 @@ IN: compiler.cfg.linear-scan.allocation : no-free-registers? ( result -- ? ) second 0 = ; inline +: split-to-fit ( new n -- before after ) + split-interval + [ [ compute-start/end ] bi@ ] + [ >>split-next drop ] + [ ] + 2tri ; + : register-partially-available ( new result -- ) - [ second split-to-fit ] keep - '[ _ register-available ] [ add-unhandled ] bi* ; + { + { [ 2dup second 1 - spill-live-out? ] [ drop spill-live-out ] } + { [ 2dup second 1 - spill-live-in? ] [ drop spill-live-in ] } + [ + [ second 1 - split-to-fit ] keep + '[ _ register-available ] [ add-unhandled ] bi* + ] + } cond ; : assign-register ( new -- ) dup coalesce? [ coalesce ] [ dup register-status { { [ dup no-free-registers? ] [ drop assign-blocked-register ] } { [ 2dup register-available? ] [ register-available ] } - [ register-partially-available ] + ! [ register-partially-available ] + [ drop assign-blocked-register ] } cond ] if ; diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index b4240ea813..b89c1f4de2 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -80,6 +80,8 @@ ERROR: bad-live-ranges interval ; [ add-unhandled ] } cleave ; +: spill-live-out? ( live-interval n -- ? ) [ uses>> last ] dip < ; + : spill-live-out ( live-interval -- ) ! The interval has no more usages after the spill location. This ! means it is the first child of an interval that was split. We @@ -91,6 +93,8 @@ ERROR: bad-live-ranges interval ; [ add-handled ] } cleave ; +: spill-live-in? ( live-interval n -- ? ) [ uses>> first ] dip > ; + : spill-live-in ( live-interval -- ) ! The interval does not have any usages before the spill location. ! This means it is the second child of an interval that was @@ -103,10 +107,10 @@ ERROR: bad-live-ranges interval ; [ add-unhandled ] } cleave ; -: (spill-intersecting) ( live-interval new -- ) - start>> { - { [ 2dup [ uses>> last ] dip < ] [ drop spill-live-out ] } - { [ 2dup [ uses>> first ] dip > ] [ drop spill-live-in ] } +: spill ( live-interval n -- ) + { + { [ 2dup spill-live-out? ] [ drop spill-live-out ] } + { [ 2dup spill-live-in? ] [ drop spill-live-in ] } [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] } cond ; @@ -115,7 +119,7 @@ ERROR: bad-live-ranges interval ; ! most one) are split and spilled and removed from the inactive ! set. new vreg>> active-intervals-for [ [ reg>> reg = ] find swap dup ] keep - '[ _ delete-nth new (spill-intersecting) ] [ 2drop ] if ; + '[ _ delete-nth new start>> spill ] [ 2drop ] if ; :: spill-intersecting-inactive ( new reg -- ) ! Any inactive intervals using 'reg' are split and spilled @@ -123,7 +127,7 @@ ERROR: bad-live-ranges interval ; new vreg>> inactive-intervals-for [ dup reg>> reg = [ dup new intervals-intersect? [ - new (spill-intersecting) f + new start>> spill f ] [ drop t ] if ] [ drop t ] if ] filter-here ; diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor index 4e33334730..0a67710bc8 100644 --- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor +++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor @@ -61,23 +61,3 @@ ERROR: splitting-atomic-interval ; after split-after ; HINTS: split-interval live-interval object ; - -: split-between-blocks ( new n -- before after ) - split-interval - 2dup [ compute-start/end ] bi@ ; - -: insert-use-for-copy ( seq n -- seq' ) - [ '[ _ < ] filter ] - [ nip dup 1 + 2array ] - [ 1 + '[ _ > ] filter ] - 2tri 3append ; - -: split-to-fit ( new n -- before after ) - 1 - - 2dup swap covers? [ - [ '[ _ insert-use-for-copy ] change-uses ] keep - split-between-blocks - 2dup >>split-next drop - ] [ - split-between-blocks - ] if ; \ No newline at end of file diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 7d2d367af8..06817071d4 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1,7 +1,7 @@ IN: compiler.cfg.linear-scan.tests USING: tools.test random sorting sequences sets hashtables assocs kernel fry arrays splitting namespaces math accessors vectors locals -math.order grouping strings strings.private +math.order grouping strings strings.private classes cpu.architecture compiler.cfg compiler.cfg.optimizer @@ -153,56 +153,6 @@ check-numbering? on } 10 split-for-spill [ f >>split-next ] bi@ ] unit-test -[ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 4 } - { uses V{ 0 1 4 } } - { ranges V{ T{ live-range f 0 4 } } } - } - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 5 } - { end 5 } - { uses V{ 5 } } - { ranges V{ T{ live-range f 5 5 } } } - } -] [ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 5 } - { uses V{ 0 1 5 } } - { ranges V{ T{ live-range f 0 5 } } } - } 5 split-to-fit [ f >>split-next ] bi@ -] unit-test - -[ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 4 } - { uses V{ 0 1 4 } } - { ranges V{ T{ live-range f 0 4 } } } - } - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 5 } - { end 10 } - { uses V{ 5 10 } } - { ranges V{ T{ live-range f 5 10 } } } - } -] [ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 10 } - { uses V{ 0 1 10 } } - { ranges V{ T{ live-range f 0 10 } } } - } 5 split-to-fit [ f >>split-next ] bi@ -] unit-test - [ T{ live-interval { vreg T{ vreg { reg-class int-regs } { n 1 } } } @@ -225,7 +175,7 @@ check-numbering? on { end 10 } { uses V{ 0 1 4 5 10 } } { ranges V{ T{ live-range f 0 10 } } } - } 5 split-to-fit [ f >>split-next ] bi@ + } 4 split-to-fit [ f >>split-next ] bi@ ] unit-test [ @@ -1847,8 +1797,6 @@ test-diamond [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test -USING: classes ; - [ ] [ 1 get instructions>> first regs>> V int-regs 0 swap at 2 get instructions>> first regs>> V int-regs 1 swap at assert=