From: David Lichteblau <david@lichteblau.com>
Date: Sun, 30 Sep 2012 10:50:04 +0000 (+0200)
Subject: Do not use RETURN-FROM in MAKE-THREAD
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=991c149c68b5e60a3824fa2af09403d49e0af341;p=sbcl.git

Do not use RETURN-FROM in MAKE-THREAD

Fix for lp#1058799, regression in 1.0.56.55-f0da2f6.
---

diff --git a/NEWS b/NEWS
index 9403b96..8c6d71a 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,8 @@ changes relative to sbcl-1.0.58:
     into a DEFCAS defined place was used as the place.
   * bug fix: FIND and POSITION signaled a type-error when non-bits where looked
     for from bit-vectors.
+  * bug fix: a race condition around thread creation could (in SBCL 1.0.57)
+    lead to internal errors or crashes (lp#1058799).
   * documentation: a section on random number generation has been added to the
     manual. (lp#656839)
 
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 74a89e2..5f61722 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -1368,10 +1368,9 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
                        "Argument passed to ~S, ~S, is an improper list."
                        'make-thread arguments)
   #!+sb-thread
-  (tagbody
+  (let ((thread (%make-thread :name name :%ephemeral-p ephemeral)))
      (with-mutex (*make-thread-lock*)
-       (let* ((thread (%make-thread :name name :%ephemeral-p ephemeral))
-              (setup-sem (make-semaphore :name "Thread setup semaphore"))
+       (let* ((setup-sem (make-semaphore :name "Thread setup semaphore"))
               (real-function (coerce function 'function))
               (arguments     (if (listp arguments)
                                  arguments
@@ -1461,15 +1460,11 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
          ;; thread.
          (without-interrupts
            (with-pinned-objects (initial-function)
-             (let ((os-thread
-                     (%create-thread
-                      (get-lisp-obj-address initial-function))))
-               (when (zerop os-thread)
-                 (go :cant-spawn))
-               (wait-on-semaphore setup-sem)
-               (return-from make-thread thread))))))
-   :cant-spawn
-     (error "Could not create a new thread.")))
+             (if (zerop
+                  (%create-thread (get-lisp-obj-address initial-function)))
+                 (setf thread nil)
+                 (wait-on-semaphore setup-sem))))))
+     (or thread (error "Could not create a new thread."))))
 
 (defun join-thread (thread &key (default nil defaultp) timeout)
   #!+sb-doc