userspace CONDITION-WAIT and interrupts

  GC and signals cause WITHOUT-THREAD-WAITING-FOR to mark the thread as
  temporarily not waiting for anything, restoring the old status on unwind.

  This is fine for mutex deadlock detection, but now that the same slot is
  used for userspace condition variable wakeups we end up in trouble:

   T1: enqueue self on waitqueue, marked as waiting on it.

   T1: receives an interrupt and is marked as not waiting anymore while the
       interrupt is handled.

   T2: delivers a wakeup to the queue, sees T1 as not waiting anymore and
       drops it from the queue.

   T1: resumes waiting, but isn't on the queue, and never receives a wakeup.

       Extra Bonus:

       If T1 times out or unwinds for any reason, it sees itself as not having
       been woken up, and with interrupts disabled tries to unqueue itself
       from the queue -- ending up in an uninterruptible endless loop.

  The Fix:

    WITHOUT-THREAD-WAITING-FOR no longer restores the waiting-for information
    for waitqueues, effectively causing a bogus wakeup.

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 4798bf4..5eb0e8a 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -669,17 +669,18 @@ IF-NOT-OWNER is :FORCE)."
     (setf (thread-waiting-for thread) nil)
     (let ((head (waitqueue-%head queue)))
       (do ((list head (cdr list))
-           (prev nil))
-          ((eq (car list) thread)
-           (let ((rest (cdr list)))
-             (cond (prev
-                    (setf (cdr prev) rest))
-                   (t
-                    (setf (waitqueue-%head queue) rest
-                          prev rest)))
-             (unless rest
-               (setf (waitqueue-%tail queue) prev))))
-        (setf prev list)))
+           (prev nil list))
+          ((or (null list)
+               (eq (car list) thread))
+           (when list
+             (let ((rest (cdr list)))
+               (cond (prev
+                      (setf (cdr prev) rest))
+                     (t
+                      (setf (waitqueue-%head queue) rest
+                            prev rest)))
+               (unless rest
+                 (setf (waitqueue-%tail queue) prev)))))))
     nil)
   (defun %waitqueue-wakeup (queue n)
     (declare (fixnum n))
@@ -779,8 +780,7 @@ around the call, checking the the associated data:
                    (setf status
                          (or (flet ((wakeup ()
                                       (barrier (:read))
-                                      (when (neq queue
-                                                 (thread-waiting-for me))
+                                      (unless (eq queue (thread-waiting-for me))
                                         :ok)))
                                (declare (dynamic-extent #'wakeup))
                                (allow-with-interrupts

diff --git a/src/code/thread.lisp b/src/code/thread.lisp
index 4d6a83c..a780b16 100644 (file)
--- a/src/code/thread.lisp
+++ b/src/code/thread.lisp
@@ -118,8 +118,11 @@ stale value, use MUTEX-OWNER instead."
                        (setf (thread-waiting-for ,thread) nil)
                        (barrier (:write))
                        (,with (exec)))
-                  (setf (thread-waiting-for ,thread) ,prev)
-                  (barrier (:write))))
+                  ;; If we were waiting on a waitqueue, this becomes a bogus
+                  ;; wakeup.
+                  (when (mutex-p ,prev)
+                    (setf (thread-waiting-for ,thread) ,prev)
+                    (barrier (:write)))))
                (exec)))))))
 
 (sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t))