mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 02:00:26 +02:00
Code Activity

* scmsigs.h, async.h: updated.

Browse source 
* _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.
This commit is contained in:
Gary Houston 1997-05-31 19:02:38 +00:00
parent 19da35d025
commit e1a191a8ca
18 changed files with 557 additions and 634 deletions
Download patch file Download diff file Expand all files Collapse all files

29
libguile/ChangeLog
View file

@ -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"

16
libguile/_scm.h
View file

@ -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

157
libguile/async.c
View file

@ -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"
}

13
libguile/async.h
View file

@ -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
@ -47,6 +47,16 @@
#include "libguile/__scm.h"
#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;
@ -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));

2
libguile/init.c
View file

@ -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);

4
libguile/posix.c
View file

@ -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);

6
libguile/scmconfig.h.in
View file

@ -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

520
libguile/scmsigs.c
View file

@ -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. */
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);
}
#ifdef SIGHUP
SIGFN(scm_hup_signal, SCM_HUP_SIGNAL, SIGHUP)
#endif
static SCM
sys_deliver_signals (void)
{
int i;
#ifdef SIGINT
SIGFN(scm_int_signal, SCM_INT_SIGNAL, SIGINT)
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
#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); \
}
}
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
}
#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
SCM_DEFER_INTS;
if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
scm_syserror (s_raise);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
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,
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"
}

8
libguile/scmsigs.h
View file

@ -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 */

2
libguile/script.c
View file

@ -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,

2
libguile/simpos.c
View file

@ -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