[project @ 1998-11-26 09:17:22 by sof]
[ghc-hetmet.git] / ghc / runtime / main / Signals.lc
index 3189786..2f376ae 100644 (file)
@@ -19,18 +19,23 @@ Since they're pretty rudimentary, they shouldn't actually cause as
 much pain.
 
 \begin{code}
-#include "platform.h"
+#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)
+#if defined(freebsd_TARGET_OS) 
 # define NON_POSIX_SOURCE
 #endif
 
-#if defined(osf1_TARGET_OS)
+#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
@@ -47,13 +52,38 @@ much pain.
 # 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... */
-# include <asm/signal.h>
+/* 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)
@@ -61,6 +91,10 @@ much pain.
 # include <siginfo.h>
 #endif
 
+#if defined(cygwin32_TARGET_OS)
+# include <windows.h>
+#endif
+
 \end{code}
 
 %************************************************************************
@@ -77,6 +111,7 @@ 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}
@@ -88,26 +123,48 @@ Fun, eh?
 
 \begin{code}
 # if defined(sunos4_TARGET_OS) || defined(freebsd_TARGET_OS) \
-  || defined(linux_TARGET_OS)  || defined(linuxaout_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 */
+#  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 /* linux */
+#     endif
+#    endif 
+#  endif
 {
     extern void StackOverflow(STG_NO_ARGS) STG_NORETURN;
 
 #  if defined(linux_TARGET_OS)  || defined(linuxaout_TARGET_OS)
-    caddr_t addr = scp.cr2;
+    unsigned long addr = scp.cr2;
     /* Magic info from Tommy Thorn! */
 #  endif
-
-    if (addr >= (caddr_t) stks_space
-      && addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize))
+#  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);
@@ -122,7 +179,9 @@ install_segv_handler(void)
     /* FreeBSD seems to generate SIGBUS for stack overflows */
     if (signal(SIGBUS, segv_handler) == SIG_ERR)
        return -1;
-    return ((int) signal(SIGSEGV, segv_handler));
+    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
@@ -131,11 +190,80 @@ install_segv_handler(void)
 #endif
 }
 
-# else /* Not SunOS 4, FreeBSD, or Linux(a.out) */
+# 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
+        /* certainly BOGUS (WDP 94/05) -- copied from /usr/include/sys/siginfo.h */
+#     define si_addr _data._fault._addr
 #  endif
 
 static void
@@ -167,7 +295,7 @@ install_segv_handler(STG_NO_ARGS)
     return sigaction(SIGSEGV, &action, NULL);
 }
 
-# endif    /* not SunOS 4 */
+# endif /* ! (cygwin32|irix6|sunos4|linux*|*bsd|aix) */
 
 #endif /* STACK_CHECK_BY_PAGE_FAULT */
 
@@ -195,8 +323,24 @@ extern I_ delayTicks;
 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
@@ -243,7 +387,7 @@ vtalrm_handler(int sig)
 
     if (delayTicks != 0) /* delayTicks>0 => don't handle timer expiry (in GC) */
        delayTicks++;
-    else if (WaitingThreadsHd != Prelude_Z91Z93_closure)
+    else if (WaitingThreadsHd != PrelBase_Z91Z93_closure)
             AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime);
 
 #  ifdef PAR
@@ -262,7 +406,7 @@ vtalrm_handler(int sig)
 
     if (CurrentTSO != NULL ||
 #  else
-    if (RunnableThreadsHd != Prelude_Z91Z93_closure ||
+    if (RunnableThreadsHd != PrelBase_Z91Z93_closure ||
 #  endif
       PendingSparksHd[REQUIRED_POOL] < PendingSparksTl[REQUIRED_POOL] ||
       PendingSparksHd[ADVISORY_POOL] < PendingSparksTl[ADVISORY_POOL]) {
@@ -273,7 +417,63 @@ vtalrm_handler(int sig)
 
 # endif
 
-# if defined(sunos4_TARGET_OS)
+
+#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)
@@ -428,6 +628,8 @@ more_handlers(I_ sig)
     nHandlers = sig + 1;
 }
 
+I_ nocldstop = 0;
+
 # ifdef _POSIX_SOURCE
 
 static void
@@ -470,8 +672,6 @@ unblockUserSignals(void)
 }
 
 
-I_ nocldstop = 0;
-
 I_ 
 sig_install(sig, spi, mask)
   I_ sig;