(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)))))))))
+ (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
+ (sb!thread::without-thread-waiting-for (:already-without-interrupts t)
+ (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)
#!+sb-doc
(flet ((interrupt-it ()
(with-alien ((context (* os-context-t) context))
(with-interrupts
- (%break 'sigint 'interactive-interrupt
- :context context
- :address (sap-int (sb!vm:context-pc context)))))))
+ (let ((int (make-condition 'interactive-interrupt
+ :context context
+ :address (sap-int (sb!vm:context-pc context)))))
+ ;; First SIGNAL, so that handlers can run.
+ (signal int)
+ ;; Then enter the debugger like BREAK.
+ (%break 'sigint int))))))
(sb!thread:interrupt-thread (sb!thread::foreground-thread)
#'interrupt-it)))