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