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

;;;                           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-RECORD-OFFSET nil
  "Offset into NVRAM of current (for this boot) crash record.")

(Defun Initialize-Crash-Record-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-BUFFER-POINTER)))
	(Setq CURRENT-CRASH-RECORD-OFFSET (Find-Previous-Crash-Record next-crec))))))

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

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

(Defun Read-Current-Crash-Record (offset)
  "Read byte at location OFFSET in current crash record."
  (Read-NVRAM (+ offset CURRENT-CRASH-RECORD-OFFSET)))

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

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

(Defun Write-Current-Crash-Record-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-RECORD-OFFSET) value))

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


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

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

(DefSetf Read-Crash-Record Write-Crash-Record)

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

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

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

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

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

(Defun Find-Previous-Crash-Record (crash-record-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-BUFFER-RECORD-LENGTH))
	 (crec-buffer-base (Read-NVRAM-16B NVRAM-CRASH-BUFFER-BASE))
	 (trial-prev (- crash-record-pointer crec-size)))
    (If (>= trial-prev crec-buffer-base)
	trial-prev
      (Read-NVRAM-16B NVRAM-CRASH-BUFFER-LAST))
    ))
						
(Defun Find-Next-Crash-Record (crash-record-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-BUFFER-RECORD-LENGTH))
	 (crec-buffer-last (Read-NVRAM-16B NVRAM-CRASH-BUFFER-LAST))
	 (trial-next (+ crash-record-pointer crec-size)))
    (If (<= trial-next crec-buffer-last)
	trial-next
      (Read-NVRAM-16B NVRAM-CRASH-BUFFER-BASE))
    ))

(Defun Number-of-Crash-Records-in-Ring ()
  "Returns total number of crash records in crash ring."
  (Let ((crec-size (Read-NVRAM-16B NVRAM-CRASH-BUFFER-RECORD-LENGTH))
	(crec-buffer-last (Read-NVRAM-16B NVRAM-CRASH-BUFFER-LAST))
	(crec-buffer-first (Read-NVRAM-16B NVRAM-CRASH-BUFFER-BASE)))
    ;; last points before last record so add one
    (1+ (truncate (- crec-buffer-last crec-buffer-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 (Find-Next-Crash-Record current-crec)
	     (Find-Next-Crash-Record 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-Record 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))

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

(Defun Get-CREC-String-For-MCR (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-Record crec CRO-Load-Unit)))

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

(Defun Get-CREC-String-For-Load-Version (crec)
  "Returns string for CREC's load band version/revision."
  (Let  ((version  (Read-Crash-Record-16B crec CRO-Load-Version))
	 (revision (Read-Crash-Record-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-MCR-Version (crec)
  "Returns string for MCR version."
  (Let ((version (Read-Crash-Record-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-Record 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-Record crec CRO-PROGRESS) CREC-PROGRESS-TIME-INITIALIZED)
      "Boot time not recorded"
      (Format nil "~d//~d//~2d ~2d:~2d"
	      (Read-Crash-Record crec CRO-BOOT-MONTH)
	      (Read-Crash-Record crec CRO-BOOT-DAY)
	      (Read-Crash-Record crec CRO-BOOT-YEAR)
	      (Read-Crash-Record crec CRO-BOOT-HOUR)
	      (Read-Crash-Record crec CRO-BOOT-MINUTE))
      ))

(Defun Get-CREC-String-For-Shutdown-Time (crec)
  "Returns string for crash time."
  (if (< (Read-Crash-Record crec CRO-PROGRESS) CREC-PROGRESS-TIME-INITIALIZED)
      "Shutdown time not recorded"
      (Format nil "~d//~d//~2d ~2d:~2d"
	      (Read-Crash-Record crec CRO-CURRENT-MONTH)
	      (Read-Crash-Record crec CRO-CURRENT-DAY)
	      (Read-Crash-Record crec CRO-CURRENT-YEAR)
	      (Read-Crash-Record crec CRO-CURRENT-HOUR)
	      (Read-Crash-Record 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-Record crec (+ offset 12.)))
	 (cdr-code (Ldb 0602 high-byte))
	 (data-type (Ldb 0105 high-byte))
	 (low-pointer (Dpb (Read-Crash-Record crec (+ offset 8.))
			   2010
			   (Dpb (Read-Crash-Record crec (+ offset 4.))
				1010
				(Read-Crash-Record 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 #o~O~[~; CDR-ERROR~; CDR-NIL~; CDR-NEXT~]> (#o~O)"
	    (Q-Data-Types data-type) pointer cdr-code whole)))

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

(Defmacro Test-Crash-Record-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-Record ,crec ,offset)))

(Defmacro Store-Crash-Record-Field (crec offset ppss value)
  "Deposits VALUE into field PPSS of the 8 bits of a crash record
   CREC at OFFSET."
  `(Write-Crash-Record ,crec ,offset
		    (DPB ,value ,ppss (Read-Crash-Record ,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-Record 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-Record crec CRO-PROGRESS) CREC-PROGRESS-MAX)
       (<= (Read-Crash-Record crec CRO-CONTROLLER) 15.)
       (<= (Read-Crash-Record crec CRO-BOOT-MONTH) 12.)))

(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-BUFFER-FORMAT-PROCESSOR)
	  CRASH-RECORD-FORMAT-PROCESSOR-TYPE)
       (= (Read-NVRAM NVRAM-CRASH-BUFFER-FORMAT-REV)
	  CRASH-RECORD-FORMAT-VERSION)))

(Defun Normal-Lisp-Halt-P (crec)
  "Returns t if Halt called from Lisp was normal (shutdown, disk save, etc)"
  (Let ((code (Read-Crash-Record-16B crec CRO-M-1)))
    (= code 0)))

(Defun Normal-Shutdown-P (crec)
  "Returns NIL if crash, T if normal shutdown or reboot."
  (If (= (Read-Crash-Record crec CRO-HALT-KIND) CREC-SYSTEM-BOOT)
      t
      (And (= (Read-Crash-Record crec CRO-HALT-KIND)
	      CREC-LISP-HALT)
	   (Normal-Lisp-Halt-P crec)
	   )))

;;;
;;; Formatting stuff.
;;;

(Defun Time-Stamp-Log (stream)
  "Writes time and date to stream where crash record written"
  (Format stream "~2%")
  (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:initialize-nvram).~%"
	  (Read-NVRAM NVRAM-CRASH-BUFFER-FORMAT-REV)
	  (Read-NVRAM-16B NVRAM-CRASH-BUFFER-FORMAT-PROCESSOR)
	  CRASH-RECORD-FORMAT-VERSION
	  CRASH-RECORD-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"
  (Format stream
	  "~2&Crash record at offset #o~O does not look reasonable." crec))

(Defun Show-Version-Information (crec stream)
  "Prints Load Band and MCR Band version information."
  (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-MCR crec)
     (Get-CREC-String-For-MCR-Version crec)
     (Get-CREC-String-For-MCR-Unit crec)))

(Defun Show-Time-Frame-Information (crec stream)
  "Prints the boot time and shutdown time."
  (Format stream
     "~%Boot Time:  ~25,0T~A ~
		  ~%Shutdown Time:  ~25,0T~A "
     (Get-CREC-String-For-Boot-Time crec)
     (Get-CREC-String-For-Shutdown-Time crec))
  (Format stream "~%"))

(Defun Show-Register-Values (crec stream)
  "Writes CREC register values to STREAM."
  (Let ((M-1-Q (Get-Q-String-From-CREC crec CRO-M-1))
	(M-2-Q (Get-Q-String-From-CREC crec CRO-M-2))
	(MD-Q  (Get-Q-String-From-CREC crec CRO-MD))
	(VMA-Q (Get-Q-String-From-CREC crec CRO-VMA)))
    (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 (crec stream)
  (Format stream "~2&Shutdown Reason: ~25,0TSystem Boot")
  (Show-Version-Information crec stream)
  (Show-Time-Frame-Information crec stream))

(Defun Report-Hardware-Halt (crec stream)
  (Format stream "~2&Shutdown Reason: ~25,0THardware Halt")
  (Show-Version-Information crec stream)
  (Show-Time-Frame-Information crec stream))

(Defun Report-Lisp-Halt (crec stream debugging-info)
  (Let ((code (Read-Crash-Record-16B crec CRO-Halt-Addr)))
    (Format stream "~2&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)))
  (Show-Version-Information crec stream)
  (Show-Time-Frame-Information crec stream)
;  (When debugging-info
;    (Show-Register-Values crec stream))
  )

(Defun Report-Ucode-Crash (crec stream debugging-info)
  (Format stream "~2&Shutdown Reason: ~25,0t~a"
	  (Describe-Ucode-Crash crec))
  (Show-Version-Information crec stream)
  (Show-Time-Frame-Information crec stream)
  (When debugging-info
    (Format stream "~&Crash Debugging Information:")
    (Format stream "~&UPC Stack (top): ~25,0t")
    (Report-Ucode-PC (Read-Crash-Record-16B crec CRO-HALT-ADDR) stream)
    (Format stream "~&~25,0t")
    (Report-Ucode-PC (Read-Crash-Record-16B crec CRO-UPCSTK-0) stream)
    (Format stream "~&~25,0t")
    (Report-Ucode-PC (Read-Crash-Record-16B crec CRO-UPCSTK-1) stream)
    (Format stream "~&~25,0t")
    (Report-Ucode-PC (Read-Crash-Record-16B crec CRO-UPCSTK-2) stream)
    (Format stream "~&~25,0t")
    (Report-Ucode-PC (Read-Crash-Record-16B crec CRO-UPCSTK-3) stream)
    (Show-Register-Values crec 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-Initialized ()
  "Make sure that the variables needed for crash analysis are initialized.
This should be redundant."
  (When (Null CURRENT-CRASH-RECORD-OFFSET)		
       (Initialize-NVRAM-Vars)
       (Initialize-Crash-Record-Vars)))

(Defun Describe-Lisp-Crash (code)
  "Gets text describing the lisp crash code CODE."
  (If (= code 0)				;Right now we only have 0.  
      "Normal shutdown by SHUTDOWN"
      "Unknown Lisp Crash Code."))

(Defun Describe-Ucode-Crash (crec)
  "Gets the text string from the microcode error table describing the crash
cause.  This string is found using the halt address in the CREC."
  (Eh:Assure-Table-Loaded)
  (Let* ((error-table-entry (Cdr (Assq (1- (Read-Crash-Record-16B crec CRO-HALT-ADDR))
				       EH:ERROR-TABLE)))
	 (crash-description (Cadr error-table-entry)))
    (Cond ((Or (Null error-table-entry)
	       (Neq (car error-table-entry) 'EH:CRASH))
	   "Crash description not found in error table")
	  ((Stringp crash-description) crash-description)
	  (t (Format nil "Bad crash description")))))
  
(Defun Report-Crec (Crec stream debugging-info)
  "Internal routine used to report CREC's crash information to STREAM."
  (Let ((halt-kind (Read-Crash-Record crec CRO-HALT-KIND)))
	;; set these so they can be used in FORMAT or REPORT
    (Select halt-kind
      (CREC-SYSTEM-BOOT (Report-Boot-CREC crec stream))
      (CREC-UCODE-HALT (Report-Ucode-Crash crec stream debugging-info))
      (CREC-HARDWARE-HALT (Report-Hardware-Halt crec stream))
      (CREC-LISP-HALT (Report-Lisp-Halt crec stream debugging-info)))))

(Defun Report-Crash-Record (crec stream debugging-info)
  "Reports CREC's crash information to STREAM if the format is reasonable."
  (If (Crec-Allocated-P crec)
      (If (Crash-Record-Reasonable-P crec)
	  (Report-Crec crec stream debugging-info)
	  (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))
  "Determines whether or not the last system shutdown was abnormal.  If it was,
a message is written to STREAM.  Returns nothing."
  (Assure-CREC-Vars-Initialized)
  (Let ((crec (Find-Previous-Crash-Record CURRENT-CRASH-RECORD-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 determine shutdown reason, execute (Si:Show-Shutdown-Reason)~%"))
    (Values)))


(Defun Show-Shutdown-Reason (&key (stream terminal-io)
			     (pathname nil)
			     (abnormal-only nil)
			     (debugging-info nil))
  "Shows the reason for the system shutdown preceding the current session.
  If ABNORMAL-ONLY is T, the shutdown reason 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 shutdown reason is written to the indicated file.
The file specified by PATHNAME is opened in the append mode.  The crash record
associated with the shutdown will be marked internally as logged.
  If PATHNAME is nil, the shutdown reason is written to the stream indicated
by the STREAM keyword.  STREAM defaults to Terminal-IO.
  If DEBUGGING-INFO is non-nil, any debugging information available for the shutdown
is displayed."
  (Assure-CREC-Vars-Initialized)
  (Cond ((Not (NVRAM-Functioning-P))
	 (Format-Bad-NVRAM-Msg stream))
	((Not (CREC-Format-Matches-P))
	 (Format-Bad-Crec-Rev stream))
        (t					
	 (Let ((Crec (Find-Previous-Crash-Record CURRENT-CRASH-RECORD-OFFSET)))
	   (If pathname
	       (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
		     (When (Not (Normal-Shutdown-P crec))
		       (Report-Crash-Record crec file-strm debugging-info))
		   (Report-Crash-Record crec file-strm debugging-info))
		 (Store-Crash-Record-Field crec
					   CRO-REPORT-FLAGS
					   %%CREC-RECORDED-IN-LOG 1))
	       (If abnormal-only
		   (When (Not (Normal-Shutdown-P crec))
		     (Report-Crash-Record crec stream debugging-info))
		 (Report-Crash-Record crec stream debugging-info))))))
  (Values))

(Defun Show-All-Recorded-Shutdowns (&key (stream terminal-io)
			     (pathname nil)
			     (abnormal-only nil)
			     (unlogged-only nil)
			     (debugging-info nil))
  "Shows the reason for each recorded shutdown.
  If ABNORMAL-ONLY is T, the shutdown reason 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 shutdown reason is written to the indicated
file.  The file specified by PATHNAME is opened in the append mode.  
  If PATHNAME is non-nil and UNLOGGED-ONLY is t, only shutdown reasons associated
with crash records that have not previously been logged will be written to the file.
Crash records are marked internally as logged after the shutdown reason is displayed.
  If DEBUGGING-INFO is non-nil, any debugging information available for the shutdown
is displayed."
  (Assure-CREC-Vars-Initialized)
  (Cond ((Not (NVRAM-functioning-p))
	 (Format-Bad-NVRAM-Msg stream))
	((Not (CREC-Format-Matches-P))
	 (Format-Bad-Crec-Rev stream))
	(t
	 (If pathname
	     (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 (Find-Previous-Crash-Record CURRENT-CRASH-RECORD-OFFSET)
			  (Find-Previous-Crash-Record crec))
		    (n    (1- (Number-of-Crash-Records-in-Ring))
			  (1- n)))
		   ((zerop n))
		 (If unlogged-only
		     (If (Not (Test-Crash-Record-Bits crec 
						      CRO-REPORT-FLAGS 
						      %%CREC-RECORDED-IN-LOG))
			 (If abnormal-only	
			     (If (Not (Normal-Shutdown-P crec))
				 (Report-Crash-Record crec file-strm debugging-info))
			     (Report-Crash-Record crec file-strm debugging-info)))
		     (If abnormal-only	
			 (If (Not (Normal-Shutdown-P crec))
			     (Report-Crash-Record crec file-strm debugging-info))
			 (Report-Crash-Record crec file-strm debugging-info)))
		 (Store-Crash-Record-Field crec 
					   CRO-REPORT-FLAGS 
					   %%CREC-RECORDED-IN-LOG 1)))
	     (Do ((crec (Find-Previous-Crash-Record CURRENT-CRASH-RECORD-OFFSET)
			(Find-Previous-Crash-Record crec))
		  (n    (1- (Number-of-Crash-Records-in-Ring))
			(1- n)))
		 ((zerop n))
	       (If abnormal-only	
		   (If (Not (Normal-Shutdown-P crec))
		       (Report-Crash-Record crec stream debugging-info))
		   (Report-Crash-Record crec stream debugging-info))
	       ))))
  (values))				
		    
  

;;;
;;; 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-RECORD-LENGTH 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-Record CRO-CURRENT-MONTH)
    (Read-Current-Crash-Record CRO-CURRENT-DAY  )
    (Read-Current-Crash-Record CRO-CURRENT-YEAR )
    (Read-Current-Crash-Record CRO-CURRENT-HOUR )
    (Read-Current-Crash-Record 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-Record     crec CRO-PROGRESS))
      (Format s "~%Controller = ~d."          (Read-Crash-Record     crec CRO-CONTROLLER))
      (Format s "~%Ucode unit = #x~16r"       (Read-Crash-Record     crec CRO-UCODE-UNIT))
      (Format s "~%Load unit = #x~16r"        (Read-Crash-Record     crec CRO-LOAD-UNIT))
      (Format s "~%Ucode partition = #x~16r"  (Read-Crash-Record-32b crec CRO-UCODE-PART))
      (Format s "~%Load partition = #x~16r"   (Read-Crash-Record-32b crec CRO-LOAD-PART))
      (Format s "~%Ucode version = ~d."       (Read-Crash-Record-16b crec CRO-UCODE-VERSION))
      (Format s "~%Load version = ~d."        (Read-Crash-Record-16b crec CRO-LOAD-VERSION))
      (Format s "~%Load revision = ~d."       (Read-Crash-Record-16b crec CRO-LOAD-REVISION))
      (Format s "~%Boot month = ~d."          (Read-Crash-Record     crec CRO-BOOT-MONTH))
      (Format s "~%Boot day = ~d."            (Read-Crash-Record     crec CRO-BOOT-DAY))
      (Format s "~%Boot year = ~d."           (Read-Crash-Record     crec CRO-BOOT-YEAR))
      (Format s "~%Boot hour = ~d."           (Read-Crash-Record     crec CRO-BOOT-HOUR))
      (Format s "~%Boot minute = ~d."         (Read-Crash-Record     crec CRO-BOOT-MINUTE))
      (Format s "~%Current month = ~d."       (Read-Crash-Record     crec CRO-CURRENT-MONTH))
      (Format s "~%Current day = ~d."         (Read-Crash-Record     crec CRO-CURRENT-DAY))
      (Format s "~%Current year = ~d."        (Read-Crash-Record     crec CRO-CURRENT-YEAR))
      (Format s "~%Current hour = ~d."        (Read-Crash-Record     crec CRO-CURRENT-HOUR))
      (Format s "~%Current minute = ~d."      (Read-Crash-Record     crec CRO-CURRENT-MINUTE))
      (Format s "~%Report-flags = #x~16r"     (Read-Crash-Record     crec CRO-REPORT-FLAGS))
      (Format s "~%Halt address = #x~16r"     (Read-Crash-Record-16b crec CRO-HALT-ADDR))
      (Format s "~%Halt kind = ~d."           (Read-Crash-Record     crec CRO-HALT-KIND))
      (Format s "~%CRO-M-1 = #x~16r"          (Read-Crash-Record-32b crec CRO-M-1))
      (Format s "~%CRO-M-2 = #x~16r"          (Read-Crash-Record-32b crec CRO-M-2))
      (Format s "~%CRO-MD = #x~16r"           (Read-Crash-Record-32b crec CRO-MD))
      (Format s "~%CRO-VMA = #x~16r"          (Read-Crash-Record-32b crec CRO-VMA))
      (Format s "~%CRO-UPCSTK-0 = #x~16r"     (Read-Crash-Record-16b crec CRO-UPCSTK-0))
      (Format s "~%CRO-UPCSTK-1 = #x~16r"     (Read-Crash-Record-16b crec CRO-UPCSTK-1))
      (Format s "~%CRO-UPCSTK-2 = #x~16r"     (Read-Crash-Record-16b crec CRO-UPCSTK-2))
      (Format s "~%CRO-UPCSTK-3 = #x~16r"     (Read-Crash-Record-16b crec CRO-UPCSTK-3))
      (Format s "~%---------------------------------------"))))