+ (progn
+ (setf foo (get-foo))
+ (funcall function foo))
+ (when foo
+ (release-foo foo)))))
+
+If TIMEOUT occurs after GET-FOO has executed, but before the assignment, then
+RELEASE-FOO will be missed. While individual sites like this can be made proof
+against asynchronous unwinds, this doesn't solve the fundamental issue, as all
+the frames potentially unwound through need to be proofed, which includes both
+system and application code -- and in essence proofing everything will make
+the system uninterruptible."
+ (with-unique-names (timer)
+ ;; FIXME: a temporary compatibility workaround for CLX, if unsafe
+ ;; unwinds are handled revisit it.
+ `(if (> ,expires 0)
+ (let ((,timer (make-timer (lambda ()
+ (cerror "Continue" 'sb!ext::timeout)))))
+ (schedule-timer ,timer ,expires)
+ (unwind-protect
+ (progn ,@body)
+ (unschedule-timer ,timer)))
+ (progn ,@body))))