delim cont repair to avoid chains of meta-cont references

svn: r4713

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;

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);

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);
+        if (seg) {
-        seg[stackpos].key = NULL;
+          stackpos = ((long)pos & SCHEME_MARK_SEGMENT_MASK);
-        seg[stackpos].val = NULL;
+          seg[stackpos].key = NULL;
-        seg[stackpos].cache = NULL;
+          seg[stackpos].val = NULL;
+          seg[stackpos].cache = NULL;
+        }
       }
     }
   }