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