Skip to content
Browse files

New predicate THREAD-EPHEMERAL-P for certain system threads

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.
  • Loading branch information...
1 parent 81678bf commit 83fc8f3154fa6ffe1c9451399eb23586ae07357d @lichtblau lichtblau committed Sep 18, 2012
Showing with 14 additions and 3 deletions.
  1. +1 −0 package-data-list.lisp-expr
  2. +10 −2 src/code/target-thread.lisp
  3. +1 −0 src/code/thread.lisp
  4. +2 −1 tests/test-util.lisp
View
1 package-data-list.lisp-expr
@@ -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
View
12 src/code/target-thread.lisp
@@ -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)
View
1 src/code/thread.lisp
@@ -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)
View
3 tests/test-util.lisp
@@ -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

0 comments on commit 83fc8f3

Please sign in to comment.
Something went wrong with that request. Please try again.