(in-package "SB!UNIX")
+(defmacro with-interrupt-bindings (&body body)
+ (with-unique-names (empty)
+ `(let*
+ ;; KLUDGE: Whatever is on the PCL stacks before the interrupt
+ ;; handler runs doesn't really matter, since we're not on the
+ ;; same call stack, really -- and if we don't bind these (esp.
+ ;; the cache one) we can get a bogus metacircle if an interrupt
+ ;; handler calls a GF that was being computed when the interrupt
+ ;; hit.
+ ((sb!pcl::*cache-miss-values-stack* nil)
+ (sb!pcl::*dfun-miss-gfs-on-stack* nil)
+ ;; Unless we do this, ADJUST-ARRAY and SORT would need to
+ ;; disable interrupts.
+ (,empty (vector))
+ (sb!impl::*zap-array-data-temp* ,empty)
+ (sb!impl::*merge-sort-temp-vector* ,empty))
+ ,@body)))
+
(defun invoke-interruption (function)
(without-interrupts
- ;; 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)
+ (with-interrupt-bindings
+ ;; Reset signal mask: the C-side handler has blocked all
+ ;; deferrable interrupts before arranging return to lisp. This is
+ ;; safe because we can't get a pending interrupt before we unblock
+ ;; signals.
+ ;;
+ ;; FIXME: Should we not reset the _entire_ mask, but just
+ ;; restore it to the state before we got the interrupt?
+ (reset-signal-mask)
+ (let ((sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
+ (allow-with-interrupts (funcall function))))))
+
+(defmacro in-interruption ((&key) &body body)
#!+sb-doc
"Convenience macro on top of INVOKE-INTERRUPTION."
- `(invoke-interruption (lambda () ,@body) ,@args))
+ `(dx-flet ((interruption () ,@body))
+ (invoke-interruption #'interruption)))
\f
;;;; system calls that deal with signals
(declare (type (or function fixnum (member :default :ignore)) handler))
(/show0 "enable-interrupt")
(flet ((run-handler (&rest args)
+ (declare (truly-dynamic-extent args))
(in-interruption ()
(apply handler args))))
(without-gcing