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