From 20ec57496522080dd55f8be22594f2d412e00b14 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 1 Aug 2009 20:22:31 -0500
Subject: [PATCH] compiler.cfg.ssa.destruction: fix bug in trivial-interference
 heuristic, and type error in code path that didn't run before

---
 .../process-blocks/process-blocks.factor      | 28 +++++++++----------
 basis/compiler/tests/codegen.factor           | 10 ++++++-
 2 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
index f3f4dfd2cc..8eff20a11e 100644
--- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
+++ b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
@@ -18,29 +18,29 @@ IN: compiler.cfg.ssa.destruction.process-blocks
 ! the source vregs above
 SYMBOLS: phi-union unioned-blocks ;
 
-:: operand-live-into-phi-node's-block? ( bb src dst -- ? )
-    src bb live-in? ;
+: operand-live-into-phi-node's-block? ( src dst -- ? )
+    def-of live-in? ;
 
-:: phi-node-is-live-out-of-operand's-block? ( bb src dst -- ? )
-    dst src def-of live-out? ;
+: phi-node-is-live-out-of-operand's-block? ( src dst -- ? )
+    swap def-of live-out? ;
 
-:: operand-is-phi-node-and-live-into-operand's-block? ( bb src dst -- ? )
-    { [ src insn-of ##phi? ] [ src src def-of live-in? ] } 0&& ;
+: operand-is-phi-node-and-live-into-operand's-block? ( src dst -- ? )
+    drop { [ insn-of ##phi? ] [ dup def-of live-in? ] } 1&& ;
 
-:: operand-being-renamed? ( bb src dst -- ? )
-    src processed-names get key? ;
+: operand-being-renamed? ( src dst -- ? )
+    drop processed-names get key? ;
 
-:: two-operands-in-same-block? ( bb src dst -- ? )
-    src def-of unioned-blocks get key? ;
+: two-operands-in-same-block? ( src dst -- ? )
+    drop def-of unioned-blocks get key? ;
 
-: trivial-interference? ( bb src dst -- ? )
+: trivial-interference? ( src dst -- ? )
     {
         [ operand-live-into-phi-node's-block? ]
         [ phi-node-is-live-out-of-operand's-block? ]
         [ operand-is-phi-node-and-live-into-operand's-block? ]
         [ operand-being-renamed? ]
         [ two-operands-in-same-block? ]
-    } 3|| ;
+    } 2|| ;
 
 : don't-coalesce ( bb src dst -- )
     2nip processed-name ;
@@ -56,7 +56,7 @@ SYMBOLS: phi-union unioned-blocks ;
 : process-phi-operand ( bb src dst -- )
     {
         { [ 2dup eq? ] [ don't-coalesce ] }
-        { [ 3dup trivial-interference? ] [ trivial-interference ] }
+        { [ 2dup trivial-interference? ] [ trivial-interference ] }
         [ add-to-renaming-set ]
     } cond ;
 
@@ -70,7 +70,7 @@ SYMBOLS: phi-union unioned-blocks ;
     bb src dst trivial-interference
     src phi-union get delete-at ;
 
-:: insert-copy-for-parent ( bb src node dst -- )
+:: insert-copy-for-parent ( bb src dst node -- )
     src node vreg>> eq? [ bb src dst insert-copy ] when ;
 
 : insert-copies-for-parent ( ##phi node child -- )
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 698aefd7c6..f8f8788125 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -358,4 +358,12 @@ cell 4 = [
 [ 0 3 f { 1 2 3 } ] [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test
 [ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 0 7 "hello" coalescing-bug-1 ] unit-test
 [ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 3 2 "hello" coalescing-bug-1 ] unit-test
-[ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
\ No newline at end of file
+[ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
+
+! Another one, found by Dan
+: coalescing-bug-2 ( a -- b )
+    dup dup 10 fixnum< [ 1 fixnum+fast ] when
+    fixnum+fast 2 fixnum*fast 2 fixnum-fast 2 fixnum*fast 2 fixnum+fast ;
+
+[ 10 ] [ 1 coalescing-bug-2 ] unit-test
+[ 86 ] [ 11 coalescing-bug-2 ] unit-test
\ No newline at end of file