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