libguile/scmsigs.c

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