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

/* Copyright (C) 1995, 1996, 1997, 1998, 1999 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)
{
  int saved_errno = errno;
  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);
  errno = saved_errno;
}

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))
    {
      /* It's really ugly to assume that SIG_DFL can be nicely cast to
	 a fixnum.  This has got to go.  */
      if (SCM_INUM (handler) == (SCM) SIG_DFL
	  || SCM_INUM (handler) == (SCM) 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 ((SCM) 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

#ifdef HAVE_RESTARTS
      /* ensure that system calls will be restarted for all signals.  */
      /* sigintterupt would be simpler, but it seems better to avoid
	 dependency on another system call.  */
      {
	struct sigaction action;

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