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