libguile/scmsigs.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16  */
  17
  18
  19 \f
  20
  21 #if HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <signal.h>
  26 #include <errno.h>
  27
  28 #include "libguile/_scm.h"
  29
  30 #include "libguile/async.h"
  31 #include "libguile/eval.h"
  32 #include "libguile/root.h"
  33 #include "libguile/vectors.h"
  34
  35 #include "libguile/validate.h"
  36 #include "libguile/scmsigs.h"
  37
  38 #ifdef HAVE_UNISTD_H
  39 #include <unistd.h>
  40 #endif
  41
  42 #ifdef HAVE_SYS_TIME_H
  43 #include <sys/time.h>
  44 #endif
  45
  46 #ifdef __MINGW32__
  47 #include <windows.h>
  48 #define alarm(sec) (0)
  49 /* This weird comma expression is because Sleep is void under Windows. */
  50 #define sleep(sec) (Sleep ((sec) * 1000), 0)
  51 #define usleep(usec) (Sleep ((usec) / 1000), 0)
  52 #define kill(pid, sig) raise (sig)
  53 #endif
  54
  55 \f
  56
  57 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  58
  59 #ifdef RETSIGTYPE
  60 # define SIGRETTYPE RETSIGTYPE
  61 #else
  62 # ifdef STDC_HEADERS
  63 #  define SIGRETTYPE void
  64 # else
  65 #  define SIGRETTYPE int
  66 # endif
  67 #endif
  68
  69 \f
  70
  71 /* take_signal is installed as the C signal handler whenever a Scheme
  72    handler is set.  when a signal arrives, take_signal will queue the
  73    Scheme handler procedure for its thread.  */
  74
  75
  76 /* Scheme vectors with information about a signal.  signal_handlers
  77    contains the handler procedure or #f, signal_handler_cells contains
  78    pre-queued cells for the handler (since we can't do fancy things
  79    during signal delivery), signal_cell_handlers contains the SCM
  80    value to be stuffed into the pre-queued cell upon delivery, and
  81    signal_handler_threads points to the thread that a signal should be
  82    delivered to.
  83 */
  84 static SCM *signal_handlers;
  85 static SCM signal_handler_cells;
  86 static SCM signal_cell_handlers;
  87 static SCM signal_handler_threads;
  88
  89 /* saves the original C handlers, when a new handler is installed.
  90    set to SIG_ERR if the original handler is installed.  */
  91 #ifdef HAVE_SIGACTION
  92 static struct sigaction orig_handlers[NSIG];
  93 #else
  94 static SIGRETTYPE (*orig_handlers[NSIG])(int);
  95 #endif
  96
  97
  98 static SIGRETTYPE
  99 take_signal (int signum)
 100 {
 101   if (signum >= 0 && signum < NSIG)
 102     {
 103       SCM cell = SCM_VECTOR_REF(signal_handler_cells, signum);
 104       SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
 105       SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
 106       scm_root_state *root = scm_i_thread_root (thread);
 107       if (SCM_CONSP (cell))
 108         {
 109           SCM_SETCAR (cell, handler);
 110           root->pending_asyncs = 1;
 111         }
 112     }
 113
 114 #ifndef HAVE_SIGACTION
 115   signal (signum, take_signal);
 116 #endif
 117 }
 118
 119 SCM
 120 scm_sigaction (SCM signum, SCM handler, SCM flags)
 121 {
 122   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 123 }
 124
 125 static SCM
 126 close_1 (SCM proc, SCM arg)
 127 {
 128   return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
 129                                            scm_list_2 (proc, arg)));
 130 }
 131
 132 /* Make sure that signal SIGNUM can be delivered to THREAD, using
 133    HANDLER.  THREAD and HANDLER must either both be non-#f (which
 134    means install the handler), or both #f (which means deinstall an
 135    existing handler).
 136 */
 137
 138 struct install_handler_data {
 139   int signum;
 140   SCM thread;
 141   SCM handler;
 142 };
 143
 144 static SCM
 145 scm_delq_spine_x (SCM cell, SCM list)
 146 {
 147   SCM s = list, prev = SCM_BOOL_F;
 148
 149   while (!SCM_EQ_P (cell, s))
 150     {
 151       if (SCM_NULLP (s))
 152         return list;
 153       prev = s;
 154       s = SCM_CDR (s);
 155     }
 156   if (SCM_FALSEP (prev))
 157     return SCM_CDR (cell);
 158   else
 159     {
 160       SCM_SETCDR (prev, SCM_CDR (cell));
 161       return list;
 162     }
 163 }
 164
 165 static void *
 166 really_install_handler (void *data)
 167 {
 168   struct install_handler_data *args = data;
 169   int signum = args->signum;
 170   SCM thread = args->thread;
 171   SCM handler = args->handler;
 172   SCM cell;
 173   SCM old_thread;
 174
 175   /* The following modifications are done while signals can be
 176      delivered.  That is not a real problem since the signal handler
 177      will only touch the car of the handler cell and set the
 178      pending_asyncs trigger of a thread.  While the data structures
 179      are in flux, the signal handler might store the wrong handler in
 180      the cell, or set pending_asyncs of the wrong thread.  We fix this
 181      at the end by making sure that the cell has the right handler in
 182      it, if any, and that pending_asyncs is set for the new thread.
 183   */
 184
 185   /* Make sure we have a cell. */
 186   cell = SCM_VECTOR_REF (signal_handler_cells, signum);
 187   if (SCM_FALSEP (cell))
 188     {
 189       cell = scm_cons (SCM_BOOL_F, SCM_EOL);
 190       SCM_VECTOR_SET (signal_handler_cells, signum, cell);
 191     }
 192
 193   /* Make sure it is queued for the right thread. */
 194   old_thread = SCM_VECTOR_REF (signal_handler_threads, signum);
 195   if (!SCM_EQ_P (thread, old_thread))
 196     {
 197       scm_root_state *r;
 198       if (!SCM_FALSEP (old_thread))
 199         {
 200           r = scm_i_thread_root (old_thread);
 201           r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs);
 202         }
 203       if (!SCM_FALSEP (thread))
 204         {
 205           r = scm_i_thread_root (thread);
 206           SCM_SETCDR (cell, r->signal_asyncs);
 207           r->signal_asyncs = cell;
 208           /* Set pending_asyncs just in case.  A signal that is
 209              delivered while we modify the data structures here might set
 210              pending_asyncs of old_thread. */
 211           r->pending_asyncs = 1;
 212         }
 213       SCM_VECTOR_SET (signal_handler_threads, signum, thread);
 214     }
 215
 216   /* Set the new handler. */
 217   if (SCM_FALSEP (handler))
 218     {
 219       SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
 220       SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
 221     }
 222   else
 223     {
 224       SCM_VECTOR_SET (*signal_handlers, signum, handler);
 225       SCM_VECTOR_SET (signal_cell_handlers, signum,
 226                       close_1 (handler, scm_int2num (signum)));
 227     }
 228
 229   /* Now fix up the cell.  It might contain the old handler but since
 230      it is now queued for the new thread, we must make sure that the
 231      new handler is run.  Any signal that is delivered during the
 232      following code will install the new handler, so we have no
 233      problem.
 234   */
 235   if (!SCM_FALSEP (SCM_CAR (cell)))
 236     SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
 237
 238   /* Phfew.  That should be it. */
 239   return NULL;
 240 }
 241
 242 static void
 243 install_handler (int signum, SCM thread, SCM handler)
 244 {
 245   /* We block asyncs while installing the handler.  It would be safe
 246      to leave them on, but we might run the wrong handler should a
 247      signal be delivered.
 248   */
 249
 250   struct install_handler_data args;
 251   args.signum = signum;
 252   args.thread = thread;
 253   args.handler = handler;
 254   scm_c_call_with_blocked_asyncs (really_install_handler, &args);
 255 }
 256
 257 /* user interface for installation of signal handlers.  */
 258 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 259            (SCM signum, SCM handler, SCM flags, SCM thread),
 260             "Install or report the signal handler for a specified signal.\n\n"
 261             "@var{signum} is the signal number, which can be specified using the value\n"
 262             "of variables such as @code{SIGINT}.\n\n"
 263             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 264             "CAR is the current\n"
 265             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 266             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 267             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 268             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 269             "If @var{handler} is provided, it is installed as the new handler for\n"
 270             "@var{signum}.  @var{handler} can be a Scheme procedure taking one\n"
 271             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 272             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 273             "was installed before @code{sigaction} was first used.  When\n"
 274             "a scheme procedure has been specified, that procedure will run\n"
 275             "in the given @var{thread}.   When no thread has been given, the\n"
 276             "thread that made this call to @code{sigaction} is used.\n"
 277             "Flags can "
 278             "optionally be specified for the new handler (@code{SA_RESTART} will\n"
 279             "always be added if it's available and the system is using restartable\n"
 280             "system calls.)  The return value is a pair with information about the\n"
 281             "old handler as described above.\n\n"
 282             "This interface does not provide access to the \"signal blocking\"\n"
 283             "facility.  Maybe this is not needed, since the thread support may\n"
 284             "provide solutions to the problem of consistent access to data\n"
 285             "structures.")
 286 #define FUNC_NAME s_scm_sigaction_for_thread
 287 {
 288   int csig;
 289 #ifdef HAVE_SIGACTION
 290   struct sigaction action;
 291   struct sigaction old_action;
 292 #else
 293   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 294   SIGRETTYPE (* old_chandler) (int);
 295 #endif
 296   int query_only = 0;
 297   int save_handler = 0;
 298
 299   SCM old_handler;
 300
 301   SCM_VALIDATE_INUM_COPY (1, signum, csig);
 302   if (csig < 0 || csig >= NSIG)
 303     SCM_OUT_OF_RANGE (1, signum);
 304 #if defined(HAVE_SIGACTION)
 305 #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
 306   /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
 307      is defined, since libguile would be likely to produce spurious
 308      EINTR errors.  */
 309   action.sa_flags = SA_RESTART;
 310 #else
 311   action.sa_flags = 0;
 312 #endif
 313   if (!SCM_UNBNDP (flags))
 314     {
 315       SCM_VALIDATE_INUM (3, flags);
 316       action.sa_flags |= SCM_INUM (flags);
 317     }
 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_DEFER_INTS;
 331   old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
 332   if (SCM_UNBNDP (handler))
 333     query_only = 1;
 334   else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
 335     {
 336       if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL
 337           || SCM_NUM2LONG (2, handler) == (long) SIG_IGN)
 338         {
 339 #ifdef HAVE_SIGACTION
 340           action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 341 #else
 342           chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 343 #endif
 344           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 345         }
 346       else
 347         SCM_OUT_OF_RANGE (2, handler);
 348     }
 349   else if (SCM_FALSEP (handler))
 350     {
 351       /* restore the default handler.  */
 352 #ifdef HAVE_SIGACTION
 353       if (orig_handlers[csig].sa_handler == SIG_ERR)
 354         query_only = 1;
 355       else
 356         {
 357           action = orig_handlers[csig];
 358           orig_handlers[csig].sa_handler = SIG_ERR;
 359           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 360         }
 361 #else
 362       if (orig_handlers[csig] == SIG_ERR)
 363         query_only = 1;
 364       else
 365         {
 366           chandler = orig_handlers[csig];
 367           orig_handlers[csig] = SIG_ERR;
 368           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 369         }
 370 #endif
 371     }
 372   else
 373     {
 374       SCM_VALIDATE_PROC (2, handler);
 375 #ifdef HAVE_SIGACTION
 376       action.sa_handler = take_signal;
 377       if (orig_handlers[csig].sa_handler == SIG_ERR)
 378         save_handler = 1;
 379 #else
 380       chandler = take_signal;
 381       if (orig_handlers[csig] == SIG_ERR)
 382         save_handler = 1;
 383 #endif
 384       install_handler (csig, thread, handler);
 385     }
 386
 387   /* XXX - Silently ignore setting handlers for `program error signals'
 388      because they can't currently be handled by Scheme code.
 389   */
 390
 391   switch (csig)
 392     {
 393       /* This list of program error signals is from the GNU Libc
 394          Reference Manual */
 395     case SIGFPE:
 396     case SIGILL:
 397     case SIGSEGV:
 398 #ifdef SIGBUS
 399     case SIGBUS:
 400 #endif
 401     case SIGABRT:
 402 #if defined(SIGIOT) && (SIGIOT != SIGABRT)
 403     case SIGIOT:
 404 #endif
 405 #ifdef SIGTRAP
 406     case SIGTRAP:
 407 #endif
 408 #ifdef SIGEMT
 409     case SIGEMT:
 410 #endif
 411 #ifdef SIGSYS
 412     case SIGSYS:
 413 #endif
 414       query_only = 1;
 415     }
 416
 417 #ifdef HAVE_SIGACTION
 418   if (query_only)
 419     {
 420       if (sigaction (csig, 0, &old_action) == -1)
 421         SCM_SYSERROR;
 422     }
 423   else
 424     {
 425       if (sigaction (csig, &action , &old_action) == -1)
 426         SCM_SYSERROR;
 427       if (save_handler)
 428         orig_handlers[csig] = old_action;
 429     }
 430   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 431     old_handler = scm_long2num ((long) old_action.sa_handler);
 432   SCM_ALLOW_INTS;
 433   return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
 434 #else
 435   if (query_only)
 436     {
 437       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 438         SCM_SYSERROR;
 439       if (signal (csig, old_chandler) == SIG_ERR)
 440         SCM_SYSERROR;
 441     }
 442   else
 443     {
 444       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 445         SCM_SYSERROR;
 446       if (save_handler)
 447         orig_handlers[csig] = old_chandler;
 448     }
 449   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 450     old_handler = scm_long2num ((long) old_chandler);
 451   SCM_ALLOW_INTS;
 452   return scm_cons (old_handler, SCM_MAKINUM (0));
 453 #endif
 454 }
 455 #undef FUNC_NAME
 456
 457 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 458             (void),
 459             "Return all signal handlers to the values they had before any call to\n"
 460             "@code{sigaction} was made.  The return value is unspecified.")
 461 #define FUNC_NAME s_scm_restore_signals
 462 {
 463   int i;
 464   for (i = 0; i < NSIG; i++)
 465     {
 466 #ifdef HAVE_SIGACTION
 467       if (orig_handlers[i].sa_handler != SIG_ERR)
 468         {
 469           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 470             SCM_SYSERROR;
 471           orig_handlers[i].sa_handler = SIG_ERR;
 472           SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 473         }
 474 #else
 475       if (orig_handlers[i] != SIG_ERR)
 476         {
 477           if (signal (i, orig_handlers[i]) == SIG_ERR)
 478             SCM_SYSERROR;
 479           orig_handlers[i] = SIG_ERR;
 480           SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 481         }
 482 #endif
 483     }
 484   return SCM_UNSPECIFIED;
 485 }
 486 #undef FUNC_NAME
 487
 488 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 489            (SCM i),
 490             "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
 491             "number of seconds (an integer).  It's advisable to install a signal\n"
 492             "handler for\n"
 493             "@code{SIGALRM} beforehand, since the default action is to terminate\n"
 494             "the process.\n\n"
 495             "The return value indicates the time remaining for the previous alarm,\n"
 496             "if any.  The new value replaces the previous alarm.  If there was\n"
 497             "no previous alarm, the return value is zero.")
 498 #define FUNC_NAME s_scm_alarm
 499 {
 500   unsigned int j;
 501   SCM_VALIDATE_INUM (1, i);
 502   j = alarm (SCM_INUM (i));
 503   return SCM_MAKINUM (j);
 504 }
 505 #undef FUNC_NAME
 506
 507 #ifdef HAVE_SETITIMER
 508 SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
 509            (SCM which_timer,
 510             SCM interval_seconds, SCM interval_microseconds,
 511             SCM value_seconds, SCM value_microseconds),
 512             "Set the timer specified by @var{which_timer} according to the given\n"
 513             "@var{interval_seconds}, @var{interval_microseconds},\n"
 514             "@var{value_seconds}, and @var{value_microseconds} values.\n"
 515             "\n"
 516             "Return information about the timer's previous setting."
 517             "\n"
 518             "Errors are handled as described in the guile info pages under ``POSIX\n"
 519             "Interface Conventions''.\n"
 520             "\n"
 521             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 522             "and @code{ITIMER_PROF}.\n"
 523             "\n"
 524             "The return value will be a list of two cons pairs representing the\n"
 525             "current state of the given timer.  The first pair is the seconds and\n"
 526             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 527             "the seconds and microseconds of the timer @code{it_value}.")
 528 #define FUNC_NAME s_scm_setitimer
 529 {
 530   int rv;
 531   int c_which_timer;
 532   struct itimerval new_timer;
 533   struct itimerval old_timer;
 534
 535   c_which_timer = SCM_NUM2INT(1, which_timer);
 536   new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
 537   new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
 538   new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
 539   new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
 540
 541   SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
 542
 543   if(rv != 0)
 544     SCM_SYSERROR;
 545
 546   return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
 547                              scm_long2num(old_timer.it_interval.tv_usec)),
 548                     scm_cons(scm_long2num(old_timer.it_value.tv_sec),
 549                              scm_long2num(old_timer.it_value.tv_usec)));
 550 }
 551 #undef FUNC_NAME
 552 #endif /* HAVE_SETITIMER */
 553
 554 #ifdef HAVE_GETITIMER
 555 SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
 556   (SCM which_timer),
 557             "Return information about the timer specified by @var{which_timer}"
 558             "\n"
 559             "Errors are handled as described in the guile info pages under ``POSIX\n"
 560             "Interface Conventions''.\n"
 561             "\n"
 562             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 563             "and @code{ITIMER_PROF}.\n"
 564             "\n"
 565             "The return value will be a list of two cons pairs representing the\n"
 566             "current state of the given timer.  The first pair is the seconds and\n"
 567             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 568             "the seconds and microseconds of the timer @code{it_value}.")
 569 #define FUNC_NAME s_scm_getitimer
 570 {
 571   int rv;
 572   int c_which_timer;
 573   struct itimerval old_timer;
 574
 575   c_which_timer = SCM_NUM2INT(1, which_timer);
 576
 577   SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
 578
 579   if(rv != 0)
 580     SCM_SYSERROR;
 581
 582   return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
 583                              scm_long2num(old_timer.it_interval.tv_usec)),
 584                     scm_cons(scm_long2num(old_timer.it_value.tv_sec),
 585                              scm_long2num(old_timer.it_value.tv_usec)));
 586 }
 587 #undef FUNC_NAME
 588 #endif /* HAVE_GETITIMER */
 589
 590 #ifdef HAVE_PAUSE
 591 SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 592            (),
 593             "Pause the current process (thread?) until a signal arrives whose\n"
 594             "action is to either terminate the current process or invoke a\n"
 595             "handler procedure.  The return value is unspecified.")
 596 #define FUNC_NAME s_scm_pause
 597 {
 598   pause ();
 599   return SCM_UNSPECIFIED;
 600 }
 601 #undef FUNC_NAME
 602 #endif
 603
 604 SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 605            (SCM i),
 606             "Wait for the given number of seconds (an integer) or until a signal\n"
 607             "arrives.  The return value is zero if the time elapses or the number\n"
 608             "of seconds remaining otherwise.")
 609 #define FUNC_NAME s_scm_sleep
 610 {
 611   unsigned long j;
 612   SCM_VALIDATE_INUM_MIN (1, i,0);
 613   j = scm_thread_sleep (SCM_INUM(i));
 614   return scm_ulong2num (j);
 615 }
 616 #undef FUNC_NAME
 617
 618 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 619            (SCM i),
 620             "Sleep for I microseconds.  @code{usleep} is not available on\n"
 621             "all platforms.")
 622 #define FUNC_NAME s_scm_usleep
 623 {
 624   unsigned long j;
 625   SCM_VALIDATE_INUM_MIN (1, i,0);
 626   j = scm_thread_usleep (SCM_INUM (i));
 627   return scm_ulong2num (j);
 628 }
 629 #undef FUNC_NAME
 630
 631 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 632            (SCM sig),
 633             "Sends a specified signal @var{sig} to the current process, where\n"
 634             "@var{sig} is as described for the kill procedure.")
 635 #define FUNC_NAME s_scm_raise
 636 {
 637   SCM_VALIDATE_INUM (1, sig);
 638   SCM_DEFER_INTS;
 639   if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
 640     SCM_SYSERROR;
 641   SCM_ALLOW_INTS;
 642   return SCM_UNSPECIFIED;
 643 }
 644 #undef FUNC_NAME
 645
 646 \f
 647
 648 void
 649 scm_init_scmsigs ()
 650 {
 651   int i;
 652
 653   signal_handlers =
 654     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 655                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 656   signal_handler_cells =
 657     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 658   signal_cell_handlers =
 659     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 660   signal_handler_threads =
 661     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 662
 663   for (i = 0; i < NSIG; i++)
 664     {
 665 #ifdef HAVE_SIGACTION
 666       orig_handlers[i].sa_handler = SIG_ERR;
 667
 668 #else
 669       orig_handlers[i] = SIG_ERR;
 670 #endif
 671
 672 #ifdef HAVE_RESTARTABLE_SYSCALLS
 673       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
 674          signals really are restartable.  don't rely on the same
 675          run-time that configure got: reset the default for every signal.
 676       */
 677 #ifdef HAVE_SIGINTERRUPT
 678       siginterrupt (i, 0);
 679 #elif defined(SA_RESTART)
 680       {
 681         struct sigaction action;
 682
 683         sigaction (i, NULL, &action);
 684         if (!(action.sa_flags & SA_RESTART))
 685           {
 686             action.sa_flags |= SA_RESTART;
 687             sigaction (i, &action, NULL);
 688           }
 689       }
 690 #endif
 691       /* if neither siginterrupt nor SA_RESTART are available we may
 692          as well assume that signals are always restartable.  */
 693 #endif
 694     }
 695
 696   scm_c_define ("NSIG", scm_long2num (NSIG));
 697   scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
 698   scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
 699 #ifdef SA_NOCLDSTOP
 700   scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
 701 #endif
 702 #ifdef SA_RESTART
 703   scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
 704 #endif
 705
 706 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 707   /* Stuff needed by setitimer and getitimer. */
 708   scm_c_define ("ITIMER_REAL", SCM_MAKINUM (ITIMER_REAL));
 709   scm_c_define ("ITIMER_VIRTUAL", SCM_MAKINUM (ITIMER_VIRTUAL));
 710   scm_c_define ("ITIMER_PROF", SCM_MAKINUM (ITIMER_PROF));
 711 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 712
 713 #include "libguile/scmsigs.x"
 714 }
 715
 716
 717 /*
 718   Local Variables:
 719   c-file-style: "gnu"
 720   End:
 721 */