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