,@body)))
(defun under-scheduler-lock-p ()
- #!-sb!thread
+ #!-sb-thread
t
- #!+sb!thread
+ #!+sb-thread
(eq sb!thread:*current-thread* (sb!thread:mutex-value *scheduler-lock*)))
(defparameter *schedule* (make-priority-queue :key #'%timer-expire-time))
(handler-case
(sb!thread:interrupt-thread thread function)
(sb!thread:interrupt-thread-error (c)
- (warn c)))))))
+ (declare (ignore c))
+ (warn "Timer ~S failed to interrupt thread ~S."
+ timer thread)))))))
+;; Called from the signal handler.
(defun run-expired-timers ()
(unwind-protect
- (let (timer)
- (loop
- (with-scheduler-lock ()
- (setq timer (peek-schedule))
- (unless (and timer
- (> (get-internal-real-time)
- (%timer-expire-time timer)))
- (return-from run-expired-timers nil))
- (assert (eq timer (priority-queue-extract-maximum *schedule*))))
- ;; run the timer without the lock
- (run-timer timer)))
+ (with-interrupts
+ (let (timer)
+ (loop
+ (with-scheduler-lock ()
+ (setq timer (peek-schedule))
+ (unless (and timer
+ (> (get-internal-real-time)
+ (%timer-expire-time timer)))
+ (return-from run-expired-timers nil))
+ (assert (eq timer (priority-queue-extract-maximum *schedule*))))
+ ;; run the timer without the lock
+ (run-timer timer))))
(with-scheduler-lock ()
(set-system-timer))))
"Execute the body, asynchronously interrupting it and signalling a
TIMEOUT condition after at least EXPIRES seconds have passed."
(with-unique-names (timer)
- `(let ((,timer (make-timer (lambda ()
- (cerror "Continue" 'sb!ext::timeout)))))
- (schedule-timer ,timer ,expires)
- (unwind-protect
- (progn ,@body)
- (unschedule-timer ,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))))