- `(dx-flet ((with-interrupts-thunk () ,@body))
- (call-with-interrupts
- #'with-interrupts-thunk
- (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))))
+ (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 (and ,allowp (not ,enablep)) *interrupt-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))