Import Upstream version 3a1upstream/3a1

1 files changed, 67 insertions, 67 deletions

diff --git a/tzfile.scm b/tzfile.scm
index 51c85e8..f5be145 100644
--- a/tzfile.scm
+++ b/tzfile.scm
@@ -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)