1.0.37.15: Make SB-THREAD:TRY-SEMAPHORE decrement count by N.

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

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 48417e7..6f31ada 100644 (file)
--- 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)