X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fmain%2FSignals.lc;fp=ghc%2Fruntime%2Fmain%2FSignals.lc;h=0000000000000000000000000000000000000000;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=2f376aef649ce9cdfd417806e09251e2071df869;hpb=967cc47f37cb93a5e2b6df7822c9a646f0428247;p=ghc-hetmet.git diff --git a/ghc/runtime/main/Signals.lc b/ghc/runtime/main/Signals.lc deleted file mode 100644 index 2f376ae..0000000 --- a/ghc/runtime/main/Signals.lc +++ /dev/null @@ -1,821 +0,0 @@ -% -% (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 -#endif - - /* This is useful with the particular set of header files on my NeXT. - * CaS - */ -#if defined(HAVE_SYS_SIGNAL_H) -# include -#endif - -#if defined(HAVE_SIGNAL_H) -# include -#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 -# 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 -# else -# include -# endif - -#endif - -#if defined(HAVE_SIGINFO_H) - /* DEC OSF1 seems to need this explicitly. Maybe others do as well? */ -# include -#endif - -#if defined(cygwin32_TARGET_OS) -# include -#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 . - 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 - -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}