diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /tzfile.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'tzfile.scm')
-rw-r--r-- | tzfile.scm | 134 |
1 files changed, 67 insertions, 67 deletions
@@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -23,7 +23,7 @@ (let ((hibyte (read-byte port))) (do ((idx 3 (+ -1 idx)) (val (if (> hibyte 127) (+ #x-100 hibyte) hibyte) - (+ (ash val 8) (read-byte port)))) + (+ (* val 256) (read-byte port)))) ((zero? idx) val)))) (define (tzfile:read-longs len port) (define ra (make-vector len 0)) @@ -34,68 +34,68 @@ (define (tzfile:read-bool port) (let ((c (read-char port))) (if (eof-object? c) c (if (zero? (char->integer c)) #f #t)))) - +;@ (define (tzfile:read path) (define null (integer->char 0)) - (call-with-input-file path - (lambda (port) - (do ((idx 0 (+ 1 idx))) ;reserved. - ((>= idx 20)) - (read-char port)) - (let* ((ttisgmtcnt (tzfile:read-long port)) - (ttisstdcnt (tzfile:read-long port)) - (leapcnt (tzfile:read-long port)) - (timecnt (tzfile:read-long port)) - (typecnt (tzfile:read-long port)) - (charcnt (tzfile:read-long port)) - (transition-times (tzfile:read-longs timecnt port)) - (transition-types - (do ((ra (make-vector timecnt 0)) - (idx 0 (+ 1 idx))) - ((>= idx timecnt) ra) - (vector-set! ra idx (read-byte port)))) - ;;(printf " typecnt = %d\n" typecnt) - (mode-table (do ((tt (make-vector typecnt #f)) - (idx 0 (+ 1 idx))) - ((>= idx typecnt) tt) - (let* ((gmt-offset (tzfile:read-long port)) - (isdst (tzfile:read-bool port)) - (abbrev-index (read-byte port))) - (vector-set! tt idx - (vector abbrev-index gmt-offset - isdst #f #f))))) - ;;(printf " %d bytes of abbreviations:\n" charcnt) - (abbrevs (do ((ra (make-bytes charcnt 0)) - (idx 0 (+ 1 idx))) - ((>= idx charcnt) ra) - (string-set! ra idx (read-char 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))) - (cond ((not (or (eqv? 0 ttisgmtcnt) (eqv? typecnt ttisgmtcnt))) - (slib:warn 'tzfile:read "format error" ttisgmtcnt typecnt))) - ;;(printf " reading %d transition attributes\n" ttisstdcnt) - (do ((idx 0 (+ 1 idx))) - ((>= idx ttisstdcnt)) - (vector-set! (vector-ref mode-table idx) 3 (tzfile:read-bool port))) - ;;(printf " reading %d transition attributes\n" ttisgmtcnt) - (do ((idx 0 (+ 1 idx))) - ((>= idx ttisgmtcnt)) - (vector-set! (vector-ref mode-table idx) 4 (tzfile:read-bool port))) - (cond ((not (eof-object? (peek-char port))) - (slib:warn 'tzfile:read "bytes left at end"))) - (do ((idx 0 (+ 1 idx))) - ((>= idx ttisstdcnt)) - (let ((rec (vector-ref mode-table idx))) - (vector-set! - rec 0 (let loop ((pos (vector-ref rec 0))) - (cond ((>= pos (string-length abbrevs)) - (slib:warn 'tzfile:read "format error" abbrevs) #f) - ((char=? null (string-ref abbrevs pos)) - (substring abbrevs (vector-ref rec 0) pos)) - (else (loop (+ 1 pos)))))))) - (list path mode-table leap-seconds transition-times transition-types) - )))) + (call-with-open-ports + (open-file path 'rb) + (lambda (port) + (do ((idx 0 (+ 1 idx))) ;reserved. + ((>= idx 20)) + (read-char port)) + (let* ((ttisgmtcnt (tzfile:read-long port)) + (ttisstdcnt (tzfile:read-long port)) + (leapcnt (tzfile:read-long port)) + (timecnt (tzfile:read-long port)) + (typecnt (tzfile:read-long port)) + (charcnt (tzfile:read-long port)) + (transition-times (tzfile:read-longs timecnt port)) + (transition-types + (do ((ra (make-vector timecnt 0)) + (idx 0 (+ 1 idx))) + ((>= idx timecnt) ra) + (vector-set! ra idx (read-byte port)))) + ;;(printf " typecnt = %d\\n" typecnt) + (mode-table (do ((tt (make-vector typecnt #f)) + (idx 0 (+ 1 idx))) + ((>= idx typecnt) tt) + (let* ((gmt-offset (tzfile:read-long port)) + (isdst (tzfile:read-bool port)) + (abbrev-index (read-byte port))) + (vector-set! tt idx + (vector abbrev-index gmt-offset + isdst #f #f))))) + ;;(printf " %d bytes of abbreviations:\\n" charcnt) + (abbrevs (do ((ra (make-bytes charcnt 0)) + (idx 0 (+ 1 idx))) + ((>= idx charcnt) ra) + (string-set! ra idx (read-char 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))) + (cond ((not (or (eqv? 0 ttisgmtcnt) (eqv? typecnt ttisgmtcnt))) + (slib:warn 'tzfile:read "format error" ttisgmtcnt typecnt))) + ;;(printf " reading %d transition attributes\\n" ttisstdcnt) + (do ((idx 0 (+ 1 idx))) + ((>= idx ttisstdcnt)) + (vector-set! (vector-ref mode-table idx) 3 (tzfile:read-bool port))) + ;;(printf " reading %d transition attributes\\n" ttisgmtcnt) + (do ((idx 0 (+ 1 idx))) + ((>= idx ttisgmtcnt)) + (vector-set! (vector-ref mode-table idx) 4 (tzfile:read-bool port))) + (cond ((not (eof-object? (peek-char port))) + (slib:warn 'tzfile:read "bytes left at end"))) + (do ((idx 0 (+ 1 idx))) + ((>= idx ttisstdcnt)) + (let ((rec (vector-ref mode-table idx))) + (vector-set! + rec 0 (let loop ((pos (vector-ref rec 0))) + (cond ((>= pos (string-length abbrevs)) + (slib:warn 'tzfile:read "format error" abbrevs) #f) + ((char=? null (string-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 @@ -103,8 +103,8 @@ (lambda (path mode-table leap-seconds transition-times transition-types) (let ((ntrns (vector-length transition-times))) (if (zero? ntrns) -1 - (let loop ((lidx (ash (+ 1 ntrns) -1)) - (jmp (ash (+ 1 ntrns) -2))) + (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) @@ -113,8 +113,8 @@ ((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 (ash (+ 1 jmp) -1)))))))))) + (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) @@ -124,7 +124,7 @@ (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) |