From 41149789e922b385fb8fc611033d9d210d6916a7 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Wed, 29 May 2019 16:10:52 +0000 Subject: [PATCH] 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) --- src/runtime/thread.scm | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 4977ea0d7..3e840c178 100644 --- 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)) -- 2.25.1