;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for CDI version 1.18
;;; Reason:
;;;  Added reading the Explorer Clock chip to initialize timebase if network not available.
;;; Written 17-Jul-86 12:45:34 by Gibson at site CDI Dallas
;;; while running on EXPLORER-1 from band 1
;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.93, Experimental Window-Maker 2.0, Experimental CDI 1.16, microcode 1564, CDI Beta III.



; From modified file S2: >Lambda-3>IO1>time.lisp.129 at 17-Jul-86 12:45:35
#10R TIME#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TIME")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; TIME  "

(DEFUN INITIALIZE-TIMEBASE (&OPTIONAL UT always-ask suppress-notify &AUX SOURCE-HOST)
  "Set the clock.
Possible sources of the time include the network, the Lambda SDU clock, (explorer SIB clock),
and, failing that, the user who happens to be around.  
Will notify where time gotten from unless suppressed."
  (TAGBODY
      (if always-ask (go string))
      (When (And (Null ut) (Not (SI:GET-SITE-OPTION :STANDALONE)) *NETWORK-TIME-FUNCTION*)
	(Multiple-Value (UT SOURCE-HOST)
	  (FUNCALL *NETWORK-TIME-FUNCTION*))
	(When (And (Not SUPPRESS-NOTIFY) (FBOUNDP 'TV:NOTIFY) (NUMBERP UT) SOURCE-HOST)
	  (TV:NOTIFY NIL "Time from host ~A is ~VQ." SOURCE-HOST UT 'PRINT-UNIVERSAL-TIME)))
      (When (NUMBERP UT) (GO DO-IT))
      (Select-Processor
	(:lambda
	  (SETQ UT (AND (NULL SI:*IN-COLD-LOAD-P*) ; don't deal with SDU clock until cold load is done ...
			(NULL (UNIX-PROCESSOR-PRESENT))  ;It sets up SDU clock differently, let it have it.
			(RTC-GET-UNIVERSAL-TIME)))
	  (COND ((AND (NULL SUPPRESS-NOTIFY)
		      (FBOUNDP 'TV:NOTIFY)
		      UT)
		 (TV:NOTIFY NIL "Time from SDU clock is ~VQ." UT 'PRINT-UNIVERSAL-TIME)))
	  (COND (UT (GO DO-IT))))    ; change to GIVE-IT-A-SHOT if the user should be asked
	(:explorer
	  (when (explorer-initial-date-valid-p)
	    (setq ut (explorer-get-universal-time))
	    (When (And (Not suppress-notify) (FBoundP 'TV:NOTIFY) (Not (Null ut)))
	      (tv:Notify nil "Time from SIB clock is ~VQ." ut 'print-universal-time))
	    (go do-it)))
	(:cadr))
   STRING
      (FORMAT *QUERY-IO* "~&Please type the date and time: ")
      (SETQ UT (READLINE *QUERY-IO*))
      (WHEN (STRING-EQUAL UT "")
	(IF (Y-OR-N-P "Do you want to specify the time or not? ")
	    (GO STRING)
	  (SETQ *LAST-TIME-UPDATE-TIME* NIL)
	  (RETURN-FROM INITIALIZE-TIMEBASE NIL)))
      (CONDITION-CASE (ERROR)
	  (SETQ UT (PARSE-UNIVERSAL-TIME UT 0 NIL T 0))
	(ERROR (SEND ERROR :REPORT *QUERY-IO*)
	       (GO STRING)))
   GIVE-IT-A-SHOT
      (UNLESS (Y-OR-N-P (FORMAT NIL "Time is ~A, OK? " (PRINT-UNIVERSAL-DATE UT NIL)))
	(GO STRING))
   DO-IT
      (WITHOUT-INTERRUPTS
	(IF (NOT (NULL *UT-AT-BOOT-TIME*))
	    ;;if we are randomly changing the time while up, mung uptime
	    (SETQ *UT-AT-BOOT-TIME*
		  (+ *UT-AT-BOOT-TIME* (- UT (GET-UNIVERSAL-TIME))))
	  ;;no real surprise: changing at boot time
	  (SETQ *UT-AT-BOOT-TIME* UT))
	(SETQ *LAST-TIME-UPDATE-TIME* (TIME))
	(MULTIPLE-VALUE (*LAST-TIME-SECONDS* *LAST-TIME-MINUTES* *LAST-TIME-HOURS*
			 *LAST-TIME-DAY* *LAST-TIME-MONTH* *LAST-TIME-YEAR*
			 *LAST-TIME-DAY-OF-THE-WEEK* *LAST-TIME-DAYLIGHT-SAVINGS-P*)
	  (DECODE-UNIVERSAL-TIME UT))
	(select-processor
	  (:lambda
	    (Unless (unix-processor-present)
	      (RTC-SET-UNIVERSAL-TIME UT)))
	  (:explorer
	    (explorer-set-universal-time UT))
	  (:cadr))
	(RETURN-FROM INITIALIZE-TIMEBASE T))))

))

; From modified file S2: >Lambda-3>IO1>time.lisp.129 at 17-Jul-86 12:46:32
#10R TIME#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TIME")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; TIME  "

;;; Explorer RTC code.

(DefConst Real-Time-Clock-Base #xF80000)
(DefConst RTC-Seconds-Counter				 8.)
(DefConst RTC-Minutes-Counter				12.)
(DefConst RTC-Hours-Counter				16.)
(DefConst RTC-Day-Of-Month-Counter			24.)
(DefConst RTC-Month-Counter				28.)
(DefConst RTC-RAM-100-Nanoseconds-Counter		32.)
(DefConst RTC-RAM-10-And-100-Millisecond-Counter	36.)
(DefConst RTC-Read-Status-Bit				80.)


(DefConst RTC-Counter-Registers
	  `(,RTC-Seconds-Counter
	    ,RTC-Minutes-Counter
	    ,RTC-Hours-Counter
	    ,RTC-Day-Of-Month-Counter
	    ,RTC-Month-Counter))

(DefConst *maximum-year* 2399.)

(Defun BCD-to-Fixnum (bcd-number)
  (+ (* (truncate bcd-number #x10) 10.)
     (mod bcd-number #x10)))

(Defun Fixnum-to-BCD (fixnum)
  (+ (* (truncate fixnum 10.) #x10)
     (mod fixnum 10.)))

(Defun Read-Explorer-RTC-Chip (offset)
  (si:%nubus-read-8 tv:tv-quad-slot (+ real-time-clock-base offset)))

(Defun Write-Explorer-RTC-chip (offset value)
  (si:%nubus-write-8 tv:tv-quad-slot (+ real-time-clock-base offset) value))

(Defun Explorer-RTC-Read-Status-OK-P ()
  (Evenp (Read-Explorer-RTC-Chip RTC-read-status-bit)))

(Defun Read-Explorer-RTC (&aux clock-values (try-again t))
  (loop WHILE try-again
        DO
        (progn
          (without-interrupts
            (setq clock-values 
                  (loop FOR register IN RTC-counter-registers 
                        ALWAYS (Explorer-RTC-Read-Status-Ok-P)
                        FINALLY (Return (Progn (Setq try-again nil) clock-collector))
                        COLLECT (BCD-to-Fixnum (Read-Explorer-RTC-Chip register))
                        INTO clock-collector)))))
  clock-values)

(Defun Write-Explorer-RTC (seconds minutes hours date month
			   &aux clock-values (try-again t))
  (Setq clock-values `(,seconds ,minutes ,hours ,date ,month))
  (Loop WHILE try-again
        DO (without-interrupts
	     (loop FOR time-index FROM 0 BY 1
		   FOR register IN RTC-counter-registers 
		   ALWAYS (Explorer-RTC-read-status-ok-p)
		   FINALLY (setq try-again nil)
		   DO
		     (Write-Explorer-RTC-chip
		       register (fixnum-to-bcd (nth time-index clock-values))))))
  )

(Defun Explorer-Set-Universal-Time (universal-time)
  (Multiple-Value-Bind (seconds minutes hours day-of-month month year)
      (time:decode-universal-time universal-time)
    (Let ((february-29 (and (= day-of-month 29) (= month 2))))
      (Write-Explorer-RTC
	seconds minutes hours (if february-29 (1- day-of-month) day-of-month) month)
      (Write-Day-is-February-29 february-29)
      (Write-Explorer-Year year)))
  )


(Defun Explorer-Initial-Date-Valid-P ()
  (Let ((year (Read-Explorer-Year)))
    (Unless (or (< year 1984.) (> year *maximum-year*))
      (Let ((clock-value (read-explorer-RTC)))
	(Unless (or (> (nth 0 clock-value) 59.)		; Seconds
		    (> (nth 1 clock-value) 59.)		; Minutes
		    (> (nth 2 clock-value) 23.))	; Hours
	  (Let ((month (nth 4 clock-value)))
	    (Unless (or (> month 12.)
			(> (nth 3 clock-value)
			   (month-length month year)))	; Day of month
	      t))))))
  )

(Defun Explorer-Get-Universal-Time ()
  ;; Special note: when February 29th comes around, we have
  ;; backed up the clock to February 28th and set a flag
  ;; that indicates that today is really February 29th.
  (Let ((clock-value (Read-Explorer-RTC)))
    (time:encode-universal-time
      (nth 0 clock-value)    		; Seconds
      (nth 1 clock-value)    		; Minutes
      (nth 2 clock-value)    		; Hours
      (+ (nth 3 clock-value)    	; Day of month
	 (if (day-is-february-29-p) 1 0))
      (nth 4 clock-value)    		; Month
      (Read-Explorer-Year)))
  )

(Defun Read-Explorer-Year ()
  ;; The clock chip doesn't have a year counter so we will store that
  ;; information into the RAM part of the clock which we will not be
  ;; using.  The low order 3 decimal digits of the time will contain
  ;; the year data in the following format:
  ;;   10 and 100 millisecond counters - year within century
  ;;   100 nanosecond counter          - formula
  ;;
  ;; where the formula is calculated as follows:
  ;;   (century - 19) * 2 + day-is-february-29
  ;; Note that the 100 nanosecond counter only has the 10's digits
  ;; being valid.  The units digits are all zeros.
  ;;      7 6 5 4 3 2 1 0  bit position
  ;;      D D D D 0 0 0 0  data present or 0
  ;;      x x x            century
  ;;            x          day-is-february-29
  ;;
  ;; This will get us up to the year 2399, which should be enough.
  ;;
  ;; day-is-february-29 is 0 on every day which is not February 29 and
  ;;   is  1 on that day.
  (+ (bcd-to-fixnum
       (Read-Explorer-RTC-chip RTC-RAM-10-and-100-millisecond-counter))
     (* 100. (+ 19. (ldb #o0503 (read-explorer-RTC-chip RTC-RAM-100-nanoseconds-counter)))))
  )

(Defun Write-Explorer-Year (year)
  (Multiple-Value-Bind (century year-within-century)
      (Truncate year 100.)
    (Write-Explorer-RTC-chip
      RTC-RAM-10-and-100-millisecond-counter (fixnum-to-bcd year-within-century))
    ;; Write in the century information, being careful not to
    ;; touch the day-is-february-29 bit (bit 4)
    (Write-Explorer-RTC-chip
      RTC-RAM-100-nanoseconds-counter
      (dpb (- century 19.) #o0503
	   (read-explorer-RTC-chip RTC-RAM-100-nanoseconds-counter))))
  )


(Defun day-is-february-29-p ()
  (ldb-test #o0401 (read-explorer-RTC-chip RTC-RAM-100-nanoseconds-counter)))

(Defun write-day-is-february-29 (day-indicator)
  (Unless (numberp day-indicator)
    (Setq day-indicator (if day-indicator 1 0)))
  (Write-Explorer-RTC-Chip
    RTC-RAM-100-nanoseconds-counter
    (dpb day-indicator #o0401
	 (Read-Explorer-RTC-Chip
	   RTC-RAM-100-nanoseconds-counter)))
  )

))