X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=180b6b6bc1b414d107f6e89fb3aafd694539cac4;hb=6ddaf294e5a7e3b1792ed1d9c342894c38538773;hp=52c3059ba657aa26d0f3cc68515af37859d61adb;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/time.lisp b/src/code/time.lisp index 52c3059..180b6b6 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -106,6 +106,18 @@ ;;; history (Perq time base?) could be cleaned up any on this basis. ;;; -- dan, 2003-08-08 +;;; In order to accomodate universal times between January 1st 1900 +;;; and sometime on December 13th 1901, I'm doing the same calculation +;;; as described above in order to handle dates in that interval, by +;;; normalizing them to March 1st 1903, which shares the same special +;;; properties described above (except for the 400-year property, but +;;; this isn't an issue for the limited range we need to handle). + +;;; One open issue is whether to pass UNIX a 64-bit time_t value on +;;; 64-bit platforms. I don't know if time_t is always 64-bit on those +;;; platforms, and looking at this file reveals a scary amount of +;;; literal 31 and 32s. +;;; -- bem, 2005-08-09 ;;; Subtract from the returned Internal-Time to get the universal ;;; time. The offset between our time base and the Perq one is 2145 @@ -138,6 +150,8 @@ (defconstant +mar-1-2000+ #.(encode-universal-time 0 0 0 1 3 2000 0)) (defconstant +mar-1-2035+ #.(encode-universal-time 0 0 0 1 3 2035 0)) +(defconstant +mar-1-1903+ #.(encode-universal-time 0 0 0 1 3 1903 0)) + (defun years-since-mar-2000 (utime) "Returns number of complete years since March 1st 2000, and remainder in seconds" (let* ((days-in-year (* 86400 365)) @@ -159,11 +173,16 @@ (defun truncate-to-unix-range (utime) (let ((unix-time (- utime unix-to-universal-time))) - (if (< unix-time (ash 1 31)) - unix-time - (multiple-value-bind (year offset) (years-since-mar-2000 utime) - (declare (ignore year)) - (+ +mar-1-2035+ (- unix-to-universal-time) offset))))) + (cond + ((< unix-time (- (ash 1 31))) + (multiple-value-bind (year offset) (years-since-mar-2000 utime) + (declare (ignore year)) + (+ +mar-1-1903+ (- unix-to-universal-time) offset))) + ((>= unix-time (ash 1 31)) + (multiple-value-bind (year offset) (years-since-mar-2000 utime) + (declare (ignore year)) + (+ +mar-1-2035+ (- unix-to-universal-time) offset))) + (t unix-time)))) (defun decode-universal-time (universal-time &optional time-zone) #!+sb-doc @@ -246,7 +265,11 @@ (type (mod 24) hour) (type (integer 1 31) date) (type (integer 1 12) month) - (type (or (integer 0 99) (integer 1900)) year) + (type (or (integer 0 99) (integer 1899)) year) + ;; that type used to say (integer 1900), but that's + ;; incorrect when a time-zone is specified: we should be + ;; able to encode to produce 0 when a non-zero timezone is + ;; specified - bem, 2005-08-09 (type (or null rational) time-zone)) (let* ((year (if (< year 100) (pick-obvious-year year) @@ -257,33 +280,21 @@ (leap-years-before (1+ year)) (leap-years-before year)) (* (- year 1900) 365))) - (hours (+ hour (* days 24)))) + (hours (+ hour (* days 24))) + (encoded-time 0)) (if time-zone - (+ second (* (+ minute (* (+ hours time-zone) 60)) 60)) - ;; can't ask unix for times after 2037: this is only a problem - ;; if we need to query the system timezone - (if (> year 2037) - (labels ((leap-year-p (year) - (cond ((zerop (mod year 400)) t) - ((zerop (mod year 100)) nil) - ((zerop (mod year 4)) t) - (t nil)))) - (let* ((fake-year (if (leap-year-p year) 2036 2037)) - (fake-time (encode-universal-time second minute hour - date month fake-year))) - (+ fake-time - (* 86400 (+ (* 365 (- year fake-year)) - (- (leap-years-before year) - (leap-years-before fake-year))))))) - (let* ((secwest-guess - (sb!unix::unix-get-seconds-west - (- (* hours 60 60) unix-to-universal-time))) - (guess (+ second (* 60 (+ minute (* hours 60))) - secwest-guess)) - (secwest - (sb!unix::unix-get-seconds-west - (- guess unix-to-universal-time)))) - (+ guess (- secwest secwest-guess))))))) + (setf encoded-time (+ second (* (+ minute (* (+ hours time-zone) 60)) 60))) + (let* ((secwest-guess + (sb!unix::unix-get-seconds-west + (truncate-to-unix-range (* hours 60 60)))) + (guess (+ second (* 60 (+ minute (* hours 60))) + secwest-guess)) + (secwest + (sb!unix::unix-get-seconds-west + (truncate-to-unix-range guess)))) + (setf encoded-time (+ guess (- secwest secwest-guess))))) + (assert (typep encoded-time '(integer 0))) + encoded-time)) ;;;; TIME