+ (return-from %%wait-for-mutex t)))))
+ (prog ((old (sb!ext:compare-and-swap (mutex-state mutex)
+ +lock-free+ +lock-taken+)))
+ ;; Got it right off the bat?
+ (maybe old)
+ :retry
+ ;; Mark it as contested, and sleep. (Exception: it was just released.)
+ (when (or (eql +lock-contested+ old)
+ (not (eql +lock-free+
+ (sb!ext:compare-and-swap
+ (mutex-state mutex) +lock-taken+ +lock-contested+))))
+ (when (eql 1 (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 = EWOULDBLOCK, possibly spurious wakeup
+ ;; 0 = normal wakeup
+ ;; 1 = ETIMEDOUT ***DONE***
+ ;; 2 = EINTR, a spurious wakeup
+ (return-from %%wait-for-mutex nil)))
+ ;; Try to get it, still marking it as contested.
+ (maybe
+ (sb!ext:compare-and-swap (mutex-state mutex) +lock-free+ +lock-contested+))
+ ;; Update timeout if necessary.
+ (when stop-sec
+ (setf (values to-sec to-usec)
+ (sb!impl::relative-decoded-times stop-sec stop-usec)))
+ ;; Spin.
+ (go :retry))))
+
+(defun %wait-for-mutex (mutex self timeout to-sec to-usec stop-sec stop-usec deadlinep)
+ (with-deadlocks (self mutex timeout)
+ (with-interrupts (check-deadlock))
+ (tagbody
+ :again
+ (return-from %wait-for-mutex
+ (or (%%wait-for-mutex mutex self to-sec to-usec stop-sec stop-usec)
+ (when deadlinep
+ (signal-deadline)
+ ;; FIXME: substract elapsed time from timeout...
+ (setf (values to-sec to-usec stop-sec stop-usec deadlinep)
+ (decode-timeout timeout))
+ (go :again)))))))
+
+(defun get-mutex (mutex &optional new-owner (waitp t) (timeout nil))
+ #!+sb-doc
+ "Deprecated in favor of GRAB-MUTEX."
+ (declare (ignorable waitp timeout))
+ (let ((new-owner (or new-owner *current-thread*)))
+ (or (%try-mutex mutex new-owner)
+ #!+sb-thread
+ (when waitp
+ (multiple-value-call #'%wait-for-mutex
+ mutex new-owner timeout (decode-timeout timeout))))))
+
+(defun grab-mutex (mutex &key (waitp t) (timeout nil))
+ #!+sb-doc
+ "Acquire MUTEX for the current thread. If WAITP is true (the default) and
+the mutex is not immediately available, 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:
+
+ - 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.
+
+ - (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.
+"
+ (declare (ignorable waitp timeout))
+ (let ((self *current-thread*))
+ (or (%try-mutex mutex self)
+ #!+sb-thread
+ (when waitp
+ (multiple-value-call #'%wait-for-mutex
+ mutex self timeout (decode-timeout timeout))))))
projects / sbcl.git / blobdiff