- ;; not quite perfect, because it does not take WITHOUT-INTERRUPTS
- ;; into account
- #!-sb-thread
- (funcall function)
- #!+sb-thread
- (if (eq thread *current-thread*)
- (funcall function)
- (let ((os-thread (thread-os-thread thread)))
- (cond ((not os-thread)
- (error 'interrupt-thread-error :thread thread))
- (t
- (with-interruptions-lock (thread)
- (push function (thread-interruptions thread)))
- (when (minusp (signal-interrupt-thread os-thread))
- (error 'interrupt-thread-error :thread thread)))))))
+ (flet ((interrupt-self ()
+ ;; *IN-INTERRUPTION* is true IFF we're being called as an
+ ;; interruption without an intervening WITHOUT-INTERRUPTS,
+ ;; in which case it is safe to enable interrupts. Otherwise
+ ;; interrupts are either already enabled, or there is an outer
+ ;; WITHOUT-INTERRUPTS we know nothing about, which makes it
+ ;; unsafe to enable interrupts.
+ (if *in-interruption*
+ (with-interrupts (funcall function))
+ (funcall function))))
+ #!-sb-thread
+ (interrupt-self)
+ #!+sb-thread
+ (if (eq thread *current-thread*)
+ (interrupt-self)
+ (let ((os-thread (thread-os-thread thread)))
+ (cond ((not os-thread)
+ (error 'interrupt-thread-error :thread thread))
+ (t
+ (with-interruptions-lock (thread)
+ (push function (thread-interruptions thread)))
+ (when (minusp (signal-interrupt-thread os-thread))
+ (error 'interrupt-thread-error :thread thread))))))))