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

fix srfi 19 nanoseconds

Browse Source 
svn: r18363
This commit is contained in:
Sam Tobin-Hochstadt 2010-02-26 20:50:35 +00:00
parent 5d3e46bb2f
commit d61e50410b
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/srfi/19/time.ss
View File

@ -301,20 +301,20 @@
(define (tm:current-time-utc) (define (tm:current-time-utc)
(receive (seconds ms) (tm:get-time-of-day) (receive (seconds ms) (tm:get-time-of-day)
(make-time time-utc (* ms 10000) seconds))) (make-time time-utc (* ms 1000000) seconds)))
(define (tm:current-time-tai) (define (tm:current-time-tai)
(receive (seconds ms) (tm:get-time-of-day) (receive (seconds ms) (tm:get-time-of-day)
(make-time time-tai (make-time time-tai
(* ms 10000) (* ms 1000000)
(+ seconds (tm:leap-second-delta seconds)) (+ seconds (tm:leap-second-delta seconds))
))) )))
(define (tm:current-time-ms-time time-type proc) (define (tm:current-time-ms-time time-type proc)
(let ((current-ms (proc))) (let ((current-ms (proc)))
(make-time time-type (make-time time-type
(* (remainder current-ms 1000) 10000) (* (remainder current-ms 1000) 1000000)
(quotient current-ms 10000) (quotient current-ms 1000000)
))) )))
;; -- we define it to be the same as TAI. ;; -- we define it to be the same as TAI.
@ -325,7 +325,7 @@
(define (tm:current-time-monotonic) (define (tm:current-time-monotonic)
(receive (seconds ms) (tm:get-time-of-day) (receive (seconds ms) (tm:get-time-of-day)
(make-time time-monotonic (make-time time-monotonic
(* ms 10000) (* ms 1000000)
(+ seconds (tm:leap-second-delta seconds)) (+ seconds (tm:leap-second-delta seconds))
))) )))
@ -357,12 +357,12 @@
(define (time-resolution . clock-type) (define (time-resolution . clock-type)
(let ((clock-type (:optional clock-type time-utc))) (let ((clock-type (:optional clock-type time-utc)))
(cond (cond
((eq? clock-type time-tai) 10000) ((eq? clock-type time-tai) 1000000)
((eq? clock-type time-utc) 10000) ((eq? clock-type time-utc) 1000000)
((eq? clock-type time-monotonic) 10000) ((eq? clock-type time-monotonic) 1000000)
((eq? clock-type time-thread) 10000) ((eq? clock-type time-thread) 1000000)
((eq? clock-type time-process) 10000) ((eq? clock-type time-process) 1000000)
((eq? clock-type time-gc) 10000) ((eq? clock-type time-gc) 1000000)
(else (tm:time-error 'time-resolution 'invalid-clock-type clock-type))))) (else (tm:time-error 'time-resolution 'invalid-clock-type clock-type)))))
(define (tm:time-compare-check time1 time2 caller) (define (tm:time-compare-check time1 time2 caller)