Inherit the root thread continuation.

Fixes
<http://lists.gnu.org/archive/html/mit-scheme-devel/2012-04/msg00000.html>:
nested CREATE-THREADs sometimes see an unassigned root continuation.

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 35fcd6edd4f5f5213f8871d8858134339b0cfd0a..9ba3ff8859a582baed62915e4c53ee626c970319 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -137,20 +137,21 @@ USA.
       (error:wrong-type-argument root-continuation
                                 "continuation or #f"
                                 create-thread))
-  (call-with-current-continuation
-   (lambda (return)
-     (%within-continuation (or root-continuation root-continuation-default)
-                          #t
-       (lambda ()
-        (fluid-let ((state-space:local (make-state-space)))
-          (call-with-current-continuation
-           (lambda (continuation)
-             (let ((thread (make-thread continuation)))
-               (%within-continuation (let ((k return)) (set! return #f) k)
-                                     #t
-                                     (lambda () thread)))))
-          (set-interrupt-enables! interrupt-mask/all)
-          (exit-current-thread (thunk))))))))
+  (let ((root-continuation (or root-continuation root-continuation-default)))
+    (call-with-current-continuation
+     (lambda (return)
+       (%within-continuation root-continuation #t
+        (lambda ()
+          (fluid-let ((state-space:local (make-state-space)))
+            (call-with-current-continuation
+              (lambda (continuation)
+                (let ((thread (make-thread continuation)))
+                  (%within-continuation (let ((k return)) (set! return #f) k)
+                                        #t
+                                        (lambda () thread)))))
+            (set-interrupt-enables! interrupt-mask/all)
+            (exit-current-thread
+             (with-create-thread-continuation root-continuation thunk)))))))))
 
 (define (create-thread-continuation)
   root-continuation-default)