;;; -*- 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 (c)(1)(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- 1989 Texas Instruments Incorporated. All rights reserved.

;;;
;;; This file contains low-level NVRAM and Crash-Record Accessor functions
;;; and macros.  The templates describing the format of NVRAM and the Crash
;;; area of NVRAM can be found in SYS:COLD-BAND;QDEV
;;;

;;; Package dependencies: must be loaded into whatever package rest of NVRAM
;;; system is in, but beyond that should work.  (All names defined outside
;;; NVRAM system should carry explicit package prefix).

;;; Edit History:
;;; -------------
;;; 3/85      sdk  Original (part of CRASH-RECORD)
;;; 5/85      ab   Minor cleanup, documentation.  Put NVRAM functions in SETUP-NVRAM
;;; 9/85      ab     Broke out NVRAM & Crash record functions into ACCESSORS file.
;;;                  Added Field accessor macros & related support.
;;;                  Put all macros from CRASH-RECORD here.
;;;                  Prefixed all non-NVRAM names with explicit pkg.
;;; 08-04-87  ab   Added TYPED-BLOCK accessors. [SPR 5119]
;;; 01.12.88 MBC   Make conditional based on Resource-Present-P and :NVRAM.
;;;		   	Some defsubst changed to defuns... Write-Nvram, Read-Nvram.
;;;		Two defmacros put back to SYS4 versions: Read-Nvram-Field & Write-Nvram-Field.



;;;
;;; NVRAM Variables.
;;;

;;; Initialized in Setup-NVRAM-Vars, run during warm inits.

(Defvar Nvram-Slot #o0 "Slot address of board containing NVRAM") 

(Defvar Nvram-Slot-Offset #o0 "Offset into board memory of start of NVRAM") 

(DEFVAR nvram-error nil)

;;
;; Additions for MX

(proclaim '(special ADDIN:*CREC-ACB*))

;;clm 6/16/88 - these were moved to this file from NVRAM-DEFS.  read-crec-acb
;;is used in this file but was being defined in NVRAM-DEFS which comes
;;after this file in the make-system

(DEFPARAMETER crec-channel si:%Chan-Type-Misc-Addin)
(DEFVAR read-crec-acb nil)



;;;
;;; NVRAM Reading, Writing routines.
;;;

;;; offset above #x100 indicates another crash record, keep track of the current one and
;;; read in a new one if needed.

(PROCLAIM '(notinline read-nvram write-nvram))

(Defun (:COND (NOT (resource-present-p :NVRAM)) Read-Nvram) (Offset)
  "Read byte of NVRAM at address OFFSET from start of NVRAM."
;  (format t "~&read offset #x~x~%" offset)
  (setf offset (logand #xff offset))
  (if (or (not (boundp 'read-crec-acb )) (not read-crec-acb))
      (progn
	(setq nvram-error (format nil "~&Read-Nvram offset invalid or read-crec-acb not initialized: #x~x~%" Offset))
	0)
    (add:parm-8b read-crec-acb (FLOOR offset 4.))))

(Defun (:COND (resource-present-p :NVRAM) Read-Nvram) (Offset)
  "Read byte of NVRAM at address OFFSET from start of NVRAM."
  (%Nubus-Read-8b Nvram-Slot (+ Nvram-Slot-Offset Offset)))



(Defun (:COND (NOT (resource-present-p :NVRAM)) Write-Nvram) (Offset Value)
  "Write least significant byte of VALUE into NVRAM at address OFFSET from start of NVRAM."
  ;(format t "~&write offset #x~x  value #x~x~%" offset value)
  (setf offset (logand #xff offset))
  (if (or (not (boundp 'addin:*crec-acb* )) (not addin:*crec-acb*))
      (progn      
	(setq nvram-error (format nil "~&write-Nvram offset invalid or *crec-acb* not initialized: #x~x~%" Offset))
	0)
    (SETF (add:parm-8b addin:*crec-acb* (FLOOR offset 4)) value)))

(Defun (:COND (resource-present-p :NVRAM) Write-Nvram) (Offset Value)
  "Write least significant byte of VALUE into NVRAM at address OFFSET from start of NVRAM."
  (%Nubus-Write-8b Nvram-Slot (+ Nvram-Slot-Offset Offset) Value))



(Defsetf Read-Nvram Write-Nvram) 


(Defun Read-Nvram-16b (Offset)
  "Read half-word of NVRAM (LSB first) at address OFFSET from start of NVRAM."
  (Let ((Lo-8 (Read-Nvram Offset))
	(Hi-8 (Read-Nvram (+ Offset #o4))))
    (Dpb Hi-8 (Byte #o10 #o10) Lo-8))) 


(Defun Write-Nvram-16b (Offset Value)
  "Write least significant 16 bits of VALUE into NVRAM.  LSB is written first."
  (Let ((Lo-8 (Ldb (Byte #o10 #o0) Value))
	(Hi-8 (Ldb (Byte #o10 #o10) Value)))
    (Write-Nvram Offset Lo-8)
    (Write-Nvram (+ Offset #o4) Hi-8))) 


(Defsetf Read-Nvram-16b Write-Nvram-16b) 


(Defun Write-Nvram-24b (Offset Value)
  "Write least significant 24 bits of VALUE into NVRAM, LSB first."
  (Let ((Lo-8 (Ldb (Byte #o10 #o0) Value))
	(Mid-8 (Ldb (Byte #o10 #o10) Value))
	(Hi-8 (Ldb (Byte #o10 #o20) Value)))
    (Write-Nvram Offset Lo-8)
    (Write-Nvram (+ Offset #o4) Mid-8)
    (Write-Nvram (+ Offset #o10) Hi-8))) 	


(Defun Read-Nvram-24b (Offset)
  "Read 3 bytes of NVRAM starting at OFFSET, LSB first."
  (Let ((Lo-8 (Read-Nvram Offset))
	(Mid-8 (Read-Nvram (+ Offset #o4)))
	(Hi-8 (Read-Nvram (+ Offset #o10))))
    (Dpb Hi-8 (Byte #o10 #o20) (Dpb Mid-8 (Byte #o10 #o10) Lo-8)))) 


(Defsetf Read-Nvram-24b Write-Nvram-24b) 


(Defun Write-Nvram-32b (Offset Value)
  "Write least significant 32 bits of VALUE into NVRAM, LSB first."
  (Let ((Lo-16 (Ldb (Byte #o20 #o0) Value))
	(Hi-16 (Ldb (Byte #o20 #o20) Value)))
    (Write-Nvram-16b Offset Lo-16)
    (Write-Nvram-16b (+ Offset #o10) Hi-16))) 


(Defun Read-Nvram-32b (Offset)
  "Read 4 bytes of NVRAM starting at OFFSET, LSB first."
  (Let ((Lo-16 (Read-Nvram-16b Offset))
	(Hi-16 (Read-Nvram-16b (+ Offset #o10))))
    (Dpb Hi-16 (Byte #o20 #o20) Lo-16)))  


(Defsetf Read-Nvram-24b Write-Nvram-24b) 



;;;
;;; Crash Record Variables.
;;;

;;; Initialized in Setup-Crash-Rec-Vars, run during warm inits.

(Defvar Current-Crash-Rec-Offset #o0
   "Offset into NVRAM of current (for this boot) crash record.") 


;;;
;;; 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) 

;;; Current crash record. 32-bit forms

(Defun Read-Current-Crash-Rec-32b (Offset)
  "Read 32 bit word stored at OFFSET in current crash record, from LSB to MSB."
  (Dpb (Read-Nvram-16b (+ Offset Current-Crash-Rec-Offset #o10)) (Byte #o20 #o20)
       (Read-Nvram-16b (+ Offset Current-Crash-Rec-Offset)))) 


(Defun Write-Current-Crash-Rec-32b (Offset Value)
  "Write 32 bits of VALUE into current crash record at location OFFSET, LSB first."
  (Write-Nvram-16b (+ Offset Current-Crash-Rec-Offset) (Ldb (Byte #o20 #o0) Value))
  (Write-Nvram-16b (+ Offset Current-Crash-Rec-Offset #o10) (Ldb (Byte #o20 #o20) Value))) 
  

(Defsetf Read-Current-Crash-Rec-32b Write-Current-Crash-Rec-32b) 


;;; 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 #o10)) (Byte #o20 #o20)
       (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 (Byte #o20 #o0) Value))
  (Write-Nvram-16b (+ Offset Crash-Rec-Pointer #o10) (Ldb (Byte #o20 #o20) Value))) 
  

(Defsetf Read-Crash-Rec-32b Write-Crash-Rec-32b) 


;;;
;;; Crash Record offset symbols property-list setup routines
;;;

;; Iterate over all symbols on CRASH-REC-OFFSETS and NVRAM-OFFSETS lists (defined in QDEV),
;; adding NVRAM-Field-Size property to each.  This property is the length in bits
;; of the particular crash record field.  It will be used by the read macros below
;; in the generation of the correct accessor function for these fields.


(Eval-When (Compile Load)
	   ;; Adds NVRAM-Field-Size property to all symbols on LIST.
   (Defun Def-Nvram-Field-Size (List)
     (If (Not (Consp List))
       (Ferror () "Def-NVRAM-Field-Size argument LIST-NAME (~s) not a list" List))
     (Do* ((L List (Rest L))
	   (Sym1 (First L) (First L))
	   (Sym2 (Second L) (Second L))
	   (Size
	    (* #o10
		(Truncate (- (Symbol-Value Sym2) (Symbol-Value Sym1)) #o4))
	    (* #o10
		(Truncate (- (Symbol-Value Sym2) (Symbol-Value Sym1)) #o4))))
	  ((= (Length L) #o2)
	   (Setf (Get Sym1 'Nvram-Field-Size) Size))
       (Setf (Get Sym1 'Nvram-Field-Size) Size)))) 


(Eval-When (Compile Load) (Def-Nvram-Field-Size Crash-Rec-Offsets)
   (Def-Nvram-Field-Size Nvram-Offsets)) 



;;;
;;; Crash Record field accessor macros
;;;

;; The macros below expand into the right accessor function for FIELD, a crash record
;; offset.  They work off the property list for the symbol passed in their FIELD argument.
;; The property list should contain an NVRAM-Field-Size property indicating the size of
;; the field in bits. 


(Defmacro Read-Current-Crash-Field (Field)
  (Check-Arg Field (Member Field Crash-Rec-Offsets :Test #'Eq)
     "a member of the si:CRASH-REC-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Read-Current-Crash-Rec)
       (#o20 'Read-Current-Crash-Rec-16b)
       (#o40 'Read-Current-Crash-Rec-32b))
    ,Field)) 


(Defmacro Write-Current-Crash-Field (Field Value)
  (Check-Arg Field (Member Field Crash-Rec-Offsets :Test #'Eq)
     "a member of the si:CRASH-REC-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Write-Current-Crash-Rec)
       (#o20 'Write-Current-Crash-Rec-16b)
       (#o40 'Write-Current-Crash-Rec-32b))
    ,Field ,Value)) 


(Defmacro Read-Crash-Field (Crec Field)
  (Check-Arg Field (Member Field Crash-Rec-Offsets :Test #'Eq)
     "a member of the si:CRASH-REC-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Read-Crash-Rec)
       (#o20 'Read-Crash-Rec-16b)
       (#o40 'Read-Crash-Rec-32b))
    ,Crec ,Field)) 


(Defmacro Write-Crash-Field (Crec Field Value)
  (Check-Arg Field (Member Field Crash-Rec-Offsets :Test #'Eq)
     "a member of the si:CRASH-REC-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Write-Crash-Rec)
       (#o20 'Write-Crash-Rec-16b)
       (#o40 'Write-Crash-Rec-32b))
    ,Crec ,Field ,Value)) 

;;; 1.12.88 MBC
;;;(Defmacro Read-Nvram-Field (Field)
;;;  (format t "~& read-nvram-field: ~a~%" field)
;;;  0)

(Defmacro Read-Nvram-Field (Field)
  (Check-Arg Field (Member Field Nvram-Offsets :Test #'Eq)
     "a member of the si:NVRAM-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o30 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., 24, or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Read-Nvram)
       (#o20 'Read-Nvram-16b)
       (#o30 'Read-Nvram-24b)
       (#o40 'Read-Nvram-32b))
    ,Field)) 

;;; 1.12.88 MBC
;;;(Defmacro Write-Nvram-Field (Field Value)
;;; (format t "~& write-nvram-field: ~a ~a~%" field value)
;;;  nil)

(Defmacro Write-Nvram-Field (Field Value)
  (Check-Arg Field (Member Field Nvram-Offsets :Test #'Eq)
     "a member of the si:NVRAM-OFFSETS list")
  (Check-Arg Field (Member (Get Field 'Nvram-Field-Size) '(#o10 #o20 #o30 #o40) :Test #'Eq)
     "a symbol with an NVRAM-Field-Size property of 8., 16., 24, or 32")
  `(,(Case (Get Field 'Nvram-Field-Size)
       (#o10 'Write-Nvram)
       (#o20 'Write-Nvram-16b)
       (#o30 'Write-Nvram-24b)
       (#o40 'Write-Nvram-32b))
    ,Field ,Value))



;;;
;;; Other CREC macros
;;;

;; Crash Record keyword/value list support:


(Defmacro Get-Item (Record Item)
 ;; Gets ITEM's value (ITEM is a crash field designator) from RECORD
 ;; (the internal Crash Record data structure).
  `(Second (ASSOC ,Item ,Record :test #'EQ))) 


;; CREC field test/set support:


(Defmacro Test-Crash-Rec-Bits (Crec Offset Ppss)
 ;; Reads 8 bits from the NVRAM crash record at address CREC and returns
 ;; T if the field PPSS is not zero.  Used to test flag bits.
  `(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 CREC at OFFSET.
 ;; Used to set flag bits.
  `(Write-Crash-Rec ,Crec ,Offset (Dpb ,Value ,Ppss (Read-Crash-Rec ,Crec ,Offset)))) 


;;;
;;; Typed Block accessors
;;;

;;;AB 8/4/87.  New, for [SPR 5119].

(PROCLAIM '(inline typed-block-id))
(DEFUN typed-block-id (typed-block)
  "Returns TYPED-BLOCK's numeric ID."
  (read-nvram-16b (+ typed-block Typed-Block-ID-Offset)))

(PROCLAIM '(inline set-typed-block-id))
(DEFUN set-typed-block-id (typed-block id)
  "Sets TYPED-BLOCK's numeric identifier to ID."
  (write-nvram-16b (+ typed-block Typed-Block-ID-Offset) id)
  id)

(DEFSETF typed-block-id set-typed-block-id)


(PROCLAIM '(inline typed-block-length))
(DEFUN typed-block-length (typed-block)
  "Returns TYPED-BLOCK's total length in Nubus bytes, including overhead."
  (read-nvram-16b (+ typed-block Typed-Block-Length-Offset)))

(PROCLAIM '(inline set-typed-block-length))
(DEFUN set-typed-block-length (typed-block length)
  "Sets TYPED-BLOCK's total length (including overhead) to LENGTH Nubus bytes."
  (write-nvram-16b (+ typed-block Typed-Block-Length-Offset) length)
  length)

(DEFSETF typed-block-length set-typed-block-length)


(PROCLAIM '(inline tb-type))
(DEFUN tb-type (id)
  "Given a numeric typed block ID, returns symbol naming the typed-block's type, or NIL if unknown."
  (LOOP for sym in Typed-Block-Type-Codes
	do (WHEN (= (SYMBOL-VALUE sym) id)
	     (RETURN sym))
	finally (RETURN nil)))

(PROCLAIM '(inline tb-data-bytes))
(DEFUN tb-data-bytes (length-in-nubus-bytes)
  "Given a LENGTH-IN-NUBUS-BYTES, retuns a typed block's number of data bytes."
  (ASH (- length-in-nubus-bytes Typed-Block-Overhead-Length) -2))


(PROCLAIM '(inline tb-nubus-bytes))
(DEFUN tb-nubus-bytes (data-bytes)
  "Given a number of DATA-BYTES, retuns a typed block's length in Nubus bytes."
  (+ (ASH data-bytes 2) Typed-Block-Overhead-Length))


(PROCLAIM '(inline typed-block-data-length))
(DEFUN typed-block-data-length (typed-block)
  "Returns number of data bytes in TYPED-BLOCK."
  (tb-data-bytes (typed-block-length typed-block)))

(PROCLAIM '(inline set-typed-block-data-length))
(DEFUN set-typed-block-data-length (typed-block data-bytes)
  "Sets TYPED-BLOCKS length in data bytes to DATA-BYTES."
  (L