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