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