X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftimer.lisp;h=3ad04ea8cb20d570f873f3bce02a2ef1783f9e0a;hb=dcb73f3edef1e31078fbe585e2fafbd26743efd7;hp=7f49302e9de247fe10ca22ab07eb0eaa9ef97d08;hpb=1aee76da48edafa210f60e852913041a843428b7;p=sbcl.git diff --git a/src/code/timer.lisp b/src/code/timer.lisp index 7f49302..3ad04ea 100644 --- a/src/code/timer.lisp +++ b/src/code/timer.lisp @@ -208,9 +208,9 @@ from now. For timers with a repeat interval it returns true." ,@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)) @@ -337,21 +337,24 @@ triggers." (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))))