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 %description))
 108             (:copier nil))
 109   %name                             ; signal keyword
 110   (%number nil :type integer)       ; UNIX signal number
 111   (%description nil :type string))  ; documentation
 112
 113 (defvar *unix-signals* nil
 114   #!+sb-doc
 115   "A list of Unix signal structures.")
 116
 117 (defmacro def-unix-signal (name number description)
 118   (let ((symbol (intern (symbol-name name))))
 119     `(progn
 120        ;; KLUDGE: This PUSH should be probably be something like PUSHNEW if we
 121        ;; want to be able to cleanly reload this file. (Or perhaps
 122        ;; *UNIX-SIGNALS* should be a hash table keyed by signal name, or a
 123        ;; vector keyed by signal number?)
 124        (push (make-unix-signal ,name ,number ,description) *unix-signals*)
 125        ;; This is to make the new signal lookup stuff compatible with
 126        ;; old code which expects the symbol with the same print name as
 127        ;; our keywords to be a constant with a value equal to the signal
 128        ;; number.
 129        (defconstant ,symbol ,number ,description))))
 130
 131 (defun unix-signal-or-lose (arg)
 132   (let ((signal (find arg *unix-signals*
 133                       :key (etypecase arg
 134                              (symbol #'unix-signal-%name)
 135                              (number #'unix-signal-%number)))))
 136     (unless signal
 137       (error "~S is not a valid signal name or number." arg))
 138     signal))
 139
 140 (defun unix-signal-name (signal)
 141   #!+sb-doc
 142   "Return the name of the signal as a string. Signal should be a valid
 143   signal number or a keyword of the standard UNIX signal name."
 144   (symbol-name (unix-signal-%name (unix-signal-or-lose signal))))
 145
 146 (defun unix-signal-description (signal)
 147   #!+sb-doc
 148   "Return a string describing signal. Signal should be a valid signal
 149   number or a keyword of the standard UNIX signal name."
 150   (unix-signal-%description (unix-signal-or-lose signal)))
 151
 152 (defun unix-signal-number (signal)
 153   #!+sb-doc
 154   "Return the number of the given signal. Signal should be a valid
 155   signal number or a keyword of the standard UNIX signal name."
 156   (unix-signal-%number (unix-signal-or-lose signal)))
 157
 158 ;;; known signals
 159 (def-unix-signal :CHECK 0 "Check")
 160 (def-unix-signal :SIGHUP 1 "Hangup")
 161 (def-unix-signal :SIGINT 2 "Interrupt")
 162 (def-unix-signal :SIGQUIT 3 "Quit")
 163 (def-unix-signal :SIGILL 4 "Illegal instruction")
 164 (def-unix-signal :SIGTRAP 5 "Trace trap")
 165 (def-unix-signal :SIGIOT 6 "Iot instruction")
 166 #!-linux
 167 (def-unix-signal :SIGEMT 7 "Emt instruction")
 168 (def-unix-signal :SIGFPE 8 "Floating point exception")
 169 (def-unix-signal :SIGKILL 9 "Kill")
 170 (def-unix-signal :SIGBUS #!-linux 10 #!+linux 7 "Bus error")
 171 (def-unix-signal :SIGSEGV 11 "Segmentation violation")
 172 #!-linux
 173 (def-unix-signal :SIGSYS 12 "Bad argument to system call")
 174 (def-unix-signal :SIGPIPE 13 "Write on a pipe with no one to read it")
 175 (def-unix-signal :SIGALRM 14 "Alarm clock")
 176 (def-unix-signal :SIGTERM 15 "Software termination signal")
 177 #!+linux
 178 (def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor")
 179 (def-unix-signal :SIGURG #!+svr4 21 #!-(or hpux svr4 linux) 16 #!+hpux 29
 180   #!+linux 23 "Urgent condition present on socket")
 181 (def-unix-signal :SIGSTOP #!-(or hpux svr4 linux) 17 #!+hpux 24 #!+svr4 23
 182   #!+linux 19 "Stop")
 183 (def-unix-signal :SIGTSTP #!-(or hpux svr4 linux) 18 #!+hpux 25 #!+svr4 24
 184   #!+linux 20 "Stop signal generated from keyboard")
 185 (def-unix-signal :SIGCONT #!-(or hpux svr4 linux) 19 #!+hpux 26 #!+svr4 25
 186   #!+linux 18 "Continue after stop")
 187 (def-unix-signal :SIGCHLD #!-(or linux hpux) 20
 188   #!+hpux 18 #!+linux 17 "Child status has changed")
 189 (def-unix-signal :SIGTTIN #!-(or hpux svr4) 21 #!+hpux 27 #!+svr4 26
 190   "Background read attempted from control terminal")
 191 (def-unix-signal :SIGTTOU #!-(or hpux svr4) 22 #!+hpux 28 #!+svr4 27
 192   "Background write attempted to control terminal")
 193 (def-unix-signal :SIGIO #!-(or hpux irix linux) 23 #!+(or hpux irix) 22
 194   #!+linux 29
 195   "I/O is possible on a descriptor")
 196 #!-hpux
 197 (def-unix-signal :SIGXCPU #!-svr4 24 #!+svr4 30  "Cpu time limit exceeded")
 198 #!-hpux
 199 (def-unix-signal :SIGXFSZ #!-svr4 25 #!+svr4 31 "File size limit exceeded")
 200 (def-unix-signal :SIGVTALRM #!-(or hpux svr4) 26 #!+hpux 20 #!+svr4 28
 201     "Virtual time alarm")
 202 (def-unix-signal :SIGPROF #!-(or hpux svr4 linux) 27 #!+hpux 21 #!+svr4 29
 203   #!+linux 30 "Profiling timer alarm")
 204 (def-unix-signal :SIGWINCH #!-(or hpux svr4) 28 #!+hpux 23 #!+svr4 20
 205     "Window size change")
 206 (def-unix-signal :SIGUSR1 #!-(or hpux svr4 linux) 30 #!+(or hpux svr4) 16
 207   #!+linux 10 "User defined signal 1")
 208 (def-unix-signal :SIGUSR2 #!-(or hpux svr4 linux) 31 #!+(or hpux svr4) 17
 209   #!+linux 12 "User defined signal 2")
 210
 211 #!+mach
 212 (def-unix-signal :SIGEMSG 30 "Mach Emergency message")
 213 #!+mach
 214 (def-unix-signal :SIGMSG 31 "Mach message")
 215
 216 ;;; SVR4 (or Solaris?) specific signals
 217 #!+svr4
 218 (def-unix-signal :SIGWAITING 32 "Process's lwps are blocked")
 219
 220 (sb!xc:defmacro sigmask (&rest signals)
 221   #!+sb-doc
 222   "Returns a mask given a set of signals."
 223   (apply #'logior
 224          (mapcar #'(lambda (signal)
 225                      (ash 1 (1- (unix-signal-number signal))))
 226                  signals)))