1.0.26.4: less pessimal waitqueues

Readers calling CONDITION-WAIT don't interfere with each other.
CONDITION-WAIT used to set WAITQUEUE-DATA to *CURRENT-THREAD* causing
other readers entering FUTEX-WAIT to return with EWOULDBLOCK.

Set WAITQUEUE-DATA to NIL in readers, and to *CURRENT-THREAD* in
writers.

Also, fix a warning in :SEMAPHORE-MULTIPLE-WAITERS test.

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 359b0f3..736c27e 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -328,7 +328,7 @@ directly."
       (setf (mutex-%owner mutex) new-owner)
       t)
     #!-sb-lutex
-    ;; This is a direct tranlation of the Mutex 2 algorithm from
+    ;; This is a direct translation of the Mutex 2 algorithm from
     ;; "Futexes are Tricky" by Ulrich Drepper.
     (let ((old (sb!ext:compare-and-swap (mutex-state mutex)
                                         +lock-free+
@@ -463,7 +463,7 @@ time we reacquire MUTEX and return to the caller."
     ;; mutex on our way out.
     (without-interrupts
       (unwind-protect
-           (let ((me *current-thread*))
+           (let ((me nil))
              ;; This setf becomes visible to other CPUS due to the
              ;; usual memory barrier semantics of lock
              ;; acquire/release.
@@ -487,6 +487,8 @@ time we reacquire MUTEX and return to the caller."
                                       (or to-usec 0))))
                   ((1) (signal-deadline))
                   ((2))
+                  ;; EWOULDBLOCK, -1 here, is the possible spurious
+                  ;; wakeup case. 0 is the normal wakeup.
                   (otherwise (return))))))
         ;; If we are interrupted while waiting, we should do these
         ;; things before returning. Ideally, in the case of an
@@ -497,7 +499,7 @@ time we reacquire MUTEX and return to the caller."
 (defun condition-notify (queue &optional (n 1))
   #!+sb-doc
   "Notify N threads waiting on QUEUE. The same mutex that is used in
-the correspoinding condition-wait must be held by this thread during
+the corresponding CONDITION-WAIT must be held by this thread during
 this call."
   #!-sb-thread (declare (ignore queue n))
   #!-sb-thread (error "Not supported in unithread builds.")

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 31341c6..9db5021 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -871,6 +871,28 @@
 |     (mp:make-process #'roomy)))
 |#
 
+(with-test (:name (:condition-variable :wait-multiple))
+  (loop repeat 40 do
+        (let ((waitqueue (sb-thread:make-waitqueue :name "Q"))
+              (mutex (sb-thread:make-mutex :name "M"))
+              (failedp nil))
+          (format t ".")
+          (finish-output t)
+          (let ((threads (loop repeat 200
+                               collect
+                               (sb-thread:make-thread
+                                (lambda ()
+                                  (handler-case
+                                      (sb-sys:with-deadline (:seconds 0.01)
+                                        (sb-thread:with-mutex (mutex)
+                                          (sb-thread:condition-wait waitqueue
+                                                                    mutex)
+                                          (setq failedp t)))
+                                    (sb-sys:deadline-timeout (c)
+                                      (declare (ignore c)))))))))
+            (mapc #'sb-thread:join-thread threads)
+            (assert (not failedp))))))
+
 (with-test (:name (:condition-variable :notify-multiple))
   (flet ((tester (notify-fun)
            (let ((queue (make-waitqueue :name "queue"))

diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index fbffaaa..cb1a827 100644 (file)
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -110,12 +110,12 @@
                (values
                 (loop for r from 0 below n
                       collect
-                      (let ((r r))
-                        (sb-thread:make-thread (lambda ()
-                                                 (let ((sem semaphore))
-                                                   (dotimes (s i)
-                                                     (sb-thread:wait-on-semaphore sem))))
-                                               :name "reader")))
+                      (sb-thread:make-thread
+                       (lambda ()
+                         (let ((sem semaphore))
+                           (dotimes (s i)
+                             (sb-thread:wait-on-semaphore sem))))
+                       :name "reader"))
                 (* n i)))
              (make-writers (n readers i)
                (let ((j (* readers i)))
@@ -124,12 +124,12 @@
                     (let ((writers
                            (loop for w from 0 below n
                                  collect
-                                 (let ((w w))
-                                   (sb-thread:make-thread (lambda ()
-                                                            (let ((sem semaphore))
-                                                              (dotimes (s k)
-                                                                (sb-thread:signal-semaphore sem))))
-                                                          :name "writer")))))
+                                 (sb-thread:make-thread
+                                  (lambda ()
+                                    (let ((sem semaphore))
+                                      (dotimes (s k)
+                                        (sb-thread:signal-semaphore sem))))
+                                  :name "writer"))))
                       (assert (zerop rem))
                       writers)
                     (+ rem (* n k))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 27e6b38..71a80d7 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.26.3"
+"1.0.26.4"