From add75411a0ae136037a323a7fd160d8bca39296f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@user-64-9-236-134.googlewifi.com>
Date: Sun, 5 Sep 2010 23:07:30 -0700
Subject: [PATCH] compiler.cfg.write-barrier: handle ##copy instructions

---
 .../cfg/write-barrier/write-barrier.factor    | 22 ++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor
index 5c75eba21c..95562eadca 100644
--- a/basis/compiler/cfg/write-barrier/write-barrier.factor
+++ b/basis/compiler/cfg/write-barrier/write-barrier.factor
@@ -12,19 +12,30 @@ SYMBOL: fresh-allocations
 
 SYMBOL: mutated-objects
 
+SYMBOL: copies
+
+: resolve-copy ( src -- dst )
+    copies get ?at drop ;
+
 GENERIC: eliminate-write-barrier ( insn -- ? )
 
+: fresh-allocation ( vreg -- )
+    fresh-allocations get conjoin ;
+
 M: ##allot eliminate-write-barrier
-    dst>> fresh-allocations get conjoin t ;
+    dst>> fresh-allocation t ;
+
+: mutated-object ( vreg -- )
+    resolve-copy mutated-objects get conjoin ;
 
 M: ##set-slot eliminate-write-barrier
-    obj>> mutated-objects get conjoin t ;
+    obj>> mutated-object t ;
 
 M: ##set-slot-imm eliminate-write-barrier
-    obj>> mutated-objects get conjoin t ;
+    obj>> mutated-object t ;
 
 : needs-write-barrier? ( insn -- ? )
-    {
+    resolve-copy {
         [ fresh-allocations get key? not ]
         [ mutated-objects get key? ]
     } 1&& ;
@@ -39,13 +50,14 @@ M: gc-map-insn eliminate-write-barrier
     fresh-allocations get clear-assoc ;
 
 M: ##copy eliminate-write-barrier
-    "Run copy propagation first" throw ;
+    [ src>> ] [ dst>> ] bi copies get set-at t ;
 
 M: insn eliminate-write-barrier drop t ;
 
 : write-barriers-step ( insns -- insns' )
     H{ } clone fresh-allocations set
     H{ } clone mutated-objects set
+    H{ } clone copies set
     [ eliminate-write-barrier ] filter! ;
 
 : eliminate-write-barriers ( cfg -- cfg )