[bpt/guile.git] / libguile / scmsigs.c

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


\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 int j;
  SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
  j = sleep (SCM_INUM(i));
  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);
  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,
						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"
}
Commit	Line	Data
e1a191a8	1	/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
0f2d19dd JB	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
82892bed JB	15	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
82892bed JB	16	* Boston, MA 02111-1307 USA
0f2d19dd JB	17	*
	18	* As a special exception, the Free Software Foundation gives permission
	19	* for additional uses of the text contained in its release of GUILE.
	20	*
	21	* The exception is that, if you link the GUILE library with other files
	22	* to produce an executable, this does not by itself cause the
	23	* resulting executable to be covered by the GNU General Public License.
	24	* Your use of that executable is in no way restricted on account of
	25	* linking the GUILE library code into it.
	26	*
	27	* This exception does not however invalidate any other reasons why
	28	* the executable file might be covered by the GNU General Public License.
	29	*
	30	* This exception applies only to the code released by the
	31	* Free Software Foundation under the name GUILE. If you copy
	32	* code from other Free Software Foundation releases into a copy of
	33	* GUILE, as the General Public License permits, the exception does
	34	* not apply to the code that you add in this way. To avoid misleading
	35	* anyone as to the status of such modified files, you must delete
	36	* this exception notice from them.
	37	*
	38	* If you write modifications of your own for GUILE, it is your choice
	39	* whether to permit this exception to apply to your modifications.
82892bed	40	* If you do not wish that, delete this exception notice. */
0f2d19dd JB	41	\f
	42
	43	#include <stdio.h>
	44	#include <signal.h>
	45	#include "_scm.h"
	46
e1a191a8 GH	47	#include "async.h"
e1a191a8 GH	48	#include "eval.h"
20e6290e JB	49	#include "scmsigs.h"
20e6290e JB	50
0f2d19dd JB	51	#ifdef HAVE_UNISTD_H
	52	#include <unistd.h>
	53	#endif
	54
	55
	56	\f
	57
317607b0 MD	58	#ifdef USE_MIT_PTHREADS
	59	#undef signal
	60	#define signal pthread_signal
	61	#endif
	62
0f2d19dd JB	63	\f
0f2d19dd JB	64
e1a191a8	65	/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
0f2d19dd JB	66
0f2d19dd JB	67	#ifdef RETSIGTYPE
e1a191a8	68	# define SIGRETTYPE RETSIGTYPE
0f2d19dd	69	#else
e1a191a8 GH	70	# ifdef STDC_HEADERS
	71	# define SIGRETTYPE void
	72	# else
	73	# define SIGRETTYPE int
	74	# endif
0f2d19dd JB	75	#endif
	76
	77	\f
	78
e1a191a8 GH	79	/* take_signal is installed as the C signal handler whenever a Scheme
	80	handler is set. when a signal arrives, take_signal marks the corresponding
	81	element of got_signal and marks signal_async. the thunk in signal_async
	82	(sys_deliver_signals) will be run at the next opportunity, outside a
	83	critical section. sys_deliver_signals runs each Scheme handler for
	84	which got_signal is set. */
0f2d19dd	85
e1a191a8	86	static SCM signal_async;
0f2d19dd	87
e1a191a8	88	static char got_signal[NSIG];
0f2d19dd	89
e1a191a8 GH	90	/* a Scheme vector of handler procedures. */
e1a191a8 GH	91	static SCM *signal_handlers;
0f2d19dd	92
e1a191a8 GH	93	/* saves the original C handlers, when a new handler is installed.
	94	set to SIG_ERR if the original handler is installed. */
	95	#ifdef HAVE_SIGACTION
	96	static struct sigaction orig_handlers[NSIG];
	97	#else
	98	static SIGRETTYPE (*orig_handlers)(int)[NSIG];
0f2d19dd JB	99	#endif
0f2d19dd JB	100
e1a191a8 GH	101	static SIGRETTYPE
	102	take_signal (int signum)
	103	{
	104	SCM ignored;
	105	if (!scm_ints_disabled)
	106	{
	107	/* For reasons of speed, the SCM_NEWCELL macro doesn't defer
	108	interrupts. Instead, it first sets its argument to point to
	109	the first cell in the list, and then advances the freelist
	110	pointer to the next cell. Now, if this procedure is
	111	interrupted, the only anomalous state possible is to have
	112	both SCM_NEWCELL's argument and scm_freelist pointing to the
	113	same cell. To deal with this case, we always throw away the
	114	first cell in scm_freelist here.
	115
	116	At least, that's the theory. I'm not convinced that that's
	117	the only anomalous path we need to worry about. */
	118	SCM_NEWCELL (ignored);
	119	}
	120	got_signal[signum] = 1;
	121	#if HAVE_SIGACTION
	122	/* unblock the signal before the scheme handler gets to run, since
	123	it may use longjmp to escape (i.e., throw an exception). */
	124	{
	125	sigset_t set;
	126	sigemptyset (&set);
	127	sigaddset (&set, signum);
	128	sigprocmask (SIG_UNBLOCK, &set, NULL);
	129	}
	130	#endif
	131	scm_system_async_mark (signal_async);
	132	}
0f2d19dd	133
e1a191a8 GH	134	static SCM
	135	sys_deliver_signals (void)
	136	{
	137	int i;
	138
	139	for (i = 0; i < NSIG; i++)
	140	{
	141	if (got_signal[i])
	142	{
cc0b3312 GH	143	/* The flag is reset before calling the handler in case the
	144	handler doesn't return. If the handler doesn't return
	145	but leaves other signals flagged, they their handlers
	146	will be applied some time later when the async is checked
	147	again. It would probably be better to reset the flags
	148	after doing a longjmp. */
e1a191a8 GH	149	got_signal[i] = 0;
	150	#ifndef HAVE_SIGACTION
	151	signal (i, take_signal);
	152	#endif
2ad6b1a5 GH	153	scm_apply (SCM_VELTS (*signal_handlers)[i],
	154	scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
	155	SCM_EOL);
e1a191a8 GH	156	}
	157	}
	158	return SCM_UNSPECIFIED;
0f2d19dd JB	159	}
0f2d19dd JB	160
e1a191a8 GH	161	/* user interface for installation of signal handlers. */
	162	SCM_PROC(s_sigaction, "sigaction", 1, 2, 0, scm_sigaction);
	163	SCM
	164	scm_sigaction (SCM signum, SCM handler, SCM flags)
	165	{
	166	int csig;
	167	#ifdef HAVE_SIGACTION
	168	struct sigaction action;
	169	struct sigaction old_action;
	170	#else
	171	SIGRETTYPE (* chandler) (int);
	172	SIGRETTYPE (* old_chandler) (int);
	173	#endif
	174	int query_only = 0;
	175	int save_handler = 0;
	176	SCM scheme_handlers = SCM_VELTS (signal_handlers);
	177	SCM old_handler;
	178
	179	SCM_ASSERT (SCM_INUMP (signum), signum, SCM_ARG1, s_sigaction);
	180	csig = SCM_INUM (signum);
	181	#ifdef HAVE_SIGACTION
	182	/* always use restartable system calls if available. */
	183	#ifdef SA_RESTART
	184	action.sa_flags = SA_RESTART;
	185	#else
	186	action.sa_flags = 0;
	187	#endif
	188	if (!SCM_UNBNDP (flags))
	189	{
	190	SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG3, s_sigaction);
	191	action.sa_flags \|= SCM_INUM (flags);
	192	}
	193	sigemptyset (&action.sa_mask);
	194	#endif
	195	SCM_DEFER_INTS;
	196	old_handler = scheme_handlers[csig];
	197	if (SCM_UNBNDP (handler))
	198	query_only = 1;
	199	else if (SCM_INUMP (handler))
	200	{
	201	if (SCM_INUM (handler) == (int) SIG_DFL
	202	\|\| SCM_INUM (handler) == (int) SIG_IGN)
	203	{
	204	#ifdef HAVE_SIGACTION
	205	action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
	206	#else
	207	chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
	208	#endif
	209	scheme_handlers[csig] = SCM_BOOL_F;
	210	}
	211	else
	212	scm_out_of_range (s_sigaction, handler);
	213	}
	214	else if (SCM_FALSEP (handler))
	215	{
	216	/* restore the default handler. */
	217	#ifdef HAVE_SIGACTION
	218	if (orig_handlers[csig].sa_handler == SIG_ERR)
	219	query_only = 1;
	220	else
	221	{
	222	action = orig_handlers[csig];
	223	orig_handlers[csig].sa_handler = SIG_ERR;
	224	scheme_handlers[csig] = SCM_BOOL_F;
225	}
226	#else
227	if (orig_handlers[csig] == SIG_ERR)
228	query_only = 1;
229	else
230	{
231	chandler = orig_handlers[csig];
232	orig_handlers[csig] = SIG_ERR;
233	scheme_handlers[csig] = SCM_BOOL_F;
234	}
235	#endif
236	}
237	else
238	{
239	SCM_ASSERT (SCM_NIMP (handler), handler, SCM_ARG2, s_sigaction);
240	#ifdef HAVE_SIGACTION
241	action.sa_handler = take_signal;
242	if (orig_handlers[csig].sa_handler == SIG_ERR)
243	save_handler = 1;
244	#else
245	chandler = take_signal;
246	if (orig_handlers[csig] == SIG_ERR)
247	save_handler = 1;
248	#endif
249	scheme_handlers[csig] = handler;
250	}
251	#ifdef HAVE_SIGACTION
252	if (query_only)
253	{
254	if (sigaction (csig, 0, &old_action) == -1)
255	scm_syserror (s_sigaction);
256	}
257	else
258	{
259	if (sigaction (csig, &action , &old_action) == -1)
260	scm_syserror (s_sigaction);
261	if (save_handler)
262	orig_handlers[csig] = old_action;
263	}
264	if (old_action.sa_handler == SIG_DFL \|\| old_action.sa_handler == SIG_IGN)
265	old_handler = SCM_MAKINUM ((int) old_action.sa_handler);
266	SCM_ALLOW_INTS;
267	return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
268	#else
269	if (query_only)
270	{
271	if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
272	scm_syserror (s_sigaction);
273	if (signal (csig, old_chandler) == SIG_ERR)
274	scm_syserror (s_sigaction);
275	}
276	else
277	{
278	if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
279	scm_syserror (s_sigaction);
280	if (save_handler)
281	orig_handlers[csig] = old_chandler;
282	}
283	if (old_chandler == SIG_DFL \|\| old_chandler == SIG_IGN)
284	old_handler = SCM_MAKINUM ((int) old_chandler);
285	SCM_ALLOW_INTS;
286	return scm_cons (old_handler, SCM_MAKINUM (0));
0f2d19dd	287	#endif
e1a191a8 GH	288	}
	289
	290	SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
	291	SCM
	292	scm_restore_signals (void)
	293	{
	294	int i;
	295	SCM scheme_handlers = SCM_VELTS (signal_handlers);
	296
	297	for (i = 0; i < NSIG; i++)
	298	{
	299	#ifdef HAVE_SIGACTION
	300	if (orig_handlers[i].sa_handler != SIG_ERR)
	301	{
	302	if (sigaction (i, &orig_handlers[i], NULL) == -1)
	303	scm_syserror (s_restore_signals);
	304	orig_handlers[i].sa_handler = SIG_ERR;
	305	scheme_handlers[i] = SCM_BOOL_F;
	306	}
	307	#else
	308	if (orig_handlers[i] != SIG_ERR)
	309	{
	310	if (signal (i, orig_handlers[i]) == SIG_ERR)
	311	scm_syserror (s_restore_signals);
	312	orig_handlers[i] = SIG_ERR;
	313	scheme_handlers[i] = SCM_BOOL_F;
	314	}
	315	#endif
	316	}
	317	return SCM_UNSPECIFIED;
	318	}
0f2d19dd JB	319
0f2d19dd JB	320	SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
1cc91f1b	321
0f2d19dd JB	322	SCM
	323	scm_alarm (i)
	324	SCM i;
0f2d19dd JB	325	{
	326	unsigned int j;
	327	SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
e1a191a8	328	j = alarm (SCM_INUM (i));
0f2d19dd JB	329	return SCM_MAKINUM (j);
	330	}
	331
0e958795	332	#ifdef HAVE_PAUSE
0f2d19dd	333	SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
1cc91f1b	334
0f2d19dd JB	335	SCM
0f2d19dd JB	336	scm_pause ()
0f2d19dd JB	337	{
	338	pause ();
	339	return SCM_UNSPECIFIED;
	340	}
0e958795	341	#endif
0f2d19dd JB	342
0f2d19dd JB	343	SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
1cc91f1b	344
0f2d19dd JB	345	SCM
	346	scm_sleep (i)
	347	SCM i;
0f2d19dd JB	348	{
	349	unsigned int j;
	350	SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
e1a191a8	351	j = sleep (SCM_INUM(i));
0f2d19dd JB	352	return SCM_MAKINUM (j);
	353	}
	354
	355	SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
1cc91f1b	356
0f2d19dd JB	357	SCM
	358	scm_raise(sig)
	359	SCM sig;
0f2d19dd JB	360	{
0f2d19dd JB	361	SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
e1a191a8 GH	362	SCM_DEFER_INTS;
	363	if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
	364	scm_syserror (s_raise);
	365	SCM_ALLOW_INTS;
	366	return SCM_UNSPECIFIED;
0f2d19dd JB	367	}
	368
	369	\f
0f2d19dd	370
e1a191a8 GH	371	void
e1a191a8 GH	372	scm_init_scmsigs ()
0f2d19dd	373	{
e1a191a8 GH	374	SCM thunk;
	375	int i;
	376
	377	signal_handlers =
	378	SCM_CDRLOC (scm_sysintern ("signal-handlers",
	379	scm_make_vector (SCM_MAKINUM (NSIG),
	380	SCM_BOOL_F,
	381	SCM_BOOL_F)));
	382	thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
	383	sys_deliver_signals);
	384	signal_async = scm_system_async (thunk);
	385
	386	for (i = 0; i < NSIG; i++)
	387	{
	388	got_signal[i] = 0;
	389	#ifdef HAVE_SIGACTION
	390	orig_handlers[i].sa_handler = SIG_ERR;
	391	#else
	392	orig_handlers[i] = SIG_ERR;
0f2d19dd	393	#endif
e1a191a8	394	}
1cc91f1b	395
e1a191a8 GH	396	scm_sysintern ("NSIG", scm_long2num (NSIG));
	397	scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
	398	scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
	399	#ifdef SA_NOCLDSTOP
	400	scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
0f2d19dd	401	#endif
e1a191a8 GH	402	#ifdef SA_RESTART
e1a191a8 GH	403	scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
0f2d19dd	404	#endif
1cc91f1b	405
0f2d19dd JB	406	#include "scmsigs.x"
	407	}
	408