libguile/scmsigs.c

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