any time."
(thread-%alive-p thread))
-(defun thread-emphemeral-p (thread)
+(defun thread-ephemeral-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
(defun semaphore-notification-status (semaphore-notification)
#!+sb-doc
"Returns T if a WAIT-ON-SEMAPHORE or TRY-SEMAPHORE using
-SEMAPHORE-NOTICATION has succeeded since the notification object was created
+SEMAPHORE-NOTIFICATION has succeeded since the notification object was created
or cleared."
(barrier (:read))
(semaphore-notification-%status semaphore-notification))
#!+sb-thread
(defun initial-thread-function-trampoline
- (thread setup-sem real-function arguments)
+ (thread setup-sem real-function arguments arg1 arg2 arg3)
;; In time we'll move some of the binding presently done in C here
;; too.
;;
(let* ((*current-thread* thread)
(*restart-clusters* nil)
(*handler-clusters* (sb!kernel::initial-handler-clusters))
- (*condition-restarts* nil)
(*exit-in-process* nil)
(sb!impl::*deadline* nil)
(sb!impl::*deadline-seconds* nil)
(setf (thread-os-thread thread) (current-thread-os-thread))
(with-mutex ((thread-result-lock thread))
(with-all-threads-lock
- (push thread *all-threads*))
+ (push thread *all-threads*))
(with-session-lock (*session*)
(push thread (session-threads *session*)))
(setf (thread-%alive-p thread) t)
- (signal-semaphore setup-sem)
+ (when setup-sem (signal-semaphore setup-sem))
;; Using handling-end-of-the-world would be a bit tricky
;; due to other catches and interrupts, so we essentially
;; re-implement it here. Once and only once more.
(without-interrupts
(unwind-protect
(with-local-interrupts
- (sb!unix::unblock-deferrable-signals)
+ (setf *gc-inhibit* nil) ;for foreign callbacks
+ (sb!unix::unblock-deferrable-signals)
(setf (thread-result thread)
(prog1
(cons t
(multiple-value-list
(unwind-protect
(catch '%return-from-thread
- (apply real-function arguments))
+ (if (listp arguments)
+ (apply real-function arguments)
+ (funcall real-function arg1 arg2 arg3)))
(when *exit-in-process*
(sb!impl::call-exit-hooks)))))
#!+sb-safepoint
the function returns. The return values of FUNCTION are kept around
and can be retrieved by JOIN-THREAD.
-Invoking the initial ABORT restart estabilished by MAKE-THREAD
+Invoking the initial ABORT restart established by MAKE-THREAD
terminates the thread.
See also: RETURN-FROM-THREAD, ABORT-THREAD."
'make-thread arguments)
#!+sb-thread
(let ((thread (%make-thread :name name :%ephemeral-p ephemeral)))
- (with-mutex (*make-thread-lock*)
- (let* ((setup-sem (make-semaphore :name "Thread setup semaphore"))
- (real-function (coerce function 'function))
- (arguments (if (listp arguments)
- arguments
- (list arguments)))
- (initial-function
- (named-lambda initial-thread-function ()
- ;; As it is, this lambda must not cons until we are ready
- ;; to run GC. Be very careful.
- (initial-thread-function-trampoline
- thread setup-sem real-function arguments))))
- ;; If the starting thread is stopped for gc before it signals the
- ;; semaphore then we'd be stuck.
- (assert (not *gc-inhibit*))
- ;; Keep INITIAL-FUNCTION pinned until the child thread is
- ;; initialized properly. Wrap the whole thing in
- ;; WITHOUT-INTERRUPTS because we pass INITIAL-FUNCTION to another
- ;; thread.
- (without-interrupts
- (with-pinned-objects (initial-function)
- (if (zerop
- (%create-thread (get-lisp-obj-address initial-function)))
- (setf thread nil)
- (wait-on-semaphore setup-sem))))))
- (or thread (error "Could not create a new thread."))))
+ (let* ((setup-sem (make-semaphore :name "Thread setup semaphore"))
+ (real-function (coerce function 'function))
+ (arguments (if (listp arguments)
+ arguments
+ (list arguments)))
+ #!+win32
+ (fp-modes (dpb 0 sb!vm::float-sticky-bits ;; clear accrued bits
+ (sb!vm:floating-point-modes)))
+ (initial-function
+ (named-lambda initial-thread-function ()
+ ;; Win32 doesn't inherit parent thread's FP modes,
+ ;; while it seems to happen everywhere else
+ #!+win32
+ (setf (sb!vm:floating-point-modes) fp-modes)
+ ;; As it is, this lambda must not cons until we are
+ ;; ready to run GC. Be very careful.
+ (initial-thread-function-trampoline
+ thread setup-sem real-function arguments nil nil nil))))
+ ;; If the starting thread is stopped for gc before it signals
+ ;; the semaphore then we'd be stuck.
+ (assert (not *gc-inhibit*))
+ ;; Keep INITIAL-FUNCTION pinned until the child thread is
+ ;; initialized properly. Wrap the whole thing in
+ ;; WITHOUT-INTERRUPTS because we pass INITIAL-FUNCTION to
+ ;; another thread.
+ (with-system-mutex (*make-thread-lock*)
+ (with-pinned-objects (initial-function)
+ (if (zerop
+ (%create-thread (get-lisp-obj-address initial-function)))
+ (setf thread nil)
+ (wait-on-semaphore setup-sem)))))
+ (or thread (error "Could not create a new thread."))))
(defun join-thread (thread &key (default nil defaultp) timeout)
#!+sb-doc
TIMEOUT occurs or the process exits: when main thread exits, the
entire process exits.
-NOTE: Return convention in case of a timeout is exprimental and
+NOTE: Return convention in case of a timeout is experimental and
subject to change."
(let ((lock (thread-result-lock thread))
(got-it nil)
"Deprecated. Same as TERMINATE-THREAD."
(terminate-thread thread))
+#!+sb-safepoint
+(defun enter-foreign-callback (arg1 arg2 arg3)
+ (initial-thread-function-trampoline
+ (make-foreign-thread :name "foreign callback")
+ nil #'sb!alien::enter-alien-callback t arg1 arg2 arg3))
+
(defmacro with-interruptions-lock ((thread) &body body)
`(with-system-mutex ((thread-interruptions-lock ,thread))
,@body))
given that asynch-unwind-safety does not compose: a function calling
only asynch-unwind-safe function isn't automatically asynch-unwind-safe.
- This means that in order for an asych unwind to be safe, the entire
+ This means that in order for an asynch unwind to be safe, the entire
callstack at the point of interruption needs to be asynch-unwind-safe.
* In addition to asynch-unwind-safety you must consider the issue of
- re-entrancy. INTERRUPT-THREAD can cause function that are never normally
+ reentrancy. INTERRUPT-THREAD can cause function that are never normally
called recursively to be re-entered during their dynamic contour,
which may cause them to misbehave. (Consider binding of special variables,
values of global variables, etc.)
-Take togather, these two restrict the \"safe\" things to do using
+Take together, these two restrict the \"safe\" things to do using
INTERRUPT-THREAD to a fairly minimal set. One useful one -- exclusively for
interactive development use is using it to force entry to debugger to inspect
the state of a thread: