X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSignals.c;h=ee5ef810321d69f7217e6bc377cc3ee9d6476be5;hb=b86f4b95cb51d69a2537217132f675afa1e9519c;hp=6d9ea447e1b930b2edc3468680a50ffc72843fce;hpb=7f309f1c021e7583f724cce599ce2dd3c439361b;p=ghc-hetmet.git diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c index 6d9ea44..ee5ef81 100644 --- a/ghc/rts/Signals.c +++ b/ghc/rts/Signals.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Signals.c,v 1.4 1999/02/05 16:02:54 simonm Exp $ + * $Id: Signals.c,v 1.17 2000/04/14 16:47:43 panne Exp $ * * (c) The GHC Team, 1998-1999 * @@ -9,13 +9,17 @@ #include "Rts.h" #include "SchedAPI.h" +#include "Schedule.h" #include "Signals.h" #include "RtsUtils.h" #include "RtsFlags.h" #include "StablePriv.h" +#ifndef mingw32_TARGET_OS + #ifndef PAR +/* SUP: The type of handlers is a little bit, well, doubtful... */ static StgInt *handlers = NULL; /* Dynamically grown array of signal handlers */ static StgInt nHandlers = 0; /* Size of handlers array */ @@ -36,21 +40,20 @@ more_handlers(I_ sig) I_ i; if (sig < nHandlers) - return; + return; if (handlers == NULL) - handlers = (I_ *) malloc((sig + 1) * sizeof(I_)); + handlers = (I_ *) malloc((sig + 1) * sizeof(I_)); else - handlers = (I_ *) realloc(handlers, (sig + 1) * sizeof(I_)); + handlers = (I_ *) realloc(handlers, (sig + 1) * sizeof(I_)); if (handlers == NULL) { - fflush(stdout); - fprintf(stderr, "VM exhausted (in more_handlers)\n"); - exit(EXIT_FAILURE); + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + barf("VM exhausted (in more_handlers)"); } for(i = nHandlers; i <= sig; i++) - /* Fill in the new slots with default actions */ - handlers[i] = STG_SIG_DFL; + /* Fill in the new slots with default actions */ + handlers[i] = STG_SIG_DFL; nHandlers = sig + 1; } @@ -71,7 +74,7 @@ generic_handler(int sig) either. However, we have to schedule a new thread somehow. It's probably ok to request a context switch and allow the - scheduler to start the handler thread, but how to we + scheduler to start the handler thread, but how do we communicate this to the scheduler? We need some kind of locking, but with low overhead (i.e. no @@ -95,7 +98,7 @@ generic_handler(int sig) circumstances, depending on the signal. */ - *next_pending_handler++ = deRefStablePtr(handlers[sig]); + *next_pending_handler++ = deRefStablePtr(stgCast(StgStablePtr,handlers[sig])); /* stack full? */ if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) { @@ -106,6 +109,8 @@ generic_handler(int sig) sigemptyset(&signals); sigaddset(&signals, sig); sigprocmask(SIG_UNBLOCK, &signals, NULL); + + context_switch = 1; } /* ----------------------------------------------------------------------------- @@ -167,11 +172,13 @@ sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) sigdelset(&userSignals, sig); action.sa_handler = SIG_DFL; break; + case STG_SIG_HAN: handlers[sig] = (I_)handler; sigaddset(&userSignals, sig); action.sa_handler = generic_handler; break; + default: barf("sig_install: bad spi"); } @@ -190,7 +197,7 @@ sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) * by freeing the previous handler if there was one. */ if (previous_spi >= 0) { - freeStablePtr(handlers[sig]); + freeStablePtr(stgCast(StgStablePtr,handlers[sig])); } return STG_SIG_ERR; } @@ -211,12 +218,9 @@ start_signal_handlers(void) next_pending_handler--; - /* create*Thread puts the thread on the head of the runnable - * queue, hence it will be run next. Poor man's priority - * scheduling. - */ - createIOThread(RtsFlags.GcFlags.initialStkSize, - (StgClosure *) *next_pending_handler); + scheduleThread( + createIOThread(RtsFlags.GcFlags.initialStkSize, + (StgClosure *) *next_pending_handler)); } unblockUserSignals(); @@ -226,10 +230,8 @@ start_signal_handlers(void) StgInt sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) { - fflush(stdout); - fprintf(stderr, - "No signal handling support in a parallel implementation.\n"); - exit(EXIT_FAILURE); + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + barf("no signal handling support in a parallel implementation"); } void @@ -237,3 +239,66 @@ start_signal_handlers(void) { } #endif + +/* ----------------------------------------------------------------------------- + SIGINT handler. + + We like to shutdown nicely after receiving a SIGINT, write out the + stats, write profiling info, close open files and flush buffers etc. + -------------------------------------------------------------------------- */ + +#ifdef SMP +pthread_t startup_guy; +#endif + +static void +shutdown_handler(int sig STG_UNUSED) +{ +#ifdef SMP + /* if I'm a worker thread, send this signal to the guy who + * originally called startupHaskell(). Since we're handling + * the signal, it won't be a "send to all threads" type of signal + * (according to the POSIX threads spec). + */ + if (pthread_self() != startup_guy) { + pthread_kill(startup_guy, sig); + } else +#endif + + /* If we're already trying to interrupt the RTS, terminate with + * extreme prejudice. So the first ^C tries to exit the program + * cleanly, and the second one just kills it. + */ + if (interrupted) { + exit(EXIT_INTERRUPTED); + } else { + interruptStgRts(); + } +} + +/* + * The RTS installs a default signal handler for catching + * SIGINT, so that we can perform an orderly shutdown. + * + * Haskell code may install their own SIGINT handler, which is + * fine, provided they're so kind as to put back the old one + * when they de-install. + */ +void +init_default_handlers() +{ + struct sigaction action,oact; + +#ifdef SMP + startup_guy = pthread_self(); +#endif + action.sa_handler = shutdown_handler; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (sigaction(SIGINT, &action, &oact) != 0) { + /* Oh well, at least we tried. */ + prog_belch("failed to install SIGINT handler"); + } +} + +#endif /*! mingw32_TARGET_OS */