From b052aa61cbe11ed2dbbe2baef567b2d7218aa86c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 30 Sep 2010 20:48:52 -0700
Subject: [PATCH] compiler.cfg.linear-scan: extend lifetime intervals of base
 pointers correctly (reported by Anton Gorenko)

---
 .../live-intervals/live-intervals.factor        | 17 +++++++++++++++--
 basis/compiler/tests/alien.factor               |  8 +++++++-
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 41545981c2..37707e294e 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -132,17 +132,30 @@ M: vreg-insn compute-live-intervals* ( insn -- )
     [ [ temp-vregs ] dip '[ _ record-temp ] each ]
     2tri ;
 
+! Extend lifetime intervals of base pointers, so that their
+! values are available even if the base pointer is never used
+! again.
+
+GENERIC: uses-vregs* ( insn -- seq )
+
+M: gc-map-insn uses-vregs* ( insn -- )
+    [ uses-vregs ] [ gc-map>> derived-roots>> values ] bi append ;
+
+M: vreg-insn uses-vregs* uses-vregs ;
+
+M: insn uses-vregs* drop f ;
+
 M: clobber-insn compute-live-intervals* ( insn -- )
     dup insn#>>
     [ [ defs-vregs ] dip '[ _ f record-def ] each ]
-    [ [ uses-vregs ] dip '[ _ t record-use ] each ]
+    [ [ uses-vregs* ] dip '[ _ t record-use ] each ]
     [ [ temp-vregs ] dip '[ _ record-temp ] each ]
     2tri ;
 
 M: hairy-clobber-insn compute-live-intervals* ( insn -- )
     dup insn#>>
     [ [ defs-vregs ] dip '[ _ t record-def ] each ]
-    [ [ uses-vregs ] dip '[ _ t record-use ] each ]
+    [ [ uses-vregs* ] dip '[ _ t record-use ] each ]
     [ [ temp-vregs ] dip '[ _ record-temp ] each ]
     2tri ;
 
diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 60e132bb76..2c27118146 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -6,7 +6,7 @@ math memory namespaces namespaces.private parser
 quotations sequences specialized-arrays stack-checker
 stack-checker.errors system threads tools.test words
 alien.complex concurrency.promises alien.data
-byte-arrays classes compiler.test ;
+byte-arrays classes compiler.test libc ;
 FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: char
@@ -823,3 +823,9 @@ TUPLE: some-tuple x ;
         aa-indirect-1 >>x
     ] compile-call
 ] unit-test
+
+! GC maps regression
+: anton's-regression ( -- )
+    f (free) f (free) ;
+
+[ ] [ anton's-regression ] unit-test
-- 
2.34.1