- ;; FIXME: This is wrong. Imagine the following sequence:
- ;;
- ;; 1. an asynch interrupt arrives after entry to
- ;; WITHOUT-INTERRUPTS but before RESET-SIGNAL-MASK: pending
- ;; machinery blocks all signals and marks the signal as
- ;; pending.
- ;;
- ;; 2. RESET-SIGNAL-MASK is called, and all signals are unblocked.
- ;;
- ;; 3. Another signal arrives while we already have one pending.
- ;; Oops -- we lose().
- ;;
- ;; Not sure what the right thing is, but definitely not
- ;; RESET-SIGNAL-MASK. Removing it breaks signals.impure.lisp
- ;; right now, though, and this is a rare race, so...
- (reset-signal-mask)
- (funcall function)))
-
-(defmacro in-interruption ((&rest args) &body body)
+ ;; Reset signal mask: the C-side handler has blocked all
+ ;; deferrable signals before funcalling into lisp. They are to be
+ ;; unblocked the first time interrupts are enabled. With this
+ ;; mechanism there are no extra frames on the stack from a
+ ;; previous signal handler when the next signal is delivered
+ ;; provided there is no WITH-INTERRUPTS.
+ (let ((*unblock-deferrables-on-enabling-interrupts-p* t))
+ (with-interrupt-bindings
+ (let ((sb!debug:*stack-top-hint*
+ (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
+ (allow-with-interrupts
+ (nlx-protect (funcall function)
+ ;; We've been running with deferrables
+ ;; blocked in Lisp called by a C signal
+ ;; handler. If we return normally the sigmask
+ ;; in the interrupted context is restored.
+ ;; However, if we do an nlx the operating
+ ;; system will not restore it for us.
+ (when *unblock-deferrables-on-enabling-interrupts-p*
+ ;; This means that storms of interrupts
+ ;; doing an nlx can still run out of stack.
+ (unblock-deferrable-signals)))))))))
+
+(defmacro in-interruption ((&key) &body body)