diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index 47935c193c..7b1b9100c4 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -5,7 +5,7 @@ classes.tuple accessors prettyprint prettyprint.config compiler.tree.builder compiler.tree.optimizer compiler.cfg.builder compiler.cfg.linearization compiler.cfg.stack-frame compiler.cfg.linear-scan -compiler.cfg.optimizer ; +compiler.cfg.two-operand compiler.cfg.optimizer ; IN: compiler.cfg.debugger GENERIC: test-cfg ( quot -- cfgs ) @@ -22,6 +22,7 @@ SYMBOL: allocate-registers? test-cfg [ optimize-cfg build-mr + convert-two-operand allocate-registers? get [ linear-scan build-stack-frame ] when ] map ; diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 9402e4d841..7944415cbc 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -56,6 +56,20 @@ SYMBOL: progress [ [ start>> ] keep ] { } map>assoc unhandled-intervals get heap-push-all ; +! Coalescing +: active-interval ( vreg -- live-interval ) + dup active-intervals-for [ vreg>> = ] with find nip ; + +: coalesce? ( live-interval -- ? ) + [ start>> ] [ copy-from>> ] bi + dup [ active-interval end>> = ] [ 2drop f ] if ; + +: coalesce ( live-interval -- ) + dup copy-from>> active-interval + [ [ add-active ] [ delete-active ] bi* ] + [ reg>> >>reg drop ] + 2bi ; + ! Splitting : find-use ( live-interval n quot -- i elt ) [ uses>> ] 2dip curry find ; inline @@ -67,7 +81,7 @@ SYMBOL: progress : split-after ( live-interval i -- after ) [ clone dup uses>> ] dip [ tail >>uses ] [ swap nth >>start ] 2bi - f >>reg ; + f >>reg f >>copy-from ; : split-interval ( live-interval n -- before after ) [ drop ] [ [ > ] find-use drop ] 2bi @@ -128,8 +142,14 @@ SYMBOL: spill-counts pop >>reg add-active ; : assign-register ( new -- ) - dup vreg>> free-registers-for - [ assign-blocked-register ] [ assign-free-register ] if-empty ; + dup coalesce? [ + coalesce + ] [ + dup vreg>> free-registers-for + [ assign-blocked-register ] + [ assign-free-register ] + if-empty + ] if ; ! Main loop : reg-classes ( -- seq ) { int-regs double-float-regs } ; inline diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 1eea66f523..aa899208c0 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -303,3 +303,55 @@ USING: math.private compiler.cfg.debugger ; allocate-registers first split-before>> [ start>> ] [ end>> ] bi ] unit-test + +! Coalescing interacted badly with splitting +[ ] [ + { + T{ live-interval + { vreg V int-regs 70 } + { start 14 } + { end 17 } + { uses V{ 14 15 16 17 } } + { copy-from V int-regs 67 } + } + T{ live-interval + { vreg V int-regs 67 } + { start 13 } + { end 14 } + { uses V{ 13 14 } } + } + T{ live-interval + { vreg V int-regs 30 } + { start 4 } + { end 18 } + { uses V{ 4 12 16 17 18 } } + } + T{ live-interval + { vreg V int-regs 27 } + { start 3 } + { end 13 } + { uses V{ 3 7 13 } } + } + T{ live-interval + { vreg V int-regs 59 } + { start 10 } + { end 18 } + { uses V{ 10 11 12 18 } } + { copy-from V int-regs 56 } + } + T{ live-interval + { vreg V int-regs 60 } + { start 12 } + { end 17 } + { uses V{ 12 17 } } + } + T{ live-interval + { vreg V int-regs 56 } + { start 9 } + { end 10 } + { uses V{ 9 10 } } + } + } + { { int-regs { 0 1 2 3 } } } + allocate-registers +] 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 5ac733114b..73fe904485 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -8,7 +8,8 @@ IN: compiler.cfg.linear-scan.live-intervals TUPLE: live-interval vreg reg spill-to reload-from split-before split-after -start end uses ; +start end uses +copy-from ; : add-use ( n live-interval -- ) dup live-interval? [ "No def" throw ] unless @@ -37,12 +38,23 @@ SYMBOL: live-intervals [ [ ] keep ] dip set-at ] if ; -: compute-live-intervals* ( insn n -- ) +GENERIC# compute-live-intervals* 1 ( insn n -- ) + +M: insn compute-live-intervals* live-intervals get [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ] [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ] 3bi ; +: record-copy ( insn -- ) + [ dst>> live-intervals get at ] [ src>> ] bi >>copy-from drop ; + +M: ##copy compute-live-intervals* + [ call-next-method ] [ drop record-copy ] 2bi ; + +M: ##copy-float compute-live-intervals* + [ call-next-method ] [ drop record-copy ] 2bi ; + : compute-live-intervals ( instructions -- live-intervals ) H{ } clone [ live-intervals set