From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Sun, 24 Jan 2016 22:57:50 +0000 (-0800)
Subject: Eagerly transport list CDRs to linearize lists.
X-Git-Tag: mit-scheme-pucked-9.2.12~371^2~10
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ec471d089c144115a6a17c897949b5b65e61097f;p=mit-scheme.git

Eagerly transport list CDRs to linearize lists.
---

diff --git a/src/microcode/gcloop.c b/src/microcode/gcloop.c
index 9c2a2190c..d7153a725 100644
--- a/src/microcode/gcloop.c
+++ b/src/microcode/gcloop.c
@@ -442,13 +442,23 @@ DEFINE_GC_TUPLE_HANDLER (gc_tuple)
 {
   SCHEME_OBJECT * from = (OBJECT_ADDRESS (tuple));
   SCHEME_OBJECT * new_address = (GC_PRECHECK_FROM (from));
+  if (new_address == 0) {
+    new_address = GC_TRANSPORT_WORDS (from, n_words, false);
+    /* A little hack to localize lists.  Transport CDRs eagerly. */
+    if (n_words == 2) {
+      SCHEME_OBJECT cdr = READ_TOSPACE(new_address + CONS_CDR);
+      while (OBJECT_TYPE(cdr) == TC_LIST &&
+             (GC_PRECHECK_FROM(OBJECT_ADDRESS(cdr)) == 0)) {
+        cdr = READ_TOSPACE(GC_TRANSPORT_WORDS(OBJECT_ADDRESS(cdr), 2, false) +
+                           CONS_CDR);
+      }
+    }
+  }
   return
-    (OBJECT_NEW_ADDRESS (tuple,
-			 ((new_address != 0)
-			  ? new_address
-			  : (GC_TRANSPORT_WORDS (from, n_words, false)))));
+      (OBJECT_NEW_ADDRESS(tuple, new_address));
 }
 
+
 DEFINE_GC_VECTOR_HANDLER (gc_vector)
 {
   SCHEME_OBJECT * from = (OBJECT_ADDRESS (vector));