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