*** empty log message ***
[bpt/guile.git] / libguile / scmsigs.c
index 4839405..ea75a72 100644 (file)
@@ -1,15 +1,15 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+ *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 
 \f
 
-#include <stdio.h>
 #include <signal.h>
+#include <errno.h>
+
 #include "libguile/_scm.h"
 
 #include "libguile/async.h"
 #include "libguile/eval.h"
+#include "libguile/root.h"
 #include "libguile/vectors.h"
 
 #include "libguile/validate.h"
@@ -72,11 +74,12 @@ int usleep ();
 
 #endif
 
-\f
-
-#ifdef USE_MIT_PTHREADS
-#undef signal
-#define signal pthread_signal
+#ifdef __MINGW32__
+#include <windows.h>
+#define alarm(sec) (0)
+/* This weird comma expression is because Sleep is void under Windows. */
+#define sleep(sec) (Sleep ((sec) * 1000), 0)
+#define kill(pid, sig) raise (sig)
 #endif
 
 \f
@@ -150,8 +153,6 @@ take_signal (int signum)
   }
 #endif
   scm_system_async_mark (signal_async);
-  if (signum == SIGSEGV || signum == SIGILL || signum == SIGBUS)
-    SCM_ASYNC_TICK;
   errno = saved_errno;
 }
 
@@ -174,18 +175,16 @@ sys_deliver_signals (void)
 #ifndef HAVE_SIGACTION
          signal (i, take_signal);
 #endif
-         scm_apply (SCM_VELTS (*signal_handlers)[i], 
-                    scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
-                    SCM_EOL);
+         scm_call_1 (SCM_VELTS (*signal_handlers)[i], SCM_MAKINUM (i));
        }
     }
   return SCM_UNSPECIFIED;
 }
 
 /* user interface for installation of signal handlers.  */
-SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, 
+SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
            (SCM signum, SCM handler, SCM flags),
-           "Install or report the signal hander for a specified signal.\n\n"
+           "Install or report the signal handler for a specified signal.\n\n"
            "@var{signum} is the signal number, which can be specified using the value\n"
            "of variables such as @code{SIGINT}.\n\n"
            "If @var{action} is omitted, @code{sigaction} returns a pair: the\n"
@@ -200,7 +199,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
            "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
            "was installed before @code{sigaction} was first used.  Flags can\n"
            "optionally be specified for the new handler (@code{SA_RESTART} will\n"
-           "always be added if it's available and the system is using rstartable\n"
+           "always be added if it's available and the system is using restartable\n"
            "system calls.)  The return value is a pair with information about the\n"
            "old handler as described above.\n\n"
            "This interface does not provide access to the \"signal blocking\"\n"
@@ -243,10 +242,10 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
   old_handler = scheme_handlers[csig];
   if (SCM_UNBNDP (handler))
     query_only = 1;
-  else if (SCM_TRUE_P (scm_integer_p (handler)))
+  else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
     {
-      if (SCM_NUM2LONG (2,handler) == (long) SIG_DFL
-         || SCM_NUM2LONG (2,handler) == (long) SIG_IGN)
+      if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL
+         || SCM_NUM2LONG (2, handler) == (long) SIG_IGN)
        {
 #ifdef HAVE_SIGACTION
          action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
@@ -280,7 +279,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
          scheme_handlers[csig] = SCM_BOOL_F;
        }
 #endif
-    } 
+    }
   else
     {
       SCM_VALIDATE_NIM (2,handler);
@@ -295,6 +294,37 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
 #endif
       scheme_handlers[csig] = handler;
     }
+
+  /* XXX - Silently ignore setting handlers for `program error signals'
+     because they can't currently be handled by Scheme code.
+  */
+
+  switch (csig)
+    {
+      /* This list of program error signals is from the GNU Libc
+         Reference Manual */
+    case SIGFPE:
+    case SIGILL:
+    case SIGSEGV:
+#ifdef SIGBUS
+    case SIGBUS:
+#endif
+    case SIGABRT:
+#if defined(SIGIOT) && (SIGIOT != SIGABRT)
+    case SIGIOT:
+#endif
+#ifdef SIGTRAP
+    case SIGTRAP:
+#endif
+#ifdef SIGEMT
+    case SIGEMT:
+#endif
+#ifdef SIGSYS
+    case SIGSYS:
+#endif
+      query_only = 1;
+    }
+
 #ifdef HAVE_SIGACTION
   if (query_only)
     {
@@ -335,14 +365,14 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, 
+SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
             (void),
            "Return all signal handlers to the values they had before any call to\n"
            "@code{sigaction} was made.  The return value is unspecified.")
 #define FUNC_NAME s_scm_restore_signals
 {
   int i;
-  SCM *scheme_handlers = SCM_VELTS (*signal_handlers);  
+  SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
 
   for (i = 0; i < NSIG; i++)
     {
@@ -368,7 +398,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0, 
+SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
            (SCM i),
            "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
            "number of seconds (an integer).  It's advisable to install a signal\n"
@@ -388,7 +418,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 #undef FUNC_NAME
 
 #ifdef HAVE_PAUSE
-SCM_DEFINE (scm_pause, "pause", 0, 0, 0, 
+SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
            (),
            "Pause the current process (thread?) until a signal arrives whose\n"
            "action is to either terminate the current process or invoke a\n"
@@ -401,7 +431,7 @@ SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 #undef FUNC_NAME
 #endif
 
-SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0, 
+SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
            (SCM i),
            "Wait for the given number of seconds (an integer) or until a signal\n"
            "arrives.  The return value is zero if the time elapses or the number\n"
@@ -420,10 +450,10 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 #undef FUNC_NAME
 
 #if defined(USE_THREADS) || defined(HAVE_USLEEP)
-SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0, 
+SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
            (SCM i),
-           "Sleep for I microseconds.\n"
-            "`usleep' is not available on all platforms.")
+           "Sleep for I microseconds.  @code{usleep} is not available on\n"
+           "all platforms.")
 #define FUNC_NAME s_scm_usleep
 {
   SCM_VALIDATE_INUM_MIN (1,i,0);
@@ -449,9 +479,8 @@ SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 #undef FUNC_NAME
 #endif /* GUILE_ISELECT || HAVE_USLEEP */
 
-SCM_DEFINE (scm_raise, "raise", 1, 0, 0, 
+SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
            (SCM sig),
-           "\n"
            "Sends a specified signal @var{sig} to the current process, where\n"
            "@var{sig} is as described for the kill procedure.")
 #define FUNC_NAME s_scm_raise
@@ -465,15 +494,6 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_PROC(s_segfault, "segfault", 0, 0, 0, scm_segfault);
-
-SCM
-scm_segfault ()
-{
-  *(int *)0 = 0;
-  return SCM_UNSPECIFIED;
-}
-
 \f
 
 void
@@ -483,11 +503,11 @@ scm_init_scmsigs ()
   int i;
 
   signal_handlers =
-    SCM_CDRLOC (scm_sysintern ("signal-handlers",
-                              scm_make_vector (SCM_MAKINUM (NSIG),
-                                               SCM_BOOL_F)));
-  thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
-                         sys_deliver_signals);
+    SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
+                                 scm_c_make_vector (NSIG, SCM_BOOL_F)));
+  /* XXX - use scm_c_make_gsubr here instead of `define'? */
+  thunk = scm_c_define_gsubr ("%deliver-signals", 0, 0, 0,
+                             sys_deliver_signals);
   signal_async = scm_system_async (thunk);
 
   for (i = 0; i < NSIG; i++)
@@ -502,7 +522,7 @@ scm_init_scmsigs ()
 
 #ifdef HAVE_RESTARTABLE_SYSCALLS
       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
-        signals really are restartable.  don't rely on the same 
+        signals really are restartable.  don't rely on the same
         run-time that configure got: reset the default for every signal.
       */
 #ifdef HAVE_SIGINTERRUPT
@@ -514,7 +534,7 @@ scm_init_scmsigs ()
        sigaction (i, NULL, &action);
        if (!(action.sa_flags & SA_RESTART))
          {
-           action.sa_flags &= SA_RESTART;
+           action.sa_flags |= SA_RESTART;
            sigaction (i, &action, NULL);
          }
       }
@@ -524,17 +544,19 @@ scm_init_scmsigs ()
 #endif
     }
 
-  scm_sysintern ("NSIG", scm_long2num (NSIG));
-  scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
-  scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
+  scm_c_define ("NSIG", scm_long2num (NSIG));
+  scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
+  scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
 #ifdef SA_NOCLDSTOP
-  scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
+  scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
 #endif
 #ifdef SA_RESTART
-  scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
+  scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
 #endif
 
+#ifndef SCM_MAGIC_SNARFER
 #include "libguile/scmsigs.x"
+#endif
 }