+(defun make-cancellable-interruptor (timer)
+ ;; return a list of two functions: one that does the same as
+ ;; FUNCTION until the other is called, from when it does nothing.
+ (let ((mutex (sb!thread:make-mutex))
+ (cancelledp nil)
+ (function (if (%timer-repeat-interval timer)
+ (lambda ()
+ (unwind-protect
+ (funcall (%timer-function timer))
+ (reschedule-timer timer)))
+ (%timer-function timer))))
+ (list
+ (lambda ()
+ ;; Use WITHOUT-INTERRUPTS for the acquiring lock to avoid
+ ;; unblocking deferrables unless it's inevitable.
+ (without-interrupts
+ (sb!thread:with-recursive-lock (mutex)
+ (unless cancelledp
+ (allow-with-interrupts
+ (funcall function))))))
+ (lambda ()
+ (sb!thread:with-recursive-lock (mutex)
+ (setq cancelledp t))))))
+