-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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 library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * This program is distributed in the hope that it will be useful,
+ * This library 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.
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser 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. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
-#include <stdio.h>
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
#include <signal.h>
+#include <errno.h>
+
#include "libguile/_scm.h"
#include "libguile/async.h"
#include "libguile/eval.h"
+#include "libguile/root.h"
#include "libguile/vectors.h"
#include "libguile/validate.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 ();
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
#endif
+#ifdef __MINGW32__
+#include <windows.h>
+#define alarm(sec) (0)
+/* This weird comma expression is because Sleep is void under Windows. */
+#define sleep(sec) (Sleep ((sec) * 1000), 0)
+#define usleep(usec) (Sleep ((usec) / 1000), 0)
+#define kill(pid, sig) raise (sig)
#endif
\f
\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;
+ handler is set. when a signal arrives, take_signal will queue the
+ Scheme handler procedure for its thread. */
-static char got_signal[NSIG];
-/* a Scheme vector of handler procedures. */
+/* Scheme vectors with information about a signal. signal_handlers
+ contains the handler procedure or #f, signal_handler_cells contains
+ pre-queued cells for the handler (since we can't do fancy things
+ during signal delivery), signal_cell_handlers contains the SCM
+ value to be stuffed into the pre-queued cell upon delivery, and
+ signal_handler_threads points to the thread that a signal should be
+ delivered to.
+*/
static SCM *signal_handlers;
+static SCM signal_handler_cells;
+static SCM signal_cell_handlers;
+static SCM signal_handler_threads;
/* saves the original C handlers, when a new handler is installed.
set to SIG_ERR if the original handler is installed. */
static SIGRETTYPE (*orig_handlers[NSIG])(int);
#endif
+
static SIGRETTYPE
take_signal (int signum)
{
- int saved_errno = errno;
- SCM ignored;
-
- if (!scm_ints_disabled)
+ if (signum >= 0 && signum < NSIG)
{
- /* 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 cell = SCM_VECTOR_REF(signal_handler_cells, signum);
+ SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
+ SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
+ scm_root_state *root = scm_i_thread_root (thread);
+ if (SCM_CONSP (cell))
+ {
+ SCM_SETCAR (cell, handler);
+ root->pending_asyncs = 1;
+ }
}
- 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);
- }
+
+#ifndef HAVE_SIGACTION
+ signal (signum, take_signal);
#endif
- scm_system_async_mark (signal_async);
- errno = saved_errno;
+}
+
+SCM
+scm_sigaction (SCM signum, SCM handler, SCM flags)
+{
+ return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
}
static SCM
-sys_deliver_signals (void)
+close_1 (SCM proc, SCM arg)
{
- int i;
+ return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
+ scm_list_2 (proc, arg)));
+}
- for (i = 0; i < NSIG; i++)
+/* Make sure that signal SIGNUM can be delivered to THREAD, using
+ HANDLER. THREAD and HANDLER must either both be non-#f (which
+ means install the handler), or both #f (which means deinstall an
+ existing handler).
+*/
+
+struct install_handler_data {
+ int signum;
+ SCM thread;
+ SCM handler;
+};
+
+static SCM
+scm_delq_spine_x (SCM cell, SCM list)
+{
+ SCM s = list, prev = SCM_BOOL_F;
+
+ while (!SCM_EQ_P (cell, s))
+ {
+ if (SCM_NULLP (s))
+ return list;
+ prev = s;
+ s = SCM_CDR (s);
+ }
+ if (SCM_FALSEP (prev))
+ return SCM_CDR (cell);
+ else
+ {
+ SCM_SETCDR (prev, SCM_CDR (cell));
+ return list;
+ }
+}
+
+static void *
+really_install_handler (void *data)
+{
+ struct install_handler_data *args = data;
+ int signum = args->signum;
+ SCM thread = args->thread;
+ SCM handler = args->handler;
+ SCM cell;
+ SCM old_thread;
+
+ /* The following modifications are done while signals can be
+ delivered. That is not a real problem since the signal handler
+ will only touch the car of the handler cell and set the
+ pending_asyncs trigger of a thread. While the data structures
+ are in flux, the signal handler might store the wrong handler in
+ the cell, or set pending_asyncs of the wrong thread. We fix this
+ at the end by making sure that the cell has the right handler in
+ it, if any, and that pending_asyncs is set for the new thread.
+ */
+
+ /* Make sure we have a cell. */
+ cell = SCM_VECTOR_REF (signal_handler_cells, signum);
+ if (SCM_FALSEP (cell))
{
- if (got_signal[i])
+ cell = scm_cons (SCM_BOOL_F, SCM_EOL);
+ SCM_VECTOR_SET (signal_handler_cells, signum, cell);
+ }
+
+ /* Make sure it is queued for the right thread. */
+ old_thread = SCM_VECTOR_REF (signal_handler_threads, signum);
+ if (!SCM_EQ_P (thread, old_thread))
+ {
+ scm_root_state *r;
+ if (!SCM_FALSEP (old_thread))
{
- /* 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);
+ r = scm_i_thread_root (old_thread);
+ r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs);
+ }
+ if (!SCM_FALSEP (thread))
+ {
+ r = scm_i_thread_root (thread);
+ SCM_SETCDR (cell, r->signal_asyncs);
+ r->signal_asyncs = cell;
+ /* Set pending_asyncs just in case. A signal that is
+ delivered while we modify the data structures here might set
+ pending_asyncs of old_thread. */
+ r->pending_asyncs = 1;
}
+ SCM_VECTOR_SET (signal_handler_threads, signum, thread);
}
- return SCM_UNSPECIFIED;
+
+ /* Set the new handler. */
+ if (SCM_FALSEP (handler))
+ {
+ SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
+ SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
+ }
+ else
+ {
+ SCM_VECTOR_SET (*signal_handlers, signum, handler);
+ SCM_VECTOR_SET (signal_cell_handlers, signum,
+ close_1 (handler, scm_int2num (signum)));
+ }
+
+ /* Now fix up the cell. It might contain the old handler but since
+ it is now queued for the new thread, we must make sure that the
+ new handler is run. Any signal that is delivered during the
+ following code will install the new handler, so we have no
+ problem.
+ */
+ if (!SCM_FALSEP (SCM_CAR (cell)))
+ SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
+
+ /* Phfew. That should be it. */
+ return NULL;
+}
+
+static void
+install_handler (int signum, SCM thread, SCM handler)
+{
+ /* We block asyncs while installing the handler. It would be safe
+ to leave them on, but we might run the wrong handler should a
+ signal be delivered.
+ */
+
+ struct install_handler_data args;
+ args.signum = signum;
+ args.thread = thread;
+ args.handler = handler;
+ scm_c_call_with_blocked_asyncs (really_install_handler, &args);
}
/* user interface for installation of signal handlers. */
-SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
- (SCM signum, SCM handler, SCM flags),
+SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
+ (SCM signum, SCM handler, SCM flags, SCM thread),
"Install or report the signal handler for a specified signal.\n\n"
"@var{signum} is the signal number, which can be specified using the value\n"
"of variables such as @code{SIGINT}.\n\n"
- "If @var{action} is omitted, @code{sigaction} returns a pair: the\n"
+ "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
"CAR is the current\n"
"signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
"(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
"handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
"signal. The CDR contains the current @code{sigaction} flags for the handler.\n\n"
- "If @var{action} is provided, it is installed as the new handler for\n"
- "@var{signum}. @var{action} can be a Scheme procedure taking one\n"
+ "If @var{handler} is provided, it is installed as the new handler for\n"
+ "@var{signum}. @var{handler} can be a Scheme procedure taking one\n"
"argument, or the value of @code{SIG_DFL} (default action) or\n"
"@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
- "was installed before @code{sigaction} was first used. Flags can\n"
+ "was installed before @code{sigaction} was first used. When\n"
+ "a scheme procedure has been specified, that procedure will run\n"
+ "in the given @var{thread}. When no thread has been given, the\n"
+ "thread that made this call to @code{sigaction} is used.\n"
+ "Flags can "
"optionally be specified for the new handler (@code{SA_RESTART} will\n"
"always be added if it's available and the system is using restartable\n"
"system calls.) The return value is a pair with information about the\n"
"facility. Maybe this is not needed, since the thread support may\n"
"provide solutions to the problem of consistent access to data\n"
"structures.")
-#define FUNC_NAME s_scm_sigaction
+#define FUNC_NAME s_scm_sigaction_for_thread
{
int csig;
#ifdef HAVE_SIGACTION
struct sigaction action;
struct sigaction old_action;
#else
- SIGRETTYPE (* chandler) (int);
+ SIGRETTYPE (* chandler) (int) = SIG_DFL;
SIGRETTYPE (* old_chandler) (int);
#endif
int query_only = 0;
int save_handler = 0;
- SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
+
SCM old_handler;
- SCM_VALIDATE_INUM_COPY (1,signum,csig);
+ SCM_VALIDATE_INUM_COPY (1, signum, csig);
+ if (csig < 0 || csig > NSIG)
+ SCM_OUT_OF_RANGE (1, signum);
#if defined(HAVE_SIGACTION)
#if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
/* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
#endif
if (!SCM_UNBNDP (flags))
{
- SCM_VALIDATE_INUM (3,flags);
+ SCM_VALIDATE_INUM (3, flags);
action.sa_flags |= SCM_INUM (flags);
}
sigemptyset (&action.sa_mask);
#endif
+
+ if (SCM_UNBNDP (thread))
+ thread = scm_current_thread ();
+ else
+ {
+ SCM_VALIDATE_THREAD (4, thread);
+ if (scm_c_thread_exited_p (thread))
+ SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
+ }
+
SCM_DEFER_INTS;
- old_handler = scheme_handlers[csig];
+ old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
if (SCM_UNBNDP (handler))
query_only = 1;
else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
{
- if (SCM_NUM2LONG (2,handler) == (long) SIG_DFL
- || SCM_NUM2LONG (2,handler) == (long) SIG_IGN)
+ if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL
+ || SCM_NUM2LONG (2, handler) == (long) 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;
+ install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
}
else
SCM_OUT_OF_RANGE (2, handler);
{
action = orig_handlers[csig];
orig_handlers[csig].sa_handler = SIG_ERR;
- scheme_handlers[csig] = SCM_BOOL_F;
+ install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
}
#else
if (orig_handlers[csig] == SIG_ERR)
{
chandler = orig_handlers[csig];
orig_handlers[csig] = SIG_ERR;
- scheme_handlers[csig] = SCM_BOOL_F;
+ install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
}
#endif
}
else
{
- SCM_VALIDATE_NIM (2,handler);
+ SCM_VALIDATE_NIM (2, handler);
#ifdef HAVE_SIGACTION
action.sa_handler = take_signal;
if (orig_handlers[csig].sa_handler == SIG_ERR)
if (orig_handlers[csig] == SIG_ERR)
save_handler = 1;
#endif
- scheme_handlers[csig] = handler;
+ install_handler (csig, thread, handler);
}
/* XXX - Silently ignore setting handlers for `program error signals'
case SIGFPE:
case SIGILL:
case SIGSEGV:
+#ifdef SIGBUS
case SIGBUS:
+#endif
case SIGABRT:
#if defined(SIGIOT) && (SIGIOT != SIGABRT)
case SIGIOT:
#endif
+#ifdef SIGTRAP
case SIGTRAP:
+#endif
#ifdef SIGEMT
case SIGEMT:
#endif
#define FUNC_NAME s_scm_restore_signals
{
int i;
- SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
-
for (i = 0; i < NSIG; i++)
{
#ifdef HAVE_SIGACTION
if (sigaction (i, &orig_handlers[i], NULL) == -1)
SCM_SYSERROR;
orig_handlers[i].sa_handler = SIG_ERR;
- scheme_handlers[i] = SCM_BOOL_F;
+ SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
}
#else
if (orig_handlers[i] != SIG_ERR)
if (signal (i, orig_handlers[i]) == SIG_ERR)
SCM_SYSERROR;
orig_handlers[i] = SIG_ERR;
- scheme_handlers[i] = SCM_BOOL_F;
+ SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
}
#endif
}
#define FUNC_NAME s_scm_alarm
{
unsigned int j;
- SCM_VALIDATE_INUM (1,i);
+ SCM_VALIDATE_INUM (1, i);
j = alarm (SCM_INUM (i));
return SCM_MAKINUM (j);
}
#undef FUNC_NAME
+#ifdef HAVE_SETITIMER
+SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
+ (SCM which_timer,
+ SCM interval_seconds, SCM interval_microseconds,
+ SCM value_seconds, SCM value_microseconds),
+ "Set the timer specified by @var{which_timer} according to the given\n"
+ "@var{interval_seconds}, @var{interval_microseconds},\n"
+ "@var{value_seconds}, and @var{value_microseconds} values.\n"
+ "\n"
+ "Return information about the timer's previous setting."
+ "\n"
+ "Errors are handled as described in the guile info pages under ``POSIX\n"
+ "Interface Conventions''.\n"
+ "\n"
+ "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
+ "and @code{ITIMER_PROF}.\n"
+ "\n"
+ "The return value will be a list of two cons pairs representing the\n"
+ "current state of the given timer. The first pair is the seconds and\n"
+ "microseconds of the timer @code{it_interval}, and the second pair is\n"
+ "the seconds and microseconds of the timer @code{it_value}.")
+#define FUNC_NAME s_scm_setitimer
+{
+ int rv;
+ int c_which_timer;
+ struct itimerval new_timer;
+ struct itimerval old_timer;
+
+ c_which_timer = SCM_NUM2INT(1, which_timer);
+ new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
+ new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
+ new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
+ new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
+
+ SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
+
+ if(rv != 0)
+ SCM_SYSERROR;
+
+ return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
+ scm_long2num(old_timer.it_interval.tv_usec)),
+ scm_cons(scm_long2num(old_timer.it_value.tv_sec),
+ scm_long2num(old_timer.it_value.tv_usec)));
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETITIMER */
+
+#ifdef HAVE_GETITIMER
+SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
+ (SCM which_timer),
+ "Return information about the timer specified by @var{which_timer}"
+ "\n"
+ "Errors are handled as described in the guile info pages under ``POSIX\n"
+ "Interface Conventions''.\n"
+ "\n"
+ "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
+ "and @code{ITIMER_PROF}.\n"
+ "\n"
+ "The return value will be a list of two cons pairs representing the\n"
+ "current state of the given timer. The first pair is the seconds and\n"
+ "microseconds of the timer @code{it_interval}, and the second pair is\n"
+ "the seconds and microseconds of the timer @code{it_value}.")
+#define FUNC_NAME s_scm_getitimer
+{
+ int rv;
+ int c_which_timer;
+ struct itimerval old_timer;
+
+ c_which_timer = SCM_NUM2INT(1, which_timer);
+
+ SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
+
+ if(rv != 0)
+ SCM_SYSERROR;
+
+ return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
+ scm_long2num(old_timer.it_interval.tv_usec)),
+ scm_cons(scm_long2num(old_timer.it_value.tv_sec),
+ scm_long2num(old_timer.it_value.tv_usec)));
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETITIMER */
+
#ifdef HAVE_PAUSE
SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
(),
#define FUNC_NAME s_scm_sleep
{
unsigned long j;
- SCM_VALIDATE_INUM_MIN (1,i,0);
-#ifdef USE_THREADS
+ SCM_VALIDATE_INUM_MIN (1, i,0);
j = scm_thread_sleep (SCM_INUM(i));
-#else
- j = sleep (SCM_INUM(i));
-#endif
return scm_ulong2num (j);
}
#undef FUNC_NAME
-#if defined(USE_THREADS) || defined(HAVE_USLEEP)
SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
(SCM i),
- "Sleep for I microseconds.\n"
- "`usleep' is not available on all platforms.")
+ "Sleep for I microseconds. @code{usleep} is not available on\n"
+ "all platforms.")
#define FUNC_NAME s_scm_usleep
{
- SCM_VALIDATE_INUM_MIN (1,i,0);
-
-#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
+ unsigned long j;
+ SCM_VALIDATE_INUM_MIN (1, i,0);
+ j = scm_thread_usleep (SCM_INUM (i));
+ return scm_ulong2num (j);
}
#undef FUNC_NAME
-#endif /* GUILE_ISELECT || HAVE_USLEEP */
SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
(SCM sig),
- "\n"
"Sends a specified signal @var{sig} to the current process, where\n"
"@var{sig} is as described for the kill procedure.")
#define FUNC_NAME s_scm_raise
{
- SCM_VALIDATE_INUM (1,sig);
+ SCM_VALIDATE_INUM (1, sig);
SCM_DEFER_INTS;
if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
SCM_SYSERROR;
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);
+ SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
+ scm_c_make_vector (NSIG, SCM_BOOL_F)));
+ signal_handler_cells =
+ scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
+ signal_cell_handlers =
+ scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
+ signal_handler_threads =
+ scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
for (i = 0; i < NSIG; i++)
{
- got_signal[i] = 0;
#ifdef HAVE_SIGACTION
orig_handlers[i].sa_handler = 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));
+ scm_c_define ("NSIG", scm_long2num (NSIG));
+ scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
+ scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
#ifdef SA_NOCLDSTOP
- scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
+ scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
#endif
#ifdef SA_RESTART
- scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
+ scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
#endif
+#if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
+ /* Stuff needed by setitimer and getitimer. */
+ scm_c_define ("ITIMER_REAL", SCM_MAKINUM (ITIMER_REAL));
+ scm_c_define ("ITIMER_VIRTUAL", SCM_MAKINUM (ITIMER_VIRTUAL));
+ scm_c_define ("ITIMER_PROF", SCM_MAKINUM (ITIMER_PROF));
+#endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
+
#include "libguile/scmsigs.x"
}
HCoop / bpt / guile.git / blobdiff