From 9f926ab88cd2388d7e7a3b9c55bac9cd4e628a39 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 16 Jul 2009 02:17:58 -0500
Subject: [PATCH] compiler.cfg.block-joining: join basic blocks connected by a
 single edge to improve effectiveness of local optimizations

---
 .../cfg/block-joining/block-joining.factor    | 44 +++++++++++++++++++
 .../cfg/instructions/instructions.factor      | 22 ++++++++++
 basis/compiler/cfg/optimizer/optimizer.factor |  3 ++
 basis/compiler/cfg/tco/tco.factor             |  3 +-
 basis/compiler/utilities/utilities.factor     |  4 +-
 5 files changed, 73 insertions(+), 3 deletions(-)
 create mode 100644 basis/compiler/cfg/block-joining/block-joining.factor

diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor
new file mode 100644
index 0000000000..39d9a64c41
--- /dev/null
+++ b/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 ;
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 910cb1992b..2f2668df8b 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/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 ;
diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index e16fb734e1..1af0fcbc53 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/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
diff --git a/basis/compiler/cfg/tco/tco.factor b/basis/compiler/cfg/tco/tco.factor
index 5fa2e1b042..8be9c15b04 100644
--- a/basis/compiler/cfg/tco/tco.factor
+++ b/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&& ]
diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor
index ac276b6e41..c21be39adb 100644
--- a/basis/compiler/utilities/utilities.factor
+++ b/basis/compiler/utilities/utilities.factor
@@ -27,4 +27,6 @@ SYMBOL: yield-hook
 yield-hook [ [ ] ] initialize
 
 : alist-max ( alist -- pair )
-    [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
\ No newline at end of file
+    [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
+
+: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;