compiler.cfg.ssa.destruction.coalescing: new vocab to refactor and

simplify the prepare-insn code in compiler.cfg.ssa.destruction

basis/compiler/cfg/linearization/linearization.factor

@@ -74,5 +74,11 @@ SYMBOL: numbers
 : number-blocks ( bbs -- )
     H{ } zip-index-as numbers set ;
 
+: blocks>insns ( bbs -- insns )
+    [ instructions>> ] map concat ;
+
 : cfg>insns ( cfg -- insns )
-    linearization-order [ instructions>> ] map concat ;
+    linearization-order blocks>insns ;
+
+: cfg>insns-rpo ( cfg -- insns )
+    reverse-post-order blocks>insns ;

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

@@ -0,0 +1,39 @@
+USING: compiler.cfg.instructions compiler.cfg.ssa.interference
+help.markup help.syntax kernel make sequences ;
+IN: compiler.cfg.ssa.destruction.coalescing
+
+HELP: class-element-map
+{ $var-description "Maps leaders to equivalence class elements which are sequences of " { $link vreg-info } " instances." } ;
+
+HELP: coalesce-elements
+{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
+{ $description "Delete follower's class, and set leaders's class to merged." } ;
+
+HELP: coalesce-insn
+{ $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 } "." } ;
+
+HELP: coalesce-vregs
+{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
+{ $description "Sets 'leader' as the leader of 'follower'." } ;
+
+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." }
+{ $see-also try-eliminate-copies vregs-interfere? } ;
+
+HELP: try-eliminate-copies
+{ $values { "pairs" "a sequence of vreg pairs" } { "must?" boolean } }
+{ $description "Tries to eliminate the vreg copies in the " { $link sequence } " 'pairs'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if any of the vregs interfere." }
+{ $see-also try-eliminate-copy } ;
+
+ARTICLE: "compiler.cfg.ssa.destruction.coalescing" "Vreg Coalescing"
+"This compiler pass eliminates redundant vreg copies."
+$nl
+"Main entry point:"
+{ $subsections coalesce-cfg }
+"Vreg copy elimination:"
+{ $subsections
+  try-eliminate-copies
+  try-eliminate-copy
+} ;

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

@@ -0,0 +1,49 @@
+USING: assocs compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.ssa.destruction.coalescing compiler.cfg.ssa.destruction.leaders
+cpu.architecture grouping kernel make namespaces random sequences tools.test ;
+QUALIFIED: sets
+IN: compiler.cfg.ssa.destruction.coalescing.tests
+
+! init-coalescing
+{
+    H{ { 123 123 } { 77 77 } }
+} [
+    H{ { 123 "bb1" } { 77 "bb2" } } defs set
+    init-coalescing
+    leader-map get
+] unit-test
+
+! try-eliminate-copy
+{ } [
+    10 10 f try-eliminate-copy
+] unit-test
+
+! coalesce-insn
+{ V{ { 2 1 } } } [
+    [
+        T{ ##copy { src 1 } { dst 2 } { rep int-rep } } coalesce-insn
+    ] V{ } make
+] unit-test
+
+{ V{ { 3 4 } { 7 8 } } } [
+    [
+        T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } coalesce-insn
+    ] V{ } make
+] unit-test
+
+! All this work to make the 'values' order non-deterministic.
+: make-phi-inputs ( -- assoc )
+    H{ } clone [
+        { 2287 2288 } [
+            10 iota 1 sample first rot set-at
+        ] with each
+    ] keep ;
+
+{ t } [
+    10 [
+        { 2286 2287 2288 } sets:unique leader-map set
+        2286 make-phi-inputs ##phi new-insn
+        coalesce-insn
+        2286 leader
+    ] replicate all-equal?
+] unit-test

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

@@ -0,0 +1,79 @@
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.linearization
+compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
+compiler.cfg.ssa.interference cpu.architecture fry kernel make
+namespaces sequences sets sorting ;
+FROM: namespaces => set ;
+IN: compiler.cfg.ssa.destruction.coalescing
+
+: zip-scalar ( scalar seq -- pairs )
+    [ 2array ] with map ;
+
+SYMBOL: class-element-map
+
+: value-of ( vreg -- value )
+    dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
+
+: init-coalescing ( -- )
+    defs get
+    [ keys unique leader-map set ]
+    [
+        [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map
+        class-element-map set
+    ] bi ;
+
+: coalesce-elements ( merged follower leader -- )
+    class-element-map get [ delete-at ] [ set-at ] bi-curry bi* ;
+
+: coalesce-vregs ( merged follower leader -- )
+    2dup swap leader-map get set-at coalesce-elements ;
+
+: vregs-interfere? ( vreg1 vreg2 -- merged/f ? )
+    [ class-element-map get at ] bi@ sets-interfere? ;
+
+ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
+
+: try-eliminate-copy ( follower leader must? -- )
+    -rot leaders 2dup = [ 3drop ] [
+        2dup vregs-interfere? [
+            drop rot [ vregs-shouldn't-interfere ] [ 2drop ] if
+        ] [ -rot coalesce-vregs drop ] if
+    ] if ;
+
+: try-eliminate-copies ( pairs must? -- )
+    '[ first2 _ try-eliminate-copy ] each ;
+
+GENERIC: coalesce-insn ( insn -- )
+
+M: insn coalesce-insn drop ;
+
+M: alien-call-insn coalesce-insn drop ;
+
+M: vreg-insn coalesce-insn
+    [ temp-vregs [ leader-map get conjoin ] each ]
+    [
+        [ defs-vregs ] [ uses-vregs ] bi
+        2dup [ empty? not ] both? [
+            [ first ] bi@
+            2dup [ rep-of reg-class-of ] bi@ eq?
+            [ 2array , ] [ 2drop ] if
+        ] [ 2drop ] if
+    ] bi ;
+
+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 ;
+
+: coalesce-cfg ( cfg -- )
+    init-coalescing
+    cfg>insns-rpo [ [ coalesce-insn ] each ] V{ } make
+    f try-eliminate-copies ;

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

@@ -3,35 +3,10 @@ compiler.cfg.ssa.destruction.private compiler.cfg.ssa.destruction.leaders
 compiler.cfg.ssa.interference help.markup help.syntax kernel sequences ;
 IN: compiler.cfg.ssa.destruction
 
-HELP: class-element-map
-{ $var-description "Maps leaders to equivalence class elements which are sequences of " { $link vreg-info } " instances." } ;
-
 HELP: cleanup-cfg
 { $values { "cfg" cfg } }
 { $description "In this step, " { $link ##parallel-copy } " instructions are substituted with more concreete " { $link ##copy } " instructions. " { $link ##phi } " instructions are removed here." } ;
 
-HELP: coalesce-elements
-{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
-{ $description "Delete follower's class, and set leaders's class to merged." } ;
-
-HELP: coalesce-vregs
-{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
-{ $description "Sets 'leader' as the leader of 'follower'." } ;
-
-HELP: copies
-{ $var-description "Sequence of copies (tuples of { vreg-dst vreg-src}) that maybe can be eliminated later." }
-{ $see-also init-coalescing } ;
-
-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." }
-{ $see-also try-eliminate-copies vregs-interfere? } ;
-
-HELP: try-eliminate-copies
-{ $values { "pairs" "a sequence of vreg pairs" } { "must?" boolean } }
-{ $description "Tries to eliminate the vreg copies in the " { $link sequence } " 'pairs'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if any of the vregs interfere." }
-{ $see-also try-eliminate-copy } ;
-
 ARTICLE: "compiler.cfg.ssa.destruction" "SSA Destruction"
 "Because of the design of the register allocator, this pass has three peculiar properties."
 { $list
@@ -41,12 +16,6 @@ ARTICLE: "compiler.cfg.ssa.destruction" "SSA Destruction"
 }
 $nl
 "Main entry point:"
-{ $subsections destruct-ssa }
+{ $subsections destruct-ssa } ;
-"Vreg copy elimination:"
-{ $subsections
-  perform-coalescing
-  try-eliminate-copies
-  try-eliminate-copy
-} ;
 
 ABOUT: "compiler.cfg.ssa.destruction"

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

@@ -1,11 +1,8 @@
-USING: alien.syntax assocs compiler.cfg.def-use
+USING: alien.syntax compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.instructions compiler.cfg.registers
 compiler.cfg.ssa.destruction compiler.cfg.ssa.destruction.leaders
 compiler.cfg.ssa.destruction.private compiler.cfg.utilities
-cpu.architecture cpu.x86.assembler.operands grouping kernel make math
+cpu.architecture cpu.x86.assembler.operands kernel make namespaces
-math.functions math.order math.ranges namespaces random sequences
+sequences tools.test ;
-tools.test ;
-QUALIFIED: sets
 IN: compiler.cfg.ssa.destruction.tests
 
 ! cleanup-insn
@@ -30,15 +27,6 @@ IN: compiler.cfg.ssa.destruction.tests
     [ cleanup-insn ] V{ } make
 ] unit-test
 
-! init-coalescing
-{
-    H{ { 123 123 } { 77 77 } }
-} [
-    H{ { 123 "bb1" } { 77 "bb2" } } defs set
-    init-coalescing
-    leader-map get
-] unit-test
-
 ! destruct-ssa
 { } [
     H{ { 36 23 } { 23 23 } } leader-map set
@@ -65,45 +53,3 @@ IN: compiler.cfg.ssa.destruction.tests
         }
     } 0 insns>block block>cfg destruct-ssa
 ] unit-test
-
-! try-eliminate-copy
-{ } [
-    10 10 f try-eliminate-copy
-] unit-test
-
-! prepare-insn
-{ V{ { 2 1 } } } [
-    V{ } clone copies set
-    T{ ##copy { src 1 } { dst 2 } { rep int-rep } } prepare-insn
-    copies get
-] unit-test
-
-{ V{ { 3 4 } { 7 8 } } } [
-    V{ } clone copies set
-    T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } prepare-insn
-    copies get
-] unit-test
-
-! All this work to make the 'values' order non-deterministic.
-: make-phi-inputs ( -- assoc )
-    H{ } clone [
-        { 2287 2288 } [
-            10 iota 1 sample first rot set-at
-        ] with each
-    ] keep ;
-
-{ t } [
-    10 [
-        { 2286 2287 2288 } sets:unique leader-map set
-        2286 make-phi-inputs ##phi new-insn
-        prepare-insn
-        2286 leader
-    ] replicate all-equal?
-] unit-test
-
-! Test is just to ensure the my-euler word compiles. See #1345
-: my-euler-step ( min m n -- min' )
-    dup sqrt 1 mod [ - min ] [ 2drop ] if ; inline
-
-: my-euler ( -- answer )
-    33 2500 [1,b] [ dup [1,b] [ my-euler-step ] with each ] each ;

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

@@ -1,97 +1,16 @@
 ! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compiler.cfg.def-use
+USING: accessors assocs compiler.cfg.def-use compiler.cfg.dominance
-compiler.cfg.dominance compiler.cfg.instructions
+compiler.cfg.instructions compiler.cfg.liveness
-compiler.cfg.liveness compiler.cfg.parallel-copy
+compiler.cfg.parallel-copy compiler.cfg.rpo compiler.cfg.ssa.cssa
-compiler.cfg.registers compiler.cfg.rpo compiler.cfg.ssa.cssa
+compiler.cfg.ssa.destruction.coalescing compiler.cfg.ssa.destruction.leaders
-compiler.cfg.ssa.destruction.leaders
-compiler.cfg.ssa.interference
 compiler.cfg.ssa.interference.live-ranges compiler.cfg.utilities
-cpu.architecture fry kernel make namespaces sequences sets sorting ;
+kernel make sequences ;
 FROM: namespaces => set ;
 IN: compiler.cfg.ssa.destruction
 
-SYMBOL: class-element-map
-
 <PRIVATE
 
-SYMBOL: copies
-
-: value-of ( vreg -- value )
-    dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
-
-: init-coalescing ( -- )
-    defs get
-    [ keys unique leader-map set ]
-    [
-        [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map
-        class-element-map set
-    ] bi
-    V{ } clone copies set ;
-
-: coalesce-elements ( merged follower leader -- )
-    class-element-map get [ delete-at ] [ set-at ] bi-curry bi* ;
-
-: coalesce-vregs ( merged follower leader -- )
-    2dup swap leader-map get set-at coalesce-elements ;
-
-GENERIC: prepare-insn ( insn -- )
-
-M: insn prepare-insn drop ;
-
-M: alien-call-insn prepare-insn drop ;
-
-M: vreg-insn prepare-insn
-    [ temp-vregs [ leader-map get conjoin ] each ]
-    [
-        [ defs-vregs ] [ uses-vregs ] bi
-        2dup [ empty? not ] both? [
-            [ first ] bi@
-            2dup [ rep-of reg-class-of ] bi@ eq?
-            [ 2array copies get push ] [ 2drop ] if
-        ] [ 2drop ] if
-    ] bi ;
-
-M: ##copy prepare-insn
-    [ dst>> ] [ src>> ] bi 2array copies get push ;
-
-M: ##parallel-copy prepare-insn
-    values>> copies get push-all ;
-
-: leaders ( vreg1 vreg2 -- vreg1' vreg2' )
-    [ leader ] bi@ ;
-
-: vregs-interfere? ( vreg1 vreg2 -- merged/f ? )
-    [ class-element-map get at ] bi@ sets-interfere? ;
-
-ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
-
-: try-eliminate-copy ( follower leader must? -- )
-    -rot leaders 2dup = [ 3drop ] [
-        2dup vregs-interfere? [
-            drop rot [ vregs-shouldn't-interfere ] [ 2drop ] if
-        ] [ -rot coalesce-vregs drop ] if
-    ] if ;
-
-: try-eliminate-copies ( pairs must? -- )
-    '[ first2 _ try-eliminate-copy ] each ;
-
-M: ##tagged>integer prepare-insn
-    [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
-
-: zip-scalar ( scalar seq -- pairs )
-    [ 2array ] with map ;
-
-M: ##phi prepare-insn
-    [ dst>> ] [ inputs>> values ] bi zip-scalar
-    natural-sort t try-eliminate-copies ;
-
-: prepare-coalescing ( cfg -- )
-    init-coalescing [ [ prepare-insn ] each ] simple-analysis ;
-
-: perform-coalescing ( cfg -- )
-    prepare-coalescing copies get f try-eliminate-copies ;
-
 GENERIC: cleanup-insn ( insn -- )
 
 : useful-copy? ( insn -- ? )
@@ -125,7 +44,7 @@ PRIVATE>
         compute-insns
         compute-live-sets
         compute-live-ranges
-        perform-coalescing
+        coalesce-cfg
         cleanup-cfg
         compute-live-sets
     } apply-passes ;

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

@@ -1,4 +1,4 @@
-USING: compiler.cfg.ssa.destruction.private help.markup help.syntax math ;
+USING: compiler.cfg.ssa.destruction.coalescing help.markup help.syntax math ;
 IN: compiler.cfg.ssa.destruction.leaders
 
 HELP: ?leader
@@ -7,7 +7,7 @@ HELP: ?leader
 
 HELP: leader-map
 { $var-description "A map from vregs to canonical representatives due to coalescing done by SSA destruction. Used by liveness analysis and the register allocator, so we can use the original SSA names to get certain info (reaching definitions, representations). By default, each vreg is its own leader." }
-{ $see-also init-coalescing perform-coalescing } ;
+{ $see-also init-coalescing } ;
 
 ARTICLE: "compiler.cfg.ssa.destruction.leaders" "Leader book-keeping" "This vocab defines words for getting the leaders of vregs." ;
 

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

@@ -8,3 +8,6 @@ SYMBOL: leader-map
 : leader ( vreg -- vreg' ) leader-map get compress-path ;
 
 : ?leader ( vreg -- vreg' ) [ leader ] keep or ; inline
+
+: leaders ( vreg1 vreg2 -- vreg1' vreg2' )
+    [ leader ] bi@ ;