Let SIGALRM do its thing even if we're on the right millisecond.

If we request a timer interrupt now in logic that closes a lot of
files, which runs through %deregister-io-descriptor, it looks like
_all_ the time is spent in closing files even if it's merely the case
that at least one file is closed every millisecond.

If we instead let SIGALRM do its thing, unless the interrupt is
_overdue_, then the profiler can discriminate at sub-millisecond
resolution where the time is spent which is what I really want.

(cherry picked from commit 6748a3cf190f5232d25483f15a833e8a61e706be)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 4977ea0d7047a9392420732faee338f581d21d8e..3e840c17806d0a597e9711eac6b309219a2c25f1 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -1147,12 +1147,20 @@ USA.
       (cond (timer-records
             (let ((next-event-time (timer-record/time timer-records)))
               (if (<= next-event-time now)
-                  ;; Don't set the timer to non-positive values.
-                  ;; Instead signal the interrupt now.  This is ugly
-                  ;; but much simpler than refactoring the scheduler
-                  ;; so that we can do the right thing here.
-                  ((ucode-primitive request-interrupts! 1)
-                   interrupt-bit/timer)
+                  ;; We're due.  If the timer is already scheduled for
+                  ;; the next event time, let it fire when it is ready
+                  ;; -- it's a difference of microseconds.  Otherwise,
+                  ;; if we're overdue, request a timer interrupt now.
+                  (if (or (not next-scheduled-timeout)
+                          (< next-event-time next-scheduled-timeout))
+                      (begin
+                        ;; Don't set the timer to non-positive values.
+                        ;; Instead signal the interrupt now.  This is ugly
+                        ;; but much simpler than refactoring the scheduler
+                        ;; so that we can do the right thing here.
+                        (set! next-scheduled-timeout now)
+                        ((ucode-primitive request-interrupts! 1)
+                         interrupt-bit/timer)))
                   (start
                    (if (and consider-non-timers? timer-interval)
                        (min next-event-time (+ now timer-interval))