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 (defvar *interrupts-enabled* t)
  41 (defvar *interrupt-pending* nil)
  42
  43 ;;; KLUDGE: This tells INTERRUPT-THREAD that it is being invoked as an
  44 ;;; interruption, so that if the thread being interrupted is the
  45 ;;; current thread it knows to enable interrupts. INVOKE-INTERRUPTION
  46 ;;; binds it to T, and WITHOUT-INTERRUPTS binds it to NIL, so that if
  47 ;;; interrupts are disable between INTERRUPT-THREAD and this we don't
  48 ;;; accidentally re-enable them.
  49 (defvar *in-interruption* nil)
  50
  51 (sb!xc:defmacro without-interrupts (&body body)
  52   #!+sb-doc
  53   "Execute BODY with all deferrable interrupts deferred. Deferrable interrupts
  54 include most blockable POSIX signals, and SB-THREAD:INTERRUPT-THREAD. Does not
  55 interfere with garbage collection, and unlike in many traditional Lisps using
  56 userspace threads, in SBCL WITHOUT-INTERRUPTS does not inhibit scheduling of
  57 other threads."
  58   (let ((name (gensym "WITHOUT-INTERRUPTS-BODY-")))
  59     `(flet ((,name () ,@body))
  60        (if *interrupts-enabled*
  61            (unwind-protect
  62                 (let ((*interrupts-enabled* nil)
  63                       (*in-interruption* nil))
  64                   (,name))
  65              ;; If we were interrupted in the protected section, then
  66              ;; the interrupts are still blocked and it remains so
  67              ;; until the pending interrupt is handled.
  68              ;;
  69              ;; If we were not interrupted in the protected section,
  70              ;; but here, then even if the interrupt handler enters
  71              ;; another WITHOUT-INTERRUPTS, the pending interrupt will
  72              ;; be handled immediately upon exit from said
  73              ;; WITHOUT-INTERRUPTS, so it is as if nothing has
  74              ;; happened.
  75              (when *interrupt-pending*
  76                (receive-pending-interrupt)))
  77            (,name)))))
  78
  79 (sb!xc:defmacro with-interrupts (&body body)
  80   #!+sb-doc
  81   "Allow interrupts while executing BODY. As interrupts are normally allowed,
  82 this is only useful inside a SB-SYS:WITHOUT-INTERRUPTS. Signals a runtime
  83 warning if used inside the dynamic countour of SB-SYS:WITHOUT-GCING."
  84   (let ((name (gensym)))
  85     `(flet ((,name () ,@body))
  86        (if *interrupts-enabled*
  87            (,name)
  88            (progn
  89              (when sb!kernel:*gc-inhibit*
  90                (warn "Re-enabling interrupts while GC is inhibited."))
  91              (let ((*interrupts-enabled* t))
  92                (when *interrupt-pending*
  93                  (receive-pending-interrupt))
  94                (,name)))))))