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