X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=e51387281304e5e2ac372bec3b3eee85a9b385c9;hb=b411b7d5ee00409d531a8b0b4fcfc4d1d3c5c1d9;hp=a73ec31051e28554eab99bacc5fab0002c0772e8;hpb=b18df732481502bca0040c56685979712ec58754;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index a73ec31..e513872 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -103,18 +103,6 @@ instead.")
 (setf (fdocumentation '*current-thread* 'variable)
       "Bound in each thread to the thread itself.")
 
-(defstruct (thread (:constructor %make-thread))
-  #!+sb-doc
-  "Thread type. Do not rely on threads being structs as it may change
-in future versions."
-  name
-  %alive-p
-  os-thread
-  interruptions
-  (interruptions-lock (make-mutex :name "thread interruptions lock"))
-  result
-  (result-lock (make-mutex :name "thread result lock")))
-
 #!+sb-doc
 (setf
  (fdocumentation 'thread-name 'function)
@@ -568,7 +556,8 @@ time we reacquire MUTEX and return to the caller."
         ;; continuing after a deadline or EINTR.
         (setf (waitqueue-data queue) me)
         (loop
-         (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
+         (multiple-value-bind (to-sec to-usec)
+             (allow-with-interrupts (decode-timeout nil))
            (case (unwind-protect
                       (with-pinned-objects (queue me)
                         ;; RELEASE-MUTEX is purposefully as close to
@@ -586,7 +575,7 @@ time we reacquire MUTEX and return to the caller."
                         (allow-with-interrupts
                           (futex-wait (waitqueue-data-address queue)
                                       (get-lisp-obj-address me)
-                                      ;; our way if saying "no
+                                      ;; our way of saying "no
                                       ;; timeout":
                                       (or to-sec -1)
                                       (or to-usec 0))))
@@ -596,8 +585,10 @@ time we reacquire MUTEX and return to the caller."
                    ;; them before entering the debugger, but this is
                    ;; better than nothing.
                    (allow-with-interrupts (get-mutex mutex)))
-             ;; ETIMEDOUT
-             ((1) (signal-deadline))
+             ;; ETIMEDOUT; we know it was a timeout, yet we cannot
+             ;; signal a deadline unconditionally here because the
+             ;; call to GET-MUTEX may already have signaled it.
+             ((1))
              ;; EINTR
              ((2))
              ;; EWOULDBLOCK, -1 here, is the possible spurious wakeup
@@ -889,7 +880,7 @@ around and can be retrieved by JOIN-THREAD."
          (setup-sem (make-semaphore :name "Thread setup semaphore"))
          (real-function (coerce function 'function))
          (initial-function
-          (lambda ()
+          (named-lambda initial-thread-function ()
             ;; In time we'll move some of the binding presently done in C
             ;; here too.
             ;;