X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=667a0ce42773a2ce61ce442b0c5d71debfd631da;hb=01044af1b8d69fc3899dc0417064c1512223223d;hp=fb35b183eb50ab97e4033e56d80dca7c7e1e130f;hpb=f4b9ac56f10a3a83f1c4db98c6fd9428bbc5f4e3;p=sbcl.git

diff --git a/src/code/time.lisp b/src/code/time.lisp
index fb35b18..667a0ce 100644
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -170,56 +170,45 @@
    nine values: second, minute, hour, date, month, year, day of week (0 =
    Monday), T (daylight savings time) or NIL (standard time), and timezone.
    Completely ignores daylight-savings-time when time-zone is supplied."
-  (multiple-value-bind (weeks secs)
-      (truncate (+ universal-time seconds-offset)
-		seconds-in-week)
-    (let* ((weeks (+ weeks weeks-offset))
-	   (second NIL)
-	   (minute NIL)
-	   (hour NIL)
-	   (date NIL)
-	   (month NIL)
-	   (year NIL)
-	   (day NIL)
-	   (daylight NIL)
-	   (timezone (cond
-		       ((null time-zone)
-			(multiple-value-bind (ignore minwest dst)
-			    (sb!unix::get-timezone
-			     (truncate-to-unix-range universal-time))
-			  (declare (ignore ignore))
-			  (declare (fixnum minwest))
-			  (setf daylight dst)
-			  minwest))
-		       (t (* time-zone 60)))))
-      (declare (fixnum timezone))
-      (multiple-value-bind (t1 seconds) (truncate secs 60)
-	(setq second seconds)
-	(setq t1 (- t1 timezone))
-	(let* ((tday (if (< t1 0)
-			 (1- (truncate (1+ t1) minutes-per-day))
-			 (truncate t1 minutes-per-day))))
-	  (multiple-value-setq (hour minute)
-	    (truncate (- t1 (* tday minutes-per-day)) 60))
-	  (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
-		 (tcent (truncate t2 quarter-days-per-century)))
-	    (setq t2 (mod t2 quarter-days-per-century))
-	    (setq t2 (+ (- t2 (mod t2 4)) 3))
-	    (setq year (+ (* tcent 100) (truncate t2 quarter-days-per-year)))
-	    (let ((days-since-mar0 (1+ (truncate (mod t2 quarter-days-per-year)
-						 4))))
-	      (setq day (mod (+ tday weekday-november-17-1858) 7))
-	      (let ((t3 (+ (* days-since-mar0 5) 456)))
-		(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))))))
+  (multiple-value-bind (daylight seconds-west)
+      (if time-zone
+	  (values nil (* time-zone 60 60))
+	  (multiple-value-bind (ignore seconds-west daylight)
+	      (sb!unix::get-timezone (truncate-to-unix-range universal-time))
+	    (declare (ignore ignore))
+	    (declare (fixnum seconds-west))
+	    (values daylight seconds-west)))
+    (declare (fixnum seconds-west))
+    (multiple-value-bind (weeks secs)
+	(truncate (+ (- universal-time seconds-west) seconds-offset)
+		  seconds-in-week)
+      (let ((weeks (+ weeks weeks-offset)))
+	(multiple-value-bind (t1 second)
+	    (truncate secs 60)
+	  (let ((tday (truncate t1 minutes-per-day)))
+	    (multiple-value-bind (hour minute)
+		(truncate (- t1 (* tday minutes-per-day)) 60)
+	      (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
+		     (tcent (truncate t2 quarter-days-per-century)))
+		(setq t2 (mod t2 quarter-days-per-century))
+		(setq t2 (+ (- t2 (mod t2 4)) 3))
+		(let* ((year (+ (* tcent 100)
+				(truncate t2 quarter-days-per-year)))
+		       (days-since-mar0
+			(1+ (truncate (mod t2 quarter-days-per-year) 4)))
+		       (day (mod (+ tday weekday-november-17-1858) 7))
+		       (t3 (+ (* days-since-mar0 5) 456)))
+		  (cond ((>= t3 1989)
+			 (setq t3 (- t3 1836))
+			 (setq year (1+ year))))
+		  (multiple-value-bind (month t3)
+		      (truncate t3 153)
+		    (let ((date (1+ (truncate t3 5))))
+		      (values second minute hour date month year day
+			      daylight
+			      (if daylight
+				  (1+ (/ seconds-west 60 60))
+				  (/ seconds-west 60 60))))))))))))))
 
 (defun pick-obvious-year (year)
   (declare (type (mod 100) year))
@@ -275,7 +264,7 @@
 	(if (> year 2037)
 	    (labels ((leap-year-p (year)
 		       (cond ((zerop (mod year 400)) t)
-			     ((zerop (mod year 100)) t)
+			     ((zerop (mod year 100)) nil)
 			     ((zerop (mod year 4)) t)
 			     (t nil))))
 	      (let* ((fake-year (if (leap-year-p year) 2036 2037))
@@ -285,17 +274,24 @@
 		   (* 86400 (+ (* 365 (- year fake-year))
 			       (- (leap-years-before year)
 				  (leap-years-before fake-year)))))))
-	    (let* ((minwest-guess
-		    (sb!unix::unix-get-minutes-west
+	    (let* ((secwest-guess
+		    (sb!unix::unix-get-seconds-west
 		     (- (* hours 60 60) unix-to-universal-time)))
-		   (guess (+ minute (* hours 60) minwest-guess))
-		   (minwest
-		    (sb!unix::unix-get-minutes-west
-		     (- (* guess 60) unix-to-universal-time))))
-	      (+ second (* (+ guess (- minwest minwest-guess)) 60)))))))
+		   (guess (+ second (* 60 (+ minute (* hours 60)))
+			     secwest-guess))
+		   (secwest
+		    (sb!unix::unix-get-seconds-west
+		     (- guess unix-to-universal-time))))
+	      (+ guess (- secwest secwest-guess)))))))
 
 ;;;; TIME
 
+(defvar *gc-run-time* 0
+  #!+sb-doc
+  "the total CPU time spent doing garbage collection (as reported by
+   GET-INTERNAL-RUN-TIME)")
+(declaim (type index *gc-run-time*))
+
 (defmacro time (form)
   #!+sb-doc
   "Execute FORM and print timing information on *TRACE-OUTPUT*."