summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1997-05-31 19:02:38 +0000
committerGary Houston <ghouston@arglist.com>1997-05-31 19:02:38 +0000
commite1a191a8ca07dd14b956f6e349044d3dabb424c5 (patch)
treec69be678321a8190bfcf46f1d11fca404c56ee40 /libguile
parent19da35d025dbc924ca37e77a8c8d97864f3ef58c (diff)
downloadguile-e1a191a8ca07dd14b956f6e349044d3dabb424c5.tar.gz
* scmsigs.h, async.h: updated.
* _scm.h: if HAVE_RESTARTS is defined then don't use a SYSCALL loop. * posix.c (scm_uname): interpret only negative values as an error. Solaris normally returns a positive value. * script.c (scm_compile_shell_switches): if we are not going into an interactive repl, set scm_mask_ints to zero so that asyncs can run. * simpos.c (scm_system): don't ignore/unignore signals around the "system" call. * posix.c (scm_open_pipe): don't ignore/unignore signals around the "popen" call. * init.c (scm_boot_guile_1): don't call scm_init_signals, it's done in boot-9.scm instead. * scmsigs.c, async.c: Major rewriting of signal handling code. (scm_sigaction): new procedure. (scm_sleep): don't wrap sleep in SCM_SYSCALL, it would mess up the timing. (scm_raise): return unspecified, throw error on failure. * boot-9.scm: signal-handler, alarm-thunk: removed. don't define ticks-interrupt etc. top-repl: install signal handlers for SIGINT, SIGFPE, SIGSEGV, SIGBUS during call to scm-style-repl. * acconfig.h: mention HAVE_RESTARTS. * configure.in: check for sigaction and restartable system calls.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/ChangeLog29
-rw-r--r--libguile/_scm.h16
-rw-r--r--libguile/async.c157
-rw-r--r--libguile/async.h13
-rw-r--r--libguile/init.c2
-rw-r--r--libguile/posix.c4
-rw-r--r--libguile/scmconfig.h.in6
-rw-r--r--libguile/scmsigs.c508
-rw-r--r--libguile/scmsigs.h8
-rw-r--r--libguile/script.c2
-rw-r--r--libguile/simpos.c2
11 files changed, 337 insertions, 410 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 42cee4094..8bcfb3fcb 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,32 @@
+Sat May 31 18:57:51 1997 Gary Houston <ghouston@actrix.gen.nz>
+
+ * scmsigs.h, async.h: updated.
+
+ * _scm.h: if HAVE_RESTARTS is defined then don't use a SYSCALL
+ loop.
+
+ * posix.c (scm_uname): interpret only negative values as an error.
+ Solaris normally returns a positive value.
+
+ * script.c (scm_compile_shell_switches): if we are not going into
+ an interactive repl, set scm_mask_ints to zero so that asyncs can
+ run.
+
+ * simpos.c (scm_system): don't ignore/unignore signals around
+ the "system" call.
+
+ * posix.c (scm_open_pipe): don't ignore/unignore signals around
+ the "popen" call.
+
+ * init.c (scm_boot_guile_1): don't call scm_init_signals, it's
+ done in boot-9.scm instead.
+
+ * scmsigs.c, async.c: Major rewriting of signal handling code.
+ (scm_sigaction): new procedure.
+ (scm_sleep): don't wrap sleep in SCM_SYSCALL, it would mess up the
+ timing.
+ (scm_raise): return unspecified, throw error on failure.
+
Thu May 29 02:47:36 1997 Jim Blandy <jimb@floss.cyclic.com>
* regex-posix.c (scm_init_regex_posix): Register the "regex"
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 2798c2090..d8662881d 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -76,7 +76,18 @@
*/
#include <errno.h>
-/* SCM_SYSCALL retries system calls that have been interrupted (EINTR) */
+/* SCM_SYSCALL retries system calls that have been interrupted (EINTR).
+ However this can be avoided if the operating system can restart
+ system calls automatically. We assume this is the case if
+ sigaction is available and SA_RESTART is defined; they will be used
+ when installing signal handlers.
+ */
+
+#ifdef HAVE_RESTARTS
+#define SCM_SYSCALL(line) line
+#endif
+
+#ifndef SCM_SYSCALL
#ifdef vms
# ifndef __GNUC__
# include <ssdef.h>
@@ -84,6 +95,7 @@
while(EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))
# endif /* ndef __GNUC__ */
#endif /* def vms */
+#endif /* ndef SCM_SYSCALL */
#ifndef SCM_SYSCALL
# ifdef EINTR
@@ -94,7 +106,7 @@
#endif /* ndef SCM_SYSCALL */
#ifndef SCM_SYSCALL
-# define SCM_SYSCALL(line) {line;}
+# define SCM_SYSCALL(line) line;
#endif /* ndef SCM_SYSCALL */
#ifndef MSDOS
diff --git a/libguile/async.c b/libguile/async.c
index 2e4960ab5..1a0f74050 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
@@ -100,26 +100,8 @@ static unsigned int scm_switch_clock = 0;
static unsigned int scm_switch_rate = 0;
static unsigned int scm_desired_switch_rate = 0;
-static SCM system_signal_asyncs[SCM_NUM_SIGS];
-static SCM handler_var;
-static SCM symbol_signal;
-
-
-struct scm_async
-{
- int got_it; /* needs to be delivered? */
- SCM thunk; /* the handler. */
-};
-
-
static long scm_tc16_async;
-#define SCM_ASYNCP(X) (scm_tc16_async == SCM_GCTYP16 (X))
-#define SCM_ASYNC(X) ((struct scm_async *)SCM_CDR (X))
-
-
-
-
static int asyncs_pending SCM_P ((void));
@@ -281,30 +263,8 @@ scm_switch ()
#endif
}
-
-
-static void scm_deliver_signal SCM_P ((int num));
-
-static void
-scm_deliver_signal (num)
- int num;
-{
- SCM handler;
- handler = SCM_CDR (handler_var);
- if (handler != SCM_BOOL_F)
- scm_apply (handler, SCM_MAKINUM (num), scm_listofnull);
- else
- {
- scm_mask_ints = 0;
- scm_throw (symbol_signal,
- scm_listify (SCM_MAKINUM (num), SCM_UNDEFINED));
- }
-}
-
-
-
static int print_async SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
static int
@@ -514,66 +474,6 @@ scm_set_switch_rate (n)
-
-static SCM scm_sys_hup_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_hup_async_thunk ()
-{
- scm_deliver_signal (SCM_HUP_SIGNAL);
- return SCM_BOOL_F;
-}
-
-
-static SCM scm_sys_int_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_int_async_thunk ()
-{
- scm_deliver_signal (SCM_INT_SIGNAL);
- return SCM_BOOL_F;
-}
-
-
-static SCM scm_sys_fpe_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_fpe_async_thunk ()
-{
- scm_deliver_signal (SCM_FPE_SIGNAL);
- return SCM_BOOL_F;
-}
-
-
-static SCM scm_sys_bus_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_bus_async_thunk ()
-{
- scm_deliver_signal (SCM_BUS_SIGNAL);
- return SCM_BOOL_F;
-}
-
-
-static SCM scm_sys_segv_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_segv_async_thunk ()
-{
- scm_deliver_signal (SCM_SEGV_SIGNAL);
- return SCM_BOOL_F;
-}
-
-
-static SCM scm_sys_alrm_async_thunk SCM_P ((void));
-
-static SCM
-scm_sys_alrm_async_thunk ()
-{
- scm_deliver_signal (SCM_ALRM_SIGNAL);
- return SCM_BOOL_F;
-}
-
/* points to the GC system-async, so that scm_gc_end can find it. */
SCM scm_gc_async;
@@ -597,32 +497,6 @@ scm_sys_gc_async_thunk (void)
-SCM
-scm_take_signal (n)
- int n;
-{
- 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);
- }
- scm_system_async_mark (system_signal_asyncs[SCM_SIG_ORD(n)]);
- return SCM_BOOL_F;
-}
-
-
-
SCM_PROC(s_unmask_signals, "unmask-signals", 0, 0, 0, scm_unmask_signals);
SCM
@@ -649,39 +523,10 @@ scm_init_async ()
{
SCM a_thunk;
scm_tc16_async = scm_newsmob (&async_smob);
- symbol_signal = SCM_CAR (scm_sysintern ("signal", SCM_UNDEFINED));
- scm_permanent_object (symbol_signal);
-
- /* These are in the opposite order of delivery priortity.
- *
- * Error conditions are given low priority:
- */
- a_thunk = scm_make_gsubr ("%hup-thunk", 0, 0, 0, scm_sys_hup_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_HUP_SIGNAL)] = scm_system_async (a_thunk);
- a_thunk = scm_make_gsubr ("%int-thunk", 0, 0, 0, scm_sys_int_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_INT_SIGNAL)] = scm_system_async (a_thunk);
- a_thunk = scm_make_gsubr ("%fpe-thunk", 0, 0, 0, scm_sys_fpe_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_FPE_SIGNAL)] = scm_system_async (a_thunk);
- a_thunk = scm_make_gsubr ("%bus-thunk", 0, 0, 0, scm_sys_bus_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_BUS_SIGNAL)] = scm_system_async (a_thunk);
- a_thunk = scm_make_gsubr ("%segv-thunk", 0, 0, 0, scm_sys_segv_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_SEGV_SIGNAL)] = scm_system_async (a_thunk);
scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F);
a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk);
scm_gc_async = scm_system_async (a_thunk);
- /* Clock and PC driven conditions are given highest priority. */
- /*
- a_thunk = scm_make_gsubr ("%tick-thunk", 0, 0, 0, scm_sys_tick_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)] = scm_system_async (a_thunk);
- */
-
- a_thunk = scm_make_gsubr ("%alrm-thunk", 0, 0, 0, scm_sys_alrm_async_thunk);
- system_signal_asyncs[SCM_SIG_ORD(SCM_ALRM_SIGNAL)] = scm_system_async (a_thunk);
-
- handler_var = scm_sysintern ("signal-handler", SCM_UNDEFINED);
- SCM_SETCDR (handler_var, SCM_BOOL_F);
- scm_permanent_object (handler_var);
#include "async.x"
}
diff --git a/libguile/async.h b/libguile/async.h
index ffb7d9346..6f9458983 100644
--- a/libguile/async.h
+++ b/libguile/async.h
@@ -2,7 +2,7 @@
#ifndef ASYNCH
#define ASYNCH
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
@@ -48,6 +48,16 @@
+#define SCM_ASYNCP(X) (scm_tc16_async == SCM_GCTYP16 (X))
+#define SCM_ASYNC(X) ((struct scm_async *)SCM_CDR (X))
+
+struct scm_async
+{
+ int got_it; /* needs to be delivered? */
+ SCM thunk; /* the handler. */
+};
+
+
extern unsigned int scm_mask_ints;
extern SCM scm_gc_async;
@@ -63,7 +73,6 @@ extern SCM scm_run_asyncs SCM_P ((SCM list_of_a));
extern SCM scm_noop SCM_P ((SCM args));
extern SCM scm_set_tick_rate SCM_P ((SCM n));
extern SCM scm_set_switch_rate SCM_P ((SCM n));
-extern SCM scm_take_signal SCM_P ((int n));
extern SCM scm_unmask_signals SCM_P ((void));
extern SCM scm_mask_signals SCM_P ((void));
extern void scm_init_async SCM_P ((void));
diff --git a/libguile/init.c b/libguile/init.c
index 2b7271ca9..d561f83a7 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -473,8 +473,6 @@ scm_boot_guile_1 (base, closure)
setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont));
if (!setjmp_val)
{
- scm_init_signals ();
-
scm_set_program_arguments (closure->argc, closure->argv, 0);
scm_internal_catch (SCM_BOOL_T, invoke_main_func, closure,
scm_handle_by_message, 0);
diff --git a/libguile/posix.c b/libguile/posix.c
index 67aeb87df..c763f4da8 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -811,7 +811,7 @@ scm_uname ()
SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
SCM *ve = SCM_VELTS (ans);
SCM_DEFER_INTS;
- if (uname (&buf))
+ if (uname (&buf) < 0)
scm_syserror (s_uname);
ve[0] = scm_makfrom0str (buf.sysname);
ve[1] = scm_makfrom0str (buf.nodename);
@@ -921,9 +921,7 @@ scm_open_pipe (pipestr, modes)
modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
SCM_NEWCELL (z);
SCM_DEFER_INTS;
- scm_ignore_signals ();
SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
- scm_unignore_signals ();
if (!f)
scm_syserror (s_open_pipe);
pt = scm_add_to_port_table (z);
diff --git a/libguile/scmconfig.h.in b/libguile/scmconfig.h.in
index 2005c89e3..09b790c4f 100644
--- a/libguile/scmconfig.h.in
+++ b/libguile/scmconfig.h.in
@@ -158,6 +158,9 @@
/* Define if you want support for dynamic linking. */
#undef DYNAMIC_LINKING
+/* Define if the operating system can restart system calls. */
+#undef HAVE_RESTARTS
+
/* Define if you have the ctermid function. */
#undef HAVE_CTERMID
@@ -227,6 +230,9 @@
/* Define if you have the shl_load function. */
#undef HAVE_SHL_LOAD
+/* Define if you have the sigaction function. */
+#undef HAVE_SIGACTION
+
/* Define if you have the strerror function. */
#undef HAVE_STRERROR
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 9206addef..fe11eb651 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
@@ -44,6 +44,8 @@
#include <signal.h>
#include "_scm.h"
+#include "async.h"
+#include "eval.h"
#include "scmsigs.h"
#ifdef HAVE_UNISTD_H
@@ -53,10 +55,6 @@
-#if (__TURBOC__==1)
-#define signal ssignal /* Needed for TURBOC V1.0 */
-#endif
-
#ifdef USE_MIT_PTHREADS
#undef signal
#define signal pthread_signal
@@ -64,81 +62,254 @@
-/* SIGRETTYPE is the type that signal handlers return. See <signal.h>*/
+/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
#ifdef RETSIGTYPE
-#define SIGRETTYPE 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
+# ifdef STDC_HEADERS
+# define SIGRETTYPE void
+# else
+# define SIGRETTYPE int
+# endif
#endif
-#define SIGFN(NAME, SCM_NAME, SIGNAL) \
-static SIGRETTYPE \
-NAME (sig) \
- int sig; \
-{ \
- signal (SIGNAL, NAME); \
- scm_take_signal (SCM_NAME); \
-}
+/* 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. */
-#ifdef SIGHUP
-SIGFN(scm_hup_signal, SCM_HUP_SIGNAL, SIGHUP)
-#endif
+static SCM signal_async;
-#ifdef SIGINT
-SIGFN(scm_int_signal, SCM_INT_SIGNAL, SIGINT)
-#endif
+static char got_signal[NSIG];
-#ifdef SIGFPE
-SIGFN(scm_fpe_signal, SCM_FPE_SIGNAL, SIGFPE)
-#endif
+/* a Scheme vector of handler procedures. */
+static SCM *signal_handlers;
-#ifdef SIGBUS
-SIGFN(scm_bus_signal, SCM_BUS_SIGNAL, SIGBUS)
-#endif
-
-#ifdef SIGSEGV
-SIGFN(scm_segv_signal, SCM_SEGV_SIGNAL, SIGSEGV)
+/* 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
-#ifdef SIGALRM
-SIGFN(scm_alrm_signal, SCM_ALRM_SIGNAL, SIGALRM)
-#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);
+}
-#define FAKESIGFN(NAME, SCM_NAME) \
-static SIGRETTYPE \
-NAME (sig) \
- int sig; \
-{ \
- scm_take_signal (SCM_NAME); \
+static SCM
+sys_deliver_signals (void)
+{
+ int i;
+
+ for (i = 0; i < NSIG; i++)
+ {
+ if (got_signal[i])
+ {
+ scm_apply (SCM_VELTS (*signal_handlers)[i],
+ scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
+ SCM_EOL);
+ got_signal[i] = 0;
+#ifndef HAVE_SIGACTION
+ signal (i, take_signal);
+#endif
+ }
+ }
+ return SCM_UNSPECIFIED;
}
-#if 0
-/* !!! */
-FAKESIGFN(scm_gc_signal, SCM_GC_SIGNAL)
-FAKESIGFN(scm_tick_signal, SCM_TICK_SIGNAL)
+/* 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);
@@ -148,11 +319,10 @@ scm_alarm (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)));
+ j = alarm (SCM_INUM (i));
return SCM_MAKINUM (j);
}
-
SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
SCM
@@ -170,11 +340,7 @@ scm_sleep (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
+ j = sleep (SCM_INUM(i));
return SCM_MAKINUM (j);
}
@@ -185,184 +351,50 @@ 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
+ SCM_DEFER_INTS;
+ if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
+ scm_syserror (s_raise);
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
}
-#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 ()
+void
+scm_init_scmsigs ()
{
- 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);
+ SCM thunk;
+ int i;
+
+ signal_handlers =
+ SCM_CDRLOC (scm_sysintern ("signal-handlers",
+ scm_make_vector (SCM_MAKINUM (NSIG),
+ SCM_BOOL_F,
+ 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
-#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);
+ 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 SIGSEGV /* AMIGA lacks! */
- signal (SIGSEGV, oldsegv);
+#ifdef SA_RESTART
+ scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
#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"
}
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
index 26a0aaa3b..9cce2b67b 100644
--- a/libguile/scmsigs.h
+++ b/libguile/scmsigs.h
@@ -2,7 +2,7 @@
#ifndef SCMSIGSH
#define SCMSIGSH
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
@@ -47,14 +47,12 @@
+extern SCM scm_sigaction (SCM signum, SCM handler, SCM flags);
+extern SCM scm_restore_signals SCM_P ((void));
extern SCM scm_alarm SCM_P ((SCM i));
extern SCM scm_pause SCM_P ((void));
extern SCM scm_sleep SCM_P ((SCM i));
extern SCM scm_raise SCM_P ((SCM sig));
-extern void scm_init_signals SCM_P ((void));
-extern void scm_ignore_signals SCM_P ((void));
-extern void scm_unignore_signals SCM_P ((void));
-extern SCM scm_restore_signals SCM_P ((void));
extern void scm_init_scmsigs SCM_P ((void));
#endif /* SCMSIGSH */
diff --git a/libguile/script.c b/libguile/script.c
index 3e8158681..36f3c1e19 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -614,6 +614,8 @@ scm_compile_shell_switches (int argc, char **argv)
quit. */
tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
tail);
+ /* Allow asyncs (signal handlers etc.) to be run. */
+ scm_mask_ints = 0;
}
{
/* We want a path only containing directories from SCHEME_LOAD_PATH,
diff --git a/libguile/simpos.c b/libguile/simpos.c
index 6d67e422d..69117ecae 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -67,13 +67,11 @@ scm_system(cmd)
SCM_ASSERT(SCM_NIMP(cmd) && SCM_ROSTRINGP(cmd), cmd, SCM_ARG1, s_system);
if (SCM_ROSTRINGP (cmd))
cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_ROLENGTH (cmd), 0);
- scm_ignore_signals();
# ifdef AZTEC_C
cmd = SCM_MAKINUM(Execute(SCM_ROCHARS(cmd), 0, 0));
# else
cmd = SCM_MAKINUM(0L+system(SCM_ROCHARS(cmd)));
# endif
- scm_unignore_signals();
return cmd;
}
#endif