From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 6 Nov 2014 01:39:15 +0000 (+0000)
Subject: Inherit the root thread continuation.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~128
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1dd4dd079b5477069582a7596d34a56d2cdd75be;p=mit-scheme.git

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 5706478d4..222a88a85 100644
--- 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))