0.9.4.2:
[sbcl.git] / src / runtime / interrupt.c
index 1fa2547..79275ef 100644 (file)
@@ -75,7 +75,7 @@ static void store_signal_data_for_later (struct interrupt_data *data,
                                          os_context_t *context);
 boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context);
 
-void sigaddset_blockable(sigset_t *s)
+void sigaddset_deferrable(sigset_t *s)
 {
     sigaddset(s, SIGHUP);
     sigaddset(s, SIGINT);
@@ -95,11 +95,20 @@ void sigaddset_blockable(sigset_t *s)
     sigaddset(s, SIGUSR1);
     sigaddset(s, SIGUSR2);
 #ifdef LISP_FEATURE_SB_THREAD
-    sigaddset(s, SIG_STOP_FOR_GC);
     sigaddset(s, SIG_INTERRUPT_THREAD);
 #endif
 }
 
+void sigaddset_blockable(sigset_t *s)
+{
+    sigaddset_deferrable(s);
+#ifdef LISP_FEATURE_SB_THREAD
+    sigaddset(s, SIG_STOP_FOR_GC);
+#endif
+}
+
+/* initialized in interrupt_init */
+static sigset_t deferrable_sigset;
 static sigset_t blockable_sigset;
 
 inline static void check_blockables_blocked_or_lose()
@@ -328,34 +337,64 @@ interrupt_handle_pending(os_context_t *context)
     struct interrupt_data *data;
 
     check_blockables_blocked_or_lose();
-    check_interrupts_enabled_or_lose(context);
 
     thread=arch_os_get_current_thread();
     data=thread->interrupt_data;
 
-    /* Pseudo atomic may trigger several times for a single interrupt,
-     * and while without-interrupts should not, a false trigger by
-     * pseudo-atomic may eat a pending handler even from
-     * without-interrupts. */
-    if (data->pending_handler) {
-
-        /* If we're here as the result of a pseudo-atomic as opposed
-         * to WITHOUT-INTERRUPTS, then INTERRUPT_PENDING is already
-         * NIL, because maybe_defer_handler sets
-         * PSEUDO_ATOMIC_INTERRUPTED only if interrupts are enabled.*/
-        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 */
-        sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
-
-        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);
+    if (SymbolValue(GC_INHIBIT,thread)==NIL) {
+#ifdef LISP_FEATURE_SB_THREAD
+        if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
+            /* another thread has already initiated a gc, this attempt
+             * might as well be cancelled */
+            SetSymbolValue(GC_PENDING,NIL,thread);
+            SetSymbolValue(STOP_FOR_GC_PENDING,NIL,thread);
+            sig_stop_for_gc_handler(SIG_STOP_FOR_GC,NULL,context);
+        } else
+#endif
+        if (SymbolValue(GC_PENDING,thread) != NIL) {
+            /* GC_PENDING is cleared in SUB-GC, or if another thread
+             * is doing a gc already we will get a SIG_STOP_FOR_GC and
+             * that will clear it. */
+            interrupt_maybe_gc_int(0,NULL,context);
+        }
+        check_blockables_blocked_or_lose();
+    }
+
+    /* we may be here only to do the gc stuff, if interrupts are
+     * enabled run the pending handler */
+    if (!((SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) ||
+          (
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+           (!foreign_function_call_active) &&
+#endif
+           arch_pseudo_atomic_atomic(context)))) {
+
+        /* There may be no pending handler, because it was only a gc
+         * 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
+         * pseudo atomic is interrupted in that interrupt. */
+        if (data->pending_handler) {
+
+            /* If we're here as the result of a pseudo-atomic as opposed
+             * to WITHOUT-INTERRUPTS, then INTERRUPT_PENDING is already
+             * NIL, because maybe_defer_handler sets
+             * PSEUDO_ATOMIC_INTERRUPTED only if interrupts are enabled.*/
+            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 */
+            sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
+
+            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
@@ -406,11 +445,9 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
         fake_foreign_function_call(context);
     }
 
-#ifdef QSHOW_SIGNALS
-    FSHOW((stderr,
-           "/entering interrupt_handle_now(%d, info, context)\n",
-           signal));
-#endif
+    FSHOW_SIGNAL((stderr,
+                  "/entering interrupt_handle_now(%d, info, context)\n",
+                  signal));
 
     if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
 
@@ -437,9 +474,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
         /* Allow signals again. */
         thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 
-#ifdef QSHOW_SIGNALS
-        SHOW("calling Lisp-level handler");
-#endif
+        FSHOW_SIGNAL((stderr,"/calling Lisp-level handler\n"));
 
         funcall3(handler.lisp,
                  make_fixnum(signal),
@@ -447,9 +482,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
                  context_sap);
     } else {
 
-#ifdef QSHOW_SIGNALS
-        SHOW("calling C-level handler");
-#endif
+        FSHOW_SIGNAL((stderr,"/calling C-level handler\n"));
 
         /* Allow signals again. */
         thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
@@ -464,11 +497,9 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
         undo_fake_foreign_function_call(context); /* block signals again */
     }
 
-#ifdef QSHOW_SIGNALS
-    FSHOW((stderr,
-           "/returning from interrupt_handle_now(%d, info, context)\n",
-           signal));
-#endif
+    FSHOW_SIGNAL((stderr,
+                  "/returning from interrupt_handle_now(%d, info, context)\n",
+                  signal));
 }
 
 /* This is called at the end of a critical section if the indications
@@ -479,11 +510,10 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 
 void
 run_deferred_handler(struct interrupt_data *data, void *v_context) {
-    /* The pending_handler may enable interrupts (see
-     * interrupt_maybe_gc_int) and then another interrupt may hit,
-     * overwrite interrupt_data, so reset the pending handler before
-     * calling it. Trust the handler to finish with the siginfo before
-     * enabling interrupts. */
+    /* The pending_handler may enable interrupts and then another
+     * interrupt may hit, overwrite interrupt_data, so reset the
+     * pending handler before calling it. Trust the handler to finish
+     * with the siginfo before enabling interrupts. */
     void (*pending_handler) (int, siginfo_t*, void*)=data->pending_handler;
     data->pending_handler=0;
     (*pending_handler)(data->pending_signal,&(data->pending_info), v_context);
@@ -501,16 +531,15 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
         lose("interrupt already pending");
     /* If interrupts are disabled then INTERRUPT_PENDING is set and
      * not PSEDUO_ATOMIC_INTERRUPTED. This is important for a pseudo
-     * atomic section inside a without-interrupts.
+     * atomic section inside a WITHOUT-INTERRUPTS.
      */
     if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
         store_signal_data_for_later(data,handler,signal,info,context);
         SetSymbolValue(INTERRUPT_PENDING, T,thread);
-#ifdef QSHOW_SIGNALS
-        FSHOW((stderr,
-               "/maybe_defer_handler(%x,%d),thread=%ld: deferred\n",
-               (unsigned int)handler,signal,thread->os_thread));
-#endif
+        FSHOW_SIGNAL((stderr,
+                      "/maybe_defer_handler(%x,%d),thread=%lu: deferred\n",
+                      (unsigned int)handler,signal,
+                      (unsigned long)thread->os_thread));
         return 1;
     }
     /* a slightly confusing test.  arch_pseudo_atomic_atomic() doesn't
@@ -518,23 +547,27 @@ maybe_defer_handler(void *handler, struct interrupt_data *data,
      * may succeed even when context is null (gencgc alloc()) */
     if (
 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+        /* FIXME: this foreign_function_call_active test is dubious at
+         * best. If a foreign call is made in a pseudo atomic section
+         * (?) or more likely a pseudo atomic section is in a foreign
+         * call then an interrupt is executed immediately. Maybe it
+         * has to do with C code not maintaining pseudo atomic
+         * properly. MG - 2005-08-10 */
         (!foreign_function_call_active) &&
 #endif
         arch_pseudo_atomic_atomic(context)) {
         store_signal_data_for_later(data,handler,signal,info,context);
         arch_set_pseudo_atomic_interrupted(context);
-#ifdef QSHOW_SIGNALS
-        FSHOW((stderr,
-               "/maybe_defer_handler(%x,%d),thread=%ld: deferred(PA)\n",
-               (unsigned int)handler,signal,thread->os_thread));
-#endif
+        FSHOW_SIGNAL((stderr,
+                      "/maybe_defer_handler(%x,%d),thread=%lu: deferred(PA)\n",
+                      (unsigned int)handler,signal,
+                      (unsigned long)thread->os_thread));
         return 1;
     }
-#ifdef QSHOW_SIGNALS
-        FSHOW((stderr,
-               "/maybe_defer_handler(%x,%d),thread=%ld: not deferred\n",
-               (unsigned int)handler,signal,thread->os_thread));
-#endif
+    FSHOW_SIGNAL((stderr,
+                  "/maybe_defer_handler(%x,%d),thread=%lu: not deferred\n",
+                  (unsigned int)handler,signal,
+                  (unsigned long)thread->os_thread));
     return 0;
 }
 
@@ -559,7 +592,7 @@ store_signal_data_for_later (struct interrupt_data *data, void *handler,
          * signals are added to the mask in the context so that we are
          * running with blocked signals when the handler returns */
         sigcopyset(&(data->pending_mask),os_context_sigmask_addr(context));
-        sigaddset_blockable(os_context_sigmask_addr(context));
+        sigaddset_deferrable(os_context_sigmask_addr(context));
     }
 }
 
@@ -572,8 +605,7 @@ maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 #ifdef LISP_FEATURE_LINUX
     os_restore_fp_control(context);
 #endif
-    if(maybe_defer_handler(interrupt_handle_now,data,
-                           signal,info,context))
+    if(maybe_defer_handler(interrupt_handle_now,data,signal,info,context))
         return;
     interrupt_handle_now(signal, info, context);
 #ifdef LISP_FEATURE_DARWIN
@@ -587,13 +619,14 @@ low_level_interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 {
     os_context_t *context = (os_context_t*)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
     check_blockables_blocked_or_lose();
     check_interrupts_enabled_or_lose(context);
-    (*thread->interrupt_data->interrupt_low_level_handlers[signal])
+    (*data->interrupt_low_level_handlers[signal])
         (signal, info, void_context);
 #ifdef LISP_FEATURE_DARWIN
     /* Work around G5 bug */
@@ -621,6 +654,7 @@ low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 }
 
 #ifdef LISP_FEATURE_SB_THREAD
+
 void
 sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
 {
@@ -629,32 +663,42 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
     sigset_t ss;
     int i;
 
-    /* need the context stored so it can have registers scavenged */
-    fake_foreign_function_call(context);
+    if ((arch_pseudo_atomic_atomic(context) ||
+         SymbolValue(GC_INHIBIT,thread) != NIL)) {
+        SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
+        if (SymbolValue(GC_INHIBIT,thread) == NIL)
+            arch_set_pseudo_atomic_interrupted(context);
+        FSHOW_SIGNAL((stderr,"thread=%lu sig_stop_for_gc deferred\n",
+                      thread->os_thread));
+    } else {
+        /* 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. */
-    thread_sigmask(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  */
-    if(thread->state!=STATE_RUNNING) {
-        lose("sig_stop_for_gc_handler: wrong thread state: %ld\n",
-             fixnum_value(thread->state));
-    }
-    thread->state=STATE_SUSPENDED;
+        sigemptyset(&ss);
+        for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
+        thread_sigmask(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  */
+        if(thread->state!=STATE_RUNNING) {
+            lose("sig_stop_for_gc_handler: wrong thread state: %ld\n",
+                 fixnum_value(thread->state));
+        }
+        thread->state=STATE_SUSPENDED;
+        FSHOW_SIGNAL((stderr,"thread=%lu suspended\n",thread->os_thread));
+
+        sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
+        sigwaitinfo(&ss,0);
+        FSHOW_SIGNAL((stderr,"thread=%lu resumed\n",thread->os_thread));
+        if(thread->state!=STATE_RUNNING) {
+            lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n",
+                 fixnum_value(thread->state));
+        }
 
-    sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
-    sigwaitinfo(&ss,0);
-    if(thread->state!=STATE_SUSPENDED) {
-        lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n",
-           fixnum_value(thread->state));
+        undo_fake_foreign_function_call(context);
     }
-    thread->state=STATE_RUNNING;
-
-    undo_fake_foreign_function_call(context);
 }
 #endif
 
@@ -835,7 +879,7 @@ 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);
     /* The order of interrupt execution is peculiar. If thread A
-     * interrupts thread B with I1, I2 and B for some reason recieves
+     * interrupts thread B with I1, I2 and B for some reason receives
      * I1 when FUN2 is already on the list, then it is FUN2 that gets
      * to run first. But when FUN2 is run SIG_INTERRUPT_THREAD is
      * enabled again and I2 hits pretty soon in FUN2 and run
@@ -843,14 +887,18 @@ void interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
      * thread interrupt execution is undefined. */
     struct thread *th=arch_os_get_current_thread();
     struct cons *c;
+    lispobj function;
     if (th->state != STATE_RUNNING)
-        lose("interrupt_thread_handler: thread %ld in wrong state: %d\n",
+        lose("interrupt_thread_handler: thread %lu in wrong state: %d\n",
              th->os_thread,fixnum_value(th->state));
     get_spinlock(&th->interrupt_fun_lock,(long)th);
     c=((struct cons *)native_pointer(th->interrupt_fun));
-    arrange_return_to_lisp_function(context,c->car);
+    function=c->car;
     th->interrupt_fun=c->cdr;
     release_spinlock(&th->interrupt_fun_lock);
+    if (function==NIL)
+        lose("interrupt_thread_handler: NIL function\n");
+    arrange_return_to_lisp_function(context,function);
 }
 
 #endif
@@ -915,15 +963,28 @@ 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;
+    struct interrupt_data *data=th->interrupt_data;
 
-    if(!data->pending_handler && !foreign_function_call_active &&
-       gc_trigger_hit(signal, info, context)){
+    if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){
+        struct thread *thread=arch_os_get_current_thread();
         clear_auto_gc_trigger();
-        if(!maybe_defer_handler(interrupt_maybe_gc_int,
-                                data,signal,info,void_context))
-            interrupt_maybe_gc_int(signal,info,void_context);
+        /* Don't flood the system with interrupts if the need to gc is
+         * already noted. This can happen for example when SUB-GC
+         * allocates or after a gc triggered in a WITHOUT-GCING. */
+        if (SymbolValue(GC_PENDING,thread) == NIL) {
+            if (SymbolValue(GC_INHIBIT,thread) == NIL) {
+                if (arch_pseudo_atomic_atomic(context)) {
+                    /* set things up so that GC happens when we finish
+                     * the PA section */
+                    SetSymbolValue(GC_PENDING,T,thread);
+                    arch_set_pseudo_atomic_interrupted(context);
+                } else {
+                    interrupt_maybe_gc_int(signal,info,void_context);
+                }
+            } else {
+                SetSymbolValue(GC_PENDING,T,thread);
+            }
+        }
         return 1;
     }
     return 0;
@@ -936,6 +997,7 @@ boolean
 interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context)
 {
     os_context_t *context=(os_context_t *) void_context;
+    struct thread *thread=arch_os_get_current_thread();
 
     check_blockables_blocked_or_lose();
     fake_foreign_function_call(context);
@@ -949,11 +1011,28 @@ interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context)
      * and signal a storage condition from there.
      */
 
-    /* restore the signal mask from the interrupted context before
-     * calling into Lisp */
-    if (context)
+    /* Restore the signal mask from the interrupted context before
+     * calling into Lisp if interrupts are enabled. Why not always?
+     *
+     * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
+     * interrupt hits while in SUB-GC, it is deferred and the
+     * os_context_sigmask of that interrupt is set to block further
+     * deferrable interrupts (until the first one is
+     * handled). Unfortunately, that context refers to this place and
+     * when we return from here the signals will not be blocked.
+     *
+     * A kludgy alternative is to propagate the sigmask change to the
+     * outer context.
+     */
+    if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL)
         thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
-
+#ifdef LISP_FEATURE_SB_THREAD
+    else {
+        sigset_t new;
+        sigaddset(&new,SIG_STOP_FOR_GC);
+        thread_sigmask(SIG_UNBLOCK,&new,0);
+    }
+#endif
     funcall0(SymbolFunction(SUB_GC));
 
     undo_fake_foreign_function_call(context);
@@ -973,6 +1052,7 @@ undoably_install_low_level_interrupt_handler (int signal,
 {
     struct sigaction sa;
     struct thread *th=arch_os_get_current_thread();
+    /* It may be before the initial thread is started. */
     struct interrupt_data *data=
         th ? th->interrupt_data : global_interrupt_data;
 
@@ -980,7 +1060,7 @@ undoably_install_low_level_interrupt_handler (int signal,
         lose("bad signal number %d", signal);
     }
 
-    if (sigismember(&blockable_sigset,signal))
+    if (sigismember(&deferrable_sigset,signal))
         sa.sa_sigaction = low_level_maybe_now_maybe_later;
     else
         sa.sa_sigaction = handler;
@@ -1010,6 +1090,7 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
     sigset_t old, new;
     union interrupt_handler oldhandler;
     struct thread *th=arch_os_get_current_thread();
+    /* It may be before the initial thread is started. */
     struct interrupt_data *data=
         th ? th->interrupt_data : global_interrupt_data;
 
@@ -1019,16 +1100,13 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
     sigaddset(&new, signal);
     thread_sigmask(SIG_BLOCK, &new, &old);
 
-    sigemptyset(&new);
-    sigaddset_blockable(&new);
-
     FSHOW((stderr, "/data->interrupt_low_level_handlers[signal]=%x\n",
            (unsigned int)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)) {
+        } else if (sigismember(&deferrable_sigset, signal)) {
             sa.sa_sigaction = maybe_now_maybe_later;
         } else {
             sa.sa_sigaction = interrupt_handle_now_handler;
@@ -1055,7 +1133,9 @@ interrupt_init()
 {
     int i;
     SHOW("entering interrupt_init()");
+    sigemptyset(&deferrable_sigset);
     sigemptyset(&blockable_sigset);
+    sigaddset_deferrable(&deferrable_sigset);
     sigaddset_blockable(&blockable_sigset);
 
     global_interrupt_data=calloc(sizeof(struct interrupt_data), 1);