libguile/scmsigs.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008 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 #include "libguile/threads.h"
  37
  38 #include "libguile/validate.h"
  39 #include "libguile/scmsigs.h"
  40
  41 #ifdef HAVE_IO_H
  42 #include <io.h>  /* for mingw _pipe() */
  43 #endif
  44
  45 #ifdef HAVE_PROCESS_H
  46 #include <process.h>    /* for mingw */
  47 #endif
  48
  49 #ifdef HAVE_UNISTD_H
  50 #include <unistd.h>
  51 #endif
  52
  53 #ifdef HAVE_SYS_TIME_H
  54 #include <sys/time.h>
  55 #endif
  56
  57 #ifdef __MINGW32__
  58 #include <windows.h>
  59 #define alarm(sec) (0)
  60 /* This weird comma expression is because Sleep is void under Windows. */
  61 #define sleep(sec) (Sleep ((sec) * 1000), 0)
  62 #define usleep(usec) (Sleep ((usec) / 1000), 0)
  63 #define pipe(fd) _pipe (fd, 256, O_BINARY)
  64 #endif
  65
  66 \f
  67
  68 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  69
  70 #ifdef RETSIGTYPE
  71 # define SIGRETTYPE RETSIGTYPE
  72 #else
  73 # ifdef STDC_HEADERS
  74 #  define SIGRETTYPE void
  75 # else
  76 #  define SIGRETTYPE int
  77 # endif
  78 #endif
  79
  80 \f
  81
  82 /* take_signal is installed as the C signal handler whenever a Scheme
  83    handler is set.  When a signal arrives, take_signal will write a
  84    byte into the 'signal pipe'.  The 'signal delivery thread' will
  85    read this pipe and queue the appropriate asyncs.
  86
  87    When Guile is built without threads, the signal handler will
  88    install the async directly.
  89 */
  90
  91
  92 /* Scheme vectors with information about a signal.  signal_handlers
  93    contains the handler procedure or #f, signal_handler_asyncs
  94    contains the thunk to be marked as an async when the signal arrives
  95    (or the cell with the thunk in a singlethreaded Guile), and
  96    signal_handler_threads points to the thread that a signal should be
  97    delivered to.
  98 */
  99 static SCM *signal_handlers;
 100 static SCM signal_handler_asyncs;
 101 static SCM signal_handler_threads;
 102
 103 /* The signal delivery thread.  */
 104 scm_i_thread *scm_i_signal_delivery_thread = NULL;
 105
 106 /* The mutex held when launching the signal delivery thread.  */
 107 static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
 108   SCM_I_PTHREAD_MUTEX_INITIALIZER;
 109
 110
 111 /* saves the original C handlers, when a new handler is installed.
 112    set to SIG_ERR if the original handler is installed.  */
 113 #ifdef HAVE_SIGACTION
 114 static struct sigaction orig_handlers[NSIG];
 115 #else
 116 static SIGRETTYPE (*orig_handlers[NSIG])(int);
 117 #endif
 118
 119 static SCM
 120 close_1 (SCM proc, SCM arg)
 121 {
 122   return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
 123                                            scm_list_2 (proc, arg)));
 124 }
 125
 126 #if SCM_USE_PTHREAD_THREADS
 127 /* On mingw there's no notion of inter-process signals, only a raise()
 128    within the process itself which apparently invokes the registered handler
 129    immediately.  Not sure how well the following code will cope in this
 130    case.  It builds but it may not offer quite the same scheme-level
 131    semantics as on a proper system.  If you're relying on much in the way of
 132    signal handling on mingw you probably lose anyway.  */
 133
 134 static int signal_pipe[2];
 135
 136 static SIGRETTYPE
 137 take_signal (int signum)
 138 {
 139   char sigbyte = signum;
 140   write (signal_pipe[1], &sigbyte, 1);
 141
 142 #ifndef HAVE_SIGACTION
 143   signal (signum, take_signal);
 144 #endif
 145 }
 146
 147 typedef struct {
 148   ssize_t res;
 149   int fd;
 150   char *buf;
 151   size_t n;
 152 } read_without_guile_data;
 153
 154 static void *
 155 do_read_without_guile (void *raw_data)
 156 {
 157   read_without_guile_data *data = (read_without_guile_data *)raw_data;
 158   data->res = read (data->fd, data->buf, data->n);
 159   return NULL;
 160 }
 161
 162 static ssize_t
 163 read_without_guile (int fd, char *buf, size_t n)
 164 {
 165   read_without_guile_data data;
 166   data.fd = fd;
 167   data.buf = buf;
 168   data.n = n;
 169   scm_without_guile (do_read_without_guile, &data);
 170   return data.res;
 171 }
 172
 173 static SCM
 174 signal_delivery_thread (void *data)
 175 {
 176   int n, sig;
 177   char sigbyte;
 178 #if HAVE_PTHREAD_SIGMASK  /* not on mingw, see notes above */
 179   sigset_t all_sigs;
 180   sigfillset (&all_sigs);
 181   scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL);
 182 #endif
 183
 184   while (1)
 185     {
 186       n = read_without_guile (signal_pipe[0], &sigbyte, 1);
 187       sig = sigbyte;
 188       if (n == 1 && sig >= 0 && sig < NSIG)
 189         {
 190           SCM h, t;
 191
 192           h = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig);
 193           t = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig);
 194           if (scm_is_true (h))
 195             scm_system_async_mark_for_thread (h, t);
 196         }
 197       else if (n == 0)
 198         break; /* the signal pipe was closed. */
 199       else if (n < 0 && errno != EINTR)
 200         perror ("error in signal delivery thread");
 201     }
 202
 203   return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
 204 }
 205
 206 static void
 207 start_signal_delivery_thread (void)
 208 {
 209   SCM signal_thread;
 210
 211   scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
 212
 213   if (pipe (signal_pipe) != 0)
 214     scm_syserror (NULL);
 215   signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
 216                                     scm_handle_by_message,
 217                                     "signal delivery thread");
 218   scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread);
 219
 220   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 221 }
 222
 223 void
 224 scm_i_ensure_signal_delivery_thread ()
 225 {
 226   static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
 227   scm_i_pthread_once (&once, start_signal_delivery_thread);
 228 }
 229
 230 #else /* !SCM_USE_PTHREAD_THREADS */
 231
 232 static SIGRETTYPE
 233 take_signal (int signum)
 234 {
 235   SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, signum);
 236   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 237
 238   if (scm_is_false (SCM_CDR (cell)))
 239     {
 240       SCM_SETCDR (cell, t->active_asyncs);
 241       t->active_asyncs = cell;
 242       t->pending_asyncs = 1;
 243     }
 244
 245 #ifndef HAVE_SIGACTION
 246   signal (signum, take_signal);
 247 #endif
 248 }
 249
 250 void
 251 scm_i_ensure_signal_delivery_thread ()
 252 {
 253   return;
 254 }
 255
 256 #endif /* !SCM_USE_PTHREAD_THREADS */
 257
 258 static void
 259 install_handler (int signum, SCM thread, SCM handler)
 260 {
 261   if (scm_is_false (handler))
 262     {
 263       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
 264       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, SCM_BOOL_F);
 265     }
 266   else
 267     {
 268       SCM async = close_1 (handler, scm_from_int (signum));
 269 #if !SCM_USE_PTHREAD_THREADS
 270       async = scm_cons (async, SCM_BOOL_F);
 271 #endif
 272       SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
 273       SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async);
 274     }
 275
 276   SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
 277 }
 278
 279 SCM
 280 scm_sigaction (SCM signum, SCM handler, SCM flags)
 281 {
 282   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 283 }
 284
 285 /* user interface for installation of signal handlers.  */
 286 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 287            (SCM signum, SCM handler, SCM flags, SCM thread),
 288             "Install or report the signal handler for a specified signal.\n\n"
 289             "@var{signum} is the signal number, which can be specified using the value\n"
 290             "of variables such as @code{SIGINT}.\n\n"
 291             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 292             "CAR is the current\n"
 293             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 294             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 295             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 296             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 297             "If @var{handler} is provided, it is installed as the new handler for\n"
 298             "@var{signum}.  @var{handler} can be a Scheme procedure taking one\n"
 299             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 300             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 301             "was installed before @code{sigaction} was first used.  When\n"
 302             "a scheme procedure has been specified, that procedure will run\n"
 303             "in the given @var{thread}.   When no thread has been given, the\n"
 304             "thread that made this call to @code{sigaction} is used.\n"
 305             "Flags can "
 306             "optionally be specified for the new handler (@code{SA_RESTART} will\n"
 307             "always be added if it's available and the system is using restartable\n"
 308             "system calls.)  The return value is a pair with information about the\n"
 309             "old handler as described above.\n\n"
 310             "This interface does not provide access to the \"signal blocking\"\n"
 311             "facility.  Maybe this is not needed, since the thread support may\n"
 312             "provide solutions to the problem of consistent access to data\n"
 313             "structures.")
 314 #define FUNC_NAME s_scm_sigaction_for_thread
 315 {
 316   int csig;
 317 #ifdef HAVE_SIGACTION
 318   struct sigaction action;
 319   struct sigaction old_action;
 320 #else
 321   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 322   SIGRETTYPE (* old_chandler) (int);
 323 #endif
 324   int query_only = 0;
 325   int save_handler = 0;
 326
 327   SCM old_handler;
 328
 329   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 330
 331 #if defined(HAVE_SIGACTION)
 332 #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
 333   /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
 334      is defined, since libguile would be likely to produce spurious
 335      EINTR errors.  */
 336   action.sa_flags = SA_RESTART;
 337 #else
 338   action.sa_flags = 0;
 339 #endif
 340   if (!SCM_UNBNDP (flags))
 341     action.sa_flags |= scm_to_int (flags);
 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_i_ensure_signal_delivery_thread ();
 355
 356   SCM_CRITICAL_SECTION_START;
 357   old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
 358   if (SCM_UNBNDP (handler))
 359     query_only = 1;
 360   else if (scm_is_integer (handler))
 361     {
 362       long handler_int = scm_to_long (handler);
 363
 364       if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN)
 365         {
 366 #ifdef HAVE_SIGACTION
 367           action.sa_handler = (SIGRETTYPE (*) (int)) handler_int;
 368 #else
 369           chandler = (SIGRETTYPE (*) (int)) handler_int;
 370 #endif
 371           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 372         }
 373       else
 374         SCM_OUT_OF_RANGE (2, handler);
 375     }
 376   else if (scm_is_false (handler))
 377     {
 378       /* restore the default handler.  */
 379 #ifdef HAVE_SIGACTION
 380       if (orig_handlers[csig].sa_handler == SIG_ERR)
 381         query_only = 1;
 382       else
 383         {
 384           action = orig_handlers[csig];
 385           orig_handlers[csig].sa_handler = SIG_ERR;
 386           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 387         }
 388 #else
 389       if (orig_handlers[csig] == SIG_ERR)
 390         query_only = 1;
 391       else
 392         {
 393           chandler = orig_handlers[csig];
 394           orig_handlers[csig] = SIG_ERR;
 395           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 396         }
 397 #endif
 398     }
 399   else
 400     {
 401       SCM_VALIDATE_PROC (2, handler);
 402 #ifdef HAVE_SIGACTION
 403       action.sa_handler = take_signal;
 404       if (orig_handlers[csig].sa_handler == SIG_ERR)
 405         save_handler = 1;
 406 #else
 407       chandler = take_signal;
 408       if (orig_handlers[csig] == SIG_ERR)
 409         save_handler = 1;
 410 #endif
 411       install_handler (csig, thread, handler);
 412     }
 413
 414   /* XXX - Silently ignore setting handlers for `program error signals'
 415      because they can't currently be handled by Scheme code.
 416   */
 417
 418   switch (csig)
 419     {
 420       /* This list of program error signals is from the GNU Libc
 421          Reference Manual */
 422     case SIGFPE:
 423     case SIGILL:
 424     case SIGSEGV:
 425 #ifdef SIGBUS
 426     case SIGBUS:
 427 #endif
 428     case SIGABRT:
 429 #if defined(SIGIOT) && (SIGIOT != SIGABRT)
 430     case SIGIOT:
 431 #endif
 432 #ifdef SIGTRAP
 433     case SIGTRAP:
 434 #endif
 435 #ifdef SIGEMT
 436     case SIGEMT:
 437 #endif
 438 #ifdef SIGSYS
 439     case SIGSYS:
 440 #endif
 441       query_only = 1;
 442     }
 443
 444 #ifdef HAVE_SIGACTION
 445   if (query_only)
 446     {
 447       if (sigaction (csig, 0, &old_action) == -1)
 448         SCM_SYSERROR;
 449     }
 450   else
 451     {
 452       if (sigaction (csig, &action , &old_action) == -1)
 453         SCM_SYSERROR;
 454       if (save_handler)
 455         orig_handlers[csig] = old_action;
 456     }
 457   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 458     old_handler = scm_from_long ((long) old_action.sa_handler);
 459   SCM_CRITICAL_SECTION_END;
 460   return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
 461 #else
 462   if (query_only)
 463     {
 464       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 465         SCM_SYSERROR;
 466       if (signal (csig, old_chandler) == SIG_ERR)
 467         SCM_SYSERROR;
 468     }
 469   else
 470     {
 471       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 472         SCM_SYSERROR;
 473       if (save_handler)
 474         orig_handlers[csig] = old_chandler;
 475     }
 476   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 477     old_handler = scm_from_long ((long) old_chandler);
 478   SCM_CRITICAL_SECTION_END;
 479   return scm_cons (old_handler, scm_from_int (0));
 480 #endif
 481 }
 482 #undef FUNC_NAME
 483
 484 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 485             (void),
 486             "Return all signal handlers to the values they had before any call to\n"
 487             "@code{sigaction} was made.  The return value is unspecified.")
 488 #define FUNC_NAME s_scm_restore_signals
 489 {
 490   int i;
 491   for (i = 0; i < NSIG; i++)
 492     {
 493 #ifdef HAVE_SIGACTION
 494       if (orig_handlers[i].sa_handler != SIG_ERR)
 495         {
 496           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 497             SCM_SYSERROR;
 498           orig_handlers[i].sa_handler = SIG_ERR;
 499           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 500         }
 501 #else
 502       if (orig_handlers[i] != SIG_ERR)
 503         {
 504           if (signal (i, orig_handlers[i]) == SIG_ERR)
 505             SCM_SYSERROR;
 506           orig_handlers[i] = SIG_ERR;
 507           SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 508         }
 509 #endif
 510     }
 511   return SCM_UNSPECIFIED;
 512 }
 513 #undef FUNC_NAME
 514
 515 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 516            (SCM i),
 517             "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
 518             "number of seconds (an integer).  It's advisable to install a signal\n"
 519             "handler for\n"
 520             "@code{SIGALRM} beforehand, since the default action is to terminate\n"
 521             "the process.\n\n"
 522             "The return value indicates the time remaining for the previous alarm,\n"
 523             "if any.  The new value replaces the previous alarm.  If there was\n"
 524             "no previous alarm, the return value is zero.")
 525 #define FUNC_NAME s_scm_alarm
 526 {
 527   return scm_from_uint (alarm (scm_to_uint (i)));
 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_from_long (old_timer.it_interval.tv_sec),
 571                                scm_from_long (old_timer.it_interval.tv_usec)),
 572                      scm_cons (scm_from_long (old_timer.it_value.tv_sec),
 573                                scm_from_long (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_from_long (old_timer.it_interval.tv_sec),
 607                                scm_from_long (old_timer.it_interval.tv_usec)),
 608                      scm_cons (scm_from_long (old_timer.it_value.tv_sec),
 609                                scm_from_long (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.\n"
 633             "\n"
 634             "See also @code{usleep}.")
 635 #define FUNC_NAME s_scm_sleep
 636 {
 637   return scm_from_uint (scm_std_sleep (scm_to_uint (i)));
 638 }
 639 #undef FUNC_NAME
 640
 641 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 642            (SCM i),
 643             "Wait the given period @var{usecs} microseconds (an integer).\n"
 644             "If a signal arrives the wait stops and the return value is the\n"
 645             "time remaining, in microseconds.  If the period elapses with no\n"
 646             "signal the return is zero.\n"
 647             "\n"
 648             "On most systems the process scheduler is not microsecond accurate and\n"
 649             "the actual period slept by @code{usleep} may be rounded to a system\n"
 650             "clock tick boundary.  Traditionally such ticks were 10 milliseconds\n"
 651             "apart, and that interval is often still used.\n"
 652             "\n"
 653             "See also @code{sleep}.")
 654 #define FUNC_NAME s_scm_usleep
 655 {
 656   return scm_from_ulong (scm_std_usleep (scm_to_ulong (i)));
 657 }
 658 #undef FUNC_NAME
 659
 660 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 661            (SCM sig),
 662             "Sends a specified signal @var{sig} to the current process, where\n"
 663             "@var{sig} is as described for the kill procedure.")
 664 #define FUNC_NAME s_scm_raise
 665 {
 666   if (raise (scm_to_int (sig)) != 0)
 667     SCM_SYSERROR;
 668   return SCM_UNSPECIFIED;
 669 }
 670 #undef FUNC_NAME
 671
 672 \f
 673
 674 void
 675 scm_i_close_signal_pipe()
 676 {
 677   /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
 678      thread is being launched.  The thread that calls this function is
 679      already holding the thread admin mutex, so if the delivery thread hasn't
 680      been launched at this point, it never will be before shutdown.  */
 681   scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
 682
 683 #if SCM_USE_PTHREAD_THREADS
 684   if (scm_i_signal_delivery_thread != NULL)
 685     close (signal_pipe[1]);
 686 #endif
 687
 688   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 689 }
 690
 691 void
 692 scm_init_scmsigs ()
 693 {
 694   int i;
 695
 696   signal_handlers =
 697     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 698                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 699   signal_handler_asyncs =
 700     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 701   signal_handler_threads =
 702     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 703
 704   for (i = 0; i < NSIG; i++)
 705     {
 706 #ifdef HAVE_SIGACTION
 707       orig_handlers[i].sa_handler = SIG_ERR;
 708
 709 #else
 710       orig_handlers[i] = SIG_ERR;
 711 #endif
 712
 713 #ifdef HAVE_RESTARTABLE_SYSCALLS
 714       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
 715          signals really are restartable.  don't rely on the same
 716          run-time that configure got: reset the default for every signal.
 717       */
 718 #ifdef HAVE_SIGINTERRUPT
 719       siginterrupt (i, 0);
 720 #elif defined(SA_RESTART)
 721       {
 722         struct sigaction action;
 723
 724         sigaction (i, NULL, &action);
 725         if (!(action.sa_flags & SA_RESTART))
 726           {
 727             action.sa_flags |= SA_RESTART;
 728             sigaction (i, &action, NULL);
 729           }
 730       }
 731 #endif
 732       /* if neither siginterrupt nor SA_RESTART are available we may
 733          as well assume that signals are always restartable.  */
 734 #endif
 735     }
 736
 737   scm_c_define ("NSIG", scm_from_long (NSIG));
 738   scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN));
 739   scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL));
 740 #ifdef SA_NOCLDSTOP
 741   scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP));
 742 #endif
 743 #ifdef SA_RESTART
 744   scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART));
 745 #endif
 746
 747 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 748   /* Stuff needed by setitimer and getitimer. */
 749   scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
 750   scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
 751   scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
 752 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 753
 754 #include "libguile/scmsigs.x"
 755 }
 756
 757
 758 /*
 759   Local Variables:
 760   c-file-style: "gnu"
 761   End:
 762 */