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.
"THREAD-ERROR"
"THREAD-ERROR-THREAD"
"THREAD-ALIVE-P"
"THREAD-ERROR"
"THREAD-ERROR-THREAD"
"THREAD-ALIVE-P"
"THREAD-NAME"
"THREAD-YIELD"
;; Memory barrier
"THREAD-NAME"
"THREAD-YIELD"
;; Memory barrier
any time."
(thread-%alive-p thread))
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.
;; 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.
-(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
#!+sb-doc
"Create a new thread of NAME that runs FUNCTION with the argument
list designator provided (defaults to no argument). Thread exits when
#!+sb-thread
(tagbody
(with-mutex (*make-thread-lock*)
#!+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)
(setup-sem (make-semaphore :name "Thread setup semaphore"))
(real-function (coerce function 'function))
(arguments (if (listp arguments)
in future versions."
(name nil :type (or thread-name null))
(%alive-p nil :type boolean)
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)
(os-thread nil :type (or integer null))
(interruptions nil :type list)
(result nil :type list)
(dolist (thread (sb-thread:list-all-threads))
(unless (or (not (sb-thread:thread-alive-p thread))
(eql thread sb-thread:*current-thread*)
(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
(setf any-leftover thread)
(ignore-errors (sb-thread:terminate-thread thread))))
(when any-leftover