X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=3edfb7d5092f71df77df75dc60197b3718946364;hb=48ec282d877900caf5ea4ab42e9d87e566ce6b43;hp=7ca853f906785d6caa76bdc69c4fa8b5e1068aa6;hpb=495f7dfb9c4ce0ba965f3297a4c94f6c75691b70;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 7ca853f..3edfb7d 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -14,8 +14,7 @@
 ;;; Of the WITH-PINNED-OBJECTS in this file, not every single one is
 ;;; necessary because threads are only supported with the conservative
 ;;; gencgc and numbers on the stack (returned by GET-LISP-OBJ-ADDRESS)
-;;; are treated as references. In fact, I think there isn't one that's
-;;; truly important as of now.
+;;; are treated as references.
 
 ;;; set the doc here because in early-thread FDOCUMENTATION is not
 ;;; available, yet
@@ -118,17 +117,11 @@ in future versions."
 
 ;;;; spinlocks
 
-(defstruct spinlock
-  #!+sb-doc
-  "Spinlock type."
-  (name nil :type (or null simple-string))
-  (value 0))
-
 (declaim (inline get-spinlock release-spinlock))
 
 ;;; The bare 2 here and below are offsets of the slots in the struct.
 ;;; There ought to be some better way to get these numbers
-(defun get-spinlock (spinlock new-value)
+(defun get-spinlock (spinlock)
   (declare (optimize (speed 3) (safety 0))
            #!-sb-thread
            (ignore spinlock new-value))
@@ -136,7 +129,7 @@ in future versions."
   ;; store any value
   #!+sb-thread
   (loop until
-        (eql (sb!vm::%instance-set-conditional spinlock 2 0 new-value) 0)))
+        (eql (sb!vm::%instance-set-conditional spinlock 2 0 1) 0)))
 
 (defun release-spinlock (spinlock)
   (declare (optimize (speed 3) (safety 0))
@@ -151,19 +144,13 @@ in future versions."
 (defmacro with-spinlock ((spinlock) &body body)
   (sb!int:with-unique-names (lock)
     `(let ((,lock ,spinlock))
-      (get-spinlock ,lock *current-thread*)
+      (get-spinlock ,lock)
       (unwind-protect
            (progn ,@body)
         (release-spinlock ,lock)))))
 
 ;;;; mutexes
 
-(defstruct mutex
-  #!+sb-doc
-  "Mutex type."
-  (name nil :type (or null simple-string))
-  (value nil))
-
 #!+sb-doc
 (setf (sb!kernel:fdocumentation 'make-mutex 'function)
       "Create a mutex."
@@ -549,17 +536,16 @@ returns the thread exits."
                         ;; reference to this thread
                         (handle-thread-exit thread)))))))
             (values))))
-    (let ((os-thread
-           ;; don't let the child inherit *CURRENT-THREAD* because that
-           ;; can prevent gc'ing this thread while the child runs
-           (let ((*current-thread* nil))
-             (with-pinned-objects (initial-function)
-               (%create-thread
-                (sb!kernel:get-lisp-obj-address initial-function))))))
-      (when (zerop os-thread)
-        (error "Can't create a new thread"))
-      (wait-on-semaphore setup-sem)
-      thread)))
+    ;; Keep INITIAL-FUNCTION pinned until the child thread is
+    ;; initialized properly.
+    (with-pinned-objects (initial-function)
+      (let ((os-thread
+             (%create-thread
+              (sb!kernel:get-lisp-obj-address initial-function))))
+        (when (zerop os-thread)
+          (error "Can't create a new thread"))
+        (wait-on-semaphore setup-sem)
+        thread))))
 
 (defun destroy-thread (thread)
   #!+sb-doc