From d9b9cbe16ab9a5a59a9f8f3a3623a15d12936a20 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 29 Oct 2011 09:33:26 -0600
Subject: [PATCH] fix space-safety bug in composable continuations

---
 collects/tests/racket/prompt.rktl | 26 ++++++++++++++++++++++++++
 src/racket/src/fun.c              |  3 +++
 src/racket/src/type.c             |  2 ++
 3 files changed, 31 insertions(+)

diff --git a/collects/tests/racket/prompt.rktl b/collects/tests/racket/prompt.rktl
index ec50b21181..2a8935f687 100644
--- a/collects/tests/racket/prompt.rktl
+++ b/collects/tests/racket/prompt.rktl
@@ -118,6 +118,32 @@
             (eval r)
             (loop))))))))
 
+;; ----------------------------------------
+;; Check that a constant-space loop doesn't
+;; accumulate memory (test by Nicolas Oury)
+
+(let ()
+  (define prompt1 (make-continuation-prompt-tag 'p1))
+  (define prompt2 (make-continuation-prompt-tag 'p2))
+
+  (define (capture-and-abort prompt-tag)
+    (call-with-composable-continuation
+     (lambda (k) (abort-current-continuation prompt-tag k))
+     prompt-tag))
+
+  (define (go i)
+    (call-with-continuation-prompt
+     (lambda ()
+       (call-with-continuation-prompt
+        (lambda()
+          (for ((j i))
+            (capture-and-abort prompt1)
+            (capture-and-abort prompt2)))
+        prompt2))
+     prompt1))
+
+  (test (void) go 100000))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c
index 6eeab8013a..15e3a59fb2 100644
--- a/src/racket/src/fun.c
+++ b/src/racket/src/fun.c
@@ -6256,6 +6256,9 @@ Scheme_Object *scheme_compose_continuation(Scheme_Cont *cont, int num_rands, Sch
     empty_to_next_mc = 0;
   }
 
+  /* Clear to avoid retaining a chain of meta-continuationss: */
+  mc = NULL;
+
   value = compose_continuation(cont, 0, NULL, empty_to_next_mc);
   
   scheme_current_thread->next_meta -= 1;
diff --git a/src/racket/src/type.c b/src/racket/src/type.c
index 67b2052928..33a25541cd 100644
--- a/src/racket/src/type.c
+++ b/src/racket/src/type.c
@@ -395,9 +395,11 @@ char *scheme_get_type_name(Scheme_Type t)
   if (t < 0 || t >= maxtype)
     return "<bad-value>";
   s = type_names[t];
+#ifndef MZ_GC_BACKTRACE
   if (!s)
     return "???";
   else
+#endif
     return s;
 }