- "Execute BODY with all deferrable interrupts deferred. Deferrable interrupts
-include most blockable POSIX signals, and SB-THREAD:INTERRUPT-THREAD. Does not
-interfere with garbage collection, and unlike in many traditional Lisps using
-userspace threads, in SBCL WITHOUT-INTERRUPTS does not inhibit scheduling of
-other threads."
- (let ((name (gensym "WITHOUT-INTERRUPTS-BODY-")))
- `(flet ((,name () ,@body))
+ "Executes BODY with all deferrable interrupts disabled. Deferrable
+interrupts arriving during execution of the BODY take effect after BODY has
+been executed.
+
+Deferrable interrupts include most blockable POSIX signals, and
+SB-THREAD:INTERRUPT-THREAD. Does not interfere with garbage collection, and
+unlike in many traditional Lisps using userspace threads, in SBCL
+WITHOUT-INTERRUPTS does not inhibit scheduling of other threads.
+
+Binds ALLOW-WITH-INTERRUPTS and WITH-LOCAL-INTERRUPTS as a local macros.
+
+ALLOW-WITH-INTERRUPTS allows the WITH-INTERRUPTS to take effect during the
+dynamic scope of its body, unless there is an outer WITHOUT-INTERRUPTS without
+a corresponding ALLOW-WITH-INTERRUPTS.
+
+WITH-LOCAL-INTERRUPTS executes its body with interrupts enabled provided that
+for there is an ALLOW-WITH-INTERRUPTS for every WITHOUT-INTERRUPTS surrounding
+the current one. WITH-LOCAL-INTERRUPTS is equivalent to:
+
+ (allow-with-interrupts (with-interrupts ...))
+
+Care must be taken not to let either ALLOW-WITH-INTERRUPTS or
+WITH-LOCAL-INTERRUPTS appear in a function that escapes from inside the
+WITHOUT-INTERRUPTS in:
+
+ (without-interrupts
+ ;; The body of the lambda would be executed with WITH-INTERRUPTS allowed
+ ;; regardless of the interrupt policy in effect when it is called.
+ (lambda () (allow-with-interrupts ...)))
+
+ (without-interrupts
+ ;; The body of the lambda would be executed with interrupts enabled
+ ;; regardless of the interrupt policy in effect when it is called.
+ (lambda () (with-local-interrupts ...)))
+"
+ (with-unique-names (outer-allow-with-interrupts without-interrupts-body)
+ `(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 (and ,',outer-allow-with-interrupts *interrupt-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))))