Rewrite of signal-handling (ghc patch; see also base and unix patches)

The API is the same (for now).  The new implementation has the
capability to define signal handlers that have access to the siginfo
of the signal (#592), but this functionality is not exposed in this
patch.

#2451 is the ticket for the new API.

The main purpose of bringing this in now is to fix race conditions in
the old signal handling code (#2858).  Later we can enable the new
API in the HEAD.

Implementation differences:

 - More of the signal-handling is moved into Haskell.  We store the
   table of signal handlers in an MVar, rather than having a table of
   StablePtrs in the RTS.

 - In the threaded RTS, the siginfo of the signal is passed down the
   pipe to the IO manager thread, which manages the business of
   starting up new signal handler threads.  In the non-threaded RTS,
   the siginfo of caught signals is stored in the RTS, and the
   scheduler starts new signal handler threads.

6 files changed, 102 insertions, 94 deletions

diff --git a/includes/RtsExternal.h b/includes/RtsExternal.h
index 31cae1a45a..2272b2a429 100644
--- a/includes/RtsExternal.h
+++ b/includes/RtsExternal.h
@@ -94,7 +94,7 @@ extern HpcModuleInfo *hs_hpc_rootModule(void);
 extern int  rts_InstallConsoleEvent ( int action, StgStablePtr *handler );
 extern void rts_ConsoleHandlerDone  ( int ev );
 #else
-extern int stg_sig_install (int, int, StgStablePtr *, void *);
+extern int stg_sig_install (int, int, void *);
 #endif
 
 #if defined(mingw32_HOST_OS)
diff --git a/rts/Prelude.h b/rts/Prelude.h
index d89119ad1e..69bd3f516b 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -44,6 +44,7 @@ PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure);
 
 PRELUDE_CLOSURE(base_GHCziConc_runSparks_closure);
 PRELUDE_CLOSURE(base_GHCziConc_ensureIOManagerIsRunning_closure);
+PRELUDE_CLOSURE(base_GHCziConc_runHandlers_closure);
 
 PRELUDE_INFO(ghczmprim_GHCziTypes_Czh_static_info);
 PRELUDE_INFO(ghczmprim_GHCziTypes_Izh_static_info);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 6abeb404a0..b9442d2bd5 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -402,12 +402,6 @@ hs_exit_(rtsBool wait_foreign)
     
     OnExitHook();
 
-#if defined(RTS_USER_SIGNALS)
-    if (RtsFlags.MiscFlags.install_signal_handlers) {
-        freeSignalHandlers();
-    }
-#endif
-
 #if defined(THREADED_RTS)
     ioManagerDie();
 #endif
@@ -418,6 +412,12 @@ hs_exit_(rtsBool wait_foreign)
     /* run C finalizers for all active weak pointers */
     runAllCFinalizers(weak_ptr_list);
     
+#if defined(RTS_USER_SIGNALS)
+    if (RtsFlags.MiscFlags.install_signal_handlers) {
+        freeSignalHandlers();
+    }
+#endif
+
 #if defined(GRAN)
     /* end_gr_simulation prints global stats if requested -- HWL */
     if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
diff --git a/rts/package.conf.in b/rts/package.conf.in
index d4882a5868..490222fdb9 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -110,6 +110,7 @@ ld-options:
          , "-u", "_base_GHCziTopHandler_runNonIO_closure"
 	 , "-u", "_base_GHCziConc_ensureIOManagerIsRunning_closure"
 	 , "-u", "_base_GHCziConc_runSparks_closure"
+	 , "-u", "_base_GHCziConc_runHandlers_closure"
 #else
            "-u", "ghczmprim_GHCziTypes_Izh_static_info"
          , "-u", "ghczmprim_GHCziTypes_Czh_static_info"
@@ -147,6 +148,7 @@ ld-options:
          , "-u", "base_GHCziTopHandler_runNonIO_closure"
 	 , "-u", "base_GHCziConc_ensureIOManagerIsRunning_closure"
 	 , "-u", "base_GHCziConc_runSparks_closure"
+	 , "-u", "base_GHCziConc_runHandlers_closure"
 #endif
 
 /*  Pick up static libraries in preference over dynamic if in earlier search
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index 493b083401..c016b9bf75 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -35,7 +35,12 @@
 # include <signal.h>
 #endif
 
+#ifdef HAVE_ERRNO_H
+# include <errno.h>
+#endif
+
 #include <stdlib.h>
+#include <string.h>
 
 /* This curious flag is provided for the benefit of the Haskell binding
  * to POSIX.1 to control whether or not to include SA_NOCLDSTOP when
@@ -60,7 +65,7 @@ static nat n_haskell_handlers = 0;
  * -------------------------------------------------------------------------- */
 
 static void
-more_handlers(I_ sig)
+more_handlers(int sig)
 {
     StgInt i;
 
@@ -79,33 +84,6 @@ more_handlers(I_ sig)
     nHandlers = sig + 1;
 }
 
-/* -----------------------------------------------------------------------------
- * Pending Handlers
- *
- * The mechanism for starting handlers differs between the threaded
- * (THREADED_RTS) and non-threaded versions of the RTS.
- *
- * When the RTS is single-threaded, we just write the pending signal
- * handlers into a buffer, and start a thread for each one in the
- * scheduler loop.
- *
- * When THREADED_RTS, the problem is that signals might be
- * delivered to multiple threads, so we would need to synchronise
- * access to pending_handler_buf somehow.  Using thread
- * synchronisation from a signal handler isn't possible in general
- * (some OSs support it, eg. MacOS X, but not all).  So instead:
- *
- *   - the signal handler writes the signal number into the pipe
- *     managed by the IO manager thread (see GHC.Conc).
- *   - the IO manager picks up the signal number and calls
- *     startSignalHandler() to start the thread.
- *
- * This also has the nice property that we don't need to arrange to
- * wake up a worker task to start the signal handler: the IO manager
- * wakes up when we write into the pipe.
- *
- * -------------------------------------------------------------------------- */
-
 // Here's the pipe into which we will send our signals
 static int io_manager_pipe = -1;
 
@@ -138,6 +116,8 @@ ioManagerDie (void)
     if (io_manager_pipe >= 0) {
 	StgWord8 byte = (StgWord8)IO_MANAGER_DIE;
 	write(io_manager_pipe, &byte, 1);
+        close(io_manager_pipe);
+        io_manager_pipe = -1;
     }
 }
 
@@ -158,8 +138,8 @@ ioManagerStart (void)
 
 #define N_PENDING_HANDLERS 16
 
-StgPtr pending_handler_buf[N_PENDING_HANDLERS];
-StgPtr *next_pending_handler = pending_handler_buf;
+siginfo_t pending_handler_buf[N_PENDING_HANDLERS];
+siginfo_t *next_pending_handler = pending_handler_buf;
 
 #endif /* THREADED_RTS */
 
@@ -171,7 +151,9 @@ StgPtr *next_pending_handler = pending_handler_buf;
  * -------------------------------------------------------------------------- */
 
 static void
-generic_handler(int sig)
+generic_handler(int sig USED_IF_THREADS,
+                siginfo_t *info,
+                void *p STG_UNUSED)
 {
     sigset_t signals;
 
@@ -179,10 +161,16 @@ generic_handler(int sig)
 
     if (io_manager_pipe != -1)
     {
-	// Write the signal number into the pipe as a single byte.  We
-	// hope that signals fit into a byte...
-	StgWord8 csig = (StgWord8)sig;
-	write(io_manager_pipe, &csig, 1);
+        StgWord8 buf[sizeof(siginfo_t) + 1];
+        int r;
+
+        buf[0] = sig;
+        memcpy(buf+1, info, sizeof(siginfo_t));
+	r = write(io_manager_pipe, buf, sizeof(siginfo_t)+1);
+        if (r == -1 && errno == EAGAIN)
+        {
+            errorBelch("lost signal due to full pipe: %d\n", sig);
+        }
     }
     // If the IO manager hasn't told us what the FD of the write end
     // of its pipe is, there's not much we can do here, so just ignore
@@ -218,7 +206,9 @@ generic_handler(int sig)
        circumstances, depending on the signal.  
     */
 
-    *next_pending_handler++ = deRefStablePtr((StgStablePtr)signal_handlers[sig]);
+    memcpy(next_pending_handler, info, sizeof(siginfo_t));
+
+    next_pending_handler++;
 
     // stack full?
     if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
@@ -247,6 +237,10 @@ void
 initUserSignals(void)
 {
     sigemptyset(&userSignals);
+#ifndef THREADED_RTS
+    getStablePtr((StgPtr)&base_GHCziConc_runHandlers_closure); 
+    // needed to keep runHandler alive
+#endif
 }
 
 void
@@ -279,10 +273,14 @@ awaitUserSignals(void)
 
 /* -----------------------------------------------------------------------------
  * Install a Haskell signal handler.
+ *
+ * We should really do this in Haskell in GHC.Conc, and share the
+ * signal_handlers array with the one there.
+ *
  * -------------------------------------------------------------------------- */
 
 int
-stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
+stg_sig_install(int sig, int spi, void *mask)
 {
     sigset_t signals, osignals;
     struct sigaction action;
@@ -303,26 +301,19 @@ stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
     
     switch(spi) {
     case STG_SIG_IGN:
-    	signal_handlers[sig] = STG_SIG_IGN;
-	sigdelset(&userSignals, sig);
         action.sa_handler = SIG_IGN;
     	break;
-    	
+
     case STG_SIG_DFL:
-    	signal_handlers[sig] = STG_SIG_DFL;
-	sigdelset(&userSignals, sig);
         action.sa_handler = SIG_DFL;
     	break;
 
-    case STG_SIG_HAN:
     case STG_SIG_RST:
-    	signal_handlers[sig] = (StgInt)*handler;
-	sigaddset(&userSignals, sig);
-    	action.sa_handler = generic_handler;
-	if (spi == STG_SIG_RST) {
-	    action.sa_flags = SA_RESETHAND;
-	}
-	n_haskell_handlers++;
+        action.sa_flags |= SA_RESETHAND;
+        /* fall through */
+    case STG_SIG_HAN:
+    	action.sa_sigaction = generic_handler;
+        action.sa_flags |= SA_SIGINFO;
     	break;
 
     default:
@@ -336,25 +327,38 @@ stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
 
     action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
 
-    if (sigaction(sig, &action, NULL) || 
-	sigprocmask(SIG_SETMASK, &osignals, NULL)) 
+    if (sigaction(sig, &action, NULL))
     {
-	// need to return an error code, so avoid a stable pointer leak
-	// by freeing the previous handler if there was one.
-	if (previous_spi >= 0) {
-	    freeStablePtr(stgCast(StgStablePtr,signal_handlers[sig]));
-	    n_haskell_handlers--;
-	}
+        errorBelch("sigaction");
 	return STG_SIG_ERR;
     }
 
-    if (previous_spi == STG_SIG_DFL || previous_spi == STG_SIG_IGN
-	|| previous_spi == STG_SIG_ERR) {
-	return previous_spi;
-    } else {
-	*handler = (StgStablePtr)previous_spi;
-	return STG_SIG_HAN;
+    signal_handlers[sig] = spi;
+
+    switch(spi) {
+    case STG_SIG_RST:
+    case STG_SIG_HAN:
+	sigaddset(&userSignals, sig);
+        if (previous_spi != STG_SIG_HAN && previous_spi != STG_SIG_RST) {
+            n_haskell_handlers++;
+        }
+    	break;
+
+    default:
+	sigdelset(&userSignals, sig);
+        if (previous_spi == STG_SIG_HAN || previous_spi == STG_SIG_RST) {
+            n_haskell_handlers--;
+        }
+        break;
+    }
+
+    if (sigprocmask(SIG_SETMASK, &osignals, NULL))
+    {
+        errorBelch("sigprocmask");
+	return STG_SIG_ERR;
     }
+
+    return previous_spi;
 }
 
 /* -----------------------------------------------------------------------------
@@ -365,16 +369,32 @@ stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
 void
 startSignalHandlers(Capability *cap)
 {
+  siginfo_t *info;
+  int sig;
+
   blockUserSignals();
   
   while (next_pending_handler != pending_handler_buf) {
 
     next_pending_handler--;
 
+    sig = next_pending_handler->si_signo;
+    if (signal_handlers[sig] == STG_SIG_DFL) {
+        continue; // handler has been changed.
+    }
+
+    info = stgMallocBytes(sizeof(siginfo_t), "startSignalHandlers"); 
+           // freed by runHandler
+    memcpy(info, next_pending_handler, sizeof(siginfo_t));
+
     scheduleThread (cap,
 	createIOThread(cap,
 		       RtsFlags.GcFlags.initialStkSize, 
-		       (StgClosure *) *next_pending_handler));
+                       rts_apply(cap,
+                                 rts_apply(cap,
+                                           &base_GHCziConc_runHandlers_closure,
+                                           rts_mkPtr(cap, info)),
+                                 rts_mkInt(cap, info->si_signo))));
   }
 
   unblockUserSignals();
@@ -383,37 +403,18 @@ startSignalHandlers(Capability *cap)
 
 /* ----------------------------------------------------------------------------
  * Mark signal handlers during GC.
- *
- * We do this rather than trying to start all the signal handlers
- * prior to GC, because that requires extra heap for the new threads.
- * Signals must be blocked (see blockUserSignals() above) during GC to
- * avoid race conditions.
  * -------------------------------------------------------------------------- */
 
-#if !defined(THREADED_RTS)
-void
-markSignalHandlers (evac_fn evac, void *user)
-{
-    StgPtr *p;
-
-    p = next_pending_handler;
-    while (p != pending_handler_buf) {
-	p--;
-	evac(user, (StgClosure **)p);
-    }
-}
-#else
 void
 markSignalHandlers (evac_fn evac STG_UNUSED, void *user STG_UNUSED)
 {
+    // nothing to do
 }
-#endif
 
 #else /* !RTS_USER_SIGNALS */
 StgInt 
 stg_sig_install(StgInt sig STG_UNUSED,
 		StgInt spi STG_UNUSED,
-		StgStablePtr* handler STG_UNUSED,
 		void* mask STG_UNUSED)
 {
   //barf("User signals not supported");
diff --git a/rts/posix/Signals.h b/rts/posix/Signals.h
index aa440b38aa..e1d550fdad 100644
--- a/rts/posix/Signals.h
+++ b/rts/posix/Signals.h
@@ -9,11 +9,15 @@
 #ifndef POSIX_SIGNALS_H
 #define POSIX_SIGNALS_H
 
+#ifdef HAVE_SIGNAL_H
+# include <signal.h>
+#endif
+
 extern rtsBool anyUserHandlers(void);
 
 #if !defined(THREADED_RTS)
-extern StgPtr pending_handler_buf[];
-extern StgPtr *next_pending_handler;
+extern siginfo_t pending_handler_buf[];
+extern siginfo_t *next_pending_handler;
 #define signals_pending() (next_pending_handler != pending_handler_buf)
 void startSignalHandlers(Capability *cap);
 #endif