0.9.0.8:
[sbcl.git] / src / runtime / interrupt.c
index cb5fcaf..1578aca 100644 (file)
  * files for more information.
  */
 
-#include <stdio.h>
 
+/* As far as I can tell, what's going on here is:
+ *
+ * In the case of most signals, when Lisp asks us to handle the
+ * signal, the outermost handler (the one actually passed to UNIX) is
+ * either interrupt_handle_now(..) or maybe_now_maybe_later(..).
+ * In that case, the Lisp-level handler is stored in interrupt_handlers[..]
+ * and interrupt_low_level_handlers[..] is cleared.
+ *
+ * However, some signals need special handling, e.g. 
+ *
+ * o the SIGSEGV (for e.g. Linux) or SIGBUS (for e.g. FreeBSD) used by the
+ *   garbage collector to detect violations of write protection,
+ *   because some cases of such signals (e.g. GC-related violations of
+ *   write protection) are handled at C level and never passed on to
+ *   Lisp. For such signals, we still store any Lisp-level handler
+ *   in interrupt_handlers[..], but for the outermost handle we use
+ *   the value from interrupt_low_level_handlers[..], instead of the
+ *   ordinary interrupt_handle_now(..) or interrupt_handle_later(..).
+ *
+ * o the SIGTRAP (Linux/Alpha) which Lisp code uses to handle breakpoints,
+ *   pseudo-atomic sections, and some classes of error (e.g. "function
+ *   not defined").  This never goes anywhere near the Lisp handlers at all.
+ *   See runtime/alpha-arch.c and code/signal.lisp 
+ * 
+ * - WHN 20000728, dan 20010128 */
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
 #include <signal.h>
-#ifdef mach /* KLUDGE: #ifdef on lowercase symbols? Ick. -- WHN 19990904 */
-#ifdef mips
-#include <mips/cpu.h>
-#endif
-#endif
+#include <sys/types.h>
+#include <sys/wait.h>
 
+#include "sbcl.h"
 #include "runtime.h"
 #include "arch.h"
-#include "sbcl.h"
 #include "os.h"
 #include "interrupt.h"
 #include "globals.h"
 #include "alloc.h"
 #include "dynbind.h"
 #include "interr.h"
+#include "genesis/fdefn.h"
+#include "genesis/simple-fun.h"
+
+
+
+void run_deferred_handler(struct interrupt_data *data, void *v_context) ;
+static void store_signal_data_for_later (struct interrupt_data *data, 
+                                        void *handler, int signal,
+                                        siginfo_t *info, 
+                                        os_context_t *context);
+boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context);
+
+extern volatile lispobj all_threads_lock;
+
+/*
+ * This is a workaround for some slightly silly Linux/GNU Libc
+ * behaviour: glibc defines sigset_t to support 1024 signals, which is
+ * more than the kernel.  This is usually not a problem, but becomes
+ * one when we want to save a signal mask from a ucontext, and restore
+ * it later into another ucontext: the ucontext is allocated on the
+ * stack by the kernel, so copying a libc-sized sigset_t into it will
+ * overflow and cause other data on the stack to be corrupted */
+
+#define REAL_SIGSET_SIZE_BYTES ((NSIG/8))
 
 void sigaddset_blockable(sigset_t *s)
 {
@@ -44,6 +94,7 @@ void sigaddset_blockable(sigset_t *s)
     sigaddset(s, SIGPIPE);
     sigaddset(s, SIGALRM);
     sigaddset(s, SIGURG);
+    sigaddset(s, SIGFPE);
     sigaddset(s, SIGTSTP);
     sigaddset(s, SIGCHLD);
     sigaddset(s, SIGIO);
@@ -54,6 +105,10 @@ void sigaddset_blockable(sigset_t *s)
     sigaddset(s, SIGWINCH);
     sigaddset(s, SIGUSR1);
     sigaddset(s, SIGUSR2);
+#ifdef LISP_FEATURE_SB_THREAD
+    sigaddset(s, SIG_STOP_FOR_GC);
+    sigaddset(s, SIG_INTERRUPT_THREAD);
+#endif
 }
 
 /* When we catch an internal error, should we pass it back to Lisp to
@@ -63,84 +118,43 @@ void sigaddset_blockable(sigset_t *s)
  * becomes 'yes'.) */
 boolean internal_errors_enabled = 0;
 
-os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
+struct interrupt_data * global_interrupt_data;
 
-/* As far as I can tell, what's going on here is:
- *
- * In the case of most signals, when Lisp asks us to handle the
- * signal, the outermost handler (the one actually passed to UNIX) is
- * either interrupt_handle_now(..) or interrupt_handle_later(..).
- * In that case, the Lisp-level handler is stored in interrupt_handlers[..]
- * and interrupt_low_level_handlers[..] is cleared.
- *
- * However, some signals need special handling, e.g. 
- *
- * o the SIGSEGV (for e.g. Linux) or SIGBUS (for e.g. FreeBSD) used by the
- *   garbage collector to detect violations of write protection,
- *   because some cases of such signals (e.g. GC-related violations of
- *   write protection) are handled at C level and never passed on to
- *   Lisp. For such signals, we still store any Lisp-level handler
- *   in interrupt_handlers[..], but for the outermost handle we use
- *   the value from interrupt_low_level_handlers[..], instead of the
- *   ordinary interrupt_handle_now(..) or interrupt_handle_later(..).
- *
- * o the SIGTRAP (Linux/Alpha) which Lisp code uses to handle breakpoints,
- *   pseudo-atomic sections, and some classes of error (e.g. "function
- *   not defined").  This never goes anywhere near the Lisp handlers at all.
- *   See runtime/alpha-arch.c and code/signal.lisp 
- * 
- * - WHN 20000728, dan 20010128 */
+/* At the toplevel repl we routinely call this function.  The signal
+ * mask ought to be clear anyway most of the time, but may be non-zero
+ * if we were interrupted e.g. while waiting for a queue.  */
 
+void reset_signal_mask () 
+{
+    sigset_t new;
+    sigemptyset(&new);
+    sigprocmask(SIG_SETMASK,&new,0);
+}
 
-void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*) = {0};
-union interrupt_handler interrupt_handlers[NSIG];
 
-/* signal number, siginfo_t, and old mask information for pending signal
- *
- * pending_signal=0 when there is no pending signal. */
-static int pending_signal = 0;
-static siginfo_t pending_info;
-static sigset_t pending_mask;
 
-static boolean maybe_gc_pending = 0;
 \f
 /*
  * utility routines used by various signal handlers
  */
 
-void
-fake_foreign_function_call(os_context_t *context)
+void 
+build_fake_control_stack_frames(struct thread *th,os_context_t *context)
 {
-    int context_index;
-#ifndef __i386__
+#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+    
     lispobj oldcont;
-#endif
 
-    /* Get current Lisp state from context. */
-#ifdef reg_ALLOC
-    dynamic_space_free_pointer =
-       (lispobj *)(*os_context_register_addr(context, reg_ALLOC));
-#ifdef alpha
-    if ((long)dynamic_space_free_pointer & 1) {
-       lose("dead in fake_foreign_function_call, context = %x", context);
-    }
-#endif
-#endif
-#ifdef reg_BSP
-    current_binding_stack_pointer =
-       (lispobj *)(*os_context_register_addr(context, reg_BSP));
-#endif
+    /* Build a fake stack frame or frames */
 
-#ifndef __i386__
-    /* Build a fake stack frame. */
     current_control_frame_pointer =
        (lispobj *)(*os_context_register_addr(context, reg_CSP));
     if ((lispobj *)(*os_context_register_addr(context, reg_CFP))
        == current_control_frame_pointer) {
         /* There is a small window during call where the callee's
          * frame isn't built yet. */
-        if (LowtagOf(*os_context_register_addr(context, reg_CODE))
-           == type_FunctionPointer) {
+        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] =
@@ -157,9 +171,10 @@ fake_foreign_function_call(os_context_t *context)
             oldcont = (lispobj)(*os_context_register_addr(context, reg_OCFP));
         }
     }
-    /* ### We can't tell whether we are still in the caller if it had
-     * to reg_ALLOCate the stack frame due to stack arguments. */
-    /* ### Can anything strange happen during return? */
+    /* We can't tell whether we are still in the caller if it had to
+     * allocate a stack frame due to stack arguments. */
+    /* This observation provoked some past CMUCL maintainer to ask
+     * "Can anything strange happen during return?" */
     else {
         /* normal case */
         oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
@@ -172,32 +187,57 @@ fake_foreign_function_call(os_context_t *context)
     current_control_frame_pointer[2] =
        (lispobj)(*os_context_register_addr(context, reg_CODE));
 #endif
+}
+
+void
+fake_foreign_function_call(os_context_t *context)
+{
+    int context_index;
+    struct thread *thread=arch_os_get_current_thread();
+
+    /* Get current Lisp state from context. */
+#ifdef reg_ALLOC
+    dynamic_space_free_pointer =
+       (lispobj *)(*os_context_register_addr(context, reg_ALLOC));
+#if defined(LISP_FEATURE_ALPHA)
+    if ((long)dynamic_space_free_pointer & 1) {
+       lose("dead in fake_foreign_function_call, context = %x", context);
+    }
+#endif
+#endif
+#ifdef reg_BSP
+    current_binding_stack_pointer =
+       (lispobj *)(*os_context_register_addr(context, reg_BSP));
+#endif
+
+    build_fake_control_stack_frames(thread,context);
 
     /* Do dynamic binding of the active interrupt context index
      * and save the context in the context array. */
-    context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
-    /* FIXME: Ick! Why use abstract "make_fixnum" in some places if
-     * you're going to convert from fixnum by bare >>2 in other
-     * places? Use fixnum_value(..) here, and look for other places
-     * which do bare >> and << for fixnum_value and make_fixnum. */
-
+    context_index =
+       fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
+    
     if (context_index >= MAX_INTERRUPTS) {
-        lose("maximum interrupt nesting depth (%d) exceeded",
-            MAX_INTERRUPTS);
+        lose("maximum interrupt nesting depth (%d) exceeded", MAX_INTERRUPTS);
     }
 
     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
-                 make_fixnum(context_index + 1));
+                 make_fixnum(context_index + 1),thread);
 
-    lisp_interrupt_contexts[context_index] = context;
+    thread->interrupt_contexts[context_index] = context;
 
     /* no longer in Lisp now */
     foreign_function_call_active = 1;
 }
 
+/* blocks all blockable signals.  If you are calling from a signal handler,
+ * the usual signal mask will be restored from the context when the handler 
+ * finishes.  Otherwise, be careful */
+
 void
 undo_fake_foreign_function_call(os_context_t *context)
 {
+    struct thread *thread=arch_os_get_current_thread();
     /* Block all blockable signals. */
     sigset_t block;
     sigemptyset(&block);
@@ -207,13 +247,8 @@ undo_fake_foreign_function_call(os_context_t *context)
     /* going back into Lisp */
     foreign_function_call_active = 0;
 
-    /* Undo dynamic binding. */
-    /* ### Do I really need to unbind_to_here()? */
-    /* FIXME: Is this to undo the binding of
-     * FREE_INTERRUPT_CONTEXT_INDEX? If so, we should say so. And
-     * perhaps yes, unbind_to_here() really would be clearer and less
-     * fragile.. */
-    unbind();
+    /* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
+    unbind(thread);
 
 #ifdef reg_ALLOC
     /* Put the dynamic space free pointer back into the context. */
@@ -242,7 +277,7 @@ interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
 
     if (internal_errors_enabled) {
         SHOW("in interrupt_internal_error");
-#if QSHOW
+#ifdef QSHOW
        /* Display some rudimentary debugging information about the
         * error, so that even if the Lisp error handler gets badly
         * confused, we have a chance to determine what's going on. */
@@ -256,119 +291,77 @@ interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
         * before the Lisp error handling mechanism is set up. */
        lose("internal error too early in init, can't recover");
     }
-    undo_fake_foreign_function_call(context);
+    undo_fake_foreign_function_call(context); /* blocks signals again */
     if (continuable) {
        arch_skip_instruction(context);
     }
 }
 
-/* This function handles pending interrupts.  Note that in C/kernel
- * terms we dealt with the signal already; we just haven't decided
- * whether to call a Lisp handler or do a GC or something like that.
- * If it helps, you can think of pending_{signal,mask,info} as a
- * one-element queue of signals that we have acknowledged but not
- * processed */
-
 void
 interrupt_handle_pending(os_context_t *context)
 {
-#ifndef __i386__
-    boolean were_in_lisp = !foreign_function_call_active;
-#endif
-
-    SetSymbolValue(INTERRUPT_PENDING, NIL);
-
-    if (maybe_gc_pending) {
-       maybe_gc_pending = 0;
-#ifndef __i386__
-       if (were_in_lisp)
-#endif
-       {
-           fake_foreign_function_call(context);
-       }
-       funcall0(SymbolFunction(MAYBE_GC));
-#ifndef __i386__
-       if (were_in_lisp)
-#endif
-       {
-           undo_fake_foreign_function_call(context);
-        }
-    }
-
-    /* FIXME: This isn't very clear. It would be good to reverse
-     * engineer it and rewrite the code more clearly, or write a clear
-     * explanation of what's going on in the comments, or both.
-     *
-     * WHN's question 1a: How come we unconditionally copy from
-     * pending_mask into the context, and then test whether
-     * pending_signal is set?
-     * 
-     * WHN's question 1b: If pending_signal wasn't set, how could
-     * pending_mask be valid?
-     * 
-     * Dan Barlow's reply (sbcl-devel 2001-03-13): And the answer is -
-     * or appears to be - because interrupt_maybe_gc set it that way
-     * (look in the #ifndef __i386__ bit). We can't GC during a
-     * pseudo-atomic, so we set maybe_gc_pending=1 and
-     * arch_set_pseudo_atomic_interrupted(..) When we come out of
-     * pseudo_atomic we're marked as interrupted, so we call
-     * interrupt_handle_pending, which does the GC using the pending
-     * context (it needs a context so that it has registers to use as
-     * GC roots) then notices there's no actual interrupt handler to
-     * call, so doesn't. That's the second question [1b] answered,
-     * anyway. Why we still need to copy the pending_mask into the
-     * context given that we're now done with the context anyway, I
-     * couldn't say. */
-    memcpy(os_context_sigmask_addr(context), &pending_mask, sizeof(sigset_t));
-    sigemptyset(&pending_mask);
-    if (pending_signal) {
-       int signal = pending_signal;
-       siginfo_t info;
-       memcpy(&info, &pending_info, sizeof(siginfo_t));
-       pending_signal = 0;
-       interrupt_handle_now(signal, &info, context);
-    }
+    struct thread *thread;
+    struct interrupt_data *data;
+
+    thread=arch_os_get_current_thread();
+    data=thread->interrupt_data;
+    /* FIXME I'm not altogether sure this is appropriate if we're
+     * here as the result of a pseudo-atomic */
+    SetSymbolValue(INTERRUPT_PENDING, NIL,thread);
+
+    /* restore the saved signal mask from the original signal (the
+     * one that interrupted us during the critical section) into the
+     * os_context for the signal we're currently in the handler for.
+     * This should ensure that when we return from the handler the
+     * blocked signals are unblocked */
+
+    memcpy(os_context_sigmask_addr(context), &data->pending_mask, 
+          REAL_SIGSET_SIZE_BYTES);
+
+    sigemptyset(&data->pending_mask);
+    /* This will break on sparc linux: the deferred handler really wants
+     * to be called with a void_context */
+    run_deferred_handler(data,(void *)context);        
 }
 \f
 /*
  * the two main signal handlers:
  *   interrupt_handle_now(..)
  *   maybe_now_maybe_later(..)
+ *
+ * to which we have added interrupt_handle_now_handler(..).  Why?
+ * Well, mostly because the SPARC/Linux platform doesn't quite do
+ * signals the way we want them done.  The third argument in the
+ * handler isn't filled in by the kernel properly, so we fix it up
+ * ourselves in the arch_os_get_context(..) function; however, we only
+ * want to do this when we first hit the handler, and not when
+ * interrupt_handle_now(..) is being called from some other handler
+ * (when the fixup will already have been done). -- CSR, 2002-07-23
  */
 
 void
 interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 {
     os_context_t *context = (os_context_t*)void_context;
-#ifndef __i386__
+    struct thread *thread=arch_os_get_current_thread();
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
     boolean were_in_lisp;
 #endif
     union interrupt_handler handler;
 
-    /* FIXME: The CMU CL we forked off of had this Linux-only
-     * operation here. Newer CMU CLs (e.g. 18c) have hairier
-     * Linux/i386-only logic here. SBCL seems to be more reliable
-     * without anything here. However, if we start supporting code
-     * which sets the rounding mode, then we may want to do something
-     * special to force the rounding mode back to some standard value
-     * here, so that ISRs can have a standard environment. (OTOH, if
-     * rounding modes are under user control, then perhaps we should
-     * leave this up to the user.)
-     *
-     * In the absence of a test case to show that this is really a
-     * problem, we just suppress this code completely (just like the
-     * parallel code in maybe_now_maybe_later).
-     * #ifdef __linux__
-     *    SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
-     * #endif */
-
-    handler = interrupt_handlers[signal];
+#ifdef LISP_FEATURE_LINUX
+    /* 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_restore_fp_control(context);
+#endif 
+    handler = thread->interrupt_data->interrupt_handlers[signal];
 
     if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
        return;
     }
-
-#ifndef __i386__
+    
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
     were_in_lisp = !foreign_function_call_active;
     if (were_in_lisp)
 #endif
@@ -389,12 +382,19 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
         * support decides to pass on it. */
        lose("no handler for signal %d in interrupt_handle_now(..)", signal);
 
-    } else if (LowtagOf(handler.lisp) == type_FunctionPointer) {
+    } else if (lowtag_of(handler.lisp) == FUN_POINTER_LOWTAG) {
+       /* Once we've decided what to do about contexts in a 
+        * return-elsewhere world (the original context will no longer
+        * be available; should we copy it or was nobody using it anyway?)
+        * then we should convert this to return-elsewhere */
+
+        /* CMUCL comment said "Allocate the SAPs while the interrupts
+        * are still disabled.".  I (dan, 2003.08.21) assume this is 
+        * because we're not in pseudoatomic and allocation shouldn't
+        * be interrupted.  In which case it's no longer an issue as
+        * all our allocation from C now goes through a PA wrapper,
+        * but still, doesn't hurt */
 
-        /* Allocate the SAPs while the interrupts are still disabled.
-        * (FIXME: Why? This is the way it was done in CMU CL, and it
-        * even had the comment noting that this is the way it was
-        * done, but no motivation..) */
         lispobj info_sap,context_sap = alloc_sap(context);
         info_sap = alloc_sap(info);
         /* Allow signals again. */
@@ -420,11 +420,11 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
         (*handler.c)(signal, info, void_context);
     }
 
-#ifndef __i386__
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
     if (were_in_lisp)
 #endif
     {
-        undo_fake_foreign_function_call(context);
+        undo_fake_foreign_function_call(context); /* block signals again */
     }
 
 #ifdef QSHOW_SIGNALS
@@ -434,177 +434,406 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 #endif
 }
 
-static void
-maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
-{
-    os_context_t *context = (os_context_t*)void_context;
+/* This is called at the end of a critical section if the indications
+ * are that some signal was deferred during the section.  Note that as
+ * far as C or the kernel is concerned we dealt with the signal
+ * already; we're just doing the Lisp-level processing now that we
+ * put off then */
 
-    /* FIXME: See Debian cmucl 2.4.17, and mail from DTC on the CMU CL
-     * mailing list 23 Oct 1999, for changes in FPU handling at
-     * interrupt time which should be ported into SBCL. Also see the
-     * analogous logic at the head of interrupt_handle_now for
-     * more related FIXME stuff. 
-     *
-     * For now, we just suppress this code completely.
-     * #ifdef __linux__
-     *    SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
-     * #endif */
-
-    /* see comments at top of code/signal.lisp for what's going on here
-     * with INTERRUPTS_ENABLED/INTERRUPT_HANDLE_NOW 
-     */
-    if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
-
-       /* FIXME: This code is exactly the same as the code in the
-        * other leg of the if(..), and should be factored out into
-        * a shared function. */
-        pending_signal = signal;
-       memcpy(&pending_info, info, sizeof(siginfo_t));
-        memcpy(&pending_mask,
-              os_context_sigmask_addr(context),
-              sizeof(sigset_t));
-       sigaddset_blockable(os_context_sigmask_addr(context));
-        SetSymbolValue(INTERRUPT_PENDING, T);
+void
+run_deferred_handler(struct interrupt_data *data, void *v_context) {
+    (*(data->pending_handler))
+       (data->pending_signal,&(data->pending_info), v_context);
+    data->pending_handler=0;
+}
 
-    } else if (
-#ifndef __i386__
-              (!foreign_function_call_active) &&
+boolean
+maybe_defer_handler(void *handler, struct interrupt_data *data,
+                   int signal, siginfo_t *info, os_context_t *context)
+{
+    struct thread *thread=arch_os_get_current_thread();
+    if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
+       store_signal_data_for_later(data,handler,signal,info,context);
+        SetSymbolValue(INTERRUPT_PENDING, T,thread);
+       return 1;
+    } 
+    /* a slightly confusing test.  arch_pseudo_atomic_atomic() doesn't
+     * actually use its argument for anything on x86, so this branch
+     * may succeed even when context is null (gencgc alloc()) */
+    if (
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+       (!foreign_function_call_active) &&
 #endif
-              arch_pseudo_atomic_atomic(context)) {
-
-       /* FIXME: It would probably be good to replace these bare
-        * memcpy(..) calls with calls to cpy_siginfo_t and
-        * cpy_sigset_t, so that we only have to get the sizeof
-        * expressions right in one place, and after that static type
-        * checking takes over. */
-        pending_signal = signal;
-       memcpy(&pending_info, info, sizeof(siginfo_t));
-       memcpy(&pending_mask,
+       arch_pseudo_atomic_atomic(context)) {
+       store_signal_data_for_later(data,handler,signal,info,context);
+       arch_set_pseudo_atomic_interrupted(context);
+       return 1;
+    }
+    return 0;
+}
+static void
+store_signal_data_for_later (struct interrupt_data *data, void *handler,
+                            int signal, 
+                            siginfo_t *info, os_context_t *context)
+{
+    data->pending_handler = handler;
+    data->pending_signal = signal;
+    if(info)
+       memcpy(&(data->pending_info), info, sizeof(siginfo_t));
+    if(context) {
+       /* the signal mask in the context (from before we were
+        * interrupted) is copied to be restored when
+        * run_deferred_handler happens.  Then the usually-blocked
+        * signals are added to the mask in the context so that we are
+        * running with blocked signals when the handler returns */
+       sigemptyset(&(data->pending_mask));
+       memcpy(&(data->pending_mask),
               os_context_sigmask_addr(context),
-              sizeof(sigset_t));
+              REAL_SIGSET_SIZE_BYTES);
        sigaddset_blockable(os_context_sigmask_addr(context));
+    } else {
+       /* this is also called from gencgc alloc(), in which case
+        * there has been no signal and is therefore no context. */
+       sigset_t new;
+       sigemptyset(&new);
+       sigaddset_blockable(&new);
+       sigprocmask(SIG_BLOCK,&new,&(data->pending_mask));
+    }
+}
 
-       arch_set_pseudo_atomic_interrupted(context);
 
-    } else {
-        interrupt_handle_now(signal, info, context);
+static void
+maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
+{
+    os_context_t *context = arch_os_get_context(&void_context);
+    struct thread *thread=arch_os_get_current_thread();
+    struct interrupt_data *data=thread->interrupt_data;
+#ifdef LISP_FEATURE_LINUX
+    os_restore_fp_control(context);
+#endif 
+    if(maybe_defer_handler(interrupt_handle_now,data,
+                          signal,info,context))
+       return;
+    interrupt_handle_now(signal, info, context);
+#ifdef LISP_FEATURE_DARWIN
+    /* Work around G5 bug */
+    DARWIN_FIX_CONTEXT(context);
+#endif
+}
+
+#ifdef LISP_FEATURE_SB_THREAD
+void
+sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
+{
+    os_context_t *context = arch_os_get_context(&void_context);
+    struct thread *thread=arch_os_get_current_thread();
+    struct interrupt_data *data=thread->interrupt_data;
+    sigset_t ss;
+    int i;
+    
+    if(maybe_defer_handler(sig_stop_for_gc_handler,data,
+                          signal,info,context)) {
+       return;
     }
+    /* need the context stored so it can have registers scavenged */
+    fake_foreign_function_call(context); 
+
+    sigemptyset(&ss);
+    for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
+    sigprocmask(SIG_BLOCK,&ss,0);
+
+    /* The GC can't tell if a thread is a zombie, so this would be a
+     * good time to let the kernel reap any of our children in that
+     * awful state, to stop them from being waited for indefinitely.
+     * Userland reaping is done later when GC is finished  */
+    mark_dead_threads();
+
+    thread->state=STATE_STOPPED;
+
+    sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
+    sigwaitinfo(&ss,0);
+
+    undo_fake_foreign_function_call(context);
 }
-\f
+#endif
+
+void
+interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
+{
+    os_context_t *context = arch_os_get_context(&void_context);
+    interrupt_handle_now(signal, info, context);
+#ifdef LISP_FEATURE_DARWIN
+    DARWIN_FIX_CONTEXT(context);
+#endif
+}
+
 /*
  * stuff to detect and handle hitting the GC trigger
  */
 
-#ifndef INTERNAL_GC_TRIGGER
+#ifndef LISP_FEATURE_GENCGC 
+/* since GENCGC has its own way to record trigger */
 static boolean
 gc_trigger_hit(int signal, siginfo_t *info, os_context_t *context)
 {
     if (current_auto_gc_trigger == NULL)
        return 0;
     else{
-       lispobj *badaddr=(lispobj *)arch_get_bad_addr(signal,
-                                                     info,
-                                                     context);
+       void *badaddr=arch_get_bad_addr(signal,info,context);
+       return (badaddr >= (void *)current_auto_gc_trigger &&
+               badaddr <((void *)current_dynamic_space + DYNAMIC_SPACE_SIZE));
+    }
+}
+#endif
+
+/* manipulate the signal context and stack such that when the handler
+ * returns, it will call function instead of whatever it was doing
+ * previously
+ */
+
+extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
+extern void post_signal_tramp(void);
+void arrange_return_to_lisp_function(os_context_t *context, lispobj function)
+{
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
+    void * fun=native_pointer(function);
+    void *code = &(((struct simple_fun *) fun)->code);
+#endif    
+
+    /* Build a stack frame showing `interrupted' so that the
+     * user's backtrace makes (as much) sense (as usual) */
+#ifdef LISP_FEATURE_X86
+    /* Suppose the existence of some function that saved all
+     * registers, called call_into_lisp, then restored GP registers and
+     * returned.  It would look something like this:
+
+     push   ebp
+     mov    ebp esp
+     pushad
+     push   $0
+     push   $0
+     pushl  {address of function to call}
+     call   0x8058db0 <call_into_lisp>
+     addl   $12,%esp
+     popa
+     leave  
+     ret    
+
+     * What we do here is set up the stack that call_into_lisp would
+     * expect to see if it had been called by this code, and frob the
+     * signal context so that signal return goes directly to call_into_lisp,
+     * and when that function (and the lisp function it invoked) returns,
+     * it returns to the second half of this imaginary function which
+     * restores all registers and returns to C
+
+     * For this to work, the latter part of the imaginary function
+     * must obviously exist in reality.  That would be post_signal_tramp
+     */
+
+    u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP);
+
+    *(sp-14) = post_signal_tramp; /* return address for call_into_lisp */
+    *(sp-13) = function;        /* args for call_into_lisp : function*/
+    *(sp-12) = 0;              /*                           arg array */
+    *(sp-11) = 0;              /*                           no. args */
+    /* this order matches that used in POPAD */
+    *(sp-10)=*os_context_register_addr(context,reg_EDI);
+    *(sp-9)=*os_context_register_addr(context,reg_ESI);
+
+    *(sp-8)=*os_context_register_addr(context,reg_ESP)-8;
+    *(sp-7)=0;
+    *(sp-6)=*os_context_register_addr(context,reg_EBX);
+
+    *(sp-5)=*os_context_register_addr(context,reg_EDX);
+    *(sp-4)=*os_context_register_addr(context,reg_ECX);
+    *(sp-3)=*os_context_register_addr(context,reg_EAX);
+    *(sp-2)=*os_context_register_addr(context,reg_EBP);
+    *(sp-1)=*os_context_pc_addr(context);
+
+#elif defined(LISP_FEATURE_X86_64)
+    u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP);
+    *(sp-19) = post_signal_tramp;  /* return address for call_into_lisp */
+
+    *(sp-18)=*os_context_register_addr(context,reg_R15);
+    *(sp-17)=*os_context_register_addr(context,reg_R14);
+    *(sp-16)=*os_context_register_addr(context,reg_R13);
+    *(sp-15)=*os_context_register_addr(context,reg_R12);
+    *(sp-14)=*os_context_register_addr(context,reg_R11);
+    *(sp-13)=*os_context_register_addr(context,reg_R10);
+    *(sp-12)=*os_context_register_addr(context,reg_R9);
+    *(sp-11)=*os_context_register_addr(context,reg_R8);
+    *(sp-10)=*os_context_register_addr(context,reg_RDI);
+    *(sp-9)=*os_context_register_addr(context,reg_RSI);
+    *(sp-8)=*os_context_register_addr(context,reg_RSP)-16;
+    *(sp-7)=0;
+    *(sp-6)=*os_context_register_addr(context,reg_RBX);
+    *(sp-5)=*os_context_register_addr(context,reg_RDX);
+    *(sp-4)=*os_context_register_addr(context,reg_RCX);
+    *(sp-3)=*os_context_register_addr(context,reg_RAX);
+    *(sp-2)=*os_context_register_addr(context,reg_RBP);
+    *(sp-1)=*os_context_pc_addr(context);
+
+    *os_context_register_addr(context,reg_RDI) = function; /* function */
+    *os_context_register_addr(context,reg_RSI) = 0;        /* arg. array */
+    *os_context_register_addr(context,reg_RDX) = 0;        /* no. args */
+#else 
+    struct thread *th=arch_os_get_current_thread();
+    build_fake_control_stack_frames(th,context);
+#endif
 
-       return (badaddr >= current_auto_gc_trigger &&
-               badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE);
+#ifdef LISP_FEATURE_X86
+    *os_context_pc_addr(context) = call_into_lisp;
+    *os_context_register_addr(context,reg_ECX) = 0; 
+    *os_context_register_addr(context,reg_EBP) = sp-2;
+#ifdef __NetBSD__ 
+    *os_context_register_addr(context,reg_UESP) = sp-14;
+#else
+    *os_context_register_addr(context,reg_ESP) = sp-14;
+#endif
+#elif defined(LISP_FEATURE_X86_64)
+    *os_context_pc_addr(context) = call_into_lisp;
+    *os_context_register_addr(context,reg_RCX) = 0; 
+    *os_context_register_addr(context,reg_RBP) = sp-2;
+    *os_context_register_addr(context,reg_RSP) = sp-19;
+#else
+    /* this much of the calling convention is common to all
+       non-x86 ports */
+    *os_context_pc_addr(context) = code;
+    *os_context_register_addr(context,reg_NARGS) = 0; 
+    *os_context_register_addr(context,reg_LIP) = code;
+    *os_context_register_addr(context,reg_CFP) = 
+       current_control_frame_pointer;
+#endif
+#ifdef ARCH_HAS_NPC_REGISTER
+    *os_context_npc_addr(context) =
+       4 + *os_context_pc_addr(context);
+#endif
+#ifdef LISP_FEATURE_SPARC
+    *os_context_register_addr(context,reg_CODE) = 
+       fun + FUN_POINTER_LOWTAG;
+#endif
+}
+
+#ifdef LISP_FEATURE_SB_THREAD
+void interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
+{
+    os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
+    struct thread *th=arch_os_get_current_thread();
+    struct interrupt_data *data=
+       th ? th->interrupt_data : global_interrupt_data;
+    if(maybe_defer_handler(interrupt_thread_handler,data,num,info,context)){
+       return ;
     }
+    arrange_return_to_lisp_function(context,info->si_value.sival_int);
 }
+
+void thread_exit_handler(int num, siginfo_t *info, void *v_context)
+{   /* called when a child thread exits */
+    mark_dead_threads();
+}
+       
 #endif
 
-#ifndef __i386__
-/* This function gets called from the SIGSEGV (for e.g. Linux or
+/* 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,
+ * that has the added benefit of automatically discriminating between
+ * functions and variables. 
+ */
+void undefined_alien_function() {
+    funcall0(SymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
+}
+
+boolean handle_guard_page_triggered(os_context_t *context,void *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) {
+        /* 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. */
+        protect_control_stack_guard_page(th->pid,0);
+        protect_control_stack_return_guard_page(th->pid,1);
+        
+        arrange_return_to_lisp_function
+            (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
+        return 1;
+    }
+    else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) &&
+            addr < CONTROL_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
+        /* We're returning from the guard page: reprotect it, and
+         * unprotect this one. This works even if we somehow missed
+         * the return-guard-page, and hit it on our way to new
+         * exhaustion instead. */
+        protect_control_stack_guard_page(th->pid,1);
+        protect_control_stack_return_guard_page(th->pid,0);
+        return 1;
+    }
+    else if (addr >= undefined_alien_address &&
+            addr < undefined_alien_address + os_vm_page_size) {
+       arrange_return_to_lisp_function
+          (context, SymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
+       return 1;
+    }
+    else return 0;
+}
+
+#ifndef LISP_FEATURE_GENCGC
+/* This function gets called from the SIGSEGV (for e.g. Linux, NetBSD, &
  * OpenBSD) or SIGBUS (for e.g. FreeBSD) handler. Here we check
  * whether the signal was due to treading on the mprotect()ed zone -
  * and if so, arrange for a GC to happen. */
+extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
+
 boolean
 interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context)
 {
     os_context_t *context=(os_context_t *) void_context;
+    struct thread *th=arch_os_get_current_thread();
+    struct interrupt_data *data=
+       th ? th->interrupt_data : global_interrupt_data;
 
-    if (!foreign_function_call_active
-#ifndef INTERNAL_GC_TRIGGER
-       && gc_trigger_hit(signal, info, context)
-#endif
-       ) {
-#ifndef INTERNAL_GC_TRIGGER
+    if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){
        clear_auto_gc_trigger();
-#endif
-
-       if (arch_pseudo_atomic_atomic(context)) {
-           /* don't GC during an atomic operation.  Instead, copy the 
-            * signal mask somewhere safe.  interrupt_handle_pending
-            * will detect pending_signal==0 and know to do a GC with the
-            * signal context instead of calling a Lisp-level handler */
-           maybe_gc_pending = 1;
-           if (pending_signal == 0) {
-               /* FIXME: This copy-pending_mask-then-sigaddset_blockable
-                * idiom occurs over and over. It should be factored out
-                * into a function with a descriptive name. */
-               memcpy(&pending_mask,
-                      os_context_sigmask_addr(context),
-                      sizeof(sigset_t));
-               sigaddset_blockable(os_context_sigmask_addr(context));
-           }
-           arch_set_pseudo_atomic_interrupted(context);
-       }
-       else {
-           fake_foreign_function_call(context);
-           funcall0(SymbolFunction(MAYBE_GC));
-           undo_fake_foreign_function_call(context);
-       }
-
+       if(!maybe_defer_handler
+          (interrupt_maybe_gc_int,data,signal,info,void_context))
+           interrupt_maybe_gc_int(signal,info,void_context);
        return 1;
-    } else {
-       return 0;
     }
+    return 0;
 }
+
 #endif
+
+/* this is also used by gencgc, in alloc() */
+boolean
+interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context)
+{
+    sigset_t new;
+    os_context_t *context=(os_context_t *) void_context;
+    fake_foreign_function_call(context);
+    /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
+     * which case we will be running with no gc trigger barrier
+     * thing for a while.  But it shouldn't be long until the end
+     * of WITHOUT-GCING. */
+
+    sigemptyset(&new);
+    sigaddset_blockable(&new);
+    /* enable signals before calling into Lisp */
+    sigprocmask(SIG_UNBLOCK,&new,0);
+    funcall0(SymbolFunction(SUB_GC));
+    undo_fake_foreign_function_call(context);
+    return 1;
+}
+
 \f
 /*
  * noise to install handlers
  */
 
-/*
- * what low-level signal handlers looked like before
- * undoably_install_low_level_interrupt_handler() got involved
- */
-struct low_level_signal_handler_state {
-    int was_modified;
-    void (*handler)(int, siginfo_t*, void*);
-} old_low_level_signal_handler_states[NSIG];
-
-void
-uninstall_low_level_interrupt_handlers_atexit(void)
-{
-    int signal;
-    for (signal = 0; signal < NSIG; ++signal) {
-       struct low_level_signal_handler_state
-           *old_low_level_signal_handler_state =
-           old_low_level_signal_handler_states + signal;
-       if (old_low_level_signal_handler_state->was_modified) {
-           struct sigaction sa;
-           sa.sa_sigaction = old_low_level_signal_handler_state->handler;
-           sigemptyset(&sa.sa_mask);
-           sa.sa_flags = SA_SIGINFO | SA_RESTART; 
-           sigaction(signal, &sa, NULL);
-       }
-    }
-}
-
-/* Undoably install a special low-level handler for signal; or if
- * handler is SIG_DFL, remove any special handling for signal.
- *
- * The "undoably" aspect is because we also arrange with atexit() for
- * the handler to be restored to its old value. This is for tidiness:
- * it shouldn't matter much ordinarily, but it does remove a window
- * where e.g. memory fault signals (SIGSEGV or SIGBUS, which in
- * ordinary operation of SBCL are sent to the generational garbage
- * collector, then possibly onward to Lisp code) or SIGINT (which is
- * ordinarily passed to Lisp code) could otherwise be handled
- * bizarrely/brokenly because the Lisp code would try to deal with
- * them using machinery (like stream output buffers) which has already
- * been dismantled. */
 void
 undoably_install_low_level_interrupt_handler (int signal,
                                              void handler(int,
@@ -612,8 +841,9 @@ undoably_install_low_level_interrupt_handler (int signal,
                                                           void*))
 {
     struct sigaction sa;
-    struct low_level_signal_handler_state *old_low_level_signal_handler_state =
-       old_low_level_signal_handler_states + signal;
+    struct thread *th=arch_os_get_current_thread();
+    struct interrupt_data *data=
+       th ? th->interrupt_data : global_interrupt_data;
 
     if (0 > signal || signal >= NSIG) {
        lose("bad signal number %d", signal);
@@ -623,19 +853,18 @@ undoably_install_low_level_interrupt_handler (int signal,
     sigemptyset(&sa.sa_mask);
     sigaddset_blockable(&sa.sa_mask);
     sa.sa_flags = SA_SIGINFO | SA_RESTART;
-
-    /* In the case of interrupt handlers which are modified
-     * more than once, we only save the original unmodified
-     * copy. */
-    if (!old_low_level_signal_handler_state->was_modified) {
-       old_low_level_signal_handler_state->was_modified = 1;
-       sigaction(signal, &sa, &old_low_level_signal_handler_state->handler);
-    } else {
-       sigaction(signal, &sa, NULL);
-    }
-
-    interrupt_low_level_handlers[signal] =
-       (ARE_SAME_HANDLER(handler,SIG_DFL) ? 0 : handler);
+#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+    if((signal==SIG_MEMORY_FAULT) 
+#ifdef SIG_INTERRUPT_THREAD
+       || (signal==SIG_INTERRUPT_THREAD)
+#endif
+       )
+       sa.sa_flags|= SA_ONSTACK;
+#endif
+    
+    sigaction(signal, &sa, NULL);
+    data->interrupt_low_level_handlers[signal] =
+       (ARE_SAME_HANDLER(handler, SIG_DFL) ? 0 : handler);
 }
 
 /* This is called from Lisp. */
@@ -645,6 +874,9 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
     struct sigaction sa;
     sigset_t old, new;
     union interrupt_handler oldhandler;
+    struct thread *th=arch_os_get_current_thread();
+    struct interrupt_data *data=
+       th ? th->interrupt_data : global_interrupt_data;
 
     FSHOW((stderr, "/entering POSIX install_handler(%d, ..)\n", signal));
 
@@ -655,27 +887,26 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
     sigemptyset(&new);
     sigaddset_blockable(&new);
 
-    FSHOW((stderr, "/interrupt_low_level_handlers[signal]=%d\n",
-          interrupt_low_level_handlers[signal]));
-    if (interrupt_low_level_handlers[signal]==0) {
+    FSHOW((stderr, "/data->interrupt_low_level_handlers[signal]=%d\n",
+          data->interrupt_low_level_handlers[signal]));
+    if (data->interrupt_low_level_handlers[signal]==0) {
        if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
            ARE_SAME_HANDLER(handler, SIG_IGN)) {
            sa.sa_sigaction = handler;
        } else if (sigismember(&new, signal)) {
            sa.sa_sigaction = maybe_now_maybe_later;
        } else {
-           sa.sa_sigaction = interrupt_handle_now;
+           sa.sa_sigaction = interrupt_handle_now_handler;
        }
 
        sigemptyset(&sa.sa_mask);
        sigaddset_blockable(&sa.sa_mask);
        sa.sa_flags = SA_SIGINFO | SA_RESTART;
-
        sigaction(signal, &sa, NULL);
     }
 
-    oldhandler = interrupt_handlers[signal];
-    interrupt_handlers[signal].c = handler;
+    oldhandler = data->interrupt_handlers[signal];
+    data->interrupt_handlers[signal].c = handler;
 
     sigprocmask(SIG_SETMASK, &old, 0);
 
@@ -685,18 +916,15 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
 }
 
 void
-interrupt_init(void)
+interrupt_init()
 {
     int i;
-
     SHOW("entering interrupt_init()");
-
-    /* Set up for recovery from any installed low-level handlers. */
-    atexit(&uninstall_low_level_interrupt_handlers_atexit);
+    global_interrupt_data=calloc(sizeof(struct interrupt_data), 1);
 
     /* Set up high level handler information. */
     for (i = 0; i < NSIG; i++) {
-        interrupt_handlers[i].c =
+        global_interrupt_data->interrupt_handlers[i].c =
            /* (The cast here blasts away the distinction between
             * SA_SIGACTION-style three-argument handlers and
             * signal(..)-style one-argument handlers, which is OK