[plt-scheme] High precision timing and MrEd/OSX

At 22 Dec 2004 21:23:20 +1100, Rohan Drape wrote:
> I will look into your other suggestions in the next weeks, it would be
> nice to implement this all in scheme, with further bonus that then it
> would work under Windows.  If I can get it working I will do some
> measurements and let you know how it compares.

Great - thanks!

To get some idea of the issues involved, I decided to do a quick
experiment myself.

The v299 code below implements a little `set-timer' interface that is
like yours (I think); the timer posts the semaphore `s' when it
expires.

On my Linux machine, the displayed time delta is within 30 usec of the
requested 0.1-msec delay.

But there's a catch: I had to throw in a busy loop to ensure that
MzScheme doesn't sleep via select(). Apparently, select() on my OS
times out only on 10-msec boundaries. So, this might be a reason to
keep your timer. Or maybe we should change MzScheme so that it installs
its own timer to get finer-grained sleep times.

(Minor caveat: If I request an alarm from anywhere between 15 and 30
msec, then the actual interval is 30 msec. But if I redirect the
printout to a file, this doesn't happen. So the 15-to-30-msec case is
related to the OS scheduler, which gives MzScheme a 15-msec timeslice
and then switches to the terminal application to show MzScheme's
printouts.)

Matthew

----------------------------------------

;; Semaphore that is posted to signal the timeout
(define s (make-semaphore))

;; Channel to communicate to the alarm-server thread
(define req-ch (make-channel))

;; Function to run in the alarm-server thread
(define (serve time-to-post)
  ;; Wait for either the timeout or a new request:
  (sync (handle-evt
	 (alarm-evt time-to-post)
	 (lambda (x)
	   (semaphore-post s)
	   (serve +inf.0)))
	(handle-evt
	 req-ch
	 (lambda (t)
	   (serve (min t time-to-post))))))

;; Start the server thread for set-itimer
(thread (lambda () (serve +inf.0)))

;; Request an alarm at time `time-to-post':
(define (set-itimer time-to-post)
  (channel-put req-ch time-to-post))

;; Busy loop to avoid select()-based sleep. Yuck.
(thread (lambda () (let loop () (sleep) (loop))))

(let loop ()
  (let ([now (current-inexact-milliseconds)])
    ;; Initially, request a semaphore post after 1 msec:
    (set-itimer (+ now 1))
    ;; Change that to 0.1 msec (to test adjusting the alarm):
    (set-itimer (+ now 0.1))
    ;; Wait for the timeout:
    (semaphore-wait s)
    ;; Measure actual delay:
    (printf "~a~n" (- (current-inexact-milliseconds) now))
    (loop)))