X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=18bec356f5c35e494b3cc6e5dd66464a5a290cca;hb=beddcfe1ea23d2cfdddde2fa7cde6436799715a2;hp=ba189b3073308ebe5f2b8feb2e4c2c6e81cc6162;hpb=564b828342b894e8d65d15c676a402a8bbc08334;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index ba189b3..18bec35 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -443,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.
@@ -1071,17 +1073,26 @@ have the foreground next."
 
 ;;;; The beef
 
-(defun make-thread (function &key name)
+(defun make-thread (function &key name arguments)
   #!+sb-doc
-  "Create a new thread of NAME that runs FUNCTION. When the function
+  "Create a new thread of NAME that runs FUNCTION with the argument
+list designator provided (defaults to no argument). When the function
 returns the thread exits. The return values of FUNCTION are kept
 around and can be retrieved by JOIN-THREAD."
-  #!-sb-thread (declare (ignore function name))
+  #!-sb-thread (declare (ignore function name arguments))
   #!-sb-thread (error "Not supported in unithread builds.")
+  #!+sb-thread (assert (or (atom arguments)
+                           (null (cdr (last arguments))))
+                       (arguments)
+                       "Argument passed to ~S, ~S, is an improper list."
+                       'make-thread arguments)
   #!+sb-thread
   (let* ((thread (%make-thread :name name))
          (setup-sem (make-semaphore :name "Thread setup semaphore"))
          (real-function (coerce function 'function))
+         (arguments     (if (listp arguments)
+                            arguments
+                            (list arguments)))
          (initial-function
           (named-lambda initial-thread-function ()
             ;; In time we'll move some of the binding presently done in C
@@ -1142,7 +1153,7 @@ around and can be retrieved by JOIN-THREAD."
                                (setf (thread-result thread)
                                      (cons t
                                            (multiple-value-list
-                                            (funcall real-function))))
+                                            (apply real-function arguments))))
                                ;; Try to block deferrables. An
                                ;; interrupt may unwind it, but for a
                                ;; normal exit it prevents interrupt