libguile/scmsigs.c

   1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999 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 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46
  47 #include <stdio.h>
  48 #include <signal.h>
  49 #include "libguile/_scm.h"
  50
  51 #include "libguile/async.h"
  52 #include "libguile/eval.h"
  53 #include "libguile/vectors.h"
  54
  55 #include "libguile/validate.h"
  56 #include "libguile/scmsigs.h"
  57
  58 #ifdef HAVE_UNISTD_H
  59 #include <unistd.h>
  60 #endif
  61
  62 /* The thread system has its own sleep and usleep functions.  */
  63 #ifndef USE_THREADS
  64
  65 #if defined(MISSING_SLEEP_DECL)
  66 int sleep ();
  67 #endif
  68
  69 #if defined(HAVE_USLEEP) && defined(MISSING_USLEEP_DECL)
  70 int usleep ();
  71 #endif
  72
  73 #endif
  74
  75 \f
  76
  77 #ifdef USE_MIT_PTHREADS
  78 #undef signal
  79 #define signal pthread_signal
  80 #endif
  81
  82 \f
  83
  84 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  85
  86 #ifdef RETSIGTYPE
  87 # define SIGRETTYPE RETSIGTYPE
  88 #else
  89 # ifdef STDC_HEADERS
  90 #  define SIGRETTYPE void
  91 # else
  92 #  define SIGRETTYPE int
  93 # endif
  94 #endif
  95
  96 \f
  97
  98 /* take_signal is installed as the C signal handler whenever a Scheme
  99    handler is set.  when a signal arrives, take_signal marks the corresponding
 100    element of got_signal and marks signal_async.  the thunk in signal_async
 101    (sys_deliver_signals) will be run at the next opportunity, outside a
 102    critical section. sys_deliver_signals runs each Scheme handler for
 103    which got_signal is set.  */
 104
 105 static SCM signal_async;
 106
 107 static char got_signal[NSIG];
 108
 109 /* a Scheme vector of handler procedures.  */
 110 static SCM *signal_handlers;
 111
 112 /* saves the original C handlers, when a new handler is installed.
 113    set to SIG_ERR if the original handler is installed.  */
 114 #ifdef HAVE_SIGACTION
 115 static struct sigaction orig_handlers[NSIG];
 116 #else
 117 static SIGRETTYPE (*orig_handlers[NSIG])(int);
 118 #endif
 119
 120 static SIGRETTYPE
 121 take_signal (int signum)
 122 {
 123   int saved_errno = errno;
 124   SCM ignored;
 125
 126   if (!scm_ints_disabled)
 127     {
 128       /* For reasons of speed, the SCM_NEWCELL macro doesn't defer
 129          interrupts.  Instead, it first sets its argument to point to
 130          the first cell in the list, and then advances the freelist
 131          pointer to the next cell.  Now, if this procedure is
 132          interrupted, the only anomalous state possible is to have
 133          both SCM_NEWCELL's argument and scm_freelist pointing to the
 134          same cell.  To deal with this case, we always throw away the
 135          first cell in scm_freelist here.
 136
 137          At least, that's the theory.  I'm not convinced that that's
 138          the only anomalous path we need to worry about.  */
 139       SCM_NEWCELL (ignored);
 140     }
 141   got_signal[signum] = 1;
 142 #if HAVE_SIGACTION
 143   /* unblock the signal before the scheme handler gets to run, since
 144      it may use longjmp to escape (i.e., throw an exception).  */
 145   {
 146     sigset_t set;
 147     sigemptyset (&set);
 148     sigaddset (&set, signum);
 149     sigprocmask (SIG_UNBLOCK, &set, NULL);
 150   }
 151 #endif
 152   scm_system_async_mark (signal_async);
 153   errno = saved_errno;
 154 }
 155
 156 static SCM
 157 sys_deliver_signals (void)
 158 {
 159   int i;
 160
 161   for (i = 0; i < NSIG; i++)
 162     {
 163       if (got_signal[i])
 164         {
 165           /* The flag is reset before calling the handler in case the
 166              handler doesn't return.  If the handler doesn't return
 167              but leaves other signals flagged, they their handlers
 168              will be applied some time later when the async is checked
 169              again.  It would probably be better to reset the flags
 170              after doing a longjmp.  */
 171           got_signal[i] = 0;
 172 #ifndef HAVE_SIGACTION
 173           signal (i, take_signal);
 174 #endif
 175           scm_apply (SCM_VELTS (*signal_handlers)[i],
 176                      scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
 177                      SCM_EOL);
 178         }
 179     }
 180   return SCM_UNSPECIFIED;
 181 }
 182
 183 /* user interface for installation of signal handlers.  */
 184 SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
 185            (SCM signum, SCM handler, SCM flags),
 186             "Install or report the signal hander for a specified signal.\n\n"
 187             "@var{signum} is the signal number, which can be specified using the value\n"
 188             "of variables such as @code{SIGINT}.\n\n"
 189             "If @var{action} is omitted, @code{sigaction} returns a pair: the\n"
 190             "CAR is the current\n"
 191             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 192             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 193             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 194             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 195             "If @var{action} is provided, it is installed as the new handler for\n"
 196             "@var{signum}.  @var{action} can be a Scheme procedure taking one\n"
 197             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 198             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 199             "was installed before @code{sigaction} was first used.  Flags can\n"
 200             "optionally be specified for the new handler (@code{SA_RESTART} will\n"
 201             "always be added if it's available and the system is using rstartable\n"
 202             "system calls.)  The return value is a pair with information about the\n"
 203             "old handler as described above.\n\n"
 204             "This interface does not provide access to the \"signal blocking\"\n"
 205             "facility.  Maybe this is not needed, since the thread support may\n"
 206             "provide solutions to the problem of consistent access to data\n"
 207             "structures.")
 208 #define FUNC_NAME s_scm_sigaction
 209 {
 210   int csig;
 211 #ifdef HAVE_SIGACTION
 212   struct sigaction action;
 213   struct sigaction old_action;
 214 #else
 215   SIGRETTYPE (* chandler) (int);
 216   SIGRETTYPE (* old_chandler) (int);
 217 #endif
 218   int query_only = 0;
 219   int save_handler = 0;
 220   SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
 221   SCM old_handler;
 222
 223   SCM_VALIDATE_INUM_COPY (1,signum,csig);
 224 #if defined(HAVE_SIGACTION)
 225 #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
 226   /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
 227      is defined, since libguile would be likely to produce spurious
 228      EINTR errors.  */
 229   action.sa_flags = SA_RESTART;
 230 #else
 231   action.sa_flags = 0;
 232 #endif
 233   if (!SCM_UNBNDP (flags))
 234     {
 235       SCM_VALIDATE_INUM (3,flags);
 236       action.sa_flags |= SCM_INUM (flags);
 237     }
 238   sigemptyset (&action.sa_mask);
 239 #endif
 240   SCM_DEFER_INTS;
 241   old_handler = scheme_handlers[csig];
 242   if (SCM_UNBNDP (handler))
 243     query_only = 1;
 244   else if (SCM_TRUE_P (scm_integer_p (handler)))
 245     {
 246       if (SCM_NUM2LONG (2,handler) == (long) SIG_DFL
 247           || SCM_NUM2LONG (2,handler) == (long) SIG_IGN)
 248         {
 249 #ifdef HAVE_SIGACTION
 250           action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 251 #else
 252           chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 253 #endif
 254           scheme_handlers[csig] = SCM_BOOL_F;
 255         }
 256       else
 257         SCM_OUT_OF_RANGE (2, handler);
 258     }
 259   else if (SCM_FALSEP (handler))
 260     {
 261       /* restore the default handler.  */
 262 #ifdef HAVE_SIGACTION
 263       if (orig_handlers[csig].sa_handler == SIG_ERR)
 264         query_only = 1;
 265       else
 266         {
 267           action = orig_handlers[csig];
 268           orig_handlers[csig].sa_handler = SIG_ERR;
 269           scheme_handlers[csig] = SCM_BOOL_F;
 270         }
 271 #else
 272       if (orig_handlers[csig] == SIG_ERR)
 273         query_only = 1;
 274       else
 275         {
 276           chandler = orig_handlers[csig];
 277           orig_handlers[csig] = SIG_ERR;
 278           scheme_handlers[csig] = SCM_BOOL_F;
 279         }
 280 #endif
 281     }
 282   else
 283     {
 284       SCM_VALIDATE_NIM (2,handler);
 285 #ifdef HAVE_SIGACTION
 286       action.sa_handler = take_signal;
 287       if (orig_handlers[csig].sa_handler == SIG_ERR)
 288         save_handler = 1;
 289 #else
 290       chandler = take_signal;
 291       if (orig_handlers[csig] == SIG_ERR)
 292         save_handler = 1;
 293 #endif
 294       scheme_handlers[csig] = handler;
 295     }
 296 #ifdef HAVE_SIGACTION
 297   if (query_only)
 298     {
 299       if (sigaction (csig, 0, &old_action) == -1)
 300         SCM_SYSERROR;
 301     }
 302   else
 303     {
 304       if (sigaction (csig, &action , &old_action) == -1)
 305         SCM_SYSERROR;
 306       if (save_handler)
 307         orig_handlers[csig] = old_action;
 308     }
 309   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 310     old_handler = scm_long2num ((long) old_action.sa_handler);
 311   SCM_ALLOW_INTS;
 312   return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
 313 #else
 314   if (query_only)
 315     {
 316       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 317         SCM_SYSERROR;
 318       if (signal (csig, old_chandler) == SIG_ERR)
 319         SCM_SYSERROR;
 320     }
 321   else
 322     {
 323       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 324         SCM_SYSERROR;
 325       if (save_handler)
 326         orig_handlers[csig] = old_chandler;
 327     }
 328   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 329     old_handler = scm_long2num ((long) old_chandler);
 330   SCM_ALLOW_INTS;
 331   return scm_cons (old_handler, SCM_MAKINUM (0));
 332 #endif
 333 }
 334 #undef FUNC_NAME
 335
 336 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 337             (void),
 338             "Return all signal handlers to the values they had before any call to\n"
 339             "@code{sigaction} was made.  The return value is unspecified.")
 340 #define FUNC_NAME s_scm_restore_signals
 341 {
 342   int i;
 343   SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
 344
 345   for (i = 0; i < NSIG; i++)
 346     {
 347 #ifdef HAVE_SIGACTION
 348       if (orig_handlers[i].sa_handler != SIG_ERR)
 349         {
 350           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 351             SCM_SYSERROR;
 352           orig_handlers[i].sa_handler = SIG_ERR;
 353           scheme_handlers[i] = SCM_BOOL_F;
 354         }
 355 #else
 356       if (orig_handlers[i] != SIG_ERR)
 357         {
 358           if (signal (i, orig_handlers[i]) == SIG_ERR)
 359             SCM_SYSERROR;
 360           orig_handlers[i] = SIG_ERR;
 361           scheme_handlers[i] = SCM_BOOL_F;
 362         }
 363 #endif
 364     }
 365   return SCM_UNSPECIFIED;
 366 }
 367 #undef FUNC_NAME
 368
 369 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 370            (SCM i),
 371             "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
 372             "number of seconds (an integer).  It's advisable to install a signal\n"
 373             "handler for\n"
 374             "@code{SIGALRM} beforehand, since the default action is to terminate\n"
 375             "the process.\n\n"
 376             "The return value indicates the time remaining for the previous alarm,\n"
 377             "if any.  The new value replaces the previous alarm.  If there was\n"
 378             "no previous alarm, the return value is zero.")
 379 #define FUNC_NAME s_scm_alarm
 380 {
 381   unsigned int j;
 382   SCM_VALIDATE_INUM (1,i);
 383   j = alarm (SCM_INUM (i));
 384   return SCM_MAKINUM (j);
 385 }
 386 #undef FUNC_NAME
 387
 388 #ifdef HAVE_PAUSE
 389 SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 390            (),
 391             "Pause the current process (thread?) until a signal arrives whose\n"
 392             "action is to either terminate the current process or invoke a\n"
 393             "handler procedure.  The return value is unspecified.")
 394 #define FUNC_NAME s_scm_pause
 395 {
 396   pause ();
 397   return SCM_UNSPECIFIED;
 398 }
 399 #undef FUNC_NAME
 400 #endif
 401
 402 SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 403            (SCM i),
 404             "Wait for the given number of seconds (an integer) or until a signal\n"
 405             "arrives.  The return value is zero if the time elapses or the number\n"
 406             "of seconds remaining otherwise.")
 407 #define FUNC_NAME s_scm_sleep
 408 {
 409   unsigned long j;
 410   SCM_VALIDATE_INUM_MIN (1,i,0);
 411 #ifdef USE_THREADS
 412   j = scm_thread_sleep (SCM_INUM(i));
 413 #else
 414   j = sleep (SCM_INUM(i));
 415 #endif
 416   return scm_ulong2num (j);
 417 }
 418 #undef FUNC_NAME
 419
 420 #if defined(USE_THREADS) || defined(HAVE_USLEEP)
 421 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 422            (SCM i),
 423             "Sleep for I microseconds.\n"
 424             "`usleep' is not available on all platforms.")
 425 #define FUNC_NAME s_scm_usleep
 426 {
 427   SCM_VALIDATE_INUM_MIN (1,i,0);
 428
 429 #ifdef USE_THREADS
 430   /* If we have threads, we use the thread system's sleep function.  */
 431   {
 432     unsigned long j = scm_thread_usleep (SCM_INUM (i));
 433     return scm_ulong2num (j);
 434   }
 435 #else
 436 #ifdef USLEEP_RETURNS_VOID
 437   usleep (SCM_INUM (i));
 438   return SCM_INUM0;
 439 #else
 440   {
 441     int j = usleep (SCM_INUM (i));
 442     return SCM_MAKINUM (j);
 443   }
 444 #endif
 445 #endif
 446 }
 447 #undef FUNC_NAME
 448 #endif /* GUILE_ISELECT || HAVE_USLEEP */
 449
 450 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 451            (SCM sig),
 452             "\n"
 453             "Sends a specified signal @var{sig} to the current process, where\n"
 454             "@var{sig} is as described for the kill procedure.")
 455 #define FUNC_NAME s_scm_raise
 456 {
 457   SCM_VALIDATE_INUM (1,sig);
 458   SCM_DEFER_INTS;
 459   if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
 460     SCM_SYSERROR;
 461   SCM_ALLOW_INTS;
 462   return SCM_UNSPECIFIED;
 463 }
 464 #undef FUNC_NAME
 465
 466 SCM_PROC(s_segfault, "segfault", 0, 0, 0, scm_segfault);
 467
 468 SCM
 469 scm_segfault ()
 470 {
 471   *(int *)0 = 0;
 472   return SCM_UNSPECIFIED;
 473 }
 474
 475 \f
 476
 477 void
 478 scm_init_scmsigs ()
 479 {
 480   SCM thunk;
 481   int i;
 482
 483   signal_handlers =
 484     SCM_CDRLOC (scm_sysintern ("signal-handlers",
 485                                scm_make_vector (SCM_MAKINUM (NSIG),
 486                                                 SCM_BOOL_F)));
 487   thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
 488                           sys_deliver_signals);
 489   signal_async = scm_system_async (thunk);
 490
 491   for (i = 0; i < NSIG; i++)
 492     {
 493       got_signal[i] = 0;
 494 #ifdef HAVE_SIGACTION
 495       orig_handlers[i].sa_handler = SIG_ERR;
 496
 497 #else
 498       orig_handlers[i] = SIG_ERR;
 499 #endif
 500
 501 #ifdef HAVE_RESTARTABLE_SYSCALLS
 502       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
 503          signals really are restartable.  don't rely on the same
 504          run-time that configure got: reset the default for every signal.
 505       */
 506 #ifdef HAVE_SIGINTERRUPT
 507       siginterrupt (i, 0);
 508 #elif defined(SA_RESTART)
 509       {
 510         struct sigaction action;
 511
 512         sigaction (i, NULL, &action);
 513         if (!(action.sa_flags & SA_RESTART))
 514           {
 515             action.sa_flags &= SA_RESTART;
 516             sigaction (i, &action, NULL);
 517           }
 518       }
 519 #endif
 520       /* if neither siginterrupt nor SA_RESTART are available we may
 521          as well assume that signals are always restartable.  */
 522 #endif
 523     }
 524
 525   scm_sysintern ("NSIG", scm_long2num (NSIG));
 526   scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
 527   scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
 528 #ifdef SA_NOCLDSTOP
 529   scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
 530 #endif
 531 #ifdef SA_RESTART
 532   scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
 533 #endif
 534
 535 #include "libguile/scmsigs.x"
 536 }
 537
 538
 539 /*
 540   Local Variables:
 541   c-file-style: "gnu"
 542   End:
 543 */