1.0.4.49: revert debugger hackery
[sbcl.git] / 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 (sb!xc:defmacro without-interrupts (&body body)
44   #!+sb-doc
45   "Execute BODY with all deferrable interrupts deferred. Deferrable interrupts
46 include most blockable POSIX signals, and SB-THREAD:INTERRUPT-THREAD. Does not
47 interfere with garbage collection, and unlike in many traditional Lisps using
48 userspace threads, in SBCL WITHOUT-INTERRUPTS does not inhibit scheduling of
49 other threads."
50   (let ((name (gensym "WITHOUT-INTERRUPTS-BODY-")))
51     `(flet ((,name () ,@body))
52        (if *interrupts-enabled*
53            (unwind-protect
54                 (let ((*interrupts-enabled* nil))
55                   (,name))
56              ;; If we were interrupted in the protected section, then
57              ;; the interrupts are still blocked and it remains so
58              ;; until the pending interrupt is handled.
59              ;;
60              ;; If we were not interrupted in the protected section,
61              ;; but here, then even if the interrupt handler enters
62              ;; another WITHOUT-INTERRUPTS, the pending interrupt will
63              ;; be handled immediately upon exit from said
64              ;; WITHOUT-INTERRUPTS, so it is as if nothing has
65              ;; happened.
66              (when *interrupt-pending*
67                (receive-pending-interrupt)))
68            (,name)))))
69
70 (sb!xc:defmacro with-interrupts (&body body)
71   #!+sb-doc
72   "Allow interrupts while executing BODY. As interrupts are normally allowed,
73 this is only useful inside a SB-SYS:WITHOUT-INTERRUPTS. Signals a runtime
74 warning if used inside the dynamic countour of SB-SYS:WITHOUT-GCING."
75   (let ((name (gensym)))
76     `(flet ((,name () ,@body))
77        (if *interrupts-enabled*
78            (,name)
79            (progn
80              (when sb!kernel:*gc-inhibit*
81                (warn "Re-enabling interrupts while GC is inhibited."))
82              (let ((*interrupts-enabled* t))
83                (when *interrupt-pending*
84                  (receive-pending-interrupt))
85                (,name)))))))