libguile/scmsigs.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009, 2011, 2013 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   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.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  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
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21
  22 #ifdef HAVE_CONFIG_H
  23 #  include <config.h>
  24 #endif
  25
  26 #include <fcntl.h>      /* for mingw */
  27 #include <signal.h>
  28 #include <stdio.h>
  29 #include <errno.h>
  30
  31 #ifdef HAVE_PROCESS_H
  32 #include <process.h>    /* for mingw */
  33 #endif
  34
  35 #ifdef HAVE_UNISTD_H
  36 #include <unistd.h>
  37 #endif
  38
  39 #ifdef HAVE_SYS_TIME_H
  40 #include <sys/time.h>
  41 #endif
  42
  43 #include <full-write.h>
  44
  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
  56
  57 \f
  58
  59 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  60
  61 #ifdef RETSIGTYPE
  62 # define SIGRETTYPE RETSIGTYPE
  63 #else
  64 # ifdef STDC_HEADERS
  65 #  define SIGRETTYPE void
  66 # else
  67 #  define SIGRETTYPE int
  68 # endif
  69 #endif
  70
  71 \f
  72
  73 /* take_signal is installed as the C signal handler whenever a Scheme
  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 */
  81
  82
  83 /* Scheme vectors with information about a signal.  signal_handlers
  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
  87    signal_handler_threads points to the thread that a signal should be
  88    delivered to.
  89 */
  90 static SCM *signal_handlers;
  91 static SCM signal_handler_asyncs;
  92 static SCM signal_handler_threads;
  93
  94 /* The signal delivery thread.  */
  95 scm_i_thread *scm_i_signal_delivery_thread = NULL;
  96
  97 /* The mutex held when launching the signal delivery thread.  */
  98 static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
  99   SCM_I_PTHREAD_MUTEX_INITIALIZER;
 100
 101
 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
 105 static struct sigaction orig_handlers[NSIG];
 106 #else
 107 static SIGRETTYPE (*orig_handlers[NSIG])(int);
 108 #endif
 109
 110 static SCM
 111 close_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
 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.  */
 124
 125 static int signal_pipe[2];
 126
 127 static SIGRETTYPE
 128 take_signal (int signum)
 129 {
 130   char sigbyte = signum;
 131   full_write (signal_pipe[1], &sigbyte, 1);
 132
 133 #ifndef HAVE_SIGACTION
 134   signal (signum, take_signal);
 135 #endif
 136 }
 137
 138 struct signal_pipe_data
 139 {
 140   char sigbyte;
 141   ssize_t n;
 142   int err;
 143 };
 144
 145 static void*
 146 read_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
 156 static SCM
 157 signal_delivery_thread (void *data)
 158 {
 159   int sig;
 160 #if HAVE_PTHREAD_SIGMASK  /* not on mingw, see notes above */
 161   sigset_t all_sigs;
 162   sigfillset (&all_sigs);
 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 ());
 168   scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL);
 169 #endif
 170
 171   while (1)
 172     {
 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)
 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         }
 187       else if (sigdata.n == 0)
 188         break; /* the signal pipe was closed. */
 189       else if (sigdata.n < 0 && sigdata.err != EINTR)
 190         perror ("error in signal delivery thread");
 191     }
 192
 193   return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
 194 }
 195
 196 static void
 197 start_signal_delivery_thread (void)
 198 {
 199   SCM signal_thread;
 200
 201   scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
 202
 203   if (pipe2 (signal_pipe, O_CLOEXEC) != 0)
 204     scm_syserror (NULL);
 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);
 211 }
 212
 213 void
 214 scm_i_ensure_signal_delivery_thread ()
 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 }
 219
 220 #else /* !SCM_USE_PTHREAD_THREADS */
 221
 222 static SIGRETTYPE
 223 take_signal (int signum)
 224 {
 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)))
 229     {
 230       SCM_SETCDR (cell, t->active_asyncs);
 231       t->active_asyncs = cell;
 232       t->pending_asyncs = 1;
 233     }
 234
 235 #ifndef HAVE_SIGACTION
 236   signal (signum, take_signal);
 237 #endif
 238 }
 239
 240 void
 241 scm_i_ensure_signal_delivery_thread ()
 242 {
 243   return;
 244 }
 245
 246 #endif /* !SCM_USE_PTHREAD_THREADS */
 247
 248 static void
 249 install_handler (int signum, SCM thread, SCM handler)
 250 {
 251   if (scm_is_false (handler))
 252     {
 253       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
 254       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, SCM_BOOL_F);
 255     }
 256   else
 257     {
 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
 262       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
 263       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async);
 264     }
 265
 266   SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
 267 }
 268
 269 SCM
 270 scm_sigaction (SCM signum, SCM handler, SCM flags)
 271 {
 272   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 273 }
 274
 275 /* user interface for installation of signal handlers.  */
 276 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 277            (SCM signum, SCM handler, SCM flags, SCM thread),
 278             "Install or report the signal handler for a specified signal.\n\n"
 279             "@var{signum} is the signal number, which can be specified using the value\n"
 280             "of variables such as @code{SIGINT}.\n\n"
 281             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 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"
 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"
 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"
 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"
 295             "Flags can optionally be specified for the new handler.\n"
 296             "The return value is a pair with information about the\n"
 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.")
 302 #define FUNC_NAME s_scm_sigaction_for_thread
 303 {
 304   int csig;
 305 #ifdef HAVE_SIGACTION
 306   struct sigaction action;
 307   struct sigaction old_action;
 308 #else
 309   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 310   SIGRETTYPE (* old_chandler) (int);
 311 #endif
 312   int query_only = 0;
 313   int save_handler = 0;
 314
 315   SCM old_handler;
 316
 317   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 318
 319 #if defined(HAVE_SIGACTION)
 320   action.sa_flags = 0;
 321   if (!SCM_UNBNDP (flags))
 322     action.sa_flags |= scm_to_int (flags);
 323   sigemptyset (&action.sa_mask);
 324 #endif
 325
 326   if (SCM_UNBNDP (thread))
 327     thread = scm_current_thread ();
 328   else
 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     }
 334
 335   scm_i_ensure_signal_delivery_thread ();
 336
 337   SCM_CRITICAL_SECTION_START;
 338   old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
 339   if (SCM_UNBNDP (handler))
 340     query_only = 1;
 341   else if (scm_is_integer (handler))
 342     {
 343       long handler_int = scm_to_long (handler);
 344
 345       if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN)
 346         {
 347 #ifdef HAVE_SIGACTION
 348           action.sa_handler = (SIGRETTYPE (*) (int)) handler_int;
 349 #else
 350           chandler = (SIGRETTYPE (*) (int)) handler_int;
 351 #endif
 352           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 353         }
 354       else
 355         {
 356           SCM_CRITICAL_SECTION_END;
 357           SCM_OUT_OF_RANGE (2, handler);
 358         }
 359     }
 360   else if (scm_is_false (handler))
 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;
 370           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 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;
 379           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 380         }
 381 #endif
 382     }
 383   else
 384     {
 385       SCM_VALIDATE_PROC (2, handler);
 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
 395       install_handler (csig, thread, handler);
 396     }
 397
 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:
 409 #ifdef SIGBUS
 410     case SIGBUS:
 411 #endif
 412     case SIGABRT:
 413 #if defined(SIGIOT) && (SIGIOT != SIGABRT)
 414     case SIGIOT:
 415 #endif
 416 #ifdef SIGTRAP
 417     case SIGTRAP:
 418 #endif
 419 #ifdef SIGEMT
 420     case SIGEMT:
 421 #endif
 422 #ifdef SIGSYS
 423     case SIGSYS:
 424 #endif
 425       query_only = 1;
 426     }
 427
 428 #ifdef HAVE_SIGACTION
 429   if (query_only)
 430     {
 431       if (sigaction (csig, 0, &old_action) == -1)
 432         SCM_SYSERROR;
 433     }
 434   else
 435     {
 436       if (sigaction (csig, &action , &old_action) == -1)
 437         SCM_SYSERROR;
 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)
 442     old_handler = scm_from_long ((long) old_action.sa_handler);
 443   SCM_CRITICAL_SECTION_END;
 444   return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
 445 #else
 446   if (query_only)
 447     {
 448       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 449         SCM_SYSERROR;
 450       if (signal (csig, old_chandler) == SIG_ERR)
 451         SCM_SYSERROR;
 452     }
 453   else
 454     {
 455       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 456         SCM_SYSERROR;
 457       if (save_handler)
 458         orig_handlers[csig] = old_chandler;
 459     }
 460   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 461     old_handler = scm_from_long ((long) old_chandler);
 462   SCM_CRITICAL_SECTION_END;
 463   return scm_cons (old_handler, scm_from_int (0));
 464 #endif
 465 }
 466 #undef FUNC_NAME
 467
 468 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 469             (void),
 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.")
 472 #define FUNC_NAME s_scm_restore_signals
 473 {
 474   int i;
 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)
 481             SCM_SYSERROR;
 482           orig_handlers[i].sa_handler = SIG_ERR;
 483           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 484         }
 485 #else
 486       if (orig_handlers[i] != SIG_ERR)
 487         {
 488           if (signal (i, orig_handlers[i]) == SIG_ERR)
 489             SCM_SYSERROR;
 490           orig_handlers[i] = SIG_ERR;
 491           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 492         }
 493 #endif
 494     }
 495   return SCM_UNSPECIFIED;
 496 }
 497 #undef FUNC_NAME
 498
 499 #if defined HAVE_ALARM && HAVE_DECL_ALARM
 500 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 501            (SCM i),
 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.")
 510 #define FUNC_NAME s_scm_alarm
 511 {
 512   return scm_from_uint (alarm (scm_to_uint (i)));
 513 }
 514 #undef FUNC_NAME
 515 #endif /* HAVE_ALARM */
 516
 517 #ifdef HAVE_SETITIMER
 518 SCM_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"
 531             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 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"
 537             "the seconds and microseconds of the timer @code{it_value}.")
 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
 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)));
 560 }
 561 #undef FUNC_NAME
 562 #endif /* HAVE_SETITIMER */
 563
 564 #ifdef HAVE_GETITIMER
 565 SCM_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"
 572             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 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"
 578             "the seconds and microseconds of the timer @code{it_value}.")
 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
 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)));
 596 }
 597 #undef FUNC_NAME
 598 #endif /* HAVE_GETITIMER */
 599
 600 #ifdef HAVE_PAUSE
 601 SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 602            (),
 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.")
 606 #define FUNC_NAME s_scm_pause
 607 {
 608   pause ();
 609   return SCM_UNSPECIFIED;
 610 }
 611 #undef FUNC_NAME
 612 #endif
 613
 614 SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 615            (SCM i),
 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"
 618             "of seconds remaining otherwise.\n"
 619             "\n"
 620             "See also @code{usleep}.")
 621 #define FUNC_NAME s_scm_sleep
 622 {
 623   return scm_from_uint (scm_std_sleep (scm_to_uint (i)));
 624 }
 625 #undef FUNC_NAME
 626
 627 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 628            (SCM i),
 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}.")
 640 #define FUNC_NAME s_scm_usleep
 641 {
 642   return scm_from_ulong (scm_std_usleep (scm_to_ulong (i)));
 643 }
 644 #undef FUNC_NAME
 645
 646 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 647            (SCM sig),
 648             "Sends a specified signal @var{sig} to the current process, where\n"
 649             "@var{sig} is as described for the kill procedure.")
 650 #define FUNC_NAME s_scm_raise
 651 {
 652   if (raise (scm_to_int (sig)) != 0)
 653     SCM_SYSERROR;
 654   return SCM_UNSPECIFIED;
 655 }
 656 #undef FUNC_NAME
 657
 658 \f
 659
 660 void
 661 scm_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
 669 #if SCM_USE_PTHREAD_THREADS
 670   if (scm_i_signal_delivery_thread != NULL)
 671     close (signal_pipe[1]);
 672 #endif
 673
 674   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 675 }
 676
 677 void
 678 scm_init_scmsigs ()
 679 {
 680   int i;
 681
 682   signal_handlers =
 683     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 684                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 685   signal_handler_asyncs = scm_c_make_vector (NSIG, SCM_BOOL_F);
 686   signal_handler_threads = scm_c_make_vector (NSIG, SCM_BOOL_F);
 687
 688   for (i = 0; i < NSIG; i++)
 689     {
 690 #ifdef HAVE_SIGACTION
 691       orig_handlers[i].sa_handler = SIG_ERR;
 692
 693 #else
 694       orig_handlers[i] = SIG_ERR;
 695 #endif
 696     }
 697
 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));
 701 #ifdef SA_NOCLDSTOP
 702   scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
 703 #endif
 704 #ifdef SA_RESTART
 705   scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
 706 #endif
 707
 708 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 709   /* Stuff needed by setitimer and getitimer. */
 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));
 713 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 714
 715 #include "libguile/scmsigs.x"
 716 }
 717
 718
 719 /*
 720   Local Variables:
 721   c-file-style: "gnu"
 722   End:
 723 */