summaryrefslogtreecommitdiffstats
path: root/tzfile.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tzfile.scm')
-rw-r--r--tzfile.scm49
1 files changed, 4 insertions, 45 deletions
diff --git a/tzfile.scm b/tzfile.scm
index f5be145..9354743 100644
--- a/tzfile.scm
+++ b/tzfile.scm
@@ -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))))