src/code/signal.lisp

   1 ;;;; handling UNIX signals
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!UNIX")
  13 \f
  14 ;;;; macros for dynamically enabling and disabling signal handling
  15
  16 ;;; Notes on how the without-interrupts/with-interrupts stuff works:
  17 ;;;
  18 ;;; Before invoking the supplied handler for any of the signals that
  19 ;;; can be blocked, the C interrupt support code checks to see whether
  20 ;;; *interrupts-enabled* has been bound to NIL. If so, it saves the
  21 ;;; signal number and the value of the signal mask (from the signal
  22 ;;; context), sets the signal mask to block all blockable signals,
  23 ;;; sets *interrupt-pending* and returns without handling the signal.
  24 ;;;
  25 ;;; When we drop out the without interrupts, we check to see whether
  26 ;;; *interrupt-pending* has been set. If so, we call
  27 ;;; do-pending-interrupt, which generates a SIGTRAP. The C code
  28 ;;; invokes the handler for the saved signal instead of the SIGTRAP
  29 ;;; after replacing the signal mask in the signal context with the
  30 ;;; saved value. When that hander returns, the original signal mask is
  31 ;;; installed, allowing any other pending signals to be handled.
  32 ;;;
  33 ;;; This means that the cost of without-interrupts is just a special
  34 ;;; binding in the case when no signals are delivered (the normal
  35 ;;; case). It's only when a signal is actually delivered that we use
  36 ;;; any system calls, and by then the cost of the extra system calls
  37 ;;; are lost in the noise when compared with the cost of delivering
  38 ;;; the signal in the first place.
  39
  40 ;;; Magically converted by the compiler into a break instruction.
  41 (defun do-pending-interrupt ()
  42   (do-pending-interrupt))
  43
  44 #!-gengc (progn
  45
  46 (defvar *interrupts-enabled* t)
  47 (defvar *interrupt-pending* nil)
  48
  49 (sb!xc:defmacro without-interrupts (&body body)
  50   #!+sb-doc
  51   "Execute BODY in a context impervious to interrupts."
  52   (let ((name (gensym)))
  53     `(flet ((,name () ,@body))
  54        (if *interrupts-enabled*
  55            (unwind-protect
  56                (let ((*interrupts-enabled* nil))
  57                  (,name))
  58              ;; FIXME: Does it matter that an interrupt coming in here
  59              ;; could be executed before any of the pending interrupts?
  60              ;; Or do incoming interrupts have the good grace to check
  61              ;; whether interrupts are pending before executing themselves
  62              ;; immediately?
  63              (when *interrupt-pending*
  64                (do-pending-interrupt)))
  65            (,name)))))
  66
  67 (sb!xc:defmacro with-interrupts (&body body)
  68   #!+sb-doc
  69   "Allow interrupts while executing BODY. As interrupts are normally allowed,
  70   this is only useful inside a WITHOUT-INTERRUPTS."
  71   (let ((name (gensym)))
  72     `(flet ((,name () ,@body))
  73        (if *interrupts-enabled*
  74            (,name)
  75            (let ((*interrupts-enabled* t))
  76              (when *interrupt-pending*
  77                (do-pending-interrupt))
  78              (,name))))))
  79
  80 ) ; PROGN
  81
  82 ;;; On the GENGC system, we have to do it slightly differently because of the
  83 ;;; existence of threads. Each thread has a suspends_disabled_count in its
  84 ;;; mutator structure. When this value is other then zero, the low level stuff
  85 ;;; will not suspend the thread, but will instead set the suspend_pending flag
  86 ;;; (also in the mutator). So when we finish the without-interrupts, we just
  87 ;;; check the suspend_pending flag and trigger a do-pending-interrupt if
  88 ;;; necessary.
  89
  90 #!+gengc
  91 (defmacro without-interrupts (&body body)
  92   `(unwind-protect
  93        (progn
  94          (locally
  95            (declare (optimize (speed 3) (safety 0)))
  96            (incf (sb!kernel:mutator-interrupts-disabled-count)))
  97          ,@body)
  98      (locally
  99        (declare (optimize (speed 3) (safety 0)))
 100        (when (and (zerop (decf (sb!kernel:mutator-interrupts-disabled-count)))
 101                   (not (zerop (sb!kernel:mutator-interrupt-pending))))
 102          (do-pending-interrupt)))))
 103 \f
 104 ;;;; utilities for dealing with signal names and numbers
 105
 106 (defstruct (unix-signal
 107             (:constructor make-unix-signal (%name %number))
 108             (:copier nil))
 109   ;; signal keyword (e.g. :SIGINT for the Unix SIGINT signal)
 110   (%name   (required-argument) :type keyword :read-only t)
 111   ;; signal number
 112   (%number (required-argument) :type integer :read-only t))
 113
 114 ;;; list of all defined UNIX-SIGNALs
 115 (defvar *unix-signals* nil)
 116
 117 (defmacro !def-unix-signal (name number)
 118   (declare (type keyword name))
 119   (declare (type (and fixnum unsigned-byte) number))
 120   `(push (make-unix-signal ,name ,number) *unix-signals*))
 121
 122 (/show0 "signal.lisp 131")
 123
 124 (defun unix-signal-or-lose (designator)
 125   (or (find designator (the list *unix-signals*)
 126             :key (etypecase designator
 127                    (symbol #'unix-signal-%name)
 128                    (number #'unix-signal-%number)))
 129       (error "not a valid signal name or number: ~S" designator)))
 130
 131 (/show0 "signal.lisp 142")
 132
 133 ;;; Return the name of the designated signal.
 134 (defun unix-signal-name (designator)
 135   (symbol-name (unix-signal-%name (unix-signal-or-lose designator))))
 136
 137 (/show0 "signal.lisp 150")
 138
 139 ;;; Return the number of the designated signal.
 140 (defun unix-signal-number (designator)
 141   (unix-signal-%number (unix-signal-or-lose designator)))
 142
 143 (/show0 "signal.lisp 168")
 144
 145 ;;; known signals
 146 (/show0 "defining Unix signals")
 147 (!def-unix-signal :CHECK 0) ; check
 148 (/show0 "done defining CHECK")
 149 (!def-unix-signal :SIGHUP 1) ; hangup
 150 (/show0 "done defining SIGHUP")
 151 (!def-unix-signal :SIGINT 2) ; interrupt
 152 (/show0 "done defining SIGINT")
 153 (!def-unix-signal :SIGQUIT 3) ; quit
 154 (!def-unix-signal :SIGILL 4) ; illegal instruction
 155 (!def-unix-signal :SIGTRAP 5) ; trace trap
 156 (!def-unix-signal :SIGIOT 6) ; IOT instruction
 157 #!-linux
 158 (!def-unix-signal :SIGEMT 7) ; EMT instruction
 159 (!def-unix-signal :SIGFPE 8) ; floating point exception
 160 (!def-unix-signal :SIGKILL 9) ; kill
 161 (!def-unix-signal :SIGBUS #!-linux 10 #!+linux 7) ; bus error
 162 (!def-unix-signal :SIGSEGV 11) ; segmentation violation
 163 #!-linux
 164 (!def-unix-signal :SIGSYS 12) ; bad argument to system call
 165 (!def-unix-signal :SIGPIPE 13) ; write on a pipe with no one to read it
 166 (!def-unix-signal :SIGALRM 14) ; alarm clock
 167 (!def-unix-signal :SIGTERM 15) ; software termination signal
 168 #!+linux
 169 (!def-unix-signal :SIGSTKFLT 16) ; stack fault on coprocessor
 170 (!def-unix-signal :SIGURG ; urgent condition present on socket
 171   #!+svr4 21
 172   #!-(or hpux svr4 linux) 16
 173   #!+hpux 29
 174   #!+linux 23)
 175 (!def-unix-signal :SIGSTOP ; stop
 176   #!-(or hpux svr4 linux) 17
 177   #!+hpux 24
 178   #!+svr4 23
 179   #!+linux 19)
 180 (!def-unix-signal :SIGTSTP ;  stop signal generated from keyboard
 181   #!-(or hpux svr4 linux) 18
 182   #!+hpux 25
 183   #!+svr4 24
 184   #!+linux 20)
 185 (!def-unix-signal :SIGCONT ; continue after stop
 186   #!-(or hpux svr4 linux) 19
 187   #!+hpux 26
 188   #!+svr4 25
 189   #!+linux 18)
 190 (!def-unix-signal :SIGCHLD ; Child status has changed.
 191   #!-(or linux hpux) 20
 192   #!+hpux 18
 193   #!+linux 17)
 194 (!def-unix-signal :SIGTTIN ; background read attempted from control terminal
 195   #!-(or hpux svr4) 21
 196   #!+hpux 27
 197   #!+svr4 26)
 198 (!def-unix-signal :SIGTTOU ; background write attempted to control terminal
 199   #!-(or hpux svr4) 22
 200   #!+hpux 28
 201   #!+svr4 27)
 202 (!def-unix-signal :SIGIO ; I/O is possible on a descriptor.
 203   #!-(or hpux irix linux) 23
 204   #!+(or hpux irix) 22
 205   #!+linux 29)
 206 #!-hpux
 207 (!def-unix-signal :SIGXCPU ; CPU time limit exceeded
 208   #!-svr4 24
 209   #!+svr4 30)
 210 #!-hpux
 211 (!def-unix-signal :SIGXFSZ ;  file size limit exceeded
 212   #!-svr4 25
 213   #!+svr4 31)
 214 (!def-unix-signal :SIGVTALRM ; virtual time alarm
 215   #!-(or hpux svr4) 26
 216   #!+hpux 20
 217   #!+svr4 28)
 218 (!def-unix-signal :SIGPROF ;  profiling timer alarm
 219   #!-(or hpux svr4 linux) 27
 220   #!+hpux 21
 221   #!+svr4 29
 222   #!+linux 30)
 223 (!def-unix-signal :SIGWINCH ; window size change
 224   #!-(or hpux svr4) 28
 225   #!+hpux 23
 226   #!+svr4 20)
 227 (!def-unix-signal :SIGUSR1 ;  user-defined signal 1
 228   #!-(or hpux svr4 linux) 30
 229   #!+(or hpux svr4) 16
 230   #!+linux 10)
 231 (!def-unix-signal :SIGUSR2 ; user-defined signal 2
 232   #!-(or hpux svr4 linux) 31
 233   #!+(or hpux svr4) 17
 234   #!+linux 12)
 235
 236 ;;; SVR4 (or Solaris?) specific signals
 237 #!+svr4
 238 (!def-unix-signal :SIGWAITING 32) ; Process's LWPs are blocked.
 239
 240 (sb!xc:defmacro sigmask (&rest signals)
 241   #!+sb-doc
 242   "Returns a mask given a set of signals."
 243   (apply #'logior
 244          (mapcar (lambda (signal)
 245                    (ash 1 (1- (unix-signal-number signal))))
 246                  signals)))
 247
 248 (/show0 "done with signal.lisp")