1.0.25.23: more allocation checks
[sbcl.git] / src / runtime / interrupt.c
index c702e58..74fd67b 100644 (file)
@@ -74,11 +74,21 @@ static void store_signal_data_for_later (struct interrupt_data *data,
                                          siginfo_t *info,
                                          os_context_t *context);
 
+static void
+fill_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);
+}
+
 void
 sigaddset_deferrable(sigset_t *s)
 {
     sigaddset(s, SIGHUP);
     sigaddset(s, SIGINT);
+    sigaddset(s, SIGTERM);
     sigaddset(s, SIGQUIT);
     sigaddset(s, SIGPIPE);
     sigaddset(s, SIGALRM);
@@ -86,8 +96,10 @@ sigaddset_deferrable(sigset_t *s)
     sigaddset(s, SIGTSTP);
     sigaddset(s, SIGCHLD);
     sigaddset(s, SIGIO);
+#ifndef LISP_FEATURE_HPUX
     sigaddset(s, SIGXCPU);
     sigaddset(s, SIGXFSZ);
+#endif
     sigaddset(s, SIGVTALRM);
     sigaddset(s, SIGPROF);
     sigaddset(s, SIGWINCH);
@@ -115,9 +127,31 @@ sigaddset_blockable(sigset_t *s)
 }
 
 /* initialized in interrupt_init */
-static sigset_t deferrable_sigset;
-static sigset_t blockable_sigset;
+sigset_t deferrable_sigset;
+sigset_t blockable_sigset;
+#endif
+
+void
+check_deferrables_blocked_in_sigset_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);
+    }
 #endif
+}
+
+void
+check_deferrables_blocked_or_lose(void)
+{
+#if !defined(LISP_FEATURE_WIN32)
+    sigset_t current;
+    fill_current_sigmask(&current);
+    check_deferrables_blocked_in_sigset_or_lose(&current);
+#endif
+}
 
 void
 check_blockables_blocked_or_lose(void)
@@ -275,12 +309,19 @@ fake_foreign_function_call(os_context_t *context)
     dynamic_space_free_pointer =
         (lispobj *)(unsigned long)
             (*os_context_register_addr(context, reg_ALLOC));
-    /* fprintf(stderr,"dynamic_space_free_pointer: %p\n", dynamic_space_free_pointer); */
-#if defined(LISP_FEATURE_ALPHA)
+/*     fprintf(stderr,"dynamic_space_free_pointer: %p\n", */
+/*             dynamic_space_free_pointer); */
+#if defined(LISP_FEATURE_ALPHA) || defined(LISP_FEATURE_MIPS)
     if ((long)dynamic_space_free_pointer & 1) {
         lose("dead in fake_foreign_function_call, context = %x\n", context);
     }
 #endif
+/* why doesnt PPC and SPARC do something like this: */
+#if defined(LISP_FEATURE_HPPA)
+    if ((long)dynamic_space_free_pointer & 4) {
+        lose("dead in fake_foreign_function_call, context = %x, d_s_f_p = %x\n", context, dynamic_space_free_pointer);
+    }
+#endif
 #endif
 #ifdef reg_BSP
     current_binding_stack_pointer =
@@ -333,7 +374,8 @@ undo_fake_foreign_function_call(os_context_t *context)
         | (*os_context_register_addr(context, reg_ALLOC)
            & LOWTAG_MASK);
     /*
-      ((unsigned long)(*os_context_register_addr(context, reg_ALLOC)) & ~LOWTAG_MASK)
+      ((unsigned long)(*os_context_register_addr(context, reg_ALLOC))
+      & ~LOWTAG_MASK)
       | ((unsigned long) dynamic_space_free_pointer & LOWTAG_MASK);
     */
 #endif
@@ -370,7 +412,7 @@ interrupt_internal_error(os_context_t *context, boolean continuable)
      * confused, we have a chance to determine what's going on. */
     describe_internal_error(context);
 #endif
-    funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
+    funcall2(StaticSymbolFunction(INTERNAL_ERROR), context_sap,
              continuable ? T : NIL);
 
     undo_fake_foreign_function_call(context); /* blocks signals again */
@@ -381,28 +423,23 @@ interrupt_internal_error(os_context_t *context, boolean continuable)
 void
 interrupt_handle_pending(os_context_t *context)
 {
-    /* There are three ways we can get here.  First, if an interrupt
+    /* There are three ways we can get here. First, if an interrupt
      * occurs within pseudo-atomic, it will be deferred, and we'll
-     * trap to here at the end of the pseudo-atomic block.  Second, if
+     * trap to here at the end of the pseudo-atomic block. Second, if
      * the GC (in alloc()) decides that a GC is required, it will set
-     * *GC-PENDING* and pseudo-atomic-interrupted, and alloc() is
-     * always called from within pseudo-atomic, and 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. */
+     * *GC-PENDING* and pseudo-atomic-interrupted if not *GC-INHIBIT*,
+     * and alloc() is always called from within pseudo-atomic, and
+     * 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?) */
 
     struct thread *thread;
 
-    /* Punt if in PA section, marking it as interrupted. This can
-     * happenat least if we pick up a GC request while in a
-     * WITHOUT-GCING with an outer PA -- it is not immediately clear
-     * to me that this should/could ever happen, but better safe then
-     * sorry. --NS 2007-05-15 */
     if (arch_pseudo_atomic_atomic(context)) {
-        arch_set_pseudo_atomic_interrupted(context);
-        return;
+        lose("Handling pending interrupt in pseduo atomic.");
     }
 
     thread = arch_os_get_current_thread();
@@ -442,7 +479,7 @@ interrupt_handle_pending(os_context_t *context)
          * that had to be executed or because pseudo atomic triggered
          * twice for a single interrupt. For the interested reader,
          * that may happen if an interrupt hits after the interrupted
-         * flag is cleared but before pseduo-atomic is set and a
+         * flag is cleared but before pseudo-atomic is set and a
          * pseudo atomic is interrupted in that interrupt. */
         if (data->pending_handler) {
 
@@ -628,9 +665,8 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
         store_signal_data_for_later(data,handler,signal,info,context);
         SetSymbolValue(INTERRUPT_PENDING, T,thread);
         FSHOW_SIGNAL((stderr,
-                      "/maybe_defer_handler(%x,%d),thread=%lu: deferred\n",
-                      (unsigned int)handler,signal,
-                      (unsigned long)thread->os_thread));
+                      "/maybe_defer_handler(%x,%d): deferred\n",
+                      (unsigned int)handler,signal));
         return 1;
     }
     /* a slightly confusing test. arch_pseudo_atomic_atomic() doesn't
@@ -640,15 +676,13 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
         store_signal_data_for_later(data,handler,signal,info,context);
         arch_set_pseudo_atomic_interrupted(context);
         FSHOW_SIGNAL((stderr,
-                      "/maybe_defer_handler(%x,%d),thread=%lu: deferred(PA)\n",
-                      (unsigned int)handler,signal,
-                      (unsigned long)thread->os_thread));
+                      "/maybe_defer_handler(%x,%d): deferred(PA)\n",
+                      (unsigned int)handler,signal));
         return 1;
     }
     FSHOW_SIGNAL((stderr,
-                  "/maybe_defer_handler(%x,%d),thread=%lu: not deferred\n",
-                  (unsigned int)handler,signal,
-                  (unsigned long)thread->os_thread));
+                  "/maybe_defer_handler(%x,%d): not deferred\n",
+                  (unsigned int)handler,signal));
     return 0;
 }
 
@@ -667,7 +701,8 @@ store_signal_data_for_later (struct interrupt_data *data, void *handler,
     if(info)
         memcpy(&(data->pending_info), info, sizeof(siginfo_t));
 
-    FSHOW_SIGNAL((stderr, "/store_signal_data_for_later: signal: %d\n", signal));
+    FSHOW_SIGNAL((stderr, "/store_signal_data_for_later: signal: %d\n",
+                  signal));
 
     if(context) {
         /* the signal mask in the context (from before we were
@@ -693,19 +728,16 @@ maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 
     if(!maybe_defer_handler(interrupt_handle_now,data,signal,info,context))
         interrupt_handle_now(signal, info, context);
-
-#ifdef LISP_FEATURE_DARWIN
-    DARWIN_FIX_CONTEXT(context);
-#endif
 }
 
 static void
-low_level_interrupt_handle_now(int signal, siginfo_t *info, os_context_t *context)
+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_interrupts_enabled_or_lose(context);
-    interrupt_low_level_handlers[signal](signal, info, context);
+    (*interrupt_low_level_handlers[signal])(signal, info, context);
     /* No Darwin context fixage needed, caller does that. */
 }
 
@@ -723,10 +755,6 @@ low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
     if(!maybe_defer_handler(low_level_interrupt_handle_now,data,
                             signal,info,context))
         low_level_interrupt_handle_now(signal, info, context);
-
-#ifdef LISP_FEATURE_DARWIN
-    DARWIN_FIX_CONTEXT(context);
-#endif
 }
 #endif
 
@@ -743,15 +771,12 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
     if (arch_pseudo_atomic_atomic(context)) {
         SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
         arch_set_pseudo_atomic_interrupted(context);
-        FSHOW_SIGNAL((stderr,"thread=%lu sig_stop_for_gc deferred (PA)\n",
-                      thread->os_thread));
+        FSHOW_SIGNAL((stderr, "sig_stop_for_gc deferred (PA)\n"));
         return;
     }
     else if (SymbolValue(GC_INHIBIT,thread) != NIL) {
         SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
-        FSHOW_SIGNAL((stderr,
-                      "thread=%lu sig_stop_for_gc deferred (*GC-INHIBIT*)\n",
-                      thread->os_thread));
+        FSHOW_SIGNAL((stderr, "sig_stop_for_gc deferred (*GC-INHIBIT*)\n"));
         return;
     }
 
@@ -774,7 +799,7 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
     }
 
     thread->state=STATE_SUSPENDED;
-    FSHOW_SIGNAL((stderr,"thread=%lu suspended\n",thread->os_thread));
+    FSHOW_SIGNAL((stderr,"suspended\n"));
 
     sigemptyset(&ss);
 #if defined(SIG_RESUME_FROM_GC)
@@ -795,7 +820,7 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
     while (sigwaitinfo(&ss,0) != SIG_STOP_FOR_GC);
 #endif
 
-    FSHOW_SIGNAL((stderr,"thread=%lu resumed\n",thread->os_thread));
+    FSHOW_SIGNAL((stderr,"resumed\n"));
     if(thread->state!=STATE_RUNNING) {
         lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n",
              fixnum_value(thread->state));
@@ -811,11 +836,16 @@ interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
     os_context_t *context = arch_os_get_context(&void_context);
 #if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT)
     os_restore_fp_control(context);
+#ifndef LISP_FEATURE_WIN32
+    if ((signal == SIGILL) || (signal == SIGBUS)
+#ifndef LISP_FEATURE_LINUX
+        || (signal == SIGEMT)
+#endif
+        )
+        corruption_warning_and_maybe_lose("Signal %d recieved", signal);
 #endif
-    interrupt_handle_now(signal, info, context);
-#ifdef LISP_FEATURE_DARWIN
-    DARWIN_FIX_CONTEXT(context);
 #endif
+    interrupt_handle_now(signal, info, context);
 }
 
 /* manipulate the signal context and stack such that when the handler
@@ -1000,6 +1030,8 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function)
     *os_context_register_addr(context,reg_CODE) =
         (os_context_register_t)(fun + FUN_POINTER_LOWTAG);
 #endif
+    FSHOW((stderr, "/arranged return to Lisp function (0x%lx)\n",
+           (long)function));
 }
 
 #ifdef LISP_FEATURE_SB_THREAD
@@ -1011,9 +1043,13 @@ interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
 {
     os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
 
+    FSHOW_SIGNAL((stderr,"/interrupt_thread_handler\n"));
+    check_blockables_blocked_or_lose();
+
     /* let the handler enable interrupts again when it sees fit */
     sigaddset_deferrable(os_context_sigmask_addr(context));
-    arrange_return_to_lisp_function(context, SymbolFunction(RUN_INTERRUPTION));
+    arrange_return_to_lisp_function(context,
+                                    StaticSymbolFunction(RUN_INTERRUPTION));
 }
 
 #endif
@@ -1027,7 +1063,7 @@ interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
 void
 undefined_alien_function(void)
 {
-    funcall0(SymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
+    funcall0(StaticSymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
 }
 
 boolean
@@ -1043,11 +1079,12 @@ handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
          * 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");
         protect_control_stack_guard_page(0);
         protect_control_stack_return_guard_page(1);
 
         arrange_return_to_lisp_function
-            (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
+            (context, StaticSymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
         return 1;
     }
     else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) &&
@@ -1063,7 +1100,7 @@ handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
     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));
+          (context, StaticSymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
         return 1;
     }
     else return 0;
@@ -1254,6 +1291,14 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
 #endif
 }
 
+/* This must not go through lisp as it's allowed anytime, even when on
+ * the altstack. */
+void
+sigabrt_handler(int signal, siginfo_t *info, void *void_context)
+{
+    lose("SIGABRT received.\n");
+}
+
 void
 interrupt_init(void)
 {
@@ -1276,7 +1321,7 @@ interrupt_init(void)
              * 3-argument form is expected.) */
             (void (*)(int, siginfo_t*, void*))SIG_DFL;
     }
-
+    undoably_install_low_level_interrupt_handler(SIGABRT, sigabrt_handler);
     SHOW("returning from interrupt_init()");
 #endif
 }
@@ -1298,7 +1343,10 @@ lisp_memory_fault_error(os_context_t *context, os_vm_address_t addr)
     * now -- some address is better then no address in this case.
     */
     current_memory_fault_address = addr;
-    arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR));
+    /* To allow debugging memory faults in signal handlers and such. */
+    corruption_warning_and_maybe_lose("Memory fault");
+    arrange_return_to_lisp_function(context,
+                                    StaticSymbolFunction(MEMORY_FAULT_ERROR));
 }
 #endif
 
@@ -1311,7 +1359,7 @@ unhandled_trap_error(os_context_t *context)
 #ifndef LISP_FEATURE_WIN32
     thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 #endif
-    funcall1(SymbolFunction(UNHANDLED_TRAP_ERROR), context_sap);
+    funcall1(StaticSymbolFunction(UNHANDLED_TRAP_ERROR), context_sap);
     lose("UNHANDLED-TRAP-ERROR fell through");
 }