- (with-unique-names (outer-allow-with-interrupts)
- `(dx-flet ((without-interrupts-thunk (,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)
- `(dx-flet ((allow-with-interrupts-thunk ()
- ,@allow-forms))
- (call-allowing-with-interrupts
- #'allow-with-interrupts-thunk
- ,',outer-allow-with-interrupts)))
- (with-local-interrupts (&body with-forms)
- `(dx-flet ((with-local-interrupts-thunk ()
- ,@with-forms))
- (call-with-local-interrupts
- #'with-local-interrupts-thunk
- ,',outer-allow-with-interrupts))))
- (declare (enable-package-locks allow-with-interrupts
- with-interrupts))
- ,@body)))
- (call-without-interrupts #'without-interrupts-thunk))))
+ (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)))))