From 2d719534cf5f2e00aed2eb8123e596d75fc0f21c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 1 Aug 2009 06:12:43 -0500
Subject: [PATCH] compiler.cfg.stacks: kill set now includes all locations
 eliminated as a result of stack height decrease; reduces number of ##replace
 instructions generated by 2%

---
 .../compiler/cfg/stacks/global/global.factor  |  2 +-
 basis/compiler/cfg/stacks/local/local.factor  | 31 ++++++++++++++-----
 basis/compiler/cfg/stacks/stacks.factor       |  1 +
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor
index 129d7e74cd..2062815787 100644
--- a/basis/compiler/cfg/stacks/global/global.factor
+++ b/basis/compiler/cfg/stacks/global/global.factor
@@ -26,7 +26,7 @@ M: avail-analysis transfer-set drop [ peek-set ] [ replace-set ] bi assoc-union
 ! which are going to be overwritten.
 BACKWARD-ANALYSIS: kill
 
-M: kill-analysis transfer-set drop replace-set assoc-union ;
+M: kill-analysis transfer-set drop kill-set assoc-union ;
 
 ! Main word
 : compute-global-sets ( cfg -- cfg' )
diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
index 754789042a..4d3ed36be9 100644
--- a/basis/compiler/cfg/stacks/local/local.factor
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math namespaces sets make sequences
+USING: accessors assocs kernel math math.order namespaces sets make
+sequences combinators fry
 compiler.cfg
 compiler.cfg.hats
 compiler.cfg.instructions
@@ -12,14 +13,18 @@ IN: compiler.cfg.stacks.local
 ! Local stack analysis. We build local peek and replace sets for every basic
 ! block while constructing the CFG.
 
-SYMBOLS: peek-sets replace-sets ;
+SYMBOLS: peek-sets replace-sets kill-sets ;
 
 SYMBOL: locs>vregs
 
 : loc>vreg ( loc -- vreg ) locs>vregs get [ drop i ] cache ;
 : vreg>loc ( vreg -- loc/f ) locs>vregs get value-at ;
 
-TUPLE: current-height { d initial: 0 } { r initial: 0 } { emit-d initial: 0 } { emit-r initial: 0 } ;
+TUPLE: current-height
+{ d initial: 0 }
+{ r initial: 0 }
+{ emit-d initial: 0 }
+{ emit-r initial: 0 } ;
 
 SYMBOLS: local-peek-set local-replace-set replace-mapping ;
 
@@ -72,20 +77,32 @@ M: rs-loc translate-local-loc n>> current-height get r>> - <rs-loc> ;
         bi
     ] if ;
 
+: compute-local-kill-set ( -- assoc )
+    basic-block get current-height get
+    [ [ ds-heights get at dup ] [ d>> ] bi* [-] iota [ swap - <ds-loc> ] with map ]
+    [ [ rs-heights get at dup ] [ r>> ] bi* [-] iota [ swap - <rs-loc> ] with map ]
+    [ drop local-replace-set get at ] 2tri
+    [ append unique dup ] dip update ;
+
 : begin-local-analysis ( -- )
     H{ } clone local-peek-set set
     H{ } clone local-replace-set set
     H{ } clone replace-mapping set
-    current-height get 0 >>emit-d 0 >>emit-r drop
-    current-height get [ d>> ] [ r>> ] bi basic-block get record-stack-heights ;
+    current-height get
+    [ 0 >>emit-d 0 >>emit-r drop ]
+    [ [ d>> ] [ r>> ] bi basic-block get record-stack-heights ] bi ;
 
 : end-local-analysis ( -- )
     emit-changes
-    local-peek-set get basic-block get peek-sets get set-at
-    local-replace-set get basic-block get replace-sets get set-at ;
+    basic-block get {
+        [ [ local-peek-set get ] dip peek-sets get set-at ]
+        [ [ local-replace-set get ] dip replace-sets get set-at ]
+        [ [ compute-local-kill-set ] dip kill-sets get set-at ]
+    } cleave ;
 
 : clone-current-height ( -- )
     current-height [ clone ] change ;
 
 : peek-set ( bb -- assoc ) peek-sets get at ;
 : replace-set ( bb -- assoc ) replace-sets get at ;
+: kill-set ( bb -- assoc ) kill-sets get at ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/stacks/stacks.factor b/basis/compiler/cfg/stacks/stacks.factor
index 2683222fb8..1896b0a7fb 100755
--- a/basis/compiler/cfg/stacks/stacks.factor
+++ b/basis/compiler/cfg/stacks/stacks.factor
@@ -13,6 +13,7 @@ IN: compiler.cfg.stacks
     H{ } clone rs-heights set
     H{ } clone peek-sets set
     H{ } clone replace-sets set
+    H{ } clone kill-sets set
     current-height new current-height set ;
 
 : end-stack-analysis ( -- )