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