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