Remove unneeded `scm_without_guile ()' call.
[bpt/guile.git] / libguile / scmsigs.c
CommitLineData
512c3595 1/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
adb2c53b 2 *
73be1d9e 3 * This library is free software; you can redistribute it and/or
53befeb7
NJ
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
adb2c53b 7 *
53befeb7
NJ
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e
MV
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
adb2c53b 12 *
73be1d9e
MV
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
53befeb7
NJ
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16 * 02110-1301 USA
73be1d9e 17 */
1bbd0b84 18
1bbd0b84 19
0f2d19dd
JB
20\f
21
dbb605f5 22#ifdef HAVE_CONFIG_H
29d36c2d
RB
23# include <config.h>
24#endif
25
23d72566 26#include <fcntl.h> /* for mingw */
0f2d19dd 27#include <signal.h>
9de87eea 28#include <stdio.h>
e6e2e95a
MD
29#include <errno.h>
30
a0599745 31#include "libguile/_scm.h"
0f2d19dd 32
a0599745
MD
33#include "libguile/async.h"
34#include "libguile/eval.h"
fdc28395 35#include "libguile/root.h"
a0599745 36#include "libguile/vectors.h"
2e77f720 37#include "libguile/threads.h"
1bbd0b84 38
a0599745
MD
39#include "libguile/validate.h"
40#include "libguile/scmsigs.h"
20e6290e 41
23d72566
KR
42#ifdef HAVE_IO_H
43#include <io.h> /* for mingw _pipe() */
44#endif
45
46#ifdef HAVE_PROCESS_H
47#include <process.h> /* for mingw */
48#endif
49
0f2d19dd
JB
50#ifdef HAVE_UNISTD_H
51#include <unistd.h>
52#endif
53
1bed8c28
GH
54#ifdef HAVE_SYS_TIME_H
55#include <sys/time.h>
56#endif
57
82893676
MG
58#ifdef __MINGW32__
59#include <windows.h>
60#define alarm(sec) (0)
61/* This weird comma expression is because Sleep is void under Windows. */
62#define sleep(sec) (Sleep ((sec) * 1000), 0)
ed618cc9 63#define usleep(usec) (Sleep ((usec) / 1000), 0)
23d72566 64#define pipe(fd) _pipe (fd, 256, O_BINARY)
82893676
MG
65#endif
66
634aa8de
LC
67#include <full-write.h>
68
69
0f2d19dd
JB
70\f
71
e1a191a8 72/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
0f2d19dd
JB
73
74#ifdef RETSIGTYPE
e1a191a8 75# define SIGRETTYPE RETSIGTYPE
0f2d19dd 76#else
e1a191a8
GH
77# ifdef STDC_HEADERS
78# define SIGRETTYPE void
79# else
80# define SIGRETTYPE int
81# endif
0f2d19dd
JB
82#endif
83
84\f
85
e1a191a8 86/* take_signal is installed as the C signal handler whenever a Scheme
9de87eea
MV
87 handler is set. When a signal arrives, take_signal will write a
88 byte into the 'signal pipe'. The 'signal delivery thread' will
89 read this pipe and queue the appropriate asyncs.
90
91 When Guile is built without threads, the signal handler will
92 install the async directly.
93*/
0f2d19dd 94
0f2d19dd 95
2fbc8609 96/* Scheme vectors with information about a signal. signal_handlers
9de87eea
MV
97 contains the handler procedure or #f, signal_handler_asyncs
98 contains the thunk to be marked as an async when the signal arrives
99 (or the cell with the thunk in a singlethreaded Guile), and
dbbaa07c
MV
100 signal_handler_threads points to the thread that a signal should be
101 delivered to.
2fbc8609 102*/
e1a191a8 103static SCM *signal_handlers;
9de87eea 104static SCM signal_handler_asyncs;
2fbc8609 105static SCM signal_handler_threads;
0f2d19dd 106
2e77f720
LC
107/* The signal delivery thread. */
108scm_i_thread *scm_i_signal_delivery_thread = NULL;
109
110/* The mutex held when launching the signal delivery thread. */
111static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
112 SCM_I_PTHREAD_MUTEX_INITIALIZER;
113
114
e1a191a8
GH
115/* saves the original C handlers, when a new handler is installed.
116 set to SIG_ERR if the original handler is installed. */
117#ifdef HAVE_SIGACTION
118static struct sigaction orig_handlers[NSIG];
119#else
da6e81b6 120static SIGRETTYPE (*orig_handlers[NSIG])(int);
0f2d19dd
JB
121#endif
122
9de87eea
MV
123static SCM
124close_1 (SCM proc, SCM arg)
125{
126 return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
127 scm_list_2 (proc, arg)));
128}
129
130#if SCM_USE_PTHREAD_THREADS
23d72566
KR
131/* On mingw there's no notion of inter-process signals, only a raise()
132 within the process itself which apparently invokes the registered handler
133 immediately. Not sure how well the following code will cope in this
134 case. It builds but it may not offer quite the same scheme-level
135 semantics as on a proper system. If you're relying on much in the way of
136 signal handling on mingw you probably lose anyway. */
9de87eea
MV
137
138static int signal_pipe[2];
dbbaa07c 139
e1a191a8
GH
140static SIGRETTYPE
141take_signal (int signum)
142{
9de87eea 143 char sigbyte = signum;
634aa8de 144 full_write (signal_pipe[1], &sigbyte, 1);
9de87eea 145
2fbc8609
MV
146#ifndef HAVE_SIGACTION
147 signal (signum, take_signal);
148#endif
e1a191a8 149}
0f2d19dd 150
9de87eea
MV
151static SCM
152signal_delivery_thread (void *data)
e1a191a8 153{
9de87eea
MV
154 int n, sig;
155 char sigbyte;
23d72566
KR
156#if HAVE_PTHREAD_SIGMASK /* not on mingw, see notes above */
157 sigset_t all_sigs;
9de87eea
MV
158 sigfillset (&all_sigs);
159 scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL);
23d72566 160#endif
9de87eea
MV
161
162 while (1)
163 {
512c3595 164 n = read (signal_pipe[0], &sigbyte, 1);
9de87eea 165 sig = sigbyte;
9de87eea
MV
166 if (n == 1 && sig >= 0 && sig < NSIG)
167 {
168 SCM h, t;
169
170 h = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig);
171 t = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig);
172 if (scm_is_true (h))
173 scm_system_async_mark_for_thread (h, t);
174 }
2e77f720
LC
175 else if (n == 0)
176 break; /* the signal pipe was closed. */
9de87eea
MV
177 else if (n < 0 && errno != EINTR)
178 perror ("error in signal delivery thread");
179 }
229a0710 180
2e77f720 181 return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
2fbc8609 182}
e1a191a8 183
9de87eea
MV
184static void
185start_signal_delivery_thread (void)
2fbc8609 186{
2e77f720
LC
187 SCM signal_thread;
188
189 scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
190
9de87eea
MV
191 if (pipe (signal_pipe) != 0)
192 scm_syserror (NULL);
2e77f720
LC
193 signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
194 scm_handle_by_message,
195 "signal delivery thread");
196 scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread);
197
198 scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
0f2d19dd
JB
199}
200
2e77f720
LC
201void
202scm_i_ensure_signal_delivery_thread ()
9de87eea
MV
203{
204 static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
205 scm_i_pthread_once (&once, start_signal_delivery_thread);
206}
dbbaa07c 207
9de87eea 208#else /* !SCM_USE_PTHREAD_THREADS */
dbbaa07c 209
9de87eea
MV
210static SIGRETTYPE
211take_signal (int signum)
dbbaa07c 212{
9de87eea
MV
213 SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, signum);
214 scm_i_thread *t = SCM_I_CURRENT_THREAD;
215
216 if (scm_is_false (SCM_CDR (cell)))
dbbaa07c 217 {
9de87eea
MV
218 SCM_SETCDR (cell, t->active_asyncs);
219 t->active_asyncs = cell;
220 t->pending_asyncs = 1;
dbbaa07c 221 }
9de87eea
MV
222
223#ifndef HAVE_SIGACTION
224 signal (signum, take_signal);
225#endif
dbbaa07c
MV
226}
227
2e77f720
LC
228void
229scm_i_ensure_signal_delivery_thread ()
dbbaa07c 230{
9de87eea
MV
231 return;
232}
dbbaa07c 233
9de87eea 234#endif /* !SCM_USE_PTHREAD_THREADS */
dbbaa07c 235
9de87eea
MV
236static void
237install_handler (int signum, SCM thread, SCM handler)
238{
7888309b 239 if (scm_is_false (handler))
dbbaa07c 240 {
4057a3e0 241 SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
9de87eea 242 SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, SCM_BOOL_F);
dbbaa07c
MV
243 }
244 else
245 {
9de87eea
MV
246 SCM async = close_1 (handler, scm_from_int (signum));
247#if !SCM_USE_PTHREAD_THREADS
248 async = scm_cons (async, SCM_BOOL_F);
249#endif
4057a3e0 250 SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
9de87eea 251 SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async);
dbbaa07c
MV
252 }
253
9de87eea 254 SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
dbbaa07c
MV
255}
256
9de87eea
MV
257SCM
258scm_sigaction (SCM signum, SCM handler, SCM flags)
dbbaa07c 259{
9de87eea 260 return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
dbbaa07c
MV
261}
262
e1a191a8 263/* user interface for installation of signal handlers. */
2fbc8609
MV
264SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
265 (SCM signum, SCM handler, SCM flags, SCM thread),
0d172d3f 266 "Install or report the signal handler for a specified signal.\n\n"
b380b885
MD
267 "@var{signum} is the signal number, which can be specified using the value\n"
268 "of variables such as @code{SIGINT}.\n\n"
2fbc8609 269 "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
b380b885
MD
270 "CAR is the current\n"
271 "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
272 "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
273 "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
274 "signal. The CDR contains the current @code{sigaction} flags for the handler.\n\n"
2fbc8609
MV
275 "If @var{handler} is provided, it is installed as the new handler for\n"
276 "@var{signum}. @var{handler} can be a Scheme procedure taking one\n"
b380b885
MD
277 "argument, or the value of @code{SIG_DFL} (default action) or\n"
278 "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
2fbc8609
MV
279 "was installed before @code{sigaction} was first used. When\n"
280 "a scheme procedure has been specified, that procedure will run\n"
281 "in the given @var{thread}. When no thread has been given, the\n"
282 "thread that made this call to @code{sigaction} is used.\n"
0ebbcf43
NJ
283 "Flags can optionally be specified for the new handler.\n"
284 "The return value is a pair with information about the\n"
b380b885
MD
285 "old handler as described above.\n\n"
286 "This interface does not provide access to the \"signal blocking\"\n"
287 "facility. Maybe this is not needed, since the thread support may\n"
288 "provide solutions to the problem of consistent access to data\n"
289 "structures.")
2fbc8609 290#define FUNC_NAME s_scm_sigaction_for_thread
e1a191a8
GH
291{
292 int csig;
293#ifdef HAVE_SIGACTION
294 struct sigaction action;
295 struct sigaction old_action;
296#else
af68e5e5 297 SIGRETTYPE (* chandler) (int) = SIG_DFL;
e1a191a8
GH
298 SIGRETTYPE (* old_chandler) (int);
299#endif
300 int query_only = 0;
301 int save_handler = 0;
34d19ef6 302
e1a191a8
GH
303 SCM old_handler;
304
a55c2b68
MV
305 csig = scm_to_signed_integer (signum, 0, NSIG-1);
306
7ee92fce 307#if defined(HAVE_SIGACTION)
e1a191a8 308 action.sa_flags = 0;
e1a191a8 309 if (!SCM_UNBNDP (flags))
a55c2b68 310 action.sa_flags |= scm_to_int (flags);
e1a191a8 311 sigemptyset (&action.sa_mask);
4feac0b9
MV
312#endif
313
2fbc8609
MV
314 if (SCM_UNBNDP (thread))
315 thread = scm_current_thread ();
316 else
dbbaa07c
MV
317 {
318 SCM_VALIDATE_THREAD (4, thread);
319 if (scm_c_thread_exited_p (thread))
320 SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
321 }
4feac0b9 322
2e77f720 323 scm_i_ensure_signal_delivery_thread ();
9de87eea
MV
324
325 SCM_CRITICAL_SECTION_START;
4057a3e0 326 old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
e1a191a8
GH
327 if (SCM_UNBNDP (handler))
328 query_only = 1;
e11e83f3 329 else if (scm_is_integer (handler))
e1a191a8 330 {
9de87eea
MV
331 long handler_int = scm_to_long (handler);
332
333 if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN)
e1a191a8
GH
334 {
335#ifdef HAVE_SIGACTION
9de87eea 336 action.sa_handler = (SIGRETTYPE (*) (int)) handler_int;
e1a191a8 337#else
9de87eea 338 chandler = (SIGRETTYPE (*) (int)) handler_int;
e1a191a8 339#endif
dbbaa07c 340 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
341 }
342 else
1bbd0b84 343 SCM_OUT_OF_RANGE (2, handler);
e1a191a8 344 }
7888309b 345 else if (scm_is_false (handler))
e1a191a8
GH
346 {
347 /* restore the default handler. */
348#ifdef HAVE_SIGACTION
349 if (orig_handlers[csig].sa_handler == SIG_ERR)
350 query_only = 1;
351 else
352 {
353 action = orig_handlers[csig];
354 orig_handlers[csig].sa_handler = SIG_ERR;
dbbaa07c 355 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
356 }
357#else
358 if (orig_handlers[csig] == SIG_ERR)
359 query_only = 1;
360 else
361 {
362 chandler = orig_handlers[csig];
363 orig_handlers[csig] = SIG_ERR;
dbbaa07c 364 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
365 }
366#endif
adb2c53b 367 }
e1a191a8
GH
368 else
369 {
43067cec 370 SCM_VALIDATE_PROC (2, handler);
e1a191a8
GH
371#ifdef HAVE_SIGACTION
372 action.sa_handler = take_signal;
373 if (orig_handlers[csig].sa_handler == SIG_ERR)
374 save_handler = 1;
375#else
376 chandler = take_signal;
377 if (orig_handlers[csig] == SIG_ERR)
378 save_handler = 1;
379#endif
dbbaa07c 380 install_handler (csig, thread, handler);
e1a191a8 381 }
adb2c53b 382
0d172d3f
MV
383 /* XXX - Silently ignore setting handlers for `program error signals'
384 because they can't currently be handled by Scheme code.
385 */
386
387 switch (csig)
388 {
389 /* This list of program error signals is from the GNU Libc
390 Reference Manual */
391 case SIGFPE:
392 case SIGILL:
393 case SIGSEGV:
82893676 394#ifdef SIGBUS
0d172d3f 395 case SIGBUS:
82893676 396#endif
0d172d3f 397 case SIGABRT:
6732de1b 398#if defined(SIGIOT) && (SIGIOT != SIGABRT)
0d172d3f
MV
399 case SIGIOT:
400#endif
82893676 401#ifdef SIGTRAP
0d172d3f 402 case SIGTRAP:
82893676 403#endif
0d172d3f
MV
404#ifdef SIGEMT
405 case SIGEMT:
406#endif
adb2c53b 407#ifdef SIGSYS
0d172d3f 408 case SIGSYS:
adb2c53b 409#endif
0d172d3f
MV
410 query_only = 1;
411 }
412
e1a191a8
GH
413#ifdef HAVE_SIGACTION
414 if (query_only)
415 {
416 if (sigaction (csig, 0, &old_action) == -1)
1bbd0b84 417 SCM_SYSERROR;
e1a191a8
GH
418 }
419 else
420 {
421 if (sigaction (csig, &action , &old_action) == -1)
1bbd0b84 422 SCM_SYSERROR;
e1a191a8
GH
423 if (save_handler)
424 orig_handlers[csig] = old_action;
425 }
426 if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
b9bd8526 427 old_handler = scm_from_long ((long) old_action.sa_handler);
9de87eea 428 SCM_CRITICAL_SECTION_END;
e11e83f3 429 return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
e1a191a8
GH
430#else
431 if (query_only)
432 {
433 if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
1bbd0b84 434 SCM_SYSERROR;
e1a191a8 435 if (signal (csig, old_chandler) == SIG_ERR)
1bbd0b84 436 SCM_SYSERROR;
e1a191a8
GH
437 }
438 else
439 {
440 if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
1bbd0b84 441 SCM_SYSERROR;
e1a191a8
GH
442 if (save_handler)
443 orig_handlers[csig] = old_chandler;
444 }
445 if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
b9bd8526 446 old_handler = scm_from_long ((long) old_chandler);
9de87eea 447 SCM_CRITICAL_SECTION_END;
e11e83f3 448 return scm_cons (old_handler, scm_from_int (0));
0f2d19dd 449#endif
e1a191a8 450}
1bbd0b84 451#undef FUNC_NAME
e1a191a8 452
adb2c53b 453SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
1bbd0b84 454 (void),
b380b885
MD
455 "Return all signal handlers to the values they had before any call to\n"
456 "@code{sigaction} was made. The return value is unspecified.")
1bbd0b84 457#define FUNC_NAME s_scm_restore_signals
e1a191a8
GH
458{
459 int i;
e1a191a8
GH
460 for (i = 0; i < NSIG; i++)
461 {
462#ifdef HAVE_SIGACTION
463 if (orig_handlers[i].sa_handler != SIG_ERR)
464 {
465 if (sigaction (i, &orig_handlers[i], NULL) == -1)
1bbd0b84 466 SCM_SYSERROR;
e1a191a8 467 orig_handlers[i].sa_handler = SIG_ERR;
4057a3e0 468 SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
469 }
470#else
471 if (orig_handlers[i] != SIG_ERR)
472 {
473 if (signal (i, orig_handlers[i]) == SIG_ERR)
1bbd0b84 474 SCM_SYSERROR;
e1a191a8 475 orig_handlers[i] = SIG_ERR;
4057a3e0 476 SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
477 }
478#endif
479 }
480 return SCM_UNSPECIFIED;
481}
1bbd0b84 482#undef FUNC_NAME
0f2d19dd 483
adb2c53b 484SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
1bbd0b84 485 (SCM i),
b380b885
MD
486 "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
487 "number of seconds (an integer). It's advisable to install a signal\n"
488 "handler for\n"
489 "@code{SIGALRM} beforehand, since the default action is to terminate\n"
490 "the process.\n\n"
491 "The return value indicates the time remaining for the previous alarm,\n"
492 "if any. The new value replaces the previous alarm. If there was\n"
493 "no previous alarm, the return value is zero.")
1bbd0b84 494#define FUNC_NAME s_scm_alarm
0f2d19dd 495{
a55c2b68 496 return scm_from_uint (alarm (scm_to_uint (i)));
0f2d19dd 497}
1bbd0b84 498#undef FUNC_NAME
0f2d19dd 499
53f8a0d2
RB
500#ifdef HAVE_SETITIMER
501SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
502 (SCM which_timer,
503 SCM interval_seconds, SCM interval_microseconds,
504 SCM value_seconds, SCM value_microseconds),
505 "Set the timer specified by @var{which_timer} according to the given\n"
506 "@var{interval_seconds}, @var{interval_microseconds},\n"
507 "@var{value_seconds}, and @var{value_microseconds} values.\n"
508 "\n"
509 "Return information about the timer's previous setting."
510 "\n"
511 "Errors are handled as described in the guile info pages under ``POSIX\n"
512 "Interface Conventions''.\n"
513 "\n"
9401323e 514 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
515 "and @code{ITIMER_PROF}.\n"
516 "\n"
517 "The return value will be a list of two cons pairs representing the\n"
518 "current state of the given timer. The first pair is the seconds and\n"
519 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 520 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
521#define FUNC_NAME s_scm_setitimer
522{
523 int rv;
524 int c_which_timer;
525 struct itimerval new_timer;
526 struct itimerval old_timer;
527
528 c_which_timer = SCM_NUM2INT(1, which_timer);
529 new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
530 new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
531 new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
532 new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
533
534 SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
535
536 if(rv != 0)
537 SCM_SYSERROR;
538
b9bd8526
MV
539 return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
540 scm_from_long (old_timer.it_interval.tv_usec)),
541 scm_cons (scm_from_long (old_timer.it_value.tv_sec),
542 scm_from_long (old_timer.it_value.tv_usec)));
53f8a0d2
RB
543}
544#undef FUNC_NAME
545#endif /* HAVE_SETITIMER */
546
547#ifdef HAVE_GETITIMER
548SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
549 (SCM which_timer),
550 "Return information about the timer specified by @var{which_timer}"
551 "\n"
552 "Errors are handled as described in the guile info pages under ``POSIX\n"
553 "Interface Conventions''.\n"
554 "\n"
9401323e 555 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
556 "and @code{ITIMER_PROF}.\n"
557 "\n"
558 "The return value will be a list of two cons pairs representing the\n"
559 "current state of the given timer. The first pair is the seconds and\n"
560 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 561 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
562#define FUNC_NAME s_scm_getitimer
563{
564 int rv;
565 int c_which_timer;
566 struct itimerval old_timer;
567
568 c_which_timer = SCM_NUM2INT(1, which_timer);
569
570 SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
571
572 if(rv != 0)
573 SCM_SYSERROR;
574
b9bd8526
MV
575 return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
576 scm_from_long (old_timer.it_interval.tv_usec)),
577 scm_cons (scm_from_long (old_timer.it_value.tv_sec),
578 scm_from_long (old_timer.it_value.tv_usec)));
53f8a0d2
RB
579}
580#undef FUNC_NAME
581#endif /* HAVE_GETITIMER */
582
0e958795 583#ifdef HAVE_PAUSE
adb2c53b 584SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
1bbd0b84 585 (),
b380b885
MD
586 "Pause the current process (thread?) until a signal arrives whose\n"
587 "action is to either terminate the current process or invoke a\n"
588 "handler procedure. The return value is unspecified.")
1bbd0b84 589#define FUNC_NAME s_scm_pause
0f2d19dd
JB
590{
591 pause ();
592 return SCM_UNSPECIFIED;
593}
1bbd0b84 594#undef FUNC_NAME
0e958795 595#endif
0f2d19dd 596
adb2c53b 597SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
1bbd0b84 598 (SCM i),
b380b885
MD
599 "Wait for the given number of seconds (an integer) or until a signal\n"
600 "arrives. The return value is zero if the time elapses or the number\n"
651f2cd2
KR
601 "of seconds remaining otherwise.\n"
602 "\n"
603 "See also @code{usleep}.")
1bbd0b84 604#define FUNC_NAME s_scm_sleep
0f2d19dd 605{
9de87eea 606 return scm_from_uint (scm_std_sleep (scm_to_uint (i)));
0f2d19dd 607}
1bbd0b84 608#undef FUNC_NAME
0f2d19dd 609
adb2c53b 610SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
1bbd0b84 611 (SCM i),
651f2cd2
KR
612 "Wait the given period @var{usecs} microseconds (an integer).\n"
613 "If a signal arrives the wait stops and the return value is the\n"
614 "time remaining, in microseconds. If the period elapses with no\n"
615 "signal the return is zero.\n"
616 "\n"
617 "On most systems the process scheduler is not microsecond accurate and\n"
618 "the actual period slept by @code{usleep} may be rounded to a system\n"
619 "clock tick boundary. Traditionally such ticks were 10 milliseconds\n"
620 "apart, and that interval is often still used.\n"
621 "\n"
622 "See also @code{sleep}.")
1bbd0b84 623#define FUNC_NAME s_scm_usleep
ce874f2d 624{
9de87eea 625 return scm_from_ulong (scm_std_usleep (scm_to_ulong (i)));
b74f4728 626}
1bbd0b84 627#undef FUNC_NAME
ce874f2d 628
adb2c53b 629SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
1bbd0b84 630 (SCM sig),
b380b885
MD
631 "Sends a specified signal @var{sig} to the current process, where\n"
632 "@var{sig} is as described for the kill procedure.")
1bbd0b84 633#define FUNC_NAME s_scm_raise
0f2d19dd 634{
23d72566 635 if (raise (scm_to_int (sig)) != 0)
1bbd0b84 636 SCM_SYSERROR;
e1a191a8 637 return SCM_UNSPECIFIED;
0f2d19dd 638}
1bbd0b84 639#undef FUNC_NAME
0f2d19dd
JB
640
641\f
0f2d19dd 642
2e77f720
LC
643void
644scm_i_close_signal_pipe()
645{
646 /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
647 thread is being launched. The thread that calls this function is
648 already holding the thread admin mutex, so if the delivery thread hasn't
649 been launched at this point, it never will be before shutdown. */
650 scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
651
70eca635 652#if SCM_USE_PTHREAD_THREADS
2e77f720
LC
653 if (scm_i_signal_delivery_thread != NULL)
654 close (signal_pipe[1]);
70eca635 655#endif
2e77f720
LC
656
657 scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
658}
659
e1a191a8
GH
660void
661scm_init_scmsigs ()
0f2d19dd 662{
e1a191a8
GH
663 int i;
664
665 signal_handlers =
86d31dfe
MV
666 SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
667 scm_c_make_vector (NSIG, SCM_BOOL_F)));
9de87eea 668 signal_handler_asyncs =
dbbaa07c 669 scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
2fbc8609
MV
670 signal_handler_threads =
671 scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
e1a191a8
GH
672
673 for (i = 0; i < NSIG; i++)
674 {
e1a191a8
GH
675#ifdef HAVE_SIGACTION
676 orig_handlers[i].sa_handler = SIG_ERR;
840ae05d 677
e1a191a8
GH
678#else
679 orig_handlers[i] = SIG_ERR;
0f2d19dd 680#endif
e1a191a8 681 }
1cc91f1b 682
b9bd8526
MV
683 scm_c_define ("NSIG", scm_from_long (NSIG));
684 scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN));
685 scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL));
e1a191a8 686#ifdef SA_NOCLDSTOP
b9bd8526 687 scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
0f2d19dd 688#endif
e1a191a8 689#ifdef SA_RESTART
b9bd8526 690 scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
0f2d19dd 691#endif
1cc91f1b 692
53f8a0d2
RB
693#if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
694 /* Stuff needed by setitimer and getitimer. */
e11e83f3
MV
695 scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
696 scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
697 scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
53f8a0d2
RB
698#endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
699
a0599745 700#include "libguile/scmsigs.x"
0f2d19dd
JB
701}
702
89e00824
ML
703
704/*
705 Local Variables:
706 c-file-style: "gnu"
707 End:
708*/