--- /dev/null
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2005
+ *
+ * Signal processing / handling.
+ *
+ * ---------------------------------------------------------------------------*/
+
+/* This is non-Posix-compliant.
+ #include "PosixSource.h"
+*/
+#include "Rts.h"
+#include "SchedAPI.h"
+#include "Schedule.h"
+#include "RtsSignals.h"
+#include "posix/Signals.h"
+#include "RtsUtils.h"
+#include "RtsFlags.h"
+
+#ifdef alpha_HOST_ARCH
+# if defined(linux_HOST_OS)
+# include <asm/fpu.h>
+# else
+# include <machine/fpu.h>
+# endif
+#endif
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_SIGNAL_H
+# include <signal.h>
+#endif
+
+#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;
+
+/* -----------------------------------------------------------------------------
+ * The table of signal handlers
+ * -------------------------------------------------------------------------- */
+
+#if defined(RTS_USER_SIGNALS)
+
+/* SUP: The type of handlers is a little bit, well, doubtful... */
+StgInt *signal_handlers = NULL; /* Dynamically grown array of signal handlers */
+static StgInt nHandlers = 0; /* Size of handlers array */
+
+static nat n_haskell_handlers = 0;
+
+/* -----------------------------------------------------------------------------
+ * Allocate/resize the table of signal handlers.
+ * -------------------------------------------------------------------------- */
+
+static void
+more_handlers(I_ sig)
+{
+ StgInt i;
+
+ if (sig < nHandlers)
+ return;
+
+ if (signal_handlers == NULL)
+ signal_handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt), "more_handlers");
+ else
+ signal_handlers = (StgInt *)stgReallocBytes(signal_handlers, (sig + 1) * sizeof(StgInt), "more_handlers");
+
+ for(i = nHandlers; i <= sig; i++)
+ // Fill in the new slots with default actions
+ signal_handlers[i] = STG_SIG_DFL;
+
+ nHandlers = sig + 1;
+}
+
+/* -----------------------------------------------------------------------------
+ * Pending Handlers
+ *
+ * The mechanism for starting handlers differs between the threaded
+ * (THREADED_RTS) and non-threaded versions of the RTS.
+ *
+ * When the RTS is single-threaded, we just write the pending signal
+ * handlers into a buffer, and start a thread for each one in the
+ * scheduler loop.
+ *
+ * When THREADED_RTS, the problem is that signals might be
+ * delivered to multiple threads, so we would need to synchronise
+ * access to pending_handler_buf somehow. Using thread
+ * synchronisation from a signal handler isn't possible in general
+ * (some OSs support it, eg. MacOS X, but not all). So instead:
+ *
+ * - the signal handler writes the signal number into the pipe
+ * managed by the IO manager thread (see GHC.Conc).
+ * - the IO manager picks up the signal number and calls
+ * startSignalHandler() to start the thread.
+ *
+ * This also has the nice property that we don't need to arrange to
+ * wake up a worker task to start the signal handler: the IO manager
+ * wakes up when we write into the pipe.
+ *
+ * -------------------------------------------------------------------------- */
+
+// Here's the pipe into which we will send our signals
+static int io_manager_pipe = -1;
+
+void
+setIOManagerPipe (int fd)
+{
+ // only called when THREADED_RTS, but unconditionally
+ // compiled here because GHC.Conc depends on it.
+ io_manager_pipe = fd;
+}
+
+#if !defined(THREADED_RTS)
+
+#define N_PENDING_HANDLERS 16
+
+StgPtr pending_handler_buf[N_PENDING_HANDLERS];
+StgPtr *next_pending_handler = pending_handler_buf;
+
+#endif /* THREADED_RTS */
+
+/* -----------------------------------------------------------------------------
+ * SIGCONT handler
+ *
+ * It seems that shells tend to put stdin back into blocking mode
+ * following a suspend/resume of the process. Here we arrange to put
+ * it back into non-blocking mode. We don't do anything to
+ * stdout/stderr because these handles don't get put into non-blocking
+ * mode at all - see the comments on stdout/stderr in PrelHandle.hsc.
+ * -------------------------------------------------------------------------- */
+
+static void
+cont_handler(int sig STG_UNUSED)
+{
+ setNonBlockingFd(0);
+}
+
+/* -----------------------------------------------------------------------------
+ * Low-level signal handler
+ *
+ * Places the requested handler on a stack of pending handlers to be
+ * started up at the next context switch.
+ * -------------------------------------------------------------------------- */
+
+static void
+generic_handler(int sig)
+{
+ sigset_t signals;
+
+#if defined(THREADED_RTS)
+
+ if (io_manager_pipe != -1)
+ {
+ // Write the signal number into the pipe as a single byte. We
+ // hope that signals fit into a byte...
+ StgWord8 csig = (StgWord8)sig;
+ write(io_manager_pipe, &csig, 1);
+ }
+ // If the IO manager hasn't told us what the FD of the write end
+ // of its pipe is, there's not much we can do here, so just ignore
+ // the signal..
+
+#else /* not THREADED_RTS */
+
+ /* Can't call allocate from here. Probably can't call malloc
+ 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 do we
+ communicate this to the scheduler?
+
+ We need some kind of locking, but with low overhead (i.e. no
+ blocking signals every time around the scheduler).
+
+ Signal Handlers are atomic (i.e. they can't be interrupted), and
+ we can make use of this. We just need to make sure the
+ critical section of the scheduler can't be interrupted - the
+ only way to do this is to block signals. However, we can lower
+ the overhead by only blocking signals when there are any
+ handlers to run, i.e. the set of pending handlers is
+ non-empty.
+ */
+
+ /* We use a stack to store the pending signals. We can't
+ dynamically grow this since we can't allocate any memory from
+ within a signal handler.
+
+ Hence unfortunately we have to bomb out if the buffer
+ overflows. It might be acceptable to carry on in certain
+ circumstances, depending on the signal.
+ */
+
+ *next_pending_handler++ = deRefStablePtr((StgStablePtr)signal_handlers[sig]);
+
+ // stack full?
+ if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
+ errorBelch("too many pending signals");
+ stg_exit(EXIT_FAILURE);
+ }
+
+#endif /* THREADED_RTS */
+
+ // re-establish the signal handler, and carry on
+ sigemptyset(&signals);
+ sigaddset(&signals, sig);
+ sigprocmask(SIG_UNBLOCK, &signals, NULL);
+
+ // *always* do the SIGCONT handler, even if the user overrides it.
+ if (sig == SIGCONT) {
+ cont_handler(sig);
+ }
+
+ context_switch = 1;
+}
+
+/* -----------------------------------------------------------------------------
+ * Blocking/Unblocking of the user signals
+ * -------------------------------------------------------------------------- */
+
+static sigset_t userSignals;
+static sigset_t savedSignals;
+
+void
+initUserSignals(void)
+{
+ sigemptyset(&userSignals);
+}
+
+void
+blockUserSignals(void)
+{
+ sigprocmask(SIG_BLOCK, &userSignals, &savedSignals);
+}
+
+void
+unblockUserSignals(void)
+{
+ sigprocmask(SIG_SETMASK, &savedSignals, NULL);
+}
+
+rtsBool
+anyUserHandlers(void)
+{
+ return n_haskell_handlers != 0;
+}
+
+#if !defined(THREADED_RTS)
+void
+awaitUserSignals(void)
+{
+ while (!signals_pending() && !interrupted) {
+ pause();
+ }
+}
+#endif
+
+/* -----------------------------------------------------------------------------
+ * Install a Haskell signal handler.
+ * -------------------------------------------------------------------------- */
+
+int
+stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
+{
+ 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, &osignals)) {
+ return STG_SIG_ERR;
+ }
+
+ more_handlers(sig);
+
+ previous_spi = signal_handlers[sig];
+
+ action.sa_flags = 0;
+
+ switch(spi) {
+ case STG_SIG_IGN:
+ signal_handlers[sig] = STG_SIG_IGN;
+ sigdelset(&userSignals, sig);
+ action.sa_handler = SIG_IGN;
+ break;
+
+ case STG_SIG_DFL:
+ signal_handlers[sig] = STG_SIG_DFL;
+ sigdelset(&userSignals, sig);
+ action.sa_handler = SIG_DFL;
+ break;
+
+ case STG_SIG_HAN:
+ case STG_SIG_RST:
+ signal_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 != NULL)
+ action.sa_mask = *(sigset_t *)mask;
+ else
+ sigemptyset(&action.sa_mask);
+
+ action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
+
+ if (sigaction(sig, &action, 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,signal_handlers[sig]));
+ n_haskell_handlers--;
+ }
+ return STG_SIG_ERR;
+ }
+
+ 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;
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ * Creating new threads for signal handlers.
+ * -------------------------------------------------------------------------- */
+
+#if !defined(THREADED_RTS)
+void
+startSignalHandlers(void)
+{
+ blockUserSignals();
+
+ ASSERT_LOCK_HELD(&sched_mutex);
+
+ while (next_pending_handler != pending_handler_buf) {
+
+ next_pending_handler--;
+
+ scheduleThread (
+ &MainCapability,
+ createIOThread(&MainCapability,
+ RtsFlags.GcFlags.initialStkSize,
+ (StgClosure *) *next_pending_handler));
+ }
+
+ unblockUserSignals();
+}
+#endif
+
+/* ----------------------------------------------------------------------------
+ * 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.
+ * -------------------------------------------------------------------------- */
+
+#if !defined(THREADED_RTS)
+void
+markSignalHandlers (evac_fn evac)
+{
+ StgPtr *p;
+
+ p = next_pending_handler;
+ while (p != pending_handler_buf) {
+ p--;
+ evac((StgClosure **)p);
+ }
+}
+#else
+void
+markSignalHandlers (evac_fn evac STG_UNUSED)
+{
+}
+#endif
+
+#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.
+ *
+ * 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);
+ 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) {
+ stg_exit(EXIT_INTERRUPTED);
+ } else {
+ interruptStgRts();
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ * Install default signal handlers.
+ *
+ * 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.
+ *
+ * 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
+initDefaultHandlers()
+{
+ struct sigaction action,oact;
+
+#ifdef SMP
+ startup_guy = pthread_self();
+#endif
+
+ // install the SIGINT handler
+ action.sa_handler = shutdown_handler;
+ sigemptyset(&action.sa_mask);
+ action.sa_flags = 0;
+ if (sigaction(SIGINT, &action, &oact) != 0) {
+ 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) {
+ 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) {
+ errorBelch("warning: failed to install SIGFPE handler");
+ }
+#endif
+
+#ifdef alpha_HOST_ARCH
+ ieee_set_fp_control(0);
+#endif
+}
+
+#endif /* RTS_USER_SIGNALS */
projects / ghc-hetmet.git / blobdiff