X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=0b129d13e3735ac6ea2f8e3802cf12f856bd8a58;hb=ce2a580a469d285e7054ada13ef456e3dad08a34;hp=9ab61b18f7ca16ff07de83f872f693c1e02eaf1d;hpb=cf8e7223bce9948aaa764fd407871f0c441b3097;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 9ab61b1..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 <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
@@ -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
@@ -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.