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) (define (receive-help timeout timeout-thunk matcher)
;(if (and timeout (negative? timeout)) ;(if (and timeout (negative? timeout))
;(timeout-thunk) ;(timeout-thunk)
(let* ([start-time (current-milliseconds)] (let* ([start-time (current-inexact-milliseconds)]
[mb (hash-table-get mailboxes (tid-lid (self)))] [mb (hash-table-get mailboxes (tid-lid (self)))]
[val (try-extract matcher (mailbox-old-head mb))]) [val (try-extract matcher (mailbox-old-head mb))])
(if (eq? val match-fail) (if (eq? val match-fail)
(let loop () (let loop ()
(let* ([elapsed (- (current-milliseconds) start-time)] (let* ([elapsed (- (current-inexact-milliseconds) start-time)]
[wait-time (cond [wait-time (cond
[(not timeout) false] [(not timeout) false]
[(> elapsed timeout) 0] [(> elapsed timeout) 0]

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

@ -797,7 +797,7 @@
(receive [after (cond (receive [after (cond
[(not (iq-empty?)) 0] [(not (iq-empty?)) 0]
[(not (alarms-empty?)) (- (alarms-peak-ms) [(not (alarms-empty?)) (- (alarms-peak-ms)
(current-milliseconds))] (current-inexact-milliseconds))]
[else #f]) [else #f])
(void)] (void)]
[(? signal? b) [(? signal? b)
@ -855,7 +855,7 @@
;; enqueue expired timers for execution ;; enqueue expired timers for execution
(let loop () (let loop ()
(unless (or (alarms-empty?) (unless (or (alarms-empty?)
(< (current-milliseconds) (< (current-inexact-milliseconds)
(alarms-peak-ms))) (alarms-peak-ms)))
(let ([beh (alarms-dequeue-beh)]) (let ([beh (alarms-dequeue-beh)])
(when (and beh (not (signal-stale? beh))) (when (and beh (not (signal-stale? beh)))

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

@ -182,7 +182,7 @@
[(value-now b) => [(value-now b) =>
(lambda (v) (lambda (v)
(emit v) (emit v)
(schedule-alarm (+ (value-now interval) (current-milliseconds)) ret))]))) (schedule-alarm (+ (value-now interval) (current-inexact-milliseconds)) ret))])))
b))) b)))
; ==> : event[a] (a -> b) -> event[b] ; ==> : event[a] (a -> b) -> event[b]
@ -319,10 +319,10 @@
;; Deprecated ;; Deprecated
(define (magic dtime thunk) (define (magic dtime thunk)
(let* ([last-time (current-milliseconds)] (let* ([last-time (current-inexact-milliseconds)]
[ret (let ([myself #f]) [ret (let ([myself #f])
(event-producer (event-producer
(let ([now (current-milliseconds)]) (let ([now (current-inexact-milliseconds)])
(snapshot (dtime) (snapshot (dtime)
(when (cons? the-args) (when (cons? the-args)
(set! myself (first the-args))) (set! myself (first the-args)))
@ -341,7 +341,7 @@
(let ([ret (proc->signal void)]) (let ([ret (proc->signal void)])
(set-signal-thunk! ret (set-signal-thunk! ret
(lambda () (lambda ()
(let ([t (current-milliseconds)]) (let ([t (current-inexact-milliseconds)])
(schedule-alarm (+ (value-now ms) t) ret) (schedule-alarm (+ (value-now ms) t) ret)
t))) t)))
(set-signal-value! ret ((signal-thunk ret))) (set-signal-value! ret ((signal-thunk ret)))
@ -352,7 +352,7 @@
(set-signal-thunk! ret (set-signal-thunk! ret
(lambda () (lambda ()
(let ([s (current-seconds)] (let ([s (current-seconds)]
[t (current-milliseconds)]) [t (current-inexact-milliseconds)])
(schedule-alarm (* 1000 (add1 (floor (/ t 1000)))) ret) (schedule-alarm (* 1000 (add1 (floor (/ t 1000)))) ret)
s))) s)))
(set-signal-value! ret ((signal-thunk ret))) (set-signal-value! ret ((signal-thunk ret)))
@ -364,12 +364,12 @@
(letrec ([last (mcons (cons (if (zero? (value-now ms-b)) (letrec ([last (mcons (cons (if (zero? (value-now ms-b))
(value-now/no-copy beh) (value-now/no-copy beh)
undefined) undefined)
(current-milliseconds)) (current-inexact-milliseconds))
empty)] empty)]
[head last] [head last]
[producer (proc->signal [producer (proc->signal
(lambda () (lambda ()
(let* ([now (current-milliseconds)] (let* ([now (current-inexact-milliseconds)]
[ms (value-now ms-b)]) [ms (value-now ms-b)])
(let loop () (let loop ()
(if (or (empty? (mcdr head)) (if (or (empty? (mcdr head))
@ -380,7 +380,7 @@
(loop)))))))] (loop)))))))]
[consumer (proc->signal/dont-gc-unless producer [consumer (proc->signal/dont-gc-unless producer
(lambda () (lambda ()
(let* ([now (current-milliseconds)] (let* ([now (current-inexact-milliseconds)]
[new (deep-value-now beh)] [new (deep-value-now beh)]
[ms (value-now ms-b)]) [ms (value-now ms-b)])
(when (not (equal? new (car (mcar last)))) (when (not (equal? new (car (mcar last))))
@ -400,7 +400,7 @@
(define integral (define integral
(opt-lambda (b [ms-b 20]) (opt-lambda (b [ms-b 20])
(letrec ([accum 0] (letrec ([accum 0]
[last-time (current-milliseconds)] [last-time (current-inexact-milliseconds)]
[last-val (value-now b)] [last-val (value-now b)]
[last-alarm 0] [last-alarm 0]
[producer (proc->signal (lambda () accum))] [producer (proc->signal (lambda () accum))]
@ -408,7 +408,7 @@
(set-signal-thunk! (set-signal-thunk!
consumer consumer
(lambda () (lambda ()
(let ([now (current-milliseconds)]) (let ([now (current-inexact-milliseconds)])
(if (> now (+ last-time 20)) (if (> now (+ last-time 20))
(begin (begin
(when (not (number? last-val)) (when (not (number? last-val))
@ -434,10 +434,10 @@
; derivative : signal[num] -> signal[num] ; derivative : signal[num] -> signal[num]
(define (derivative b) (define (derivative b)
(let* ([last-value (value-now b)] (let* ([last-value (value-now b)]
[last-time (current-milliseconds)] [last-time (current-inexact-milliseconds)]
[thunk (lambda () [thunk (lambda ()
(let* ([new-value (value-now b)] (let* ([new-value (value-now b)]
[new-time (current-milliseconds)] [new-time (current-inexact-milliseconds)]
[result (if (or (= new-value last-value) [result (if (or (= new-value last-value)
(= new-time last-time) (= new-time last-time)
(> new-time (> new-time