diff --git a/code/parse-time.lisp b/code/parse-time.lisp
index 024fe27df397f015b7f3e7a62b854ac1ecb24ba4..34655000b23a3ff97a94531a8001cdd4f1400f92 100644
--- a/code/parse-time.lisp
+++ b/code/parse-time.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/parse-time.lisp,v 1.16 2007/05/02 12:47:24 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/parse-time.lisp,v 1.17 2007/05/29 16:33:16 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 
@@ -155,6 +155,9 @@
 	  hour (time-divider) (minute) (time-divider) (secondp)
 	  (am-pm) (date-divider) (zone))
 
+    (year date-divider month date-divider day
+	  hour time-divider minute time-divider secondp time-divider microsecond
+          (zone))
     (hour (time-divider) (minute) (time-divider) (secondp) (am-pm)
 	  (date-divider) (zone) (weekday) month (date-divider)
 	  day (date-divider) year)
@@ -383,6 +386,9 @@
 (defun special-string-p (string)
   (and (simple-string-p string) (gethash string *special-strings*)))
 
+(defun microsecond (number)
+  (integerp number))
+
 (defun secondp (number)
   (and (integerp number) (<= 0 number 59)))
 
@@ -600,25 +606,72 @@
     (setf (decoded-time-zone parsed-values) (- (+ hours (/ mins 60))))))
 
 (defun check-days-per-month (parsed-values)
-  (cond ((= (decoded-time-month parsed-values) 2)
-	 ;; February only has 28 days, except for leap years
-	 (flet ((leap-year-p (y)
-		  ;; Leap years are years divisible by 4.  Except if
-		  ;; it's divisible by 100, in which case, only if
-		  ;; it's divisible by 400.
-		  (let ((div-100 (mod y 100))
-			(div-4 (mod y 4)))
-		    (if (zerop div-100)
-			(zerop (mod y 400))
-			(zerop div-4)))))
-	   (<= (decoded-time-day parsed-values)
-	       (if (leap-year-p (decoded-time-year parsed-values))
-		   29 28))))
-	((member (decoded-time-month parsed-values) '(4 6 9 11))
-	 ;; These months only have 30 days
-	 (<= (decoded-time-day parsed-values) 30))
-	(t
-	 t)))
+  (let ((ok
+	 (cond ((= (decoded-time-month parsed-values) 2)
+		;; February only has 28 days, except for leap years
+		(flet ((leap-year-p (y)
+			 ;; Leap years are years divisible by 4.  Except if
+			 ;; it's divisible by 100, in which case, only if
+			 ;; it's divisible by 400.
+			 (let ((div-100 (mod y 100))
+			       (div-4 (mod y 4)))
+			   (if (zerop div-100)
+			       (zerop (mod y 400))
+			       (zerop div-4)))))
+		  (<= (decoded-time-day parsed-values)
+		      (if (leap-year-p (decoded-time-year parsed-values))
+			  29 28))))
+	       ((member (decoded-time-month parsed-values) '(4 6 9 11))
+		;; These months only have 30 days
+		(<= (decoded-time-day parsed-values) 30))
+	       (t
+		t))))
+    (unless ok
+      (error "Invalid number of days (~D) for month ~D in ~D"
+	     (decoded-time-day parsed-values)
+	     (decoded-time-month parsed-values)
+	     (decoded-time-year parsed-values)))))      
+
+(defun weekday-from-gregorian (month day year)
+  ;; TYPE gregorian-date -> weekday. adapted from reingold. 0 = sunday.
+  (mod
+   (+ 0				       ; Days before start of calendar
+      (* 365 (1- year))			; Ordinary days since epoch
+      (floor (1- year)
+	     4)			     ; Julian leap days since epoch...
+      (-		       ; ...minus century years since epoch...
+       (floor (1- year) 100))
+      (floor		      ; ...plus years since epoch divisible...
+       (1- year) 400)			; ...by 400.
+      (floor			   ; Days in prior months this year...
+       (- (* 367 month) 362)		; ...assuming 30-day Feb
+       12)
+      (if (<= month 2)		       ; Correct for 28- or 29-day Feb
+	  0
+	  (if (and (= (mod year 4) 0)	; gregorian-leap-year
+		   (not (member (mod year 400)
+				(list 100 200 300))))
+	      -1
+	      -2))
+      day)
+   7))
+
+(defun check-weekday (parsed-values)
+  (let ((dotw (mod (1- (weekday-from-gregorian (decoded-time-month parsed-values)
+					       (decoded-time-day parsed-values)
+					       (decoded-time-year parsed-values)))
+		   7)))
+    (flet ((lookup-name (day)
+	     (maphash #'(lambda (k v)
+			  (when (= v day)
+			    (return-from lookup-name k)))
+		      *weekday-strings*)))
+      (unless (= dotw (decoded-time-dotw parsed-values))
+	(error "Specified day (~@(~A~)) doesn't match actual day (~@(~A~))"
+	       (lookup-name (decoded-time-dotw parsed-values))
+	       (lookup-name dotw))))))
+
+
 
 ;;; Set-time-values uses the association list of symbols and values
 ;;; to set the time in the decoded-time structure.
@@ -628,6 +681,7 @@
     (let ((form-type (car form-part))
 	  (form-value (cdr form-part)))
       (case form-type
+	(microsecond 0)
 	(secondp (setf (decoded-time-second parsed-values) form-value))
 	(minute (setf (decoded-time-minute parsed-values) form-value))
 	(hour (setf (decoded-time-hour parsed-values) form-value))
@@ -644,11 +698,9 @@
 	(t (error "Unrecognized symbol in form list: ~A." form-type)))))
   ;; Some simple sanity checks, like does the given month have that
   ;; many days?  Is it a leap year?
-  (unless (check-days-per-month parsed-values)
-    (error "Invalid number of days (~D) for month ~D in ~D"
-	   (decoded-time-day parsed-values)
-	   (decoded-time-month parsed-values)
-	   (decoded-time-year parsed-values))))
+  (check-days-per-month parsed-values)
+  (check-weekday parsed-values))
+
 
 (defun parse-time (time-string &key (start 0) (end (length time-string))
 			       (error-on-mismatch nil)