libguile/scmsigs.c

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