+++ /dev/null
-%
-% (c) The AQUA Project, Glasgow University, 1995
-%
-%************************************************************************
-%* *
-\section[Signals.lc]{Signal Handlers}
-%* *
-%************************************************************************
-
-There are two particular signals that we find interesting in the RTS:
-segmentation faults (for cheap stack overflow checks) and virtual
-timer alarms (for profiling and thread context switching). POSIX
-compliance is supposed to make this kind of thing easy, but it
-doesn't. Expect every new target platform to require gory hacks to
-get this stuff to work.
-
-Then, there are the user-specified signal handlers to cope with.
-Since they're pretty rudimentary, they shouldn't actually cause as
-much pain.
-
-\begin{code}
-#include "config.h"
-
-/* Treat nexttep3 and sunos4 alike. CaS */
-#if defined(nextstep3_TARGET_OS)
-# define NON_POSIX_SOURCE
-#endif
-
-#if defined(sunos4_TARGET_OS)
- /* The sigaction in SunOS 4.1.X does not grok SA_SIGINFO */
-# define NON_POSIX_SOURCE
-#endif
-
-#if defined(freebsd_TARGET_OS)
-# define NON_POSIX_SOURCE
-#endif
-
-#if defined(osf3_TARGET_OS) || defined(osf1_TARGET_OS)
- /* The include files for OSF1 do not normally define SA_SIGINFO */
-# define _OSF_SOURCE 1
-#endif
-
-#if irix_TARGET_OS
-/* SIGVTALRM not avail w/ POSIX_SOURCE, but worse things happen without */
-/* SIGH: triple SIGH (WDP 95/07) */
-# define SIGVTALRM 28
-#endif
-
-#include "rtsdefs.h"
-
-#if defined(HAVE_SYS_TYPES_H)
-# include <sys/types.h>
-#endif
-
- /* This is useful with the particular set of header files on my NeXT.
- * CaS
- */
-#if defined(HAVE_SYS_SIGNAL_H)
-# include <sys/signal.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#if defined(linux_TARGET_OS) || defined(linuxaout_TARGET_OS)
-/* to look *inside* sigcontext...
-
- sigcontext has moved and been protected from the General Public,
- in later versions (>2), the sigcontext decl is protected by
- a __KERNEL__ #ifdef. As ever, we workaround by trying to
- be version savvy - the version numbers are currently just a guess!
- (ToDo: determine at what version no. the sigcontext move
- was made).
-*/
-# ifndef LINUX_VERSION_CODE
-# include <linux/version.h>
-# endif
-/* Snaffled from drivers/scsi/eata.c in 2.0.30 sources */
-#define LinuxVersionCode(v, p, s) (((v)<<16)+((p)<<8)+(s))
-# if ( LINUX_VERSION_CODE < LinuxVersionCode(2,0,0) )
-# include <asm/signal.h>
-# else
-# include <asm/sigcontext.h>
-# endif
-
-#endif
-
-#if defined(HAVE_SIGINFO_H)
- /* DEC OSF1 seems to need this explicitly. Maybe others do as well? */
-# include <siginfo.h>
-#endif
-
-#if defined(cygwin32_TARGET_OS)
-# include <windows.h>
-#endif
-
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Stack-check by protected-memory-faulting}
-%* *
-%************************************************************************
-
-If we are checking stack overflow by page faulting, then we need to be
-able to install a @SIGSEGV@ handler, preferably one which can
-determine where the fault occurred, so that we can satisfy ourselves
-that it really was a stack overflow and not some random segmentation
-fault.
-
-\begin{code}
-#if STACK_CHECK_BY_PAGE_FAULT
- /* NB: At the moment, this is always false on nextstep3. CaS. */
-
-extern P_ stks_space; /* Where the stacks live, from SMstacks.lc */
-\end{code}
-
-SunOS 4.x is too old to have @SA_SIGINFO@ as a flag to @sigaction@, so
-we use the older @signal@ call instead. This means that we also have
-to set up the handler to expect a different collection of arguments.
-Fun, eh?
-
-\begin{code}
-# if defined(sunos4_TARGET_OS) || defined(freebsd_TARGET_OS) \
- || defined(linux_TARGET_OS) || defined(linuxaout_TARGET_OS) \
- || defined(aix_TARGET_OS)
-
-static void
-segv_handler(int sig,
- /* NB: all except first argument are "implementation defined" */
-# if defined(sunos4_TARGET_OS) || defined(freebsd_TARGET_OS)
- int code, struct sigcontext *scp, caddr_t addr)
-# else /* linux || aix */
-# if defined(aix_TARGET_OS)
- int code, struct sigcontext *scp)
-# else /* linux */
- /* sigcontext_struct has been renamed to sigcontext. If
- compiling this code elicits a bunch of warnings about
- "struct sigcontext_struct" being undeclared, check to
- see whether you've got "struct sigcontext" in <asm/sigcontext.h>.
- or not.
-
- If you do, lower the version number below to fit the version
- you're running (and pass us a note saying that you had to - thx!)
- */
-# if LINUX_VERSION_CODE >= LinuxVersionCode(2,1,51)
- /* sigcontext_struct has been renamed to sigcontext */
- struct sigcontext scp)
-# else
- struct sigcontext_struct scp)
-# endif
-# endif
-# endif
-{
- extern void StackOverflow(STG_NO_ARGS) STG_NORETURN;
-
-# if defined(linux_TARGET_OS) || defined(linuxaout_TARGET_OS)
- unsigned long addr = scp.cr2;
- /* Magic info from Tommy Thorn! */
-# endif
-# if defined(aix_TARGET_OS)
- caddr_t addr = scp->sc_jmpbuf.jmp_context.o_vaddr;
- /* Magic guess by andre */
-# endif
- if ( (char *)addr >= (char *)stks_space
- && (char *)addr < (char *)(stks_space + RTSflags.GcFlags.stksSize))
- StackOverflow();
-
- fflush(stdout);
- fprintf(stderr, "Segmentation fault caught, address = %lx\n", (W_) addr);
- abort();
-}
-
-int
-install_segv_handler(void)
-{
-#if freebsd_TARGET_OS
- /* FreeBSD seems to generate SIGBUS for stack overflows */
- if (signal(SIGBUS, segv_handler) == SIG_ERR)
- return -1;
- if (signal(SIGSEGV, segv_handler) == SIG_ERR)
- return -1;
- return 0;
-#else
- return ((int) signal(SIGSEGV, segv_handler) == SIG_ERR);
- /* I think the "== SIG_ERR" is saying "there was no
- handler for SIGSEGV before this one". WDP 95/12
- */
-#endif
-}
-
-# elif defined(irix6_TARGET_OS)
-
-static void
-segv_handler(int sig, siginfo_t *sip, void *dummy)
-{
- fflush(stdout);
- if (sip == NULL) {
- fprintf(stderr, "Segmentation fault caught, address unknown\n");
- } else {
- if (sip->si_addr >= (void *) stks_space
- && sip->si_addr < (void *) (stks_space + RTSflags.GcFlags.stksSize))
- StackOverflow();
- fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_) sip->si_addr);
- }
- abort();
-}
-
-int
-install_segv_handler(STG_NO_ARGS)
-{
- struct sigaction action;
-
- action.sa_sigaction = segv_handler;
- sigemptyset(&action.sa_mask);
- action.sa_flags = SA_SIGINFO;
-
- return sigaction(SIGSEGV, &action, NULL);
-}
-
-# elif defined(cygwin32_TARGET_OS)
-
-/*
- The signal handlers in cygwin32 are only passed the signal
- number, no sigcontext/siginfo is passed as event data..sigh. For
- SIGSEGV, to get at the violating address, we need to use the Win32's
- GetThreadContext() to get at the faulting address.
-*/
-static void
-segv_handler(sig)
- int sig;
-{
- CONTEXT context;
- HANDLE hThread;
- BOOL t;
-
- context.ContextFlags = CONTEXT_CONTROL;
- hThread = GetCurrentThread(); /* cannot fail */
- t = GetThreadContext(hThread,&context);
-
- fflush(stdout);
- if (t == FALSE) {
- fprintf(stderr, "Segmentation fault caught, address unknown\n");
- } else {
- void *si_addr = context.Eip; /* magic */
- if (si_addr >= (void *) stks_space
- && si_addr < (void *) (stks_space + RTSflags.GcFlags.stksSize))
- StackOverflow();
-
- fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_)si_addr);
- }
- abort();
-}
-
-int
-install_segv_handler()
-{
- return (int) signal(SIGSEGV, segv_handler) == -1;
-}
-
-# else /* ! (cygwin32|irix6|sunos4|linux*|*bsd|aix) */
-
-# if defined(irix_TARGET_OS)
- /* certainly BOGUS (WDP 94/05) -- copied from /usr/include/sys/siginfo.h */
-# define si_addr _data._fault._addr
-# endif
-
-static void
-segv_handler(int sig, siginfo_t *sip)
- /* NB: the second "siginfo_t" argument is not really standard */
-{
- fflush(stdout);
- if (sip == NULL) {
- fprintf(stderr, "Segmentation fault caught, address unknown\n");
- } else {
- if (sip->si_addr >= (caddr_t) stks_space
- && sip->si_addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize))
- StackOverflow();
-
- fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_) sip->si_addr);
- }
- abort();
-}
-
-int
-install_segv_handler(STG_NO_ARGS)
-{
- struct sigaction action;
-
- action.sa_handler = segv_handler;
- sigemptyset(&action.sa_mask);
- action.sa_flags = SA_SIGINFO;
-
- return sigaction(SIGSEGV, &action, NULL);
-}
-
-# endif /* ! (cygwin32|irix6|sunos4|linux*|*bsd|aix) */
-
-#endif /* STACK_CHECK_BY_PAGE_FAULT */
-
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Virtual-timer alarm (for profiling, etc.)}
-%* *
-%************************************************************************
-
-The timer interrupt is somewhat simpler, and we could probably use
-sigaction across the board, but since we have committed ourselves to
-the non-POSIX signal under SunOS 4.1.X, we adopt the same approach
-here.
-
-\begin{code}
-#if defined(PROFILING) || defined(CONCURRENT) /* && !defined(GRAN) */
-
-# ifdef CONCURRENT
-
-extern I_ delayTicks;
-
-# ifdef PAR
-extern P_ CurrentTSO;
-# endif
-
-/*
- cygwin32 does not support VTALRM (sigh) - to do anything
- sensible here we use the underlying Win32 calls.
- (will this work??)
-*/
-# if defined(cygwin32_TARGET_OS)
-/* windows.h already included */
-static VOID CALLBACK
-vtalrm_handler(uID,uMsg,dwUser,dw1,dw2)
-int uID;
-unsigned int uMsg;
-unsigned int dwUser;
-unsigned int dw1;
-unsigned int dw2;
-# else
-static void
-vtalrm_handler(int sig)
-# endif
-{
-/*
- For the parallel world, currentTSO is set if there is any work
- on the current PE. In this case we DO want to context switch,
- in case other PEs have sent us messages which must be processed.
-*/
-
-# if defined(PROFILING) || defined(PAR)
- static I_ csTicks = 0, pTicks = 0;
-
- if (time_profiling) {
- if (++pTicks % RTSflags.CcFlags.profilerTicks == 0) {
-# if ! defined(PROFILING)
- handle_tick_serial();
-# else
- if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
- || RTSflags.ProfFlags.doHeapProfile)
- handle_tick_serial();
- else
- handle_tick_noserial();
-# endif
- }
- if (++csTicks % RTSflags.CcFlags.ctxtSwitchTicks != 0)
- return;
- }
-# endif
-
- /*
- Handling a tick for threads blocked waiting for file
- descriptor I/O or time.
-
- This requires some care since virtual time alarm ticks
- can occur when we are in the GC. If that is the case,
- we just increment a delayed timer tick counter, but do
- not check to see if any TSOs have been made runnable
- as a result. (Do a bulk update of their status once
- the GC has completed).
-
- If the vtalrm does not occur within GC, we try to promote
- any of the waiting threads to the runnable list (see awaitEvent)
-
- 4/96 SOF
- */
-
- if (delayTicks != 0) /* delayTicks>0 => don't handle timer expiry (in GC) */
- delayTicks++;
- else if (WaitingThreadsHd != PrelBase_Z91Z93_closure)
- AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime);
-
-# ifdef PAR
- if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL] ||
- PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) {
- PruneSparks();
- if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL])
- PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] +
- SparkLimit[REQUIRED_POOL] / 2;
- if (PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) {
- PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] +
- SparkLimit[ADVISORY_POOL] / 2;
- sparksIgnored += SparkLimit[REQUIRED_POOL] / 2;
- }
- }
-
- if (CurrentTSO != NULL ||
-# else
- if (RunnableThreadsHd != PrelBase_Z91Z93_closure ||
-# endif
- PendingSparksHd[REQUIRED_POOL] < PendingSparksTl[REQUIRED_POOL] ||
- PendingSparksHd[ADVISORY_POOL] < PendingSparksTl[ADVISORY_POOL]) {
- /* ToDo: anything else for GRAN? WDP */
- context_switch = 1;
- }
-}
-
-# endif
-
-
-#if defined(cygwin32_TARGET_OS) /* really just Win32 */
-/* windows.h already included for the segv_handling above */
-
-I_ vtalrm_id;
-TIMECALLBACK *vtalrm_cback;
-
-#ifndef CONCURRENT
-void (*tick_handle)(STG_NO_ARGS);
-
-static VOID CALLBACK
-tick_handler(uID,uMsg,dwUser,dw1,dw2)
-int uID;
-unsigned int uMsg;
-unsigned int dwUser;
-unsigned int dw1;
-unsigned int dw2;
-{
- (*tick_handle)();
-}
-#endif
-
-int install_vtalrm_handler()
-{
-# ifdef CONCURRENT
- vtalrm_cback = vtalrm_handler;
-# else
- /*
- Only turn on ticking
- */
- vtalrm_cback = tick_handler;
- if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
- || RTSflags.ProfFlags.doHeapProfile)
- tick_handle = handle_tick_serial;
- else
- tick_handle = handle_tick_noserial;
-# endif
- return (int)0;
-}
-
-void
-blockVtAlrmSignal(STG_NO_ARGS)
-{
- timeKillEvent(vtalrm_id);
-}
-
-void
-unblockVtAlrmSignal(STG_NO_ARGS)
-{
-#ifdef CONCURRENT
- timeSetEvent(RTSflags.ConcFlags.ctxtSwitchTime,5,vtalrm_cback,NULL,TIME_PERIODIC);
-#else
- timeSetEvent(RTSflags.CcFlags.msecsPerTick,5,vtalrm_cback,NULL,TIME_PERIODIC);
-#endif
-}
-
-#elif defined(sunos4_TARGET_OS)
-
-int
-install_vtalrm_handler(void)
-{
- void (*old)();
-
-# ifdef CONCURRENT
- old = signal(SIGVTALRM, vtalrm_handler);
-# else
- if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
- || RTSflags.ProfFlags.doHeapProfile)
- old = signal(SIGVTALRM, handle_tick_serial);
- else
- old = signal(SIGVTALRM, handle_tick_noserial);
-# endif
- return ((int) old == SIG_ERR);
-}
-
-static int vtalrm_mask;
-
-void
-blockVtAlrmSignal(STG_NO_ARGS)
-{
- vtalrm_mask = sigblock(sigmask(SIGVTALRM));
-}
-
-void
-unblockVtAlrmSignal(STG_NO_ARGS)
-{
- (void) sigsetmask(vtalrm_mask);
-}
-
-# else /* Not SunOS 4 */
-
-int
-install_vtalrm_handler(STG_NO_ARGS)
-{
- struct sigaction action;
-
-# ifdef CONCURRENT
- action.sa_handler = vtalrm_handler;
-# else
- if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
- || RTSflags.ProfFlags.doHeapProfile)
- action.sa_handler = handle_tick_serial;
- else
- action.sa_handler = handle_tick_noserial;
-# endif
-
- sigemptyset(&action.sa_mask);
- action.sa_flags = 0;
-
- return sigaction(SIGVTALRM, &action, NULL);
-}
-
-void
-blockVtAlrmSignal(STG_NO_ARGS)
-{
- sigset_t signals;
-
- sigemptyset(&signals);
- sigaddset(&signals, SIGVTALRM);
-
- (void) sigprocmask(SIG_BLOCK, &signals, NULL);
-}
-
-void
-unblockVtAlrmSignal(STG_NO_ARGS)
-{
- sigset_t signals;
-
- sigemptyset(&signals);
- sigaddset(&signals, SIGVTALRM);
-
- (void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
-}
-
-# endif /* ! SunOS 4 */
-
-#endif /* PROFILING || CONCURRENT (but not GRAN) */
-
-\end{code}
-
-Signal handling support for user-specified signal handlers. Since we
-need stable pointers to do this properly, we just refuse to try in the
-parallel world. Sorry.
-
-\begin{code}
-
-#if defined(PAR) /* || defined(GRAN) */
-
-void
-blockUserSignals(void)
-{
- return;
-}
-
-void
-unblockUserSignals(void)
-{
- return;
-}
-
-I_
-# ifdef _POSIX_SOURCE
-sig_install(sig, spi, mask)
- sigset_t *mask;
-# else
- sig_install(sig, spi)
-# endif
- I_ sig;
- I_ spi;
-{
- fflush(stdout);
- fprintf(stderr,"No signal handling support in a parallel implementation.\n");
- EXIT(EXIT_FAILURE);
-}
-
-#else /* !PAR */
-
-# include <setjmp.h>
-
-extern StgPtr deRefStablePointer PROTO((StgStablePtr));
-extern void freeStablePointer PROTO((I_));
-extern jmp_buf restart_main;
-
-static I_ *handlers = NULL; /* Dynamically grown array of signal handlers */
-static I_ nHandlers = 0; /* Size of handlers array */
-
-static void
-more_handlers(I_ sig)
-{
- I_ i;
-
- if (sig < nHandlers)
- return;
-
- if (handlers == NULL)
- handlers = (I_ *) malloc((sig + 1) * sizeof(I_));
- else
- handlers = (I_ *) realloc(handlers, (sig + 1) * sizeof(I_));
-
- if (handlers == NULL) {
- fflush(stdout);
- fprintf(stderr, "VM exhausted (in more_handlers)\n");
- EXIT(EXIT_FAILURE);
- }
- for(i = nHandlers; i <= sig; i++)
- /* Fill in the new slots with default actions */
- handlers[i] = STG_SIG_DFL;
-
- nHandlers = sig + 1;
-}
-
-I_ nocldstop = 0;
-
-# ifdef _POSIX_SOURCE
-
-static void
-generic_handler(int sig)
-{
- sigset_t signals;
-
- SAVE_Hp = SAVE_HpLim; /* Just to be safe */
- if (! initStacks(&StorageMgrInfo)) {
- fflush(stdout);
- fprintf(stderr, "initStacks failed!\n");
- EXIT(EXIT_FAILURE);
- }
- TopClosure = deRefStablePointer(handlers[sig]);
- sigemptyset(&signals);
- sigaddset(&signals, sig);
- sigprocmask(SIG_UNBLOCK, &signals, NULL);
- longjmp(restart_main, sig);
-}
-
-static sigset_t userSignals;
-static sigset_t savedSignals;
-
-void
-initUserSignals(void)
-{
- sigemptyset(&userSignals);
-}
-
-void
-blockUserSignals(void)
-{
- sigprocmask(SIG_SETMASK, &userSignals, &savedSignals);
-}
-
-void
-unblockUserSignals(void)
-{
- sigprocmask(SIG_SETMASK, &savedSignals, NULL);
-}
-
-
-I_
-sig_install(sig, spi, mask)
- I_ sig;
- I_ spi;
- sigset_t *mask;
-{
- sigset_t signals;
- struct sigaction action;
- I_ 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))
- return STG_SIG_ERR;
-
- more_handlers(sig);
-
- previous_spi = handlers[sig];
-
- switch(spi) {
- case STG_SIG_IGN:
- handlers[sig] = STG_SIG_IGN;
- sigdelset(&userSignals, sig);
- action.sa_handler = SIG_IGN;
- break;
-
- case STG_SIG_DFL:
- handlers[sig] = STG_SIG_DFL;
- sigdelset(&userSignals, sig);
- action.sa_handler = SIG_DFL;
- break;
- default:
- handlers[sig] = spi;
- sigaddset(&userSignals, sig);
- action.sa_handler = generic_handler;
- break;
- }
-
- if (mask != NULL)
- action.sa_mask = *mask;
- else
- sigemptyset(&action.sa_mask);
-
- action.sa_flags = sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
-
- if (sigaction(sig, &action, NULL) || sigprocmask(SIG_UNBLOCK, &signals, NULL)) {
- if (previous_spi)
- freeStablePointer(handlers[sig]);
- return STG_SIG_ERR;
- }
-
- return previous_spi;
-}
-
-# else /* !POSIX */
-
-static void
-generic_handler(sig)
-{
- SAVE_Hp = SAVE_HpLim; /* Just to be safe */
- if (! initStacks(&StorageMgrInfo)) {
- fflush(stdout);
- fprintf(stderr, "initStacks failed!\n");
- EXIT(EXIT_FAILURE);
- }
- TopClosure = deRefStablePointer(handlers[sig]);
- sigsetmask(0);
- longjmp(restart_main, sig);
-}
-
-static int userSignals;
-static int savedSignals;
-
-void
-initUserSignals(void)
-{
- userSignals = 0;
-}
-
-void
-blockUserSignals(void)
-{
- savedSignals = sigsetmask(userSignals);
-}
-
-void
-unblockUserSignals(void)
-{
- sigsetmask(savedSignals);
-}
-
-I_
-sig_install(sig, spi)
- I_ sig;
- I_ spi;
-{
- I_ previous_spi;
- int mask;
- void (*handler)(int);
-
- /* Block the signal until we figure out what to do */
- /* Count on this to fail if the signal number is invalid */
- if(sig < 0 || (mask = sigmask(sig)) == 0)
- return STG_SIG_ERR;
-
- mask = sigblock(mask);
-
- more_handlers(sig);
-
- previous_spi = handlers[sig];
-
- switch(spi) {
- case STG_SIG_IGN:
- handlers[sig] = STG_SIG_IGN;
- userSignals &= ~sigmask(sig);
- handler = SIG_IGN;
- break;
-
- case STG_SIG_DFL:
- handlers[sig] = STG_SIG_DFL;
- userSignals &= ~sigmask(sig);
- handler = SIG_DFL;
- break;
- default:
- handlers[sig] = spi;
- userSignals |= sigmask(sig);
- handler = generic_handler;
- break;
- }
-
- if (signal(sig, handler) < 0) {
- if (previous_spi)
- freeStablePointer(handlers[sig]);
- sigsetmask(mask);
- return STG_SIG_ERR;
- }
-
- sigsetmask(mask);
- return previous_spi;
-}
-
-# endif /* !POSIX */
-
-#endif /* PAR */
-
-\end{code}
projects / ghc-hetmet.git / blobdiff