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