compiler.cfg.block-joining: join basic blocks connected by a single edge to improve effectiveness of local optimizations

basis/compiler/cfg/block-joining/block-joining.factor

@@ -0,0 +1,44 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit kernel sequences math
+compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
+compiler.cfg.utilities ;
+IN: compiler.cfg.block-joining
+
+! Joining blocks that are not calls and are connected by a single CFG edge.
+! Predecessors must be recomputed after this. Also this pass does not
+! update ##phi nodes and should therefore only run before stack analysis.
+
+: kill-vreg-block? ( bb -- ? )
+    instructions>> {
+        [ length 2 >= ]
+        [ penultimate kill-vreg-insn? ]
+    } 1&& ;
+
+: predecessor ( bb -- pred )
+    predecessors>> first ; inline
+
+: join-block? ( bb -- ? )
+    {
+        [ kill-vreg-block? not ]
+        [ predecessors>> length 1 = ]
+        [ predecessor kill-vreg-block? not ]
+        [ predecessor successors>> length 1 = ]
+        [ [ predecessor ] keep back-edge? not ]
+    } 1&& ;
+
+: join-instructions ( bb pred -- )
+    [ instructions>> ] bi@ dup pop* push-all ;
+
+: update-successors ( bb pred -- )
+    [ successors>> ] dip (>>successors) ;
+
+: join-block ( bb pred -- )
+    [ join-instructions ] [ update-successors ] 2bi ;
+
+: join-blocks ( cfg -- cfg' )
+    dup post-order [
+        dup join-block?
+        [ dup predecessor join-block ] [ drop ] if
+    ] each
+    cfg-changed ;

basis/compiler/cfg/instructions/instructions.factor

@@ -223,3 +223,25 @@ INSN: _reload dst class n ;
 INSN: _copy dst src class ;
 INSN: _spill-counts counts ;
 
+! Instructions that poison the stack state
+UNION: poison-insn
+    ##jump
+    ##return
+    ##callback-return
+    ##fixnum-mul-tail
+    ##fixnum-add-tail
+    ##fixnum-sub-tail ;
+
+! Instructions that kill all live vregs
+UNION: kill-vreg-insn
+    poison-insn
+    ##stack-frame
+    ##call
+    ##prologue
+    ##epilogue
+    ##fixnum-mul
+    ##fixnum-add
+    ##fixnum-sub
+    ##alien-invoke
+    ##alien-indirect
+    ##alien-callback ;

basis/compiler/cfg/optimizer/optimizer.factor

@@ -6,6 +6,7 @@ compiler.cfg.predecessors
 compiler.cfg.useless-conditionals
 compiler.cfg.stack-analysis
 compiler.cfg.branch-splitting
+compiler.cfg.block-joining
 compiler.cfg.alias-analysis
 compiler.cfg.value-numbering
 compiler.cfg.dce
@@ -31,6 +32,8 @@ SYMBOL: check-optimizer?
         delete-useless-conditionals
         compute-predecessors
         split-branches
+        join-blocks
+        compute-predecessors
         stack-analysis
         compute-liveness
         alias-analysis

basis/compiler/cfg/tco/tco.factor

@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators.short-circuit kernel math
 namespaces sequences fry combinators
+compiler.utilities
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.hats
@@ -19,8 +20,6 @@ IN: compiler.cfg.tco
         [ second ##return? ]
     } 1&& ;
 
-: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
-
 : tail-call? ( bb -- ? )
     {
         [ instructions>> { [ length 2 >= ] [ last ##branch? ] } 1&& ]

basis/compiler/utilities/utilities.factor

@@ -27,4 +27,6 @@ SYMBOL: yield-hook
 yield-hook [ [ ] ] initialize
 
 : alist-max ( alist -- pair )
-    [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
+    [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
+
+: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;