New predicate THREAD-EPHEMERAL-P for certain system threads
authorDavid Lichteblau <david@lichteblau.com>
Tue, 18 Sep 2012 17:33:10 +0000 (19:33 +0200)
committerDavid Lichteblau <david@lichteblau.com>
Wed, 19 Sep 2012 13:45:06 +0000 (15:45 +0200)
Adds an `ephemeral' flag to the thread structure and exports it.
When true, we can assume that the thread will be started and stopped
by the runtime automatically as needed.

The flag is currently of a purely informational nature; it does not
change the behaviour of thread-related functions.

Thanks to Anton Kovalenko.

package-data-list.lisp-expr
src/code/target-thread.lisp
src/code/thread.lisp
tests/test-util.lisp

index bad7f20..d3829cf 100644 (file)
@@ -2019,6 +2019,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "THREAD-ERROR"
                "THREAD-ERROR-THREAD"
                "THREAD-ALIVE-P"
+               "THREAD-EMPHEMERAL-P"
                "THREAD-NAME"
                "THREAD-YIELD"
                ;; Memory barrier
index 0ec0b37..ec60aab 100644 (file)
@@ -220,6 +220,14 @@ potentially stale even before the function returns, as the thread may exit at
 any time."
   (thread-%alive-p thread))
 
+(defun thread-emphemeral-p (thread)
+  #!+sb-doc
+  "Return T if THREAD is `ephemeral', which indicates that this thread is
+used by SBCL for internal purposes, and specifically that it knows how to
+to terminate this thread cleanly prior to core file saving without signalling
+an error in that case."
+  (thread-%ephemeral-p thread))
+
 ;; A thread is eligible for gc iff it has finished and there are no
 ;; more references to it. This list is supposed to keep a reference to
 ;; all running threads.
@@ -1341,7 +1349,7 @@ have the foreground next."
 
 ;;;; The beef
 
-(defun make-thread (function &key name arguments)
+(defun make-thread (function &key name arguments ephemeral)
   #!+sb-doc
   "Create a new thread of NAME that runs FUNCTION with the argument
 list designator provided (defaults to no argument). Thread exits when
@@ -1362,7 +1370,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
   #!+sb-thread
   (tagbody
      (with-mutex (*make-thread-lock*)
-       (let* ((thread (%make-thread :name name))
+       (let* ((thread (%make-thread :name name :%ephemeral-p ephemeral))
               (setup-sem (make-semaphore :name "Thread setup semaphore"))
               (real-function (coerce function 'function))
               (arguments     (if (listp arguments)
index d796f60..bbd9e30 100644 (file)
@@ -20,6 +20,7 @@
 in future versions."
   (name          nil :type (or thread-name null))
   (%alive-p      nil :type boolean)
+  (%ephemeral-p  nil :type boolean)
   (os-thread     nil :type (or integer null))
   (interruptions nil :type list)
   (result        nil :type list)
index 43bafa0..1d44174 100644 (file)
@@ -72,7 +72,8 @@
                     (dolist (thread (sb-thread:list-all-threads))
                       (unless (or (not (sb-thread:thread-alive-p thread))
                                   (eql thread sb-thread:*current-thread*)
-                                  (member thread ,threads))
+                                  (member thread ,threads)
+                                  (sb-thread:thread-emphemeral-p thread))
                         (setf any-leftover thread)
                         (ignore-errors (sb-thread:terminate-thread thread))))
                     (when any-leftover