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