Merge branch 'master' of git://factorcode.org/git/factor

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
+arrays compiler.cfg.phi-elimination compiler.cfg.dce
-compiler.cfg.predecessors kernel accessors
+compiler.cfg.predecessors kernel accessors assocs
 sequences classes namespaces tools.test cpu.architecture ;
 
 V{ T{ ##branch } } 0 test-bb
@@ -42,3 +42,44 @@ test-diamond
 
 [ T{ ##copy f V int-regs 3 V int-regs 2 } ] [ 3 get instructions>> second ] unit-test
 [ 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

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.rpo compiler.cfg.instructions
-compiler.cfg.liveness 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

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 ]
+        [ [ update-predecessors ] each-basic-block ]
+        [ [ update-phis ] each-basic-block ]
         [ ]
-    tri ;
+    } cleave ;

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 -- ? )
+: >compare-imm ( insn swap? -- insn' )
-    dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
+    [
-
+        {
-: flip-comparison ( insn -- insn' )
             [ dst>> ]
+            [ src1>> ]
             [ src2>> ]
-    [ src1>> vreg>constant ] tri
+            [ cc>> ]
-    cc= i \ ##compare-imm new-insn ;
+        } cleave
+    ] dip [ [ swap ] [ ] bi* ] when
+    [ vreg>constant ] dip
+    i \ ##compare-imm new-insn ; inline
 
 M: ##compare rewrite
-    dup flip-comparison? [
+    dup [ src1>> ] [ src2>> ] bi
-        flip-comparison
+    [ vreg>expr constant-expr? ] bi@ 2array {
-        dup number-values
+        { { f t } [ f >compare-imm ] }
-        rewrite
+        { { t f } [ t >compare-imm ] }
-    ] when ;
+        [ drop ]
+    } case ;
 
 : rewrite-redundant-comparison? ( insn -- ? )
     {