* rw.c: #include <config.h> if HAVE_CONFIG_H.
[bpt/guile.git] / libguile / scmsigs.c
CommitLineData
2fbc8609 1/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
adb2c53b 2 *
0f2d19dd
JB
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
6 * any later version.
adb2c53b 7 *
0f2d19dd
JB
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
adb2c53b 12 *
0f2d19dd
JB
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
82892bed
JB
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
0f2d19dd
JB
17 *
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
20 *
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
26 *
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
29 *
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
37 *
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
82892bed 40 * If you do not wish that, delete this exception notice. */
1bbd0b84 41
1bbd0b84 42
0f2d19dd
JB
43\f
44
0f2d19dd 45#include <signal.h>
e6e2e95a
MD
46#include <errno.h>
47
a0599745 48#include "libguile/_scm.h"
0f2d19dd 49
a0599745
MD
50#include "libguile/async.h"
51#include "libguile/eval.h"
fdc28395 52#include "libguile/root.h"
a0599745 53#include "libguile/vectors.h"
1bbd0b84 54
a0599745
MD
55#include "libguile/validate.h"
56#include "libguile/scmsigs.h"
20e6290e 57
0f2d19dd
JB
58#ifdef HAVE_UNISTD_H
59#include <unistd.h>
60#endif
61
1bed8c28
GH
62#ifdef HAVE_SYS_TIME_H
63#include <sys/time.h>
64#endif
65
82893676
MG
66#ifdef __MINGW32__
67#include <windows.h>
68#define alarm(sec) (0)
69/* This weird comma expression is because Sleep is void under Windows. */
70#define sleep(sec) (Sleep ((sec) * 1000), 0)
ed618cc9 71#define usleep(usec) (Sleep ((usec) / 1000), 0)
82893676
MG
72#define kill(pid, sig) raise (sig)
73#endif
74
0f2d19dd
JB
75\f
76
e1a191a8 77/* SIGRETTYPE is the type that signal handlers return. See <signal.h> */
0f2d19dd
JB
78
79#ifdef RETSIGTYPE
e1a191a8 80# define SIGRETTYPE RETSIGTYPE
0f2d19dd 81#else
e1a191a8
GH
82# ifdef STDC_HEADERS
83# define SIGRETTYPE void
84# else
85# define SIGRETTYPE int
86# endif
0f2d19dd
JB
87#endif
88
89\f
90
e1a191a8 91/* take_signal is installed as the C signal handler whenever a Scheme
2fbc8609
MV
92 handler is set. when a signal arrives, take_signal will queue the
93 Scheme handler procedure for its thread. */
0f2d19dd 94
0f2d19dd 95
2fbc8609
MV
96/* Scheme vectors with information about a signal. signal_handlers
97 contains the handler procedure or #f, signal_handler_cells contains
dbbaa07c
MV
98 pre-queued cells for the handler (since we can't do fancy things
99 during signal delivery), signal_cell_handlers contains the SCM
100 value to be stuffed into the pre-queued cell upon delivery, and
101 signal_handler_threads points to the thread that a signal should be
102 delivered to.
2fbc8609 103*/
e1a191a8 104static SCM *signal_handlers;
2fbc8609 105static SCM signal_handler_cells;
dbbaa07c 106static SCM signal_cell_handlers;
2fbc8609 107static SCM signal_handler_threads;
0f2d19dd 108
e1a191a8
GH
109/* saves the original C handlers, when a new handler is installed.
110 set to SIG_ERR if the original handler is installed. */
111#ifdef HAVE_SIGACTION
112static struct sigaction orig_handlers[NSIG];
113#else
da6e81b6 114static SIGRETTYPE (*orig_handlers[NSIG])(int);
0f2d19dd
JB
115#endif
116
dbbaa07c 117
e1a191a8
GH
118static SIGRETTYPE
119take_signal (int signum)
120{
2fbc8609
MV
121 if (signum >= 0 && signum < NSIG)
122 {
dbbaa07c
MV
123 SCM cell = SCM_VECTOR_REF(signal_handler_cells, signum);
124 SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
125 SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
126 scm_root_state *root = scm_i_thread_root (thread);
127 if (SCM_CONSP (cell))
128 {
129 SCM_SETCAR (cell, handler);
130 root->pending_asyncs = 1;
131 }
2fbc8609 132 }
dbbaa07c 133
2fbc8609
MV
134#ifndef HAVE_SIGACTION
135 signal (signum, take_signal);
136#endif
e1a191a8 137}
0f2d19dd 138
2fbc8609
MV
139SCM
140scm_sigaction (SCM signum, SCM handler, SCM flags)
e1a191a8 141{
2fbc8609
MV
142 return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
143}
e1a191a8 144
2fbc8609
MV
145static SCM
146close_1 (SCM proc, SCM arg)
147{
148 return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
149 scm_list_2 (proc, arg)));
0f2d19dd
JB
150}
151
dbbaa07c
MV
152/* Make sure that signal SIGNUM can be delivered to THREAD, using
153 HANDLER. THREAD and HANDLER must either both be non-#f (which
154 means install the handler), or both #f (which means deinstall an
155 existing handler).
156*/
157
158struct install_handler_data {
159 int signum;
160 SCM thread;
161 SCM handler;
162};
163
164static SCM
165scm_delq_spine_x (SCM cell, SCM list)
166{
167 SCM s = list, prev = SCM_BOOL_F;
168
169 while (!SCM_EQ_P (cell, s))
170 {
171 if (SCM_NULLP (s))
172 return list;
173 prev = s;
174 s = SCM_CDR (s);
175 }
176 if (SCM_FALSEP (prev))
177 return SCM_CDR (cell);
178 else
179 {
180 SCM_SETCDR (prev, SCM_CDR (cell));
181 return list;
182 }
183}
184
185static void *
186really_install_handler (void *data)
187{
188 struct install_handler_data *args = data;
189 int signum = args->signum;
190 SCM thread = args->thread;
191 SCM handler = args->handler;
192 SCM cell;
193 SCM old_thread;
194
195 /* The following modifications are done while signals can be
196 delivered. That is not a real problem since the signal handler
197 will only touch the car of the handler cell and set the
198 pending_asyncs trigger of a thread. While the data structures
199 are in flux, the signal handler might store the wrong handler in
200 the cell, or set pending_asyncs of the wrong thread. We fix this
201 at the end by making sure that the cell has the right handler in
202 it, if any, and that pending_asyncs is set for the new thread.
203 */
204
205 /* Make sure we have a cell. */
206 cell = SCM_VECTOR_REF (signal_handler_cells, signum);
207 if (SCM_FALSEP (cell))
208 {
209 cell = scm_cons (SCM_BOOL_F, SCM_EOL);
210 SCM_VECTOR_SET (signal_handler_cells, signum, cell);
211 }
212
213 /* Make sure it is queued for the right thread. */
214 old_thread = SCM_VECTOR_REF (signal_handler_threads, signum);
215 if (!SCM_EQ_P (thread, old_thread))
216 {
217 scm_root_state *r;
218 if (!SCM_FALSEP (old_thread))
219 {
220 r = scm_i_thread_root (old_thread);
221 r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs);
222 }
223 if (!SCM_FALSEP (thread))
224 {
225 r = scm_i_thread_root (thread);
226 SCM_SETCDR (cell, r->signal_asyncs);
227 r->signal_asyncs = cell;
228 /* Set pending_asyncs just in case. A signal that is
229 delivered while we modify the data structures here might set
230 pending_asyncs of old_thread. */
231 r->pending_asyncs = 1;
232 }
233 SCM_VECTOR_SET (signal_handler_threads, signum, thread);
234 }
235
236 /* Set the new handler. */
237 if (SCM_FALSEP (handler))
238 {
239 SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
240 SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
241 }
242 else
243 {
244 SCM_VECTOR_SET (*signal_handlers, signum, handler);
245 SCM_VECTOR_SET (signal_cell_handlers, signum,
246 close_1 (handler, scm_int2num (signum)));
247 }
248
249 /* Now fix up the cell. It might contain the old handler but since
250 it is now queued for the new thread, we must make sure that the
251 new handler is run. Any signal that is delivered during the
252 following code will install the new handler, so we have no
253 problem.
254 */
255 if (!SCM_FALSEP (SCM_CAR (cell)))
256 SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
257
258 /* Phfew. That should be it. */
259 return NULL;
260}
261
262static void
263install_handler (int signum, SCM thread, SCM handler)
264{
265 /* We block asyncs while installing the handler. It would be safe
266 to leave them on, but we might run the wrong handler should a
267 signal be delivered.
268 */
269
270 struct install_handler_data args;
271 args.signum = signum;
272 args.thread = thread;
273 args.handler = handler;
274 scm_c_call_with_blocked_asyncs (really_install_handler, &args);
275}
276
e1a191a8 277/* user interface for installation of signal handlers. */
2fbc8609
MV
278SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
279 (SCM signum, SCM handler, SCM flags, SCM thread),
0d172d3f 280 "Install or report the signal handler for a specified signal.\n\n"
b380b885
MD
281 "@var{signum} is the signal number, which can be specified using the value\n"
282 "of variables such as @code{SIGINT}.\n\n"
2fbc8609 283 "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
b380b885
MD
284 "CAR is the current\n"
285 "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
286 "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
287 "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
288 "signal. The CDR contains the current @code{sigaction} flags for the handler.\n\n"
2fbc8609
MV
289 "If @var{handler} is provided, it is installed as the new handler for\n"
290 "@var{signum}. @var{handler} can be a Scheme procedure taking one\n"
b380b885
MD
291 "argument, or the value of @code{SIG_DFL} (default action) or\n"
292 "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
2fbc8609
MV
293 "was installed before @code{sigaction} was first used. When\n"
294 "a scheme procedure has been specified, that procedure will run\n"
295 "in the given @var{thread}. When no thread has been given, the\n"
296 "thread that made this call to @code{sigaction} is used.\n"
297 "Flags can "
b380b885 298 "optionally be specified for the new handler (@code{SA_RESTART} will\n"
0d172d3f 299 "always be added if it's available and the system is using restartable\n"
b380b885
MD
300 "system calls.) The return value is a pair with information about the\n"
301 "old handler as described above.\n\n"
302 "This interface does not provide access to the \"signal blocking\"\n"
303 "facility. Maybe this is not needed, since the thread support may\n"
304 "provide solutions to the problem of consistent access to data\n"
305 "structures.")
2fbc8609 306#define FUNC_NAME s_scm_sigaction_for_thread
e1a191a8
GH
307{
308 int csig;
309#ifdef HAVE_SIGACTION
310 struct sigaction action;
311 struct sigaction old_action;
312#else
af68e5e5 313 SIGRETTYPE (* chandler) (int) = SIG_DFL;
e1a191a8
GH
314 SIGRETTYPE (* old_chandler) (int);
315#endif
316 int query_only = 0;
317 int save_handler = 0;
34d19ef6 318
e1a191a8
GH
319 SCM old_handler;
320
34d19ef6 321 SCM_VALIDATE_INUM_COPY (1, signum, csig);
2fbc8609
MV
322 if (csig < 0 || csig > NSIG)
323 SCM_OUT_OF_RANGE (1, signum);
7ee92fce
GH
324#if defined(HAVE_SIGACTION)
325#if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
326 /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
327 is defined, since libguile would be likely to produce spurious
328 EINTR errors. */
e1a191a8
GH
329 action.sa_flags = SA_RESTART;
330#else
331 action.sa_flags = 0;
332#endif
333 if (!SCM_UNBNDP (flags))
334 {
34d19ef6 335 SCM_VALIDATE_INUM (3, flags);
e1a191a8
GH
336 action.sa_flags |= SCM_INUM (flags);
337 }
338 sigemptyset (&action.sa_mask);
4feac0b9
MV
339#endif
340
2fbc8609
MV
341 if (SCM_UNBNDP (thread))
342 thread = scm_current_thread ();
343 else
dbbaa07c
MV
344 {
345 SCM_VALIDATE_THREAD (4, thread);
346 if (scm_c_thread_exited_p (thread))
347 SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
348 }
4feac0b9 349
e1a191a8 350 SCM_DEFER_INTS;
2fbc8609 351 old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
e1a191a8
GH
352 if (SCM_UNBNDP (handler))
353 query_only = 1;
9a09deb1 354 else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
e1a191a8 355 {
e4b265d8
DH
356 if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL
357 || SCM_NUM2LONG (2, handler) == (long) SIG_IGN)
e1a191a8
GH
358 {
359#ifdef HAVE_SIGACTION
360 action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
361#else
362 chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
363#endif
dbbaa07c 364 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
365 }
366 else
1bbd0b84 367 SCM_OUT_OF_RANGE (2, handler);
e1a191a8
GH
368 }
369 else if (SCM_FALSEP (handler))
370 {
371 /* restore the default handler. */
372#ifdef HAVE_SIGACTION
373 if (orig_handlers[csig].sa_handler == SIG_ERR)
374 query_only = 1;
375 else
376 {
377 action = orig_handlers[csig];
378 orig_handlers[csig].sa_handler = SIG_ERR;
dbbaa07c 379 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
380 }
381#else
382 if (orig_handlers[csig] == SIG_ERR)
383 query_only = 1;
384 else
385 {
386 chandler = orig_handlers[csig];
387 orig_handlers[csig] = SIG_ERR;
dbbaa07c 388 install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
e1a191a8
GH
389 }
390#endif
adb2c53b 391 }
e1a191a8
GH
392 else
393 {
34d19ef6 394 SCM_VALIDATE_NIM (2, handler);
e1a191a8
GH
395#ifdef HAVE_SIGACTION
396 action.sa_handler = take_signal;
397 if (orig_handlers[csig].sa_handler == SIG_ERR)
398 save_handler = 1;
399#else
400 chandler = take_signal;
401 if (orig_handlers[csig] == SIG_ERR)
402 save_handler = 1;
403#endif
dbbaa07c 404 install_handler (csig, thread, handler);
e1a191a8 405 }
adb2c53b 406
0d172d3f
MV
407 /* XXX - Silently ignore setting handlers for `program error signals'
408 because they can't currently be handled by Scheme code.
409 */
410
411 switch (csig)
412 {
413 /* This list of program error signals is from the GNU Libc
414 Reference Manual */
415 case SIGFPE:
416 case SIGILL:
417 case SIGSEGV:
82893676 418#ifdef SIGBUS
0d172d3f 419 case SIGBUS:
82893676 420#endif
0d172d3f 421 case SIGABRT:
6732de1b 422#if defined(SIGIOT) && (SIGIOT != SIGABRT)
0d172d3f
MV
423 case SIGIOT:
424#endif
82893676 425#ifdef SIGTRAP
0d172d3f 426 case SIGTRAP:
82893676 427#endif
0d172d3f
MV
428#ifdef SIGEMT
429 case SIGEMT:
430#endif
adb2c53b 431#ifdef SIGSYS
0d172d3f 432 case SIGSYS:
adb2c53b 433#endif
0d172d3f
MV
434 query_only = 1;
435 }
436
e1a191a8
GH
437#ifdef HAVE_SIGACTION
438 if (query_only)
439 {
440 if (sigaction (csig, 0, &old_action) == -1)
1bbd0b84 441 SCM_SYSERROR;
e1a191a8
GH
442 }
443 else
444 {
445 if (sigaction (csig, &action , &old_action) == -1)
1bbd0b84 446 SCM_SYSERROR;
e1a191a8
GH
447 if (save_handler)
448 orig_handlers[csig] = old_action;
449 }
450 if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
7ee92fce 451 old_handler = scm_long2num ((long) old_action.sa_handler);
e1a191a8
GH
452 SCM_ALLOW_INTS;
453 return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
454#else
455 if (query_only)
456 {
457 if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
1bbd0b84 458 SCM_SYSERROR;
e1a191a8 459 if (signal (csig, old_chandler) == SIG_ERR)
1bbd0b84 460 SCM_SYSERROR;
e1a191a8
GH
461 }
462 else
463 {
464 if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
1bbd0b84 465 SCM_SYSERROR;
e1a191a8
GH
466 if (save_handler)
467 orig_handlers[csig] = old_chandler;
468 }
469 if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
da6e81b6 470 old_handler = scm_long2num ((long) old_chandler);
e1a191a8
GH
471 SCM_ALLOW_INTS;
472 return scm_cons (old_handler, SCM_MAKINUM (0));
0f2d19dd 473#endif
e1a191a8 474}
1bbd0b84 475#undef FUNC_NAME
e1a191a8 476
adb2c53b 477SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
1bbd0b84 478 (void),
b380b885
MD
479 "Return all signal handlers to the values they had before any call to\n"
480 "@code{sigaction} was made. The return value is unspecified.")
1bbd0b84 481#define FUNC_NAME s_scm_restore_signals
e1a191a8
GH
482{
483 int i;
e1a191a8
GH
484 for (i = 0; i < NSIG; i++)
485 {
486#ifdef HAVE_SIGACTION
487 if (orig_handlers[i].sa_handler != SIG_ERR)
488 {
489 if (sigaction (i, &orig_handlers[i], NULL) == -1)
1bbd0b84 490 SCM_SYSERROR;
e1a191a8 491 orig_handlers[i].sa_handler = SIG_ERR;
34d19ef6 492 SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
493 }
494#else
495 if (orig_handlers[i] != SIG_ERR)
496 {
497 if (signal (i, orig_handlers[i]) == SIG_ERR)
1bbd0b84 498 SCM_SYSERROR;
e1a191a8 499 orig_handlers[i] = SIG_ERR;
34d19ef6 500 SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
e1a191a8
GH
501 }
502#endif
503 }
504 return SCM_UNSPECIFIED;
505}
1bbd0b84 506#undef FUNC_NAME
0f2d19dd 507
adb2c53b 508SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
1bbd0b84 509 (SCM i),
b380b885
MD
510 "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
511 "number of seconds (an integer). It's advisable to install a signal\n"
512 "handler for\n"
513 "@code{SIGALRM} beforehand, since the default action is to terminate\n"
514 "the process.\n\n"
515 "The return value indicates the time remaining for the previous alarm,\n"
516 "if any. The new value replaces the previous alarm. If there was\n"
517 "no previous alarm, the return value is zero.")
1bbd0b84 518#define FUNC_NAME s_scm_alarm
0f2d19dd
JB
519{
520 unsigned int j;
34d19ef6 521 SCM_VALIDATE_INUM (1, i);
e1a191a8 522 j = alarm (SCM_INUM (i));
0f2d19dd
JB
523 return SCM_MAKINUM (j);
524}
1bbd0b84 525#undef FUNC_NAME
0f2d19dd 526
53f8a0d2
RB
527#ifdef HAVE_SETITIMER
528SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
529 (SCM which_timer,
530 SCM interval_seconds, SCM interval_microseconds,
531 SCM value_seconds, SCM value_microseconds),
532 "Set the timer specified by @var{which_timer} according to the given\n"
533 "@var{interval_seconds}, @var{interval_microseconds},\n"
534 "@var{value_seconds}, and @var{value_microseconds} values.\n"
535 "\n"
536 "Return information about the timer's previous setting."
537 "\n"
538 "Errors are handled as described in the guile info pages under ``POSIX\n"
539 "Interface Conventions''.\n"
540 "\n"
9401323e 541 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
542 "and @code{ITIMER_PROF}.\n"
543 "\n"
544 "The return value will be a list of two cons pairs representing the\n"
545 "current state of the given timer. The first pair is the seconds and\n"
546 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 547 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
548#define FUNC_NAME s_scm_setitimer
549{
550 int rv;
551 int c_which_timer;
552 struct itimerval new_timer;
553 struct itimerval old_timer;
554
555 c_which_timer = SCM_NUM2INT(1, which_timer);
556 new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
557 new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
558 new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
559 new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
560
561 SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
562
563 if(rv != 0)
564 SCM_SYSERROR;
565
566 return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
567 scm_long2num(old_timer.it_interval.tv_usec)),
568 scm_cons(scm_long2num(old_timer.it_value.tv_sec),
569 scm_long2num(old_timer.it_value.tv_usec)));
570}
571#undef FUNC_NAME
572#endif /* HAVE_SETITIMER */
573
574#ifdef HAVE_GETITIMER
575SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
576 (SCM which_timer),
577 "Return information about the timer specified by @var{which_timer}"
578 "\n"
579 "Errors are handled as described in the guile info pages under ``POSIX\n"
580 "Interface Conventions''.\n"
581 "\n"
9401323e 582 "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
53f8a0d2
RB
583 "and @code{ITIMER_PROF}.\n"
584 "\n"
585 "The return value will be a list of two cons pairs representing the\n"
586 "current state of the given timer. The first pair is the seconds and\n"
587 "microseconds of the timer @code{it_interval}, and the second pair is\n"
9401323e 588 "the seconds and microseconds of the timer @code{it_value}.")
53f8a0d2
RB
589#define FUNC_NAME s_scm_getitimer
590{
591 int rv;
592 int c_which_timer;
593 struct itimerval old_timer;
594
595 c_which_timer = SCM_NUM2INT(1, which_timer);
596
597 SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
598
599 if(rv != 0)
600 SCM_SYSERROR;
601
602 return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
603 scm_long2num(old_timer.it_interval.tv_usec)),
604 scm_cons(scm_long2num(old_timer.it_value.tv_sec),
605 scm_long2num(old_timer.it_value.tv_usec)));
606}
607#undef FUNC_NAME
608#endif /* HAVE_GETITIMER */
609
0e958795 610#ifdef HAVE_PAUSE
adb2c53b 611SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
1bbd0b84 612 (),
b380b885
MD
613 "Pause the current process (thread?) until a signal arrives whose\n"
614 "action is to either terminate the current process or invoke a\n"
615 "handler procedure. The return value is unspecified.")
1bbd0b84 616#define FUNC_NAME s_scm_pause
0f2d19dd
JB
617{
618 pause ();
619 return SCM_UNSPECIFIED;
620}
1bbd0b84 621#undef FUNC_NAME
0e958795 622#endif
0f2d19dd 623
adb2c53b 624SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
1bbd0b84 625 (SCM i),
b380b885
MD
626 "Wait for the given number of seconds (an integer) or until a signal\n"
627 "arrives. The return value is zero if the time elapses or the number\n"
628 "of seconds remaining otherwise.")
1bbd0b84 629#define FUNC_NAME s_scm_sleep
0f2d19dd 630{
b74f4728 631 unsigned long j;
34d19ef6 632 SCM_VALIDATE_INUM_MIN (1, i,0);
b74f4728 633 j = scm_thread_sleep (SCM_INUM(i));
b74f4728 634 return scm_ulong2num (j);
0f2d19dd 635}
1bbd0b84 636#undef FUNC_NAME
0f2d19dd 637
adb2c53b 638SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
1bbd0b84 639 (SCM i),
5352393c
MG
640 "Sleep for I microseconds. @code{usleep} is not available on\n"
641 "all platforms.")
1bbd0b84 642#define FUNC_NAME s_scm_usleep
ce874f2d 643{
3d7f708f 644 unsigned long j;
34d19ef6 645 SCM_VALIDATE_INUM_MIN (1, i,0);
3d7f708f
MV
646 j = scm_thread_usleep (SCM_INUM (i));
647 return scm_ulong2num (j);
b74f4728 648}
1bbd0b84 649#undef FUNC_NAME
ce874f2d 650
adb2c53b 651SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
1bbd0b84 652 (SCM sig),
b380b885
MD
653 "Sends a specified signal @var{sig} to the current process, where\n"
654 "@var{sig} is as described for the kill procedure.")
1bbd0b84 655#define FUNC_NAME s_scm_raise
0f2d19dd 656{
34d19ef6 657 SCM_VALIDATE_INUM (1, sig);
e1a191a8
GH
658 SCM_DEFER_INTS;
659 if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
1bbd0b84 660 SCM_SYSERROR;
e1a191a8
GH
661 SCM_ALLOW_INTS;
662 return SCM_UNSPECIFIED;
0f2d19dd 663}
1bbd0b84 664#undef FUNC_NAME
0f2d19dd
JB
665
666\f
0f2d19dd 667
e1a191a8
GH
668void
669scm_init_scmsigs ()
0f2d19dd 670{
e1a191a8
GH
671 int i;
672
673 signal_handlers =
86d31dfe
MV
674 SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
675 scm_c_make_vector (NSIG, SCM_BOOL_F)));
2fbc8609
MV
676 signal_handler_cells =
677 scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
dbbaa07c
MV
678 signal_cell_handlers =
679 scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
2fbc8609
MV
680 signal_handler_threads =
681 scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
e1a191a8
GH
682
683 for (i = 0; i < NSIG; i++)
684 {
e1a191a8
GH
685#ifdef HAVE_SIGACTION
686 orig_handlers[i].sa_handler = SIG_ERR;
840ae05d 687
e1a191a8
GH
688#else
689 orig_handlers[i] = SIG_ERR;
0f2d19dd 690#endif
840ae05d 691
08b8c694 692#ifdef HAVE_RESTARTABLE_SYSCALLS
7ee92fce 693 /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
adb2c53b 694 signals really are restartable. don't rely on the same
7ee92fce
GH
695 run-time that configure got: reset the default for every signal.
696 */
697#ifdef HAVE_SIGINTERRUPT
698 siginterrupt (i, 0);
de881428 699#elif defined(SA_RESTART)
840ae05d
JB
700 {
701 struct sigaction action;
702
703 sigaction (i, NULL, &action);
704 if (!(action.sa_flags & SA_RESTART))
705 {
3efb80f2 706 action.sa_flags |= SA_RESTART;
840ae05d
JB
707 sigaction (i, &action, NULL);
708 }
709 }
7ee92fce
GH
710#endif
711 /* if neither siginterrupt nor SA_RESTART are available we may
712 as well assume that signals are always restartable. */
840ae05d 713#endif
e1a191a8 714 }
1cc91f1b 715
86d31dfe
MV
716 scm_c_define ("NSIG", scm_long2num (NSIG));
717 scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
718 scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
e1a191a8 719#ifdef SA_NOCLDSTOP
86d31dfe 720 scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
0f2d19dd 721#endif
e1a191a8 722#ifdef SA_RESTART
86d31dfe 723 scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
0f2d19dd 724#endif
1cc91f1b 725
53f8a0d2
RB
726#if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
727 /* Stuff needed by setitimer and getitimer. */
728 scm_c_define ("ITIMER_REAL", SCM_MAKINUM (ITIMER_REAL));
729 scm_c_define ("ITIMER_VIRTUAL", SCM_MAKINUM (ITIMER_VIRTUAL));
730 scm_c_define ("ITIMER_PROF", SCM_MAKINUM (ITIMER_PROF));
731#endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
732
a0599745 733#include "libguile/scmsigs.x"
0f2d19dd
JB
734}
735
89e00824
ML
736
737/*
738 Local Variables:
739 c-file-style: "gnu"
740 End:
741*/