Add phi elimination pass

basis/compiler/cfg/cfg.factor

@@ -1,6 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays vectors accessors namespaces ;
+USING: kernel arrays vectors accessors
+namespaces make fry sequences ;
 IN: compiler.cfg
 
 TUPLE: basic-block < identity-tuple
@@ -12,13 +13,20 @@ number
 
 M: basic-block hashcode* nip id>> ;
 
-: <basic-block> ( -- basic-block )
+: <basic-block> ( -- bb )
     basic-block new
         V{ } clone >>instructions
         V{ } clone >>successors
         V{ } clone >>predecessors
         \ basic-block counter >>id ;
 
+: add-instructions ( bb quot -- )
+    [ instructions>> building ] dip '[
+        building get pop
+        _ dip
+        building get push
+    ] with-variable ; inline
+
 TUPLE: cfg { entry basic-block } word label ;
 
 C: <cfg> cfg

basis/compiler/cfg/optimizer/optimizer-tests.factor

@@ -0,0 +1,8 @@
+USING: arrays sequences tools.test compiler.cfg.checker compiler.cfg.debugger
+compiler.cfg.def-use sets kernel ;
+IN: compiler.cfg.optimizer.tests
+
+! Miscellaneous tests
+
+[ ] [ [ 1array ] test-mr first check-mr ] unit-test
+[ ] [ [ 1 2 ? ] test-mr first check-mr ] unit-test

basis/compiler/cfg/optimizer/optimizer.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences accessors combinators
+USING: kernel sequences accessors combinators namespaces
 compiler.cfg.predecessors
 compiler.cfg.useless-blocks
 compiler.cfg.height
@@ -10,10 +10,12 @@ compiler.cfg.value-numbering
 compiler.cfg.dce
 compiler.cfg.write-barrier
 compiler.cfg.liveness
-compiler.cfg.rpo ;
+compiler.cfg.rpo
+compiler.cfg.phi-elimination ;
 IN: compiler.cfg.optimizer
 
 : optimize-cfg ( cfg -- cfg )
+    [
         [
             [ compute-predecessors ]
             [ delete-useless-blocks ]
@@ -21,12 +23,14 @@ IN: compiler.cfg.optimizer
         ] [
             reverse-post-order
             {
-            [ compute-liveness ]
                 [ normalize-height ]
                 [ stack-analysis ]
+                [ compute-liveness ]
                 [ alias-analysis ]
                 [ value-numbering ]
                 [ eliminate-dead-code ]
                 [ eliminate-write-barriers ]
+                [ eliminate-phis ]
             } cleave
-    ] [ ] tri ;
+        ] [ ] tri
+    ] with-scope ;

basis/compiler/cfg/phi-elimination/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/compiler/cfg/phi-elimination/phi-elimination.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors compiler.cfg compiler.cfg.instructions fry
+kernel sequences ;
+IN: compiler.cfg.phi-elimination
+
+: insert-copy ( predecessor input output -- )
+    '[ _ _ swap ##copy ] add-instructions ;
+
+: eliminate-phi ( bb ##phi -- )
+    [ predecessors>> ] [ [ inputs>> ] [ dst>> ] bi ] bi*
+    '[ _ insert-copy ] 2each ;
+
+: eliminate-phi-step ( bb -- )
+    dup [
+        [ ##phi? ] partition
+        [ [ eliminate-phi ] with each ] dip
+    ] change-instructions drop ;
+
+: eliminate-phis ( rpo -- )
+    [ eliminate-phi-step ] each ;

basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor

@@ -100,6 +100,7 @@ IN: compiler.cfg.stack-analysis.tests
 ] unit-test
 
 ! Sync before a back-edge, not after
+! ##peeks should be inserted before a ##loop-entry
 [ 1 ] [
     [ 1000 [ ] times ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
     [ ##add-imm? ] count

basis/compiler/cfg/stack-analysis/stack-analysis.factor

@@ -184,10 +184,6 @@ M: ##dispatch-label visit , ;
 ! Maps basic-blocks to states
 SYMBOLS: state-in state-out ;
 
-: modify-instructions ( predecessor quot -- )
-    [ instructions>> building ] dip
-    '[ building get pop _ dip building get push ] with-variable ; inline
-
 : with-state ( state quot -- )
     [ state ] dip with-variable ; inline
 
@@ -203,22 +199,14 @@ ERROR: must-equal-failed seq ;
 
 : insert-peek ( predecessor loc -- vreg )
     ! XXX critical edges
-    '[ _ ^^peek ] modify-instructions ;
+    '[ _ ^^peek ] add-instructions ;
-
-SYMBOL: phi-nodes
-
-: find-phis ( insns -- assoc )
-    [ ##phi? ] filter [ [ inputs>> ] [ dst>> ] bi ] H{ } map>assoc ;
-
-: insert-phi ( inputs -- vreg )
-    phi-nodes get [ ^^phi ] cache ;
 
 : merge-loc ( predecessors locs>vregs loc -- vreg )
     ! Insert a ##phi in the current block where the input
     ! is the vreg storing loc from each predecessor block
     [ '[ [ _ ] dip at ] map ] keep
     '[ [ ] [ _ insert-peek ] ?if ] 2map
-    dup all-equal? [ first ] [ insert-phi ] if ;
+    dup all-equal? [ first ] [ ^^phi ] if ;
 
 : (merge-locs) ( predecessors assocs -- assoc )
     dup [ keys ] map concat prune
@@ -263,7 +251,7 @@ ERROR: cannot-merge-poisoned states ;
                     cannot-merge-poisoned
                 ] [
                     [ state new ] 2dip
-                    [ [ instructions>> find-phis phi-nodes set ] [ predecessors>> ] bi ] dip
+                    [ predecessors>> ] dip
                     {
                         [ merge-locs ]
                         [ merge-actual-locs ]