(defvar *interrupts-enabled* t)
(defvar *interrupt-pending* nil)
+#!+sb-thruption (defvar *thruption-pending* nil)
(defvar *allow-with-interrupts* t)
+;;; This is to support signal handlers that want to return to the
+;;; interrupted context without leaving anything extra on the stack. A
+;;; simple
+;;;
+;;; (without-interrupts
+;;; (unblock-deferrable-signals)
+;;; (allow-with-interrupts ...))
+;;;
+;;; would not cut it, as upon leaving WITHOUT-INTERRUPTS the pending
+;;; handlers is run with stuff from the function in which this is
+;;; still on the stack.
+(defvar *unblock-deferrables-on-enabling-interrupts-p* nil)
(sb!xc:defmacro without-interrupts (&body body)
#!+sb-doc
;; regardless of the interrupt policy in effect when it is called.
(lambda () (with-local-interrupts ...)))
"
- (with-unique-names (outer-allow-with-interrupts)
- `(call-without-interrupts
- (lambda (,outer-allow-with-interrupts)
- (declare (disable-package-locks allow-with-interrupts with-interrupts)
- (ignorable ,outer-allow-with-interrupts))
- (macrolet ((allow-with-interrupts (&body allow-forms)
- `(call-allowing-with-interrupts
- (lambda () ,@allow-forms)
- ,',outer-allow-with-interrupts))
- (with-local-interrupts (&body with-forms)
- `(call-with-local-interrupts
- (lambda () ,@with-forms)
- ,',outer-allow-with-interrupts)))
- (declare (enable-package-locks allow-with-interrupts with-interrupts))
- ,@body)))))
+ (with-unique-names (outer-allow-with-interrupts without-interrupts-body)
+ `(dx-flet ((,without-interrupts-body ()
+ (declare (disable-package-locks allow-with-interrupts
+ with-local-interrupts))
+ (macrolet
+ ((allow-with-interrupts
+ (&body allow-forms)
+ `(let ((*allow-with-interrupts*
+ ,',outer-allow-with-interrupts))
+ ,@allow-forms))
+ (with-local-interrupts
+ (&body with-forms)
+ `(let ((*allow-with-interrupts*
+ ,',outer-allow-with-interrupts)
+ (*interrupts-enabled*
+ ,',outer-allow-with-interrupts))
+ (when ,',outer-allow-with-interrupts
+ (when *unblock-deferrables-on-enabling-interrupts-p*
+ (setq *unblock-deferrables-on-enabling-interrupts-p*
+ nil)
+ (sb!unix::unblock-deferrable-signals))
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
+ (receive-pending-interrupt)))
+ (locally ,@with-forms))))
+ (let ((*interrupts-enabled* nil)
+ (,outer-allow-with-interrupts *allow-with-interrupts*)
+ (*allow-with-interrupts* nil))
+ (declare (ignorable ,outer-allow-with-interrupts))
+ (declare (enable-package-locks allow-with-interrupts
+ with-local-interrupts))
+ ,@body))))
+ (if *interrupts-enabled*
+ (unwind-protect
+ (,without-interrupts-body)
+ ;; If we were interrupted in the protected section,
+ ;; then the interrupts are still blocked and it remains
+ ;; so until the pending interrupt is handled.
+ ;;
+ ;; If we were not interrupted in the protected section,
+ ;; but here, then even if the interrupt handler enters
+ ;; another WITHOUT-INTERRUPTS, the pending interrupt will be
+ ;; handled immediately upon exit from said
+ ;; WITHOUT-INTERRUPTS, so it is as if nothing has happened.
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
+ (receive-pending-interrupt)))
+ (,without-interrupts-body)))))
(sb!xc:defmacro with-interrupts (&body body)
#!+sb-doc
is an outer WITHOUT-INTERRUPTS with a corresponding ALLOW-WITH-INTERRUPTS:
interrupts are not enabled if any outer WITHOUT-INTERRUPTS is not accompanied
by ALLOW-WITH-INTERRUPTS."
- `(call-with-interrupts
- (lambda () ,@body)
- (and (not *interrupts-enabled*) *allow-with-interrupts*)))
-
-(defun call-allowing-with-interrupts (function allowp)
- (declare (function function))
- (if allowp
- (let ((*allow-with-interrupts* t))
- (funcall function))
- (funcall function)))
-
-(defun call-with-interrupts (function allowp)
- (declare (function function))
- (if allowp
- (let ((*interrupts-enabled* t))
- (when *interrupt-pending*
- (receive-pending-interrupt))
- (funcall function))
- (funcall function)))
-
-;; Distinct from CALL-WITH-INTERRUPTS as it needs to bind both *A-W-I*
-;; and *I-E*.
-(defun call-with-local-interrupts (function allowp)
- (declare (function function))
- (if allowp
- (let* ((*allow-with-interrupts* t)
- (*interrupts-enabled* t))
- (when *interrupt-pending*
- (receive-pending-interrupt))
- (funcall function))
- (funcall function)))
-
-(defun call-without-interrupts (function)
- (declare (function function))
- (flet ((run-without-interrupts ()
- (if *allow-with-interrupts*
- (let ((*allow-with-interrupts* nil))
- (funcall function t))
- (funcall function nil))))
- (if *interrupts-enabled*
- (unwind-protect
- (let ((*interrupts-enabled* nil))
- (run-without-interrupts))
- ;; If we were interrupted in the protected section, then the
- ;; interrupts are still blocked and it remains so until the
- ;; pending interrupt is handled.
- ;;
- ;; If we were not interrupted in the protected section, but
- ;; here, then even if the interrupt handler enters another
- ;; WITHOUT-INTERRUPTS, the pending interrupt will be handled
- ;; immediately upon exit from said WITHOUT-INTERRUPTS, so it
- ;; is as if nothing has happened.
- (when *interrupt-pending*
- (receive-pending-interrupt)))
- (run-without-interrupts))))
-
-;;; A low-level operation that assumes that *INTERRUPTS-ENABLED* is false,
-;;; and *ALLOW-WITH-INTERRUPTS* is true.
+ (with-unique-names (allowp enablep)
+ ;; We could manage without ENABLEP here, but that would require
+ ;; taking extra care not to ever have *ALLOW-WITH-INTERRUPTS* NIL
+ ;; and *INTERRUPTS-ENABLED* T -- instead of risking future breakage
+ ;; we take the tiny hit here.
+ `(let* ((,allowp *allow-with-interrupts*)
+ (,enablep *interrupts-enabled*)
+ (*interrupts-enabled* (or ,enablep ,allowp)))
+ (when (and ,allowp (not ,enablep))
+ (when *unblock-deferrables-on-enabling-interrupts-p*
+ (setq *unblock-deferrables-on-enabling-interrupts-p* nil)
+ (sb!unix::unblock-deferrable-signals))
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
+ (receive-pending-interrupt)))
+ (locally ,@body))))
+
+(defmacro allow-with-interrupts (&body body)
+ (declare (ignore body))
+ (error "~S is valid only inside ~S."
+ 'allow-with-interrupts 'without-interrupts))
+
+(defmacro with-local-interrupts (&body body)
+ (declare (ignore body))
+ (error "~S is valid only inside ~S."
+ 'with-local-interrupts 'without-interrupts))
+
+;;; A low-level operation that assumes that *INTERRUPTS-ENABLED* is
+;;; false, *ALLOW-WITH-INTERRUPTS* is true and deferrable signals are
+;;; unblocked.
(defun %check-interrupts ()
- ;; Here we check for pending interrupts first, because reading a special
- ;; is faster then binding it!
- (when *interrupt-pending*
+ ;; Here we check for pending interrupts first, because reading a
+ ;; special is faster then binding it!
+ (when (or *interrupt-pending* #!+sb-thruption *thruption-pending*)
(let ((*interrupts-enabled* t))
(receive-pending-interrupt))))
projects / sbcl.git / blobdiff