compiler.cfg.critical-edges: update ##phi nodes

basis/compiler/cfg/critical-edges/critical-edges-tests.factor

@@ -0,0 +1,37 @@
+USING: accessors assocs compiler.cfg
+compiler.cfg.critical-edges compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.predecessors
+compiler.cfg.registers cpu.architecture kernel namespaces
+sequences tools.test compiler.cfg.utilities ;
+IN: compiler.cfg.critical-edges.tests
+
+! Make sure we update phi nodes when splitting critical edges
+
+: test-critical-edges ( -- )
+    cfg new 0 get >>entry
+    compute-predecessors
+    split-critical-edges ;
+
+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{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##phi f V int-regs 2 H{ { 0 V int-regs 0 } { 1 V int-regs 1 } } }
+    T{ ##return }
+} 2 test-bb
+
+0 { 1 2 } edges
+1 2 edge
+
+[ ] [ test-critical-edges ] unit-test
+
+[ t ] [ 0 get successors>> second successors>> first 2 get eq? ] unit-test
+
+[ V int-regs 0 ] [ 2 get instructions>> first inputs>> 0 get successors>> second swap at ] unit-test

basis/compiler/cfg/critical-edges/critical-edges.factor

@@ -1,14 +1,22 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math accessors sequences
+USING: kernel math accessors sequences locals assocs fry
 compiler.cfg compiler.cfg.rpo compiler.cfg.utilities ;
 IN: compiler.cfg.critical-edges
 
 : critical-edge? ( from to -- ? )
     [ successors>> length 1 > ] [ predecessors>> length 1 > ] bi* and ;
 
+: new-key ( new-key old-key assoc -- )
+    [ delete-at* ] keep '[ swap _ set-at ] [ 2drop ] if ;
+
+:: update-phis ( from to bb -- )
+    ! Any phi nodes in 'to' which reference 'from'
+    ! should now reference 'bb'.
+    to [ [ bb from ] dip inputs>> new-key ] each-phi ;
+
 : split-critical-edge ( from to -- )
-    f <simple-block> insert-basic-block ;
+    f <simple-block> [ insert-basic-block ] [ update-phis ] 3bi ; 
 
 : split-critical-edges ( cfg -- )
     dup [