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