[commit: ghc] master: Improve the shutdownHaskellAndSignal and add fast exit (a987b80)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a987b8004e83c694e00cdd47cbf43a9588eb47d4/ghc

>---------------------------------------------------------------

commit a987b8004e83c694e00cdd47cbf43a9588eb47d4
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Thu Nov 14 15:54:13 2013 +0000

    Improve the shutdownHaskellAndSignal and add fast exit
    
    This is the RTS part of a patch to base's topHandler to handle exiting
    by a signal.
    
    The intended behaviour is that on Unix, throwing ExitFailure (-sig)
    results in the process terminating with that signal. Previously
    shutdownHaskellAndSignal was only used for exiting with SIGINT due to
    the UserInterrupt exception.
    
    Improve shutdownHaskellAndSignal to do the signal part more carefully.
    In particular, it (should) now reliably terminates the process one way
    or another. Previusly if the signal was blocked, ignored or handled then
    shutdownHaskellAndSignal would actually return!
    
    Also, the topHandler code has two paths a careful shutdown and a "fast
    exit" where it does not give finalisers a chance to run. We want to
    support that mode also when we want to exit by signal. So rather than
    the base code directly calling stg_exit as it did before, we have a
    fastExit bool paramater for both shutdownHaskellAnd{Exit,Signal}.


>---------------------------------------------------------------

a987b8004e83c694e00cdd47cbf43a9588eb47d4
 includes/RtsAPI.h |   10 ++++-----
 rts/RtsMain.c     |    2 +-
 rts/RtsStartup.c  |   64 +++++++++++++++++++++++++++++++++++++++++++++--------
 3 files changed, 60 insertions(+), 16 deletions(-)

diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 29c28d8..daae30b 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -94,14 +94,12 @@ extern void hs_init_with_rtsopts (int *argc, char **argv[]);
 extern void hs_init_ghc (int *argc, char **argv[],   // program arguments
                          RtsConfig rts_config);      // RTS configuration
 
-extern void shutdownHaskellAndExit ( int exitCode )
-#if __GNUC__ >= 3
-    __attribute__((__noreturn__))
-#endif
-    ;
+extern void shutdownHaskellAndExit (int exitCode, int fastExit)
+    GNUC3_ATTRIBUTE(__noreturn__);
 
 #ifndef mingw32_HOST_OS
-extern void shutdownHaskellAndSignal (int sig);
+extern void shutdownHaskellAndSignal (int sig, int fastExit)
+     GNUC3_ATTRIBUTE(__noreturn__);
 #endif
 
 extern void getProgArgv            ( int *argc, char **argv[] );
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index 435df42..df63716 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -84,7 +84,7 @@ static void real_main(void)
     default:
       barf("main thread completed with invalid status");
     }
-    shutdownHaskellAndExit(exit_status);
+    shutdownHaskellAndExit(exit_status, 0 /* !fastExit */);
 }
 
 /* The rts entry point from a compiled program using a Haskell main
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index a1c74ae..aa7306f 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -455,24 +455,70 @@ shutdownHaskell(void)
 }
 
 void
-shutdownHaskellAndExit(int n)
+shutdownHaskellAndExit(int n, int fastExit)
 {
-    // even if hs_init_count > 1, we still want to shut down the RTS
-    // and exit immediately (see #5402)
-    hs_init_count = 1;
+    if (!fastExit) {
+        // even if hs_init_count > 1, we still want to shut down the RTS
+        // and exit immediately (see #5402)
+        hs_init_count = 1;
 
-    // we're about to exit(), no need to wait for foreign calls to return.
-    hs_exit_(rtsFalse);
+        // we're about to exit(), no need to wait for foreign calls to return.
+        hs_exit_(rtsFalse);
+    }
 
     stg_exit(n);
 }
 
 #ifndef mingw32_HOST_OS
+static void exitBySignal(int sig) GNUC3_ATTRIBUTE(__noreturn__);
+
 void
-shutdownHaskellAndSignal(int sig)
+shutdownHaskellAndSignal(int sig, int fastExit)
 {
-    hs_exit_(rtsFalse);
-    kill(getpid(),sig);
+    if (!fastExit) {
+        hs_exit_(rtsFalse);
+    }
+
+    exitBySignal(sig);
+}
+
+void
+exitBySignal(int sig)
+{
+    // We're trying to kill ourselves with a given signal.
+    // That's easier said that done because:
+    //  - signals can be ignored have handlers set for them
+    //  - signals can be masked
+    //  - signals default action can do things other than terminate:
+    //    + can do nothing
+    //    + can do weirder things: stop/continue the process
+
+    struct sigaction dfl;
+    sigset_t sigset;
+
+    // So first of all, we reset the signal to use the default action.
+    (void)sigemptyset(&dfl.sa_mask);
+    dfl.sa_flags = 0;
+    dfl.sa_handler = SIG_DFL;
+    (void)sigaction(sig, &dfl, NULL);
+
+    // Then we unblock the signal so we can deliver it to ourselves
+    sigemptyset(&sigset);
+    sigaddset(&sigset, sig);
+    sigprocmask(SIG_UNBLOCK, &sigset, NULL);
+
+    switch (sig) {
+      case SIGSTOP: case SIGTSTP: case SIGTTIN: case SIGTTOU: case SIGCONT:
+        // These signals stop (or continue) the process, so are no good for
+        // exiting.
+        exit(0xff);
+
+      default:
+        kill(getpid(),sig);
+        // But it's possible the signal is one where the default action is to
+        // ignore, in which case we'll still be alive... so just exit.
+        exit(0xff);
+    }
 }
 #endif