;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:8 -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1985, Texas Instruments Incorporated. All rights reserved.
;;;                       ^^
;;; Doesn't depend on which package it is in except for Load-Crash-Table.
;;; If you change package also change in Load-Crash-Table.
;;;
;;;
;;;                 Crash Record Support for Explorer
;;;
;;;
;;; TERMS:
;;;
;;; NVRAM - Non-Volatile Random Access Memory
;;;
;;; CRASH RECORD - a block of storage in non-volatile memory (NVRAM)
;;;that is allocated and intialized by microcode when Lisp is started
;;;and in which microcode records a small amount about the
;;;circumstances whenever Lisp halts or is halted.  There is a ring of
;;;crash records in NVRAM so that the previous several halts may be
;;;recorded.
;;;
;;; HALT - an event which stops Lisp.  A halt may be caused by microcode
;;;that notices an illegal condition, by a Lisp program that notices an
;;;illegal condition, by hardware causes (ie, power failure), or by
;;;normal system shutdown at the request of the user.
;;;
;;; HANG - a condition when Lisp is unresponsive and appears to have
;;;halted but is still running.
;;;
;;; CRASH - any halt that is not a normal system shutdown.
;;;
;;; SHUTDOWN - stopping Lisp by the request of the user.
;;;
;;; CRASH RING - a ring (circularly allocated structure) that contains
;;;crash records for the previous several startups.
;;;
;;; STARTUP - when Lisp is started or restarted.  COLD BOOT and WARM
;;;BOOT each are startups.  For the purposes of CRASH RECORDS (to which
;;;startup is non-atomic) startup occurs before loading the wired areas
;;;and starting virtual memory.
;;;
;;;

;;;
;;; Variable initialization. 
;;;

(DefVar Current-Crash-Rec-Offset nil "Offset into NVRAM of current (for this boot) crash record.")

(Defun Setup-Crash-Rec-Vars ()
  "Set up CURRENT-CRASH-RECORD-OFFSET with relative address of this boot's crash record."
  (select-processor
    ((:cadr :lambda))
    (:explorer
      (Let ((next-crec (Read-NVRAM-16B NVRAM-Crash-Buff-Pointer)))
	(setq CURRENT-CRASH-REC-OFFSET (CRASH-REC-Find-Previous next-crec))))))


;;;
;;; Crash Record reading, writing.
;;;

;;; Current crash record.  8-bit forms
(Defun Write-Current-Crash-Rec (offset value)
  "Write LSB of value to location OFFSET into current crash record."
  (Write-NVRAM (+ offset Current-Crash-Rec-Offset) value))

(Defun Read-Current-Crash-Rec (offset)
  "Read byte at location OFFSET in current crash record."
  (Read-NVRAM (+ offset Current-Crash-Rec-Offset)))

(DefSetf Read-Current-Crash-Rec Write-Current-Crash-Rec)

;;; Current crash record. 16-bit forms
(Defun Read-Current-Crash-Rec-16B (offset)
  "Read half-word at OFFSET in current crash record, LSB first."
  (Read-NVRAM-16B (+ offset Current-Crash-Rec-Offset)))

(Defun Write-Current-Crash-Rec-16B (offset value)
  "Write least significant 16 bits of VALUE, LSB first, to location OFFSET
 into current crash record."
  (Write-NVRAM-16B (+ offset Current-Crash-Rec-Offset) value))

(DefSetf Read-Current-Crash-Rec-16B Write-Current-Crash-Rec-16B)


;;; Any crash record. 8-bit forms
(Defun Write-Crash-Rec (crash-rec-pointer offset value)
 "Write LSB of value to location OFFSET into crash record."
 (Write-NVRAM (+ offset crash-rec-pointer) value))

(Defun Read-Crash-Rec (crash-rec-pointer offset)
  "Read byte at location OFFSET in crash record."
  (Read-NVRAM (+ offset crash-rec-pointer)))

(DefSetf Read-Crash-Rec Write-Crash-Rec)

;;; Any crash record. 16-bit forms
(Defun Read-Crash-Rec-16B (crash-rec-pointer offset)
 "Read half-word at OFFSET in crash record, LSB first."
 (Read-NVRAM-16B (+ offset crash-rec-pointer)))

(Defun Write-Crash-Rec-16B (crash-rec-pointer offset value)
 "Write least significant 16 bits of VALUE, LSB first, to location OFFSET
 into crash record."
 (Write-NVRAM-16B (+ offset crash-rec-pointer) value))

(DefSetf Read-Crash-Rec-16B Write-Crash-Rec-16B)

;;; Any crash record. 32-bit forms
(Defun Read-Crash-Rec-32B (crash-rec-pointer offset)
  "Read 32 bit word stored at OFFSET into crash record, from LSB to MSB."
  (Dpb (Read-NVRAM-16B (+ offset crash-rec-pointer 8.))
       2020
       (Read-NVRAM-16B (+ offset crash-rec-pointer))))

(Defun Write-Crash-Rec-32B (crash-rec-pointer offset value)
  "Write 32 bits of VALUE into crash record at location OFFSET.  LSB stored first."
  (Write-NVRAM-16B (+ offset crash-rec-pointer)
		   (Ldb 0020 value))
  (Write-NVRAM-16B (+ offset crash-rec-pointer 8.)
		   (Ldb 2020 value)))
  
(DefSetf Read-Crash-Rec-32B Write-Crash-Rec-32B)

;;;
;;; Crash Record locating routines.
;;;

(Defun Crash-Rec-Find-Previous (crash-rec-pointer)
  "Given a pointer to a crash record, return pointer to previous crash record
in crash ring."
  (Let* ((crec-size (Read-NVRAM-16B NVRAM-Crash-Buff-Rec-Len))
	 (crec-buf-base (Read-NVRAM-16B NVRAM-Crash-Buff-Base))
	 (trial-prev (- crash-rec-pointer crec-size)))
    (if (>= trial-prev crec-buf-base)		;check for wrap around
	trial-prev
      (Read-NVRAM-16B NVRAM-Crash-Buff-Last))	;return ptr to last
    ))
						
(Defun Crash-Rec-Find-Next (crash-rec-pointer)
  "Given a pointer to a crash record, return pointer to next crash record
in crash ring."
  (Let* ((crec-size (Read-NVRAM-16B NVRAM-Crash-Buff-Rec-Len))
	 (crec-buf-last (Read-NVRAM-16B NVRAM-Crash-Buff-Last))
	 (trial-next (+ crash-rec-pointer crec-size)))
    (if (<= trial-next crec-buf-last)		;check for wrap around
	trial-next
      (Read-NVRAM-16B NVRAM-Crash-Buff-Base))	;return ptr to first
    ))

(Defun Number-of-Crash-Records-in-Ring ()
  "Returns total number of crash records in crash ring."
  (Let ((crec-size (Read-NVRAM-16B NVRAM-Crash-Buff-Rec-Len))
	(crec-buf-last (Read-NVRAM-16B NVRAM-Crash-Buff-Last))
	(crec-buf-first (Read-NVRAM-16B NVRAM-Crash-Buff-Base)))
    ;; last points before last record so add one
    (1+ (truncate (- crec-buf-last crec-buf-first)
		  crec-size))))

(Defun All-Crash-Records (current-crec)
  "Returns list of all crash record offsets, current record first."
  (Do* ((n (1- (Number-of-Crash-Records-in-Ring)) (1- n))
	;; since getting all can go forward to get them in reverse
	;;  order making it easier to cons them into a list.
        (crec (Crash-Rec-Find-Next current-crec)
	     (Crash-Rec-Find-Next crec))
	(l (ncons crec) (cons crec l))
	)
       ((zerop n) l)))

;;;
;;; Printers for various Crash Record fields
;;;

(Defun CREC-Chars-to-String (crec offset n-chars)
  "Make a string out of N-CHARS of bytes starting at OFFSET into CREC."
  (Do ((result (make-array n-chars ':type 'art-string ':fill-pointer n-chars))
       (idx 0 (1+ idx))
       (offset-i offset (+ offset-i 4)))
      ((>= idx n-chars) result)
    (aset (Read-Crash-Rec crec offset-i) result idx)))

(Defun Get-String-for-Unit (unit)
  "Returns descriptive string for UNIT (a physical disk unit)."
  (Format nil "Physical unit ~d" unit)
;;;  (if (and (fixp unit) (< unit #x40))		;#x40 is max physical unit nbr on Explorer -ab
;;;      (let* ((logical-unit (si:get-logical-unit unit))
;;;	     (unit-exists (car (memq logical-unit (si:all-disk-units))))
;;;	     (name-now (if unit-exists
;;;			   (si:get-pack-name logical-unit)
;;;			   nil)))
;;;	(if (null name-now)
;;;	    (format nil "Unit ~d (not currently online)" logical-unit)
;;;	    (format nil "Unit ~d (currently called ~A)" logical-unit name-now)))
;;;      (format nil "Unit ~d. (probably invalid unit)" unit))
  )

;;; Load Band Name, etc.
(Defun Get-CREC-String-for-Load (crec)
  "Returns name of LOD band."
  (CREC-Chars-to-String crec CRO-Load-Part 4))

(Defun Get-CREC-String-for-Micro (crec)
  "Returns name of MCR band."
  (CREC-Chars-to-String crec CRO-Ucode-Part 4))

(Defun Get-CREC-String-for-Load-Unit (crec)
  "Returns string describing load unit."
  (Get-String-for-Unit (Read-Crash-Rec crec CRO-Load-Unit)))

(Defun Get-CREC-String-for-Micro-Unit (crec)
  "Returns string describing unit MCR came off of."
  (Get-String-for-Unit (Read-Crash-Rec crec CRO-Ucode-Unit)))

(Defun Get-CREC-String-for-Load-Version (crec)
  "Returns string for CREC's LOD version/revision."
  (Let  ((version  (Read-Crash-Rec-16B crec CRO-Load-Version))
	 (revision (Read-Crash-Rec-16B crec CRO-Load-Revision)))
    (if (and (= version 0) (= revision 0))
	(format nil "~d.~d (probably invalid version)" version revision)
      (format nil "~d.~d" version revision))))

(Defun Get-CREC-String-for-Micro-Version (crec)
  "Returns string for MCR version."
  (Let ((version (Read-Crash-Rec-16B crec CRO-Ucode-Version)))
    (if (= version 0)
	(format nil "~d. (probably invalid version)" version)
      (format nil "~d." version))))

(Defun Get-CREC-String-for-Progress (crec)
  "Returns string describing Progress Code field.  Looks up string associated with
progress number in CREC-Progress-Decode list."
  (Let* ((progress (Read-Crash-Rec crec CRO-Progress))
	 (decode (memq progress CREC-Progress-Decode)))
    (if (null decode)
	(format nil "Progress code ~d. invalid" progress)
      (string (cadr decode)))))

(Defun Get-CREC-String-for-Boot-Time (crec)
  "Returns string for boot time."
  (if (< (Read-Crash-Rec crec CRO-Progress) CREC-Progress-Time-Initialized)
      "Boot time not recorded"
      (format nil "~d//~d//~2d ~2d:~2d"
	      (Read-Crash-Rec crec CRO-Boot-Month)
	      (Read-Crash-Rec crec CRO-Boot-Day)
	      (Read-Crash-Rec crec CRO-Boot-Year)
	      (Read-Crash-Rec crec CRO-Boot-Hour)
	      (Read-Crash-Rec crec CRO-Boot-Minute))
      ))

(Defun Get-CREC-String-for-Crash-Time (crec)
  "Returns string for crash time."
  (if (< (Read-Crash-Rec crec CRO-Progress) CREC-Progress-Time-Initialized)
      "Crash time not recorded"
      (format nil "~d//~d//~2d ~2d:~2d"
	      (Read-Crash-Rec crec CRO-Current-Month)
	      (Read-Crash-Rec crec CRO-Current-Day)
	      (Read-Crash-Rec crec CRO-Current-Year)
	      (Read-Crash-Rec crec CRO-Current-Hour)
	      (Read-Crash-Rec crec CRO-Current-Minute))
      ))

(Defun Get-Q-String-from-CREC (crec offset)
  "Returns string describing Q at OFFSET--its data type, and hex representation."
  (Let* ((high-byte (Read-Crash-Rec crec (+ offset 12.)))
	 (cdr-code (Ldb 0602 high-byte))
	 (data-type (Ldb 0105 high-byte))
	 (low-pointer (Dpb (Read-Crash-Rec crec (+ offset 8.))
			   2010
			   (Dpb (Read-Crash-Rec crec (+ offset 4.))
				1010
				(Read-Crash-Rec crec offset))))
	 (whole (Dpb high-byte 3010 low-pointer))
	 (pointer (if (ldb-test 0001 high-byte)
		      (1+ (lognot low-pointer))
		    low-pointer)))
    (format nil "<~A #x~16r~[~; CDR-ERROR~; CDR-NIL~; CDR-NEXT~]> (#x~16r)"
	    (Q-Data-Types data-type) pointer cdr-code whole)))


;;;
;;; Crash Table Entry (CTE) handling
;;;

;;; A CTE is generated by the CRASH-TABLE microassembler (ULAP) psuedo-op
;;; The ULAP statement
;;;    (CRASH-TABLE "fooo ~A baarr" M-1)
;;; will generate the CTE
;;;    ("fooo ~A baarr" M-1)
;;;
;;; The CAR of a CTE controls its meaning.
;;; If it is a string then we (EVAL (list* #'Format stream CTE))
;;; in an environment where stream and some other variables are bound.
;;; The special variables are:
;;;    M-1  bound to the value of M-1 as a positive 32-bit integer.
;;;    M-2    "    "  "    "   "  M-2  " "    "       "       "
;;;    MD     "    "  "    "   "  MD   " "    "       "       "
;;;    VMA    "    "  "    "   "  VMA  " "    "       "       "
;;;    M-1-Q bound to a string representing a Q printing of M-1
;;;    M-2-Q   "   "  "   "         "       " "    "     "  M-2
;;;    MD-Q    "   "  "   "         "       " "    "     "  MD
;;;    VMA-Q   "   "  "   "         "       " "    "     "  VMA
;;;
;;; If the CAR of a CTE is a SYMBOL, we (APPLY (get symbol 'REPORT) CTE)
;;; in the same binding environment.
;;; 
;;; Because they are evaluated, the second element and beyond of a CTE
;;; whose CAR is a string can be forms such as load-byte.  Do not rely,
;;; however, on variables beyond those mentioned above.

(DefVar M-1 :Unbound)
(DefVar M-2 :Unbound)
(DefVar MD  :Unbound)
(DefVar VMA :Unbound)
(DefVar M-1-Q :Unbound)
(DefVar M-2-Q :Unbound)
(DefVar MD-Q :Unbound)
(DefVar VMA-Q :Unbound)

;;;
;;; Microassembler Crash Table loading.
;;;

;;; Variables to hold assembler's crash table.
(DefVar Microcode-Crash-Table nil)
(DefVar Microcode-Crash-Table-Version-Number nil)
(DefVar Microcode-Crash-Tables nil "List of all currently loaded crash tables")
(DefVar *Default-Crash-Table-Pathname*
	"SYS: UBIN; CONTROL")

(Defun Assure-Crash-Table-Loaded-for-Ucode (version)
  "Makes sure crash table database for version VERSION of the ucode is loaded."
  (Let ((table (Assq version Microcode-Crash-Tables)))
    (if (null table)
	(Load-Crash-Table version)
      (cdr table))))

(Defun Load-Crash-Table (ucode-version)
  "Returns crash table for version UCODE-VERSION of the microcode."
  (SI:WITH-SYS-HOST-ACCESSIBLE
    (Let ((pathname (FUNCALL (FS:PARSE-PATHNAME *DEFAULT-CRASH-TABLE-PATHNAME*)
			     ':NEW-TYPE-AND-VERSION "CRASH" ucode-version)))
      (load pathname "SI")			;loading control.crash will set Microcode-Crash-Table
						;var to be our crash table database.
      (setq Microcode-Crash-Tables
	    (cons (cons Microcode-Crash-Table-Version-Number Microcode-Crash-Table)
		  Microcode-Crash-Tables))
      Microcode-Crash-Table)))

;;;
;;; Crash record hacking routines.
;;;

(Defmacro Test-Crash-Rec-Bits (crec offset ppss)
  "Reads 8 bits from a crash record CREC at OFFSET and returns
   T if the field PPSS is not zero."
  `(LDB-Test ,ppss (Read-Crash-Rec ,crec ,offset)))

(Defmacro Store-Crash-Rec-Field (crec offset ppss value)
  "Deposits VALUE into field PPSS of the 8 bits of a crash record
   CREC at OFFSET."
  `(Write-Crash-Rec ,crec ,offset
		    (DPB ,value ,ppss (Read-Crash-Rec ,crec ,offset))))

(Defun Crec-Allocated-P (crec)
  "Returns t if crash record progress field indicates that the crash record
was allocated; else returns nil."
  (if (= (read-crash-rec crec CRO-Progress) CREC-Progress-Initial-Value)
      nil
      t))

(Defun Crash-Record-Reasonable-P (crec)
  "Simple test that crash record is not garbage."
  (and (<= (read-crash-rec crec CRO-PROGRESS) CREC-Progress-Max) ;progress into boot  -ab
       (<= (read-crash-rec crec CRO-Controller) 15.)	;max NuBus slot number.
       (<= (read-crash-rec crec CRO-Boot-Month)      12.)))	;max month

(Defun Crec-Format-Matches-P ()
  "Returns t if crash record revision level in NVRAM matches Explorer revision
level we hack."
  (and (= (Read-NVRAM-16B NVRAM-Crash-Buff-Format-Processor) CRASH-REC-FORMAT-PROCESSOR-TYPE)
       (= (Read-NVRAM NVRAM-Crash-Buff-Format-Rev) CRASH-REC-FORMAT-VERSION)))

(Defun Normal-Lisp-Halt-P (crash-rec)
  "Returns t if Halt called from Lisp was normal (shutdown, disk save, etc); else nil."
  (let ((code (Read-Crash-Rec-16B crash-rec CRO-M-1)))
    (= code 0)))					;Make this more general  -ab

(Defun Normal-Shutdown-P (crash-rec)
  "Returns NIL if crash, T if normal shutdown or reboot."
  (If (= (Read-Crash-Rec crash-rec CRO-Halt-Kind) CREC-System-Boot)
      t
      (And (= (Read-Crash-Rec crash-rec CRO-Halt-Kind)
	      CREC-Lisp-Halt)
	   (Normal-Lisp-Halt-P crash-rec)
	   )))

;;;
;;; Formatting stuff.
;;;

(Defun CREC-Log-Print-Line (stream)
  (format stream "~%-----------------------------------------------~
--------------------------------------------------------------"))

(Defun CREC-Log-Format-Title (crec stream)
  (format stream "~&")
  (CREC-Log-Print-Line stream)
  (format stream "~%CRASH RECORD AT OFFSET #x~16r" crec)
  (CREC-Log-Print-Line stream))

(Defun Time-Stamp-Log (stream)
  "Writes time and date to stream where crash record written"
  (format stream "~2%")
  (CREC-Log-Print-Line stream)
  (format stream "~%CRASH ANALYSIS LOGGED  ~A"
	  (time:print-current-time nil)))

(Defun Format-Bad-CREC-Rev (stream)
  "Reports warning if processor type or version of NVRAM do not match."
  (format stream "~%****** WARNING ****** ~
                  ~%Crash Record Format in NVRAM (version ~d.) for processor type ~d. ~
                  ~%does not match current format (version ~d.) for Explorer (type ~d.).~
                  ~%This may indicate that your NVRAM has never been initialized or that ~
                  ~%it was initialized under outdated microcode.  Valid crash information ~
                  ~%cannot be reported until NVRAM is properly initialized using (si:setup-nvram).~%"
	  (Read-NVRAM NVRAM-Crash-Buff-Format-Rev)
	  (Read-NVRAM-16B NVRAM-Crash-Buff-Format-Processor)
	  CRASH-REC-FORMAT-VERSION
	  CRASH-REC-FORMAT-PROCESSOR-TYPE))

(Defun Format-Bad-NVRAM-Msg (stream)
  "Reports warning if NVRAM inaccessible."
  (format stream "~%****** WARNING ****** ~
                  ~%Cannot report crash records because unable to verify ~
                  ~%the proper functioning of NVRAM.  Have your NVRAM hardware examined."))

(Defun Report-Bad-Crec (crec stream)
  "Writes Bad CREC format msg to stream"
  (CREC-Log-Print-Line stream)
  (format stream
	  "~%Crash record at offset #x~16r does not look reasonable." crec))

(Defun Format-Header-Information (crec stream)
  "Prints constant portion of crash description."
  (CREC-Log-Format-Title crec stream)
  (Format stream
     "~%Load Band: ~25,0T~A, version ~A, on ~A "  
     (Get-CREC-String-for-Load crec)
     (Get-CREC-String-for-Load-Version crec)
     (Get-CREC-String-for-Load-Unit crec))
  (Format stream
     "~%Microcode Band:  ~25,0T~A, version ~A, on ~A"
     (Get-CREC-String-for-Micro crec)
     (Get-CREC-String-for-Micro-Version crec)
     (Get-CREC-String-for-Micro-Unit crec))
  (Format stream
     "~%Boot Time:  ~25,0T~A ~
      ~%Shutdown Time:  ~25,0T~A "
     (Get-CREC-String-for-Boot-Time crec)
     (Get-Crec-String-for-Crash-Time crec))
  (Format stream "~%"))

(Defun Format-Register-Values (stream)
  "Writes CREC register values to STREAM."
  (format stream "~%Register Values: ~
                  ~%M-1: ~10,0T~A ~
                  ~%M-2: ~10,0T~A ~
                  ~%MD: ~10,0T~A ~
                  ~%VMA: ~10,0T~A"
	  M-1-Q M-2-Q MD-Q VMA-Q))

(Defun Report-Boot-CREC (stream)
  (Format stream "~&Shutdown Reason: ~25,0TSystem Boot"))

(Defun Report-Hardware-Halt (stream)
  (Format stream "~&Shutdown Reason: ~25,0THardware Halt"))

(Defun Report-Lisp-Halt (crec stream)
  (let ((code (Read-Crash-Rec-16B crec CRO-Halt-Addr)))
    (Format stream "~&Shutdown Reason: ~25,0TLisp Halt")
    (Format stream "~&Lisp Crash Code: ~25,0T~d." code)
    (Format stream "~%Lisp Crash Reason: ~25,0T~A"
	    (Describe-Lisp-Crash code)))
  (Format-register-values stream))

(Defun Report-Ucode-Crash (Crec stream)
  "Writes line describing CREC's Ucode Halt to STREAM.  Gets description from
crash table based on micro pc stored in crash record, or runs report function
stored on a symbol's property list."
  (Format stream "~&UPC Stack (top): ~25,0t")
  (Report-Ucode-PC (Read-Crash-Rec-16B crec CRO-Halt-Addr) stream)
  (Format stream "~&~25,0t")
  (Report-Ucode-PC (Read-Crash-Rec-16B crec CRO-UPCSTK-0) stream)
  (Format stream "~&~25,0t")
  (Report-Ucode-PC (Read-Crash-Rec-16B crec CRO-UPCSTK-1) stream)
  (Format stream "~&~25,0t")
  (Report-Ucode-PC (Read-Crash-Rec-16B crec CRO-UPCSTK-2) stream)
  (Format stream "~&~25,0t")
  (Report-Ucode-PC (Read-Crash-Rec-16B crec CRO-UPCSTK-3) stream)
  (Format stream "~&Shutdown Description:")
  (Format-Register-values stream))

(Defun Report-Ucode-PC (micro-pc stream)
  (Cond ((and (fboundp 'lam:assure-lam-symbols-loaded)
	      (fboundp 'lam:lam-find-closest-sym))
	 (lam:assure-lam-symbols-loaded)
	 (Let ((sym (lam:lam-find-closest-sym (+ micro-pc lam:racmo))))
	   (if (listp sym)
	       (Format stream "~a + #o~5,'0o" (car sym) (cadr sym))
	     (Format stream "~a" sym))))
	(t (Format stream "#o~5,'0o" micro-pc)))
  )


;;;
;;; Crash Record Analysis       
;;;

(Defun Assure-CREC-Vars-Set-Up ()
  "Make sure we've set up needed variables for crash analysis.
This should be redundant."
  (When (NULL CURRENT-CRASH-REC-OFFSET)		
       (Setup-NVRAM-Vars)
       (Setup-Crash-Rec-Vars)))

(Defun Retrieve-CREC-CTE (crec key)
  "Get CTE for ucode halt."
  (Let* ((ucode-version (Read-Crash-Rec-16B crec CRO-Ucode-Version))
	 (crash-table (Assure-Crash-Table-Loaded-for-Ucode ucode-version)))
    (cdr (Assq key crash-table))))

(Defun Describe-Lisp-Crash (code)
  "Gets descriptive text describing lisp crash code CODE."
  (if (= code 0)				;Right now we only have 0.  
      "Normal shutdown by SHUTDOWN"		;Put in hooks for more. -ab
      "Unknown Lisp Crash Code."))

(Defun Report-Crec (Crec stream)
  "Internal routine used to report CREC's crash information to STREAM."
  (Let ((halt-kind (Read-Crash-Rec crec CRO-Halt-Kind)))
	;; set these so they can be used in FORMAT or REPORT
    (setq M-1   (Read-Crash-Rec-32B crec CRO-M-1))
    (setq M-2   (Read-Crash-Rec-32B crec CRO-M-2))
    (setq MD    (Read-Crash-Rec-32B crec CRO-MD))
    (setq VMA   (Read-Crash-Rec-32B crec CRO-VMA))
    (setq M-1-Q (Get-Q-String-from-CREC crec CRO-M-1))
    (setq M-2-Q (Get-Q-String-from-CREC crec CRO-M-2))
    (setq MD-Q  (Get-Q-String-from-CREC crec CRO-MD))
    (setq VMA-Q (Get-Q-String-from-CREC crec CRO-VMA))
    (Format-Header-Information crec stream)
    (select halt-kind
      (CREC-System-Boot (Report-Boot-CREC stream))
      (CREC-Ucode-Halt (Report-Ucode-Crash crec stream))
      (CREC-Hardware-Halt (Report-Hardware-Halt stream))
      (CREC-Lisp-Halt (Report-Lisp-Halt crec stream)))))

(Defun Report-Crash-Record (crec &optional (stream terminal-io))
  "Reports CREC's crash information to STREAM if format is reasonable."
  (If (Crec-Allocated-P crec)
      (If (Crash-Record-Reasonable-P crec)
	  (Report-Crec crec stream)
	  (Report-Bad-Crec crec stream))))


;;; Called from print-herald to check if last shutdown was abnormal.
(Defun Check-for-Abnormal-Shutdown (&optional (stream terminal-io))
  "Call this funtion to see if the last system shutdown was abnormal.  If shutdown was
abnormal, it writes an informative message to STREAM.  Returns nothing."
  (Assure-CREC-Vars-Set-Up)
  (let ((crec (Crash-Rec-Find-Previous CURRENT-CRASH-REC-OFFSET)))
    (if (and (CREC-Format-Matches-P)
	     (Crash-Record-Reasonable-P crec)
	     (not (Normal-Shutdown-P crec)))
	(format stream "~%Last system shutdown was abnormal.  ~
                          To view crash record use (si:report-last-shutdown)~%"))
    (values)))


(Defun Report-Last-Shutdown (&key (stream terminal-io)
			     (pathname nil)
			     (abnormal-only nil))
  "Reports the results of analyzing the crash record from the previous boot.
  If ABNORMAL-ONLY is T, the crash record is only reported if it represents
a crash (versus a normal shutdown or boot).  ABNORMAL-ONLY defaults to NIL.
  If PATHNAME is non-nil, the crash record is written to the indicated file instead.
PATHNAME must be parsable into a pathname, and is opened in the append mode.
Crash records written to a file are marked internally as logged (see si:report-all-shutdowns).
  If PATHNAME is nil, the crash record analysis is written to the stream indicated
by the STREAM keyword.  STREAM defaults to terminal-io."
  (Assure-CREC-Vars-Set-Up)
  (cond ((not (NVRAM-functioning-p))		;Check if NVRAM good
	 (Format-Bad-NVRAM-Msg stream))
	((not (CREC-Format-Matches-P))		;and if format good
	 (Format-Bad-Crec-Rev stream))
        (t					
	 (let ((crec (Crash-Rec-Find-Previous CURRENT-CRASH-REC-OFFSET)))
	   (if pathname				;If pathname supplied, write analysis there
	       (with-open-file
		 (file-strm (fs:parse-pathname pathname)
			    :direction :output :if-does-not-exist :create :if-exists :append)
		 (Time-Stamp-Log file-strm)
		 (If abnormal-only
		     (if (not (Normal-Shutdown-P crec))
			 (Report-Crash-Record crec file-strm))
		     (Report-Crash-Record crec file-strm))
		 (Store-Crash-Rec-Field crec CRO-Report-Flags %%CREC-Recorded-in-Log 1))
	       (If abnormal-only		;Else write report to stream
		   (if (not (Normal-Shutdown-P crec))
		       (Report-Crash-Record crec stream))
		   (Report-Crash-Record crec stream))))))
  (values))

(Defun Report-All-Shutdowns (&key (stream terminal-io)
			     (pathname nil)
			     (abnormal-only nil)
			     (unlogged-only nil))
  "Reports the results of analyzing all currently recorded crash records..
  If ABNORMAL-ONLY is T, the crash record is only reported if it represents
a crash (versus a normal shutdown or boot).  ABNORMAL-ONLY defaults to NIL.
  Usually the analysis is written to the stream indicated by the STREAM keyword.
  If PATHNAME is non-nil, however, the crash record is written to the indicated
file instead.  PATHNAME must be parsable into a pathname, and is opened in the append mode.
  If PATHNAME is non-nil and UNLOGGED-ONLY is t, only records that have not previously
logged will be written to the log file.  (Crash records are marked internally as logged after
being written to a log file either by this function or by si:report-last-shutdown.)"
  (Assure-CREC-Vars-Set-Up)
  (cond ((not (NVRAM-functioning-p))		;Check if NVRAM good
	 (Format-Bad-NVRAM-Msg stream))
	((not (CREC-Format-Matches-P))		;and if format good
	 (Format-Bad-Crec-Rev stream))
	(t
	 (if pathname				;If pathname, write analysis there & mark as logged
	     (with-open-file
	       (file-strm (fs:parse-pathname pathname)
			  :direction :output :if-does-not-exist :create :if-exists :append)
	       (Time-Stamp-Log file-strm)
	       (Do ((crec (crash-rec-find-previous Current-crash-rec-offset)	;For each crec
			  (crash-rec-find-previous crec))
		    (n    (1- (Number-of-Crash-Records-in-Ring))	;Don't report this boot's record -ab
			  (1- n)))
		   ((zerop n))
		 (If unlogged-only
		     (if (not (Test-Crash-Rec-Bits crec CRO-Report-Flags %%CREC-Recorded-in-Log))
			 (If abnormal-only	
			     (if (not (Normal-Shutdown-P crec))
				 (Report-Crash-Record crec file-strm))
			     (Report-Crash-Record crec file-strm)))
		     (If abnormal-only	
			 (if (not (Normal-Shutdown-P crec))
			     (Report-Crash-Record crec file-strm))
			 (Report-Crash-Record crec file-strm)))
		 (Store-Crash-Rec-Field crec CRO-Report-Flags %%CREC-Recorded-in-Log 1)))
	     (Do ((crec (crash-rec-find-previous Current-crash-rec-offset)	;Else report each to STREAM
			(crash-rec-find-previous crec))
		  (n    (1- (Number-of-Crash-Records-in-Ring))	;Don't report this boot's record -ab
			(1- n)))
		 ((zerop n))
	       (If abnormal-only	
		   (if (not (Normal-Shutdown-P crec))
		       (Report-Crash-Record crec stream))
		   (Report-Crash-Record crec stream))
	       )))))				
		    
  

;;;
;;; Functions used for debugging
;;;

(Defun Dump-NVRAM-Contents ()
  "Dump all NVRAM locations.  For debugging."
  (if (NVRAM-functioning-p)
      (Do ((offset 0 (+ offset 32.)))
	   ((= offset #x2000) nil)
	   (format t "~&~16r -- ~16r  ~16r  ~16r  ~16r  ~16r  ~16r  ~16r  ~16r"
		   offset
		   (Read-NVRAM offset)
		   (Read-NVRAM (+ offset 4))
		   (Read-NVRAM (+ offset 8.))
		   (Read-NVRAM (+ offset 12.))
		   (Read-NVRAM (+ offset 16.))
		   (Read-NVRAM (+ offset 20.))
		   (Read-NVRAM (+ offset 24.))
		   (Read-NVRAM (+ offset 28.))))
      "Can't get to NVRAM"))

(Defun Dump-CREC-hex (crec)
  "Dump CREC's contents in hex.  For debugging"
  (if (NVRAM-functioning-p)
      (do ((offset crec (+ offset 32.)))
	  ((> offset (+ crec CRASH-REC-LEN 32.)) nil)
	(format t "~&~16r -- ~16r  ~16r  ~16r  ~16r  ~16r  ~16r  ~16r  ~16r"
		offset
		(Read-NVRAM offset)
		(Read-NVRAM (+ offset 4))
		(Read-NVRAM (+ offset 8.))
		(Read-NVRAM (+ offset 12.))
		(Read-NVRAM (+ offset 16.))
		(Read-NVRAM (+ offset 20.))
		(Read-NVRAM (+ offset 24.))
		(Read-NVRAM (+ offset 28.))))
      "Can't get to NVRAM"))

(Defun Read-NVRAM-Time ()
   "Displays current time as recorded in CREC.  For debugging."
  (format nil "~%Month ~d.  Day ~d.  Year ~d.  Hour ~d.  Minute ~d."
    (Read-Current-Crash-Rec CRO-CURRENT-MONTH)
    (Read-Current-Crash-Rec CRO-CURRENT-DAY  )
    (Read-Current-Crash-Rec CRO-CURRENT-YEAR )
    (Read-Current-Crash-Rec CRO-CURRENT-HOUR )
    (Read-Current-Crash-Rec CRO-CURRENT-MINUTE)
    ))
			   
(Defun Dump-Crec (crec &optional (stream terminal-io))
  "Dumps out crec in semi-human-readable form.  For debugging.  If
STREAM is a string, it is interpreted as a filename, and output goes there."
  (when (NVRAM-functioning-p)
    (with-open-stream (s (if (stringp stream)
			     (open (fs:parse-pathname stream)
				   :direction :output)
			     stream)) 
      (format s "~%CRASH RECORD #x~16r"        crec)
      (format s "~%Progress = ~d."            (Read-Crash-Rec     crec CRO-Progress))
      (format s "~%Controller = ~d."          (Read-Crash-Rec     crec CRO-Controller))
      (format s "~%Ucode unit = #x~16r"       (Read-Crash-Rec     crec CRO-Ucode-Unit))
      (format s "~%Load unit = #x~16r"        (Read-Crash-Rec     crec CRO-Load-Unit))
      (format s "~%Ucode partition = #x~16r"  (Read-Crash-Rec-32b crec CRO-Ucode-Part))
      (format s "~%Load partition = #x~16r"   (Read-Crash-Rec-32b crec CRO-Load-Part))
      (format s "~%Ucode version = ~d."       (Read-Crash-Rec-16b crec CRO-Ucode-version))
      (format s "~%Load version = ~d."        (Read-Crash-Rec-16b crec CRO-Load-version))
      (format s "~%Load revision = ~d."       (Read-Crash-Rec-16b crec CRO-Load-Revision))
      (format s "~%Boot month = ~d."          (Read-Crash-Rec     crec CRO-Boot-Month))
      (format s "~%Boot day = ~d."            (Read-Crash-Rec     crec CRO-Boot-Day))
      (format s "~%Boot year = ~d."           (Read-Crash-Rec     crec CRO-Boot-Year))
      (format s "~%Boot hour = ~d."           (Read-Crash-Rec     crec CRO-Boot-Hour))
      (format s "~%Boot minute = ~d."         (Read-Crash-Rec     crec CRO-Boot-Minute))
      (format s "~%Current month = ~d."       (Read-Crash-Rec     crec CRO-Current-Month))
      (format s "~%Current day = ~d."         (Read-Crash-Rec     crec CRO-Current-Day))
      (format s "~%Current year = ~d."        (Read-Crash-Rec     crec CRO-Current-Year))
      (format s "~%Current hour = ~d."        (Read-Crash-Rec     crec CRO-Current-Hour))
      (format s "~%Current minute = ~d."      (Read-Crash-Rec     crec CRO-Current-Minute))
      (format s "~%Report-flags = #x~16r"     (Read-Crash-Rec     crec CRO-Report-flags))
      (format s "~%Halt address = #x~16r"     (Read-Crash-Rec-16b crec CRO-Halt-Addr))
      (format s "~%Halt kind = ~d."           (Read-Crash-Rec     crec CRO-Halt-Kind))
      (format s "~%CRO-M-1 = #x~16r"          (Read-Crash-Rec-32b crec CRO-M-1))
      (format s "~%CRO-M-2 = #x~16r"          (Read-Crash-Rec-32b crec CRO-M-2))
      (format s "~%CRO-MD = #x~16r"           (Read-Crash-Rec-32b crec CRO-MD))
      (format s "~%CRO-VMA = #x~16r"          (Read-Crash-Rec-32b crec CRO-VMA))
      (format s "~%CRO-UPCSTK-0 = #x~16r"     (Read-Crash-Rec-16b crec CRO-UPCSTK-0))
      (format s "~%CRO-UPCSTK-1 = #x~16r"     (Read-Crash-Rec-16b crec CRO-UPCSTK-1))
      (format s "~%CRO-UPCSTK-2 = #x~16r"     (Read-Crash-Rec-16b crec CRO-UPCSTK-2))
      (format s "~%CRO-UPCSTK-3 = #x~16r"     (Read-Crash-Rec-16b crec CRO-UPCSTK-3))
      (format s "~%---------------------------------------"))))