1.0.29.32: SCRUB-CONTROL-STACK related changes
[sbcl.git] / src / runtime / interrupt.c
index 305f75f..294fc64 100644 (file)
 #include "globals.h"
 #include "lispregs.h"
 #include "validate.h"
+#include "interr.h"
 #include "gc.h"
 #include "alloc.h"
 #include "dynbind.h"
-#include "interr.h"
 #include "pseudo-atomic.h"
 #include "genesis/fdefn.h"
 #include "genesis/simple-fun.h"
 #include "genesis/cons.h"
 
+/* When we catch an internal error, should we pass it back to Lisp to
+ * be handled in a high-level way? (Early in cold init, the answer is
+ * 'no', because Lisp is still too brain-dead to handle anything.
+ * After sufficient initialization has been completed, the answer
+ * becomes 'yes'.) */
+boolean internal_errors_enabled = 0;
+
+#ifndef LISP_FEATURE_WIN32
+static
+void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, os_context_t*);
+#endif
+union interrupt_handler interrupt_handlers[NSIG];
+
 /* Under Linux on some architectures, we appear to have to restore the
  * FPU control word from the context, as after the signal is delivered
  * we appear to have a null FPU control word. */
     os_context_t *context = arch_os_get_context(&void_context);
 #endif
 
+/* Foreign code may want to start some threads on its own.
+ * Non-targetted, truly asynchronous signals can be delivered to
+ * basically any thread, but invoking Lisp handlers in such foregign
+ * threads is really bad, so let's resignal it.
+ *
+ * This should at least bring attention to the problem, but it cannot
+ * work for SIGSEGV and similar. It is good enough for timers, and
+ * maybe all deferrables. */
+
+#ifdef LISP_FEATURE_SB_THREAD
+static void
+add_handled_signals(sigset_t *sigset)
+{
+    int i;
+    for(i = 1; i < NSIG; i++) {
+        if (!(ARE_SAME_HANDLER(interrupt_low_level_handlers[i], SIG_DFL)) ||
+            !(ARE_SAME_HANDLER(interrupt_handlers[i].c, SIG_DFL))) {
+            sigaddset(sigset, i);
+        }
+    }
+}
+
+void block_signals(sigset_t *what, sigset_t *where, sigset_t *old);
+#endif
+
+static boolean
+maybe_resignal_to_lisp_thread(int signal, os_context_t *context)
+{
+#ifdef LISP_FEATURE_SB_THREAD
+    if (!pthread_getspecific(lisp_thread)) {
+        if (!(sigismember(&deferrable_sigset,signal))) {
+            corruption_warning_and_maybe_lose
+                ("Received signal %d in non-lisp thread %lu, resignalling to a lisp thread.",
+                 signal,
+                 pthread_self());
+        }
+        {
+            sigset_t sigset;
+            sigemptyset(&sigset);
+            add_handled_signals(&sigset);
+            block_signals(&sigset, 0, 0);
+            block_signals(&sigset, os_context_sigmask_addr(context), 0);
+            kill(getpid(), signal);
+        }
+        return 1;
+    } else
+#endif
+        return 0;
+}
+
 /* These are to be used in signal handlers. Currently all handlers are
  * called from one of:
  *
  * kernel properly, so we fix it up ourselves in the
  * arch_os_get_context(..) function. -- CSR, 2002-07-23
  */
-#define SAVE_ERRNO(context,void_context)                        \
+#define SAVE_ERRNO(signal,context,void_context)                 \
     {                                                           \
         int _saved_errno = errno;                               \
         RESTORE_FP_CONTROL_WORD(context,void_context);          \
+        if (!maybe_resignal_to_lisp_thread(signal, context))    \
         {
 
 #define RESTORE_ERRNO                                           \
@@ -116,15 +180,95 @@ static void store_signal_data_for_later (struct interrupt_data *data,
                                          void *handler, int signal,
                                          siginfo_t *info,
                                          os_context_t *context);
+\f
 
-static void
-fill_current_sigmask(sigset_t *sigset)
+/* Generic signal related utilities. */
+
+void
+get_current_sigmask(sigset_t *sigset)
 {
     /* Get the current sigmask, by blocking the empty set. */
-    sigset_t empty;
-    sigemptyset(&empty);
-    thread_sigmask(SIG_BLOCK, &empty, sigset);
+    thread_sigmask(SIG_BLOCK, 0, sigset);
+}
+
+void
+block_signals(sigset_t *what, sigset_t *where, sigset_t *old)
+{
+    if (where) {
+        int i;
+        if (old)
+            sigcopyset(old, where);
+        for(i = 1; i < NSIG; i++) {
+            if (sigismember(what, i))
+                sigaddset(where, i);
+        }
+    } else {
+        thread_sigmask(SIG_BLOCK, what, old);
+    }
+}
+
+void
+unblock_signals(sigset_t *what, sigset_t *where, sigset_t *old)
+{
+    if (where) {
+        int i;
+        if (old)
+            sigcopyset(old, where);
+        for(i = 1; i < NSIG; i++) {
+            if (sigismember(what, i))
+                sigdelset(where, i);
+        }
+    } else {
+        thread_sigmask(SIG_UNBLOCK, what, old);
+    }
+}
+
+static void
+print_sigset(sigset_t *sigset)
+{
+  int i;
+  for(i = 1; i < NSIG; i++) {
+    if (sigismember(sigset, i))
+      fprintf(stderr, "Signal %d masked\n", i);
+  }
+}
+
+/* Return 1 is all signals is sigset2 are masked in sigset, return 0
+ * if all re unmasked else die. Passing NULL for sigset is a shorthand
+ * for the current sigmask. */
+boolean
+all_signals_blocked_p(sigset_t *sigset, sigset_t *sigset2,
+                                const char *name)
+{
+#if !defined(LISP_FEATURE_WIN32)
+    int i;
+    boolean has_blocked = 0, has_unblocked = 0;
+    sigset_t current;
+    if (sigset == 0) {
+        get_current_sigmask(&current);
+        sigset = &current;
+    }
+    for(i = 1; i < NSIG; i++) {
+        if (sigismember(sigset2, i)) {
+            if (sigismember(sigset, i))
+                has_blocked = 1;
+            else
+                has_unblocked = 1;
+        }
+    }
+    if (has_blocked && has_unblocked) {
+        print_sigset(sigset);
+        lose("some %s signals blocked, some unblocked\n", name);
+    }
+    if (has_blocked)
+        return 1;
+    else
+        return 0;
+#endif
 }
+\f
+
+/* Deferrables, blockables, gc signals. */
 
 void
 sigaddset_deferrable(sigset_t *s)
@@ -149,27 +293,6 @@ sigaddset_deferrable(sigset_t *s)
 }
 
 void
-sigdelset_deferrable(sigset_t *s)
-{
-    sigdelset(s, SIGHUP);
-    sigdelset(s, SIGINT);
-    sigdelset(s, SIGQUIT);
-    sigdelset(s, SIGPIPE);
-    sigdelset(s, SIGALRM);
-    sigdelset(s, SIGURG);
-    sigdelset(s, SIGTSTP);
-    sigdelset(s, SIGCHLD);
-    sigdelset(s, SIGIO);
-#ifndef LISP_FEATURE_HPUX
-    sigdelset(s, SIGXCPU);
-    sigdelset(s, SIGXFSZ);
-#endif
-    sigdelset(s, SIGVTALRM);
-    sigdelset(s, SIGPROF);
-    sigdelset(s, SIGWINCH);
-}
-
-void
 sigaddset_blockable(sigset_t *sigset)
 {
     sigaddset_deferrable(sigset);
@@ -184,113 +307,161 @@ sigaddset_gc(sigset_t *sigset)
 #endif
 }
 
-void
-sigdelset_gc(sigset_t *sigset)
-{
-#ifdef LISP_FEATURE_SB_THREAD
-    sigdelset(sigset,SIG_STOP_FOR_GC);
-#endif
-}
-
 /* initialized in interrupt_init */
 sigset_t deferrable_sigset;
 sigset_t blockable_sigset;
 sigset_t gc_sigset;
+
 #endif
 
+#if !defined(LISP_FEATURE_WIN32)
 boolean
-deferrables_blocked_in_sigset_p(sigset_t *sigset)
+deferrables_blocked_p(sigset_t *sigset)
+{
+    return all_signals_blocked_p(sigset, &deferrable_sigset, "deferrable");
+}
+#endif
+
+void
+check_deferrables_unblocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    int i;
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&deferrable_sigset, i) && sigismember(sigset, i))
-            return 1;
-    }
+    if (deferrables_blocked_p(sigset))
+        lose("deferrables blocked\n");
 #endif
-    return 0;
 }
 
 void
-check_deferrables_unblocked_in_sigset_or_lose(sigset_t *sigset)
+check_deferrables_blocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    int i;
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&deferrable_sigset, i) && sigismember(sigset, i))
-            lose("deferrable signal %d blocked\n",i);
-    }
+    if (!deferrables_blocked_p(sigset))
+        lose("deferrables unblocked\n");
 #endif
 }
 
+#if !defined(LISP_FEATURE_WIN32)
+boolean
+blockables_blocked_p(sigset_t *sigset)
+{
+    return all_signals_blocked_p(sigset, &blockable_sigset, "blockable");
+}
+#endif
+
 void
-check_deferrables_blocked_in_sigset_or_lose(sigset_t *sigset)
+check_blockables_unblocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    int i;
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&deferrable_sigset, i) && !sigismember(sigset, i))
-            lose("deferrable signal %d not blocked\n",i);
-    }
+    if (blockables_blocked_p(sigset))
+        lose("blockables blocked\n");
 #endif
 }
 
 void
-check_deferrables_unblocked_or_lose(void)
+check_blockables_blocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    sigset_t current;
-    fill_current_sigmask(&current);
-    check_deferrables_unblocked_in_sigset_or_lose(&current);
+    if (!blockables_blocked_p(sigset))
+        lose("blockables unblocked\n");
 #endif
 }
 
+#if !defined(LISP_FEATURE_WIN32)
+boolean
+gc_signals_blocked_p(sigset_t *sigset)
+{
+    return all_signals_blocked_p(sigset, &gc_sigset, "gc");
+}
+#endif
+
 void
-check_deferrables_blocked_or_lose(void)
+check_gc_signals_unblocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    sigset_t current;
-    fill_current_sigmask(&current);
-    check_deferrables_blocked_in_sigset_or_lose(&current);
+    if (gc_signals_blocked_p(sigset))
+        lose("gc signals blocked\n");
 #endif
 }
 
 void
-check_blockables_blocked_or_lose(void)
+check_gc_signals_blocked_or_lose(sigset_t *sigset)
 {
 #if !defined(LISP_FEATURE_WIN32)
-    sigset_t current;
-    int i;
-    fill_current_sigmask(&current);
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&blockable_sigset, i) && !sigismember(&current, i))
-            lose("blockable signal %d not blocked\n",i);
-    }
+    if (!gc_signals_blocked_p(sigset))
+        lose("gc signals unblocked\n");
 #endif
 }
 
 void
-check_gc_signals_unblocked_in_sigset_or_lose(sigset_t *sigset)
+block_deferrable_signals(sigset_t *where, sigset_t *old)
 {
-#if !defined(LISP_FEATURE_WIN32)
-    int i;
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&gc_sigset, i) && sigismember(sigset, i))
-            lose("gc signal %d blocked\n",i);
-    }
+#ifndef LISP_FEATURE_WIN32
+    block_signals(&deferrable_sigset, where, old);
 #endif
 }
 
 void
-check_gc_signals_unblocked_or_lose(void)
+block_blockable_signals(sigset_t *where, sigset_t *old)
 {
-#if !defined(LISP_FEATURE_WIN32)
-    sigset_t current;
-    fill_current_sigmask(&current);
-    check_gc_signals_unblocked_in_sigset_or_lose(&current);
+#ifndef LISP_FEATURE_WIN32
+    block_signals(&blockable_sigset, where, old);
+#endif
+}
+
+void
+block_gc_signals(sigset_t *where, sigset_t *old)
+{
+#ifndef LISP_FEATURE_WIN32
+    block_signals(&gc_sigset, where, old);
+#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");
+    check_gc_signals_unblocked_or_lose(where);
+    unblock_signals(&deferrable_sigset, where, old);
+#endif
+}
+
+void
+unblock_blockable_signals(sigset_t *where, sigset_t *old)
+{
+#ifndef LISP_FEATURE_WIN32
+    unblock_signals(&blockable_sigset, where, old);
 #endif
 }
 
+void
+unblock_gc_signals(sigset_t *where, sigset_t *old)
+{
+#ifndef LISP_FEATURE_WIN32
+    unblock_signals(&gc_sigset, where, old);
+#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);
+    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\
+gc deadlocks. Since GC signals are only blocked in signal handlers when \n\
+they are not safe to interrupt at all, this is a pretty severe occurrence.\n");
+        unblock_gc_signals(sigset, 0);
+    }
+    if (!interrupt_handler_pending_p()) {
+        unblock_deferrable_signals(sigset, 0);
+    }
+#endif
+}
+\f
+
 inline static void
 check_interrupts_enabled_or_lose(os_context_t *context)
 {
@@ -315,7 +486,7 @@ maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
     sigset_t oldset;
     /* Obviously, this function is called when signals may not be
      * blocked. Let's make sure we are not interrupted. */
-    thread_sigmask(SIG_BLOCK, &blockable_sigset, &oldset);
+    block_blockable_signals(0, &oldset);
 #ifndef LISP_FEATURE_SB_THREAD
     /* With threads a SIG_STOP_FOR_GC and a normal GC may also want to
      * block. */
@@ -337,7 +508,7 @@ maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
              * unblock gc signals. In the end, this is equivalent to
              * blocking the deferrables. */
             sigcopyset(&data->pending_mask, &oldset);
-            unblock_gc_signals();
+            thread_sigmask(SIG_UNBLOCK, &gc_sigset, 0);
             return;
         }
     }
@@ -397,7 +568,14 @@ check_interrupt_context_or_lose(os_context_t *context)
         if (stop_for_gc_pending)
             if (!(pseudo_atomic_interrupted || gc_inhibit || in_race_p))
                 lose("STOP_FOR_GC_PENDING, but why?\n");
+        if (pseudo_atomic_interrupted)
+            if (!(gc_pending || stop_for_gc_pending || interrupt_deferred_p))
+                lose("pseudo_atomic_interrupted, but why?\n");
     }
+#else
+    if (pseudo_atomic_interrupted)
+        if (!(gc_pending || interrupt_deferred_p))
+            lose("pseudo_atomic_interrupted, but why?\n");
 #endif
 #endif
     if (interrupt_pending && !interrupt_deferred_p)
@@ -405,102 +583,18 @@ check_interrupt_context_or_lose(os_context_t *context)
     if ((data->gc_blocked_deferrables) && interrupt_pending)
         lose("gc_blocked_deferrables and interrupt pending\n.");
     if (data->gc_blocked_deferrables)
-        check_deferrables_blocked_in_sigset_or_lose(sigset);
+        check_deferrables_blocked_or_lose(sigset);
     if (interrupt_pending || interrupt_deferred_p ||
         data->gc_blocked_deferrables)
-        check_deferrables_blocked_in_sigset_or_lose(sigset);
+        check_deferrables_blocked_or_lose(sigset);
     else {
-        check_deferrables_unblocked_in_sigset_or_lose(sigset);
+        check_deferrables_unblocked_or_lose(sigset);
         /* If deferrables are unblocked then we are open to signals
          * that run lisp code. */
-        check_gc_signals_unblocked_in_sigset_or_lose(sigset);
-    }
-#endif
-}
-
-/* When we catch an internal error, should we pass it back to Lisp to
- * be handled in a high-level way? (Early in cold init, the answer is
- * 'no', because Lisp is still too brain-dead to handle anything.
- * After sufficient initialization has been completed, the answer
- * becomes 'yes'.) */
-boolean internal_errors_enabled = 0;
-
-#ifndef LISP_FEATURE_WIN32
-static
-void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, os_context_t*);
-#endif
-union interrupt_handler interrupt_handlers[NSIG];
-
-void
-block_blockable_signals(void)
-{
-#ifndef LISP_FEATURE_WIN32
-    thread_sigmask(SIG_BLOCK, &blockable_sigset, 0);
-#endif
-}
-
-void
-block_deferrable_signals(void)
-{
-#ifndef LISP_FEATURE_WIN32
-    thread_sigmask(SIG_BLOCK, &deferrable_sigset, 0);
-#endif
-}
-
-void
-unblock_deferrable_signals_in_sigset(sigset_t *sigset)
-{
-#ifndef LISP_FEATURE_WIN32
-    if (interrupt_handler_pending_p())
-        lose("unblock_deferrable_signals_in_sigset: losing proposition\n");
-    check_gc_signals_unblocked_in_sigset_or_lose(sigset);
-    sigdelset_deferrable(sigset);
-#endif
-}
-
-void
-unblock_deferrable_signals(void)
-{
-#ifndef LISP_FEATURE_WIN32
-    if (interrupt_handler_pending_p())
-        lose("unblock_deferrable_signals: losing proposition\n");
-    check_gc_signals_unblocked_or_lose();
-    thread_sigmask(SIG_UNBLOCK, &deferrable_sigset, 0);
-#endif
-}
-
-void
-unblock_gc_signals(void)
-{
-#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_WIN32)
-    thread_sigmask(SIG_UNBLOCK,&gc_sigset,0);
-#endif
-}
-
-void
-unblock_signals_in_context_and_maybe_warn(os_context_t *context)
-{
-#ifndef LISP_FEATURE_WIN32
-    int i, oops=0;
-    sigset_t *sigset=os_context_sigmask_addr(context);
-    for(i = 1; i < NSIG; i++) {
-        if (sigismember(&gc_sigset, i) && sigismember(sigset, i)) {
-            if (!oops) {
-                fprintf(stderr,
-"Enabling blocked gc signals to allow returning to Lisp without risking\n\
-gc deadlocks. Since GC signals are only blocked in signal handlers when \n\
-they are not safe to interrupt at all, this is a pretty severe occurrence.\n");
-            }
-            oops=1;
-        }
-    }
-    sigdelset_gc(sigset);
-    if (!interrupt_handler_pending_p()) {
-        unblock_deferrable_signals_in_sigset(sigset);
+        check_gc_signals_unblocked_or_lose(sigset);
     }
 #endif
 }
-
 \f
 /*
  * utility routines used by various signal handlers
@@ -568,7 +662,7 @@ fake_foreign_function_call(os_context_t *context)
     struct thread *thread=arch_os_get_current_thread();
 
     /* context_index incrementing must not be interrupted */
-    check_blockables_blocked_or_lose();
+    check_blockables_blocked_or_lose(0);
 
     /* Get current Lisp state from context. */
 #ifdef reg_ALLOC
@@ -624,7 +718,7 @@ undo_fake_foreign_function_call(os_context_t *context)
 {
     struct thread *thread=arch_os_get_current_thread();
     /* Block all blockable signals. */
-    block_blockable_signals();
+    block_blockable_signals(0, 0);
 
 #ifdef FOREIGN_FUNCTION_CALL_FLAG
     foreign_function_call_active = 0;
@@ -665,7 +759,7 @@ interrupt_internal_error(os_context_t *context, boolean continuable)
 
     /* Allocate the SAP object while the interrupts are still
      * disabled. */
-    unblock_gc_signals();
+    unblock_gc_signals(0, 0);
     context_sap = alloc_sap(context);
 
 #ifndef LISP_FEATURE_WIN32
@@ -725,12 +819,12 @@ interrupt_handle_pending(os_context_t *context)
     struct interrupt_data *data = thread->interrupt_data;
 
     if (arch_pseudo_atomic_atomic(context)) {
-        lose("Handling pending interrupt in pseduo atomic.");
+        lose("Handling pending interrupt in pseudo atomic.");
     }
 
     FSHOW_SIGNAL((stderr, "/entering interrupt_handle_pending\n"));
 
-    check_blockables_blocked_or_lose();
+    check_blockables_blocked_or_lose(0);
 
     /* If GC/SIG_STOP_FOR_GC struck during PA and there was no pending
      * handler, then the pending mask was saved and
@@ -810,7 +904,7 @@ interrupt_handle_pending(os_context_t *context)
             lose("Trapping to run pending handler while GC in progress.");
         }
 
-        check_blockables_blocked_or_lose();
+        check_blockables_blocked_or_lose(0);
 
         /* No GC shall be lost. If SUB_GC triggers another GC then
          * that should be handled on the spot. */
@@ -845,11 +939,15 @@ interrupt_handle_pending(os_context_t *context)
         sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
         run_deferred_handler(data, context);
     }
+#endif
+#ifdef LISP_FEATURE_GENCGC
+    if (get_pseudo_atomic_interrupted(thread))
+        lose("pseudo_atomic_interrupted after interrupt_handle_pending\n");
+#endif
     /* It is possible that the end of this function was reached
      * without never actually doing anything, the tests in Lisp for
      * when to call receive-pending-interrupt are not exact. */
     FSHOW_SIGNAL((stderr, "/exiting interrupt_handle_pending\n"));
-#endif
 }
 \f
 
@@ -861,7 +959,7 @@ interrupt_handle_now(int signal, siginfo_t *info, os_context_t *context)
 #endif
     union interrupt_handler handler;
 
-    check_blockables_blocked_or_lose();
+    check_blockables_blocked_or_lose(0);
 
 #ifndef LISP_FEATURE_WIN32
     if (sigismember(&deferrable_sigset,signal))
@@ -912,7 +1010,7 @@ interrupt_handle_now(int signal, siginfo_t *info, os_context_t *context)
         lispobj info_sap, context_sap;
         /* Leave deferrable signals blocked, the handler itself will
          * allow signals again when it sees fit. */
-        unblock_gc_signals();
+        unblock_gc_signals(0, 0);
         context_sap = alloc_sap(context);
         info_sap = alloc_sap(info);
 
@@ -973,7 +1071,7 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
 {
     struct thread *thread=arch_os_get_current_thread();
 
-    check_blockables_blocked_or_lose();
+    check_blockables_blocked_or_lose(0);
 
     if (SymbolValue(INTERRUPT_PENDING,thread) != NIL)
         lose("interrupt already pending\n");
@@ -992,12 +1090,12 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
      */
     if ((SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) ||
         in_leaving_without_gcing_race_p(thread)) {
-        store_signal_data_for_later(data,handler,signal,info,context);
-        SetSymbolValue(INTERRUPT_PENDING, T,thread);
         FSHOW_SIGNAL((stderr,
                       "/maybe_defer_handler(%x,%d): deferred (RACE=%d)\n",
                       (unsigned int)handler,signal,
                       in_leaving_without_gcing_race_p(thread)));
+        store_signal_data_for_later(data,handler,signal,info,context);
+        SetSymbolValue(INTERRUPT_PENDING, T,thread);
         check_interrupt_context_or_lose(context);
         return 1;
     }
@@ -1005,11 +1103,11 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
      * actually use its argument for anything on x86, so this branch
      * may succeed even when context is null (gencgc alloc()) */
     if (arch_pseudo_atomic_atomic(context)) {
-        store_signal_data_for_later(data,handler,signal,info,context);
-        arch_set_pseudo_atomic_interrupted(context);
         FSHOW_SIGNAL((stderr,
                       "/maybe_defer_handler(%x,%d): deferred(PA)\n",
                       (unsigned int)handler,signal));
+        store_signal_data_for_later(data,handler,signal,info,context);
+        arch_set_pseudo_atomic_interrupted(context);
         check_interrupt_context_or_lose(context);
         return 1;
     }
@@ -1052,10 +1150,9 @@ store_signal_data_for_later (struct interrupt_data *data, void *handler,
 static void
 maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
     struct thread *thread = arch_os_get_current_thread();
     struct interrupt_data *data = thread->interrupt_data;
-
     if(!maybe_defer_handler(interrupt_handle_now,data,signal,info,context))
         interrupt_handle_now(signal, info, context);
     RESTORE_ERRNO;
@@ -1066,7 +1163,7 @@ low_level_interrupt_handle_now(int signal, siginfo_t *info,
                                os_context_t *context)
 {
     /* No FP control fixage needed, caller has done that. */
-    check_blockables_blocked_or_lose();
+    check_blockables_blocked_or_lose(0);
     check_interrupts_enabled_or_lose(context);
     (*interrupt_low_level_handlers[signal])(signal, info, context);
     /* No Darwin context fixage needed, caller does that. */
@@ -1075,7 +1172,7 @@ low_level_interrupt_handle_now(int signal, siginfo_t *info,
 static void
 low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
     struct thread *thread = arch_os_get_current_thread();
     struct interrupt_data *data = thread->interrupt_data;
 
@@ -1093,20 +1190,19 @@ void
 sig_stop_for_gc_handler(int signal, siginfo_t *info, os_context_t *context)
 {
     struct thread *thread=arch_os_get_current_thread();
-    sigset_t ss;
 
     /* Test for GC_INHIBIT _first_, else we'd trap on every single
      * pseudo atomic until gc is finally allowed. */
     if (SymbolValue(GC_INHIBIT,thread) != NIL) {
-        SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
         FSHOW_SIGNAL((stderr, "sig_stop_for_gc deferred (*GC-INHIBIT*)\n"));
+        SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
         return;
     } else if (arch_pseudo_atomic_atomic(context)) {
+        FSHOW_SIGNAL((stderr,"sig_stop_for_gc deferred (PA)\n"));
         SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
         arch_set_pseudo_atomic_interrupted(context);
         maybe_save_gc_mask_and_block_deferrables
             (os_context_sigmask_addr(context));
-        FSHOW_SIGNAL((stderr,"sig_stop_for_gc deferred (PA)\n"));
         return;
     }
 
@@ -1117,14 +1213,27 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, os_context_t *context)
     /* need the context stored so it can have registers scavenged */
     fake_foreign_function_call(context);
 
-    /* Block everything. */
-    sigfillset(&ss);
-    thread_sigmask(SIG_BLOCK,&ss,0);
-
     /* Not pending anymore. */
     SetSymbolValue(GC_PENDING,NIL,thread);
     SetSymbolValue(STOP_FOR_GC_PENDING,NIL,thread);
 
+    /* Consider this: in a PA section GC is requested: GC_PENDING,
+     * pseudo_atomic_interrupted and gc_blocked_deferrables are set,
+     * deferrables are blocked then pseudo_atomic_atomic is cleared,
+     * but a SIG_STOP_FOR_GC arrives before trapping to
+     * interrupt_handle_pending. Here, GC_PENDING is cleared but
+     * pseudo_atomic_interrupted is not and we go on running with
+     * pseudo_atomic_interrupted but without a pending interrupt or
+     * GC. GC_BLOCKED_DEFERRABLES is also left at 1. So let's tidy it
+     * up. */
+    if (thread->interrupt_data->gc_blocked_deferrables) {
+        FSHOW_SIGNAL((stderr,"cleaning up after gc_blocked_deferrables\n"));
+        clear_pseudo_atomic_interrupted(thread);
+        sigcopyset(os_context_sigmask_addr(context),
+                   &thread->interrupt_data->pending_mask);
+        thread->interrupt_data->gc_blocked_deferrables = 0;
+    }
+
     if(thread_state(thread)!=STATE_RUNNING) {
         lose("sig_stop_for_gc_handler: wrong thread state: %ld\n",
              fixnum_value(thread->state));
@@ -1133,6 +1242,12 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, os_context_t *context)
     set_thread_state(thread,STATE_SUSPENDED);
     FSHOW_SIGNAL((stderr,"suspended\n"));
 
+    /* While waiting for gc to finish occupy ourselves with zeroing
+     * the unused portion of the control stack to reduce conservatism.
+     * On hypothetic platforms with threads and exact gc it is
+     * actually a must. */
+    scrub_control_stack();
+
     wait_for_thread_state_change(thread, STATE_SUSPENDED);
     FSHOW_SIGNAL((stderr,"resumed\n"));
 
@@ -1149,7 +1264,7 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, os_context_t *context)
 void
 interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
 #ifndef LISP_FEATURE_WIN32
     if ((signal == SIGILL) || (signal == SIGBUS)
 #ifndef LISP_FEATURE_LINUX
@@ -1178,7 +1293,7 @@ void
 arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 {
 #ifndef LISP_FEATURE_WIN32
-    check_gc_signals_unblocked_in_sigset_or_lose
+    check_gc_signals_unblocked_or_lose
         (os_context_sigmask_addr(context));
 #endif
 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
@@ -1370,22 +1485,40 @@ undefined_alien_function(void)
     funcall0(StaticSymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
 }
 
+/* Called from the REPL, too. */
+void reset_control_stack_guard_page(void)
+{
+    struct thread *th=arch_os_get_current_thread();
+    if (th->control_stack_guard_page_protected == NIL) {
+        memset(CONTROL_STACK_GUARD_PAGE(th), 0, os_vm_page_size);
+        protect_control_stack_guard_page(1, NULL);
+        protect_control_stack_return_guard_page(0, NULL);
+        th->control_stack_guard_page_protected = T;
+        fprintf(stderr, "INFO: Control stack guard page reprotected\n");
+    }
+}
+
 boolean
 handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
 {
     struct thread *th=arch_os_get_current_thread();
 
-    /* note the os_context hackery here.  When the signal handler returns,
-     * it won't go back to what it was doing ... */
-    if(addr >= CONTROL_STACK_GUARD_PAGE(th) &&
-       addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) {
+    if(addr >= CONTROL_STACK_HARD_GUARD_PAGE(th) &&
+       addr < CONTROL_STACK_HARD_GUARD_PAGE(th) + os_vm_page_size) {
+        lose("Control stack exhausted");
+    }
+    else if(addr >= CONTROL_STACK_GUARD_PAGE(th) &&
+            addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) {
         /* We hit the end of the control stack: disable guard page
          * protection so the error handler has some headroom, protect the
          * previous page so that we can catch returns from the guard page
          * and restore it. */
-        corruption_warning_and_maybe_lose("Control stack exhausted");
+        if (th->control_stack_guard_page_protected == NIL)
+            lose("control_stack_guard_page_protected NIL");
         protect_control_stack_guard_page(0, NULL);
         protect_control_stack_return_guard_page(1, NULL);
+        th->control_stack_guard_page_protected = NIL;
+        fprintf(stderr, "INFO: Control stack guard page unprotected\n");
 
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
         /* For the unfortunate case, when the control stack is
@@ -1402,16 +1535,20 @@ handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
          * unprotect this one. This works even if we somehow missed
          * the return-guard-page, and hit it on our way to new
          * exhaustion instead. */
-        fprintf(stderr, "INFO: Control stack guard page reprotected\n");
-        protect_control_stack_guard_page(1, NULL);
-        protect_control_stack_return_guard_page(0, NULL);
+        if (th->control_stack_guard_page_protected != NIL)
+            lose("control_stack_guard_page_protected not NIL");
+        reset_control_stack_guard_page();
         return 1;
     }
+    else if(addr >= BINDING_STACK_HARD_GUARD_PAGE(th) &&
+            addr < BINDING_STACK_HARD_GUARD_PAGE(th) + os_vm_page_size) {
+        lose("Binding stack exhausted");
+    }
     else if(addr >= BINDING_STACK_GUARD_PAGE(th) &&
             addr < BINDING_STACK_GUARD_PAGE(th) + os_vm_page_size) {
-        corruption_warning_and_maybe_lose("Binding stack exhausted");
         protect_binding_stack_guard_page(0, NULL);
         protect_binding_stack_return_guard_page(1, NULL);
+        fprintf(stderr, "INFO: Binding stack guard page unprotected\n");
 
         /* For the unfortunate case, when the binding stack is
          * exhausted in a signal handler. */
@@ -1422,16 +1559,20 @@ handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
     }
     else if(addr >= BINDING_STACK_RETURN_GUARD_PAGE(th) &&
             addr < BINDING_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
-        fprintf(stderr, "INFO: Binding stack guard page reprotected\n");
         protect_binding_stack_guard_page(1, NULL);
         protect_binding_stack_return_guard_page(0, NULL);
+        fprintf(stderr, "INFO: Binding stack guard page reprotected\n");
         return 1;
     }
+    else if(addr >= ALIEN_STACK_HARD_GUARD_PAGE(th) &&
+            addr < ALIEN_STACK_HARD_GUARD_PAGE(th) + os_vm_page_size) {
+        lose("Alien stack exhausted");
+    }
     else if(addr >= ALIEN_STACK_GUARD_PAGE(th) &&
             addr < ALIEN_STACK_GUARD_PAGE(th) + os_vm_page_size) {
-        corruption_warning_and_maybe_lose("Alien stack exhausted");
         protect_alien_stack_guard_page(0, NULL);
         protect_alien_stack_return_guard_page(1, NULL);
+        fprintf(stderr, "INFO: Alien stack guard page unprotected\n");
 
         /* For the unfortunate case, when the alien stack is
          * exhausted in a signal handler. */
@@ -1442,15 +1583,15 @@ handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
     }
     else if(addr >= ALIEN_STACK_RETURN_GUARD_PAGE(th) &&
             addr < ALIEN_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
-        fprintf(stderr, "INFO: Alien stack guard page reprotected\n");
         protect_alien_stack_guard_page(1, NULL);
         protect_alien_stack_return_guard_page(0, NULL);
+        fprintf(stderr, "INFO: Alien stack guard page reprotected\n");
         return 1;
     }
     else if (addr >= undefined_alien_address &&
              addr < undefined_alien_address + os_vm_page_size) {
         arrange_return_to_lisp_function
-          (context, StaticSymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
+            (context, StaticSymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
         return 1;
     }
     else return 0;
@@ -1482,10 +1623,9 @@ static volatile int sigaction_nodefer_works = -1;
 static void
 sigaction_nodefer_test_handler(int signal, siginfo_t *info, void *void_context)
 {
-    sigset_t empty, current;
+    sigset_t current;
     int i;
-    sigemptyset(&empty);
-    thread_sigmask(SIG_BLOCK, &empty, &current);
+    get_current_sigmask(&current);
     /* There should be exactly two blocked signals: the two we added
      * to sa_mask when setting up the handler.  NetBSD doesn't block
      * the signal we're handling when SA_NODEFER is set; Linux before
@@ -1529,7 +1669,7 @@ see_if_sigaction_nodefer_works(void)
 static void
 unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
     sigset_t unblock;
 
     sigemptyset(&unblock);
@@ -1542,7 +1682,7 @@ unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
 static void
 low_level_unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
     sigset_t unblock;
 
     sigemptyset(&unblock);
@@ -1555,7 +1695,7 @@ low_level_unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
 static void
 low_level_handle_now_handler(int signal, siginfo_t *info, void *void_context)
 {
-    SAVE_ERRNO(context,void_context);
+    SAVE_ERRNO(signal,context,void_context);
     (*interrupt_low_level_handlers[signal])(signal, info, context);
     RESTORE_ERRNO;
 }
@@ -1600,12 +1740,12 @@ install_handler(int signal, void handler(int, siginfo_t*, os_context_t*))
 {
 #ifndef LISP_FEATURE_WIN32
     struct sigaction sa;
-    sigset_t old, new;
+    sigset_t old;
     union interrupt_handler oldhandler;
 
     FSHOW((stderr, "/entering POSIX install_handler(%d, ..)\n", signal));
 
-    thread_sigmask(SIG_BLOCK, &blockable_sigset, &old);
+    block_blockable_signals(0, &old);
 
     FSHOW((stderr, "/interrupt_low_level_handlers[signal]=%x\n",
            (unsigned int)interrupt_low_level_handlers[signal]));
@@ -1696,7 +1836,15 @@ lisp_memory_fault_error(os_context_t *context, os_vm_address_t addr)
     */
     current_memory_fault_address = addr;
     /* To allow debugging memory faults in signal handlers and such. */
-    corruption_warning_and_maybe_lose("Memory fault at %x", addr);
+    corruption_warning_and_maybe_lose("Memory fault at %x (pc=%p, sp=%p)",
+                                      addr,
+                                      *os_context_pc_addr(context),
+#ifdef ARCH_HAS_STACK_POINTER
+                                      *os_context_sp_addr(context)
+#else
+                                      0
+#endif
+                                      );
     unblock_signals_in_context_and_maybe_warn(context);
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
     arrange_return_to_lisp_function(context,
@@ -1712,7 +1860,7 @@ unhandled_trap_error(os_context_t *context)
 {
     lispobj context_sap;
     fake_foreign_function_call(context);
-    unblock_gc_signals();
+    unblock_gc_signals(0, 0);
     context_sap = alloc_sap(context);
 #ifndef LISP_FEATURE_WIN32
     thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);