%
% (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}