From aeaed40d9c8bb4d3f611a01b99b30ff48956dbd0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 15 Jun 2015 10:44:53 +0200
Subject: [PATCH] compiler.cfg.ssa.destruction.coalescing: new vocab to
 refactor and simplify the prepare-insn code in compiler.cfg.ssa.destruction

---
 .../cfg/linearization/linearization.factor    |  8 +-
 .../coalescing/coalescing-docs.factor         | 39 ++++++++
 .../coalescing/coalescing-tests.factor        | 49 ++++++++++
 .../destruction/coalescing/coalescing.factor  | 79 ++++++++++++++++
 .../ssa/destruction/destruction-docs.factor   | 33 +------
 .../ssa/destruction/destruction-tests.factor  | 60 +-----------
 .../cfg/ssa/destruction/destruction.factor    | 93 ++-----------------
 .../destruction/leaders/leaders-docs.factor   |  4 +-
 .../ssa/destruction/leaders/leaders.factor    |  3 +
 9 files changed, 189 insertions(+), 179 deletions(-)
 create mode 100644 basis/compiler/cfg/ssa/destruction/coalescing/coalescing-docs.factor
 create mode 100644 basis/compiler/cfg/ssa/destruction/coalescing/coalescing-tests.factor
 create mode 100644 basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 998bcdfd09..c20be464f1 100644
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/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 ;
diff --git a/basis/compiler/cfg/ssa/destruction/coalescing/coalescing-docs.factor b/basis/compiler/cfg/ssa/destruction/coalescing/coalescing-docs.factor
new file mode 100644
index 0000000000..a392c0dbfc
--- /dev/null
+++ b/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
+} ;
diff --git a/basis/compiler/cfg/ssa/destruction/coalescing/coalescing-tests.factor b/basis/compiler/cfg/ssa/destruction/coalescing/coalescing-tests.factor
new file mode 100644
index 0000000000..4eecdb0061
--- /dev/null
+++ b/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
diff --git a/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor b/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor
new file mode 100644
index 0000000000..80e066beab
--- /dev/null
+++ b/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 ;
diff --git a/basis/compiler/cfg/ssa/destruction/destruction-docs.factor b/basis/compiler/cfg/ssa/destruction/destruction-docs.factor
index 2fea4ed3ca..b76cc9c139 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction-docs.factor
+++ b/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 }
-"Vreg copy elimination:"
-{ $subsections
-  perform-coalescing
-  try-eliminate-copies
-  try-eliminate-copy
-} ;
+{ $subsections destruct-ssa } ;
 
 ABOUT: "compiler.cfg.ssa.destruction"
diff --git a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
index 661d567d41..2549134884 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
@@ -1,11 +1,8 @@
-USING: alien.syntax assocs compiler.cfg.def-use
-compiler.cfg.instructions compiler.cfg.registers
+USING: alien.syntax 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
-math.functions math.order math.ranges namespaces random sequences
-tools.test ;
-QUALIFIED: sets
+cpu.architecture cpu.x86.assembler.operands kernel make namespaces
+sequences tools.test ;
 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 ;
diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index 8a0d41a9b2..b4d325e49a 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/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
-compiler.cfg.dominance compiler.cfg.instructions
-compiler.cfg.liveness compiler.cfg.parallel-copy
-compiler.cfg.registers compiler.cfg.rpo compiler.cfg.ssa.cssa
-compiler.cfg.ssa.destruction.leaders
-compiler.cfg.ssa.interference
+USING: accessors assocs compiler.cfg.def-use compiler.cfg.dominance
+compiler.cfg.instructions compiler.cfg.liveness
+compiler.cfg.parallel-copy compiler.cfg.rpo compiler.cfg.ssa.cssa
+compiler.cfg.ssa.destruction.coalescing compiler.cfg.ssa.destruction.leaders
 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 ;
diff --git a/basis/compiler/cfg/ssa/destruction/leaders/leaders-docs.factor b/basis/compiler/cfg/ssa/destruction/leaders/leaders-docs.factor
index 4cc85b3da6..a8f6bc2ddc 100644
--- a/basis/compiler/cfg/ssa/destruction/leaders/leaders-docs.factor
+++ b/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." ;
 
diff --git a/basis/compiler/cfg/ssa/destruction/leaders/leaders.factor b/basis/compiler/cfg/ssa/destruction/leaders/leaders.factor
index bc2344de49..291aadd571 100644
--- a/basis/compiler/cfg/ssa/destruction/leaders/leaders.factor
+++ b/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@ ;