X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=06002df4aed862289ec1b714dfcb01614e6a251c;hb=d564ccae6f79c4423b3d8f8dd1af59844fea6ac2;hp=302a9faf055eba491809e234429e4f839950c33d;hpb=b66385e2031fc2cac17dd129df0af400beb48a22;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 302a9fa..06002df 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -57,10 +57,18 @@ in future versions."
 (defvar *all-threads* ())
 (defvar *all-threads-lock* (make-mutex :name "all threads lock"))
 
+(defmacro with-all-threads-lock (&body body)
+  #!-sb-thread
+  `(locally ,@body)
+  #!+sb-thread
+  `(without-interrupts
+     (with-mutex (*all-threads-lock*)
+       ,@body)))
+
 (defun list-all-threads ()
   #!+sb-doc
   "Return a list of the live threads."
-  (with-mutex (*all-threads-lock*)
+  (with-all-threads-lock
     (copy-list *all-threads*)))
 
 (declaim (inline current-thread-sap))
@@ -97,7 +105,7 @@ in future versions."
   (define-alien-routine "signal_interrupt_thread"
       integer (os-thread unsigned-long))
 
-  (define-alien-routine "block_blockable_signals"
+  (define-alien-routine "block_deferrable_signals"
       void)
 
   #!+sb-lutex
@@ -117,6 +125,9 @@ in future versions."
     (sb!alien:define-alien-routine ("lutex_lock" %lutex-lock)
         int (lutex unsigned-long))
 
+    (sb!alien:define-alien-routine ("lutex_trylock" %lutex-trylock)
+        int (lutex unsigned-long))
+
     (sb!alien:define-alien-routine ("lutex_unlock" %lutex-unlock)
         int (lutex unsigned-long))
 
@@ -246,11 +257,11 @@ until it is available"
       (format *debug-io* "Thread: ~A~%" *current-thread*)
       (sb!debug:backtrace most-positive-fixnum *debug-io*)
       (force-output *debug-io*))
-    ;; FIXME: sb-lutex and (not wait-p)
     #!+sb-lutex
-    (when wait-p
-      (with-lutex-address (lutex (mutex-lutex mutex))
-        (%lutex-lock lutex))
+    (when (zerop (with-lutex-address (lutex (mutex-lutex mutex))
+                   (if wait-p
+                       (%lutex-lock lutex)
+                       (%lutex-trylock lutex))))
       (setf (mutex-value mutex) new-value))
     #!-sb-lutex
     (let (old)
@@ -472,16 +483,22 @@ this semaphore, then N of them is woken up."
 ;;; Remove thread from its session, if it has one.
 #!+sb-thread
 (defun handle-thread-exit (thread)
-  (with-mutex (*all-threads-lock*)
-    (/show0 "HANDLING THREAD EXIT")
-    #!+sb-lutex
-    (when (thread-interruptions-lock thread)
-      (/show0 "FREEING MUTEX LUTEX")
-      (with-lutex-address (lutex (mutex-lutex (thread-interruptions-lock thread)))
-        (%lutex-destroy lutex)))
-    (setq *all-threads* (delete thread *all-threads*)))
-  (when *session*
-    (%delete-thread-from-session thread *session*)))
+  (/show0 "HANDLING THREAD EXIT")
+  ;; We're going down, can't handle interrupts sanely anymore.
+  ;; GC remains enabled.
+  (block-deferrable-signals)
+  ;; Lisp-side cleanup
+  (with-all-threads-lock
+    (setf (thread-%alive-p thread) nil)
+    (setf (thread-os-thread thread) nil)
+    (setq *all-threads* (delete thread *all-threads*))
+    (when *session*
+      (%delete-thread-from-session thread *session*)))
+  #!+sb-lutex
+  (when (thread-interruptions-lock thread)
+    (/show0 "FREEING MUTEX LUTEX")
+    (with-lutex-address (lutex (mutex-lutex (thread-interruptions-lock thread)))
+      (%lutex-destroy lutex))))
 
 (defun terminate-session ()
   #!+sb-doc
@@ -621,7 +638,7 @@ returns the thread exits."
                   (sb!impl::*internal-symbol-output-fun* nil)
                   (sb!impl::*descriptor-handlers* nil)) ; serve-event
               (setf (thread-os-thread thread) (current-thread-sap-id))
-              (with-mutex (*all-threads-lock*)
+              (with-all-threads-lock
                 (push thread *all-threads*))
               (with-session-lock (*session*)
                 (push thread (session-threads *session*)))
@@ -644,15 +661,7 @@ returns the thread exits."
                            ;; threads, it's time to enable signals
                            (sb!unix::reset-signal-mask)
                            (funcall real-function))
-                      ;; we're going down, can't handle
-                      ;; interrupts sanely anymore
-                      (let ((sb!impl::*gc-inhibit* t))
-                        (block-blockable-signals)
-                        (setf (thread-%alive-p thread) nil)
-                        (setf (thread-os-thread thread) nil)
-                        ;; and remove what can be the last
-                        ;; reference to this thread
-                        (handle-thread-exit thread)))))))
+                      (handle-thread-exit thread))))))
             (values))))
     ;; Keep INITIAL-FUNCTION pinned until the child thread is
     ;; initialized properly.