guile18/libguile/scmsigs.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007 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
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but 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 02110-1301 USA
  16  */
  17
  18
  19 \f
  20
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <fcntl.h>      /* for mingw */
  26 #include <signal.h>
  27 #include <stdio.h>
  28 #include <errno.h>
  29
  30 #include "libguile/_scm.h"
  31
  32 #include "libguile/async.h"
  33 #include "libguile/eval.h"
  34 #include "libguile/root.h"
  35 #include "libguile/vectors.h"
  36
  37 #include "libguile/validate.h"
  38 #include "libguile/scmsigs.h"
  39
  40 #ifdef HAVE_IO_H
  41 #include <io.h>  /* for mingw _pipe() */
  42 #endif
  43
  44 #ifdef HAVE_PROCESS_H
  45 #include <process.h>    /* for mingw */
  46 #endif
  47
  48 #ifdef HAVE_UNISTD_H
  49 #include <unistd.h>
  50 #endif
  51
  52 #ifdef HAVE_SYS_TIME_H
  53 #include <sys/time.h>
  54 #endif
  55
  56 #ifdef __MINGW32__
  57 #include <windows.h>
  58 #define alarm(sec) (0)
  59 /* This weird comma expression is because Sleep is void under Windows. */
  60 #define sleep(sec) (Sleep ((sec) * 1000), 0)
  61 #define usleep(usec) (Sleep ((usec) / 1000), 0)
  62 #define pipe(fd) _pipe (fd, 256, O_BINARY)
  63 #endif
  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 /* 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 handler_to_async (SCM handler, int signum)
 112 {
 113   if (scm_is_false (handler))
 114     return SCM_BOOL_F;
 115   else
 116     {
 117       SCM async = scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
 118                                                     scm_list_2 (handler,
 119                                                                 scm_from_int (signum))));
 120 #if !SCM_USE_PTHREAD_THREADS
 121       async = scm_cons (async, SCM_BOOL_F);
 122 #endif
 123       return async;
 124     }
 125 }
 126
 127 #if SCM_USE_PTHREAD_THREADS
 128 /* On mingw there's no notion of inter-process signals, only a raise()
 129    within the process itself which apparently invokes the registered handler
 130    immediately.  Not sure how well the following code will cope in this
 131    case.  It builds but it may not offer quite the same scheme-level
 132    semantics as on a proper system.  If you're relying on much in the way of
 133    signal handling on mingw you probably lose anyway.  */
 134
 135 static int signal_pipe[2];
 136
 137 static SIGRETTYPE
 138 take_signal (int signum)
 139 {
 140   size_t count;
 141   char sigbyte = signum;
 142
 143   count = write (signal_pipe[1], &sigbyte, 1);
 144
 145 #ifndef HAVE_SIGACTION
 146   signal (signum, take_signal);
 147 #endif
 148 }
 149
 150 typedef struct {
 151   ssize_t res;
 152   int fd;
 153   char *buf;
 154   size_t n;
 155 } read_without_guile_data;
 156
 157 static void *
 158 do_read_without_guile (void *raw_data)
 159 {
 160   read_without_guile_data *data = (read_without_guile_data *)raw_data;
 161   data->res = read (data->fd, data->buf, data->n);
 162   return NULL;
 163 }
 164
 165 static ssize_t
 166 read_without_guile (int fd, char *buf, size_t n)
 167 {
 168   read_without_guile_data data;
 169   data.fd = fd;
 170   data.buf = buf;
 171   data.n = n;
 172   scm_without_guile (do_read_without_guile, &data);
 173   return data.res;
 174 }
 175
 176 static SCM
 177 signal_delivery_thread (void *data)
 178 {
 179   int n, sig;
 180   char sigbyte;
 181 #if HAVE_PTHREAD_SIGMASK  /* not on mingw, see notes above */
 182   sigset_t all_sigs;
 183   sigfillset (&all_sigs);
 184   scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL);
 185 #endif
 186
 187   while (1)
 188     {
 189       n = read_without_guile (signal_pipe[0], &sigbyte, 1);
 190       sig = sigbyte;
 191       if (n == 1 && sig >= 0 && sig < NSIG)
 192         {
 193           SCM h, t;
 194
 195           h = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig);
 196           t = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig);
 197           if (scm_is_true (h))
 198             scm_system_async_mark_for_thread (h, t);
 199         }
 200       else if (n < 0 && errno != EINTR)
 201         perror ("error in signal delivery thread");
 202     }
 203
 204   return SCM_UNSPECIFIED;       /* not reached */
 205 }
 206
 207 static void
 208 start_signal_delivery_thread (void)
 209 {
 210   if (pipe (signal_pipe) != 0)
 211     scm_syserror (NULL);
 212   scm_spawn_thread (signal_delivery_thread, NULL,
 213                     scm_handle_by_message, "signal delivery thread");
 214 }
 215
 216 static void
 217 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 static void
 244 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, SCM async)
 253 {
 254   SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
 255   SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async);
 256   SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
 257 }
 258
 259 SCM
 260 scm_sigaction (SCM signum, SCM handler, SCM flags)
 261 {
 262   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 263 }
 264
 265 /* user interface for installation of signal handlers.  */
 266 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 267            (SCM signum, SCM handler, SCM flags, SCM thread),
 268             "Install or report the signal handler for a specified signal.\n\n"
 269             "@var{signum} is the signal number, which can be specified using the value\n"
 270             "of variables such as @code{SIGINT}.\n\n"
 271             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 272             "CAR is the current\n"
 273             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 274             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 275             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 276             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 277             "If @var{handler} is provided, it is installed as the new handler for\n"
 278             "@var{signum}.  @var{handler} can be a Scheme procedure taking one\n"
 279             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 280             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 281             "was installed before @code{sigaction} was first used.  When\n"
 282             "a scheme procedure has been specified, that procedure will run\n"
 283             "in the given @var{thread}.   When no thread has been given, the\n"
 284             "thread that made this call to @code{sigaction} is used.\n"
 285             "Flags can optionally be specified for the new handler.\n"
 286             "The return value is a pair with information about the\n"
 287             "old handler as described above.\n\n"
 288             "This interface does not provide access to the \"signal blocking\"\n"
 289             "facility.  Maybe this is not needed, since the thread support may\n"
 290             "provide solutions to the problem of consistent access to data\n"
 291             "structures.")
 292 #define FUNC_NAME s_scm_sigaction_for_thread
 293 {
 294   int csig;
 295 #ifdef HAVE_SIGACTION
 296   struct sigaction action;
 297   struct sigaction old_action;
 298 #else
 299   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 300   SIGRETTYPE (* old_chandler) (int);
 301 #endif
 302   int query_only = 0;
 303   int save_handler = 0;
 304
 305   SCM old_handler;
 306   SCM async;
 307
 308   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 309
 310 #if defined(HAVE_SIGACTION)
 311   action.sa_flags = 0;
 312   if (!SCM_UNBNDP (flags))
 313     action.sa_flags |= scm_to_int (flags);
 314   sigemptyset (&action.sa_mask);
 315 #endif
 316
 317   if (SCM_UNBNDP (thread))
 318     thread = scm_current_thread ();
 319   else
 320     {
 321       SCM_VALIDATE_THREAD (4, thread);
 322       if (scm_c_thread_exited_p (thread))
 323         SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
 324     }
 325
 326   /* Allocate upfront, as we can't do it inside the critical
 327      section. */
 328   async = handler_to_async (handler, csig);
 329
 330   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, async);
 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, async);
 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, async);
 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, async);
 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 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
 510 #ifdef HAVE_SETITIMER
 511 SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
 512            (SCM which_timer,
 513             SCM interval_seconds, SCM interval_microseconds,
 514             SCM value_seconds, SCM value_microseconds),
 515             "Set the timer specified by @var{which_timer} according to the given\n"
 516             "@var{interval_seconds}, @var{interval_microseconds},\n"
 517             "@var{value_seconds}, and @var{value_microseconds} values.\n"
 518             "\n"
 519             "Return information about the timer's previous setting."
 520             "\n"
 521             "Errors are handled as described in the guile info pages under ``POSIX\n"
 522             "Interface Conventions''.\n"
 523             "\n"
 524             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 525             "and @code{ITIMER_PROF}.\n"
 526             "\n"
 527             "The return value will be a list of two cons pairs representing the\n"
 528             "current state of the given timer.  The first pair is the seconds and\n"
 529             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 530             "the seconds and microseconds of the timer @code{it_value}.")
 531 #define FUNC_NAME s_scm_setitimer
 532 {
 533   int rv;
 534   int c_which_timer;
 535   struct itimerval new_timer;
 536   struct itimerval old_timer;
 537
 538   c_which_timer = SCM_NUM2INT(1, which_timer);
 539   new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
 540   new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
 541   new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
 542   new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
 543
 544   SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
 545
 546   if(rv != 0)
 547     SCM_SYSERROR;
 548
 549   return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
 550                                scm_from_long (old_timer.it_interval.tv_usec)),
 551                      scm_cons (scm_from_long (old_timer.it_value.tv_sec),
 552                                scm_from_long (old_timer.it_value.tv_usec)));
 553 }
 554 #undef FUNC_NAME
 555 #endif /* HAVE_SETITIMER */
 556
 557 #ifdef HAVE_GETITIMER
 558 SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
 559   (SCM which_timer),
 560             "Return information about the timer specified by @var{which_timer}"
 561             "\n"
 562             "Errors are handled as described in the guile info pages under ``POSIX\n"
 563             "Interface Conventions''.\n"
 564             "\n"
 565             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 566             "and @code{ITIMER_PROF}.\n"
 567             "\n"
 568             "The return value will be a list of two cons pairs representing the\n"
 569             "current state of the given timer.  The first pair is the seconds and\n"
 570             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 571             "the seconds and microseconds of the timer @code{it_value}.")
 572 #define FUNC_NAME s_scm_getitimer
 573 {
 574   int rv;
 575   int c_which_timer;
 576   struct itimerval old_timer;
 577
 578   c_which_timer = SCM_NUM2INT(1, which_timer);
 579
 580   SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
 581
 582   if(rv != 0)
 583     SCM_SYSERROR;
 584
 585   return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
 586                                scm_from_long (old_timer.it_interval.tv_usec)),
 587                      scm_cons (scm_from_long (old_timer.it_value.tv_sec),
 588                                scm_from_long (old_timer.it_value.tv_usec)));
 589 }
 590 #undef FUNC_NAME
 591 #endif /* HAVE_GETITIMER */
 592
 593 #ifdef HAVE_PAUSE
 594 SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 595            (),
 596             "Pause the current process (thread?) until a signal arrives whose\n"
 597             "action is to either terminate the current process or invoke a\n"
 598             "handler procedure.  The return value is unspecified.")
 599 #define FUNC_NAME s_scm_pause
 600 {
 601   pause ();
 602   return SCM_UNSPECIFIED;
 603 }
 604 #undef FUNC_NAME
 605 #endif
 606
 607 SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 608            (SCM i),
 609             "Wait for the given number of seconds (an integer) or until a signal\n"
 610             "arrives.  The return value is zero if the time elapses or the number\n"
 611             "of seconds remaining otherwise.\n"
 612             "\n"
 613             "See also @code{usleep}.")
 614 #define FUNC_NAME s_scm_sleep
 615 {
 616   return scm_from_uint (scm_std_sleep (scm_to_uint (i)));
 617 }
 618 #undef FUNC_NAME
 619
 620 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 621            (SCM i),
 622             "Wait the given period @var{usecs} microseconds (an integer).\n"
 623             "If a signal arrives the wait stops and the return value is the\n"
 624             "time remaining, in microseconds.  If the period elapses with no\n"
 625             "signal the return is zero.\n"
 626             "\n"
 627             "On most systems the process scheduler is not microsecond accurate and\n"
 628             "the actual period slept by @code{usleep} may be rounded to a system\n"
 629             "clock tick boundary.  Traditionally such ticks were 10 milliseconds\n"
 630             "apart, and that interval is often still used.\n"
 631             "\n"
 632             "See also @code{sleep}.")
 633 #define FUNC_NAME s_scm_usleep
 634 {
 635   return scm_from_ulong (scm_std_usleep (scm_to_ulong (i)));
 636 }
 637 #undef FUNC_NAME
 638
 639 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 640            (SCM sig),
 641             "Sends a specified signal @var{sig} to the current process, where\n"
 642             "@var{sig} is as described for the kill procedure.")
 643 #define FUNC_NAME s_scm_raise
 644 {
 645   if (raise (scm_to_int (sig)) != 0)
 646     SCM_SYSERROR;
 647   return SCM_UNSPECIFIED;
 648 }
 649 #undef FUNC_NAME
 650
 651 \f
 652
 653 void
 654 scm_init_scmsigs ()
 655 {
 656   int i;
 657
 658   signal_handlers =
 659     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 660                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 661   signal_handler_asyncs =
 662     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 663   signal_handler_threads =
 664     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 665
 666   for (i = 0; i < NSIG; i++)
 667     {
 668 #ifdef HAVE_SIGACTION
 669       orig_handlers[i].sa_handler = SIG_ERR;
 670
 671 #else
 672       orig_handlers[i] = SIG_ERR;
 673 #endif
 674     }
 675
 676   scm_c_define ("NSIG", scm_from_long (NSIG));
 677   scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN));
 678   scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL));
 679 #ifdef SA_NOCLDSTOP
 680   scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
 681 #endif
 682 #ifdef SA_RESTART
 683   scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
 684 #endif
 685
 686 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 687   /* Stuff needed by setitimer and getitimer. */
 688   scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
 689   scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
 690   scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
 691 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 692
 693 #include "libguile/scmsigs.x"
 694 }
 695
 696
 697 /*
 698   Local Variables:
 699   c-file-style: "gnu"
 700   End:
 701 */