0.8.1.48

[sbcl.git] / src / code / target-thread.lisp

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index fd13e62..c7d40d9 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -83,31 +83,32 @@
 (sb!alien:define-alien-routine "block_sigcont"  void)
 (sb!alien:define-alien-routine "unblock_sigcont_and_sleep"  void)
 
+;;; this should only be called while holding the queue spinlock.
+;;; it releases the spinlock before sleeping
 (defun wait-on-queue (queue &optional lock)
   (let ((pid (current-thread-id)))
     ;; FIXME what should happen if we get interrupted when we've blocked
     ;; the sigcont?  For that matter, can we get interrupted?
     (block-sigcont)
     (when lock (release-mutex lock))
-    (get-spinlock queue 2 pid)
-    (pushnew pid (waitqueue-data queue))
+    (sb!sys:without-interrupts
+     (pushnew pid (waitqueue-data queue)))
     (setf (waitqueue-lock queue) 0)
     (unblock-sigcont-and-sleep)))
 
+;;; this should only be called while holding the queue spinlock.  It doesn't
+;;; release it
 (defun dequeue (queue)
   (let ((pid (current-thread-id)))
-    (get-spinlock queue 2 pid)
-    (setf (waitqueue-data queue)
-         (delete pid (waitqueue-data queue)))
-    (setf (waitqueue-lock queue) 0)))
+    (sb!sys:without-interrupts     
+     (setf (waitqueue-data queue)
+          (delete pid (waitqueue-data queue))))))
 
+;;; this should probably only be called while holding the queue spinlock.
+;;; not sure
 (defun signal-queue-head (queue)
-  (let ((pid (current-thread-id)))
-    (get-spinlock queue 2 pid)
-    (let ((h (car (waitqueue-data queue))))
-      (setf (waitqueue-lock queue) 0)
-      (when h
-       (sb!unix:unix-kill h :sigcont)))))
+  (let ((p (car (waitqueue-data queue))))
+    (when p (sb!unix:unix-kill p  :sigcont))))
 
 ;;;; mutex
 
@@ -116,28 +117,26 @@
   (let ((pid (current-thread-id)))
     (unless new-value (setf new-value pid))
     (assert (not (eql new-value (mutex-value lock))))
+    (get-spinlock lock 2 pid)
     (loop
      (unless
         ;; args are object slot-num old-value new-value
         (sb!vm::%instance-set-conditional lock 4 nil new-value)
        (dequeue lock)
+       (setf (waitqueue-lock lock) 0)
        (return t))
-     (unless wait-p (return nil))
+     (unless wait-p
+       (setf (waitqueue-lock lock) 0)
+       (return nil))
      (wait-on-queue lock nil))))
 
 (defun release-mutex (lock &optional (new-value nil))
   (declare (type mutex lock))
-  (let ((old-value (mutex-value lock))
-       (t1 nil))
-    (loop
-     (unless
-        ;; args are object slot-num old-value new-value
-        (eql old-value
-             (setf t1
-                   (sb!vm::%instance-set-conditional lock 4 old-value new-value)))       
-       (signal-queue-head lock)
-       (return t))
-     (setf old-value t1))))
+  ;; we assume the lock is ours to release
+  (with-spinlock (lock)
+    (setf (mutex-value lock) new-value)
+    (signal-queue-head lock)))
+
 
 (defmacro with-mutex ((mutex &key value (wait-p t))  &body body)
   (with-unique-names (got)
@@ -155,12 +154,15 @@
 thread may subsequently notify us using CONDITION-NOTIFY, at which
 time we reacquire LOCK and return to the caller."
   (unwind-protect
-       (wait-on-queue queue lock)
+       (progn
+        (get-spinlock queue 2 (current-thread-id))
+        (wait-on-queue queue lock))
     ;; If we are interrupted while waiting, we should do these things
     ;; before returning.  Ideally, in the case of an unhandled signal,
     ;; we should do them before entering the debugger, but this is
     ;; better than nothing.
-    (dequeue queue)
+    (with-spinlock (queue)
+      (dequeue queue))
     (get-mutex lock)))
 
 (defun condition-notify (queue)