diff options
| -rw-r--r-- | includes/RtsAPI.h | 10 | ||||
| -rw-r--r-- | rts/RtsMain.c | 2 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 64 |
3 files changed, 60 insertions, 16 deletions
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index 29c28d8fcc..daae30b821 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 435df420c5..df637169f8 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 a1c74ae6a6..aa7306f88a 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 |