suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use current-inexact-milliseconds instead of current-milliseconds to avoid wrap-around problems

Browse Source 
svn: r8130
This commit is contained in:
Greg Cooper 2007-12-26 18:11:37 +00:00
parent bfd42d01d0
commit e79214aa5a
3 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/frtime/erl.ss
View File

@ -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]

4
collects/frtime/frp-core.ss
View File

@ -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)))

24
collects/frtime/lang-ext.ss
View File

@ -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