From 81ba60fb270070c10c475ac68bb3cc4d308d3cc7 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 30 Oct 2006 12:19:46 +0000
Subject: [PATCH] delim cont repair to avoid chains of meta-cont references

svn: r4713
---
 src/mzscheme/src/fun.c    |  6 ++++++
 src/mzscheme/src/salloc.c | 21 +++++++++++++++++++++
 src/mzscheme/src/thread.c | 10 ++++++----
 3 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c
index b78da3959b..d376e1b6db 100644
--- a/src/mzscheme/src/fun.c
+++ b/src/mzscheme/src/fun.c
@@ -4543,6 +4543,12 @@ internal_call_cc (int argc, Scheme_Object *argv[])
      when calling `cont' composably (i.e., when supplying a resume). */
   cont->prompt_stack_start = stack_start;
 
+  /* Zero out any local variable that shouldn't be saved by the
+     continuation.  The meta-continuation for the prompt is an
+     especially important one to zero out (otherwise we build up
+     chains). */
+  prompt_cont = NULL;
+
   if (scheme_setjmpup_relative(&cont->buf, cont, stack_start, sub_cont)) {
     /* We arrive here when the continuation is applied */
     Scheme_Object *result, *extra_marks;
diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c
index 530f067bd5..a1a91ead4c 100644
--- a/src/mzscheme/src/salloc.c
+++ b/src/mzscheme/src/salloc.c
@@ -1010,6 +1010,27 @@ static void print_tagged_value(const char *prefix,
       sprintf(buffer, "[%d=%s%s%s%s%s%s]",
 	      state, run, sus, kill, clean, all, deq);
 
+      len2 = strlen(buffer);
+      t2 = (char *)scheme_malloc_atomic(len + len2 + 1);
+      memcpy(t2, type, len);
+      memcpy(t2 + len, buffer, len2 + 1);
+      len += len2;
+      type = t2;
+    } else if (!scheme_strncmp(type, "#<continuation", 13)) {
+      char buffer[256];
+      char *t2;
+      int len2;
+	    
+      sprintf(buffer, "[%s%.100s]",
+              (((Scheme_Cont *)v)->composable 
+               ? "delim;"
+               : ""),
+              (((Scheme_Cont *)v)->prompt_tag
+               ? (SCHEME_CDR(((Scheme_Cont *)v)->prompt_tag)
+                  ? SCHEME_SYM_VAL(SCHEME_CDR(((Scheme_Cont *)v)->prompt_tag))
+                  : "<anonymous>")
+               : "NULL"));
+      
       len2 = strlen(buffer);
       t2 = (char *)scheme_malloc_atomic(len + len2 + 1);
       memcpy(t2, type, len);
diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c
index 9304411e32..cd28db1365 100644
--- a/src/mzscheme/src/thread.c
+++ b/src/mzscheme/src/thread.c
@@ -6625,10 +6625,12 @@ static void prepare_thread_for_GC(Scheme_Object *t)
         int stackpos;
         segpos = ((long)pos >> SCHEME_LOG_MARK_SEGMENT_SIZE);
         seg = p->cont_mark_stack_segments[segpos];
-        stackpos = ((long)pos & SCHEME_MARK_SEGMENT_MASK);
-        seg[stackpos].key = NULL;
-        seg[stackpos].val = NULL;
-        seg[stackpos].cache = NULL;
+        if (seg) {
+          stackpos = ((long)pos & SCHEME_MARK_SEGMENT_MASK);
+          seg[stackpos].key = NULL;
+          seg[stackpos].val = NULL;
+          seg[stackpos].cache = NULL;
+        }
       }
     }
   }