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