LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031824. :SYSTEM-TYPE :LOGICAL :VERSION 8. :TYPE "LISP" :NAME "CRASH" :DIRECTORY ("REL3-SOURCE" "NVRAM") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758741148. :AUTHOR "REL3" :LENGTH-IN-BYTES 43885. :LENGTH-IN-BLOCKS 43. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ;;; -*- Mode:Common-Lisp; Package:SI; 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,1987 Texas Instruments Incorporated. All rights reserved.;;; This file contains the core functions for the crash analyzer.;;;   Report-Last-Shutdown writes analysis information from the last boot;;; session.  Report-All-Shutdowns does the same for all boot session ;;; information currently stored in the Crash Buffer in NVRAM.;;; Package dependencies: must be loaded into whatever package rest of NVRAM;;; system is in.  If that package is not SI, Load-Crash-Table should  be;;; changed.  Also, the :FORMAT-F (formatting function called by system;;; log processing) in Make-Crash-Record must be in SYSLOG package, as well;;; as the SYSLOG:LOG-ABNORMAL-SHUTDOWN function.;;; Syslog dependencies have been put into a separate file to be loaded;;; by the syslog defsystem.        Done 10-24-86 drp.;;; Edit History:;;; -------------;;; 3/85      sdk  Original (as CRASH-RECORD).;;; 5/85      ab     Moved NVRAM accessors to SETUP-NVRAM.  Changed;;;                format of info delivered to user.  Fixed some bugs,;;;                general re-structuring of code.;;; 9/85      ab     Renamed file CRASH.  Moved Crash-Record accessing;;;                functions and field-test macros to ACCESSORS file.;;;                Moved find-previous and find-next functions to INITS.;;;                Moved debug functions to ANALYSIS-FUNCTIONS.;;;                  Added support for creating keyword/value list;;;                containing crash record info for logging to system LOG.;;;                Added functions Log-Abnormal-Shutdown to be used to;;;                post abnormal crash to LOG, and FMT-Crash-Record;;;                which can be called by the syslog routines to format;;;                the system log information.;;;                  Created new crash record formatting routines.  Each;;;                one produces one item for the crash record display.;;;                The display is now driven by lists containing names;;;                of all formatting functions to run (see FMT-Crash-Record).;;;                  Changed most internal routines to use the keyword/value;;;                list data structure to retrieve information.  Data is;;;                first read from NVRAM into one of these structures, then;;;                that structure is a parameter for all routines needing;;;                the data.;;;                  Added more support for Lisp crash reporting. (%crash);;;                  Changed way register values are formatted.  Added new;;;                saved registers to list which drives formatting of the;;;                registers.;;;                  Added support for printing out FEF running at crash,;;;                if it can be found in current band.;;;                  Changed user-callable crash functions slightly;;;                (report-all-shutdowns and report-last-shutdown).  The;;;                PATHNAME keyword can now have the value :DEFAULT, in;;;                which case a default crash file name is used.  Also,;;;                no longer open in append mode.  Additionally, if;;;                STREAM argument is nil, these functions will return;;;                a string.;;;                  Use new field accessor macros.;;;                  Prefixed all non-NVRAM names with explicit pkg.;;; 10/11/85   ab    NVRAM patch 2-1.;;;                Change :DEFAULT pathname to SYS:CRASH;CRASH.LOG#>.;;;                Also change text string for computed PC.;;;                  NVRAM patch 2-3.;;;                  Fixed Normal-Lisp-Halt-p to look in right place for;;;                Lisp crash code.;;; 11/4/85    ab    NVRAM patch 2-7.  Changed default stream arguments;;;                on several functions to Standard-Output;;; 12/2/85    ab    NVRAM patch 2-8.  Fix fencepost error in date integrity ;;;                check in Record-Unreasonable.;;; 12/12/85   ab    NVRAM patch 2-9.  ;;;                  Minor change in formatting of date and time.;;;                  Changes to FMT-Running-FEF.  Warn if currently booted;;;                band isn't same as band in crash record.  Function info;;;                may not be valid (but probably is).;;; 03-31-86   ab    NVRAM patch Rel 2, 2-1.;;;                  Fix spurious warning about booted band not matching band;;;                in crash record.;;; 04-20-86   ab    NVRAM patch Rel 2, 2-3.;;;                  Make sure display header line doesn't wrap in MEDFONT.;;; 08-18-86   RJF   Added support for reporting warmboot events which the;;;                microcode will now record. Also required one qdev change.;;; 08-19-86   RJF   Added in capability to send crash report. User must define;;;                crash reporting function by setting *abnormal-shutdown-report-function* ;;;                with the function to use. Changed Report-all to take pathname as;;;                arg which is used to decide if user should be prompted for;;;                sending crash report.;;; 08-20-86   RJF   Changed error handling when crash record file not found.;;; 09-09-86   RJF   Fix so warmbooting no longer clears previously loaded crash;;;                tables.  Bug 2679.;;; 09-10-86   RJF   Added In Anna's fix to log crash records after warmboot.;;;                Bug 2346.;;; 10-28-86   pf    Changed ~a to ~s in FMT-Running-Fef.  Changed :CRASH file;;;                from CONTROL to ELROY.CRASH.;;; 11-04-86   ab    Moved some vars to NVRAM-DEFS.;;; 11-05-86   ab  Changed FMT-Running-Fef and FMT-Lisp-Object to be safe;;;                  in light of TGC.;;; 01-06-87   ab  Print PC within function in decimal.;;; 01-19-87   RJF Changed Load-Error-Table to use *processor-ucode-name-alist*. ;;; 01-29-87   RJF Changed Load-Error-Table to use *microcode-name-alist*. ;;; 02-12-87   ab  Change references to FEF to M-FEF because FEF is already a;;;                  symbol in SYS.  [SPR 2964];;; 02-20-87   ab  Fix FMT-RUNNING-FEF to use better criteria for judging whether;;;                  the booted environment is the same as the crash environment,;;;                  and display more information about why.  [SPR 3415];;; 03-23-87   ab  Fix REPORT-LAST-SHUTDOWN to return a string when :STREAM is NIL.;;;                  Change of 8-19-87 broke this.;;; 04-02-87   ab  Call records SHUTDOWN RECORDs.;;; 04-12-87   ab  Fix FMT-UNIT for SMD disks.;;; Package dependencies:;;; 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.;;;;;;;;; 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-FEF  "    "  "    "   "  M-FEF" "    "       "       "  -ab, 4/85;;;    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;;;    FEF-Q   "   "  "   "         "       " "    "     "  M-FEF -ab, 4/85;;;;;; 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.;;;;;; Microassembler Crash Table loading.;;;;; 8-20-86 RJF, Changed error handling when crash record file not found.;;(Defun Load-Crash-Table (Ucode-Version) ;; Returns crash table for version UCODE-VERSION of the microcode.  (With-Sys-Host-Accessible   (let* ((ucode-name (or (cdr (assoc microcode-type-code *microcode-name-alist*))(error "Unknown microcode-type-code: ~D." microcode-type-code)))          (Pathname            (send (send (fs:parse-pathname *Default-Crash-Table-Pathname*) :new-name ucode-name)  :new-type-and-version "crash" ucode-version)))   ;;;(Funcall (Fs:Parse-Pathname *Default-Crash-Table-Pathname*) :New-Type-And-Version   ;;;    "CRASH" Ucode-Version)));loading control.crash will set Microcode-Crash-Table ;var to be our crash table database.     (Catch-Error-Restart (Error "Continue display without Shutdown Description")(Do ()    ((Load Pathname :Package "SI" :If-Does-Not-Exist ()))  (Multiple-Value-Setq (Nil Pathname)    (Signal     (Make-Condition 'Fs:File-Not-Found "Crash record file ~s not found." Pathname)     :Proceed-Types :New-Pathname))))     (Setq Microcode-Crash-Tables   (Cons (Cons Microcode-Crash-Table-Version-Number Microcode-Crash-Table) Microcode-Crash-Tables))     Microcode-Crash-Table))) (Defun Assure-Crash-Table-Loaded-For-Ucode (Version) ;; Makes sure crash table database for version VERSION of the ucode is loaded.  (Let ((Table (Assoc Version Microcode-Crash-Tables :Test #'Eq)))    (If (Null Table)      (Load-Crash-Table Version)      (Cdr Table)))) ;;;;;; Crash Keyword/Value List functions;;;(Defvar Crec-Field-List (Butlast Crash-Rec-Offsets)   "List of symbols naming all crash record fields.")   ;; +++ Use MAPCAN below if format of list changes to plain list of keyword/value pairs.;; +++ (Then Get-Item macro defined in ACCESSORS needs to be changed also).;; Note: this function is ultimately driven by the QDEV si:CRASH-REC-OFFSETS template;; from which CREC-Field-List is derived.(Defun Make-Crash-Record (Crec)  (Let ((Kwd-List (Mapcar  #'(Lambda (Item)     ;; Must intern symbol in keyword package      (List (Intern (Symbol-Name Item) 'Keyword)    (Eval `(Read-Crash-Field ,Crec ,Item))))  Crec-Field-List)))    (Push (List :Format-F 'Fmt-Crash-Record) Kwd-List)    (Push (List :Crec-Address Crec) Kwd-List))) ;; Get-Item macro defined in ACCESSORS.(Defun Get-Crash-Record (Crec &Aux Keyword-List) ;; First check if it has already been created and put on All-Crash-Records  (Setq Keyword-List(Dolist (Kwd-List All-Crash-Records Nil)  (If (= Crec (Get-Item Kwd-List ':Crec-Address))    (Return Kwd-List))))  ;; If not on All-Crash-Records, create it and add to All-Crash-Records.  (When (Null Keyword-List)    (Setq Keyword-List (Make-Crash-Record Crec))    (Push Keyword-List All-Crash-Records))  Keyword-List) (Defun Clear-Crec-Vars (&Optional Warm-Boot-P) ;;9-9-86 RJF ;; Must be run before disk save to clear Crash Analysis junk out of ;; environment.  Should also be run before GC to free up some memory, ;; and must run after warm boot to make sure previous session reported ;; properly.  (Setq Current-Crash-Record ())  (Setq All-Crash-Records ())  (Unless Warm-Boot-P   ;;9-9-86 RJF    (Setq Microcode-Crash-Table ())    (Setq Microcode-Crash-Tables ()))) ;; Make sure analyzer Crash Record lists are cleared in environment before ;; disk-save.(Add-Initialization "Clear Crash Analyzer Variables" '(Clear-Crec-Vars) :Before-Cold) ;; Let go of some of our pointers before GC runs.(Add-Initialization "Clear Crash Analyzer Variables" '(Clear-Crec-Vars) :Full-Gc) ;; Need to reset on warm also so boot before warm boot is;; reported properly.(Add-Initialization "Clear Crash Analyzer Variables" '(Clear-Crec-Vars T) :Warm)                              ;;9-9-86 RJF;;;;;; FMT functions for various Crash Record fields;;;;;;;;; MISC(Defun Crec-Log-Print-Line (Stream)  (Format Stream  "~%--------------------------------------~----------------------------------------------------")) ;;;;;; CREC ADDRESS(Defun Fmt-Crec-Address (Record Stream)  (Format Stream "~&~a~&SHUTDOWN RECORD AT OFFSET #x+~16r~a" (Crec-Log-Print-Line ())  (Get-Item Record ':Crec-Address) (Crec-Log-Print-Line ()))) ;;;;;; LOAD/MICROLOAD BANDS(Defun Crec-Int-To-String (Int N-Chars)  ;; Make a string out of N-CHARS of bytes of INT, an integer  (Do ((Result (Make-Array N-Chars :Element-Type 'String-Char :Fill-Pointer N-Chars))       (Idx #o0 (1+ Idx))       (Field-Start #o0 (+ Field-Start #o10)))      ((>= Idx N-Chars)       Result)    (Setf (Aref Result Idx) (Ldb (Byte #o10 Field-Start) Int))))       ;; Fixed to work for SMD disks. 4-12-87 ab(Defun Fmt-Unit (Unit Stream)  ;; Returns descriptive string for UNIT (a physical disk unit).  (If (And (Numberp Unit) (plusp Unit))      (Let* ((Logical-Unit (Get-Logical-Unit Unit))     (Unit-Exists (Car (Member Logical-Unit (All-Disk-Units) :Test #'Eq)))     (Name-Now (If Unit-Exists   (Get-Pack-Name Logical-Unit)   ())))(if unit-exists    (If (Null Name-Now)(Format Stream "Unit ~d (not currently online)" Logical-Unit)(Format Stream "Unit ~d (currently called ~A)" Logical-Unit Name-Now))    (Format Stream "Physical unit #o~o (not currently online)" Unit)))      (Format Stream "Physical unit #o~o (not currently online)" Unit)))(Defun Fmt-System-Version (Record Stream) ;; Returns string for the LOD version/revision stored in RECORD (a crash record).  (Let ((Version (Get-Item Record ':Cro-Load-Version))(Revision (Get-Item Record ':Cro-Load-Revision)))    (If (And (= Version #o0) (= Revision #o0))     ;; If past the Record-Boot time step, then version shouldn't be zero.     ;; If before that step, it just hasn't been recorded.      (If (>= (Get-Item Record ':Cro-Progress) Crec-Progress-Time-Initialized)(Format Stream "~d.~d (invalid version)" Version Revision)(Format Stream "not recorded"))      (Format Stream "~d.~d" Version Revision)))) (Defun Fmt-Load-Info (Record Stream)  (Format Stream "~&~@?~a, Version ~a, on ~a" Crec-Fmt-A "Load Band:"  (Let ((Load (Get-Item Record ':Cro-Load-Part)));; If this field is zero in CREC, was default boot & boot;; didn't progress far enough for Record-Load-Unit to fix.    (If (= Load #o0)      "Name not recorded"      (Crec-Int-To-String Load #o4)))  (Fmt-System-Version Record ()) (Fmt-Unit (Get-Item Record ':Cro-Load-Unit) ()))) (Defun Fmt-Microload-Info (Record Stream)  (Format Stream "~&~@?~a, Version ~d., on ~a" Crec-Fmt-A "Microcode Band:"  (Crec-Int-To-String (Get-Item Record ':Cro-Ucode-Part) #o4)  (Get-Item Record ':Cro-Ucode-Version) (Fmt-Unit (Get-Item Record ':Cro-Ucode-Unit) ()))) ;;; 8-18-86 RJF - start change;;;;;; WARMBOOT INDICATION(Defun Fmt-Warmboot (Record Stream) ;; Return string indicating system was warmbooted.  (If (Eq #o1 (Ldb %%Crec-Warmboot-Flag (Get-Item Record ':Cro-Report-Flags)))    (Format Stream "~&~@?~a" Crec-Fmt-A "Boot Type:" "Warm Boot"))) ;;; 8-18-86 RJF - end change;;;;;; PROGRESS INTO BOOT(Defun Fmt-Progress (Record Stream) ;; Returns string describing Progress Code (using si:CREC-Progress-Decode list).  (Let* ((Progress (Get-Item Record ':Cro-Progress)) (Decode (Member Progress Crec-Progress-Decode :Test #'Eq)))    (Format Stream "~&~@?~a" Crec-Fmt-A "Progress Into Boot:"    (If (Null Decode)      (Format () "Progress code ~d. invalid" Progress)      (String-Capitalize-Words (String-Downcase (String (Cadr Decode))) () T))))) ;;;;;; BOOT/SHUTDOWN TIMES;; NVRAM patch 2-9, -ab;; Pad time display with zeros.(Defun Fmt-Boot-Time (Record Stream)  (Format Stream "~&~@?~a" Crec-Fmt-A "Boot Time:"  (If (< (Get-Item Record ':Cro-Progress) Crec-Progress-Time-Initialized)    "Boot time not recorded"    (Format () "~d/~2,'0d/~2,'0d  ~2d:~2,'0d" (Get-Item Record ':Cro-Boot-Month)    (Get-Item Record ':Cro-Boot-Day) (Get-Item Record ':Cro-Boot-Year)    (Get-Item Record ':Cro-Boot-Hour) (Get-Item Record ':Cro-Boot-Minute))))) (Defun Fmt-Shutdown-Time (Record Stream)  (Format Stream "~&~@?~a" Crec-Fmt-A "Shutdown Time:"  (If (< (Get-Item Record ':Cro-Progress) Crec-Progress-Time-Initialized)    "Shutdown time not recorded"    (Format () "~d/~2,'0d/~2,'0d  ~2d:~2,'0d" (Get-Item Record ':Cro-Current-Month)    (Get-Item Record ':Cro-Current-Day) (Get-Item Record ':Cro-Current-Year)    (Get-Item Record ':Cro-Current-Hour) (Get-Item Record ':Cro-Current-Minute))))) ;;;;;; SHUTDOWN REASON(Defun Fmt-Shutdown-Reason (Record Stream)  (Format Stream "~&~@?~a" Crec-Fmt-A "Shutdown Reason:"  (Select (Get-Item Record ':Cro-Halt-Kind) (Crec-System-Boot "System Boot")     (Crec-Ucode-Halt "Microcode Halt") (Crec-Hardware-Halt "Invalid Shutdown Type");Not used     (Crec-Lisp-Halt "Lisp Halt") (:Otherwise "Invalid Shutdown Type")))) ;;;;;; LISP SHUTDOWN DESCRIPTION(Defun Fmt-Lisp-Shutdown-Reason (Record Stream) ;; Crash code stored in Halt address field if %Crash was cause (Lisp halt)  (Let* ((Code (Get-Item Record ':Cro-Halt-Addr)) (Description (Second (Assoc Code Lisp-Crash-Code-Alist :Test #'Eq))))    (Format Stream "~&~@?~d.~&~@?~a" Crec-Fmt-A "Lisp Crash Code:" Code Crec-Fmt-A    "Lisp Halt Reason:"    (If (Null Description)      (Format () "No Lisp halt description found")      Description)))) ;;;;;; LISP OBJECT(Defun Crec-Get-Q-String (Num) ;; Returns string describing NUM as Lisp object and as a 32-bit number.  (Let* ((Cdr-Code (Ldb %%Q-Cdr-Code Num)) (Data-Type (Ldb %%Q-Data-Type Num)) (Low-Pointer (Ldb (Byte #o30 #o0) Num)) (Pointer  (If (Ldb-Test %%Q-Boxed-Sign-Bit Num)    (Logior 100000000 Low-Pointer)    Low-Pointer)))    (Format () "~11a   <~A #x+~16r~[~; CDR-ERROR~; CDR-NIL~; CDR-NEXT~]>"    (Format () "#x+~16r" Num) (Q-Data-Types Data-Type) Pointer Cdr-Code))) (Defun Fmt-Lisp-Object (Record Stream) ;; Display value of %crash's OBJECT.  If symbol and in current band, ;; also display its name. ;; %crash's OBJECT is stored in M-1 (Lisp halt)  (Let* ((Obj-Wd (Get-Item Record ':Cro-M-1)) (adr (Ldb %%Q-Pointer Obj-Wd)) (Reg (%Region-Number adr)) (Valid  (And Reg     (< adr(+ (convert-to-unsigned (region-origin reg))   (convert-to-unsigned (region-free-pointer reg)))))) (ptr (AND valid (convert-to-signed adr))) (Sym-P (AND ptr     (= (%P-LDB %%Q-Data-Type ptr) Dtp-Symbol-Header))) (sym (AND sym-p (%Make-Pointer Dtp-Symbol Ptr))))    (Format Stream "~&~@?~a" Crec-Fmt-A "Lisp Object:"    (If Sym-P     ;; If object was a symbol that exists in current band,     ;; display its name and package.      (Format () "The symbol ~s" Sym)      (Crec-Get-Q-String Obj-Wd))))) ;;;;;; UCODE HALT ADDRESS(Defun Fmt-Ucode-Halt-Address (Record Stream)  (Format Stream "~&~@?#x+~16r" Crec-Fmt-A "Ucode Halt Address:"  (Get-Item Record ':Cro-Halt-Addr))) ;;;;;; REGISTER VALUES;;; To add a regiser value to the ones formatted under "Regiser Values":;;; -- Make a defvar for it below.  Name should be the name you want printed.;;; -- Add to CREC-Register-List a list with register's variable name and;;;    its keyword-field name.;;; -- Of course the microcode must be set up to save off that register,;;;    and it must exist on the si:Crash-Rec-Offsets list (see QDEV).;; These hold 32-bit values: M-1, M-2, MD, VMA, M-FEF, M-T, LC, UPC-1 UPC-2;; This a-list must contain names of all above variables, each  paired with ;; its keyword field name.(Defvar Crec-Register-List   '((M-1 :Cro-M-1) (M-2 :Cro-M-2) (M-T :Cro-M-T) (Md :Cro-Md) (Vma :Cro-Vma) (Upc-1 :Cro-Upc-1)     (Upc-2 :Cro-Upc-2) (M-Fef :Cro-M-Fef) (Lc :Cro-Lc)));*a(Defun Fmt-Register-Values (Ignore Stream) ;; Registers variables should already be set up when this called.  (Format Stream "~&~@? ~{~&~a~}" Crec-Fmt-A "Register Values:"  (Mapcar   #'(Lambda (Lst)       (Format () "~&~5a~10a~a" "" (String-Append (Symbol-Name (First Lst)) ":")       (Crec-Get-Q-String (Symbol-Value (First Lst)))))   Crec-Register-List))) ;;;;;; UCODE SHUTDOWN DESCRIPTION(Defun Setup-Register-Vars (Record)  (Mapc #'(Lambda (Lst)    (Set (First Lst) (Get-Item Record (Second Lst))))Crec-Register-List)) (Defun Crec-Get-Cte (Record Key) ;; Get CTE for ucode halt.  (Let* ((Ucode-Version (Get-Item Record ':Cro-Ucode-Version)) ;; This will load crash table if not already loaded (Crash-Table (Assure-Crash-Table-Loaded-For-Ucode Ucode-Version)))    (Cdr (Assoc Key Crash-Table :Test #'Eq)))) (Defun Fmt-Shutdown-Description (Record 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.  (Setup-Register-Vars Record)  (Let* ((Micro-Pc (Get-Item Record ':Cro-Halt-Addr)) (Cte (Crec-Get-Cte Record Micro-Pc)) (Head (Car Cte)) (Args (Cdr Cte)))    (Format Stream "~&~@?~a" Crec-Fmt-A "Shutdown Description:"    (Cond      ((Null Head) "Halt description not found in Crash Table.")      ((Stringp Head)       (Apply #'Format () Head  ;; Evaluate format arguments      (Mapcar       #'(Lambda (El)  ;; If it's a list and function symbol doesn't  ;; have function definition, just return a string  ;; so that missing analyzer functions won't  ;; break us.   (If (Consp El)     (If (Fboundp (Car El))(Eval El)       "<Undefind Analyzer Function>")      (Eval El)))       Args)))      ((Symbolp Head)       (Let ((Fn (Get Head 'Report))) (If (Fboundp Fn)   (Apply Fn Args)   (Format () "Halt description not found in Crash Table."))))      (T (Format () "Bad Crash Table format.  Offending form: ~S." Cte)))))) ;;;;;; FUNCTION RUNNING AT CRASH(Defun Fmt-Running-Fef (Record Stream)  ;; Checks to see if M-FEF stored in crash record can be found (safely)  ;; in currently booted band.  If so, identifies it and instruction   ;; executing at crash.  (Let* ((Fef-Wd (Get-Item Record ':Cro-M-Fef)) (adr (Ldb %%Q-Pointer Fef-Wd)) (Reg (%Region-Number (Convert-To-Signed adr))) (Valid   (And Reg(< adr   (+ (Convert-To-Unsigned (Region-Origin Reg))      (Convert-To-Unsigned (Region-Free-Pointer Reg)))))) (ptr (AND valid (convert-to-signed adr))) (Fef-P (And ptr (= (%P-LDB %%q-data-type ptr) Dtp-Fef-Header))) (fef (AND fef-p (%MAKE-POINTER dtp-fef-pointer ptr)))  (Inst (AND fef-p (- (Get-Item Record ':Cro-Lc) (* #o2 adr) #o1))) (Inst-Valid (And Fef-P (< Inst (* #o2 (Structure-Total-Size Fef))))) system-unknown maj min (same-system   (progn (Multiple-Value-setq (Maj Min)    (Get-System-Version))  (SETQ system-unknown(OR (ZEROP (Get-Item Record ':Cro-Load-Version))    (NULL maj)))  (And Maj Min       (= Maj (Get-Item Record ':Cro-Load-Version))       (>= Min (Get-Item Record ':Cro-Load-Revision)))));may be warm boot after loading patches (Same-Band   (And     (String-Equal *Loaded-Band*   (Crec-Int-To-String (Get-Item Record ':Cro-Load-Part) #o4))     (= *Default-Disk-Unit* (Get-Logical-Unit (Get-Item Record ':Cro-Load-Unit))))))    (DECLARE (UNSPECIAL fef))    (Format Stream "~&~@?~:[Function not found in current system~;~S~]"    Crec-Fmt-A    "FEF Running at Crash:"    Fef-P    Fef)    (COND ((AND fef-p system-unknown (NOT same-band))   (Format Stream "~&~@?~a~&~@?~a" Crec-Fmt-A ""   (FORMAT nil "WARNING: Booted band (~a unit ~d) does not match crash record."    *Loaded-Band* *default-disk-unit*)   Crec-Fmt-A ""   "         Function information may not be valid."))  ((AND fef-p system-unknown)   (Format Stream "~&~@?~a~&~@?~a" Crec-Fmt-A ""   "WARNING: Unable to verify that booted system version matches"   Crec-Fmt-A ""   "         crash record.  Function information may not be valid."))  ((AND fef-p (NOT same-system))   (FORMAT stream "~&~@?~a~&~@?~a" Crec-Fmt-A ""   (FORMAT nil "WARNING: Current system version (~d.~d) does not match crash record."   maj min)   Crec-Fmt-A ""   "         Function information may not be valid.")))       (Format Stream "~&~@?~a" Crec-Fmt-A "PC Within Function:"    (If Inst-Valid(Format () "~d." Inst)"Invalid location counter value")))) ;;;;;; Main Crash Record formatting function;;;;;; The function FMT-Crash-Record is the main function called to display;;; the Crash Record information.  It uses the lists below to determine ;;; what functions to run to format specific fields.;; List of formatting functions for Ucode Halts only.(Defvar Ucode-Halt-Functions   '(Fmt-Ucode-Halt-Address Fmt-Shutdown-Description Fmt-Running-Fef Fmt-Register-Values)) ;; List of formatting functions for Lisp Halts only.(Defvar Lisp-Halt-Functions '(Fmt-Lisp-Shutdown-Reason Fmt-Lisp-Object)) ;; List of formatting functions for ALL shutdowns.(Defvar All-Shutdown-Functions   '(Fmt-Crec-Address Fmt-Load-Info Fmt-Microload-Info Fmt-Warmboot       ;;RJF 8-18-86      Fmt-Progress Fmt-Boot-Time Fmt-Shutdown-Time Fmt-Shutdown-Reason)) (Defun Fmt-Crash-Record (Record Stream)  (Let ((Fn-Caller (Function (Lambda (Fn)       (If (Fboundp Fn) (Funcall Fn Record Stream))))))    (Mapc Fn-Caller All-Shutdown-Functions)    (Select (Get-Item Record ':Cro-Halt-Kind)       (Crec-Lisp-Halt (Mapc Fn-Caller Lisp-Halt-Functions))       (Crec-Ucode-Halt (Mapc Fn-Caller Ucode-Halt-Functions)))    (Values))) ;;;;;; Analyzer support routines;;;;;;;;; MISC(Defun Number-Of-Crash-Records-In-Ring () ;; Returns total number of crash records in crash ring.  (Let ((Crec-Size (Read-Nvram-Field Nvram-Crash-Buff-Rec-Len))(Crec-Buf-Last (Read-Nvram-Field Nvram-Crash-Buff-Last))(Crec-Buf-First (Read-Nvram-Field Nvram-Crash-Buff-Base)));; last points before last record so add one    (1+ (Truncate (- Crec-Buf-Last Crec-Buf-First) Crec-Size)))) (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 ()))) ;;;;;; FIELD TEST/SET SUPPORT;; Macros referred to below defined in ACCESSORS(Defun Record-Logged (Crec)  (Test-Crash-Rec-Bits Crec Cro-Report-Flags %%Crec-Recorded-In-Log)) (Defun Mark-Record-Logged (Crec)  (Store-Crash-Rec-Field Crec Cro-Report-Flags %%Crec-Recorded-In-Log #o1)) (Defun Record-System-Logged (Crec) ;;9-10-86 RJF  (Test-Crash-Rec-Bits Crec Cro-Report-Flags %%Crec-Recorded-In-System-Log))       (Defun Mark-Record-System-Logged (Crec) ;;9-10-86 RJF  (Store-Crash-Rec-Field Crec Cro-Report-Flags %%Crec-Recorded-In-System-Log #o1)) ;;;;;; NVRAM CONSISTENCY CHECKS;;; NVRAM-Functioning-p can be found in NVRAM file; NVRAM-Initialized-p in;;; ACCESSORS. (Defun Crec-Format-Matches-P () ;; Returns t if crash record revision level in NVRAM matches Explorer revision ;; level we hack.  (And (= (Read-Nvram-Field Nvram-Crash-Buff-Format-Processor) Crash-Rec-Format-Processor-Type)     (= (Read-Nvram-Field Nvram-Crash-Buff-Format-Rev) Crash-Rec-Format-Version))) (Defun Ok-To-Report (Stream) ;; Checks for conditions that would not allow us to report crash info, and ;; gives warnings about these conditions to STREAM.  Value returned is T if ;; ok to report; else nil.  (Cond   ;; Can we touch NVRAM safely?   ((Not (Nvram-Functioning-P))    (Format Stream    "~%****** WARNING ****** ~                     ~%Cannot report crash record information because unable to verify ~                     ~%the proper functioning of NVRAM.  Have your NVRAM hardware examined.~%")    Nil)   ;; Is it set up (ie, Setup-NVRAM run)?   ((Not (Nvram-Initialized-P))    (Format Stream    "~%NVRAM has not been initialized.  Valid crash information cannot be ~                     ~%reported until NVRAM is properly initialized using (si:Setup-NVRAM).~%")    Nil)   ;; Does the format of NVRAM match what analyzer expects?   ((Not (Crec-Format-Matches-P))    (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 indicates that your NVRAM was initialized under outdated microcode. ~                     ~%Valid crash information cannot be reported until NVRAM is properly  ~                     ~%initialized using (si:Setup-NVRAM).~%"    (Read-Nvram-Field Nvram-Crash-Buff-Format-Rev)    (Read-Nvram-Field Nvram-Crash-Buff-Format-Processor) Crash-Rec-Format-Version    Crash-Rec-Format-Processor-Type)    Nil)   ;; Else ok to report   (T T))) ;;;;;; MISC PREDICATES;; NVRAM patch 2-3, -ab;; Crash code is stored in CRO-HALT-ADDR field, not M-1.(Defun Normal-Lisp-Halt-P (Record) ;; Returns t if Halt called from Lisp was normal (ie, through Shutdown function); else nil.  (= (Get-Item Record ':Cro-Halt-Addr) #o0)) (Defun Normal-Shutdown-P (Record) ;; Returns NIL if ucode halt or abnormal lisp halt, T if normal shutdown or reboot.  (If (= (Get-Item Record ':Cro-Halt-Kind) Crec-System-Boot)    T    (And (= (Get-Item Record ':Cro-Halt-Kind) Crec-Lisp-Halt) (Normal-Lisp-Halt-P Record)))) ;;;;;; CRASH RECORD CONSISTENCY CHECKS;;; These routines test consistency of a particular crash record before reporting it.(Defun Record-Allocated-P (Record) ;; Returns t if crash record progress field indicates that the crash record ;; was allocated; else returns nil.  (If (= (Get-Item Record ':Cro-Progress) Crec-Progress-Initial-Value)    ()    T)) ;; NVRAM patch 2-8, -ab;; Fix off-by-one month error.(Defun Record-Unreasonable (Record) ;; Test if crash record is garbage.  Returns reason as string if so.   ;; If record is ok, returns NIL.   (Let ((Prog (Get-Item       Record       ':Cro-Progress))(Slot (Get-Item Record ':Cro-Controller))(Month (Get-Item Record ':Cro-Boot-Month)))    (Cond      ((> Prog Crec-Progress-Max) (Format () "Invalid progress code: ~d." Prog))      ((> Slot #o17) (Format () "Invalid controller slot number: ~d." Slot))      ((> Month #o14) (Format () "Invalid time stamp; month = ~d." Month))      (T Nil)))) (Defun Report-Crash-Record (Record Stream) ;; Reports CREC's crash information to STREAM if format is reasonable.  (If (Record-Allocated-P Record)    (Let ((Unreasonable (Record-Unreasonable Record)))      (If Unreasonable(Progn  (Crec-Log-Print-Line Stream)  (Format Stream "~%Crash record at offset #x+~16r does not look reasonable:  ~a"  (Get-Item Record ':Crec-Address) Unreasonable))(Fmt-Crash-Record Record Stream)))))   ;;;;;; Externally called routines (from Print-Herald and Error Logger);;;;; NVRAM patch 2-7, -ab;; Change default stream arg to standard-output.;;; Called from print-herald to check if last shutdown was abnormal.(Defun Check-For-Abnormal-Shutdown (&Optional (Stream *Standard-Output*))  "Call this funtion to see if the last system shutdown was abnormal.  If shutdown wasabnormal, it writes an informative message to STREAM.  Returns nothing."  (When (And (Nvram-Accessible-P) (Nvram-Initialized-P) (Crec-Format-Matches-P))    (Let* ((Crec (Crash-Rec-Find-Previous Current-Crash-Rec-Offset))   (Record (Get-Crash-Record Crec)))      (If (And (Not (Record-Unreasonable Record)) (Not (Normal-Shutdown-P Record)))(Format Stream"~%Last system shutdown was abnormal.  ~                            To view crash record use (si:report-last-shutdown)~%"))      (Values)))) ;;;;;; Main analyzer functions;;;;; NVRAM Patch 2-1, -ab;; Change default name to use CRASH directory.(Defvar *Default-Crash-File-Pathname* "SYS: CRASH; CRASH.LOG#>") ;; 8-19-86 RJF;; This variable is set to the function (which accepts;; one arg (the CREC)) and  is used to report the crash.  If not;; defined, the crash is not reported. (Defvar *Abnormal-Shutdown-Report-Function* ())  ;; NVRAM patch 2-7, -ab;; Change default stream arg to standard-output.;;;; 8-19-86 RJF, Added check for defined crash reporting-function and;;              if defined, and abnormal shutdown, and not being sent to;;              a pathname user is prompted. (Defun Report-Last-Shutdown (&Key (Stream *Standard-Output*) (Pathname ()) (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 representsa 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 a file instead.    -- If PATHNAME is :DEFAULT, the default crash file pathname (the value of       si:*DEFAULT-CRASH-FILE-PATHNAME*) is used.      -- Otherwise PATHNAME must be parsable into a pathname, with        si:*DEFAULT-CRASH-FILE-PATHNAME* used as the default in the parsing.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 indicatedby the STREAM keyword.  STREAM defaults to *STANDARD-OUTPUT*.  If STREAM is NIL a string is returned."  (When (Ok-To-Report Stream)    (Let* ((Crec (Crash-Rec-Find-Previous Current-Crash-Rec-Offset))   (Record (Get-Crash-Record Crec))   string)   ;; First determine what kind of stream to use, then call Report-1.      (Cond(Pathname (If (Eq Pathname :Default)   (Setq Stream (Fs:Parse-Pathname *Default-Crash-File-Pathname*))   (Setq Stream (Merge-Pathnames Pathname *Default-Crash-File-Pathname*))) (With-Open-File (File-Strm Stream :Direction :Output :If-Does-Not-Exist :Create :If-Exists   :New-Version)   (Time-Stamp-Log File-Strm)   (Report-1 Record File-Strm Abnormal-Only T nil)))((Null Stream) (SETQ string       (With-Output-To-String (Strm) (Report-1 Record Strm Abnormal-Only nil nil))))(Stream (Report-1 Record Stream Abnormal-Only nil nil)))      (If (And (Not (Normal-Shutdown-P Record)) *Abnormal-Shutdown-Report-Function* (Not Pathname))(If (Y-Or-N-P "~%Do you wish to report this crash?")  (Funcall *Abnormal-Shutdown-Report-Function* Crec)))      string))) (Defun Report-1 (Record Stream Abnormal-Only Mark-As-Logged Unlogged-Only)  (If Unlogged-Only    (Unless (Record-Logged (Get-Item Record ':Crec-Address))      (If Abnormal-Only(If (Not (Normal-Shutdown-P Record))  (Report-Crash-Record Record Stream))(Report-Crash-Record Record Stream)))    (If Abnormal-Only      (If (Not (Normal-Shutdown-P Record))(Report-Crash-Record Record Stream))      (Report-Crash-Record Record Stream)))  (When Mark-As-Logged    (Mark-Record-Logged (Get-Item Record ':Crec-Address)))) ;; NVRAM patch 2-7, -ab;; Change default stream arg to standard-output.;;;; 8-19-86 RJF, Changed calls to report-all to pass pathname as a arg.(Defun Report-All-Shutdowns (&Key (Stream *Standard-Output*) (Pathname ()) (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 representsa 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 a file instead.    -- If PATHNAME is :DEFAULT, the default crash file pathname (the value of       si:*DEFAULT-CRASH-FILE-PATHNAME*) is used.      -- Otherwise PATHNAME must be parsable into a pathname, with        si:*DEFAULT-CRASH-FILE-PATHNAME* used as the default in the parsing.  If PATHNAME is non-nil and UNLOGGED-ONLY is t, only records that have not previouslybeen 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.)"  (When (Ok-To-Report Stream)   ;; First determine what kind of stream to use, then call Report-1.    (Cond      (Pathname       (If (Eq Pathname :Default) (Setq Stream (Fs:Parse-Pathname *Default-Crash-File-Pathname*)) (Setq Stream (Merge-Pathnames Pathname *Default-Crash-File-Pathname*)))       (With-Open-File (File-Strm Stream :Direction :Output :If-Does-Not-Exist :Create :If-Exists :New-Version) (Time-Stamp-Log File-Strm) (Report-All File-Strm Abnormal-Only T Unlogged-Only Pathname)))      ((Null Stream)       (With-Output-To-String (Strm) (Report-All Strm Abnormal-Only () () Pathname)))      (Stream (Report-All Stream Abnormal-Only () () Pathname)))))   ;; 8-19-86 RJF, Added check for defined crash reporting-function and;;              if defined, and abnormal shutdown, and not being sent to;;              a pathname user is prompted. Function now requires new;;              pathname as arg.(Defun Report-All (Stream Abnormal-Only Mark-As-Logged Unlogged-Only Pathname) ;; For each crec.  (Do* ((Crec (Crash-Rec-Find-Previous Current-Crash-Rec-Offset) (Crash-Rec-Find-Previous Crec))(Record (Get-Crash-Record Crec) (Get-Crash-Record Crec));; Don't report this boot's record (it is incomplete).(N (1- (Number-Of-Crash-Records-In-Ring)) (1- N)))       ((Zerop N))    (Report-1 Record Stream Abnormal-Only Mark-As-Logged Unlogged-Only)    (If (And (Not (Normal-Shutdown-P Record)) *Abnormal-Shutdown-Report-Function* (Not Pathname))      (If (Y-Or-N-P "~%Do you wish to report this crash?")(Funcall *Abnormal-Shutdown-Report-Function* Crec)))))   ;; 8-18-86  This is the crash reporting function.  This is not;;          defined in the released band.;(defun send-crash-report (crash-record-number);  "Mails a crash report containing the crash-record.";;  (if (not (get-site-option :host-for-bug-reports));      (ferror nil "Site Option host-for-bug-reports not defines"));  (let ((crash-report-address (string-append "crash";   #/@ (get-site-option :host-for-bug-reports)));(crash-description (make-array 100 :type 'art-string :fill-pointer 0));(system-description (system-version-info)));    ;    (LOOP WITH LINE-START = 0;  FOR START = 0 THEN (+ COMMA-POS 2);  AS PREV-COMMA-POS = NIL THEN COMMA-POS;  AS COMMA-POS = (STRING-SEARCH ", " System-description START);  WHEN (> (- (OR COMMA-POS (STRING-LENGTH System-description )) LINE-START) 72.);  UNLESS (NULL PREV-COMMA-POS);  DO (ASET #\CR System-description (1+ PREV-COMMA-POS));  (SETQ LINE-START (+ PREV-COMMA-POS 2));  (SETQ COMMA-POS PREV-COMMA-POS);  UNTIL (NULL COMMA-POS));    ;    (with-output-to-string (crash-description-stream crash-description);      (report-1 (get-crash-record crash-record-number) crash-description-stream  nil nil nil));    ;    (cond ((eq *terminal-io* tv:cold-load-stream);   ;; If windows are losing, don't try switching windows.;   ;   (format t "~&Please type a precise, detailed description of what you were doing before the crash.");   ;   (zwei:send-message-string crash-report-address;     (string-append (zwei:qsend-get-message);    #/return system-description;    #/return crash-description);     :try-mail-now t));  (t;   (let ((sheet (zwei:find-or-create-idle-zmacs-window)); (buffer (make-instance 'zwei:zmacs-buffer :name;(loop for i from 1;      as bufnam = (format nil "~A(~D)" crash-report-address i);      unless (zwei:find-buffer-named bufnam);      return bufnam))));     ;     (send sheet  :force-kbd-input `(:execute ,#'(lambda ();   (setf (zwei:buffer-saved-major-mode buffer) 'zwei:text-mode);   (send buffer :select) ;   (zwei:turn-on-mode 'zwei:mail-mode))));     ;     (format t "~&Mail a crash report.   Entering the editor...");     (zwei:insert-moving (zwei:buffer-point buffer) "To: ");     (zwei:insert-moving (zwei:buffer-point buffer) crash-report-address);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) "Subject: system crash ");     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer);                       (string-append "Currently running band ";                                      *loaded-band*;                                      " (may not be same as crash):"));     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) system-description);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer);                       "Please type a precise, detailed description of what you were doing before the crash.");     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     ;     ;; Save place for cursor.;     (zwei:move-bp (zwei:buffer-mark buffer) (zwei:buffer-point buffer));     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     (zwei:insert-moving (zwei:buffer-point buffer) crash-description);     (zwei:insert-moving (zwei:buffer-point buffer) #/return);     ;     ;; Place cursor;     (zwei:move-bp (zwei:buffer-point buffer) (zwei:buffer-mark buffer))      ;     ;     (send sheet :select))))));;(setq *ABNORMAL-SHUTDOWN-REPORT-FUNCTION* #'send-crash-report)level-ns-object :host-object)       (setf (name:object-get-property top-level-ns-object :host-object)     (find-old-host-object      