1.0.38.9: Integer callback result fixes.
[sbcl.git] / src / code / target-thread.lisp
index 47d07d2..76fb998 100644 (file)
@@ -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.
@@ -435,16 +437,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 +453,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 +465,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 +476,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 +534,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 +546,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 +582,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 +644,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