(when (or (null timer)
(< (get-internal-real-time)
(%timer-expire-time timer)))
+ ;; Seemingly this is a spurious SIGALRM, but play it safe and
+ ;; reset the system timer because if the system clock was set
+ ;; back after the SIGALRM had been delivered then we won't get
+ ;; another chance.
+ (set-system-timer)
(return-from run-expired-timers nil))
(assert (eq timer (priority-queue-extract-maximum *schedule*)))
(set-system-timer))
(run-timer timer)))
+(defun timeout-cerror ()
+ (cerror "Continue" 'sb!ext::timeout))
+
(defmacro sb!ext:with-timeout (expires &body body)
#!+sb-doc
"Execute the body, asynchronously interrupting it and signalling a TIMEOUT
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))))
+ `(dx-flet ((timeout-body () ,@body))
+ (let ((expires ,expires))
+ ;; FIXME: a temporary compatibility workaround for CLX, if unsafe
+ ;; unwinds are handled revisit it.
+ (if (> expires 0)
+ (let ((timer (make-timer #'timeout-cerror)))
+ (schedule-timer timer expires)
+ (unwind-protect (timeout-body)
+ (unschedule-timer timer)))
+ (timeout-body)))))