diff options
Diffstat (limited to 'tzfile.scm')
| -rw-r--r-- | tzfile.scm | 49 |
1 files changed, 4 insertions, 45 deletions
@@ -1,5 +1,5 @@ ; "tzfile.scm", Read sysV style (binary) timezone file. -; Copyright (c) 1997 Aubrey Jaffer +; Copyright (C) 1997 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -36,7 +36,6 @@ (if (eof-object? c) c (if (zero? (char->integer c)) #f #t)))) ;@ (define (tzfile:read path) - (define null (integer->char 0)) (call-with-open-ports (open-file path 'rb) (lambda (port) @@ -69,7 +68,7 @@ (abbrevs (do ((ra (make-bytes charcnt 0)) (idx 0 (+ 1 idx))) ((>= idx charcnt) ra) - (string-set! ra idx (read-char port)))) + (byte-set! ra idx (read-byte port)))) (leap-seconds (tzfile:read-longs (* 2 leapcnt) port))) (cond ((not (or (eqv? 0 ttisstdcnt) (eqv? typecnt ttisstdcnt))) (slib:warn 'tzfile:read "format error" ttisstdcnt typecnt))) @@ -90,49 +89,9 @@ (let ((rec (vector-ref mode-table idx))) (vector-set! rec 0 (let loop ((pos (vector-ref rec 0))) - (cond ((>= pos (string-length abbrevs)) + (cond ((>= pos (bytes-length abbrevs)) (slib:warn 'tzfile:read "format error" abbrevs) #f) - ((char=? null (string-ref abbrevs pos)) + ((zero? (byte-ref abbrevs pos)) (substring abbrevs (vector-ref rec 0) pos)) (else (loop (+ 1 pos)))))))) (list path mode-table leap-seconds transition-times transition-types))))) - -(define (tzfile:transition-index time zone) - (and zone - (apply - (lambda (path mode-table leap-seconds transition-times transition-types) - (let ((ntrns (vector-length transition-times))) - (if (zero? ntrns) -1 - (let loop ((lidx (quotient (+ 1 ntrns) 2)) - (jmp (quotient (+ 1 ntrns) 4))) - (let* ((idx (max 0 (min lidx (+ -1 ntrns)))) - (idx-time (vector-ref transition-times idx))) - (cond ((<= jmp 0) - (+ idx (if (>= time idx-time) 0 -1))) - ((= time idx-time) idx) - ((and (zero? idx) (< time idx-time)) -1) - ((and (not (= idx lidx)) (not (< time idx-time))) idx) - (else - (loop ((if (< time idx-time) - +) idx jmp) - (if (= 1 jmp) 0 (quotient (+ 1 jmp) 2)))))))))) - (cdr (vector->list zone))))) - -(define (tzfile:get-std-spec mode-table) - (do ((type-idx 0 (+ 1 type-idx))) - ((or (>= type-idx (vector-length mode-table)) - (not (vector-ref (vector-ref mode-table type-idx) 2))) - (if (>= type-idx (vector-length mode-table)) - (vector-ref mode-table 0) - (vector-ref mode-table type-idx))))) -;@ -(define (tzfile:get-zone-spec time zone) - (apply - (lambda (path mode-table leap-seconds transition-times transition-types) - (let* ((trans-idx (tzfile:transition-index time zone))) - (if (zero? (vector-length transition-types)) - (vector-ref mode-table 0) - (if (negative? trans-idx) - (tzfile:get-std-spec mode-table) - (vector-ref mode-table - (vector-ref transition-types trans-idx)))))) - (cdr (vector->list zone)))) |