[Sbcl-commits] master: userspace CONDITION-WAIT and interrupts

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  cb557a29b8b833b7753c2940e776eaa981633a9f (commit)
      from  dcf7b5cbc859426d005b534f3fa273be5da0b64c (commit)

- Log -----------------------------------------------------------------
commit cb557a29b8b833b7753c2940e776eaa981633a9f
Author: Nikodemus Siivola <nik...@ra...>
Date:   Fri Nov 18 20:05:38 2011 +0200

    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.
---
 src/code/target-thread.lisp |   26 +++++++++++++-------------
 src/code/thread.lisp        |    7 +++++--
 2 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 4798bf4..5eb0e8a 100644
--- 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
--- 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))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL