libguile/scmsigs.c

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