X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-thread.lisp;h=89c5111556d2c63c611e39600e28d369f1a0798f;hb=12a0ad4e13fd09f7809d0eb9066498c447674fbb;hp=4b89ca8313911153bc4825c7ef3f6cb5a08fc791;hpb=23e31980c78d174ef9cb775bf28f970890327fea;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 4b89ca8..89c5111 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -299,13 +299,16 @@ created and old ones may exit at any time."
 
 ;;;; Spinlocks
 
-(defmacro with-deadlocks ((thread lock timeout) &body forms)
+(defmacro with-deadlocks ((thread lock &optional timeout) &body forms)
+  (declare (ignorable timeout))
   (with-unique-names (prev n-thread n-lock n-timeout new)
     `(let* ((,n-thread ,thread)
             (,n-lock ,lock)
-            (,n-timeout (or ,timeout
-                            (when sb!impl::*deadline*
-                              sb!impl::*deadline-seconds*)))
+            (,n-timeout #!-sb-lutex
+                        ,(when timeout
+                           `(or ,timeout
+                                (when sb!impl::*deadline*
+                                  sb!impl::*deadline-seconds*))))
             ;; If we get interrupted while waiting for a lock, etc.
             (,prev (thread-waiting-for ,n-thread))
             (,new (if ,n-timeout
@@ -331,7 +334,7 @@ created and old ones may exit at any time."
       (when (eq old new)
         (error "Recursive lock attempt on ~S." spinlock))
       #!+sb-thread
-      (with-deadlocks (new spinlock nil)
+      (with-deadlocks (new spinlock)
         (flet ((cas ()
                  (if (sb!ext:compare-and-swap (spinlock-value spinlock) nil new)
                      (thread-yield)
@@ -440,9 +443,11 @@ HOLDING-MUTEX-P."
                             (detect-deadlock other-lock)))))))
              (deadlock-chain (thread lock)
                (let* ((other-thread (lock-owner lock))
-                      (other-lock (thread-waiting-for other-thread)))
+                      (other-lock (when other-thread
+                                    (thread-waiting-for other-thread))))
                  (cond ((not other-thread)
-                        ;; The deadlock is gone -- maybe someone timed out?
+                        ;; The deadlock is gone -- maybe someone unwound
+                        ;; from the same deadlock already?
                         (return-from check-deadlock nil))
                        ((consp other-lock)
                         ;; There's a timeout -- no deadlock.