From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:31 -0800
Subject: Import Upstream version 3a2

---
 tzfile.scm | 49 ++++---------------------------------------------
 1 file changed, 4 insertions(+), 45 deletions(-)

(limited to 'tzfile.scm')

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))))
-- 
cgit v1.2.3