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 ;;; RECEIVE-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 ;;; The conditional bindings done by this code here are worth the
  41 ;;; trouble as binding is more expensive then read & test -- so
  42 ;;;  (if *foo*
  43 ;;;      (foo)
  44 ;;;      (let ((*foo* t))
  45 ;;;        (foo)))
  46 ;;; is faster then
  47 ;;;  (let ((*foo* t))
  48 ;;;    (foo))
  49 ;;; provided that the first branch is true "often enough".
  50
  51 (defvar *interrupts-enabled* t)
  52 (defvar *interrupt-pending* nil)
  53 #!+sb-thruption (defvar *thruption-pending* nil)
  54 (defvar *allow-with-interrupts* t)
  55 ;;; This is to support signal handlers that want to return to the
  56 ;;; interrupted context without leaving anything extra on the stack. A
  57 ;;; simple
  58 ;;;
  59 ;;;  (without-interrupts
  60 ;;;   (unblock-deferrable-signals)
  61 ;;;   (allow-with-interrupts ...))
  62 ;;;
  63 ;;; would not cut it, as upon leaving WITHOUT-INTERRUPTS the pending
  64 ;;; handlers is run with stuff from the function in which this is
  65 ;;; still on the stack.
  66 (defvar *unblock-deferrables-on-enabling-interrupts-p* nil)
  67
  68 (sb!xc:defmacro without-interrupts (&body body)
  69   #!+sb-doc
  70   "Executes BODY with all deferrable interrupts disabled. Deferrable
  71 interrupts arriving during execution of the BODY take effect after BODY has
  72 been executed.
  73
  74 Deferrable interrupts include most blockable POSIX signals, and
  75 SB-THREAD:INTERRUPT-THREAD. Does not interfere with garbage collection, and
  76 unlike in many traditional Lisps using userspace threads, in SBCL
  77 WITHOUT-INTERRUPTS does not inhibit scheduling of other threads.
  78
  79 Binds ALLOW-WITH-INTERRUPTS and WITH-LOCAL-INTERRUPTS as a local macros.
  80
  81 ALLOW-WITH-INTERRUPTS allows the WITH-INTERRUPTS to take effect during the
  82 dynamic scope of its body, unless there is an outer WITHOUT-INTERRUPTS without
  83 a corresponding ALLOW-WITH-INTERRUPTS.
  84
  85 WITH-LOCAL-INTERRUPTS executes its body with interrupts enabled provided that
  86 for there is an ALLOW-WITH-INTERRUPTS for every WITHOUT-INTERRUPTS surrounding
  87 the current one. WITH-LOCAL-INTERRUPTS is equivalent to:
  88
  89   (allow-with-interrupts (with-interrupts ...))
  90
  91 Care must be taken not to let either ALLOW-WITH-INTERRUPTS or
  92 WITH-LOCAL-INTERRUPTS appear in a function that escapes from inside the
  93 WITHOUT-INTERRUPTS in:
  94
  95   (without-interrupts
  96     ;; The body of the lambda would be executed with WITH-INTERRUPTS allowed
  97     ;; regardless of the interrupt policy in effect when it is called.
  98     (lambda () (allow-with-interrupts ...)))
  99
 100   (without-interrupts
 101     ;; The body of the lambda would be executed with interrupts enabled
 102     ;; regardless of the interrupt policy in effect when it is called.
 103     (lambda () (with-local-interrupts ...)))
 104 "
 105   (with-unique-names (outer-allow-with-interrupts without-interrupts-body)
 106     `(dx-flet ((,without-interrupts-body ()
 107               (declare (disable-package-locks allow-with-interrupts
 108                                               with-local-interrupts))
 109               (macrolet
 110                   ((allow-with-interrupts
 111                      (&body allow-forms)
 112                      `(let ((*allow-with-interrupts*
 113                              ,',outer-allow-with-interrupts))
 114                         ,@allow-forms))
 115                    (with-local-interrupts
 116                      (&body with-forms)
 117                      `(let ((*allow-with-interrupts*
 118                              ,',outer-allow-with-interrupts)
 119                             (*interrupts-enabled*
 120                              ,',outer-allow-with-interrupts))
 121                         (when ,',outer-allow-with-interrupts
 122                           (when *unblock-deferrables-on-enabling-interrupts-p*
 123                             (setq *unblock-deferrables-on-enabling-interrupts-p*
 124                                   nil)
 125                             (sb!unix::unblock-deferrable-signals))
 126                           (when (or *interrupt-pending*
 127                                     #!+sb-thruption *thruption-pending*)
 128                             (receive-pending-interrupt)))
 129                         (locally ,@with-forms))))
 130                 (let ((*interrupts-enabled* nil)
 131                       (,outer-allow-with-interrupts *allow-with-interrupts*)
 132                       (*allow-with-interrupts* nil))
 133                   (declare (ignorable ,outer-allow-with-interrupts))
 134                   (declare (enable-package-locks allow-with-interrupts
 135                                                  with-local-interrupts))
 136                   ,@body))))
 137        (if *interrupts-enabled*
 138            (unwind-protect
 139                 (,without-interrupts-body)
 140              ;; If we were interrupted in the protected section,
 141              ;; then the interrupts are still blocked and it remains
 142              ;; so until the pending interrupt is handled.
 143              ;;
 144              ;; If we were not interrupted in the protected section,
 145              ;; but here, then even if the interrupt handler enters
 146              ;; another WITHOUT-INTERRUPTS, the pending interrupt will be
 147              ;; handled immediately upon exit from said
 148              ;; WITHOUT-INTERRUPTS, so it is as if nothing has happened.
 149              (when (or *interrupt-pending*
 150                        #!+sb-thruption *thruption-pending*)
 151                (receive-pending-interrupt)))
 152            (,without-interrupts-body)))))
 153
 154 (sb!xc:defmacro with-interrupts (&body body)
 155   #!+sb-doc
 156   "Executes BODY with deferrable interrupts conditionally enabled. If there
 157 are pending interrupts they take effect prior to executing BODY.
 158
 159 As interrupts are normally allowed WITH-INTERRUPTS only makes sense if there
 160 is an outer WITHOUT-INTERRUPTS with a corresponding ALLOW-WITH-INTERRUPTS:
 161 interrupts are not enabled if any outer WITHOUT-INTERRUPTS is not accompanied
 162 by ALLOW-WITH-INTERRUPTS."
 163   (with-unique-names (allowp enablep)
 164     ;; We could manage without ENABLEP here, but that would require
 165     ;; taking extra care not to ever have *ALLOW-WITH-INTERRUPTS* NIL
 166     ;; and *INTERRUPTS-ENABLED* T -- instead of risking future breakage
 167     ;; we take the tiny hit here.
 168     `(let* ((,allowp *allow-with-interrupts*)
 169             (,enablep *interrupts-enabled*)
 170             (*interrupts-enabled* (or ,enablep ,allowp)))
 171        (when (and ,allowp (not ,enablep))
 172          (when *unblock-deferrables-on-enabling-interrupts-p*
 173            (setq *unblock-deferrables-on-enabling-interrupts-p* nil)
 174            (sb!unix::unblock-deferrable-signals))
 175          (when (or *interrupt-pending*
 176                    #!+sb-thruption *thruption-pending*)
 177            (receive-pending-interrupt)))
 178        (locally ,@body))))
 179
 180 (defmacro allow-with-interrupts (&body body)
 181   (declare (ignore body))
 182   (error "~S is valid only inside ~S."
 183          'allow-with-interrupts 'without-interrupts))
 184
 185 (defmacro with-local-interrupts (&body body)
 186   (declare (ignore body))
 187   (error "~S is valid only inside ~S."
 188          'with-local-interrupts 'without-interrupts))
 189
 190 ;;; A low-level operation that assumes that *INTERRUPTS-ENABLED* is
 191 ;;; false, *ALLOW-WITH-INTERRUPTS* is true and deferrable signals are
 192 ;;; unblocked.
 193 (defun %check-interrupts ()
 194   ;; Here we check for pending interrupts first, because reading a
 195   ;; special is faster then binding it!
 196   (when (or *interrupt-pending* #!+sb-thruption *thruption-pending*)
 197     (let ((*interrupts-enabled* t))
 198       (receive-pending-interrupt))))