Coalescing

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 ;

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

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

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
         [ [ <live-interval> ] 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