compiler.cfg.linear-scan: extend lifetime intervals of base pointers correctly (repor...

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 41545981c2786f2356b28d46f39cee646f68fbab..37707e294e5e303524fb988d9e8cf8330f6d608d 100644 (file)
--- 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 60e132bb76531ad0b7d0a96ea695333cb2d77cfb..2c27118146a37a3f45a6ce96afeb0ca5bcbf4a17 100755 (executable)
--- 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