libguile/scmsigs.c

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