X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftimer.lisp;h=381e363a5293479de60360df07ac7fa730dd5217;hb=f741a144c386acdb82cac2e3352abab7cff65f1d;hp=b84168a1147ec33d5d60ae26ee9310999a0aabcd;hpb=80356ce0ff12379e93a9df74dd65433c415f7aae;p=sbcl.git

diff --git a/src/code/timer.lisp b/src/code/timer.lisp
index b84168a..381e363 100644
--- a/src/code/timer.lisp
+++ b/src/code/timer.lisp
@@ -355,18 +355,26 @@ triggers."
               (warn "Timer ~S failed to interrupt thread ~S."
                     timer thread)))))))
 
-;;; Called from the signal handler.
+;;; Called from the signal handler. We loop until all the expired timers
+;;; have been run.
 (defun run-expired-timers ()
-  (let (timer)
-    (with-scheduler-lock ()
-      (setq timer (peek-schedule))
-      (when (or (null timer)
-                (< (get-internal-real-time)
-                   (%timer-expire-time timer)))
-        (return-from run-expired-timers nil))
-      (assert (eq timer (priority-queue-extract-maximum *schedule*)))
-      (set-system-timer))
-    (run-timer timer)))
+  (loop
+    (let ((now (get-internal-real-time))
+          (timers nil))
+      (flet ((run-timers ()
+               (dolist (timer (nreverse timers))
+                 (run-timer timer))))
+        (with-scheduler-lock ()
+          (loop for timer = (peek-schedule)
+                when (or (null timer) (< now (%timer-expire-time timer)))
+                ;; No more timers to run for now, reset the system timer.
+                do (run-timers)
+                   (set-system-timer)
+                   (return-from run-expired-timers nil)
+                else
+                do (assert (eq timer (priority-queue-extract-maximum *schedule*)))
+                   (push timer timers)))
+        (run-timers)))))
 
 (defun timeout-cerror ()
   (cerror "Continue" 'sb!ext::timeout))