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

/*	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"
}
Commit	Line	Data
7dc6e754	1	/* Copyright (C) 1995,1996,1997,1998 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
b74f4728 JB	55	/* The thread system has its own sleep and usleep functions. */
	56	#ifndef USE_THREADS
	57
	58	#if defined(MISSING_SLEEP_DECL)
	59	int sleep ();
	60	#endif
	61
	62	#if defined(HAVE_USLEEP) && defined(MISSING_USLEEP_DECL)
	63	int usleep ();
ce874f2d	64	#endif
b74f4728	65
0935d604	66	#endif
0f2d19dd JB	67
	68	\f
	69
317607b0 MD	70	#ifdef USE_MIT_PTHREADS
	71	#undef signal
	72	#define signal pthread_signal
	73	#endif
	74
0f2d19dd JB	75	\f
0f2d19dd JB	76
e1a191a8	77	/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
0f2d19dd JB	78
0f2d19dd JB	79	#ifdef RETSIGTYPE
e1a191a8	80	# define SIGRETTYPE RETSIGTYPE
0f2d19dd	81	#else
e1a191a8 GH	82	# ifdef STDC_HEADERS
	83	# define SIGRETTYPE void
	84	# else
	85	# define SIGRETTYPE int
	86	# endif
0f2d19dd JB	87	#endif
	88
	89	\f
	90
e1a191a8 GH	91	/* take_signal is installed as the C signal handler whenever a Scheme
	92	handler is set. when a signal arrives, take_signal marks the corresponding
	93	element of got_signal and marks signal_async. the thunk in signal_async
	94	(sys_deliver_signals) will be run at the next opportunity, outside a
	95	critical section. sys_deliver_signals runs each Scheme handler for
	96	which got_signal is set. */
0f2d19dd	97
e1a191a8	98	static SCM signal_async;
0f2d19dd	99
e1a191a8	100	static char got_signal[NSIG];
0f2d19dd	101
e1a191a8 GH	102	/* a Scheme vector of handler procedures. */
e1a191a8 GH	103	static SCM *signal_handlers;
0f2d19dd	104
e1a191a8 GH	105	/* saves the original C handlers, when a new handler is installed.
	106	set to SIG_ERR if the original handler is installed. */
	107	#ifdef HAVE_SIGACTION
	108	static struct sigaction orig_handlers[NSIG];
	109	#else
	110	static SIGRETTYPE (*orig_handlers)(int)[NSIG];
0f2d19dd JB	111	#endif
0f2d19dd JB	112
e1a191a8 GH	113	static SIGRETTYPE
	114	take_signal (int signum)
	115	{
	116	SCM ignored;
	117	if (!scm_ints_disabled)
	118	{
	119	/* For reasons of speed, the SCM_NEWCELL macro doesn't defer
	120	interrupts. Instead, it first sets its argument to point to
	121	the first cell in the list, and then advances the freelist
	122	pointer to the next cell. Now, if this procedure is
	123	interrupted, the only anomalous state possible is to have
	124	both SCM_NEWCELL's argument and scm_freelist pointing to the
	125	same cell. To deal with this case, we always throw away the
	126	first cell in scm_freelist here.
	127
	128	At least, that's the theory. I'm not convinced that that's
	129	the only anomalous path we need to worry about. */
	130	SCM_NEWCELL (ignored);
	131	}
	132	got_signal[signum] = 1;
	133	#if HAVE_SIGACTION
	134	/* unblock the signal before the scheme handler gets to run, since
	135	it may use longjmp to escape (i.e., throw an exception). */
	136	{
	137	sigset_t set;
	138	sigemptyset (&set);
	139	sigaddset (&set, signum);
	140	sigprocmask (SIG_UNBLOCK, &set, NULL);
	141	}
	142	#endif
	143	scm_system_async_mark (signal_async);
	144	}
0f2d19dd	145
e1a191a8 GH	146	static SCM
	147	sys_deliver_signals (void)
	148	{
	149	int i;
	150
	151	for (i = 0; i < NSIG; i++)
	152	{
	153	if (got_signal[i])
	154	{
cc0b3312 GH	155	/* The flag is reset before calling the handler in case the
	156	handler doesn't return. If the handler doesn't return
	157	but leaves other signals flagged, they their handlers
	158	will be applied some time later when the async is checked
	159	again. It would probably be better to reset the flags
	160	after doing a longjmp. */
e1a191a8 GH	161	got_signal[i] = 0;
	162	#ifndef HAVE_SIGACTION
	163	signal (i, take_signal);
	164	#endif
2ad6b1a5 GH	165	scm_apply (SCM_VELTS (*signal_handlers)[i],
	166	scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
	167	SCM_EOL);
e1a191a8 GH	168	}
	169	}
	170	return SCM_UNSPECIFIED;
0f2d19dd JB	171	}
0f2d19dd JB	172
e1a191a8 GH	173	/* user interface for installation of signal handlers. */
	174	SCM_PROC(s_sigaction, "sigaction", 1, 2, 0, scm_sigaction);
	175	SCM
	176	scm_sigaction (SCM signum, SCM handler, SCM flags)
	177	{
	178	int csig;
	179	#ifdef HAVE_SIGACTION
	180	struct sigaction action;
	181	struct sigaction old_action;
	182	#else
	183	SIGRETTYPE (* chandler) (int);
	184	SIGRETTYPE (* old_chandler) (int);
	185	#endif
	186	int query_only = 0;
	187	int save_handler = 0;
	188	SCM scheme_handlers = SCM_VELTS (signal_handlers);
	189	SCM old_handler;
	190
	191	SCM_ASSERT (SCM_INUMP (signum), signum, SCM_ARG1, s_sigaction);
	192	csig = SCM_INUM (signum);
	193	#ifdef HAVE_SIGACTION
	194	/* always use restartable system calls if available. */
	195	#ifdef SA_RESTART
	196	action.sa_flags = SA_RESTART;
	197	#else
	198	action.sa_flags = 0;
	199	#endif
	200	if (!SCM_UNBNDP (flags))
	201	{
	202	SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG3, s_sigaction);
	203	action.sa_flags \|= SCM_INUM (flags);
	204	}
	205	sigemptyset (&action.sa_mask);
	206	#endif
	207	SCM_DEFER_INTS;
	208	old_handler = scheme_handlers[csig];
	209	if (SCM_UNBNDP (handler))
	210	query_only = 1;
	211	else if (SCM_INUMP (handler))
	212	{
	213	if (SCM_INUM (handler) == (int) SIG_DFL
	214	\|\| SCM_INUM (handler) == (int) SIG_IGN)
	215	{
	216	#ifdef HAVE_SIGACTION
	217	action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
	218	#else
	219	chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
	220	#endif
	221	scheme_handlers[csig] = SCM_BOOL_F;
	222	}
	223	else
	224	scm_out_of_range (s_sigaction, handler);
	225	}
	226	else if (SCM_FALSEP (handler))
	227	{
	228	/* restore the default handler. */
	229	#ifdef HAVE_SIGACTION
	230	if (orig_handlers[csig].sa_handler == SIG_ERR)
	231	query_only = 1;
	232	else
	233	{
	234	action = orig_handlers[csig];
	235	orig_handlers[csig].sa_handler = SIG_ERR;
	236	scheme_handlers[csig] = SCM_BOOL_F;
237	}
238	#else
239	if (orig_handlers[csig] == SIG_ERR)
240	query_only = 1;
241	else
242	{
243	chandler = orig_handlers[csig];
244	orig_handlers[csig] = SIG_ERR;
245	scheme_handlers[csig] = SCM_BOOL_F;
246	}
247	#endif
248	}
249	else
250	{
251	SCM_ASSERT (SCM_NIMP (handler), handler, SCM_ARG2, s_sigaction);
252	#ifdef HAVE_SIGACTION
253	action.sa_handler = take_signal;
254	if (orig_handlers[csig].sa_handler == SIG_ERR)
255	save_handler = 1;
256	#else
257	chandler = take_signal;
258	if (orig_handlers[csig] == SIG_ERR)
259	save_handler = 1;
260	#endif
261	scheme_handlers[csig] = handler;
262	}
263	#ifdef HAVE_SIGACTION
264	if (query_only)
265	{
266	if (sigaction (csig, 0, &old_action) == -1)
267	scm_syserror (s_sigaction);
268	}
269	else
270	{
271	if (sigaction (csig, &action , &old_action) == -1)
272	scm_syserror (s_sigaction);
273	if (save_handler)
274	orig_handlers[csig] = old_action;
275	}
276	if (old_action.sa_handler == SIG_DFL \|\| old_action.sa_handler == SIG_IGN)
277	old_handler = SCM_MAKINUM ((int) old_action.sa_handler);
278	SCM_ALLOW_INTS;
279	return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
280	#else
281	if (query_only)
282	{
283	if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
284	scm_syserror (s_sigaction);
285	if (signal (csig, old_chandler) == SIG_ERR)
286	scm_syserror (s_sigaction);
287	}
288	else
289	{
290	if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
291	scm_syserror (s_sigaction);
292	if (save_handler)
293	orig_handlers[csig] = old_chandler;
294	}
295	if (old_chandler == SIG_DFL \|\| old_chandler == SIG_IGN)
296	old_handler = SCM_MAKINUM ((int) old_chandler);
297	SCM_ALLOW_INTS;
298	return scm_cons (old_handler, SCM_MAKINUM (0));
0f2d19dd	299	#endif
e1a191a8 GH	300	}
	301
	302	SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
	303	SCM
	304	scm_restore_signals (void)
	305	{
	306	int i;
	307	SCM scheme_handlers = SCM_VELTS (signal_handlers);
	308
	309	for (i = 0; i < NSIG; i++)
	310	{
	311	#ifdef HAVE_SIGACTION
	312	if (orig_handlers[i].sa_handler != SIG_ERR)
	313	{
	314	if (sigaction (i, &orig_handlers[i], NULL) == -1)
	315	scm_syserror (s_restore_signals);
	316	orig_handlers[i].sa_handler = SIG_ERR;
	317	scheme_handlers[i] = SCM_BOOL_F;
	318	}
	319	#else
	320	if (orig_handlers[i] != SIG_ERR)
	321	{
	322	if (signal (i, orig_handlers[i]) == SIG_ERR)
	323	scm_syserror (s_restore_signals);
	324	orig_handlers[i] = SIG_ERR;
	325	scheme_handlers[i] = SCM_BOOL_F;
	326	}
	327	#endif
	328	}
	329	return SCM_UNSPECIFIED;
	330	}
0f2d19dd JB	331
0f2d19dd JB	332	SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
1cc91f1b	333
0f2d19dd JB	334	SCM
	335	scm_alarm (i)
	336	SCM i;
0f2d19dd JB	337	{
	338	unsigned int j;
	339	SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
e1a191a8	340	j = alarm (SCM_INUM (i));
0f2d19dd JB	341	return SCM_MAKINUM (j);
	342	}
	343
0e958795	344	#ifdef HAVE_PAUSE
0f2d19dd	345	SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
1cc91f1b	346
0f2d19dd JB	347	SCM
0f2d19dd JB	348	scm_pause ()
0f2d19dd JB	349	{
	350	pause ();
	351	return SCM_UNSPECIFIED;
	352	}
0e958795	353	#endif
0f2d19dd JB	354
0f2d19dd JB	355	SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
1cc91f1b	356
0f2d19dd JB	357	SCM
	358	scm_sleep (i)
	359	SCM i;
0f2d19dd	360	{
b74f4728	361	unsigned long j;
0f2d19dd	362	SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
b74f4728 JB	363	#ifdef USE_THREADS
	364	j = scm_thread_sleep (SCM_INUM(i));
	365	#else
e1a191a8	366	j = sleep (SCM_INUM(i));
b74f4728 JB	367	#endif
b74f4728 JB	368	return scm_ulong2num (j);
0f2d19dd JB	369	}
0f2d19dd JB	370
b74f4728	371	#if defined(USE_THREADS) \|\| defined(HAVE_USLEEP)
ce874f2d MD	372	SCM_PROC(s_usleep, "usleep", 1, 0, 0, scm_usleep);
	373
	374	SCM
	375	scm_usleep (i)
	376	SCM i;
	377	{
ce874f2d	378	SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_usleep);
b74f4728 JB	379
	380	#ifdef USE_THREADS
	381	/* If we have threads, we use the thread system's sleep function. */
	382	{
	383	unsigned long j = scm_thread_usleep (SCM_INUM (i));
	384	return scm_ulong2num (j);
	385	}
	386	#else
0935d604 MD	387	#ifdef USLEEP_RETURNS_VOID
	388	usleep (SCM_INUM (i));
	389	return SCM_INUM0;
	390	#else
b74f4728 JB	391	{
	392	int j = usleep (SCM_INUM (i));
	393	return SCM_MAKINUM (j);
	394	}
0935d604	395	#endif
ce874f2d	396	#endif
b74f4728 JB	397	}
b74f4728 JB	398	#endif /* GUILE_ISELECT \|\| HAVE_USLEEP */
ce874f2d	399
0f2d19dd	400	SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
1cc91f1b	401
0f2d19dd JB	402	SCM
	403	scm_raise(sig)
	404	SCM sig;
0f2d19dd JB	405	{
0f2d19dd JB	406	SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
e1a191a8 GH	407	SCM_DEFER_INTS;
	408	if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
	409	scm_syserror (s_raise);
	410	SCM_ALLOW_INTS;
	411	return SCM_UNSPECIFIED;
0f2d19dd JB	412	}
	413
	414	\f
0f2d19dd	415
e1a191a8 GH	416	void
e1a191a8 GH	417	scm_init_scmsigs ()
0f2d19dd	418	{
e1a191a8 GH	419	SCM thunk;
	420	int i;
	421
	422	signal_handlers =
	423	SCM_CDRLOC (scm_sysintern ("signal-handlers",
	424	scm_make_vector (SCM_MAKINUM (NSIG),
e1a191a8 GH	425	SCM_BOOL_F)));
	426	thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
	427	sys_deliver_signals);
	428	signal_async = scm_system_async (thunk);
	429
	430	for (i = 0; i < NSIG; i++)
	431	{
	432	got_signal[i] = 0;
	433	#ifdef HAVE_SIGACTION
	434	orig_handlers[i].sa_handler = SIG_ERR;
	435	#else
	436	orig_handlers[i] = SIG_ERR;
0f2d19dd	437	#endif
e1a191a8	438	}
1cc91f1b	439
e1a191a8 GH	440	scm_sysintern ("NSIG", scm_long2num (NSIG));
	441	scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
	442	scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
	443	#ifdef SA_NOCLDSTOP
	444	scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
0f2d19dd	445	#endif
e1a191a8 GH	446	#ifdef SA_RESTART
e1a191a8 GH	447	scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
0f2d19dd	448	#endif
1cc91f1b	449
0f2d19dd JB	450	#include "scmsigs.x"
	451	}
	452