(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
(lambda () (with-local-interrupts ...)))
"
(with-unique-names (outer-allow-with-interrupts without-interrupts-body)
- `(flet ((,without-interrupts-body ()
+ `(dx-flet ((,without-interrupts-body ()
(declare (disable-package-locks allow-with-interrupts
with-local-interrupts))
(macrolet
,',outer-allow-with-interrupts)
(*interrupts-enabled*
,',outer-allow-with-interrupts))
- (when (and ,',outer-allow-with-interrupts
- *interrupt-pending*)
- (receive-pending-interrupt))
+ (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*)
;; 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*
+ (when (or *interrupt-pending*
+ #!+sb-thruption *thruption-pending*)
(receive-pending-interrupt)))
(,without-interrupts-body)))))
`(let* ((,allowp *allow-with-interrupts*)
(,enablep *interrupts-enabled*)
(*interrupts-enabled* (or ,enablep ,allowp)))
- (when (and (and ,allowp (not ,enablep)) *interrupt-pending*)
- (receive-pending-interrupt))
+ (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)
(error "~S is valid only inside ~S."
'with-local-interrupts 'without-interrupts))
-;;; A low-level operation that assumes that *INTERRUPTS-ENABLED* is false,
-;;; and *ALLOW-WITH-INTERRUPTS* is true.
+;;; 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))))