libguile/scmsigs.c

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