compiler.cfg.ssa.destruction.coalescing: refactor and maybe a fix for #1308

the eliminatable-copy? word is the fix. the previous code only checked
that the registers had the same register class, but you also need to
check that they dont have the same representation size. because a copy
from double-rep -> double-2-rep is not eliminatable

basis/compiler/cfg/ssa/destruction/coalescing/coalescing-docs.factor

@@ -14,14 +14,23 @@ HELP: coalesce-elements
 { $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
 { $description "Delete follower's class, and set leaders's class to merged." } ;
 
-HELP: coalesce-insn
+HELP: coalesce-now
 { $values { "insn" insn } }
-{ $description "Generic word supposed to be called in a " { $link make } " context which generates a list of eliminatable vreg copies. The word either eliminates copies immediately in case of " { $link ##phi } " and " { $link ##tagged>integer } " instructions or appends copies to the make sequence so that they are handled later by " { $link coalesce-cfg } "." } ;
+{ $description "Generic word which finds copy pairs in instructions and tries to eliminate them directly." }
+{ $see-also coalesce-later } ;
+
+HELP: coalesce-later
+{ $values { "insn" insn } }
+{ $description "Generic word supposed to be called in a " { $link make } " context which generates a list of eliminatable vreg copies. The copies are batched up and then eliminated by " { $link try-eliminate-copies } "." } ;
 
 HELP: coalesce-vregs
 { $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
 { $description "Sets 'leader' as the leader of 'follower'." } ;
 
+HELP: eliminatable-copy?
+{ $values { "vreg1" "vreg" } { "vreg2" "vreg" } }
+{ $description "Determines if a vreg copy can be eliminated. It can be eliminated if the vregs have the same register class and same representation size." } ;
+
 HELP: try-eliminate-copy
 { $values { "follower" "vreg" } { "leader" "vreg" } { "must?" boolean } }
 { $description "Tries to eliminate a vreg copy from 'leader' to 'follower'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if the vregs interfere." }
@@ -33,7 +42,7 @@ HELP: try-eliminate-copies
 { $see-also try-eliminate-copy } ;
 
 ARTICLE: "compiler.cfg.ssa.destruction.coalescing" "Vreg Coalescing"
-"This compiler pass eliminates redundant vreg copies."
+"This compiler pass eliminates redundant vreg copies. Coalescing occurs in two steps. First all redundant copies in all " { $link ##tagged>integer } " and " { $link ##phi } " instructions are handled. Then those in other instructions like " { $link vreg-insn } ", " { $link ##copy } " and " { $link ##parallel-copy } "."
 $nl
 "Main entry point:"
 { $subsections coalesce-cfg }

basis/compiler/cfg/ssa/destruction/coalescing/coalescing-tests.factor

@@ -50,15 +50,15 @@ IN: compiler.cfg.ssa.destruction.coalescing.tests
            { size 24 }
            { temp 303 }
         }
-    } insns>cfg initial-leaders
+    } initial-leaders
 ] unit-test
 
 ! init-coalescing
 {
     H{ { 118 118 } }
 } [
-    { T{ ##phi { dst 118 } { inputs H{ { 4 120 } { 2 119 } } } } } insns>cfg
+    { T{ ##phi { dst 118 } { inputs H{ { 4 120 } { 2 119 } } } } }
-    dup compute-defs init-coalescing
+    [ insns>cfg compute-defs ] [ init-coalescing ] bi
     leader-map get
 ] unit-test
 
@@ -67,16 +67,16 @@ IN: compiler.cfg.ssa.destruction.coalescing.tests
     10 10 f try-eliminate-copy
 ] unit-test
 
-! coalesce-insn
+! coalesce-later
 { V{ { 2 1 } } } [
     [
-        T{ ##copy { src 1 } { dst 2 } { rep int-rep } } coalesce-insn
+        T{ ##copy { src 1 } { dst 2 } { rep int-rep } } coalesce-later
     ] V{ } make
 ] unit-test
 
 { V{ { 3 4 } { 7 8 } } } [
     [
-        T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } coalesce-insn
+        T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } coalesce-later
     ] V{ } make
 ] unit-test
 
@@ -92,7 +92,7 @@ IN: compiler.cfg.ssa.destruction.coalescing.tests
     10 [
         { 2286 2287 2288 } sets:unique leader-map set
         2286 make-phi-inputs ##phi new-insn
-        coalesce-insn
+        coalesce-now
         2286 leader
     ] replicate all-equal?
 ] unit-test

basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor

@@ -35,44 +35,46 @@ ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
 : try-eliminate-copies ( pairs must? -- )
     '[ first2 _ try-eliminate-copy ] each ;
 
-GENERIC: coalesce-insn ( insn -- )
+: initial-leaders ( insns -- leaders )
-
+    [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat unique ;
-M: insn coalesce-insn drop ;
-
-M: alien-call-insn coalesce-insn drop ;
-
-M: vreg-insn coalesce-insn
-    [ defs-vregs ] [ uses-vregs ] bi
-    2dup [ empty? not ] both? [
-        [ first ] bi@
-        2dup [ rep-of reg-class-of ] bi@ eq?
-        [ 2array , ] [ 2drop ] if
-    ] [ 2drop ] if ;
-
-M: ##copy coalesce-insn
-    [ dst>> ] [ src>> ] bi 2array , ;
-
-M: ##parallel-copy coalesce-insn
-    values>> % ;
-
-M: ##tagged>integer coalesce-insn
-    [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
-
-M: ##phi coalesce-insn
-    [ dst>> ] [ inputs>> values ] bi zip-scalar
-    natural-sort t try-eliminate-copies ;
-
-: initial-leaders ( cfg -- leaders )
-    cfg>insns [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat unique ;
 
 : initial-class-elements ( -- class-elements )
     defs get [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map ;
 
-: init-coalescing ( cfg -- )
+: init-coalescing ( insns -- )
     initial-leaders leader-map set
     initial-class-elements class-element-map set ;
 
+GENERIC: coalesce-now ( insn -- )
+
+M: insn coalesce-now drop ;
+
+M: ##tagged>integer coalesce-now
+    [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
+
+M: ##phi coalesce-now
+    [ dst>> ] [ inputs>> values ] bi zip-scalar
+    natural-sort t try-eliminate-copies ;
+
+GENERIC: coalesce-later ( insn -- )
+
+M: insn coalesce-later drop ;
+
+M: alien-call-insn coalesce-later drop ;
+
+M: vreg-insn coalesce-later
+    [ defs-vregs ] [ uses-vregs ] bi zip ?first [ , ] when* ;
+
+M: ##copy coalesce-later
+    [ dst>> ] [ src>> ] bi 2array , ;
+
+M: ##parallel-copy coalesce-later
+    values>> % ;
+
+: eliminatable-copy? ( vreg1 vreg2 -- ? )
+    [ rep-of ] bi@ [ [ reg-class-of ] same? ] [ [ rep-size ] same? ] 2bi and ;
+
 : coalesce-cfg ( cfg -- )
-    dup init-coalescing
+    cfg>insns-rpo dup init-coalescing
-    cfg>insns-rpo [ [ coalesce-insn ] each ] V{ } make
+    [ [ [ coalesce-now ] [ coalesce-later ] bi ] each ] { } make
-    f try-eliminate-copies ;
+    [ first2 eliminatable-copy? ] filter f try-eliminate-copies ;