From e79214aa5afa4d6016aed039ce471729c1e5d11a Mon Sep 17 00:00:00 2001
From: Greg Cooper <greg@cs.brown.edu>
Date: Wed, 26 Dec 2007 18:11:37 +0000
Subject: [PATCH] use current-inexact-milliseconds instead of
 current-milliseconds to avoid wrap-around problems

svn: r8130
---
 collects/frtime/erl.ss      |  4 ++--
 collects/frtime/frp-core.ss |  4 ++--
 collects/frtime/lang-ext.ss | 24 ++++++++++++------------
 3 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/collects/frtime/erl.ss b/collects/frtime/erl.ss
index 0b3d3e5e0f..1fd94e59f1 100644
--- a/collects/frtime/erl.ss
+++ b/collects/frtime/erl.ss
@@ -129,12 +129,12 @@
   (define (receive-help timeout timeout-thunk matcher)
     ;(if (and timeout (negative? timeout))
         ;(timeout-thunk)
-        (let* ([start-time (current-milliseconds)]
+        (let* ([start-time (current-inexact-milliseconds)]
                [mb (hash-table-get mailboxes (tid-lid (self)))]
                [val (try-extract matcher (mailbox-old-head mb))])
           (if (eq? val match-fail)
               (let loop ()
-                (let* ([elapsed (- (current-milliseconds) start-time)]
+                (let* ([elapsed (- (current-inexact-milliseconds) start-time)]
                        [wait-time (cond
                                     [(not timeout) false]
                                     [(> elapsed timeout) 0]
diff --git a/collects/frtime/frp-core.ss b/collects/frtime/frp-core.ss
index 8fbb7db0be..3b17296d76 100644
--- a/collects/frtime/frp-core.ss
+++ b/collects/frtime/frp-core.ss
@@ -797,7 +797,7 @@
                (receive [after (cond
                                  [(not (iq-empty?)) 0]
                                  [(not (alarms-empty?)) (- (alarms-peak-ms)
-                                                           (current-milliseconds))]
+                                                           (current-inexact-milliseconds))]
                                  [else #f])
                                (void)]
                         [(? signal? b)
@@ -855,7 +855,7 @@
              ;; enqueue expired timers for execution
              (let loop ()
                (unless (or (alarms-empty?)
-                           (< (current-milliseconds)
+                           (< (current-inexact-milliseconds)
                               (alarms-peak-ms)))
                  (let ([beh (alarms-dequeue-beh)])
                    (when (and beh (not (signal-stale? beh)))
diff --git a/collects/frtime/lang-ext.ss b/collects/frtime/lang-ext.ss
index 74f127203e..22888d0e70 100644
--- a/collects/frtime/lang-ext.ss
+++ b/collects/frtime/lang-ext.ss
@@ -182,7 +182,7 @@
                     [(value-now b) =>
                                    (lambda (v)
                                      (emit v)
-                                     (schedule-alarm (+ (value-now interval) (current-milliseconds)) ret))])))
+                                     (schedule-alarm (+ (value-now interval) (current-inexact-milliseconds)) ret))])))
               b)))
   
   ; ==> : event[a] (a -> b) -> event[b]
@@ -319,10 +319,10 @@
   
   ;; Deprecated
   (define (magic dtime thunk)
-    (let* ([last-time (current-milliseconds)]
+    (let* ([last-time (current-inexact-milliseconds)]
            [ret (let ([myself #f])
                   (event-producer
-                   (let ([now (current-milliseconds)])
+                   (let ([now (current-inexact-milliseconds)])
                      (snapshot (dtime)
                                (when (cons? the-args)
                                  (set! myself (first the-args)))
@@ -341,7 +341,7 @@
     (let ([ret (proc->signal void)])
       (set-signal-thunk! ret
                          (lambda ()
-                           (let ([t (current-milliseconds)])
+                           (let ([t (current-inexact-milliseconds)])
                              (schedule-alarm (+ (value-now ms) t) ret)
                              t)))
       (set-signal-value! ret ((signal-thunk ret)))
@@ -352,7 +352,7 @@
       (set-signal-thunk! ret
                          (lambda ()
                            (let ([s (current-seconds)]
-                                 [t (current-milliseconds)])
+                                 [t (current-inexact-milliseconds)])
                              (schedule-alarm (* 1000 (add1 (floor (/ t 1000)))) ret)
                              s)))
       (set-signal-value! ret ((signal-thunk ret)))
@@ -364,12 +364,12 @@
     (letrec ([last (mcons (cons (if (zero? (value-now ms-b))
                                     (value-now/no-copy beh)
                                     undefined)
-                                (current-milliseconds))
+                                (current-inexact-milliseconds))
                           empty)]
              [head last]
              [producer (proc->signal
                         (lambda ()
-                          (let* ([now (current-milliseconds)]
+                          (let* ([now (current-inexact-milliseconds)]
                                  [ms (value-now ms-b)])
                             (let loop ()
                               (if (or (empty? (mcdr head))
@@ -380,7 +380,7 @@
                                     (loop)))))))]
              [consumer (proc->signal/dont-gc-unless producer
                         (lambda ()
-                          (let* ([now (current-milliseconds)]
+                          (let* ([now (current-inexact-milliseconds)]
                                  [new (deep-value-now beh)]
                                  [ms (value-now ms-b)])
                             (when (not (equal? new (car (mcar last))))
@@ -400,7 +400,7 @@
   (define integral
     (opt-lambda (b [ms-b 20])
       (letrec ([accum 0]
-               [last-time (current-milliseconds)]
+               [last-time (current-inexact-milliseconds)]
                [last-val (value-now b)]
                [last-alarm 0]
                [producer (proc->signal (lambda () accum))]
@@ -408,7 +408,7 @@
         (set-signal-thunk!
          consumer
          (lambda ()
-           (let ([now (current-milliseconds)])
+           (let ([now (current-inexact-milliseconds)])
              (if (> now (+ last-time 20))
                  (begin
                    (when (not (number? last-val))
@@ -434,10 +434,10 @@
   ; derivative : signal[num] -> signal[num]
   (define (derivative b)
     (let* ([last-value (value-now b)]
-           [last-time (current-milliseconds)]
+           [last-time (current-inexact-milliseconds)]
            [thunk (lambda ()
                     (let* ([new-value (value-now b)]
-                           [new-time (current-milliseconds)]
+                           [new-time (current-inexact-milliseconds)]
                            [result (if (or (= new-value last-value)
                                            (= new-time last-time)
                                            (> new-time