"*ALLOW-WITH-INTERRUPTS*"
"*INTERRUPTS-ENABLED*"
"*INTERRUPT-PENDING*"
+ #!+sb-thruption "*THRUPTION-PENDING*"
"*LINKAGE-INFO*"
"*LONG-SITE-NAME*" "*SHORT-SITE-NAME*"
"*PERIODIC-POLLING-FUNCTION*"
sb!unix::*unblock-deferrables-on-enabling-interrupts-p* nil
*interrupts-enabled* t
*interrupt-pending* nil
+ #!+sb-thruption #!+sb-thruption *thruption-pending* nil
*break-on-signals* nil
*maximum-error-depth* 10
*current-error-depth* 0
sb!unix::*unblock-deferrables-on-enabling-interrupts-p*
*interrupts-enabled*
*interrupt-pending*
+ #!+sb-thruption *thruption-pending*
#!+sb-safepoint *gc-safe*
#!+sb-safepoint *in-safepoint*
*free-interrupt-context-index*
(defvar *interrupts-enabled* t)
(defvar *interrupt-pending* nil)
+#!+sb-thruption (defvar *thruption-pending* nil)
(defvar *allow-with-interrupts* t)
;;; This is to support signal handlers that want to return to the
;;; interrupted context without leaving anything extra on the stack. A
(setq *unblock-deferrables-on-enabling-interrupts-p*
nil)
(sb!unix::unblock-deferrable-signals))
- (when *interrupt-pending*
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
(receive-pending-interrupt)))
(locally ,@with-forms))))
(let ((*interrupts-enabled* nil)
;; another WITHOUT-INTERRUPTS, the pending interrupt will be
;; handled immediately upon exit from said
;; WITHOUT-INTERRUPTS, so it is as if nothing has happened.
- (when *interrupt-pending*
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
(receive-pending-interrupt)))
(,without-interrupts-body)))))
(when *unblock-deferrables-on-enabling-interrupts-p*
(setq *unblock-deferrables-on-enabling-interrupts-p* nil)
(sb!unix::unblock-deferrable-signals))
- (when *interrupt-pending*
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
(receive-pending-interrupt)))
(locally ,@body))))
(defun %check-interrupts ()
;; Here we check for pending interrupts first, because reading a
;; special is faster then binding it!
- (when *interrupt-pending*
+ (when (or *interrupt-pending* #!+sb-thruption *thruption-pending*)
(let ((*interrupts-enabled* t))
(receive-pending-interrupt))))
(declare (ignore signal code context))
(sb!ext:exit))
+#!-sb-thruption
;;; SIGPIPE is not used in SBCL for its original purpose, instead it's
;;; for signalling a thread that it should look at its interruption
;;; queue. The handler (RUN_INTERRUPTION) just returns if there is
#!-linux
(enable-interrupt sigsys #'sigsys-handler)
(enable-interrupt sigalrm #'sigalrm-handler)
+ #!-sb-thruption
(enable-interrupt sigpipe #'sigpipe-handler)
(enable-interrupt sigchld #'sigchld-handler)
#!+hpux (ignore-interrupt sigxcpu)
(os-thread #!-alpha unsigned-long #!+alpha unsigned-int)
(signal int))
+(define-alien-routine "wake_thread"
+ integer
+ (os-thread #!-alpha unsigned-long #!+alpha unsigned-int))
+
#!+sb-thread
(progn
;; FIXME it would be good to define what a thread id is or isn't
;; interupts to be lost: SIGINT comes to
;; mind.
(setq *interrupt-pending* nil)
+ #!+sb-thruption
+ (setq *thruption-pending* nil)
(handle-thread-exit thread)))))))))
(values))))
;; If the starting thread is stopped for gc before it signals the
,@body))
;;; Called from the signal handler.
-#!-win32
+#!-(or sb-thruption win32)
(defun run-interruption ()
(let ((interruption (with-interruptions-lock (*current-thread*)
(pop (thread-interruptions *current-thread*)))))
(when interruption
(funcall interruption))))
+#!+sb-thruption
+(defun run-interruption ()
+ (in-interruption () ;the non-thruption code does this in the signal handler
+ (loop
+ (let ((interruption (with-interruptions-lock (*current-thread*)
+ (pop (thread-interruptions *current-thread*)))))
+ (unless interruption
+ (return))
+ (funcall interruption)))))
+
(defun interrupt-thread (thread function)
#!+sb-doc
"Interrupt THREAD and make it run FUNCTION.
(without-interrupts
(allow-with-interrupts
(funcall function))))))))
- (when (minusp (kill-safely os-thread sb!unix:sigpipe))
+ (when (minusp (wake-thread os-thread))
(error 'interrupt-thread-error :thread thread))))))
(defun terminate-thread (thread)
*allow-with-interrupts*
*interrupts-enabled*
*interrupt-pending*
+ #!+sb-thruption *thruption-pending*
*type-system-initialized*))
(defvar *cold-init-complete-p*)
sb!di::handle-breakpoint
sb!di::handle-single-step-trap
fdefinition-object
- #!+win32 sb!kernel::handle-win32-exception))
+ #!+win32 sb!kernel::handle-win32-exception
+ #!+sb-thruption sb!thread::run-interruption))
(defparameter *common-static-symbols*
'(t
sb!unix::*allow-with-interrupts*
sb!unix::*interrupts-enabled*
sb!unix::*interrupt-pending*
+ #!+sb-thruption sb!unix::*thruption-pending*
+ #!+sb-thruption sb!impl::*restart-clusters*
*in-without-gcing*
*gc-inhibit*
*gc-pending*
* thus we end up here again. Third, when calling GC-ON or at the
* end of a WITHOUT-GCING, MAYBE-HANDLE-PENDING-GC will trap to
* here if there is a pending GC. Fourth, ahem, at the end of
- * WITHOUT-INTERRUPTS (bar complications with nesting). */
-
- /* Win32 only needs to handle the GC cases (for now?) */
+ * WITHOUT-INTERRUPTS (bar complications with nesting).
+ *
+ * A fourth way happens with safepoints: In addition to a stop for
+ * GC that is pending, there are thruptions. Both mechanisms are
+ * mostly signal-free, yet also of an asynchronous nature, so it makes
+ * sense to let interrupt_handle_pending take care of running them:
+ * It gets run precisely at those places where it is safe to process
+ * pending asynchronous tasks. */
struct thread *thread = arch_os_get_current_thread();
struct interrupt_data *data = thread->interrupt_data;
void *original_pending_handler = data->pending_handler;
#ifdef LISP_FEATURE_SB_SAFEPOINT
- /* handles the STOP_FOR_GC_PENDING case */
- thread_pitstop(context);
+ /* handles the STOP_FOR_GC_PENDING case, plus THRUPTIONS */
+ if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL
+# ifdef LISP_FEATURE_SB_THRUPTION
+ || SymbolValue(THRUPTION_PENDING,thread) != NIL
+# endif
+ )
+ {
+ /* We ought to take this chance to do a pitstop now. */
+
+ /* Now, it goes without saying that the context sigmask
+ * tweaking around this call is not pretty. However, it
+ * currently seems to be "needed" for the following
+ * situation. (So let's find a better solution and remove
+ * this comment afterwards.)
+ *
+ * Suppose we are in a signal handler (let's say SIGALRM).
+ * At the end of a WITHOUT-INTERRUPTS, the lisp code notices
+ * that a thruption is pending, and says to itself "let's
+ * receive pending interrupts then". We trust that the
+ * caller is happy to run those sorts of things now,
+ * including thruptions, otherwise it wouldn't have called
+ * us. But that's the problem: Even though we can guess the
+ * caller's intention, may_thrupt() would see that signals
+ * are blocked in the signal context (because that context
+ * itself points to a signal handler). So we cheat and
+ * pretend that signals weren't blocked.
+ * --DFL */
+#ifndef LISP_FEATURE_WIN32
+ sigset_t old, *ctxset = os_context_sigmask_addr(context);
+ unblock_signals(&deferrable_sigset, ctxset, &old);
+#endif
+ thread_pitstop(context);
+#ifndef LISP_FEATURE_WIN32
+ sigcopyset(&old, ctxset);
+#endif
+ }
#elif defined(LISP_FEATURE_SB_THREAD)
if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
/* STOP_FOR_GC_PENDING and GC_PENDING are cleared by
sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
run_deferred_handler(data, context);
}
+#ifdef LISP_FEATURE_SB_THRUPTION
+ if (SymbolValue(THRUPTION_PENDING,thread)==T)
+ /* Special case for the following situation: There is a
+ * thruption pending, but a signal had been deferred. The
+ * pitstop at the top of this function could only take care
+ * of GC, and skipped the thruption, so we need to try again
+ * now that INTERRUPT_PENDING and the sigmask have been
+ * reset. */
+ while (check_pending_thruptions(context))
+ ;
+#endif
#endif
#ifdef LISP_FEATURE_GENCGC
if (get_pseudo_atomic_interrupted(thread))
else
sa.sa_sigaction = low_level_handle_now_handler;
+#ifdef LISP_FEATURE_SB_THRUPTION
+ /* It's in `deferrable_sigset' so that we block&unblock it properly,
+ * but we don't actually want to defer it. And if we put it only
+ * into blockable_sigset, we'd have to special-case it around thread
+ * creation at least. */
+ if (signal == SIGPIPE)
+ sa.sa_sigaction = low_level_handle_now_handler;
+#endif
+
sigcopyset(&sa.sa_mask, &blockable_sigset);
sa.sa_flags = SA_SIGINFO | SA_RESTART
| (sigaction_nodefer_works ? SA_NODEFER : 0);
extern void reset_thread_control_stack_guard_page(struct thread *th);
#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_WIN32)
+# ifdef LISP_FEATURE_SB_THRUPTION
+void thruption_handler(int signal, siginfo_t *info, os_context_t *context);
+# endif
void rtmin0_handler(int signal, siginfo_t *info, os_context_t *context);
void rtmin1_handler(int signal, siginfo_t *info, os_context_t *context);
#endif
{
undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
sigsegv_handler);
+
+ /* OAOOM c.f. sunos-os.c.
+ * Should we have a reusable function gc_install_interrupt_handlers? */
#ifdef LISP_FEATURE_SB_THREAD
-# ifndef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_THRUPTION
+ undoably_install_low_level_interrupt_handler(SIGPIPE, thruption_handler);
+# endif
+# else
undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
sig_stop_for_gc_handler);
# endif
SymbolTlValue(GC_PENDING, self) == NIL));
}
+#ifdef LISP_FEATURE_SB_THRUPTION
+static inline int
+thread_may_thrupt(os_context_t *ctx)
+{
+ struct thread * self = arch_os_get_current_thread();
+ /* Thread may be interrupted if all of these are true:
+ * 1) Deferrables are unblocked in the context of the signal that
+ * went into the safepoint. -- Otherwise the surrounding code
+ * didn't want to be interrupted by a signal, so presumably it didn't
+ * want to be INTERRUPT-THREADed either.
+ * (See interrupt_handle_pending for an exception.)
+ * 2) On POSIX: There is no pending signal. This is important even
+ * after checking the sigmask, since we could be in the
+ * handle_pending trap following re-enabling of interrupts.
+ * Signals are unblocked in that case, but the signal is still
+ * pending; we want to run GC before handling the signal and
+ * therefore entered this safepoint. But the thruption would call
+ * ALLOW-WITH-INTERRUPTS, and could re-enter the handle_pending
+ * trap, leading to recursion.
+ * 3) INTERRUPTS_ENABLED is non-nil.
+ * 4) No GC pending; it takes precedence.
+ * Note that we are in a safepoint here, which is always outside of PA. */
+
+ if (SymbolValue(INTERRUPTS_ENABLED, self) == NIL)
+ return 0;
+
+ if (SymbolValue(GC_PENDING, self) != NIL)
+ return 0;
+
+ if (SymbolValue(STOP_FOR_GC_PENDING, self) != NIL)
+ return 0;
+
+#ifdef LISP_FEATURE_WIN32
+ if (deferrables_blocked_p(&self->os_thread->blocked_signal_set))
+ return 0;
+#else
+ /* ctx is NULL if the caller wants to ignore the sigmask. */
+ if (ctx && deferrables_blocked_p(os_context_sigmask_addr(ctx)))
+ return 0;
+ if (SymbolValue(INTERRUPT_PENDING, self) != NIL)
+ return 0;
+#endif
+
+ if (SymbolValue(RESTART_CLUSTERS, self) == NIL)
+ /* This special case prevents TERMINATE-THREAD from hitting
+ * during INITIAL-THREAD-FUNCTION before it's ready. Curiously,
+ * deferrables are already unblocked there. Further
+ * investigation may be in order. */
+ return 0;
+
+ return 1;
+}
+
+// returns 0 if skipped, 1 otherwise
+int
+check_pending_thruptions(os_context_t *ctx)
+{
+ struct thread *p = arch_os_get_current_thread();
+
+ gc_assert(!os_get_csp(p));
+
+ if (!thread_may_thrupt(ctx))
+ return 0;
+ if (SymbolValue(THRUPTION_PENDING, p) == NIL)
+ return 0;
+ SetSymbolValue(THRUPTION_PENDING, NIL, p);
+
+ sigset_t oldset;
+ block_deferrable_signals(0, &oldset);
+
+ funcall0(StaticSymbolFunction(RUN_INTERRUPTION));
+
+ pthread_sigmask(SIG_SETMASK, &oldset, 0);
+ return 1;
+}
+#endif
+
int
on_stack_p(struct thread *th, void *esp)
{
work without thundering herd. */
int stopped;
+ /* Thruption flag: Iff true, current STW initiator is delivering
+ thruptions and not GCing. */
+ boolean thruption;
+
} gc_dispatcher = {
/* mutexes lazy initialized, other data initially zeroed */
.mx_gpunmapped = PTHREAD_MUTEX_INITIALIZER,
in progress, begin it by unmapping GC page, and record current
thread as STW initiator.
+ `thruption' flag affects some subtleties of stop/start methods:
+ waiting for other threads allowing GC; setting and clearing
+ STOP_FOR_GC_PENDING, GC_PENDING, THRUPTION_PENDING, etc.
+
Return true if current thread becomes a GC initiator, or already
_is_ a STW initiator.
the right' to stop the world as early as it wants. */
static inline boolean
-maybe_become_stw_initiator()
+maybe_become_stw_initiator(boolean thruption)
{
struct thread* self = arch_os_get_current_thread();
odxprint(misc,"NULL STW IN GPTRANSITION, REPLACING");
/* Then we are... */
gc_dispatcher.th_stw_initiator = self;
+ gc_dispatcher.thruption = thruption;
/* hold mx_gcing until we restart the world */
pthread_mutex_lock(&gc_dispatcher.mx_gcing);
gc_stop_the_world()
{
struct thread* self = arch_os_get_current_thread(), *p;
+ boolean thruption;
if (SymbolTlValue(GC_INHIBIT,self)!=T) {
/* If GC is enabled, this thread may wait for current STW
initiator without causing deadlock. */
- if (!maybe_become_stw_initiator()) {
+ if (!maybe_become_stw_initiator(0)) {
pthread_mutex_lock(&gc_dispatcher.mx_gcing);
- maybe_become_stw_initiator();
+ maybe_become_stw_initiator(0);
pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
}
/* Now _this thread_ should be STW initiator */
gc_assert(self == gc_dispatcher.th_stw_initiator);
} else {
/* GC inhibited; e.g. we are inside SUB-GC */
- if (!maybe_become_stw_initiator()) {
+ if (!maybe_become_stw_initiator(0)) {
/* Some trouble. Inside SUB-GC, holding the Lisp-side
mutex, but some other thread is stopping the world. */
- {
+ if (gc_dispatcher.thruption) {
+ /* Thruption. Wait until it's delivered */
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ /* Warning: mx_gcing is held recursively. */
+ gc_assert(maybe_become_stw_initiator(0));
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ } else {
/* In SUB-GC, holding mutex; other thread wants to
GC. */
if (gc_dispatcher.th_subgc == self) {
}
}
}
+ thruption = gc_dispatcher.thruption; /* Thruption or GC? */
if (!gc_dispatcher.stopped++) {
/* Outermost stop: signal other threads */
pthread_mutex_lock(&all_threads_lock);
pthread_mutex_unlock(p_qrl);
} else {
/* In C; we just disabled writing. */
- {
+ if (!thruption) {
if (SymbolTlValue(GC_INHIBIT,p)==T) {
/* GC inhibited there */
SetTlSymbolValue(STOP_FOR_GC_PENDING,T,p);
odxprint(safepoints,"after remapping GC page %p",self);
SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,self);
- {
+ if (!thruption) {
struct thread* priority_gc = NULL;
for_each_thread(p) {
if (p==self)
gc_start_the_world()
{
struct thread* self = arch_os_get_current_thread(), *p;
+ boolean thruption = gc_dispatcher.thruption;
if (gc_dispatcher.th_stw_initiator != self) {
odxprint(misc,"Unmapper %p self %p",gc_dispatcher.th_stw_initiator,self);
gc_assert (gc_dispatcher.th_subgc == self);
if (!--gc_dispatcher.stopped) {
for_each_thread(p) {
- {
+ if (!thruption) {
SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,p);
SetTlSymbolValue(GC_PENDING,NIL,p);
}
- set_thread_csp_access(p,1);
+ if (
+#ifdef LISP_FEATURE_SB_THRUPTION
+ SymbolTlValue(THRUPTION_PENDING,p)!=T
+#else
+ 1 /* trivially no thruption pending */
+#endif
+ || SymbolTlValue(INTERRUPTS_ENABLED,p)!=T)
+ set_thread_csp_access(p,1);
}
pthread_mutex_unlock(&all_threads_lock);
/* Release everyone */
return;
}
if ((SymbolTlValue(GC_PENDING,self)!=NIL) &&
- maybe_become_stw_initiator() && !in_race_p()) {
+ maybe_become_stw_initiator(0) && !in_race_p()) {
gc_stop_the_world();
set_thread_csp_access(self,1);
check_pending_gc(ctxptr);
set_thread_csp_access(self,1);
WITH_GC_AT_SAFEPOINTS_ONLY() {
pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+#ifdef LISP_FEATURE_SB_THRUPTION
+ while (check_pending_thruptions(ctxptr))
+ ;
+#endif
}
return;
}
}
}
+#ifdef LISP_FEATURE_SB_THRUPTION
+ while(check_pending_thruptions(ctxptr));
+#endif
}
static inline void
return; /* trivialize */
odxprint(safepoints,"edge leaving [%p]", ctxptr);
if (SymbolTlValue(GC_INHIBIT,self)!=T) {
+#ifdef LISP_FEATURE_SB_THRUPTION
+ if (SymbolTlValue(THRUPTION_PENDING,self)==T &&
+ SymbolTlValue(INTERRUPTS_ENABLED,self)==T) {
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ set_thread_csp_access(self,1);
+ WITH_GC_AT_SAFEPOINTS_ONLY() {
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ while (check_pending_thruptions(ctxptr))
+ ;
+ }
+ } else
+#endif
{
pthread_mutex_lock(&gc_dispatcher.mx_gcing);
odxprint(safepoints,"edge leaving [%p] took gcing", ctxptr);
} else {
/* Entering. */
odxprint(safepoints,"edge entering [%p]", ctxptr);
+#ifdef LISP_FEATURE_SB_THRUPTION
+ while(check_pending_thruptions(ctxptr))
+ ;
+#endif
if (os_get_csp(self))
lose("thread_edge: would lose csp");
set_csp_from_context(self, ctxptr);
gc_assert(SymbolTlValue(GC_INHIBIT,self)!=T);
/* unmap GC page, signal other threads... */
- maybe_become_stw_initiator();
+ maybe_become_stw_initiator(0);
}
\f
+#ifdef LISP_FEATURE_SB_THRUPTION
+/* wake_thread(thread) -- ensure a thruption delivery to
+ * `thread'. */
+
+int
+wake_thread_posix(os_thread_t os_thread)
+{
+ int found = 0;
+ struct thread *thread;
+ struct thread *self = arch_os_get_current_thread();
+
+ /* Must not and need not attempt to signal ourselves while we're the
+ * STW initiator. */
+ if (self->os_thread == os_thread) {
+ SetTlSymbolValue(THRUPTION_PENDING,T,self);
+ WITH_GC_AT_SAFEPOINTS_ONLY()
+ while (check_pending_thruptions(0 /* ignore the sigmask */))
+ ;
+ return 0;
+ }
+
+ /* We are not in a signal handler here, so need to block signals
+ * manually. */
+ sigset_t oldset;
+ block_deferrable_signals(0, &oldset);
+
+ if (!maybe_become_stw_initiator(1) || in_race_p()) {
+ /* we are not able to wake the thread up, but the STW initiator
+ * will take care of it (kludge: unless it is in foreign code).
+ * Let's at least try to get our return value right. */
+ pthread_mutex_lock(&all_threads_lock);
+ for_each_thread (thread)
+ if (thread->os_thread == os_thread) {
+ found = 1;
+ break;
+ }
+ pthread_mutex_unlock(&all_threads_lock);
+ goto cleanup;
+ }
+ gc_stop_the_world();
+
+ /* we hold the all_threads lock */
+ for_each_thread (thread)
+ if (thread->os_thread == os_thread) {
+ /* it's still alive... */
+ found = 1;
+
+ SetTlSymbolValue(THRUPTION_PENDING,T,thread);
+ if (SymbolTlValue(GC_PENDING,thread) == T
+ || SymbolTlValue(STOP_FOR_GC_PENDING,thread) == T)
+ break;
+
+ if (os_get_csp(thread)) {
+ /* ... and in foreign code. Push it into a safety
+ * transition. */
+ int status = pthread_kill(os_thread, SIGPIPE);
+ if (status)
+ lose("wake_thread_posix: pthread_kill failed with %d\n",
+ status);
+ }
+ break;
+ }
+
+ /* If it was alive but in Lisp, the pit stop takes care of thruptions. */
+ gc_start_the_world();
+
+cleanup:
+ pthread_sigmask(SIG_SETMASK, &oldset, 0);
+ return found ? 0 : -1;
+}
+#endif /* LISP_FEATURE_SB_THRUPTION */
+
void
thread_in_safety_transition(os_context_t *ctx)
{
thread_pitstop(ctx);
}
+void
+thread_interrupted(os_context_t *ctx)
+{
+ FSHOW_SIGNAL((stderr, "thread_interrupted\n"));
+ thread_pitstop(ctx);
+}
+
void**
os_get_csp(struct thread* th)
{
#ifndef LISP_FEATURE_WIN32
+# ifdef LISP_FEATURE_SB_THRUPTION
+void
+thruption_handler(int signal, siginfo_t *info, os_context_t *ctx)
+{
+ struct thread *self = arch_os_get_current_thread();
+
+ if (!os_get_csp(self))
+ /* In Lisp code. Do not run thruptions asynchronously. The
+ * next safepoint will take care of it. */
+ return;
+
+ /* In C code. As a rule, we assume that running thruptions is OK. */
+ fake_foreign_function_call(ctx);
+ thread_in_safety_transition(ctx);
+ undo_fake_foreign_function_call(ctx);
+}
+# endif
+
/* Designed to be of the same type as call_into_lisp. Ignores its
* arguments. */
lispobj
undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
sigsegv_handler);
+ /* OAOOM c.f. linux-os.c.
+ * Should we have a reusable function gc_install_interrupt_handlers? */
#ifdef LISP_FEATURE_SB_THREAD
-# ifndef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+# ifdef LISP_FEATURE_SB_THRUPTION
+ undoably_install_low_level_interrupt_handler(SIGPIPE, thruption_handler);
+# endif
+# else
undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
sig_stop_for_gc_handler);
# endif
bind_variable(GC_SAFE,NIL,th);
bind_variable(IN_SAFEPOINT,NIL,th);
#endif
+#ifdef LISP_FEATURE_SB_THRUPTION
+ bind_variable(THRUPTION_PENDING,NIL,th);
+ bind_variable(RESTART_CLUSTERS,NIL,th);
+#endif
#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
access_control_stack_pointer(th)=th->control_stack_start;
#endif
#endif
}
+int
+wake_thread(os_thread_t os_thread)
+{
+#ifdef LISP_FEATURE_WIN32
+# define SIGPIPE 1
+#endif
+#if !defined(LISP_FEATURE_SB_THRUPTION) || defined(LISP_FEATURE_WIN32)
+ return kill_safely(os_thread, SIGPIPE);
+#else
+ return wake_thread_posix(os_thread);
+#endif
+}
+
/* If the thread id given does not belong to a running thread (it has
* exited or never even existed) pthread_kill _may_ fail with ESRCH,
* but it is also allowed to just segfault, see
* (NPTL recycles them extremely fast) so a signal can be sent to
* another process if the one it was sent to exited.
*
- * We send signals in two places: signal_interrupt_thread sends a
- * signal that's harmless if delivered to another thread, but
- * SIG_STOP_FOR_GC is fatal.
- *
* For these reasons, we must make sure that the thread is still alive
* when the pthread_kill is called and return if the thread is
- * exiting. */
+ * exiting.
+ *
+ * Note (DFL, 2011-06-22): At the time of writing, this function is only
+ * used for INTERRUPT-THREAD, hence the wake_thread special-case for
+ * Windows is OK. */
int
kill_safely(os_thread_t os_thread, int signal)
{
#ifdef LISP_FEATURE_SB_SAFEPOINT
void thread_in_safety_transition(os_context_t *ctx);
void thread_in_lisp_raised(os_context_t *ctx);
+void thread_interrupted(os_context_t *ctx);
void thread_pitstop(os_context_t *ctxptr);
extern void thread_register_gc_trigger();
+# ifdef LISP_FEATURE_SB_THRUPTION
+int wake_thread(os_thread_t os_thread);
+int wake_thread_posix(os_thread_t os_thread);
+# endif
+
#define thread_qrl(th) (&(th)->nonpointer_data->qrl_lock)
static inline
#define WITH_STATE_SEM(thread) \
WITH_STATE_SEM_hygenic(sbcl__state_sem, thread)
+int check_pending_thruptions(os_context_t *ctx);
+
#endif
extern boolean is_some_thread_local_addr(os_vm_address_t addr);
(push (lambda ()
(setq receivedp t))
(sb-thread::thread-interruptions sb-thread:*current-thread*))
+ #+sb-thruption
+ ;; On sb-thruption builds, the usual resignalling of SIGPIPE will
+ ;; work without problems, but the signal handler won't ordinarily
+ ;; think that there's anything to be done. Since we're poking at
+ ;; INTERRUPT-THREAD internals anyway, let's help it along.
+ (setf sb-unix::*thruption-pending* t)
(kill-non-lisp-thread)
(sleep 1)
(assert receivedp)))
projects / sbcl.git / commitdiff