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 5706478d4987f3c49bfec415cef302b36173d08b..222a88a8533e5afd1ad3768e2a2d8b1448055e0d 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -138,21 +138,22 @@ USA.
       (error:wrong-type-argument root-continuation
                                 "continuation or #f"
                                 create-thread))
-  (call-with-current-continuation
-   (lambda (return)
-     (%within-continuation (or root-continuation
-                              (fluid 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 (fluid 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)
   (fluid root-continuation-default))