void
sigaddset_gc(sigset_t *sigset)
{
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
sigaddset(sigset,SIG_STOP_FOR_GC);
#endif
}
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
#if !defined(LISP_FEATURE_WIN32)
boolean
gc_signals_blocked_p(sigset_t *sigset)
lose("gc signals unblocked\n");
#endif
}
+#endif
void
block_deferrable_signals(sigset_t *where, sigset_t *old)
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
block_gc_signals(sigset_t *where, sigset_t *old)
{
block_signals(&gc_sigset, where, old);
#endif
}
+#endif
void
unblock_deferrable_signals(sigset_t *where, sigset_t *old)
#ifndef LISP_FEATURE_WIN32
if (interrupt_handler_pending_p())
lose("unblock_deferrable_signals: losing proposition\n");
+#ifndef LISP_FEATURE_SB_SAFEPOINT
check_gc_signals_unblocked_or_lose(where);
+#endif
unblock_signals(&deferrable_sigset, where, old);
#endif
}
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
unblock_gc_signals(sigset_t *where, sigset_t *old)
{
unblock_signals(&gc_sigset, where, old);
#endif
}
+#endif
void
unblock_signals_in_context_and_maybe_warn(os_context_t *context)
{
#ifndef LISP_FEATURE_WIN32
sigset_t *sigset = os_context_sigmask_addr(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
if (all_signals_blocked_p(sigset, &gc_sigset, "gc")) {
corruption_warning_and_maybe_lose(
"Enabling blocked gc signals to allow returning to Lisp without risking\n\
they are not safe to interrupt at all, this is a pretty severe occurrence.\n");
unblock_gc_signals(sigset, 0);
}
+#endif
if (!interrupt_handler_pending_p()) {
unblock_deferrable_signals(sigset, 0);
}
* The purpose is to avoid losing the pending gc signal if a
* deferrable interrupt async unwinds between clearing the pseudo
* atomic and trapping to GC.*/
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
{
thread_sigmask(SIG_SETMASK,&oldset,0);
#endif
}
+#endif
/* Are we leaving WITH-GCING and already running with interrupts
* enabled, without the protection of *GC-INHIBIT* T and there is gc
check_deferrables_blocked_or_lose(sigset);
else {
check_deferrables_unblocked_or_lose(sigset);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
/* If deferrables are unblocked then we are open to signals
* that run lisp code. */
check_gc_signals_unblocked_or_lose(sigset);
+#endif
}
#endif
}
/* Build a fake stack frame or frames */
- current_control_frame_pointer =
+ access_control_frame_pointer(th) =
(lispobj *)(unsigned long)
(*os_context_register_addr(context, reg_CSP));
if ((lispobj *)(unsigned long)
(*os_context_register_addr(context, reg_CFP))
- == current_control_frame_pointer) {
+ == access_control_frame_pointer(th)) {
/* There is a small window during call where the callee's
* frame isn't built yet. */
if (lowtag_of(*os_context_register_addr(context, reg_CODE))
== FUN_POINTER_LOWTAG) {
/* We have called, but not built the new frame, so
* build it for them. */
- current_control_frame_pointer[0] =
+ access_control_frame_pointer(th)[0] =
*os_context_register_addr(context, reg_OCFP);
- current_control_frame_pointer[1] =
+ access_control_frame_pointer(th)[1] =
*os_context_register_addr(context, reg_LRA);
- current_control_frame_pointer += 8;
+ access_control_frame_pointer(th) += 8;
/* Build our frame on top of it. */
oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
}
oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
}
- current_control_stack_pointer = current_control_frame_pointer + 8;
+ access_control_stack_pointer(th) = access_control_frame_pointer(th) + 8;
- current_control_frame_pointer[0] = oldcont;
- current_control_frame_pointer[1] = NIL;
- current_control_frame_pointer[2] =
+ access_control_frame_pointer(th)[0] = oldcont;
+ access_control_frame_pointer(th)[1] = NIL;
+ access_control_frame_pointer(th)[2] =
(lispobj)(*os_context_register_addr(context, reg_CODE));
#endif
}
/* Get current Lisp state from context. */
#ifdef reg_ALLOC
+#ifdef LISP_FEATURE_SB_THREAD
+ thread->pseudo_atomic_bits =
+#else
dynamic_space_free_pointer =
(lispobj *)(unsigned long)
+#endif
(*os_context_register_addr(context, reg_ALLOC));
/* fprintf(stderr,"dynamic_space_free_pointer: %p\n", */
/* dynamic_space_free_pointer); */
#endif
#endif
#ifdef reg_BSP
- current_binding_stack_pointer =
- (lispobj *)(unsigned long)
- (*os_context_register_addr(context, reg_BSP));
+ set_binding_stack_pointer(thread,
+ *os_context_register_addr(context, reg_BSP));
#endif
build_fake_control_stack_frames(thread,context);
thread->interrupt_contexts[context_index] = context;
-#ifdef FOREIGN_FUNCTION_CALL_FLAG
- foreign_function_call_active = 1;
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+ /* x86oid targets don't maintain the foreign function call flag at
+ * all, so leave them to believe that they are never in foreign
+ * code. */
+ foreign_function_call_active_p(thread) = 1;
#endif
}
/* Block all blockable signals. */
block_blockable_signals(0, 0);
-#ifdef FOREIGN_FUNCTION_CALL_FLAG
- foreign_function_call_active = 0;
-#endif
+ foreign_function_call_active_p(thread) = 0;
/* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
unbind(thread);
-#ifdef reg_ALLOC
+#if defined(reg_ALLOC) && !defined(LISP_FEATURE_SB_THREAD)
/* Put the dynamic space free pointer back into the context. */
*os_context_register_addr(context, reg_ALLOC) =
(unsigned long) dynamic_space_free_pointer
| ((unsigned long) dynamic_space_free_pointer & LOWTAG_MASK);
*/
#endif
+#if defined(reg_ALLOC) && defined(LISP_FEATURE_SB_THREAD)
+ /* Put the pseudo-atomic bits and dynamic space free pointer back
+ * into the context (p-a-bits for p-a, and dynamic space free
+ * pointer for ROOM). */
+ *os_context_register_addr(context, reg_ALLOC) =
+ (unsigned long) dynamic_space_free_pointer
+ | (thread->pseudo_atomic_bits & LOWTAG_MASK);
+ /* And clear them so we don't get bit later by call-in/call-out
+ * not updating them. */
+ thread->pseudo_atomic_bits = 0;
+#endif
}
/* a handler for the signal caused by execution of a trap opcode
/* Allocate the SAP object while the interrupts are still
* disabled. */
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
#ifndef LISP_FEATURE_WIN32
* 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;
FSHOW_SIGNAL((stderr, "/entering interrupt_handle_pending\n"));
check_blockables_blocked_or_lose(0);
-
+#ifndef LISP_FEATURE_SB_SAFEPOINT
+ /*
+ * (On safepoint builds, there is no gc_blocked_deferrables nor
+ * SIG_STOP_FOR_GC.)
+ */
/* If GC/SIG_STOP_FOR_GC struck during PA and there was no pending
* handler, then the pending mask was saved and
* gc_blocked_deferrables set. Hence, there can be no pending
#endif
data->gc_blocked_deferrables = 0;
}
+#endif
if (SymbolValue(GC_INHIBIT,thread)==NIL) {
void *original_pending_handler = data->pending_handler;
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* 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
* the signal handler if it actually stops us. */
* that should be handled on the spot. */
if (SymbolValue(GC_PENDING,thread) != NIL)
lose("GC_PENDING after doing gc.");
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL)
lose("STOP_FOR_GC_PENDING after doing gc.");
#endif
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))
void
interrupt_handle_now(int signal, siginfo_t *info, os_context_t *context)
{
-#ifdef FOREIGN_FUNCTION_CALL_FLAG
boolean were_in_lisp;
-#endif
union interrupt_handler handler;
check_blockables_blocked_or_lose(0);
return;
}
-#ifdef FOREIGN_FUNCTION_CALL_FLAG
- were_in_lisp = !foreign_function_call_active;
+ were_in_lisp = !foreign_function_call_active_p(arch_os_get_current_thread());
if (were_in_lisp)
-#endif
{
fake_foreign_function_call(context);
}
lispobj info_sap, context_sap;
/* Leave deferrable signals blocked, the handler itself will
* allow signals again when it sees fit. */
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
info_sap = alloc_sap(info);
FSHOW_SIGNAL((stderr,"/calling Lisp-level handler\n"));
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ WITH_GC_AT_SAFEPOINTS_ONLY()
+#endif
funcall3(handler.lisp,
make_fixnum(signal),
info_sap,
(*handler.c)(signal, info, context);
}
-#ifdef FOREIGN_FUNCTION_CALL_FLAG
if (were_in_lisp)
-#endif
{
undo_fake_foreign_function_call(context); /* block signals again */
}
}
#endif
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
/* This function must not cons, because that may trigger a GC. */
void
sig_stop_for_gc_handler(int signal, siginfo_t *info, os_context_t *context)
{
struct thread *thread=arch_os_get_current_thread();
+ boolean was_in_lisp;
/* Test for GC_INHIBIT _first_, else we'd trap on every single
* pseudo atomic until gc is finally allowed. */
/* Not PA and GC not inhibited -- we can stop now. */
- /* need the context stored so it can have registers scavenged */
- fake_foreign_function_call(context);
+ was_in_lisp = !foreign_function_call_active_p(arch_os_get_current_thread());
+
+ if (was_in_lisp) {
+ /* need the context stored so it can have registers scavenged */
+ fake_foreign_function_call(context);
+ }
/* Not pending anymore. */
SetSymbolValue(GC_PENDING,NIL,thread);
fixnum_value(thread->state));
}
- set_thread_state(thread,STATE_SUSPENDED);
+ set_thread_state(thread,STATE_STOPPED);
FSHOW_SIGNAL((stderr,"suspended\n"));
/* While waiting for gc to finish occupy ourselves with zeroing
* actually a must. */
scrub_control_stack();
- wait_for_thread_state_change(thread, STATE_SUSPENDED);
+ wait_for_thread_state_change(thread, STATE_STOPPED);
FSHOW_SIGNAL((stderr,"resumed\n"));
if(thread_state(thread)!=STATE_RUNNING) {
fixnum_value(thread_state(thread)));
}
- undo_fake_foreign_function_call(context);
+ if (was_in_lisp) {
+ undo_fake_foreign_function_call(context);
+ }
}
#endif
extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
extern void post_signal_tramp(void);
extern void call_into_lisp_tramp(void);
+
void
-arrange_return_to_lisp_function(os_context_t *context, lispobj function)
+arrange_return_to_c_function(os_context_t *context,
+ call_into_lisp_lookalike funptr,
+ lispobj function)
{
-#ifndef LISP_FEATURE_WIN32
+#if !(defined(LISP_FEATURE_WIN32) || defined(LISP_FEATURE_SB_SAFEPOINT))
check_gc_signals_unblocked_or_lose
(os_context_sigmask_addr(context));
#endif
*(register_save_area + 8) = *context_eflags_addr(context);
*os_context_pc_addr(context) =
- (os_context_register_t) call_into_lisp_tramp;
+ (os_context_register_t) funptr;
*os_context_register_addr(context,reg_ECX) =
(os_context_register_t) register_save_area;
#else
#ifdef LISP_FEATURE_X86
#if !defined(LISP_FEATURE_DARWIN)
- *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
+ *os_context_pc_addr(context) = (os_context_register_t)funptr;
*os_context_register_addr(context,reg_ECX) = 0;
*os_context_register_addr(context,reg_EBP) = (os_context_register_t)(sp-2);
#ifdef __NetBSD__
#endif /* LISP_FEATURE_DARWIN */
#elif defined(LISP_FEATURE_X86_64)
- *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
+ *os_context_pc_addr(context) = (os_context_register_t)funptr;
*os_context_register_addr(context,reg_RCX) = 0;
*os_context_register_addr(context,reg_RBP) = (os_context_register_t)(sp-2);
*os_context_register_addr(context,reg_RSP) = (os_context_register_t)(sp-18);
*os_context_register_addr(context,reg_LIP) =
(os_context_register_t)(unsigned long)code;
*os_context_register_addr(context,reg_CFP) =
- (os_context_register_t)(unsigned long)current_control_frame_pointer;
+ (os_context_register_t)(unsigned long)access_control_frame_pointer(th);
#endif
#ifdef ARCH_HAS_NPC_REGISTER
*os_context_npc_addr(context) =
(long)function));
}
+void
+arrange_return_to_lisp_function(os_context_t *context, lispobj function)
+{
+#if defined(LISP_FEATURE_DARWIN) && defined(LISP_FEATURE_X86)
+ arrange_return_to_c_function(context, call_into_lisp_tramp, function);
+#else
+ arrange_return_to_c_function(context, call_into_lisp, function);
+#endif
+}
+
/* KLUDGE: Theoretically the approach we use for undefined alien
* variables should work for functions as well, but on PPC/Darwin
* we get bus error at bogus addresses instead, hence this workaround,
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);
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
- if((signal==SIG_MEMORY_FAULT))
+ if(signal==SIG_MEMORY_FAULT) {
sa.sa_flags |= SA_ONSTACK;
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ sigaddset(&sa.sa_mask, SIGRTMIN);
+ sigaddset(&sa.sa_mask, SIGRTMIN+1);
+# endif
+ }
#endif
sigaction(signal, &sa, NULL);
{
lispobj context_sap;
fake_foreign_function_call(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
#ifndef LISP_FEATURE_WIN32
thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
arch_handle_single_step_trap(context, trap);
break;
#endif
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ case trap_GlobalSafepoint:
+ fake_foreign_function_call(context);
+ thread_in_lisp_raised(context);
+ undo_fake_foreign_function_call(context);
+ arch_skip_instruction(context);
+ break;
+ case trap_CspSafepoint:
+ fake_foreign_function_call(context);
+ thread_in_safety_transition(context);
+ undo_fake_foreign_function_call(context);
+ arch_skip_instruction(context);
+ break;
+#endif
case trap_Halt:
fake_foreign_function_call(context);
lose("%%PRIMITIVE HALT called; the party is over.\n");
projects / sbcl.git / blobdiff