From 2e7c9ac33a7392a75402e17716ed94ba21f42f04 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Fri, 27 Jul 2018 17:32:51 +0100
Subject: [PATCH] Remove old version of LIBDOC; TIME.

---
 src/libdoc/time.kmp8 | 692 -------------------------------------------
 1 file changed, 692 deletions(-)
 delete mode 100644 src/libdoc/time.kmp8

diff --git a/src/libdoc/time.kmp8 b/src/libdoc/time.kmp8
deleted file mode 100644
index 45ccc270..00000000
--- a/src/libdoc/time.kmp8
+++ /dev/null
@@ -1,692 +0,0 @@
-;;; -*- Package:TIME; Mode:Lisp; -*-
-;;;
-;;; This package created by KMP@MC, 24 May 81.
-;;;
-;;; TIME:DAYS   - Bound to an alist of (daynum . dayname)
-;;; TIME:MONTHS - Bound to an alist of (monthnum . monthname)
-;;;
-;;; STANDARD-OUTPUT - If undefined when this package loads, this variable
-;;;			will be set to the current value of TYO
-;;;
-;;; (TIME:GET-TIME-LIST) 
-;;;	Returns (sec mins hours date month year dayofweek). This returns
-;;;	information similar to that returned by the LispM TIME:GET-TIME
-;;;	routine, but the information is returned as a list.
-;;;	Unlike the LispM, however, dayofweek is returned as a string (not
-;;;	a fixnum) and daylightsavings information is not returned at all.
-;;;
-;;; (TIME:PARSE-LIST string)
-;;;	Returns (sec mins hours date month year dayofweek). This returns
-;;;     information similar to that returned by the LispM TIME:PARSE
-;;;	routine, but the information is returned as a list.
-;;;	Unlike the LispM, however, dayofweek is returned as a string (not
-;;;	a fixnum). Daylightsavings information and relative information
-;;;	is not returned at all.
-;;;
-;;;  The following several functions are used the same as in LispM lisp.
-;;;     The optional argument, stream, in the following functions defaults to
-;;;    the value of the symbol STANDARD-OUTPUT. A stream argument of () means 
-;;;    to return the string rather than printing it.
-;;;     Year arguments less than one hundred are assumed to be offset from 
-;;;    1900.
-;;;     Day of week arguments to the dateprinting functions may be either
-;;;    strings or fixnums (0=Monday).
-;;;
-;;; (TIME:PRINT-CURRENT-TIME &optional stream)
-;;;	Calls TIME:PRINT-TIME using the current time.
-;;;
-;;; (TIME:PRINT-TIME sec min hrs date month year &optional stream)
-;;;	Displays the given time in format yr/mo/dy hr:min:sec
-;;;
-;;; (TIME:PRINT-CURRENT-DATE &optional stream)
-;;;	Calls TIME:PRINT-DATE using the current date.
-;;;		
-;;; (TIME:PRINT-DATE sec min hrs date month year dayofweek &optional stream)
-;;;	Displays the given time in full English format. eg,
-;;;		Sunday the twenty-fourth of May; 3:02:17 pm
-;;;
-;;; (TIME:MONTH-STRING n &optional ignore)
-;;;	Returns the name of the nth month (1=January).
-;;;	Mode is not supported but is provided for calling compatibility
-;;;	with the LispM.
-;;;
-;;; (TIME:DAY-OF-THE-WEEK-STRING n &optional ignore)
-;;;	Returns the name of the nth day of the week (0=Monday).
-;;;	Mode is not supported but is provided for calling compatibility
-;;;	with the LispM.
-;;;
-;;; (TIME:VERIFY-DATE date month year dayofweek)
-;;;	Returns () if day,month,year fell on dayofweek. Else returns a string
-;;;	containing a suitable error message.
-;;;
-;;;  This last function is not in the LispM lisp time package, but seemed
-;;;  a useful function to have, so is provided at no extra cost.
-;;;
-;;; (TIME:ON-WHAT-DAY-OF-THE-WEEK? day month year)
-;;;	Returns the day of the week that a given day fell on.
-;;;
-
-#+Maclisp
-(HERALD TIME /4)
-
-#+Maclisp
-(DEFVAR STANDARD-OUTPUT TYO)
-
-#+Maclisp
-(EVAL-WHEN (COMPILE) (SETQ DEFMACRO-FOR-COMPILING ()))
-
-#+Maclisp
-(DEFMACRO CHAR-UPCASE (X)
-  (IF (NOT (ATOM X))
-      `(LET ((X ,X)) (CHAR-UPCASE X))
-      `(IF (AND (>= ,X #/a) (<= ,X #/z))
-	   (- ,X #.(- #/a #/A))
-	   ,X)))
-
-#+Maclisp
-(DEFMACRO CHAR-DOWNCASE (X)
-  (IF (NOT (ATOM X))
-      `(LET ((X ,X)) (CHAR-DOWNCASE X))
-      `(IF (AND (>= ,X #/A) (<= ,X #/Z))
-	   (- ,X #.(- #/A #/a))
-	   ,X)))
-
-(DEFMACRO STANDARDIZE-YEAR (YEAR)
-  (IF (NOT (ATOM YEAR))
-      `(LET ((YEAR ,YEAR)) (STANDARDIZE-YEAR YEAR))
-      `(IF (< ,YEAR 100.) (+ ,YEAR 1900.) ,YEAR)))
-
-(DEFMACRO STRING-UPPERCASE-INITIAL (FORM)
-  `(LET ((EXPL (EXPLODEN ,FORM)))
-     (IMPLODE (CONS (CHAR-UPCASE (CAR EXPL))
-		    (DO ((L (CDR EXPL) (CDR L))
-			 (LL () (CONS (CHAR-DOWNCASE (CAR L)) LL)))
-			((NULL L) (NREVERSE LL)))))))
-
-(DEFMACRO DAY (X) `(CDR (ASSQ ,X TIME:DAYS)))
-
-(DEFVAR TIME:DAYS
-  '((0. . "Monday"   )
-    (1. . "Tuesday"  )
-    (2. . "Wednesday")
-    (3. . "Thursday" )
-    (4. . "Friday"   )
-    (5. . "Saturday" )
-    (6. . "Sunday"   )))
-
-(DEFMACRO MONTH (X) `(CDR (ASSQ ,X TIME:MONTHS)))
-
-(DEFVAR TIME:MONTHS
-  '((1.  . "January"  )
-    (2.  . "February" )
-    (3.  . "March"    )
-    (4.  . "April"    )
-    (5.  . "May"      )
-    (6.  . "June"     )
-    (7.  . "July"     )
-    (8.  . "August"   )
-    (9.  . "September")
-    (10. . "October"  )
-    (11. . "November" )
-    (12. . "December" )))
-
-(DEFUN TIME:GET-TIME-LIST ()
-  (LET ((FULL-DATE   (STATUS DATE))
-	(FULL-TIME   (STATUS DAYTIME))
-	(DAY-OF-WEEK (STATUS DOW)))
-    (IF (NOT (EQUAL FULL-DATE (STATUS DATE)))
-	(TIME:GET-TIME-LIST)
-	(LET (((HOURS MINUTES SECONDS) FULL-TIME)
-	      ((YEAR  MONTH   DATE   ) FULL-DATE)
-	      (DOW   (STRING-UPPERCASE-INITIAL DAY-OF-WEEK)))
-	  (LIST SECONDS MINUTES HOURS DATE MONTH YEAR DOW)))))
-
-(DEFUN TIME:PRINT-CURRENT-TIME (&OPTIONAL (STREAM STANDARD-OUTPUT))
-  (LEXPR-FUNCALL #'TIME:PRINT-TIME
-		 (NREVERSE
-		  (CONS STREAM (CDR (REVERSE (TIME:GET-TIME-LIST)))))))
-
-(DEFUN TIME:PRINT-TIME (SECONDS MINUTES HOURS DATE MONTH YEAR
-				&OPTIONAL (STREAM STANDARD-OUTPUT))
-  (SETQ YEAR (STANDARDIZE-YEAR YEAR))
-  (FORMAT STREAM "~D//~D//~D ~D:~2,'0D:~2,'0D"
-	  MONTH
-	  DATE
-	  (- YEAR 1900.)
-	  HOURS
-	  MINUTES
-	  SECONDS))
-
-(DEFUN TIME:PRINT-CURRENT-DATE (&OPTIONAL (STREAM STANDARD-OUTPUT))
-  (LEXPR-FUNCALL #'TIME:PRINT-DATE
-		 (APPEND (TIME:GET-TIME-LIST) (NCONS STREAM))))
-
-(DEFUN TIME:PRINT-DATE (SECONDS MINUTES HOURS DATE MONTH YEAR DAY-OF-WEEK
-				&OPTIONAL (STREAM STANDARD-OUTPUT))
-  (SETQ YEAR (STANDARDIZE-YEAR YEAR))
-;;  (LET ((MSG (TIME:VERIFY-DATE DATE MONTH YEAR DAY-OF-WEEK)))
-;;    (IF MSG (FERROR NIL MSG)))
-  (FORMAT STREAM "~A the ~:R of ~A, ~D; ~D:~2,'0D:~2,'0D ~A"
-	  (IF (FIXP DAY-OF-WEEK)
-	      (DAY DAY-OF-WEEK)
-	      (STRING-UPPERCASE-INITIAL DAY-OF-WEEK))
-	  DATE
-	  (MONTH MONTH)
-	  YEAR
-	  (LET ((HR (\ HOURS 12.))) (IF (ZEROP HR) 12. HR))
-	  MINUTES
-	  SECONDS
-	  (IF (ZEROP (// HOURS 12.)) "am" "pm")))
-
-(DEFUN TIME:MONTH-STRING (MONTHNUM &OPTIONAL MODE) MODE ;ignored
-  (MONTH MONTHNUM))
-
-(DEFUN TIME:DAY-OF-THE-WEEK-STRING (DAYNUM &OPTIONAL MODE) MODE ;ignored
-  (DAY DAYNUM))
-
-(DEFUN TIME:VERIFY-DATE (DATE MONTH YEAR DAY-OF-THE-WEEK)
-  (SETQ YEAR (STANDARDIZE-YEAR YEAR))
-  (LET ((TRUE-DOW (TIME:DAY-OF-THE-WEEK-STRING
-		   (TIME:ON-WHAT-DAY-OF-THE-WEEK? DATE MONTH YEAR))))
-    (IF (FIXP DAY-OF-THE-WEEK)
-	(SETQ DAY-OF-THE-WEEK (TIME:DAY-OF-THE-WEEK-STRING DAY-OF-THE-WEEK)))
-    (SETQ DAY-OF-THE-WEEK (STRING-UPPERCASE-INITIAL DAY-OF-THE-WEEK))
-    (IF (NOT (SAMEPNAMEP DAY-OF-THE-WEEK TRUE-DOW))
-	(LET (((TODAY-DATE TODAY-MONTH TODAY-YEAR)
-	       (CDDDR (TIME:GET-TIME-LIST))))
-	  (SETQ TODAY-YEAR (STANDARDIZE-YEAR TODAY-YEAR))
-	  (FORMAT ()
-		  (COND ((OR (> TODAY-YEAR YEAR)
-			     (AND (= TODAY-YEAR YEAR)
-				  (OR (> TODAY-MONTH MONTH)
-				      (AND (= TODAY-MONTH MONTH)
-					   (> TODAY-DATE DATE)))))
-			 "The ~:R of ~A, ~D fell on a ~A, not a ~A.")
-			((AND (= TODAY-YEAR  YEAR)
-			      (= TODAY-MONTH MONTH)
-			      (= TODAY-DATE  DATE))
-			 "Today is a ~3G~A, not a ~A.")
-			(T
-			 "The ~:R of ~A, ~D will fall on a ~A, not a ~A."))
-		  DATE
-		  (MONTH MONTH)
-		  YEAR
-		  TRUE-DOW
-		  DAY-OF-THE-WEEK)))))
-
-
-;;; This code adapted from JONL's package MC:LIBDOC;DOW >
-
-;;; The following function, when given the date as three numbers,
-;;; will produce a number of the day-of-week for that date (0=Monday).
-;;; eg, 
-;;;  (TIME:DAY-OF-THE-WEEK-STRING
-;;;	(TIME:ON-WHAT-DAY-OF-THE-WEEK? 22. 11. 1963.))
-;;;  => "Friday"
-;;; which happened to be the day President John F. Kennedy was assasinated.
-
-(DEFUN TIME:ON-WHAT-DAY-OF-THE-WEEK? (DAY MONTH YEAR)
-  (IF (NOT (AND (FIXP YEAR) (FIXP MONTH) (FIXP DAY)))
-      (ERROR "Args to TIME:DAY-OF-WEEK must be fixnums" (LIST YEAR MONTH DAY))
-      (SETQ YEAR (STANDARDIZE-YEAR YEAR))
-      (LET ((A (+ YEAR (// (+ MONTH -14.) 12.)))) 
-	(DECLARE (FIXNUM A))
-	(\ (+ (// (1- (* 13. (+ MONTH 10. (* (// (+ MONTH 10.) -13.) 12.))))
-		  5.)
-	      DAY
-	      76.
-	      (// (* 5. (- A (* (// A 100.) 100.))) 4.)
-	      (// A -2000.)
-	      (// A 400.)
-	      (* (// A -100.) 2.))
-	   7.))))
-
-
-;;; The following sequence is translated from the Teco code in 
-;;; KMP's TPARSE library.
-
-(EVAL-WHEN (EVAL COMPILE)
-  (COND ((NOT (GET 'UMLMAC 'VERSION))
-	 (LOAD '((LISP) UMLMAC)))))
-
-(DEFPROP GMT -4 TIMEZONE-OFFSET)
-
-(DEFPROP EDT  0 TIMEZONE-OFFSET)
-(DEFPROP EST  0 TIMEZONE-OFFSET)
-
-(DEFPROP CDT  1 TIMEZONE-OFFSET)
-(DEFPROP CST  1 TIMEZONE-OFFSET)
-
-(DEFPROP MDT  2 TIMEZONE-OFFSET)
-(DEFPROP MST  2 TIMEZONE-OFFSET)
-
-(DEFPROP PDT  3 TIMEZONE-OFFSET)
-(DEFPROP PST  3 TIMEZONE-OFFSET)
-
-(DEFPROP MONDAY MONDAY DAY-VALUE)
-(DEFPROP MON    MONDAY DAY-VALUE)
-
-(DEFPROP TUESDAY TUESDAY DAY-VALUE)
-(DEFPROP TUESDAY TUE     DAY-VALUE)
-
-(DEFPROP WEDNESDAY WEDNESDAY DAY-VALUE)
-(DEFPROP WEDNESDAY WED       DAY-VALUE)
-
-(DEFPROP THURSDAY THURSDAY DAY-VALUE)
-(DEFPROP THURSDAY THU      DAY-VALUE)
-
-(DEFPROP FRIDAY FRIDAY DAY-VALUE)
-(DEFPROP FRIDAY FRI    DAY-VALUE)
-
-(DEFPROP SATURDAY SATURDAY DAY-VALUE)
-(DEFPROP SATURDAY SAT      DAY-VALUE)
-
-(DEFPROP SUNDAY SUNDAY DAY-VALUE)
-(DEFPROP SUNDAY SUN    DAY-VALUE)
-
-(DEFPROP JANUARY 1 MONTH-VALUE)
-(DEFPROP JAN     1 MONTH-VALUE)
-
-(DEFPROP FEBRUARY  2 MONTH-VALUE)
-(DEFPROP FEB  2 MONTH-VALUE)
-
-(DEFPROP MARCH  3 MONTH-VALUE)
-(DEFPROP MAR  3 MONTH-VALUE)
-
-(DEFPROP APRIL  4 MONTH-VALUE)
-(DEFPROP APR  4 MONTH-VALUE)
-
-(DEFPROP MAY  5 MONTH-VALUE)
-
-(DEFPROP JUNE  6 MONTH-VALUE)
-(DEFPROP JUN  6 MONTH-VALUE)
-
-(DEFPROP JULY  7 MONTH-VALUE)
-(DEFPROP JUL  7 MONTH-VALUE)
-
-(DEFPROP AUGUST     8 MONTH-VALUE)
-(DEFPROP AUG        8 MONTH-VALUE)
-
-(DEFPROP SEPTEMBER  9 MONTH-VALUE)
-(DEFPROP SEP        9 MONTH-VALUE)
-(DEFPROP SEPT       9 MONTH-VALUE)
-
-(DEFPROP OCTOBER  10. MONTH-VALUE)
-(DEFPROP OCT      10. MONTH-VALUE)
-
-(DEFPROP NOVEMBER 11. MONTH-VALUE)
-(DEFPROP NOV      11. MONTH-VALUE)
-
-(DEFPROP DECEMBER 12. MONTH-VALUE)
-(DEFPROP DEC      12. MONTH-VALUE)
-
-(DEFUN TIME:PARSE-WORD-INTERNAL ()
-  (DECLARE (SPECIAL CHARS))
-  (DO ((L NIL (CONS C L))
-       (C (CAR CHARS) (CAR CHARS)))
-      ((AND (OR (< C #/A) (> C #/Z))
-	    (OR (< C #/a) (> C #/z)))
-       (IMPLODE (NREVERSE L)))
-    (SETQ C (IF (AND (NOT (< C #/a))
-		     (NOT (> C #/z)))
-		(- C #.(- #/a #/A))
-	      C))
-    (POP CHARS)))
-
-(DEFUN TIME:PARSE-NUMBER-INTERNAL ()
-  (DECLARE (SPECIAL CHARS))
-  (DO ((FLAG NIL T)
-       (NUM 0 (+ (- (POP CHARS) #/0) (* NUM 10.))))
-      ((NOT (MEMQ (CAR CHARS)
-		  '(#/0 #/1 #/2 #/3 #/4 #/5 #/6 #/7 #/8 #/9)))
-       (AND FLAG NUM))))
-
-(DEFUN GOTO MACRO (X)
-  #+DEBUG `(PROGN (FORMAT T "~&TO ~A N=~D. ~D//~D//~D ~D:~D:~D"
-				   ',(CADR X) N O D Y H M S)
-		  (GO ,(CADR X)))
-  #-DEBUG `(GO ,(CADR X)))
-
-(DEFUN TIME:PARSE-LIST (STRING)
-  (LET ((CHARS (EXPLODEN STRING))
-	/0 /1
-	(S -1) (M -1) (H -1)
-	(D -1) (O -1) (Y -1)
-	(Q 0.) (W NIL) (N -1) (X 0.) (R 0.))
-    (DECLARE (SPECIAL CHARS S M H D O Y))
-    (PROG ()
-     MAIN
-      (DO () ((OR (NULL CHARS)
-		  (NOT (MEMBER (CAR CHARS)
-			       '(#/( #/) #/- #\TAB #\SPACE #\LF #\CR)))))
-	(POP CHARS))
-      (IF (NULL CHARS) (GOTO RET))
-      (WHEN (= (CAR CHARS) #/,)				;Watch for MONTH DAY, YR
-	(POP CHARS)
-	(WHEN (NOT (MINUSP O)) 
-	  (WHEN (NOT (MINUSP N))
-	    (WHEN (MINUSP D)
-	      (SETQ D N)
-	      (SETQ N -1))))
-	(GOTO MAIN))
-      (LET ((NUM (TIME:PARSE-NUMBER-INTERNAL)))
-	(WHEN NUM
-	  (IF (NOT (MINUSP N)) (GOTO SYN))
-	  (SETQ N NUM)
-	  (GOTO NUM)))
-      (SETQ /0 (TIME:PARSE-WORD-INTERNAL))
-      (WHEN (SETQ /1 (GET /0 'MONTH-VALUE))
-	(WHEN (NOT (MINUSP N))
-	  (SETQ D N)
-	  (SETQ N -1))
-	(SETQ X (LOGIOR X 2.))
-	(SETQ O /1)
-	(GOTO MAIN))
-      (WHEN (SETQ /1 (GET /0 'DAY-VALUE))
-	(SETQ W /1)
-	(GOTO MAIN))
-      (IF (EQ /0 'PM) (GOTO EVE))
-      (GOTO NOT-EVE)
-     EVE
-      (COND ((MINUSP H)
-	     (IF (OR (MINUSP N) (PLUSP (- N 12.))) (GOTO SYN))
-	     (SETQ H N)
-	     (SETQ N -1.))
-	    ((NOT (MINUSP N)) (GOTO SYN)))
-      (IF (= H 12.) (SETQ H 0.))
-      (SETQ H (+ H 12.))
-      (GOTO MAIN)
-     NOT-EVE
-      (IF (EQ /0 'AM) (GOTO MORN))
-      (GOTO NOT-MORN)
-     MORN
-      (COND ((MINUSP H)
-	     (IF (OR (MINUSP N) (PLUSP (- N 12.))) (GOTO SYN))
-	     (SETQ H N)
-	     (SETQ N -1.))
-	    ((NOT (MINUSP N)) (GOTO SYN)))
-      (IF (= H 12.) (SETQ H 0.))
-      (GOTO MAIN)
-     NOT-MORN
-      (IF (EQ /0 'THE) (GOTO MAIN))
-      (WHEN (SETQ /1 (GET /0 'TIMEZONE-OFFSET))
-	(SETQ Q (+ Q /1))
-	(GOTO MAIN))
-      (IF (MEMQ /0 '(AT IN ON)) (GOTO MAIN))
-      (IF (MEMQ /0 '(ST ND RD TH)) (GOTO DATE-END))
-      (WHEN (AND (EQ /0 'O)
-		 (NOT (MINUSP N)))
-	(UNLESS (AND (= (POP CHARS) #/')
-		     (EQ (TIME:PARSE-WORD-INTERNAL) 'CLOCK))
-	  (GOTO SYN))
-	(SETQ H N)
-	(SETQ X (LOGIOR X 1.))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (IF (EQ /0 'A) (GOTO MAIN))
-      (WHEN (EQ /0 'NOON)
-	(IF (PLUSP (LOGAND X 1.)) (GOTO SYN))
-	(SETQ H 12.)
-	(SETQ M 0.)
-	(SETQ S 0.)
-	(SETQ X (LOGIOR X 1.))
-	(GOTO MAIN))
-      (WHEN (EQ /0 'NOW)
-	(SETQ X (LOGIOR X 1.))
-	(GOTO MAIN))
-      (WHEN (EQ /0 'TODAY)
-	(GOTO MAIN))
-      (WHEN (EQ /0 'TOMORROW)
-	(SETQ Q (+ Q 24.))
-	(GOTO MAIN))
-      (WHEN (EQ /0 'YESTERDAY)
-	(SETQ Q (- Q 24.))
-	(GOTO MAIN))
-      (WHEN (EQ /0 'HENCE)
-	(SETQ X (LOGIOR X 1.))
-	(SETQ /0 'AFTER))
-      (WHEN (MEMQ /0 '(AFTER FROM))
-	(IF (NOT (MINUSP N)) (GOTO SYN))
-	(SETQ Q (+ Q R))
-	(SETQ R 0.)
-	(GOTO MAIN))
-      (WHEN (MEMQ /0 '(AGO BEFORE))
-	(IF (NOT (MINUSP N)) (GOTO SYN))
-	(SETQ Q (- Q R))
-	(SETQ R 0.)
-	(GOTO MAIN))
-      (WHEN (EQ /0 'OF)
-	(IF (NOT (PLUSP R)) (GOTO MAIN))
-	(IF (NOT (ZEROP (\ R 24.))) (GOTO SYN))
-	(SETQ Q (+ Q (- R 24.)))
-	(SETQ R 0.)
-	(GOTO MAIN))
-      (WHEN (MEMQ /0 '(WK WKS WEEK WEEKS))
-	(SETQ R (+ R (* (IF (MINUSP N) 1 N) 168.)))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (WHEN (MEMQ /0 '(DY DYS DAY DAYS))
-	(SETQ R (+ R (* (IF (MINUSP N) 1 N) 24.)))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (WHEN (MEMQ /0 '(HR HRS HOUR HOURS))
-	(SETQ R (+ R (IF (MINUSP N) 1 N)))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (WHEN (MEMQ /0 '(AFTERNOON EVENING NIGHT LATE)) (GOTO EVE))
-      (WHEN (MEMQ /0 '(MORNING EARLY)) (GOTO MORN))
-      (WHEN (MINUSP N)
-	(PROG ()
-	  (WHEN (MEMQ /0 '(FIFTY  FIFTIETH )) (SETQ N 50.) (GOTO CK-UNITS))
-	  (WHEN (MEMQ /0 '(FORTY  FORTIETH )) (SETQ N 40.) (GOTO CK-UNITS))
-	  (WHEN (MEMQ /0 '(THIRTY THIRTIETH)) (SETQ N 30.) (GOTO CK-UNITS))
-	  (WHEN (MEMQ /0 '(TWENTY TWENTIETH)) (SETQ N 20.) (GOTO CK-UNITS))
-	  (GOTO NOTENS)
-	 CK-UNITS
-	  (WHEN (= (CAR CHARS) #/-)
-	    (POP CHARS)
-	    (SETQ /0 (TIME:PARSE-WORD-INTERNAL))
-	    (GOTO UNITS))
-	  (RETURN T)
-	 NOTENS
-	  (WHEN (MEMQ /0 '(NINETEEN  NINETEENTH )) (SETQ N 19.) (RETURN T))
-	  (WHEN (MEMQ /0 '(EIGHTEEN  EIGHTEENTH )) (SETQ N 18.) (RETURN T))
-	  (WHEN (MEMQ /0 '(SEVENTEEN SEVENTEENTH)) (SETQ N 17.) (RETURN T))
-	  (WHEN (MEMQ /0 '(SIXTEEN   SIXTEENTH  )) (SETQ N 16.) (RETURN T))
-	  (WHEN (MEMQ /0 '(FIFTEEN   FIFTEENTH  )) (SETQ N 15.) (RETURN T))
-	  (WHEN (MEMQ /0 '(FOURTEEN  FOURTEENTH )) (SETQ N 14.) (RETURN T))
-	  (WHEN (MEMQ /0 '(THIRTEEN  THIRTEENTH )) (SETQ N 13.) (RETURN T))
-	  (WHEN (MEMQ /0 '(TWELVE    TWELFTH    )) (SETQ N 12.) (RETURN T))
-	  (WHEN (MEMQ /0 '(ELEVEN    ELEVENTH   )) (SETQ N 11.) (RETURN T))
-	  (WHEN (MEMQ /0 '(TEN       TENTH      )) (SETQ N 10.) (RETURN T))
-	 UNITS
-	  (WHEN (MEMQ /0 '(NINE NINTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 9.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(EIGHT EIGHTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 8.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(SEVEN SEVENTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 7.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(SIX SIXTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 6.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(FIVE FIFTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 5.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(FOUR FOURTH))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 4.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(THREE THIRD))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 3.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(TWO SECOND))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 2.))
-	    (RETURN T))
-	  (WHEN (MEMQ /0 '(ONE FIRST A AN))
-	    (IF (MINUSP N) (SETQ N 0.))
-	    (SETQ N (+ N 1.))
-	    (RETURN T))))
-      (IF (NOT (MINUSP N)) (GOTO NUM))
-     SYN
-      (ERROR "Syntax error in time spec" STRING)
-     DATE-END
-      (WHEN (AND (PLUSP N)
-		 (MINUSP (- N 32.)))
-	(SETQ D N)
-	(SETQ N -1.)
-	(SETQ X (LOGIOR X 2.))
-	(GOTO MAIN))
-      (GOTO SYN)
-     NUM ;By now, N must have a positive number in it
-      (WHEN (AND (PLUSP (- N 1899.))
-		 (MINUSP Y))
-	(SETQ Y (- N 1900.))
-	(SETQ N -1.)
-	(SETQ X (LOGIOR X 2.))
-	(GOTO MAIN))
-      (WHEN (< N 100.)
-	(COND ((= (CAR CHARS) #/:)
-	       (IF (NOT (ZEROP (LOGAND X 1.))) (GOTO SYN))
-	       (SETQ X (LOGIOR X 1.))
-	       (IF (PLUSP (- N 24.)) (GOTO SYN))
-	       (SETQ H N)
-	       (SETQ N -1.)
-	       (POP CHARS)
-	       (SETQ M (TIME:PARSE-NUMBER-INTERNAL))
-	       (IF (NOT M) (GOTO SYN))
-	       (SETQ S (IF (NOT (= (CAR CHARS) #/:)) 0
-			 (POP CHARS)
-			 (TIME:PARSE-NUMBER-INTERNAL)))
-	       (IF (NOT S) (GOTO SYN))
-	       (GOTO SYN))
-	      ((MEMBER (CAR CHARS) '(#/- #//))
-	       (IF (NOT (ZEROP (LOGAND X 2.))) (GOTO SYN))
-	       (SETQ X (LOGIOR X 2.))
-	       (POP CHARS)
-	       (SETQ /0 (TIME:PARSE-NUMBER-INTERNAL))
-	       (IF (NOT /0) (GOTO NOTDATE))
-	       (IF (PLUSP (- N 12.)) (GOTO SYN))
-	       (SETQ O N)
-	       (SETQ N -1.)
-	       (SETQ D /0)
-	       (SETQ Y (IF (NOT (MEMBER (CAR CHARS) '(#// #/-))) 0
-			 (TIME:PARSE-NUMBER-INTERNAL)))
-	       (IF (NOT Y) (GOTO SYN))
-	       (GOTO MAIN))))
-     NOTDATE
-      (WHEN (AND (NOT (MINUSP D))
-		 (NOT (MINUSP O))
-		 (MINUSP Y)
-		 (> N 24.))
-	(SETQ Y N)
-	(SETQ X (LOGIOR X 2.))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (WHEN (AND (NOT (MINUSP Y))
-		 (NOT (MINUSP O))
-		 (NOT (MINUSP D)))
-	(WHEN (ZEROP (LOGAND X 1.))
-	  (IF (< N 25.) (GOTO MAIN))
-	  (SETQ H (// N 100.))
-	  (SETQ M (- N (* H 100.)))
-	  (SETQ S 0.)
-	  (SETQ X (LOGIOR X 2.))
-	  (SETQ N -1.)
-	  (GOTO MAIN)))
-      (WHEN (AND (NOT (MINUSP O))
-		 (MINUSP D)
-		 (OR (ZEROP (LOGAND X 1.))
-		     (AND (NOT (MINUSP H))
-			  (NOT (MINUSP M))
-			  (NOT (MINUSP S)))))
-	(SETQ D N)
-	(SETQ X (LOGIOR X 2.))
-	(SETQ N -1.)
-	(GOTO MAIN))
-      (GOTO MAIN)
-     RET
-      (WHEN (NOT (MINUSP N))
-	(WHEN (MINUSP D)
-	    (SETQ D N) (SETQ N -1.) (SETQ X (LOGIOR X 2.)) (GOTO DEFAULTS))
-	(WHEN (MINUSP Y)
-	  (WHEN (> N 24.)
-	    (SETQ Y N) (SETQ N -1.) (SETQ X (LOGIOR X 2.)) (GOTO DEFAULTS)))
-	(WHEN (MINUSP H)
-	    (SETQ H N) (SETQ N -1.) (SETQ X (LOGIOR X 1.)) (GOTO DEFAULTS))
-	(GOTO SYN))
-     DEFAULTS
-      (LET ((DATE (STATUS DATE))
-	    (DOW  (STATUS DOW))
-	    (TIME (STATUS DAYTIME)))
-	(WHEN (NOT (EQUAL (STATUS DATE) DATE)) ;just after midnite?
-	  (SETQ DATE (STATUS DATE))
-	  (SETQ DOW  (STATUS DOW))
-	  (SETQ TIME (STATUS DAYTIME)))
-	(PROG ()
-	  (WHEN (AND (NOT (ZEROP (LOGAND X 1.)))
-		     (MINUSP H)
-		     (MINUSP M)
-		     (MINUSP S))
-	    (SETQ H (CAR TIME) M (CADR TIME) S (CADDR TIME)))
-	  (IF (MINUSP H) (SETQ H 0.))
-	  (IF (MINUSP M) (SETQ M 0.))
-	  (IF (MINUSP S) (SETQ S 0.))
-	  (WHEN (AND (NOT (ZEROP (LOGAND X 2.)))
-		     (MINUSP Y)
-		     (MINUSP O)
-		     (MINUSP D))
-	    (GOTO TODAY))
-	  (IF (NOT (ZEROP (LOGAND X 2.))) (GOTO NOT-TODAY))
-	 TODAY
-	  (SETQ Y (CAR DATE))
-	  (SETQ O (CADR DATE))
-	  (SETQ D (CADDR DATE))
-	 NOT-TODAY
-	  (IF (MINUSP Y) (SETQ Y (CAR DATE)))
-	  (IF (MINUSP O) (SETQ O (IF (MINUSP D) 1 (CADR DATE))))
-	  (IF (MINUSP D) (SETQ D 1.)))
-	(WHEN (NOT (ZEROP Q))
-	  (SETQ /0 (+ 1 (* 2 (IF (PLUSP Q) -1 0))))
-	  (SETQ H (+ H Q))
-	  (PROG ()
-	   TOP
-	    (TIME:NORMALIZE-DATE-INTERNAL)
-	    (IF (AND (NOT (MINUSP H)) (< H 24.))
-		(RETURN T))
-	    (SETQ W NIL)
-	    (SETQ H (+ H (* 24. /0)))
-	    (SETQ D (- D /0))
-	    (GO TOP)))
-	;W holds specified date or NIL. We ignore that for now...
-	(RETURN
-	 (LIST S M H D O Y
-	       (TIME:DAY-OF-THE-WEEK-STRING
-		(TIME:ON-WHAT-DAY-OF-THE-WEEK? D O Y))))))))
-
-(DEFUN TIME:NORMALIZE-DATE-INTERNAL ()
-  (DECLARE (SPECIAL Y O D H M S))
-  (PROG (TT X)
-    (IF (AND (PLUSP D) (MINUSP (- D 29.))) (RETURN T))
-    (SETQ TT (TIME:ON-WHAT-DAY-OF-THE-WEEK? D O Y))
-    (COND ((NOT (PLUSP D))
-	   (SETQ O (1- O))
-	   (SETQ D 28.)
-	   (WHEN (ZEROP O) (SETQ O 12.) (SETQ Y (1- Y)))
-	   (SETQ X (TIME:ON-WHAT-DAY-OF-THE-WEEK? D O Y))
-	   (IF (MINUSP (- TT X)) (SETQ TT (+ TT 7)))
-	   (SETQ D (+ D TT (- X))))
-	  (T
-	   (LET ((YY Y) (OO (1+ O)) (DD 1))
-	     (WHEN (> O 12.) (SETQ O 1) (SETQ Y (1+ Y)))
-	     (SETQ X (TIME:ON-WHAT-DAY-OF-THE-WEEK? DD OO YY))
-	     (IF (ZEROP (- X TT)) (SETQ Y YY O OO D DD)))))))