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 #if 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 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   write (signal_pipe[1], &sigbyte, 1);
 132
 133 #ifndef HAVE_SIGACTION
 134   signal (signum, take_signal);
 135 #endif
 136 }
 137
 138 typedef struct {
 139   ssize_t res;
 140   int fd;
 141   char *buf;
 142   size_t n;
 143 } read_without_guile_data;
 144
 145 static void *
 146 do_read_without_guile (void *raw_data)
 147 {
 148   read_without_guile_data *data = (read_without_guile_data *)raw_data;
 149   data->res = read (data->fd, data->buf, data->n);
 150   return NULL;
 151 }
 152
 153 static ssize_t
 154 read_without_guile (int fd, char *buf, size_t n)
 155 {
 156   read_without_guile_data data;
 157   data.fd = fd;
 158   data.buf = buf;
 159   data.n = n;
 160   scm_without_guile (do_read_without_guile, &data);
 161   return data.res;
 162 }
 163
 164 static SCM
 165 signal_delivery_thread (void *data)
 166 {
 167   int n, sig;
 168   char sigbyte;
 169 #if HAVE_PTHREAD_SIGMASK  /* not on mingw, see notes above */
 170   sigset_t all_sigs;
 171   sigfillset (&all_sigs);
 172   scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL);
 173 #endif
 174
 175   while (1)
 176     {
 177       n = read_without_guile (signal_pipe[0], &sigbyte, 1);
 178       sig = sigbyte;
 179       if (n == 1 && sig >= 0 && sig < NSIG)
 180         {
 181           SCM h, t;
 182
 183           h = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig);
 184           t = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig);
 185           if (scm_is_true (h))
 186             scm_system_async_mark_for_thread (h, t);
 187         }
 188       else if (n < 0 && errno != EINTR)
 189         perror ("error in signal delivery thread");
 190     }
 191
 192   return SCM_UNSPECIFIED;       /* not reached */
 193 }
 194
 195 static void
 196 start_signal_delivery_thread (void)
 197 {
 198   if (pipe (signal_pipe) != 0)
 199     scm_syserror (NULL);
 200   scm_spawn_thread (signal_delivery_thread, NULL,
 201                     scm_handle_by_message, "signal delivery thread");
 202 }
 203
 204 static void
 205 ensure_signal_delivery_thread ()
 206 {
 207   static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
 208   scm_i_pthread_once (&once, start_signal_delivery_thread);
 209 }
 210
 211 #else /* !SCM_USE_PTHREAD_THREADS */
 212
 213 static SIGRETTYPE
 214 take_signal (int signum)
 215 {
 216   SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, signum);
 217   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 218
 219   if (scm_is_false (SCM_CDR (cell)))
 220     {
 221       SCM_SETCDR (cell, t->active_asyncs);
 222       t->active_asyncs = cell;
 223       t->pending_asyncs = 1;
 224     }
 225
 226 #ifndef HAVE_SIGACTION
 227   signal (signum, take_signal);
 228 #endif
 229 }
 230
 231 static void
 232 ensure_signal_delivery_thread ()
 233 {
 234   return;
 235 }
 236
 237 #endif /* !SCM_USE_PTHREAD_THREADS */
 238
 239 static void
 240 install_handler (int signum, SCM thread, SCM handler)
 241 {
 242   if (scm_is_false (handler))
 243     {
 244       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
 245       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, SCM_BOOL_F);
 246     }
 247   else
 248     {
 249       SCM async = close_1 (handler, scm_from_int (signum));
 250 #if !SCM_USE_PTHREAD_THREADS
 251       async = scm_cons (async, SCM_BOOL_F);
 252 #endif
 253       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
 254       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async);
 255     }
 256
 257   SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
 258 }
 259
 260 SCM
 261 scm_sigaction (SCM signum, SCM handler, SCM flags)
 262 {
 263   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 264 }
 265
 266 /* user interface for installation of signal handlers.  */
 267 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 268            (SCM signum, SCM handler, SCM flags, SCM thread),
 269             "Install or report the signal handler for a specified signal.\n\n"
 270             "@var{signum} is the signal number, which can be specified using the value\n"
 271             "of variables such as @code{SIGINT}.\n\n"
 272             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 273             "CAR is the current\n"
 274             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 275             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 276             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 277             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 278             "If @var{handler} is provided, it is installed as the new handler for\n"
 279             "@var{signum}.  @var{handler} can be a Scheme procedure taking one\n"
 280             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 281             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 282             "was installed before @code{sigaction} was first used.  When\n"
 283             "a scheme procedure has been specified, that procedure will run\n"
 284             "in the given @var{thread}.   When no thread has been given, the\n"
 285             "thread that made this call to @code{sigaction} is used.\n"
 286             "Flags can "
 287             "optionally be specified for the new handler (@code{SA_RESTART} will\n"
 288             "always be added if it's available and the system is using restartable\n"
 289             "system calls.)  The return value is a pair with information about the\n"
 290             "old handler as described above.\n\n"
 291             "This interface does not provide access to the \"signal blocking\"\n"
 292             "facility.  Maybe this is not needed, since the thread support may\n"
 293             "provide solutions to the problem of consistent access to data\n"
 294             "structures.")
 295 #define FUNC_NAME s_scm_sigaction_for_thread
 296 {
 297   int csig;
 298 #ifdef HAVE_SIGACTION
 299   struct sigaction action;
 300   struct sigaction old_action;
 301 #else
 302   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 303   SIGRETTYPE (* old_chandler) (int);
 304 #endif
 305   int query_only = 0;
 306   int save_handler = 0;
 307
 308   SCM old_handler;
 309
 310   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 311
 312 #if defined(HAVE_SIGACTION)
 313 #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
 314   /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
 315      is defined, since libguile would be likely to produce spurious
 316      EINTR errors.  */
 317   action.sa_flags = SA_RESTART;
 318 #else
 319   action.sa_flags = 0;
 320 #endif
 321   if (!SCM_UNBNDP (flags))
 322     action.sa_flags |= scm_to_int (flags);
 323   sigemptyset (&action.sa_mask);
 324 #endif
 325
 326   if (SCM_UNBNDP (thread))
 327     thread = scm_current_thread ();
 328   else
 329     {
 330       SCM_VALIDATE_THREAD (4, thread);
 331       if (scm_c_thread_exited_p (thread))
 332         SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
 333     }
 334
 335   ensure_signal_delivery_thread ();
 336
 337   SCM_CRITICAL_SECTION_START;
 338   old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
 339   if (SCM_UNBNDP (handler))
 340     query_only = 1;
 341   else if (scm_is_integer (handler))
 342     {
 343       long handler_int = scm_to_long (handler);
 344
 345       if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN)
 346         {
 347 #ifdef HAVE_SIGACTION
 348           action.sa_handler = (SIGRETTYPE (*) (int)) handler_int;
 349 #else
 350           chandler = (SIGRETTYPE (*) (int)) handler_int;
 351 #endif
 352           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 353         }
 354       else
 355         SCM_OUT_OF_RANGE (2, handler);
 356     }
 357   else if (scm_is_false (handler))
 358     {
 359       /* restore the default handler.  */
 360 #ifdef HAVE_SIGACTION
 361       if (orig_handlers[csig].sa_handler == SIG_ERR)
 362         query_only = 1;
 363       else
 364         {
 365           action = orig_handlers[csig];
 366           orig_handlers[csig].sa_handler = SIG_ERR;
 367           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 368         }
 369 #else
 370       if (orig_handlers[csig] == SIG_ERR)
 371         query_only = 1;
 372       else
 373         {
 374           chandler = orig_handlers[csig];
 375           orig_handlers[csig] = SIG_ERR;
 376           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 377         }
 378 #endif
 379     }
 380   else
 381     {
 382       SCM_VALIDATE_PROC (2, handler);
 383 #ifdef HAVE_SIGACTION
 384       action.sa_handler = take_signal;
 385       if (orig_handlers[csig].sa_handler == SIG_ERR)
 386         save_handler = 1;
 387 #else
 388       chandler = take_signal;
 389       if (orig_handlers[csig] == SIG_ERR)
 390         save_handler = 1;
 391 #endif
 392       install_handler (csig, thread, handler);
 393     }
 394
 395   /* XXX - Silently ignore setting handlers for `program error signals'
 396      because they can't currently be handled by Scheme code.
 397   */
 398
 399   switch (csig)
 400     {
 401       /* This list of program error signals is from the GNU Libc
 402          Reference Manual */
 403     case SIGFPE:
 404     case SIGILL:
 405     case SIGSEGV:
 406 #ifdef SIGBUS
 407     case SIGBUS:
 408 #endif
 409     case SIGABRT:
 410 #if defined(SIGIOT) && (SIGIOT != SIGABRT)
 411     case SIGIOT:
 412 #endif
 413 #ifdef SIGTRAP
 414     case SIGTRAP:
 415 #endif
 416 #ifdef SIGEMT
 417     case SIGEMT:
 418 #endif
 419 #ifdef SIGSYS
 420     case SIGSYS:
 421 #endif
 422       query_only = 1;
 423     }
 424
 425 #ifdef HAVE_SIGACTION
 426   if (query_only)
 427     {
 428       if (sigaction (csig, 0, &old_action) == -1)
 429         SCM_SYSERROR;
 430     }
 431   else
 432     {
 433       if (sigaction (csig, &action , &old_action) == -1)
 434         SCM_SYSERROR;
 435       if (save_handler)
 436         orig_handlers[csig] = old_action;
 437     }
 438   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 439     old_handler = scm_from_long ((long) old_action.sa_handler);
 440   SCM_CRITICAL_SECTION_END;
 441   return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
 442 #else
 443   if (query_only)
 444     {
 445       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 446         SCM_SYSERROR;
 447       if (signal (csig, old_chandler) == SIG_ERR)
 448         SCM_SYSERROR;
 449     }
 450   else
 451     {
 452       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 453         SCM_SYSERROR;
 454       if (save_handler)
 455         orig_handlers[csig] = old_chandler;
 456     }
 457   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 458     old_handler = scm_from_long ((long) old_chandler);
 459   SCM_CRITICAL_SECTION_END;
 460   return scm_cons (old_handler, scm_from_int (0));
 461 #endif
 462 }
 463 #undef FUNC_NAME
 464
 465 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 466             (void),
 467             "Return all signal handlers to the values they had before any call to\n"
 468             "@code{sigaction} was made.  The return value is unspecified.")
 469 #define FUNC_NAME s_scm_restore_signals
 470 {
 471   int i;
 472   for (i = 0; i < NSIG; i++)
 473     {
 474 #ifdef HAVE_SIGACTION
 475       if (orig_handlers[i].sa_handler != SIG_ERR)
 476         {
 477           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 478             SCM_SYSERROR;
 479           orig_handlers[i].sa_handler = SIG_ERR;
 480           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 481         }
 482 #else
 483       if (orig_handlers[i] != SIG_ERR)
 484         {
 485           if (signal (i, orig_handlers[i]) == SIG_ERR)
 486             SCM_SYSERROR;
 487           orig_handlers[i] = SIG_ERR;
 488           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 489         }
 490 #endif
 491     }
 492   return SCM_UNSPECIFIED;
 493 }
 494 #undef FUNC_NAME
 495
 496 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 497            (SCM i),
 498             "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
 499             "number of seconds (an integer).  It's advisable to install a signal\n"
 500             "handler for\n"
 501             "@code{SIGALRM} beforehand, since the default action is to terminate\n"
 502             "the process.\n\n"
 503             "The return value indicates the time remaining for the previous alarm,\n"
 504             "if any.  The new value replaces the previous alarm.  If there was\n"
 505             "no previous alarm, the return value is zero.")
 506 #define FUNC_NAME s_scm_alarm
 507 {
 508   return scm_from_uint (alarm (scm_to_uint (i)));
 509 }
 510 #undef FUNC_NAME
 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_init_scmsigs ()
 657 {
 658   int i;
 659
 660   signal_handlers =
 661     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 662                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 663   signal_handler_asyncs =
 664     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 665   signal_handler_threads =
 666     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 667
 668   for (i = 0; i < NSIG; i++)
 669     {
 670 #ifdef HAVE_SIGACTION
 671       orig_handlers[i].sa_handler = SIG_ERR;
 672
 673 #else
 674       orig_handlers[i] = SIG_ERR;
 675 #endif
 676
 677 #ifdef HAVE_RESTARTABLE_SYSCALLS
 678       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
 679          signals really are restartable.  don't rely on the same
 680          run-time that configure got: reset the default for every signal.
 681       */
 682 #ifdef HAVE_SIGINTERRUPT
 683       siginterrupt (i, 0);
 684 #elif defined(SA_RESTART)
 685       {
 686         struct sigaction action;
 687
 688         sigaction (i, NULL, &action);
 689         if (!(action.sa_flags & SA_RESTART))
 690           {
 691             action.sa_flags |= SA_RESTART;
 692             sigaction (i, &action, NULL);
 693           }
 694       }
 695 #endif
 696       /* if neither siginterrupt nor SA_RESTART are available we may
 697          as well assume that signals are always restartable.  */
 698 #endif
 699     }
 700
 701   scm_c_define ("NSIG", scm_from_long (NSIG));
 702   scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN));
 703   scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL));
 704 #ifdef SA_NOCLDSTOP
 705   scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
 706 #endif
 707 #ifdef SA_RESTART
 708   scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
 709 #endif
 710
 711 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 712   /* Stuff needed by setitimer and getitimer. */
 713   scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
 714   scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
 715   scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
 716 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 717
 718 #include "libguile/scmsigs.x"
 719 }
 720
 721
 722 /*
 723   Local Variables:
 724   c-file-style: "gnu"
 725   End:
 726 */