lazily init futures worker pool
[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
09d978f3
NJ
343 {
344 SCM_CRITICAL_SECTION_END;
345 SCM_OUT_OF_RANGE (2, handler);
346 }
e1a191a8 347 }
7888309b 348 else if (scm_is_false (handler))
e1a191a8
GH
349 {
350 /* restore the default handler. */
351#ifdef HAVE_SIGACTION
352 if (orig_handlers[csig].sa_handler == SIG_ERR)
353 query_only = 1;
354 else
355 {
356 action = orig_handlers[csig];
357 orig_handlers[csig].sa_handler = SIG_ERR;
dbbaa07c 358 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
359 }
360#else
361 if (orig_handlers[csig] == SIG_ERR)
362 query_only = 1;
363 else
364 {
365 chandler = orig_handlers[csig];
366 orig_handlers[csig] = SIG_ERR;
dbbaa07c 367 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
368 }
369#endif
adb2c53b 370 }
e1a191a8
GH
371 else
372 {
43067cec 373 SCM_VALIDATE_PROC (2, handler);
e1a191a8
GH
374#ifdef HAVE_SIGACTION
375 action.sa_handler = take_signal;
376 if (orig_handlers[csig].sa_handler == SIG_ERR)
377 save_handler = 1;
378#else
379 chandler = take_signal;
380 if (orig_handlers[csig] == SIG_ERR)
381 save_handler = 1;
382#endif
dbbaa07c 383 install_handler (csig, thread, handler);
e1a191a8 384 }
adb2c53b 385
0d172d3f
MV
386 /* XXX - Silently ignore setting handlers for `program error signals'
387 because they can't currently be handled by Scheme code.
388 */
389
390 switch (csig)
391 {
392 /* This list of program error signals is from the GNU Libc
393 Reference Manual */
394 case SIGFPE:
395 case SIGILL:
396 case SIGSEGV:
82893676 397#ifdef SIGBUS
0d172d3f 398 case SIGBUS:
82893676 399#endif
0d172d3f 400 case SIGABRT:
6732de1b 401#if defined(SIGIOT) && (SIGIOT != SIGABRT)
0d172d3f
MV
402 case SIGIOT:
403#endif
82893676 404#ifdef SIGTRAP
0d172d3f 405 case SIGTRAP:
82893676 406#endif
0d172d3f
MV
407#ifdef SIGEMT
408 case SIGEMT:
409#endif
adb2c53b 410#ifdef SIGSYS
0d172d3f 411 case SIGSYS:
adb2c53b 412#endif
0d172d3f
MV
413 query_only = 1;
414 }
415
e1a191a8
GH
416#ifdef HAVE_SIGACTION
417 if (query_only)
418 {
419 if (sigaction (csig, 0, &old_action) == -1)
1bbd0b84 420 SCM_SYSERROR;
e1a191a8
GH
421 }
422 else
423 {
424 if (sigaction (csig, &action , &old_action) == -1)
1bbd0b84 425 SCM_SYSERROR;
e1a191a8
GH
426 if (save_handler)
427 orig_handlers[csig] = old_action;
428 }
429 if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
b9bd8526 430 old_handler = scm_from_long ((long) old_action.sa_handler);
9de87eea 431 SCM_CRITICAL_SECTION_END;
e11e83f3 432 return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
e1a191a8
GH
433#else
434 if (query_only)
435 {
436 if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
1bbd0b84 437 SCM_SYSERROR;
e1a191a8 438 if (signal (csig, old_chandler) == SIG_ERR)
1bbd0b84 439 SCM_SYSERROR;
e1a191a8
GH
440 }
441 else
442 {
443 if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
1bbd0b84 444 SCM_SYSERROR;
e1a191a8
GH
445 if (save_handler)
446 orig_handlers[csig] = old_chandler;
447 }
448 if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
b9bd8526 449 old_handler = scm_from_long ((long) old_chandler);
9de87eea 450 SCM_CRITICAL_SECTION_END;
e11e83f3 451 return scm_cons (old_handler, scm_from_int (0));
0f2d19dd 452#endif
e1a191a8 453}
1bbd0b84 454#undef FUNC_NAME
e1a191a8 455
adb2c53b 456SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
1bbd0b84 457 (void),
b380b885
MD
458 "Return all signal handlers to the values they had before any call to\n"
459 "@code{sigaction} was made. The return value is unspecified.")
1bbd0b84 460#define FUNC_NAME s_scm_restore_signals
e1a191a8
GH
461{
462 int i;
e1a191a8
GH
463 for (i = 0; i < NSIG; i++)
464 {
465#ifdef HAVE_SIGACTION
466 if (orig_handlers[i].sa_handler != SIG_ERR)
467 {
468 if (sigaction (i, &orig_handlers[i], NULL) == -1)
1bbd0b84 469 SCM_SYSERROR;
e1a191a8 470 orig_handlers[i].sa_handler = SIG_ERR;
4057a3e0 471 SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
472 }
473#else
474 if (orig_handlers[i] != SIG_ERR)
475 {
476 if (signal (i, orig_handlers[i]) == SIG_ERR)
1bbd0b84 477 SCM_SYSERROR;
e1a191a8 478 orig_handlers[i] = SIG_ERR;
4057a3e0 479 SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
480 }
481#endif
482 }
483 return SCM_UNSPECIFIED;
484}
1bbd0b84 485#undef FUNC_NAME
0f2d19dd 486
adb2c53b 487SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
1bbd0b84 488 (SCM i),
b380b885
MD
489 "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
490 "number of seconds (an integer). It's advisable to install a signal\n"
491 "handler for\n"
492 "@code{SIGALRM} beforehand, since the default action is to terminate\n"
493 "the process.\n\n"
494 "The return value indicates the time remaining for the previous alarm,\n"
495 "if any. The new value replaces the previous alarm. If there was\n"
496 "no previous alarm, the return value is zero.")
1bbd0b84 497#define FUNC_NAME s_scm_alarm
0f2d19dd 498{
a55c2b68 499 return scm_from_uint (alarm (scm_to_uint (i)));
0f2d19dd 500}
1bbd0b84 501#undef FUNC_NAME
0f2d19dd 502
53f8a0d2
RB
503#ifdef HAVE_SETITIMER
504SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
505 (SCM which_timer,
506 SCM interval_seconds, SCM interval_microseconds,
507 SCM value_seconds, SCM value_microseconds),
508 "Set the timer specified by @var{which_timer} according to the given\n"
509 "@var{interval_seconds}, @var{interval_microseconds},\n"
510 "@var{value_seconds}, and @var{value_microseconds} values.\n"
511 "\n"
512 "Return information about the timer's previous setting."
513 "\n"
514 "Errors are handled as described in the guile info pages under ``POSIX\n"
515 "Interface Conventions''.\n"
516 "\n"
9401323e 517 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
518 "and @code{ITIMER_PROF}.\n"
519 "\n"
520 "The return value will be a list of two cons pairs representing the\n"
521 "current state of the given timer. The first pair is the seconds and\n"
522 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 523 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
524#define FUNC_NAME s_scm_setitimer
525{
526 int rv;
527 int c_which_timer;
528 struct itimerval new_timer;
529 struct itimerval old_timer;
530
531 c_which_timer = SCM_NUM2INT(1, which_timer);
532 new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
533 new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
534 new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
535 new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
536
537 SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
538
539 if(rv != 0)
540 SCM_SYSERROR;
541
b9bd8526
MV
542 return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
543 scm_from_long (old_timer.it_interval.tv_usec)),
544 scm_cons (scm_from_long (old_timer.it_value.tv_sec),
545 scm_from_long (old_timer.it_value.tv_usec)));
53f8a0d2
RB
546}
547#undef FUNC_NAME
548#endif /* HAVE_SETITIMER */
549
550#ifdef HAVE_GETITIMER
551SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
552 (SCM which_timer),
553 "Return information about the timer specified by @var{which_timer}"
554 "\n"
555 "Errors are handled as described in the guile info pages under ``POSIX\n"
556 "Interface Conventions''.\n"
557 "\n"
9401323e 558 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
559 "and @code{ITIMER_PROF}.\n"
560 "\n"
561 "The return value will be a list of two cons pairs representing the\n"
562 "current state of the given timer. The first pair is the seconds and\n"
563 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 564 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
565#define FUNC_NAME s_scm_getitimer
566{
567 int rv;
568 int c_which_timer;
569 struct itimerval old_timer;
570
571 c_which_timer = SCM_NUM2INT(1, which_timer);
572
573 SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
574
575 if(rv != 0)
576 SCM_SYSERROR;
577
b9bd8526
MV
578 return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
579 scm_from_long (old_timer.it_interval.tv_usec)),
580 scm_cons (scm_from_long (old_timer.it_value.tv_sec),
581 scm_from_long (old_timer.it_value.tv_usec)));
53f8a0d2
RB
582}
583#undef FUNC_NAME
584#endif /* HAVE_GETITIMER */
585
0e958795 586#ifdef HAVE_PAUSE
adb2c53b 587SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
1bbd0b84 588 (),
b380b885
MD
589 "Pause the current process (thread?) until a signal arrives whose\n"
590 "action is to either terminate the current process or invoke a\n"
591 "handler procedure. The return value is unspecified.")
1bbd0b84 592#define FUNC_NAME s_scm_pause
0f2d19dd
JB
593{
594 pause ();
595 return SCM_UNSPECIFIED;
596}
1bbd0b84 597#undef FUNC_NAME
0e958795 598#endif
0f2d19dd 599
adb2c53b 600SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
1bbd0b84 601 (SCM i),
b380b885
MD
602 "Wait for the given number of seconds (an integer) or until a signal\n"
603 "arrives. The return value is zero if the time elapses or the number\n"
651f2cd2
KR
604 "of seconds remaining otherwise.\n"
605 "\n"
606 "See also @code{usleep}.")
1bbd0b84 607#define FUNC_NAME s_scm_sleep
0f2d19dd 608{
9de87eea 609 return scm_from_uint (scm_std_sleep (scm_to_uint (i)));
0f2d19dd 610}
1bbd0b84 611#undef FUNC_NAME
0f2d19dd 612
adb2c53b 613SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
1bbd0b84 614 (SCM i),
651f2cd2
KR
615 "Wait the given period @var{usecs} microseconds (an integer).\n"
616 "If a signal arrives the wait stops and the return value is the\n"
617 "time remaining, in microseconds. If the period elapses with no\n"
618 "signal the return is zero.\n"
619 "\n"
620 "On most systems the process scheduler is not microsecond accurate and\n"
621 "the actual period slept by @code{usleep} may be rounded to a system\n"
622 "clock tick boundary. Traditionally such ticks were 10 milliseconds\n"
623 "apart, and that interval is often still used.\n"
624 "\n"
625 "See also @code{sleep}.")
1bbd0b84 626#define FUNC_NAME s_scm_usleep
ce874f2d 627{
9de87eea 628 return scm_from_ulong (scm_std_usleep (scm_to_ulong (i)));
b74f4728 629}
1bbd0b84 630#undef FUNC_NAME
ce874f2d 631
adb2c53b 632SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
1bbd0b84 633 (SCM sig),
b380b885
MD
634 "Sends a specified signal @var{sig} to the current process, where\n"
635 "@var{sig} is as described for the kill procedure.")
1bbd0b84 636#define FUNC_NAME s_scm_raise
0f2d19dd 637{
23d72566 638 if (raise (scm_to_int (sig)) != 0)
1bbd0b84 639 SCM_SYSERROR;
e1a191a8 640 return SCM_UNSPECIFIED;
0f2d19dd 641}
1bbd0b84 642#undef FUNC_NAME
0f2d19dd
JB
643
644\f
0f2d19dd 645
2e77f720
LC
646void
647scm_i_close_signal_pipe()
648{
649 /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
650 thread is being launched. The thread that calls this function is
651 already holding the thread admin mutex, so if the delivery thread hasn't
652 been launched at this point, it never will be before shutdown. */
653 scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
654
70eca635 655#if SCM_USE_PTHREAD_THREADS
2e77f720
LC
656 if (scm_i_signal_delivery_thread != NULL)
657 close (signal_pipe[1]);
70eca635 658#endif
2e77f720
LC
659
660 scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
661}
662
e1a191a8
GH
663void
664scm_init_scmsigs ()
0f2d19dd 665{
e1a191a8
GH
666 int i;
667
668 signal_handlers =
86d31dfe
MV
669 SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
670 scm_c_make_vector (NSIG, SCM_BOOL_F)));
f39448c5
AW
671 signal_handler_asyncs = scm_c_make_vector (NSIG, SCM_BOOL_F);
672 signal_handler_threads = scm_c_make_vector (NSIG, SCM_BOOL_F);
e1a191a8
GH
673
674 for (i = 0; i < NSIG; i++)
675 {
e1a191a8
GH
676#ifdef HAVE_SIGACTION
677 orig_handlers[i].sa_handler = SIG_ERR;
840ae05d 678
e1a191a8
GH
679#else
680 orig_handlers[i] = SIG_ERR;
0f2d19dd 681#endif
e1a191a8 682 }
1cc91f1b 683
b9bd8526
MV
684 scm_c_define ("NSIG", scm_from_long (NSIG));
685 scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN));
686 scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL));
e1a191a8 687#ifdef SA_NOCLDSTOP
b9bd8526 688 scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
0f2d19dd 689#endif
e1a191a8 690#ifdef SA_RESTART
b9bd8526 691 scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
0f2d19dd 692#endif
1cc91f1b 693
53f8a0d2
RB
694#if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
695 /* Stuff needed by setitimer and getitimer. */
e11e83f3
MV
696 scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
697 scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
698 scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
53f8a0d2
RB
699#endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
700
a0599745 701#include "libguile/scmsigs.x"
0f2d19dd
JB
702}
703
89e00824
ML
704
705/*
706 Local Variables:
707 c-file-style: "gnu"
708 End:
709*/