0.8.3.69:

[sbcl.git] / src / code / target-thread.lisp

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index c7d40d9..093f50f 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -17,7 +17,7 @@
          ;; can't use handling-end-of-the-world, because that flushes
          ;; output streams, and we don't necessarily have any (or we
          ;; could be sharing them)
-         (sb!sys:enable-interrupt :sigint :ignore)
+         (sb!sys:enable-interrupt sb!unix:sigint :ignore)
          (sb!unix:unix-exit
           (catch 'sb!impl::%end-of-the-world 
             (with-simple-restart 
@@ -27,18 +27,39 @@
               (funcall real-function))
             0))))))))
 
+;;; Conventional wisdom says that it's a bad idea to use these unless
+;;; you really need to.  Use a lock or a waitqueue instead
+(defun suspend-thread (thread-id)
+  (sb!unix:unix-kill thread-id sb!unix:sigstop))
+(defun resume-thread (thread-id)
+  (sb!unix:unix-kill thread-id sb!unix:sigcont))
+;;; Note warning about cleanup forms
 (defun destroy-thread (thread-id)
-  (sb!unix:unix-kill thread-id :sigterm)
+  "Destroy the thread identified by THREAD-ID abruptly, without running cleanup forms"
+  (sb!unix:unix-kill thread-id sb!unix:sigterm)
   ;; may have been stopped for some reason, so now wake it up to
   ;; deliver the TERM
-  (sb!unix:unix-kill thread-id :sigcont))
+  (sb!unix:unix-kill thread-id sb!unix:sigcont))
+
+
+;;; a moderate degree of care is expected for use of interrupt-thread,
+;;; due to its nature: if you interrupt a thread that was holding
+;;; important locks then do something that turns out to need those
+;;; locks, you probably won't like the effect.  Used with thought
+;;; though, it's a good deal gentler than the last-resort functions above
+
+(defun interrupt-thread (thread function)
+  "Interrupt THREAD and make it run FUNCTION.  "
+  (sb!unix::syscall* ("interrupt_thread"
+                     sb!alien:unsigned-long  sb!alien:unsigned-long)
+                    thread
+                    thread (sb!kernel:get-lisp-obj-address
+                            (coerce function 'function))))
+(defun terminate-thread (thread-id)
+  "Terminate the thread identified by THREAD-ID, by causing it to run
+SB-EXT:QUIT - the usual cleanup forms will be evaluated"
+  (interrupt-thread thread-id 'sb!ext:quit))
 
-;; Conventional wisdom says that it's a bad idea to use these unless
-;; you really need to.  Use a lock or a waitqueue instead
-(defun suspend-thread (thread-id)
-  (sb!unix:unix-kill thread-id :sigstop))
-(defun resume-thread (thread-id)
-  (sb!unix:unix-kill thread-id :sigcont))
 
 (defun current-thread-id ()
   (sb!sys:sap-int
@@ -104,11 +125,10 @@
      (setf (waitqueue-data queue)
           (delete pid (waitqueue-data queue))))))
 
-;;; this should probably only be called while holding the queue spinlock.
-;;; not sure
+;;; this should only be called while holding the queue spinlock.
 (defun signal-queue-head (queue)
   (let ((p (car (waitqueue-data queue))))
-    (when p (sb!unix:unix-kill p  :sigcont))))
+    (when p (sb!unix:unix-kill p  sb!unix:sigcont))))
 
 ;;;; mutex
 
@@ -153,21 +173,23 @@
   "Atomically release LOCK and enqueue ourselves on QUEUE.  Another
 thread may subsequently notify us using CONDITION-NOTIFY, at which
 time we reacquire LOCK and return to the caller."
-  (unwind-protect
-       (progn
-        (get-spinlock queue 2 (current-thread-id))
-        (wait-on-queue queue lock))
-    ;; If we are interrupted while waiting, we should do these things
-    ;; before returning.  Ideally, in the case of an unhandled signal,
-    ;; we should do them before entering the debugger, but this is
-    ;; better than nothing.
-    (with-spinlock (queue)
-      (dequeue queue))
-    (get-mutex lock)))
+  (assert lock)
+  (let ((value (mutex-value lock)))
+    (unwind-protect
+        (progn
+          (get-spinlock queue 2 (current-thread-id))
+          (wait-on-queue queue lock))
+      ;; If we are interrupted while waiting, we should do these things
+      ;; before returning.  Ideally, in the case of an unhandled signal,
+      ;; we should do them before entering the debugger, but this is
+      ;; better than nothing.
+      (with-spinlock (queue)
+       (dequeue queue))
+      (get-mutex lock value))))
 
 (defun condition-notify (queue)
   "Notify one of the processes waiting on QUEUE"
-  (signal-queue-head queue))
+  (with-spinlock (queue) (signal-queue-head queue)))
 
 
 ;;;; multiple independent listeners
@@ -196,7 +218,7 @@ time we reacquire LOCK and return to the caller."
                       (sb!sys:make-fd-stream err :input t :output t :buffering :line))
                      (sb!impl::*descriptor-handlers* nil))
                 (get-mutex *session-lock*)
-                (sb!sys:enable-interrupt :sigint #'sb!unix::sigint-handler)
+                (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler)
                 (unwind-protect
                      (sb!impl::toplevel-repl nil)
                   (sb!int:flush-standard-output-streams)))))
@@ -223,7 +245,8 @@ restart if *BACKGROUND-THREADS-WAIT-FOR-DEBUGGER* says to do that instead"
       (cond (wait-p (get-foreground))
            (t  (invoke-restart (car (compute-restarts))))))))
 
-;;; install this with (setf SB!INT:*REPL-PROMPT-FUN* #'thread-prompt-fun)
+;;; install this with
+;;; (setf SB-INT:*REPL-PROMPT-FUN* #'sb-thread::thread-repl-prompt-fun)
 ;;; One day it will be default
 (defun thread-repl-prompt-fun (out-stream)
   (let ((lock *session-lock*))