From 24dc0679dc045df3d8b0c82f903b22f631d4a193 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sat, 9 May 2015 23:02:30 +0200
Subject: [PATCH] compiler.cfg.ssa.destruction: fix and testcase for the
 "lookup-base-pointer* does not define a method for the POSTPONE: f class" bug

---
 .../ssa/destruction/destruction-tests.factor  | 45 +++++++++++++++++--
 .../cfg/ssa/destruction/destruction.factor    |  4 +-
 2 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
index e225709e0c..236eaa5989 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
@@ -1,7 +1,8 @@
-USING: compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.ssa.destruction compiler.cfg.ssa.destruction.leaders
-compiler.cfg.ssa.destruction.private cpu.architecture kernel make namespaces
-tools.test ;
+USING: alien.syntax compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.registers compiler.cfg.ssa.destruction
+compiler.cfg.ssa.destruction.leaders
+compiler.cfg.ssa.destruction.private compiler.cfg.utilities
+cpu.architecture cpu.x86.assembler.operands make namespaces tools.test ;
 IN: compiler.cfg.ssa.destruction.tests
 
 ! cleanup-insn
@@ -25,3 +26,39 @@ IN: compiler.cfg.ssa.destruction.tests
     T{ ##parallel-copy { values V{ } } }
     [ cleanup-insn ] V{ } make
 ] unit-test
+
+! init-coalescing
+{
+    H{ { 123 123 } { 77 77 } }
+} [
+    H{ { 123 "bb1" } { 77 "bb2" } } defs set
+    init-coalescing
+    leader-map get
+] unit-test
+
+! destruct-ssa
+{ } [
+    H{ { 36 23 } { 23 23 } } leader-map set
+    H{ { 36 int-rep } { 37 tagged-rep } } representations set
+    V{
+        T{ ##alien-invoke
+           { reg-inputs V{ { 56 int-rep RDI } } }
+           { stack-inputs V{ } }
+           { reg-outputs { { 36 int-rep RAX } } }
+           { dead-outputs { } }
+           { cleanup 0 }
+           { stack-size 0 }
+           { symbols "g_quark_to_string" }
+           { dll DLL" libglib-2.0.so" }
+           { gc-map T{ gc-map { scrub-d { } } { scrub-r { } } } }
+           { insn# 14 }
+        }
+        T{ ##call-gc { gc-map T{ gc-map { scrub-d { } } { scrub-r { } } } } }
+        T{ ##box-alien
+           { dst 37 }
+           { src 36 }
+           { temp 11 }
+           { insn# 18 }
+        }
+    } 0 insns>block block>cfg destruct-ssa
+] unit-test
diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index f876c5f38e..5d421a133d 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -11,7 +11,6 @@ cpu.architecture kernel locals make namespaces sequences sets ;
 FROM: namespaces => set ;
 IN: compiler.cfg.ssa.destruction
 
-! Maps leaders to equivalence class elements.
 SYMBOL: class-element-map
 
 : class-elements ( vreg -- elts ) class-element-map get at ;
@@ -26,7 +25,7 @@ SYMBOL: copies
 
 : init-coalescing ( -- )
     defs get
-    [ [ drop dup ] assoc-map leader-map set ]
+    [ keys unique leader-map set ]
     [
         [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map
         class-element-map set
@@ -132,6 +131,7 @@ M: insn cleanup-insn , ;
 PRIVATE>
 
 : destruct-ssa ( cfg -- )
+    H{ } clone leader-map set
     {
         needs-dominance
         construct-cssa