From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 9 Jul 2008 08:49:16 +0000 (+0000)
Subject: FIX part of #2301, and #1619
X-Git-Tag: Before_cabalised-GHC~53
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=addff19a9c6ee89e36cb966988aa9f868ae2e4a6

FIX part of #2301, and #1619

2301: Control-C now causes the new exception (AsyncException
UserInterrupt) to be raised in the main thread.  The signal handler
is set up by GHC.TopHandler.runMainIO, and can be overriden in the
usual way by installing a new signal handler.  The advantage is that
now all programs will get a chance to clean up on ^C.

When UserInterrupt is caught by the topmost handler, we now exit the
program via kill(getpid(),SIGINT), which tells the parent process that
we exited as a result of ^C, so the parent can take appropriate action
(it might want to exit too, for example).

One subtlety is that we have to use a weak reference to the ThreadId
for the main thread, so that the signal handler doesn't prevent the
main thread from being subject to deadlock detection.

1619: we now ignore SIGPIPE by default.  Although POSIX says that a
SIGPIPE should terminate the process by default, I wonder if this
decision was made because many C applications failed to check the exit
code from write().  In Haskell a failed write due to a closed pipe
will generate an exception anyway, so the main difference is that we
now get a useful error message instead of silent program termination.
See #1619 for more discussion.
---

diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 54fa3ee..99aaa59 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -45,6 +45,10 @@ extern void setProgArgv            ( int argc, char *argv[] );
 extern void getFullProgArgv        ( int *argc, char **argv[] );
 extern void setFullProgArgv        ( int argc, char *argv[] );
 
+#ifndef mingw32_HOST_OS
+extern void shutdownHaskellAndSignal (int sig);
+#endif
+
 /* exit() override */
 extern void (*exitFn)(int);
 
diff --git a/rts/Linker.c b/rts/Linker.c
index db495dd..27c580b 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -174,6 +174,7 @@ typedef struct _RtsSymbolVal {
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
+      SymX(shutdownHaskellAndSignal)		\
       Sym(lockFile)                             \
       Sym(unlockFile)                           \
       SymX(signal_handlers)			\
diff --git a/rts/RtsSignals.h b/rts/RtsSignals.h
index 721561e..77f2224 100644
--- a/rts/RtsSignals.h
+++ b/rts/RtsSignals.h
@@ -40,6 +40,7 @@ extern void initUserSignals(void);
  * Ctrl+C handler that shuts down the RTS in an orderly manner.
  */
 extern void initDefaultHandlers(void);
+extern void resetDefaultHandlers(void);
 
 extern void freeSignalHandlers(void);
 
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index c55fdfb..f221ad8 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -71,6 +71,9 @@
 #ifdef HAVE_SIGNAL_H
 #include <signal.h>
 #endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
 
 #if USE_PAPI
 #include "Papi.h"
@@ -383,6 +386,8 @@ hs_exit_(rtsBool wait_foreign)
     /* start timing the shutdown */
     stat_startExit();
     
+    OnExitHook();
+
 #if defined(RTS_USER_SIGNALS)
     if (RtsFlags.MiscFlags.install_signal_handlers) {
         freeSignalHandlers();
@@ -440,6 +445,9 @@ hs_exit_(rtsBool wait_foreign)
     PAR_TICKY_PAR_END();
 #endif
 
+    // uninstall signal handlers
+    resetDefaultHandlers();
+
     /* stop timing the shutdown, we're about to print stats */
     stat_endExit();
     
@@ -528,10 +536,10 @@ shutdownHaskell(void)
 void
 shutdownHaskellAndExit(int n)
 {
-    if (hs_init_count == 1) {
-	OnExitHook();
-	hs_exit_(rtsFalse);
-        // we're about to exit(), no need to wait for foreign calls to return.
+    // we're about to exit(), no need to wait for foreign calls to return.
+    hs_exit_(rtsFalse);
+
+    if (hs_init_count == 0) {
 #if defined(PAR)
 	/* really exit (stg_exit() would call shutdownParallelSystem() again) */
 	exit(n);
@@ -541,6 +549,15 @@ shutdownHaskellAndExit(int n)
     }
 }
 
+#ifndef mingw32_HOST_OS
+void
+shutdownHaskellAndSignal(int sig)
+{
+    hs_exit_(rtsFalse);
+    kill(getpid(),sig);
+}
+#endif
+
 /* 
  * called from STG-land to exit the program
  */
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index fcfa1f1..e34190c 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -496,6 +496,33 @@ initDefaultHandlers(void)
 #ifdef alpha_HOST_ARCH
     ieee_set_fp_control(0);
 #endif
+
+    // ignore SIGPIPE; see #1619
+    action.sa_handler = SIG_IGN;
+    sigemptyset(&action.sa_mask);
+    action.sa_flags = 0;
+    if (sigaction(SIGPIPE, &action, &oact) != 0) {
+	sysErrorBelch("warning: failed to install SIGPIPE handler");
+    }
+}
+
+void
+resetDefaultHandlers(void)
+{
+    struct sigaction action;
+
+    action.sa_handler = SIG_DFL;
+    sigemptyset(&action.sa_mask);
+    action.sa_flags = 0;
+
+    // restore SIGINT
+    if (sigaction(SIGINT, &action, NULL) != 0) {
+	sysErrorBelch("warning: failed to uninstall SIGINT handler");
+    }
+    // restore SIGPIPE
+    if (sigaction(SIGPIPE, &action, NULL) != 0) {
+	sysErrorBelch("warning: failed to uninstall SIGPIPE handler");
+    }
 }
 
 void
diff --git a/rts/win32/ConsoleHandler.c b/rts/win32/ConsoleHandler.c
index 2cd10ec..25472cf 100644
--- a/rts/win32/ConsoleHandler.c
+++ b/rts/win32/ConsoleHandler.c
@@ -119,6 +119,12 @@ void initDefaultHandlers(void)
     }
 }
 
+void resetDefaultHandlers(void)
+{
+    if ( !SetConsoleCtrlHandler(shutdown_handler, FALSE) ) {
+	errorBelch("warning: failed to uninstall default console handler");
+    }
+}
 
 /*
  * Function: blockUserSignals()