From 2c3b2a0b714363c36a467295b2f257cfc391d301 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Fri, 3 Jul 2009 18:45:03 -0500
Subject: [PATCH 1/2] compiler.cfg.predecessors: delete dead predecessors from
 phi nodes

---
 .../branch-folding-tests.factor               | 47 +++++++++++++++++--
 basis/compiler/cfg/gc-checks/gc-checks.factor |  6 +--
 .../cfg/predecessors/predecessors.factor      | 26 +++++++---
 3 files changed, 65 insertions(+), 14 deletions(-)

diff --git a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor b/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
index 1068954f9d..964620d2d3 100644
--- a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
+++ b/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
@@ -1,8 +1,8 @@
 IN: compiler.cfg.branch-folding.tests
 USING: compiler.cfg.branch-folding compiler.cfg.instructions
 compiler.cfg compiler.cfg.registers compiler.cfg.debugger
-arrays compiler.cfg.phi-elimination
-compiler.cfg.predecessors kernel accessors
+arrays compiler.cfg.phi-elimination compiler.cfg.dce
+compiler.cfg.predecessors kernel accessors assocs
 sequences classes namespaces tools.test cpu.architecture ;
 
 V{ T{ ##branch } } 0 test-bb
@@ -41,4 +41,45 @@ test-diamond
 [ t ] [ 1 get successors>> first 3 get eq? ] unit-test
 
 [ T{ ##copy f V int-regs 3 V int-regs 2 } ] [ 3 get instructions>> second ] unit-test
-[ 2 ] [ 4 get instructions>> length ] unit-test
\ No newline at end of file
+[ 2 ] [ 4 get instructions>> length ] unit-test
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##compare-branch f V int-regs 1 V int-regs 1 cc< }
+} 1 test-bb
+
+V{
+    T{ ##copy f V int-regs 2 V int-regs 0 }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##phi f V int-regs 3 V{ } }
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##return }
+} 4 test-bb
+
+1 get V int-regs 1 2array
+2 get V int-regs 0 2array 2array 3 get instructions>> first (>>inputs)
+
+test-diamond
+
+[ ] [
+    cfg new 0 get >>entry
+    compute-predecessors
+    fold-branches
+    compute-predecessors
+    eliminate-dead-code
+    drop
+] unit-test
+
+[ 1 ] [ 3 get instructions>> first inputs>> assoc-size ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 4176914126..090283410f 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -1,17 +1,13 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences assocs
-cpu.architecture compiler.cfg.rpo
-compiler.cfg.liveness compiler.cfg.instructions
+compiler.cfg.rpo compiler.cfg.instructions
 compiler.cfg.hats ;
 IN: compiler.cfg.gc-checks
 
 : gc? ( bb -- ? )
     instructions>> [ ##allocation? ] any? ;
 
-: object-pointer-regs ( basic-block -- vregs )
-    live-in keys [ reg-class>> int-regs eq? ] filter ;
-
 : insert-gc-check ( basic-block -- )
     dup gc? [
         [ i i f f \ ##gc new-insn prefix ] change-instructions drop
diff --git a/basis/compiler/cfg/predecessors/predecessors.factor b/basis/compiler/cfg/predecessors/predecessors.factor
index 54efc53bc4..73ae3ee242 100644
--- a/basis/compiler/cfg/predecessors/predecessors.factor
+++ b/basis/compiler/cfg/predecessors/predecessors.factor
@@ -1,13 +1,27 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences compiler.cfg.rpo ;
+USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
+compiler.cfg.instructions ;
 IN: compiler.cfg.predecessors
 
-: predecessors-step ( bb -- )
+: update-predecessors ( bb -- )
     dup successors>> [ predecessors>> push ] with each ;
 
+: update-phi ( bb ##phi -- )
+    [
+        swap predecessors>>
+        '[ drop _ memq? ] assoc-filter
+    ] change-inputs drop ;
+
+: update-phis ( bb -- )
+    dup instructions>> [
+        dup ##phi? [ update-phi ] [ 2drop ] if
+    ] with each ;
+
 : compute-predecessors ( cfg -- cfg' )
-    [ [ V{ } clone >>predecessors drop ] each-basic-block ]
-    [ [ predecessors-step ] each-basic-block ]
-    [ ]
-    tri ;
+    {
+        [ [ V{ } clone >>predecessors drop ] each-basic-block ]
+        [ [ update-predecessors ] each-basic-block ]
+        [ [ update-phis ] each-basic-block ]
+        [ ]
+    } cleave ;

From cae8fed16cba346e94fcafe4c5486c556642b30d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 3 Jul 2009 19:19:33 -0500
Subject: [PATCH 2/2] convert ##compare with immediates to ##compare-imm

---
 .../value-numbering/rewrite/rewrite.factor    | 30 +++++++++++--------
 1 file changed, 17 insertions(+), 13 deletions(-)

diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index bbfeb3f8bf..9fb6e66e9f 100755
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -70,21 +70,25 @@ M: ##compare-imm-branch rewrite
         dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
     ] when ;
 
-: flip-comparison? ( insn -- ? )
-    dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
-
-: flip-comparison ( insn -- insn' )
-    [ dst>> ]
-    [ src2>> ]
-    [ src1>> vreg>constant ] tri
-    cc= i \ ##compare-imm new-insn ;
+: >compare-imm ( insn swap? -- insn' )
+    [
+        {
+            [ dst>> ]
+            [ src1>> ]
+            [ src2>> ]
+            [ cc>> ]
+        } cleave
+    ] dip [ [ swap ] [ ] bi* ] when
+    [ vreg>constant ] dip
+    i \ ##compare-imm new-insn ; inline
 
 M: ##compare rewrite
-    dup flip-comparison? [
-        flip-comparison
-        dup number-values
-        rewrite
-    ] when ;
+    dup [ src1>> ] [ src2>> ] bi
+    [ vreg>expr constant-expr? ] bi@ 2array {
+        { { f t } [ f >compare-imm ] }
+        { { t f } [ t >compare-imm ] }
+        [ drop ]
+    } case ;
 
 : rewrite-redundant-comparison? ( insn -- ? )
     {