- "Allow interrupts while executing BODY. As interrupts are normally allowed,
-this is only useful inside a SB-SYS:WITHOUT-INTERRUPTS. Signals a runtime
-warning if used inside the dynamic countour of SB-SYS:WITHOUT-GCING."
- (let ((name (gensym)))
- `(flet ((,name () ,@body))
- (if *interrupts-enabled*
- (,name)
- (progn
- (when sb!kernel:*gc-inhibit*
- (warn "Re-enabling interrupts while GC is inhibited."))
- (let ((*interrupts-enabled* t))
- (when *interrupt-pending*
- (receive-pending-interrupt))
- (,name)))))))
+ "Executes BODY with deferrable interrupts conditionally enabled. If there
+are pending interrupts they take effect prior to executing BODY.
+
+As interrupts are normally allowed WITH-INTERRUPTS only makes sense if there
+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."
+ `(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))))
+
+;;; A low-level operation that assumes that *INTERRUPTS-ENABLED* is false,
+;;; and *ALLOW-WITH-INTERRUPTS* is true.
+(defun %check-interrupts ()
+ ;; Here we check for pending interrupts first, because reading a special
+ ;; is faster then binding it!
+ (when *interrupt-pending*
+ (let ((*interrupts-enabled* t))
+ (receive-pending-interrupt))))