X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=6f31adaf26d767b10515a301bcb31b8eb927614f;hb=ddcb2eeafdaa1c6a2cbb7b4b4dd420ad6b83d732;hp=eaf1692172b69e5cc539d07eb70e486616275af5;hpb=955ce74879cc8220d4c97bb1c0f3becd26ad68fc;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index eaf1692..6f31ada 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -678,7 +678,11 @@ negative. Else blocks until the semaphore can be decremented."
           (setf (semaphore-%count semaphore) (1- count))
           (unwind-protect
                (progn
-                 (incf (semaphore-waitcount semaphore))
+                 ;; Need to use ATOMIC-INCF despite the lock, because on our
+                 ;; way out from here we might not be locked anymore -- so
+                 ;; another thread might be tweaking this in parallel using
+                 ;; ATOMIC-DECF.
+                 (atomic-incf (semaphore-waitcount semaphore))
                  (loop until (plusp (setf count (semaphore-%count semaphore)))
                        do (condition-wait (semaphore-queue semaphore)
                                           (semaphore-mutex semaphore)))
@@ -687,17 +691,15 @@ negative. Else blocks until the semaphore can be decremented."
             ;; may unwind without the lock being held due to timeouts.
             (atomic-decf (semaphore-waitcount semaphore)))))))
 
-(defun try-semaphore (semaphore)
+(defun try-semaphore (semaphore &optional (n 1))
   #!+sb-doc
-  "Try to decrement the count of SEMAPHORE if the count would not be
-negative. Else return NIL."
-  ;; No need for disabling interrupts; the mutex prevents interleaved
-  ;; modifications, and we don't leave temporarily inconsistent state
-  ;; around.
+  "Try to decrement the count of SEMAPHORE by N. If the count were to
+become negative, punt and return NIL, otherwise return true."
+  (declare (type (integer 1) n))
   (with-mutex ((semaphore-mutex semaphore))
-    (let ((count (semaphore-%count semaphore)))
-      (when (plusp count)
-        (setf (semaphore-%count semaphore) (1- count))))))
+    (let ((new-count (- (semaphore-%count semaphore) n)))
+      (when (not (minusp new-count))
+        (setf (semaphore-%count semaphore) new-count)))))
 
 (defun signal-semaphore (semaphore &optional (n 1))
   #!+sb-doc
@@ -706,7 +708,7 @@ on this semaphore, then N of them is woken up."
   (declare (type (integer 1) n))
   ;; Need to disable interrupts so that we don't lose a wakeup after
   ;; we have incremented the count.
-  (with-system-mutex ((semaphore-mutex semaphore))
+  (with-system-mutex ((semaphore-mutex semaphore) :allow-with-interrupts t)
     (let ((waitcount (semaphore-waitcount semaphore))
           (count (incf (semaphore-%count semaphore) n)))
       (when (plusp waitcount)
@@ -918,6 +920,7 @@ around and can be retrieved by JOIN-THREAD."
                    (*handler-clusters* (sb!kernel::initial-handler-clusters))
                    (*condition-restarts* nil)
                    (sb!impl::*deadline* nil)
+                   (sb!impl::*deadline-seconds* nil)
                    (sb!impl::*step-out* nil)
                    ;; internal printer variables
                    (sb!impl::*previous-case* nil)