;; Make sure to get the current value.
(sb!ext:compare-and-swap (mutex-%owner mutex) nil nil))
-(defun get-mutex (mutex &optional (new-owner *current-thread*) (waitp t))
+(defun get-mutex (mutex &optional (new-owner *current-thread*)
+ (waitp t) (timeout nil))
#!+sb-doc
- "Acquire MUTEX for NEW-OWNER, which must be a thread or NIL. If
-NEW-OWNER is NIL, it defaults to the current thread. If WAITP is
-non-NIL and the mutex is in use, sleep until it is available.
-
-Note: using GET-MUTEX to assign a MUTEX to another thread then the
-current one is not recommended, and liable to be deprecated.
-
-GET-MUTEX is not interrupt safe. The correct way to call it is:
-
- (WITHOUT-INTERRUPTS
- ...
- (ALLOW-WITH-INTERRUPTS (GET-MUTEX ...))
- ...)
-
-WITHOUT-INTERRUPTS is necessary to avoid an interrupt unwinding the
-call while the mutex is in an inconsistent state while
-ALLOW-WITH-INTERRUPTS allows the call to be interrupted from sleep.
-
-It is recommended that you use WITH-MUTEX instead of calling GET-MUTEX
-directly."
+ "Deprecated in favor of GRAB-MUTEX."
(declare (type mutex mutex) (optimize (speed 3))
- #!-sb-thread (ignore waitp))
+ #!-sb-thread (ignore waitp timeout)
+ #!+sb-lutex (ignore timeout))
(unless new-owner
(setq new-owner *current-thread*))
(let ((old (mutex-%owner mutex)))
+lock-contested+))))
;; Wait on the contested lock.
(loop
- (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
+ (multiple-value-bind (to-sec to-usec stop-sec stop-usec deadlinep)
+ (decode-timeout timeout)
+ (declare (ignore stop-sec stop-usec))
(case (with-pinned-objects (mutex)
(futex-wait (mutex-state-address mutex)
(get-lisp-obj-address +lock-contested+)
(or to-sec -1)
(or to-usec 0)))
- ((1) (signal-deadline))
+ ((1) (if deadlinep
+ (signal-deadline)
+ (return-from get-mutex nil)))
((2))
(otherwise (return))))))
(setf old (sb!ext:compare-and-swap (mutex-state mutex)
(waitp
(bug "Failed to acquire lock with WAITP."))))))
+(defun grab-mutex (mutex &key (new-owner *current-thread*)
+ (waitp t) (timeout nil))
+ #!+sb-doc
+ "Acquire MUTEX for NEW-OWNER, which must be a thread or NIL. If
+NEW-OWNER is NIL, it defaults to the current thread. If WAITP is
+non-NIL and the mutex is in use, sleep until it is available.
+
+If TIMEOUT is given, it specifies a relative timeout, in seconds, on
+how long GRAB-MUTEX should try to acquire the lock in the contested
+case.
+
+If GRAB-MUTEX returns T, the lock acquisition was successful. In case
+of WAITP being NIL, or an expired TIMEOUT, GRAB-MUTEX may also return
+NIL which denotes that GRAB-MUTEX did -not- acquire the lock.
+
+Notes:
+
+ - Using the NEW-OWNER parameter to assign a MUTEX to another thread
+ than the current one is not recommended, and liable to be
+ deprecated.
+
+ - GRAB-MUTEX is not interrupt safe. The correct way to call it is:
+
+ (WITHOUT-INTERRUPTS
+ ...
+ (ALLOW-WITH-INTERRUPTS (GRAB-MUTEX ...))
+ ...)
+
+ WITHOUT-INTERRUPTS is necessary to avoid an interrupt unwinding
+ the call while the mutex is in an inconsistent state while
+ ALLOW-WITH-INTERRUPTS allows the call to be interrupted from
+ sleep.
+
+ - The TIMEOUT parameter is currently only supported on non-SB-LUTEX
+ platforms like Linux or BSD.
+
+ - (GRAB-MUTEX <mutex> :timeout 0.0) differs from
+ (GRAB-MUTEX <mutex> :waitp nil) in that the former may signal a
+ DEADLINE-TIMEOUT if the global deadline was due already on
+ entering GRAB-MUTEX.
+
+ The exact interplay of GRAB-MUTEX and deadlines are reserved to
+ change in future versions.
+
+ - It is recommended that you use WITH-MUTEX instead of calling
+ GRAB-MUTEX directly.
+"
+ (get-mutex mutex new-owner waitp timeout))
+
(defun release-mutex (mutex &key (if-not-owner :punt))
#!+sb-doc
"Release MUTEX by setting it to NIL. Wake up threads waiting for
(defstruct (waitqueue (:constructor %make-waitqueue))
#!+sb-doc
"Waitqueue type."
- (name nil :type (or null simple-string))
+ (name nil :type (or null thread-name))
#!+(and sb-lutex sb-thread)
(lutex (make-lutex))
#!-sb-lutex
#!+sb-doc
"Atomically release MUTEX and enqueue ourselves on QUEUE. Another
thread may subsequently notify us using CONDITION-NOTIFY, at which
-time we reacquire MUTEX and return to the caller."
+time we reacquire MUTEX and return to the caller.
+
+Note that if CONDITION-WAIT unwinds (due to eg. a timeout) instead of
+returning normally, it may do so without holding the mutex."
#!-sb-thread (declare (ignore queue))
(assert mutex)
#!-sb-thread (error "Not supported in unithread builds.")
"Semaphore type. The fact that a SEMAPHORE is a STRUCTURE-OBJECT
should be considered an implementation detail, and may change in the
future."
- (name nil :type (or null simple-string))
- (%count 0 :type (integer 0))
- (waitcount 0 :type (integer 0))
+ (name nil :type (or null thread-name))
+ (%count 0 :type (integer 0))
+ (waitcount 0 :type sb!vm:word)
(mutex (make-mutex))
(queue (make-waitqueue)))
(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. No danger over overflow, since there it
+ ;; at most one increment per thread waiting on the semaphore.
+ (sb!ext:atomic-incf (semaphore-waitcount semaphore))
(loop until (plusp (setf count (semaphore-%count semaphore)))
do (condition-wait (semaphore-queue semaphore)
(semaphore-mutex semaphore)))
(setf (semaphore-%count semaphore) (1- count)))
- (decf (semaphore-waitcount semaphore)))))))
+ ;; Need to use ATOMIC-DECF instead of DECF, as CONDITION-WAIT
+ ;; may unwind without the lock being held due to timeouts.
+ (sb!ext:atomic-decf (semaphore-waitcount semaphore)))))))
+
+(defun try-semaphore (semaphore &optional (n 1))
+ #!+sb-doc
+ "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 ((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
(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)
(*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)
projects / sbcl.git / blobdiff