X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=ddc8cbc9437cd6496f042e6eacfb1ff3d13ccc49;hb=eb4a67799308fc2e610ca330401c9cb07533143c;hp=dd8d3a54cc12a4805a7fad08afb7a39ad1d50e45;hpb=3e74cbbce991eb6c5b9b10ca9b2617b48fad54ec;p=sbcl.git diff --git a/src/code/time.lisp b/src/code/time.lisp index dd8d3a5..ddc8cbc 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -36,11 +36,9 @@ micro-seconds-per-internal-time-unit))) (declare (type (unsigned-byte 32) uint)) (cond (base - (truly-the (unsigned-byte 32) - (+ (the (unsigned-byte 32) - (* (the (unsigned-byte 32) (- seconds base)) - sb!xc:internal-time-units-per-second)) - uint))) + (+ (* (- seconds base) + sb!xc:internal-time-units-per-second) + uint)) (t (setq *internal-real-time-base-seconds* seconds) uint))))) @@ -49,7 +47,6 @@ #!+sb-doc "Return the run time in the internal time format. (See INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage." - (declare (values (unsigned-byte 32))) (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec) (sb!unix:unix-fast-getrusage sb!unix:rusage_self) (declare (ignore ignore) @@ -59,9 +56,8 @@ ;; documented anywhere and the observed behavior is to ;; sometimes return 1000000 exactly.) (type (integer 0 1000000) utime-usec stime-usec)) - (let ((result (+ (the (unsigned-byte 32) - (* (the (unsigned-byte 32) (+ utime-sec stime-sec)) - sb!xc:internal-time-units-per-second)) + (let ((result (+ (* (+ utime-sec stime-sec) + sb!xc:internal-time-units-per-second) (floor (+ utime-usec stime-usec (floor micro-seconds-per-internal-time-unit 2)) @@ -106,6 +102,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 +146,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,12 +169,16 @@ (defun truncate-to-unix-range (utime) (let ((unix-time (- utime unix-to-universal-time))) - (if (and (>= unix-time 0) - (< 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 @@ -247,7 +261,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) @@ -258,33 +276,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 - (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)))) - (+ 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