0.8.13.41: Require robustness
[sbcl.git] / src / runtime / interrupt.c
index dac50f7..2be9e0f 100644 (file)
 #include <stdlib.h>
 #include <string.h>
 #include <signal.h>
+#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"
@@ -62,6 +64,8 @@
 #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,
@@ -70,7 +74,6 @@ static void store_signal_data_for_later (struct interrupt_data *data,
 boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context);
 
 extern volatile lispobj all_threads_lock;
-extern volatile int countdown_to_gc;
 
 /*
  * This is a workaround for some slightly silly Linux/GNU Libc
@@ -117,16 +120,20 @@ boolean internal_errors_enabled = 0;
 
 struct interrupt_data * global_interrupt_data;
 
-/* this is used from Lisp in toplevel.lisp, replacing an older 
- * (sigsetmask 0) - we'd like to find out when the signal mask is 
- * not 0 */
+/* 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.  */
 
-/* This check was introduced in 0.8.4.x and some day will go away
- * again unless we find a way to trigger it */
-
-void warn_when_signals_masked () 
+#if 1
+void reset_signal_mask () 
+{
+    sigset_t new;
+    sigemptyset(&new);
+    sigprocmask(SIG_SETMASK,&new,0);
+}
+#else
+void reset_signal_mask () 
 {
-    /* and as a side-eeffect, unmask them */
     sigset_t new,old;
     int i;
     int wrong=0;
@@ -142,6 +149,9 @@ void warn_when_signals_masked ()
     if(wrong) 
        fprintf(stderr,"If this version of SBCL is less than three months old, please report this.\nOtherwise, please try a newer version first\n.  Reset signal mask.\n");
 }
+#endif
+
+
 
 \f
 /*
@@ -287,7 +297,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. */
@@ -525,37 +535,50 @@ maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
                           signal,info,context))
        return;
     interrupt_handle_now(signal, info, context);
+#ifdef LISP_FEATURE_DARWIN
+    /* Work around G5 bug */
+    sigreturn(void_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)){
+                          signal,info,context)) {
        return;
     }
     /* need the context stored so it can have registers scavenged */
     fake_foreign_function_call(context); 
 
-    get_spinlock(&all_threads_lock,thread->pid);
-    countdown_to_gc--;
+    sigemptyset(&ss);
+    for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
+    sigprocmask(SIG_BLOCK,&ss,0);
+
     thread->state=STATE_STOPPED;
-    release_spinlock(&all_threads_lock);
-    kill(thread->pid,SIGSTOP);
+
+    sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
+    sigwaitinfo(&ss,0);
 
     undo_fake_foreign_function_call(context);
 }
+#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
+    sigreturn(void_context);
+#endif
 }
 
 /*
@@ -586,9 +609,11 @@ 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)
 {
+#ifndef LISP_FEATURE_X86
     void * fun=native_pointer(function);
-    char *code = &(((struct simple_fun *) fun)->code);
-    
+    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
@@ -648,17 +673,34 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 }
 
 #ifdef LISP_FEATURE_SB_THREAD
-void handle_rt_signal(int num, siginfo_t *info, void *v_context)
+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(handle_rt_signal,data,num,info,context)){
+    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 */
+    pid_t kid;
+    int status;
+    
+    while(1) {
+       kid=waitpid(-1,&status,__WALL|WNOHANG);
+       if(kid<=0) break;
+       if(WIFEXITED(status) || WIFSIGNALED(status)) {
+           struct thread *th=find_thread_by_pid(kid);
+           if(th) th->state=STATE_DEAD;
+       }
+    }
+}
+
+       
 #endif
 
 boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){
@@ -679,7 +721,7 @@ boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){
 }
 
 #ifndef LISP_FEATURE_GENCGC
-/* This function gets called from the SIGSEGV (for e.g. Linux or
+/* 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. */
@@ -784,8 +826,8 @@ 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]));
+    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)) {