libguile/scmsigs.c

   1 /*      Copyright (C) 1995,1996 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, 675 Mass Ave, Cambridge, MA 02139, USA.
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.
  40  */
  41 \f
  42
  43 #include <stdio.h>
  44 #include <signal.h>
  45 #include "_scm.h"
  46
  47 #include "scmsigs.h"
  48
  49 #ifdef HAVE_UNISTD_H
  50 #include <unistd.h>
  51 #endif
  52
  53
  54 \f
  55
  56 #if (__TURBOC__==1)
  57 #define signal ssignal          /* Needed for TURBOC V1.0 */
  58 #endif
  59
  60 #ifdef USE_MIT_PTHREADS
  61 #undef signal
  62 #define signal pthread_signal
  63 #endif
  64
  65 \f
  66
  67 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h>*/
  68
  69 #ifdef RETSIGTYPE
  70 #define SIGRETTYPE RETSIGTYPE
  71 #else
  72 #ifdef STDC_HEADERS
  73 #if (__TURBOC__==1)
  74 #define SIGRETTYPE int
  75 #else
  76 #define SIGRETTYPE void
  77 #endif
  78 #else
  79 #ifdef linux
  80 #define SIGRETTYPE void
  81 #else
  82 #define SIGRETTYPE int
  83 #endif
  84 #endif
  85 #endif
  86
  87 #ifdef vms
  88 #ifdef __GNUC__
  89 #define SIGRETTYPE int
  90 #endif
  91 #endif
  92
  93 \f
  94
  95 #define SIGFN(NAME, SCM_NAME, SIGNAL) \
  96 static SIGRETTYPE \
  97 NAME (sig) \
  98      int sig; \
  99 { \
 100   signal (SIGNAL, NAME); \
 101   scm_take_signal (SCM_NAME); \
 102 }
 103
 104 #ifdef SIGHUP
 105 SIGFN(scm_hup_signal, SCM_HUP_SIGNAL, SIGHUP)
 106 #endif
 107
 108 #ifdef SIGINT
 109 SIGFN(scm_int_signal, SCM_INT_SIGNAL, SIGINT)
 110 #endif
 111
 112 #ifdef SIGFPE
 113 SIGFN(scm_fpe_signal, SCM_FPE_SIGNAL, SIGFPE)
 114 #endif
 115
 116 #ifdef SIGBUS
 117 SIGFN(scm_bus_signal, SCM_BUS_SIGNAL, SIGBUS)
 118 #endif
 119
 120 #ifdef SIGSEGV
 121 SIGFN(scm_segv_signal, SCM_SEGV_SIGNAL, SIGSEGV)
 122 #endif
 123
 124 #ifdef SIGALRM
 125 SIGFN(scm_alrm_signal, SCM_ALRM_SIGNAL, SIGALRM)
 126 #endif
 127
 128 #define FAKESIGFN(NAME, SCM_NAME) \
 129 static SIGRETTYPE \
 130 NAME (sig) \
 131      int sig; \
 132 { \
 133   scm_take_signal (SCM_NAME); \
 134 }
 135
 136 #if 0
 137 /* !!! */
 138 FAKESIGFN(scm_gc_signal, SCM_GC_SIGNAL)
 139 FAKESIGFN(scm_tick_signal, SCM_TICK_SIGNAL)
 140 #endif
 141 \f
 142
 143 SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
 144
 145 SCM
 146 scm_alarm (i)
 147      SCM i;
 148 {
 149   unsigned int j;
 150   SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
 151   SCM_SYSCALL (j = alarm (SCM_INUM (i)));
 152   return SCM_MAKINUM (j);
 153 }
 154
 155
 156 SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
 157
 158 SCM
 159 scm_pause ()
 160 {
 161   pause ();
 162   return SCM_UNSPECIFIED;
 163 }
 164
 165 SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
 166
 167 SCM
 168 scm_sleep (i)
 169      SCM i;
 170 {
 171   unsigned int j;
 172   SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
 173 #ifdef __HIGHC__
 174   SCM_SYSCALL(j = 0; sleep(SCM_INUM(i)););
 175 #else
 176   SCM_SYSCALL(j = sleep(SCM_INUM(i)););
 177 #endif
 178   return SCM_MAKINUM (j);
 179 }
 180
 181 SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
 182
 183 SCM
 184 scm_raise(sig)
 185      SCM sig;
 186 {
 187   SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
 188 # ifdef vms
 189   return SCM_MAKINUM(gsignal((int)SCM_INUM(sig)));
 190 # else
 191   return kill (getpid(), (int)SCM_INUM(sig)) ? SCM_BOOL_F : SCM_BOOL_T;
 192 # endif
 193 }
 194
 195 \f
 196 #ifdef SIGHUP
 197 static SIGRETTYPE (*oldhup) ();
 198 #endif
 199
 200 #ifdef SIGINT
 201 static SIGRETTYPE (*oldint) ();
 202 #endif
 203
 204 #ifdef SIGFPE
 205 static SIGRETTYPE (*oldfpe) ();
 206 #endif
 207
 208 #ifdef SIGBUS
 209 static SIGRETTYPE (*oldbus) ();
 210 #endif
 211
 212 #ifdef SIGSEGV                  /* AMIGA lacks! */
 213 static SIGRETTYPE (*oldsegv) ();
 214 #endif
 215
 216 #ifdef SIGALRM
 217 static SIGRETTYPE (*oldalrm) ();
 218 #endif
 219
 220 #ifdef SIGPIPE
 221 static SIGRETTYPE (*oldpipe) ();
 222 #endif
 223
 224
 225
 226 void
 227 scm_init_signals ()
 228 {
 229 #ifdef SIGINT
 230   oldint = signal (SIGINT, scm_int_signal);
 231 #endif
 232 #ifdef SIGHUP
 233   oldhup = signal (SIGHUP, scm_hup_signal);
 234 #endif
 235 #ifdef SIGFPE
 236   oldfpe = signal (SIGFPE, scm_fpe_signal);
 237 #endif
 238 #ifdef SIGBUS
 239   oldbus = signal (SIGBUS, scm_bus_signal);
 240 #endif
 241 #ifdef SIGSEGV                  /* AMIGA lacks! */
 242   oldsegv = signal (SIGSEGV, scm_segv_signal);
 243 #endif
 244 #ifdef SIGALRM
 245   alarm (0);                    /* kill any pending ALRM interrupts */
 246   oldalrm = signal (SIGALRM, scm_alrm_signal);
 247 #endif
 248 #ifdef SIGPIPE
 249   oldpipe = signal (SIGPIPE, SIG_IGN);
 250 #endif
 251 #ifdef ultrix
 252   siginterrupt (SIGINT, 1);
 253   siginterrupt (SIGALRM, 1);
 254   siginterrupt (SIGHUP, 1);
 255   siginterrupt (SIGPIPE, 1);
 256 #endif /* ultrix */
 257 }
 258
 259 /* This is used in preparation for a possible fork().  Ignore all
 260    signals before the fork so that child will catch only if it
 261    establishes a handler */
 262
 263 void
 264 scm_ignore_signals ()
 265 {
 266 #ifdef ultrix
 267   siginterrupt (SIGINT, 0);
 268   siginterrupt (SIGALRM, 0);
 269   siginterrupt (SIGHUP, 0);
 270   siginterrupt (SIGPIPE, 0);
 271 #endif /* ultrix */
 272   signal (SIGINT, SIG_IGN);
 273 #ifdef SIGHUP
 274   signal (SIGHUP, SIG_DFL);
 275 #endif
 276 #ifdef SCM_FLOATS
 277   signal (SIGFPE, SIG_DFL);
 278 #endif
 279 #ifdef SIGBUS
 280   signal (SIGBUS, SIG_DFL);
 281 #endif
 282 #ifdef SIGSEGV                  /* AMIGA lacks! */
 283   signal (SIGSEGV, SIG_DFL);
 284 #endif
 285   /* Some documentation claims that ALRMs are cleared accross forks.
 286      If this is not always true then the value returned by alarm(0)
 287      will have to be saved and scm_unignore_signals() will have to
 288      reinstate it. */
 289   /* This code should be neccessary only if the forked process calls
 290      alarm() without establishing a handler:
 291      #ifdef SIGALRM
 292      oldalrm = signal(SIGALRM, SIG_DFL);
 293      #endif */
 294   /* These flushes are per warning in man page on fork(). */
 295   fflush (stdout);
 296   fflush (stderr);
 297 }
 298
 299
 300 void
 301 scm_unignore_signals ()
 302 {
 303   signal (SIGINT, scm_int_signal);
 304 #ifdef SIGHUP
 305   signal (SIGHUP, scm_hup_signal);
 306 #endif
 307 #ifdef SCM_FLOATS
 308   signal (SIGFPE, scm_fpe_signal);
 309 #endif
 310 #ifdef SIGBUS
 311   signal (SIGBUS, scm_bus_signal);
 312 #endif
 313 #ifdef SIGSEGV                  /* AMIGA lacks! */
 314   signal (SIGSEGV, scm_segv_signal);
 315 #endif
 316 #ifdef SIGALRM
 317   signal (SIGALRM, scm_alrm_signal);
 318 #endif
 319 #ifdef ultrix
 320   siginterrupt (SIGINT, 1);
 321   siginterrupt (SIGALRM, 1);
 322   siginterrupt (SIGHUP, 1);
 323   siginterrupt (SIGPIPE, 1);
 324 #endif /* ultrix */
 325 }
 326
 327 SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
 328
 329 SCM
 330 scm_restore_signals ()
 331 {
 332 #ifdef ultrix
 333   siginterrupt (SIGINT, 0);
 334   siginterrupt (SIGALRM, 0);
 335   siginterrupt (SIGHUP, 0);
 336   siginterrupt (SIGPIPE, 0);
 337 #endif /* ultrix */
 338   signal (SIGINT, oldint);
 339 #ifdef SIGHUP
 340   signal (SIGHUP, oldhup);
 341 #endif
 342 #ifdef SCM_FLOATS
 343   signal (SIGFPE, oldfpe);
 344 #endif
 345 #ifdef SIGBUS
 346   signal (SIGBUS, oldbus);
 347 #endif
 348 #ifdef SIGSEGV                  /* AMIGA lacks! */
 349   signal (SIGSEGV, oldsegv);
 350 #endif
 351 #ifdef SIGPIPE
 352   signal (SIGPIPE, oldpipe);
 353 #endif
 354 #ifdef SIGALRM
 355   alarm (0);                    /* kill any pending ALRM interrupts */
 356   signal (SIGALRM, oldalrm);
 357 #endif
 358   return SCM_UNSPECIFIED;
 359 }
 360
 361
 362
 363 void
 364 scm_init_scmsigs ()
 365 {
 366 #include "scmsigs.x"
 367 }
 368