/* -----------------------------------------------------------------------------
- * $Id: Signals.c,v 1.22 2001/10/31 10:34:29 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Signals.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
-#include "StablePriv.h"
-#ifdef alpha_TARGET_ARCH
-#include <machine/fpu.h>
+#ifdef alpha_HOST_ARCH
+# if defined(linux_HOST_OS)
+# include <asm/fpu.h>
+# else
+# include <machine/fpu.h>
+# endif
#endif
-#ifndef mingw32_TARGET_OS
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_SIGNAL_H
+# include <signal.h>
+#endif
-#ifndef PAR
+#include <stdlib.h>
+
+/* This curious flag is provided for the benefit of the Haskell binding
+ * to POSIX.1 to control whether or not to include SA_NOCLDSTOP when
+ * installing a SIGCHLD handler.
+ *
+ */
+StgInt nocldstop = 0;
+
+#if defined(RTS_USER_SIGNALS)
/* 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 */
+static nat n_haskell_handlers = 0;
+
#define N_PENDING_HANDLERS 16
StgPtr pending_handler_buf[N_PENDING_HANDLERS];
StgPtr *next_pending_handler = pending_handler_buf;
-StgInt nocldstop = 0;
+/* -----------------------------------------------------------------------------
+ * Signal handling
+ * -------------------------------------------------------------------------- */
+
+#ifdef RTS_SUPPORTS_THREADS
+pthread_t signalHandlingThread;
+#endif
+
+// Handle all signals in the current thread.
+// Called from Capability.c whenever the main capability is granted to a thread
+// and in installDefaultHandlers
+void
+handleSignalsInThisThread(void)
+{
+#ifdef RTS_SUPPORTS_THREADS
+ signalHandlingThread = pthread_self();
+#endif
+}
/* -----------------------------------------------------------------------------
* Allocate/resize the table of signal handlers.
return;
if (handlers == NULL)
- handlers = (StgInt *) malloc((sig + 1) * sizeof(StgInt));
+ handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt), "more_handlers");
else
- handlers = (StgInt *) realloc(handlers, (sig + 1) * sizeof(StgInt));
+ handlers = (StgInt *)stgReallocBytes(handlers, (sig + 1) * sizeof(StgInt), "more_handlers");
- if (handlers == NULL) {
- // 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;
{
sigset_t signals;
+#if defined(THREADED_RTS)
+ // Make the thread that currently holds the main capability
+ // handle the signal.
+ // This makes sure that awaitEvent() is interrupted
+ // and it (hopefully) prevents race conditions
+ // (signal handlers are not atomic with respect to other threads)
+
+ if(pthread_self() != signalHandlingThread) {
+ pthread_kill(signalHandlingThread, sig);
+ return;
+ }
+#endif
+
/* Can't call allocate from here. Probably can't call malloc
either. However, we have to schedule a new thread somehow.
// stack full?
if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
- barf("too many pending signals");
+ errorBelch("too many pending signals");
+ stg_exit(EXIT_FAILURE);
}
// re-establish the signal handler, and carry on
void
blockUserSignals(void)
{
- sigprocmask(SIG_SETMASK, &userSignals, &savedSignals);
+ sigprocmask(SIG_BLOCK, &userSignals, &savedSignals);
}
void
sigprocmask(SIG_SETMASK, &savedSignals, NULL);
}
+rtsBool
+anyUserHandlers(void)
+{
+ return n_haskell_handlers != 0;
+}
+
+void
+awaitUserSignals(void)
+{
+ while (!signals_pending() && !interrupted) {
+ pause();
+ }
+}
/* -----------------------------------------------------------------------------
* Install a Haskell signal handler.
* -------------------------------------------------------------------------- */
-StgInt
-stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask)
+int
+stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
{
- sigset_t signals;
+ sigset_t signals, osignals;
struct sigaction action;
StgInt previous_spi;
// Block the signal until we figure out what to do
// Count on this to fail if the signal number is invalid
if (sig < 0 || sigemptyset(&signals) ||
- sigaddset(&signals, sig) || sigprocmask(SIG_BLOCK, &signals, NULL)) {
+ sigaddset(&signals, sig) || sigprocmask(SIG_BLOCK, &signals, &osignals)) {
return STG_SIG_ERR;
}
previous_spi = handlers[sig];
+ action.sa_flags = 0;
+
switch(spi) {
case STG_SIG_IGN:
handlers[sig] = STG_SIG_IGN;
break;
case STG_SIG_HAN:
- handlers[sig] = (StgInt)handler;
+ case STG_SIG_RST:
+ handlers[sig] = (StgInt)*handler;
sigaddset(&userSignals, sig);
action.sa_handler = generic_handler;
+ if (spi == STG_SIG_RST) {
+ action.sa_flags = SA_RESETHAND;
+ }
+ n_haskell_handlers++;
break;
default:
barf("stg_sig_install: bad spi");
}
- if (mask != 0)
- action.sa_mask = *mask;
+ if (mask != NULL)
+ action.sa_mask = *(sigset_t *)mask;
else
sigemptyset(&action.sa_mask);
- action.sa_flags = sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
+ action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
if (sigaction(sig, &action, NULL) ||
- sigprocmask(SIG_UNBLOCK, &signals, NULL))
+ sigprocmask(SIG_SETMASK, &osignals, NULL))
{
// need to return an error code, so avoid a stable pointer leak
// by freeing the previous handler if there was one.
if (previous_spi >= 0) {
freeStablePtr(stgCast(StgStablePtr,handlers[sig]));
+ n_haskell_handlers--;
}
return STG_SIG_ERR;
}
-
- return previous_spi;
+
+ if (previous_spi == STG_SIG_DFL || previous_spi == STG_SIG_IGN
+ || previous_spi == STG_SIG_ERR) {
+ return previous_spi;
+ } else {
+ *handler = (StgStablePtr)previous_spi;
+ return STG_SIG_HAN;
+ }
}
/* -----------------------------------------------------------------------------
unblockUserSignals();
}
-#else // PAR
-StgInt
-stg_sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask)
+/* ----------------------------------------------------------------------------
+ * Mark signal handlers during GC.
+ *
+ * We do this rather than trying to start all the signal handlers
+ * prior to GC, because that requires extra heap for the new threads.
+ * Signals must be blocked (see blockUserSignals() above) during GC to
+ * avoid race conditions.
+ * -------------------------------------------------------------------------- */
+
+void
+markSignalHandlers (evac_fn evac)
{
- // don't fflush(stdout); WORKAROUND bug in Linux glibc
- barf("no signal handling support in a parallel implementation");
+ StgPtr *p;
+
+ p = next_pending_handler;
+ while (p != pending_handler_buf) {
+ p--;
+ evac((StgClosure **)p);
+ }
}
-void
-startSignalHandlers(void)
+#else /* !RTS_USER_SIGNALS */
+StgInt
+stg_sig_install(StgInt sig STG_UNUSED,
+ StgInt spi STG_UNUSED,
+ StgStablePtr* handler STG_UNUSED,
+ void* mask STG_UNUSED)
{
+ //barf("User signals not supported");
+ return STG_SIG_DFL;
}
+
#endif
+#if defined(RTS_USER_SIGNALS)
/* -----------------------------------------------------------------------------
* SIGINT handler.
*
pthread_kill(startup_guy, sig);
return;
}
+ // ToDo: The code for the threaded RTS below does something very
+ // similar. Maybe the SMP special case is not needed
+ // -- Wolfgang Thaller
+#elif defined(THREADED_RTS)
+ // Make the thread that currently holds the main capability
+ // handle the signal.
+ // This makes sure that awaitEvent() is interrupted
+ if(pthread_self() != signalHandlingThread) {
+ pthread_kill(signalHandlingThread, sig);
+ return;
+ }
#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);
+ stg_exit(EXIT_INTERRUPTED);
} else {
interruptStgRts();
}
#ifdef SMP
startup_guy = pthread_self();
#endif
+#ifdef RTS_SUPPORTS_THREADS
+ handleSignalsInThisThread();
+#endif
// install the SIGINT handler
action.sa_handler = shutdown_handler;
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGINT, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGINT handler");
+ errorBelch("warning: failed to install SIGINT handler");
}
+#if defined(HAVE_SIGINTERRUPT)
siginterrupt(SIGINT, 1); // isn't this the default? --SDM
+#endif
// install the SIGCONT handler
action.sa_handler = cont_handler;
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGCONT, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGCONT handler");
+ errorBelch("warning: failed to install SIGCONT handler");
}
// install the SIGFPE handler
+
+ // In addition to handling SIGINT, also handle 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.
+
+ // Commented out by SDM 2/7/2002: this causes an infinite loop on
+ // some architectures when an integer division by zero occurs: we
+ // don't recover from the floating point exception, and the
+ // program just generates another one immediately.
+#if 0
action.sa_handler = SIG_IGN;
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGFPE, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGFPE handler");
+ errorBelch("warning: failed to install SIGFPE handler");
}
-#ifdef alpha_TARGET_ARCH
+#endif
+
+#ifdef alpha_HOST_ARCH
ieee_set_fp_control(0);
#endif
}
-#endif /*! mingw32_TARGET_OS */
+#endif /* RTS_USER_SIGNALS */