/[cmucl]/src/code/time.lisp
ViewVC logotype

Diff of /src/code/time.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by dtc, Thu Jan 29 07:22:45 1998 UTC revision 1.19 by dtc, Wed Jun 7 07:11:02 2000 UTC
# Line 145  Line 145 
145     nine values: second, minute, hour, date, month, year, day of week (0 =     nine values: second, minute, hour, date, month, year, day of week (0 =
146     Monday), T (daylight savings time) or NIL (standard time), and timezone.     Monday), T (daylight savings time) or NIL (standard time), and timezone.
147     Completely ignores daylight-savings-time when time-zone is supplied."     Completely ignores daylight-savings-time when time-zone is supplied."
148    (multiple-value-bind (weeks secs)    (multiple-value-bind (daylight timezone)
149                         (truncate (+ universal-time seconds-offset)        (if time-zone
150                                   seconds-in-week)            (values nil (* time-zone 60 60))
151      (let* ((weeks (+ weeks weeks-offset))            (multiple-value-bind
152             (second NIL)                  (ignore minwest dst)
153             (minute NIL)                (get-timezone (- universal-time unix-to-universal-time))
154             (hour NIL)              (declare (ignore ignore))
155             (date NIL)              (values dst (* minwest 60))))
156             (month NIL)      (declare (fixnum timezone))
157             (year NIL)      (multiple-value-bind (weeks secs)
158             (day NIL)          (truncate (+ (- universal-time timezone) seconds-offset)
159             (daylight NIL)                    seconds-in-week)
160             (timezone (if (null time-zone)        (let ((weeks (+ weeks weeks-offset)))
161                           (multiple-value-bind          (multiple-value-bind (t1 second)
162                               (ignore minwest dst)              (truncate secs 60)
163                               (get-timezone (- universal-time            (let ((tday (truncate t1 minutes-per-day)))
164                                                unix-to-universal-time))              (multiple-value-bind (hour minute)
165                             (declare (ignore ignore))                  (truncate (- t1 (* tday minutes-per-day)) 60)
166                             (setf daylight dst)                (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
167                             minwest)                       (tcent (truncate t2 quarter-days-per-century)))
168                           (* time-zone 60))))                  (setq t2 (mod t2 quarter-days-per-century))
169        (declare (fixnum timezone))                  (setq t2 (+ (- t2 (mod t2 4)) 3))
170        (multiple-value-bind (t1 seconds) (truncate secs 60)                  (let* ((year (+ (* tcent 100)
171          (setq second seconds)                                  (truncate t2 quarter-days-per-year)))
172          (setq t1 (- t1 timezone))                         (days-since-mar0
173          (let* ((tday (if (< t1 0)                          (1+ (truncate (mod t2 quarter-days-per-year) 4)))
174                           (1- (truncate (1+ t1) minutes-per-day))                         (day (mod (+ tday weekday-november-17-1858) 7))
175                           (truncate t1 minutes-per-day))))                         (t3 (+ (* days-since-mar0 5) 456)))
176            (multiple-value-setq (hour minute)                    (cond ((>= t3 1989)
177              (truncate (- t1 (* tday minutes-per-day)) 60))                           (setq t3 (- t3 1836))
178            (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))                           (setq year (1+ year))))
179                   (tcent (truncate t2 quarter-days-per-century)))                    (multiple-value-bind (month t3)
180              (setq t2 (mod t2 quarter-days-per-century))                        (truncate t3 153)
181              (setq t2 (+ (- t2 (mod t2 4)) 3))                      (let ((date (1+ (truncate t3 5))))
182              (setq year (+ (* tcent 100) (truncate t2 quarter-days-per-year)))                        (values second minute hour date month year day
183              (let ((days-since-mar0 (1+ (truncate (mod t2 quarter-days-per-year)                                daylight
184                                                   4))))                                (if daylight
185                (setq day (mod (+ tday weekday-november-17-1858) 7))                                    (1+ (/ timezone 60 60))
186                (let ((t3 (+ (* days-since-mar0 5) 456)))                                    (/ timezone 60 60))))))))))))))
                 (cond ((>= t3 1989)  
                        (setq t3 (- t3 1836))  
                        (setq year (1+ year))))  
                 (multiple-value-setq (month t3) (truncate t3 153))  
                 (setq date (1+ (truncate t3 5))))))))  
       (values second minute hour date month year day  
               daylight  
               (if daylight  
                   (1+ (/ timezone 60))  
                   (/ timezone 60))))))  
187    
188    
189  (defun pick-obvious-year (year)  (defun pick-obvious-year (year)

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

  ViewVC Help
Powered by ViewVC 1.1.5