-/* Copyright (C) 1995,1996 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, 675 Mass Ave, Cambridge, MA 02139, USA.
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
-\f
-
-#include <stdio.h>
-#include <signal.h>
-#include "_scm.h"
-
-#include "scmsigs.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-
-\f
-
-#if (__TURBOC__==1)
-#define signal ssignal /* Needed for TURBOC V1.0 */
-#endif
-
-#ifdef USE_MIT_PTHREADS
-#undef signal
-#define signal pthread_signal
-#endif
-
-\f
-
-/* SIGRETTYPE is the type that signal handlers return. See <signal.h>*/
-
-#ifdef RETSIGTYPE
-#define SIGRETTYPE RETSIGTYPE
-#else
-#ifdef STDC_HEADERS
-#if (__TURBOC__==1)
-#define SIGRETTYPE int
-#else
-#define SIGRETTYPE void
-#endif
-#else
-#ifdef linux
-#define SIGRETTYPE void
-#else
-#define SIGRETTYPE int
-#endif
-#endif
-#endif
-
-#ifdef vms
-#ifdef __GNUC__
-#define SIGRETTYPE int
-#endif
-#endif
-
-\f
-
-#define SIGFN(NAME, SCM_NAME, SIGNAL) \
-static SIGRETTYPE \
-NAME (sig) \
- int sig; \
-{ \
- signal (SIGNAL, NAME); \
- scm_take_signal (SCM_NAME); \
-}
-
-#ifdef SIGHUP
-SIGFN(scm_hup_signal, SCM_HUP_SIGNAL, SIGHUP)
-#endif
-
-#ifdef SIGINT
-SIGFN(scm_int_signal, SCM_INT_SIGNAL, SIGINT)
-#endif
-
-#ifdef SIGFPE
-SIGFN(scm_fpe_signal, SCM_FPE_SIGNAL, SIGFPE)
-#endif
-
-#ifdef SIGBUS
-SIGFN(scm_bus_signal, SCM_BUS_SIGNAL, SIGBUS)
-#endif
-
-#ifdef SIGSEGV
-SIGFN(scm_segv_signal, SCM_SEGV_SIGNAL, SIGSEGV)
-#endif
-
-#ifdef SIGALRM
-SIGFN(scm_alrm_signal, SCM_ALRM_SIGNAL, SIGALRM)
-#endif
-
-#define FAKESIGFN(NAME, SCM_NAME) \
-static SIGRETTYPE \
-NAME (sig) \
- int sig; \
-{ \
- scm_take_signal (SCM_NAME); \
-}
-
-#if 0
-/* !!! */
-FAKESIGFN(scm_gc_signal, SCM_GC_SIGNAL)
-FAKESIGFN(scm_tick_signal, SCM_TICK_SIGNAL)
-#endif
-\f
-
-SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
-
-SCM
-scm_alarm (i)
- SCM i;
-{
- unsigned int j;
- SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
- SCM_SYSCALL (j = alarm (SCM_INUM (i)));
- return SCM_MAKINUM (j);
-}
-
-
-SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
-
-SCM
-scm_pause ()
-{
- pause ();
- return SCM_UNSPECIFIED;
-}
-
-SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
-
-SCM
-scm_sleep (i)
- SCM i;
-{
- unsigned int j;
- SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
-#ifdef __HIGHC__
- SCM_SYSCALL(j = 0; sleep(SCM_INUM(i)););
-#else
- SCM_SYSCALL(j = sleep(SCM_INUM(i)););
-#endif
- return SCM_MAKINUM (j);
-}
-
-SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
-
-SCM
-scm_raise(sig)
- SCM sig;
-{
- SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
-# ifdef vms
- return SCM_MAKINUM(gsignal((int)SCM_INUM(sig)));
-# else
- return kill (getpid(), (int)SCM_INUM(sig)) ? SCM_BOOL_F : SCM_BOOL_T;
-# endif
-}
-
-\f
-#ifdef SIGHUP
-static SIGRETTYPE (*oldhup) ();
-#endif
-
-#ifdef SIGINT
-static SIGRETTYPE (*oldint) ();
-#endif
-
-#ifdef SIGFPE
-static SIGRETTYPE (*oldfpe) ();
-#endif
-
-#ifdef SIGBUS
-static SIGRETTYPE (*oldbus) ();
-#endif
-
-#ifdef SIGSEGV /* AMIGA lacks! */
-static SIGRETTYPE (*oldsegv) ();
-#endif
-
-#ifdef SIGALRM
-static SIGRETTYPE (*oldalrm) ();
-#endif
-
-#ifdef SIGPIPE
-static SIGRETTYPE (*oldpipe) ();
-#endif
-
-
-
-void
-scm_init_signals ()
-{
-#ifdef SIGINT
- oldint = signal (SIGINT, scm_int_signal);
-#endif
-#ifdef SIGHUP
- oldhup = signal (SIGHUP, scm_hup_signal);
-#endif
-#ifdef SIGFPE
- oldfpe = signal (SIGFPE, scm_fpe_signal);
-#endif
-#ifdef SIGBUS
- oldbus = signal (SIGBUS, scm_bus_signal);
-#endif
-#ifdef SIGSEGV /* AMIGA lacks! */
- oldsegv = signal (SIGSEGV, scm_segv_signal);
-#endif
-#ifdef SIGALRM
- alarm (0); /* kill any pending ALRM interrupts */
- oldalrm = signal (SIGALRM, scm_alrm_signal);
-#endif
-#ifdef SIGPIPE
- oldpipe = signal (SIGPIPE, SIG_IGN);
-#endif
-#ifdef ultrix
- siginterrupt (SIGINT, 1);
- siginterrupt (SIGALRM, 1);
- siginterrupt (SIGHUP, 1);
- siginterrupt (SIGPIPE, 1);
-#endif /* ultrix */
-}
-
-/* This is used in preparation for a possible fork(). Ignore all
- signals before the fork so that child will catch only if it
- establishes a handler */
-
-void
-scm_ignore_signals ()
-{
-#ifdef ultrix
- siginterrupt (SIGINT, 0);
- siginterrupt (SIGALRM, 0);
- siginterrupt (SIGHUP, 0);
- siginterrupt (SIGPIPE, 0);
-#endif /* ultrix */
- signal (SIGINT, SIG_IGN);
-#ifdef SIGHUP
- signal (SIGHUP, SIG_DFL);
-#endif
-#ifdef SCM_FLOATS
- signal (SIGFPE, SIG_DFL);
-#endif
-#ifdef SIGBUS
- signal (SIGBUS, SIG_DFL);
-#endif
-#ifdef SIGSEGV /* AMIGA lacks! */
- signal (SIGSEGV, SIG_DFL);
-#endif
- /* Some documentation claims that ALRMs are cleared accross forks.
- If this is not always true then the value returned by alarm(0)
- will have to be saved and scm_unignore_signals() will have to
- reinstate it. */
- /* This code should be neccessary only if the forked process calls
- alarm() without establishing a handler:
- #ifdef SIGALRM
- oldalrm = signal(SIGALRM, SIG_DFL);
- #endif */
- /* These flushes are per warning in man page on fork(). */
- fflush (stdout);
- fflush (stderr);
-}
-
-
-void
-scm_unignore_signals ()
-{
- signal (SIGINT, scm_int_signal);
-#ifdef SIGHUP
- signal (SIGHUP, scm_hup_signal);
-#endif
-#ifdef SCM_FLOATS
- signal (SIGFPE, scm_fpe_signal);
-#endif
-#ifdef SIGBUS
- signal (SIGBUS, scm_bus_signal);
-#endif
-#ifdef SIGSEGV /* AMIGA lacks! */
- signal (SIGSEGV, scm_segv_signal);
-#endif
-#ifdef SIGALRM
- signal (SIGALRM, scm_alrm_signal);
-#endif
-#ifdef ultrix
- siginterrupt (SIGINT, 1);
- siginterrupt (SIGALRM, 1);
- siginterrupt (SIGHUP, 1);
- siginterrupt (SIGPIPE, 1);
-#endif /* ultrix */
-}
-
-SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
-
-SCM
-scm_restore_signals ()
-{
-#ifdef ultrix
- siginterrupt (SIGINT, 0);
- siginterrupt (SIGALRM, 0);
- siginterrupt (SIGHUP, 0);
- siginterrupt (SIGPIPE, 0);
-#endif /* ultrix */
- signal (SIGINT, oldint);
-#ifdef SIGHUP
- signal (SIGHUP, oldhup);
-#endif
-#ifdef SCM_FLOATS
- signal (SIGFPE, oldfpe);
-#endif
-#ifdef SIGBUS
- signal (SIGBUS, oldbus);
-#endif
-#ifdef SIGSEGV /* AMIGA lacks! */
- signal (SIGSEGV, oldsegv);
-#endif
-#ifdef SIGPIPE
- signal (SIGPIPE, oldpipe);
-#endif
-#ifdef SIGALRM
- alarm (0); /* kill any pending ALRM interrupts */
- signal (SIGALRM, oldalrm);
-#endif
- return SCM_UNSPECIFIED;
-}
-
-
-
-void
-scm_init_scmsigs ()
-{
-#include "scmsigs.x"
-}
-
+/* Copyright (C) 1995,1996,1997,1998 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,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE. If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way. To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice. */
+\f
+
+#include <stdio.h>
+#include <signal.h>
+#include "_scm.h"
+
+#include "async.h"
+#include "eval.h"
+#include "scmsigs.h"
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* The thread system has its own sleep and usleep functions. */
+#ifndef USE_THREADS
+
+#if defined(MISSING_SLEEP_DECL)
+int sleep ();
+#endif
+
+#if defined(HAVE_USLEEP) && defined(MISSING_USLEEP_DECL)
+int usleep ();
+#endif
+
+#endif
+
+\f
+
+#ifdef USE_MIT_PTHREADS
+#undef signal
+#define signal pthread_signal
+#endif
+
+\f
+
+/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
+
+#ifdef RETSIGTYPE
+# define SIGRETTYPE RETSIGTYPE
+#else
+# ifdef STDC_HEADERS
+# define SIGRETTYPE void
+# else
+# define SIGRETTYPE int
+# endif
+#endif
+
+\f
+
+/* take_signal is installed as the C signal handler whenever a Scheme
+ handler is set. when a signal arrives, take_signal marks the corresponding
+ element of got_signal and marks signal_async. the thunk in signal_async
+ (sys_deliver_signals) will be run at the next opportunity, outside a
+ critical section. sys_deliver_signals runs each Scheme handler for
+ which got_signal is set. */
+
+static SCM signal_async;
+
+static char got_signal[NSIG];
+
+/* a Scheme vector of handler procedures. */
+static SCM *signal_handlers;
+
+/* saves the original C handlers, when a new handler is installed.
+ set to SIG_ERR if the original handler is installed. */
+#ifdef HAVE_SIGACTION
+static struct sigaction orig_handlers[NSIG];
+#else
+static SIGRETTYPE (*orig_handlers)(int)[NSIG];
+#endif
+
+static SIGRETTYPE
+take_signal (int signum)
+{
+ SCM ignored;
+ if (!scm_ints_disabled)
+ {
+ /* For reasons of speed, the SCM_NEWCELL macro doesn't defer
+ interrupts. Instead, it first sets its argument to point to
+ the first cell in the list, and then advances the freelist
+ pointer to the next cell. Now, if this procedure is
+ interrupted, the only anomalous state possible is to have
+ both SCM_NEWCELL's argument and scm_freelist pointing to the
+ same cell. To deal with this case, we always throw away the
+ first cell in scm_freelist here.
+
+ At least, that's the theory. I'm not convinced that that's
+ the only anomalous path we need to worry about. */
+ SCM_NEWCELL (ignored);
+ }
+ got_signal[signum] = 1;
+#if HAVE_SIGACTION
+ /* unblock the signal before the scheme handler gets to run, since
+ it may use longjmp to escape (i.e., throw an exception). */
+ {
+ sigset_t set;
+ sigemptyset (&set);
+ sigaddset (&set, signum);
+ sigprocmask (SIG_UNBLOCK, &set, NULL);
+ }
+#endif
+ scm_system_async_mark (signal_async);
+}
+
+static SCM
+sys_deliver_signals (void)
+{
+ int i;
+
+ for (i = 0; i < NSIG; i++)
+ {
+ if (got_signal[i])
+ {
+ /* The flag is reset before calling the handler in case the
+ handler doesn't return. If the handler doesn't return
+ but leaves other signals flagged, they their handlers
+ will be applied some time later when the async is checked
+ again. It would probably be better to reset the flags
+ after doing a longjmp. */
+ got_signal[i] = 0;
+#ifndef HAVE_SIGACTION
+ signal (i, take_signal);
+#endif
+ scm_apply (SCM_VELTS (*signal_handlers)[i],
+ scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
+ SCM_EOL);
+ }
+ }
+ return SCM_UNSPECIFIED;
+}
+
+/* user interface for installation of signal handlers. */
+SCM_PROC(s_sigaction, "sigaction", 1, 2, 0, scm_sigaction);
+SCM
+scm_sigaction (SCM signum, SCM handler, SCM flags)
+{
+ int csig;
+#ifdef HAVE_SIGACTION
+ struct sigaction action;
+ struct sigaction old_action;
+#else
+ SIGRETTYPE (* chandler) (int);
+ SIGRETTYPE (* old_chandler) (int);
+#endif
+ int query_only = 0;
+ int save_handler = 0;
+ SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
+ SCM old_handler;
+
+ SCM_ASSERT (SCM_INUMP (signum), signum, SCM_ARG1, s_sigaction);
+ csig = SCM_INUM (signum);
+#ifdef HAVE_SIGACTION
+ /* always use restartable system calls if available. */
+#ifdef SA_RESTART
+ action.sa_flags = SA_RESTART;
+#else
+ action.sa_flags = 0;
+#endif
+ if (!SCM_UNBNDP (flags))
+ {
+ SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG3, s_sigaction);
+ action.sa_flags |= SCM_INUM (flags);
+ }
+ sigemptyset (&action.sa_mask);
+#endif
+ SCM_DEFER_INTS;
+ old_handler = scheme_handlers[csig];
+ if (SCM_UNBNDP (handler))
+ query_only = 1;
+ else if (SCM_INUMP (handler))
+ {
+ if (SCM_INUM (handler) == (int) SIG_DFL
+ || SCM_INUM (handler) == (int) SIG_IGN)
+ {
+#ifdef HAVE_SIGACTION
+ action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
+#else
+ chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
+#endif
+ scheme_handlers[csig] = SCM_BOOL_F;
+ }
+ else
+ scm_out_of_range (s_sigaction, handler);
+ }
+ else if (SCM_FALSEP (handler))
+ {
+ /* restore the default handler. */
+#ifdef HAVE_SIGACTION
+ if (orig_handlers[csig].sa_handler == SIG_ERR)
+ query_only = 1;
+ else
+ {
+ action = orig_handlers[csig];
+ orig_handlers[csig].sa_handler = SIG_ERR;
+ scheme_handlers[csig] = SCM_BOOL_F;
+ }
+#else
+ if (orig_handlers[csig] == SIG_ERR)
+ query_only = 1;
+ else
+ {
+ chandler = orig_handlers[csig];
+ orig_handlers[csig] = SIG_ERR;
+ scheme_handlers[csig] = SCM_BOOL_F;
+ }
+#endif
+ }
+ else
+ {
+ SCM_ASSERT (SCM_NIMP (handler), handler, SCM_ARG2, s_sigaction);
+#ifdef HAVE_SIGACTION
+ action.sa_handler = take_signal;
+ if (orig_handlers[csig].sa_handler == SIG_ERR)
+ save_handler = 1;
+#else
+ chandler = take_signal;
+ if (orig_handlers[csig] == SIG_ERR)
+ save_handler = 1;
+#endif
+ scheme_handlers[csig] = handler;
+ }
+#ifdef HAVE_SIGACTION
+ if (query_only)
+ {
+ if (sigaction (csig, 0, &old_action) == -1)
+ scm_syserror (s_sigaction);
+ }
+ else
+ {
+ if (sigaction (csig, &action , &old_action) == -1)
+ scm_syserror (s_sigaction);
+ if (save_handler)
+ orig_handlers[csig] = old_action;
+ }
+ if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
+ old_handler = SCM_MAKINUM ((int) old_action.sa_handler);
+ SCM_ALLOW_INTS;
+ return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
+#else
+ if (query_only)
+ {
+ if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
+ scm_syserror (s_sigaction);
+ if (signal (csig, old_chandler) == SIG_ERR)
+ scm_syserror (s_sigaction);
+ }
+ else
+ {
+ if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
+ scm_syserror (s_sigaction);
+ if (save_handler)
+ orig_handlers[csig] = old_chandler;
+ }
+ if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
+ old_handler = SCM_MAKINUM ((int) old_chandler);
+ SCM_ALLOW_INTS;
+ return scm_cons (old_handler, SCM_MAKINUM (0));
+#endif
+}
+
+SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
+SCM
+scm_restore_signals (void)
+{
+ int i;
+ SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
+
+ for (i = 0; i < NSIG; i++)
+ {
+#ifdef HAVE_SIGACTION
+ if (orig_handlers[i].sa_handler != SIG_ERR)
+ {
+ if (sigaction (i, &orig_handlers[i], NULL) == -1)
+ scm_syserror (s_restore_signals);
+ orig_handlers[i].sa_handler = SIG_ERR;
+ scheme_handlers[i] = SCM_BOOL_F;
+ }
+#else
+ if (orig_handlers[i] != SIG_ERR)
+ {
+ if (signal (i, orig_handlers[i]) == SIG_ERR)
+ scm_syserror (s_restore_signals);
+ orig_handlers[i] = SIG_ERR;
+ scheme_handlers[i] = SCM_BOOL_F;
+ }
+#endif
+ }
+ return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
+
+SCM
+scm_alarm (i)
+ SCM i;
+{
+ unsigned int j;
+ SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
+ j = alarm (SCM_INUM (i));
+ return SCM_MAKINUM (j);
+}
+
+#ifdef HAVE_PAUSE
+SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
+
+SCM
+scm_pause ()
+{
+ pause ();
+ return SCM_UNSPECIFIED;
+}
+#endif
+
+SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
+
+SCM
+scm_sleep (i)
+ SCM i;
+{
+ unsigned long j;
+ SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
+#ifdef USE_THREADS
+ j = scm_thread_sleep (SCM_INUM(i));
+#else
+ j = sleep (SCM_INUM(i));
+#endif
+ return scm_ulong2num (j);
+}
+
+#if defined(USE_THREADS) || defined(HAVE_USLEEP)
+SCM_PROC(s_usleep, "usleep", 1, 0, 0, scm_usleep);
+
+SCM
+scm_usleep (i)
+ SCM i;
+{
+ SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_usleep);
+
+#ifdef USE_THREADS
+ /* If we have threads, we use the thread system's sleep function. */
+ {
+ unsigned long j = scm_thread_usleep (SCM_INUM (i));
+ return scm_ulong2num (j);
+ }
+#else
+#ifdef USLEEP_RETURNS_VOID
+ usleep (SCM_INUM (i));
+ return SCM_INUM0;
+#else
+ {
+ int j = usleep (SCM_INUM (i));
+ return SCM_MAKINUM (j);
+ }
+#endif
+#endif
+}
+#endif /* GUILE_ISELECT || HAVE_USLEEP */
+
+SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
+
+SCM
+scm_raise(sig)
+ SCM sig;
+{
+ SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
+ SCM_DEFER_INTS;
+ if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
+ scm_syserror (s_raise);
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
+}
+
+\f
+
+void
+scm_init_scmsigs ()
+{
+ SCM thunk;
+ 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);
+ signal_async = scm_system_async (thunk);
+
+ for (i = 0; i < NSIG; i++)
+ {
+ got_signal[i] = 0;
+#ifdef HAVE_SIGACTION
+ orig_handlers[i].sa_handler = SIG_ERR;
+#else
+ orig_handlers[i] = SIG_ERR;
+#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));
+#ifdef SA_NOCLDSTOP
+ scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
+#endif
+#ifdef SA_RESTART
+ scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
+#endif
+
+#include "scmsigs.x"
+}
+
HCoop / bpt / guile.git / blobdiff