libguile/scmsigs.c

   1 /*      Copyright (C) 1995,1996,1997 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 \f
  42
  43 #include <stdio.h>
  44 #include <signal.h>
  45 #include "_scm.h"
  46
  47 #include "async.h"
  48 #include "eval.h"
  49 #include "scmsigs.h"
  50
  51 #ifdef HAVE_UNISTD_H
  52 #include <unistd.h>
  53 #endif
  54
  55 /* The thread system has its own sleep and usleep functions.  */
  56 #ifndef USE_THREADS
  57
  58 #if defined(MISSING_SLEEP_DECL)
  59 int sleep ();
  60 #endif
  61
  62 #if defined(HAVE_USLEEP) && defined(MISSING_USLEEP_DECL)
  63 int usleep ();
  64 #endif
  65
  66 #endif
  67
  68 \f
  69
  70 #ifdef USE_MIT_PTHREADS
  71 #undef signal
  72 #define signal pthread_signal
  73 #endif
  74
  75 \f
  76
  77 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  78
  79 #ifdef RETSIGTYPE
  80 # define SIGRETTYPE RETSIGTYPE
  81 #else
  82 # ifdef STDC_HEADERS
  83 #  define SIGRETTYPE void
  84 # else
  85 #  define SIGRETTYPE int
  86 # endif
  87 #endif
  88
  89 \f
  90
  91 /* take_signal is installed as the C signal handler whenever a Scheme
  92    handler is set.  when a signal arrives, take_signal marks the corresponding
  93    element of got_signal and marks signal_async.  the thunk in signal_async
  94    (sys_deliver_signals) will be run at the next opportunity, outside a
  95    critical section. sys_deliver_signals runs each Scheme handler for
  96    which got_signal is set.  */
  97
  98 static SCM signal_async;
  99
 100 static char got_signal[NSIG];
 101
 102 /* a Scheme vector of handler procedures.  */
 103 static SCM *signal_handlers;
 104
 105 /* saves the original C handlers, when a new handler is installed.
 106    set to SIG_ERR if the original handler is installed.  */
 107 #ifdef HAVE_SIGACTION
 108 static struct sigaction orig_handlers[NSIG];
 109 #else
 110 static SIGRETTYPE (*orig_handlers)(int)[NSIG];
 111 #endif
 112
 113 static SIGRETTYPE
 114 take_signal (int signum)
 115 {
 116   SCM ignored;
 117   if (!scm_ints_disabled)
 118     {
 119       /* For reasons of speed, the SCM_NEWCELL macro doesn't defer
 120          interrupts.  Instead, it first sets its argument to point to
 121          the first cell in the list, and then advances the freelist
 122          pointer to the next cell.  Now, if this procedure is
 123          interrupted, the only anomalous state possible is to have
 124          both SCM_NEWCELL's argument and scm_freelist pointing to the
 125          same cell.  To deal with this case, we always throw away the
 126          first cell in scm_freelist here.
 127
 128          At least, that's the theory.  I'm not convinced that that's
 129          the only anomalous path we need to worry about.  */
 130       SCM_NEWCELL (ignored);
 131     }
 132   got_signal[signum] = 1;
 133 #if HAVE_SIGACTION
 134   /* unblock the signal before the scheme handler gets to run, since
 135      it may use longjmp to escape (i.e., throw an exception).  */
 136   {
 137     sigset_t set;
 138     sigemptyset (&set);
 139     sigaddset (&set, signum);
 140     sigprocmask (SIG_UNBLOCK, &set, NULL);
 141   }
 142 #endif
 143   scm_system_async_mark (signal_async);
 144 }
 145
 146 static SCM
 147 sys_deliver_signals (void)
 148 {
 149   int i;
 150
 151   for (i = 0; i < NSIG; i++)
 152     {
 153       if (got_signal[i])
 154         {
 155           /* The flag is reset before calling the handler in case the
 156              handler doesn't return.  If the handler doesn't return
 157              but leaves other signals flagged, they their handlers
 158              will be applied some time later when the async is checked
 159              again.  It would probably be better to reset the flags
 160              after doing a longjmp.  */
 161           got_signal[i] = 0;
 162 #ifndef HAVE_SIGACTION
 163           signal (i, take_signal);
 164 #endif
 165           scm_apply (SCM_VELTS (*signal_handlers)[i],
 166                      scm_listify (SCM_MAKINUM (i), SCM_UNDEFINED),
 167                      SCM_EOL);
 168         }
 169     }
 170   return SCM_UNSPECIFIED;
 171 }
 172
 173 /* user interface for installation of signal handlers.  */
 174 SCM_PROC(s_sigaction, "sigaction", 1, 2, 0, scm_sigaction);
 175 SCM
 176 scm_sigaction (SCM signum, SCM handler, SCM flags)
 177 {
 178   int csig;
 179 #ifdef HAVE_SIGACTION
 180   struct sigaction action;
 181   struct sigaction old_action;
 182 #else
 183   SIGRETTYPE (* chandler) (int);
 184   SIGRETTYPE (* old_chandler) (int);
 185 #endif
 186   int query_only = 0;
 187   int save_handler = 0;
 188   SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
 189   SCM old_handler;
 190
 191   SCM_ASSERT (SCM_INUMP (signum), signum, SCM_ARG1, s_sigaction);
 192   csig = SCM_INUM (signum);
 193 #ifdef HAVE_SIGACTION
 194   /* always use restartable system calls if available.  */
 195 #ifdef SA_RESTART
 196   action.sa_flags = SA_RESTART;
 197 #else
 198   action.sa_flags = 0;
 199 #endif
 200   if (!SCM_UNBNDP (flags))
 201     {
 202       SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG3, s_sigaction);
 203       action.sa_flags |= SCM_INUM (flags);
 204     }
 205   sigemptyset (&action.sa_mask);
 206 #endif
 207   SCM_DEFER_INTS;
 208   old_handler = scheme_handlers[csig];
 209   if (SCM_UNBNDP (handler))
 210     query_only = 1;
 211   else if (SCM_INUMP (handler))
 212     {
 213       if (SCM_INUM (handler) == (int) SIG_DFL
 214           || SCM_INUM (handler) == (int) SIG_IGN)
 215         {
 216 #ifdef HAVE_SIGACTION
 217           action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 218 #else
 219           chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
 220 #endif
 221           scheme_handlers[csig] = SCM_BOOL_F;
 222         }
 223       else
 224         scm_out_of_range (s_sigaction, handler);
 225     }
 226   else if (SCM_FALSEP (handler))
 227     {
 228       /* restore the default handler.  */
 229 #ifdef HAVE_SIGACTION
 230       if (orig_handlers[csig].sa_handler == SIG_ERR)
 231         query_only = 1;
 232       else
 233         {
 234           action = orig_handlers[csig];
 235           orig_handlers[csig].sa_handler = SIG_ERR;
 236           scheme_handlers[csig] = SCM_BOOL_F;
 237         }
 238 #else
 239       if (orig_handlers[csig] == SIG_ERR)
 240         query_only = 1;
 241       else
 242         {
 243           chandler = orig_handlers[csig];
 244           orig_handlers[csig] = SIG_ERR;
 245           scheme_handlers[csig] = SCM_BOOL_F;
 246         }
 247 #endif
 248     }
 249   else
 250     {
 251       SCM_ASSERT (SCM_NIMP (handler), handler, SCM_ARG2, s_sigaction);
 252 #ifdef HAVE_SIGACTION
 253       action.sa_handler = take_signal;
 254       if (orig_handlers[csig].sa_handler == SIG_ERR)
 255         save_handler = 1;
 256 #else
 257       chandler = take_signal;
 258       if (orig_handlers[csig] == SIG_ERR)
 259         save_handler = 1;
 260 #endif
 261       scheme_handlers[csig] = handler;
 262     }
 263 #ifdef HAVE_SIGACTION
 264   if (query_only)
 265     {
 266       if (sigaction (csig, 0, &old_action) == -1)
 267         scm_syserror (s_sigaction);
 268     }
 269   else
 270     {
 271       if (sigaction (csig, &action , &old_action) == -1)
 272         scm_syserror (s_sigaction);
 273       if (save_handler)
 274         orig_handlers[csig] = old_action;
 275     }
 276   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 277     old_handler = SCM_MAKINUM ((int) old_action.sa_handler);
 278   SCM_ALLOW_INTS;
 279   return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags));
 280 #else
 281   if (query_only)
 282     {
 283       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 284         scm_syserror (s_sigaction);
 285       if (signal (csig, old_chandler) == SIG_ERR)
 286         scm_syserror (s_sigaction);
 287     }
 288   else
 289     {
 290       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 291         scm_syserror (s_sigaction);
 292       if (save_handler)
 293         orig_handlers[csig] = old_chandler;
 294     }
 295   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 296     old_handler = SCM_MAKINUM ((int) old_chandler);
 297   SCM_ALLOW_INTS;
 298   return scm_cons (old_handler, SCM_MAKINUM (0));
 299 #endif
 300 }
 301
 302 SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
 303 SCM
 304 scm_restore_signals (void)
 305 {
 306   int i;
 307   SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
 308
 309   for (i = 0; i < NSIG; i++)
 310     {
 311 #ifdef HAVE_SIGACTION
 312       if (orig_handlers[i].sa_handler != SIG_ERR)
 313         {
 314           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 315             scm_syserror (s_restore_signals);
 316           orig_handlers[i].sa_handler = SIG_ERR;
 317           scheme_handlers[i] = SCM_BOOL_F;
 318         }
 319 #else
 320       if (orig_handlers[i] != SIG_ERR)
 321         {
 322           if (signal (i, orig_handlers[i]) == SIG_ERR)
 323             scm_syserror (s_restore_signals);
 324           orig_handlers[i] = SIG_ERR;
 325           scheme_handlers[i] = SCM_BOOL_F;
 326         }
 327 #endif
 328     }
 329   return SCM_UNSPECIFIED;
 330 }
 331
 332 SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
 333
 334 SCM
 335 scm_alarm (i)
 336      SCM i;
 337 {
 338   unsigned int j;
 339   SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
 340   j = alarm (SCM_INUM (i));
 341   return SCM_MAKINUM (j);
 342 }
 343
 344 #ifdef HAVE_PAUSE
 345 SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
 346
 347 SCM
 348 scm_pause ()
 349 {
 350   pause ();
 351   return SCM_UNSPECIFIED;
 352 }
 353 #endif
 354
 355 SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
 356
 357 SCM
 358 scm_sleep (i)
 359      SCM i;
 360 {
 361   unsigned long j;
 362   SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
 363 #ifdef USE_THREADS
 364   j = scm_thread_sleep (SCM_INUM(i));
 365 #else
 366   j = sleep (SCM_INUM(i));
 367 #endif
 368   return scm_ulong2num (j);
 369 }
 370
 371 #if defined(USE_THREADS) || defined(HAVE_USLEEP)
 372 SCM_PROC(s_usleep, "usleep", 1, 0, 0, scm_usleep);
 373
 374 SCM
 375 scm_usleep (i)
 376      SCM i;
 377 {
 378   SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_usleep);
 379
 380 #ifdef USE_THREADS
 381   /* If we have threads, we use the thread system's sleep function.  */
 382   {
 383     unsigned long j = scm_thread_usleep (SCM_INUM (i));
 384     return scm_ulong2num (j);
 385   }
 386 #else
 387 #ifdef USLEEP_RETURNS_VOID
 388   usleep (SCM_INUM (i));
 389   return SCM_INUM0;
 390 #else
 391   {
 392     int j = usleep (SCM_INUM (i));
 393     return SCM_MAKINUM (j);
 394   }
 395 #endif
 396 #endif
 397 }
 398 #endif /* GUILE_ISELECT || HAVE_USLEEP */
 399
 400 SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
 401
 402 SCM
 403 scm_raise(sig)
 404      SCM sig;
 405 {
 406   SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
 407   SCM_DEFER_INTS;
 408   if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
 409     scm_syserror (s_raise);
 410   SCM_ALLOW_INTS;
 411   return SCM_UNSPECIFIED;
 412 }
 413
 414 \f
 415
 416 void
 417 scm_init_scmsigs ()
 418 {
 419   SCM thunk;
 420   int i;
 421
 422   signal_handlers =
 423     SCM_CDRLOC (scm_sysintern ("signal-handlers",
 424                                scm_make_vector (SCM_MAKINUM (NSIG),
 425                                                 SCM_BOOL_F)));
 426   thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
 427                           sys_deliver_signals);
 428   signal_async = scm_system_async (thunk);
 429
 430   for (i = 0; i < NSIG; i++)
 431     {
 432       got_signal[i] = 0;
 433 #ifdef HAVE_SIGACTION
 434       orig_handlers[i].sa_handler = SIG_ERR;
 435 #else
 436       orig_handlers[i] = SIG_ERR;
 437 #endif
 438     }
 439
 440   scm_sysintern ("NSIG", scm_long2num (NSIG));
 441   scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
 442   scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
 443 #ifdef SA_NOCLDSTOP
 444   scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
 445 #endif
 446 #ifdef SA_RESTART
 447   scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
 448 #endif
 449
 450 #include "scmsigs.x"
 451 }
 452