X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=0b129d13e3735ac6ea2f8e3802cf12f856bd8a58;hb=809babfb68a91aa47a7f011972d39915a77a9895;hp=914882c8392d5cb5192fe4f451247b3df0eae702;hpb=93ed7777d86296768a1e98acd5b08873c5aec8e4;p=sbcl.git diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 914882c..0b129d1 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -325,7 +325,12 @@ created and old ones may exit at any time." ;; FIXME: this does not work on SMP Pentium Pro and OOSTORE systems, ;; neither on most non-x86 architectures (but we don't have threads ;; on those). - (setf (spinlock-value spinlock) nil)) + (setf (spinlock-value spinlock) nil) + + ;; FIXME: Is a :memory barrier too strong here? Can we use a :write + ;; barrier instead? + #!+(not (or x86 x86-64)) + (barrier (:memory))) ;;;; Mutexes @@ -361,10 +366,10 @@ 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*)) + (barrier (:read)) (let ((old (mutex-%owner mutex))) (when (eq new-owner old) (error "Recursive lock attempt ~S." mutex)) @@ -385,12 +390,16 @@ 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) + (barrier (:write)) + t)) #!-sb-lutex ;; This is a direct translation of the Mutex 2 algorithm from ;; "Futexes are Tricky" by Ulrich Drepper. @@ -435,16 +444,15 @@ HOLDING-MUTEX-P." (waitp (bug "Failed to acquire lock with WAITP.")))))) -(defun grab-mutex (mutex &key (new-owner *current-thread*) - (waitp t) (timeout nil)) +(defun grab-mutex (mutex &key (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. + "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. +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 @@ -452,10 +460,6 @@ 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 @@ -468,9 +472,6 @@ 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 @@ -482,7 +483,7 @@ Notes: - It is recommended that you use WITH-MUTEX instead of calling GRAB-MUTEX directly. " - (get-mutex mutex new-owner waitp timeout)) + (get-mutex mutex nil waitp timeout)) (defun release-mutex (mutex &key (if-not-owner :punt)) #!+sb-doc @@ -540,7 +541,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 +553,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 @@ -569,6 +570,7 @@ returning normally, it may do so without holding the mutex." #!-sb-thread (error "Not supported in unithread builds.") #!+sb-thread (let ((me *current-thread*)) + (barrier (:read)) (assert (eq me (mutex-%owner mutex))) (/show0 "CONDITION-WAITing") #!+sb-lutex @@ -583,7 +585,8 @@ returning normally, it may do so without holding the mutex." (with-lutex-address (mutex-lutex-address (mutex-lutex mutex)) (with-local-interrupts (%lutex-wait queue-lutex-address mutex-lutex-address))))) - (setf (mutex-%owner mutex) me))) + (barrier (:write) + (setf (mutex-%owner mutex) me)))) #!-sb-lutex ;; Need to disable interrupts so that we don't miss grabbing the ;; mutex on our way out. @@ -592,26 +595,26 @@ returning normally, it may do so without holding the mutex." ;; 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) + (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 WAITQUEUE-DATA may be - ;; set by a notifier. + ;; 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 queue->data, and so futex-wait + ;; 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-data-address queue) + (futex-wait (waitqueue-token-address queue) (get-lisp-obj-address me) ;; our way of saying "no ;; timeout": @@ -627,7 +630,9 @@ returning normally, it may do so without holding the mutex." ;; signal a deadline unconditionally here because the ;; call to GET-MUTEX may already have signaled it. ((1)) - ;; EINTR + ;; 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. @@ -658,9 +663,9 @@ this call." ;; ^-- surely futex_wake() involves a memory barrier? #!-sb-lutex (progn - (setf (waitqueue-data queue) queue) + (setf (waitqueue-token queue) queue) (with-pinned-objects (queue) - (futex-wake (waitqueue-data-address queue) n))))) + (futex-wake (waitqueue-token-address queue) n))))) (defun condition-broadcast (queue) #!+sb-doc