X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSignals.c;h=d476a01a06fc7a5f71e54765f2e5dce7ab6fa131;hb=f2eadfd5dfb23cc611e2540f46180bca7d095f15;hp=6e5d859fda690784c0c31722ca4ff741c4f4603b;hpb=1862438e1e29c4f4069d9ca43b25445078547faa;p=ghc-hetmet.git diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c index 6e5d859..d476a01 100644 --- a/ghc/rts/Signals.c +++ b/ghc/rts/Signals.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Signals.c,v 1.8 1999/09/22 11:53:33 sof Exp $ + * $Id: Signals.c,v 1.21 2001/08/14 13:40:09 sewardj Exp $ * * (c) The GHC Team, 1998-1999 * @@ -7,6 +7,9 @@ * * ---------------------------------------------------------------------------*/ +/* This is non=Posix compliant. + #include "PosixSource.h" +*/ #include "Rts.h" #include "SchedAPI.h" #include "Schedule.h" @@ -15,10 +18,15 @@ #include "RtsFlags.h" #include "StablePriv.h" +#ifdef alpha_TARGET_ARCH +#include +#endif + #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 */ @@ -48,8 +56,7 @@ more_handlers(I_ sig) if (handlers == NULL) { /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - fprintf(stderr, "VM exhausted (in more_handlers)\n"); - exit(EXIT_FAILURE); + barf("VM exhausted (in more_handlers)"); } for(i = nHandlers; i <= sig; i++) /* Fill in the new slots with default actions */ @@ -98,7 +105,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]) { @@ -144,7 +151,7 @@ unblockUserSignals(void) -------------------------------------------------------------------------- */ StgInt -sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) +stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) { sigset_t signals; struct sigaction action; @@ -180,7 +187,7 @@ sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) break; default: - barf("sig_install: bad spi"); + barf("stg_sig_install: bad spi"); } if (mask != 0) @@ -197,7 +204,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; } @@ -218,12 +225,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(); @@ -231,12 +235,10 @@ start_signal_handlers(void) #else /* PAR */ StgInt -sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) +stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask) { /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - fprintf(stderr, - "No signal handling support in a parallel implementation.\n"); - exit(EXIT_FAILURE); + barf("no signal handling support in a parallel implementation"); } void @@ -245,38 +247,83 @@ 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) +shutdown_handler(int sig STG_UNUSED) { - shutdownHaskellAndExit(EXIT_FAILURE); +#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 (finalising - * objects and flushing buffers etc.) + * 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. + * + * In addition to handling SIGINT, the RTS also handles SIGFPE + * by ignoring it. Apparently IEEE requires floating-point + * exceptions to be ignored by default, but alpha-dec-osf3 + * doesn't seem to do so. */ void -init_shutdown_handler() +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. */ -#ifdef DEBUG - fprintf(stderr, "init_shutdown_handler: failed to reg SIGINT handler"); -#endif + prog_belch("failed to install SIGINT handler"); } -} - + siginterrupt(SIGINT, 1); + action.sa_handler = SIG_IGN; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (sigaction(SIGFPE, &action, &oact) != 0) { + /* Oh well, at least we tried. */ + prog_belch("failed to install SIGFPE handler"); + } +#ifdef alpha_TARGET_ARCH + ieee_set_fp_control(0); +#endif +} #endif /*! mingw32_TARGET_OS */