libguile/scmsigs.c

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