X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=8c7c1fec9ec49e383b2def214c0d0d5a14b3d271;hb=374667fd8a38e79869e63d56bacde7ad98a40852;hp=422ee960e87ffac8a36b87dac5b2688414804af4;hpb=00616528986d795d1335a0591371e1ac9d958eed;p=sbcl.git diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 422ee96..8c7c1fe 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -361,8 +361,7 @@ HOLDING-MUTEX-P." #!+sb-doc "Deprecated in favor of GRAB-MUTEX." (declare (type mutex mutex) (optimize (speed 3)) - #!-sb-thread (ignore waitp timeout) - #!+sb-lutex (ignore timeout)) + #!-sb-thread (ignore waitp timeout)) (unless new-owner (setq new-owner *current-thread*)) (let ((old (mutex-%owner mutex))) @@ -385,12 +384,15 @@ HOLDING-MUTEX-P." ;; but has that been checked?) (2) after the lutex call, but ;; before setting the mutex owner. #!+sb-lutex - (when (zerop (with-lutex-address (lutex (mutex-lutex mutex)) - (if waitp - (with-interrupts (%lutex-lock lutex)) - (%lutex-trylock lutex)))) - (setf (mutex-%owner mutex) new-owner) - t) + (progn + (when timeout + (error "Mutex timeouts not supported on this platform.")) + (when (zerop (with-lutex-address (lutex (mutex-lutex mutex)) + (if waitp + (with-interrupts (%lutex-lock lutex)) + (%lutex-trylock lutex)))) + (setf (mutex-%owner mutex) new-owner) + t)) #!-sb-lutex ;; This is a direct translation of the Mutex 2 algorithm from ;; "Futexes are Tricky" by Ulrich Drepper. @@ -444,7 +446,8 @@ 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. +case. Unsupported on :SB-LUTEX platforms (eg. Darwin), where a non-NIL +TIMEOUT signals an error. 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 @@ -468,19 +471,16 @@ Notes: 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 :timeout 0.0) differs from + (GRAB-MUTEX :waitp nil) in that the former may signal a + DEADLINE-TIMEOUT if the global deadline was due already on + entering GRAB-MUTEX. - - (GRAB-MUTEX :timeout 0.0) differs from - (GRAB-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. - 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. + - It is recommended that you use WITH-MUTEX instead of calling + GRAB-MUTEX directly. " (get-mutex mutex new-owner waitp timeout)) @@ -540,7 +540,7 @@ IF-NOT-OWNER is :FORCE)." #!+(and sb-lutex sb-thread) (lutex (make-lutex)) #!-sb-lutex - (data nil)) + (token nil)) (defun make-waitqueue (&key name) #!+sb-doc @@ -552,9 +552,9 @@ IF-NOT-OWNER is :FORCE)." "The name of the waitqueue. Setfable.") #!+(and sb-thread (not sb-lutex)) -(define-structure-slot-addressor waitqueue-data-address +(define-structure-slot-addressor waitqueue-token-address :structure waitqueue - :slot data) + :slot token) (defun condition-wait (queue mutex) #!+sb-doc @@ -588,51 +588,52 @@ returning normally, it may do so without holding the mutex." ;; Need to disable interrupts so that we don't miss grabbing the ;; mutex on our way out. (without-interrupts - (let ((me nil)) - ;; This setf becomes visible to other CPUS due to the usual - ;; memory barrier semantics of lock acquire/release. This must - ;; not be moved into the loop else wakeups may be lost upon - ;; continuing after a deadline or EINTR. - (setf (waitqueue-data queue) me) - (loop - (multiple-value-bind (to-sec to-usec) - (allow-with-interrupts (decode-timeout nil)) - (case (unwind-protect - (with-pinned-objects (queue me) - ;; RELEASE-MUTEX is purposefully as close to - ;; FUTEX-WAIT as possible to reduce the size - ;; of the window where WAITQUEUE-DATA may be - ;; set by a notifier. - (release-mutex mutex) - ;; Now we go to sleep using futex-wait. If - ;; anyone else manages to grab MUTEX and call - ;; CONDITION-NOTIFY during this comment, it - ;; will change queue->data, and so futex-wait - ;; returns immediately instead of sleeping. - ;; Ergo, no lost wakeup. We may get spurious - ;; wakeups, but that's ok. - (allow-with-interrupts - (futex-wait (waitqueue-data-address queue) - (get-lisp-obj-address me) - ;; our way of saying "no - ;; timeout": - (or to-sec -1) - (or to-usec 0)))) - ;; 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. - (allow-with-interrupts (get-mutex mutex))) - ;; ETIMEDOUT; we know it was a timeout, yet we cannot - ;; signal a deadline unconditionally here because the - ;; call to GET-MUTEX may already have signaled it. - ((1)) - ;; EINTR - ((2)) - ;; EWOULDBLOCK, -1 here, is the possible spurious wakeup - ;; case. 0 is the normal wakeup. - (otherwise (return))))))))) + ;; This setf becomes visible to other CPUS due to the usual + ;; memory barrier semantics of lock acquire/release. This must + ;; not be moved into the loop else wakeups may be lost upon + ;; continuing after a deadline or EINTR. + (setf (waitqueue-token queue) me) + (loop + (multiple-value-bind (to-sec to-usec) + (allow-with-interrupts (decode-timeout nil)) + (case (unwind-protect + (with-pinned-objects (queue me) + ;; RELEASE-MUTEX is purposefully as close to + ;; FUTEX-WAIT as possible to reduce the size of + ;; the window where the token may be set by a + ;; notifier. + (release-mutex mutex) + ;; Now we go to sleep using futex-wait. If + ;; anyone else manages to grab MUTEX and call + ;; CONDITION-NOTIFY during this comment, it + ;; will change the token, and so futex-wait + ;; returns immediately instead of sleeping. + ;; Ergo, no lost wakeup. We may get spurious + ;; wakeups, but that's ok. + (allow-with-interrupts + (futex-wait (waitqueue-token-address queue) + (get-lisp-obj-address me) + ;; our way of saying "no + ;; timeout": + (or to-sec -1) + (or to-usec 0)))) + ;; 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. + (allow-with-interrupts (get-mutex mutex))) + ;; ETIMEDOUT; we know it was a timeout, yet we cannot + ;; signal a deadline unconditionally here because the + ;; call to GET-MUTEX may already have signaled it. + ((1)) + ;; EINTR; we do not need to return to the caller because + ;; an interleaved wakeup would change the token causing an + ;; EWOULDBLOCK in the next iteration. + ((2)) + ;; EWOULDBLOCK, -1 here, is the possible spurious wakeup + ;; case. 0 is the normal wakeup. + (otherwise (return)))))))) (defun condition-notify (queue &optional (n 1)) #!+sb-doc @@ -649,17 +650,19 @@ this call." #!+sb-lutex (with-lutex-address (lutex (waitqueue-lutex queue)) (%lutex-wake lutex n)) - ;; no problem if >1 thread notifies during the comment in - ;; condition-wait: as long as the value in queue-data isn't the - ;; waiting thread's id, it matters not what it is + ;; No problem if >1 thread notifies during the comment in condition-wait: + ;; as long as the value in queue-data isn't the waiting thread's id, it + ;; matters not what it is -- using the queue object itself is handy. + ;; ;; XXX we should do something to ensure that the result of this setf - ;; is visible to all CPUs + ;; is visible to all CPUs. + ;; + ;; ^-- surely futex_wake() involves a memory barrier? #!-sb-lutex - (let ((me *current-thread*)) - (progn - (setf (waitqueue-data queue) me) - (with-pinned-objects (queue) - (futex-wake (waitqueue-data-address queue) n)))))) + (progn + (setf (waitqueue-token queue) queue) + (with-pinned-objects (queue) + (futex-wake (waitqueue-token-address queue) n))))) (defun condition-broadcast (queue) #!+sb-doc