;;; -*- 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 functions to initialize and change NVRAM format and ;;; parameter values. ;;; Setup-NVRAM must be run before crash record reporting ;;; can begin, since it initializes the Crash Buffer data structure in NVRAM ;;; (as well as other parameters used in STBM). ;;; Change-NVRAM can be used to modify existing STBM parameters in NVRAM. ;;; ;;; 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 rg Original (as SETUP-NVRAM) ;;; 5/85 ab Modified to use QDEV templates. ;;; 9/85 ab Renamed file NVRAM. ;;; Modified both Setup-NVRAM and Change-NVRAM to understand ;;; logical unit numbers. Added error checking. Both now ;;; return strings describing current NVRAM parameters. Improved ;;; documentation. ;;; Change-NVRAM now only writes new values for supplied keyword ;;; parameters. ;;; Removed Edit-NVRAM entirely. ;;; Use new field accessor macros where appropriate. ;;; Prefixed all non-NVRAM names with explicit pkg. ;;; 11/4/85 ab NVRAM patch 2-7. Changed default stream arg for NVRAM-Status ;;; to Standard-Output. ;;; 11/86 kk KK-1. Changes to support NVRAM CRC field. Changed SETUP-NVRAM and ;;; CHANGE-NVRAM to write CRC values. ;;; 03-15-87 ab Don't initialize "start-unallocated-area" or "number typed blocks". ;;; They are obsolete. ;;; 03-29-87 ab Added some typed-block support. Change SETUP-NVRAM to make crash ;;; record buffer a typed block, and also to make a typed block for STBM. ;;; Also changed SETUP-NVRAM to initialize configuration checksum. ;;; 07-13-87 ab NVRAM 3-2. ;;; o Fix SETUP-NVRAM to initialize crash record typed block correctly. [SPR 5609] ;;; o Implement INITIALIZE-FIRST-CRASH-RECORD to avoid re-boot after SETUP-NVRAM. [SPR 4183] ;;; 08-04-87 ab NVRAM 3-5. ;;; o Implement TYPED-BLOCK accessors. [SPR 5119] ;;; 01.12.88 MBC Conditionalize on resource-present-p and :NVRAM. ;;; The entire file wrapped in this "(define-when :NVRAM ...." ;;; 08-01-88 ab o Fix to FIND-TYPED-BLOCK for when TYPED-BLOCK-VALID returns NIL. ;;; ;;; Internal functions ;;; (eval-when (eval compile) (defprop when t si:may-surround-defun) (defprop unless t si:may-surround-defun)) (define-when :NVRAM (Defun Nvram-Functioning-P (&Optional (Offset #o0)) "Simple check to see if we can read back a value written into NVRAM at OFFSET." (Let ((Save1 (%Nubus-Read-8b-Careful Nvram-Slot (+ Nvram-Slot-Offset Offset))) (Save2 (%Nubus-Read-8b-Careful Nvram-Slot (+ Nvram-Slot-Offset Offset #o4)))) (When (Numberp Save1) ;if we could read anything successfully (%Nubus-Write-8b Nvram-Slot (+ Nvram-Slot-Offset Offset) #o336) (%Nubus-Write-8b Nvram-Slot (+ Nvram-Slot-Offset Offset #o4) #o67) (Let ((Result (If (And (Eql (%Nubus-Read-8b-Careful Nvram-Slot (+ Nvram-Slot-Offset Offset)) #o336) (Eql (%Nubus-Read-8b-Careful Nvram-Slot (+ Nvram-Slot-Offset Offset #o4)) #o67)) T ()))) (%Nubus-Write-8b Nvram-Slot (+ Nvram-Slot-Offset Offset) Save1) (%Nubus-Write-8b Nvram-Slot (+ Nvram-Slot-Offset Offset #o4) Save2) Result)))) (Defun Initialize-Reserved-Areas () "Writes initial values out to all reserved locations recorded in NVRAM-Reserved list." (Dolist (Res-List Nvram-Reserved Nil) (Do ((Offset (First Res-List) (+ Offset #o4)) (Last (Second Res-List)) (Value (Third Res-List))) ((= Offset Last)) (Write-Nvram Offset Value)))) (Defun Initialize-Crash-Rec-Pointers (Base Limit) "Given BASE of crash record buffer area and LIMIT (both offsets from start of NVRAM) initialize the buffer area pointers." (DECLARE (UNSPECIAL base)) (Let* ((Buffer-Size (- Limit Base)) (Number-Of-Records (Floor Buffer-Size Crash-Rec-Len)) (End-Of-Buff (+ Base (* Number-Of-Records Crash-Rec-Len))) (Last (- End-Of-Buff Crash-Rec-Len))) (Cond ((< Number-Of-Records #o1) (Ferror "buffer too small -- not even room for one crash record")) ((< Number-Of-Records #o4) (Cerror :No-Action () () "Buffer is small -- only room for ~D crash records." Number-Of-Records))) (Write-Nvram-Field Nvram-Crash-Buff-Rec-Len Crash-Rec-Len) (Write-Nvram-Field Nvram-Crash-Buff-Base Base) (Write-Nvram-Field Nvram-Crash-Buff-Last Last) (Write-Nvram-Field Nvram-Crash-Buff-Pointer Base) (Write-Nvram-Field Nvram-Crash-Buff-Format-Rev Crash-Rec-Format-Version) (Write-Nvram-Field Nvram-Crash-Buff-Format-Processor Crash-Rec-Format-Processor-Type) ;; Return number of records Number-Of-Records)) (DEFUN initialize-first-crash-record () (setup-nvram-vars) (setup-crash-rec-vars) (write-current-crash-field ; load unit CRO-LOAD-UNIT Load-Unit) (write-current-crash-field CRO-LOAD-PART ; load partition (Dpb (CHAR-INT (Aref *Loaded-Band* #o3)) (Byte #o10 #o30) (Dpb (CHAR-INT (Aref *Loaded-Band* #o2)) (Byte #o10 #o20) (Dpb (CHAR-INT (Aref *Loaded-Band* #o1)) (Byte #o10 #o10) (CHAR-INT (Aref *Loaded-Band* #o0)))))) (write-current-crash-field ; ucode unit (assume same as load unit) CRO-UCODE-UNIT Load-Unit) (write-current-crash-field CRO-UCODE-PART ; ucode partition (Dpb (CHAR-INT (Aref *Loaded-Mcr-Band* #o3)) (Byte #o10 #o30) (Dpb (CHAR-INT (Aref *Loaded-Mcr-Band* #o2)) (Byte #o10 #o20) (Dpb (CHAR-INT (Aref *Loaded-Mcr-Band* #o1)) (Byte #o10 #o10) (CHAR-INT (Aref *Loaded-Mcr-Band* #o0)))))) (write-current-crash-field ; controller CRO-CONTROLLER (LDB (BYTE 4 0) Nupi-Slot-Number)) (write-current-crash-field ; ucode version number CRO-UCODE-VERSION %microcode-version-number) (record-system-version) ; (record-boot-time) (record-progress CREC-PROGRESS-TIME-INITIALIZED) (write-nvram-field NVRAM-CONFIG-CHECKSUM (calculate-config-checksum)) (WRITE-METER '%crash-record-physical-address (DPB nvram-slot %%Nubus-F-And-Slot-Bits (+ Nvram-Slot-Offset Current-Crash-Rec-Offset))) (update-crec-time)) ;;; ;;; User-callable NVRAM functions. ;;; (Defun Nvram-Status (&Optional (Stream *Standard-Output*)) "Writes the current status of NVRAM, including the default boot values, to STREAM." (If (Not (Nvram-Functioning-P)) (Format Stream "~%WARNING: NVRAM does not appear to be functioning. Have your SIB checked.") (If (Not (Nvram-Initialized-P)) (Format Stream "~%NVRAM has not been initialized. Use SI:Setup-NVRAM.") (Progn (Format Stream "~% Default Boot Unit is ~d. ~ ~& Default Boot Slot is ~d. ~ ~& Keyboard Unit is ~d. ~ ~& Keyboard Slot is ~d. ~ ~& Monitor Unit is ~d. ~ ~& Monitor Slot is ~d." (Get-Logical-Unit (Read-Nvram-Field Nvram-Boot-Unit)) (Read-Nvram-Field Nvram-Boot-Slot) (Read-Nvram-Field Nvram-Keyboard-Unit) (Read-Nvram-Field Nvram-Keyboard-Slot) (Read-Nvram-Field Nvram-Monitor-Unit) (Read-Nvram-Field Nvram-Monitor-Slot)))))) ;;AB 8/4/87. Calculate NVRAM CRC only after filling in everything else. Part of [SPR 5119]. (Defun Setup-Nvram (&Optional (Logical-Unit #o0)) "Initializes NVRAM in order to support system shutdown reporting and sets up the default disk unit from which the Lisp and microcode bands will be loaded during a DEFAULT boot. LOGICAL-UNIT is the logical disk unit number of the disk you wish to be the default load disk. Since this function clears the current information stored in NVRAM, it should only be run once after a system is installed, or after the SIB has been replaced or the NVRAM format used by the system has changed. To change the default load unit after NVRAM has been set up, use sys:CHANGE-NVRAM. To examine the current values and state of NVRAM, use sys:NVRAM-STATUS." (COND ((resource-present-p :NVRAM) (Check-Arg Logical-Unit (And (Integerp Logical-Unit) (>= Logical-Unit #o0) (< Logical-Unit (Array-Dimension Disk-Type-Table #o0))) "a valid disk logical unit number (an integer between 0 and 15.)") (Let ((Ans T) (Slot (Ldb (Byte #o4 #o0) Nvram-Slot))) (WHEN (Not (Disk-Online Logical-Unit)) (Setq Ans (Y-Or-N-P "~&Unit ~d is not currently online. Use as default unit anyway?" Logical-Unit))) (WHEN Ans (If (Nvram-Functioning-P) (Progn (Write-Nvram-Field Nvram-Monitor-Unit #o0) (Write-Nvram-Field Nvram-Monitor-Slot Slot) (Write-Nvram-Field Nvram-Keyboard-Unit #o0) (Write-Nvram-Field Nvram-Keyboard-Slot Slot) (Write-Nvram-Field Nvram-Boot-Unit (Convert-Logical-Unit-To-Physical Logical-Unit)) (Write-Nvram-Field Nvram-Boot-Slot (Ldb (Byte #o4 #o0) Nupi-Slot-Number)) (Write-Nvram-Field Nvram-Generation Nvram-Format-Generation-Number) (Write-Nvram-Field Nvram-Revision Nvram-Format-Revision-Level) ;;;; (Write-Nvram-Field Nvram-Crc (calc-nvram-crc)) ;; new code KK-1 (Write-Nvram-Field Nvram-Config-Checksum (calculate-config-checksum)) (Write-Nvram-Field Nvram-Shutdown-Valid-Character #o0) (Write-Nvram-Field Nvram-Shutdown-Cause #o377) (Write-Nvram-Field Nvram-Boot-Month #o0) (Write-Nvram-Field Nvram-Boot-Day #o0) (Write-Nvram-Field Nvram-Boot-Hour #o0) (Write-Nvram-Field Nvram-Boot-Minute #o0) (Write-Nvram-Field Nvram-Seconds-Since-Boot #o0) (Write-Nvram-Field Nvram-Obsolete-1 #o10000) ;for downward-compatibility (Initialize-Reserved-Areas) ;; This must happen AFTER above are done. (Initialize-Crash-Rec-Pointers si:NVRAM-Crash-Buffer-Start-Offset si:NVRAM-Crash-Buffer-Limit) (setup-typed-block-area t) (initialize-first-crash-record) (Write-NVRAM-Field NVRAM-CRC (Calc-NVRAM-CRC)) ;;calculate CRC last (Format () "~&NVRAM initialized successfully ~a" (Nvram-Status ()))) "NVRAM initialization failed: unable to verify functioning of NVRAM.")))) (t t)) (SETF current-crash-record nil all-crash-records nil) ;ab 11/11/88. t) (Defun Change-Nvram (&Key Load-Unit Load-Slot Monitor-Unit Monitor-Slot Keyboard-Unit Keyboard-Slot) "Changes specific NVRAM parameters to support STBM acces to monitor, keyboard, and load source. The most common use of this function is to change the disk unit used as the Lisp world load and microload source during a DEFAULT boot. Keywords are: :LOAD-UNIT Logical disk unit for use in DEFAULT boot :LOAD-SLOT (normally 2). Slot number of disk controller :MONITOR-UNIT (normally 0). Monitor controller unit number :MONITOR-SLOT (normally 5). Monitor controller slot number :KEYBOARD-UNIT (normally 0). Keyboard controller unit number :KEYBOARD-SLOT (normally 5). Keyboard controller slot number Only supplied parameters are changed. The funtion returns a string describing the current NVRAM parameter values (see also SI:NVRAM-Status)." (When Load-Unit (Check-Arg Load-Unit (And (Integerp Load-Unit) (>= Load-Unit #o0) (< Load-Unit (Array-Dimension Disk-Type-Table #o0))) "a valid disk logical unit number (an integer between 0 and 15.)")) (When Load-Slot (Check-Arg Load-Slot (And (Integerp Load-Slot) (>= Load-Slot #o0)) "a positive integer")) (When Monitor-Unit (Check-Arg Monitor-Unit (And (Integerp Monitor-Unit) (>= Monitor-Unit #o0)) "a positive integer")) (When Monitor-Slot (Check-Arg Monitor-Slot (And (Integerp Monitor-Slot) (>= Monitor-Slot #o0)) "a positive integer")) (When Keyboard-Unit (Check-Arg Keyboard-Unit (And (Integerp Keyboard-Unit) (>= Keyboard-Unit #o0)) "a positive integer")) (When Keyboard-Slot (Check-Arg Keyboard-Slot (And (Integerp Keyboard-Slot) (>= Keyboard-Slot #o0)) "a positive integer")) (Let ((Ans T)) (If (And Load-Unit (Not (Disk-Online Load-Unit))) (Setq Ans (Y-Or-N-P "~&Unit ~d is not currently online. Use as default unit anyway? " Load-Unit))) (If Ans (If (Nvram-Functioning-P) (Progn (When Load-Unit (Write-Nvram-Field Nvram-Boot-Unit (Convert-Logical-Unit-To-Physical Load-Unit))) (When Load-Slot (Write-Nvram-Field Nvram-Boot-Slot Load-Slot)) (When Monitor-Unit (Write-Nvram-Field Nvram-Monitor-Unit Monitor-Unit)) (When Monitor-Slot (Write-Nvram-Field Nvram-Monitor-Slot Monitor-Slot)) (When Keyboard-Unit (Write-Nvram-Field Nvram-Keyboard-Unit Keyboard-Unit)) (When Keyboard-Slot (Write-Nvram-Field Nvram-Keyboard-Slot Keyboard-Slot)) (If (Or Load-Unit Load-Slot Monitor-Unit Monitor-Slot Keyboard-Unit Keyboard-Slot) (PROGN (Write-Nvram-Field Nvram-Crc (calc-nvram-crc)) ;; new code KK-1 (Format () "~&NVRAM changes completed successfully. ~a" (Nvram-Status nil))) (Format () "~&Current NVRAM parameters are: ~a" (Nvram-Status nil)))) "NVRAM changes failed: unable to verify functioning of NVRAM") ;; User answered NO. Tell him no changes made. (Format nil "~&No changes made. Current NVRAM parameters are: ~a" (Nvram-Status nil))))) (Defun NVRAM-DEFAULT-UNIT-AND-SLOT () "Returns the current default Unit and Slot specified by NVRAM." (If (not (NVRAM-Functioning-P)) (ferror nil "~%WARNING: NVRAM does not appear to be functioning. Have your SIB checked.") (If (not (NVRAM-initialized-p)) (Ferror nil "~%NVRAM has not been initialized. Use SI:Setup-NVRAM.") (values (Read-NVRAM-Field si:NVRAM-Boot-Unit) (Read-NVRAM-Field si:NVRAM-Boot-Slot))))) ;;; ;;; Typed Block Support ;;; ;;; Lowest-level support. These first ones are required for initializing typed block ;;; area in SETUP-NVRAM. ;; Note that NVRAM-Format-Revision-Level of 2 indicates that the typed block area has ;; been initialized properly (is valid). ;;AB 8/4/87. New. Part of [SPR 5119]. (DEFUN nvram-format-ok () (AND (= Nvram-Format-Generation-Number (Read-Nvram-Field Nvram-Generation)) (= Nvram-Format-Revision-Level (Read-Nvram-Field Nvram-Revision)))) ;;AB 8/4/87. New. Part of [SPR 5119]. (DEFUN typed-block-access-ok () (AND (nvram-functioning-p) (nvram-initialized-p) (nvram-format-ok))) ;;AB 8/4/87. New. Part of [SPR 5119]. (DEFUN force-typed-block-setup () (Write-Nvram-Field Nvram-Revision (1- Nvram-Format-Revision-Level)) (Write-NVRAM-Field NVRAM-CRC (Calc-NVRAM-CRC))) ;;AB 8/4/87. New. Part of [SPR 5119]. ;; Will run on an init list so that typed block area will be set up on all machines. (DEFUN assure-typed-block-area-set-up () (WHEN (AND (nvram-functioning-p) (nvram-initialized-p)) (LET ((rev (Read-Nvram-Field Nvram-Revision))) (UNLESS (= rev Nvram-Format-Revision-Level) (setup-typed-block-area nil) (Write-Nvram-Field Nvram-Revision Nvram-Format-Revision-Level) (Write-NVRAM-Field NVRAM-CRC (Calc-NVRAM-CRC))) t)) ) ;;AB 8/4/87. Fixed to use new accessors. Part of [SPR 5119]. (DEFUN initialize-typed-block-area (&optional erase-old) ;; Set all typed block area to #x+ABAB (WHEN erase-old (DO ((offset NVRAM-Start-Typed-Block-Area (+ offset 4))) ((>= offset SIB-NVRAM-Length)) (write-nvram offset #x+AB))) ;; Make this area look like one big available typed block (up to Last-Typed-Block). (SETF (typed-block-id NVRAM-Start-Typed-Block-Area) Typed-Block-Available) (SETF (typed-block-length NVRAM-Start-Typed-Block-Area) (- NVRAM-Last-Typed-Block-Offset NVRAM-Start-Typed-Block-Area)) ;; Initialize Last Typed Block, which acts as an end marker. ;; It has a special type (type "end") and 0-length data portion. (SETF (typed-block-id NVRAM-Last-Typed-Block-Offset) Typed-Block-End-Block) (SETF (typed-block-length NVRAM-Last-Typed-Block-Offset) (+ Typed-Block-Overhead-Length TB-End-Block-Length))) ;;AB 8/4/87. Fixed to use new accessors. Part of [SPR 5119]. (DEFUN %initialize-typed-block (typed-block-code data-length-in-nubus-bytes start-offset &optional erase-old) (SETF (typed-block-id start-offset) typed-block-code) (SETF (typed-block-length start-offset) (+ data-length-in-nubus-bytes Typed-Block-Overhead-Length)) (WHEN erase-old (DO ((ct 0 (1+ ct)) (adr (+ start-offset Typed-Block-Overhead-Length) (+ adr 4.))) ((>= ct (TRUNCATE data-length-in-nubus-bytes 4.))) ;one NVRAM-byte per 4 Nubus-addressable bytes (write-nvram adr 0)))) ;;AB 8/4/87. Fixed to use new accessors. Also fixed for allocating block which fits exactly ;; into BLOCK-TO-CARVE-FROM. Part of [SPR 5119]. (DEFUN %allocate-and-initialize-typed-block (typed-block-code data-length-in-nubus-bytes block-to-carve-from &optional (offset-into-block 0) erase-old) (LET* ((new-block-total-bytes (+ data-length-in-nubus-bytes Typed-Block-Overhead-Length)) (old-type (typed-block-id block-to-carve-from)) (old-size (typed-block-length block-to-carve-from)) (new-block-addr (+ block-to-carve-from (OR offset-into-block 0))) (next-block (+ new-block-addr new-block-total-bytes)) (next-block-size (- old-size new-block-total-bytes))) (%initialize-typed-block typed-block-code data-length-in-nubus-bytes new-block-addr erase-old) (COND ((= new-block-addr block-to-carve-from) (UNLESS (OR (ZEROP next-block-size) (= next-block NVRAM-Last-Typed-Block-Offset)) ;; If next block isn't the end block or will be non-empty, ;; just move it down & reduce size to make room for new one. (SETF (typed-block-id next-block) old-type) (SETF (typed-block-length next-block) (- old-size new-block-total-bytes)))) (t ;; Shorten old-block's length. (SETF (typed-block-length block-to-carve-from) offset-into-block) (SETQ next-block-size (- old-size new-block-total-bytes offset-into-block)) ;; Make new available block after one to be inserted. (UNLESS (OR (ZEROP next-block-size) (= next-block NVRAM-Last-Typed-Block-Offset)) ;; If next block isn't the end block or will be non-empty, ;; just move it down & reduce size to make room for new one. (SETF (typed-block-id next-block) Typed-Block-Available) (SETF (typed-block-length next-block) next-block-size)))) )) (DEFUN setup-typed-block-area (&optional erase-old) ;; Order cannot be changed for next three. (initialize-typed-block-area erase-old) (%allocate-and-initialize-typed-block Typed-Block-Crash-Buffer TB-Crash-Buffer-Block-Length NVRAM-Start-Typed-Block-Area (- NVRAM-Crash-Buffer-Block-Offset NVRAM-Start-Typed-Block-Area) erase-old) (%allocate-and-initialize-typed-block Typed-Block-STBM TB-STBM-Block-Length NVRAM-STBM-Block-Offset) nil erase-old) ;;; ;;; Higher-level Typed Block Manipulators ;;; ;;;AB 8/4/87. All new. [SPR 5119] (DEFUN typed-block-valid (typed-block) (DECLARE (VALUES typed-block id id-type nubus-length data-length)) (WHEN (AND (NUMBERP typed-block) (>= typed-block NVRAM-Start-Typed-Block-Area) (< typed-block SIB-NVRAM-Length)) (LET ((len (typed-block-length typed-block)) (id (typed-block-id typed-block))) (WHEN (AND (PLUSP len) (<= len (- (+ NVRAM-Last-Typed-Block-Offset Typed-Block-Overhead-Length) typed-block))) (VALUES typed-block id (tb-type id) len (tb-data-bytes len))))) ) (DEFUN get-next-typed-block (current-typed-block &optional (stop-at-end-block t) &aux length next) "Given a typed block CURRENT-TYPED-BLOCK, returns the next typed block in NVRAM, or NIL if one cannot be found. If none can be found, a second value is returned which is a keyword indicating why." (COND ((OR (< current-typed-block NVRAM-Start-Typed-Block-Area) (>= current-typed-block SIB-NVRAM-Length)) (VALUES nil :invalid-typed-block-address)) ((= current-typed-block NVRAM-Last-Typed-Block-Offset) (VALUES nil :end)) ((AND (= NVRAM-Last-Typed-Block-Offset (SETQ next (+ current-typed-block (SETQ length (typed-block-length current-typed-block))))) stop-at-end-block) (VALUES nil :end)) ((OR (ZEROP length) (> length (- NVRAM-Last-Typed-Block-Offset current-typed-block))) (VALUES nil :invalid-typed-block-length)) (t next)) ) (DEFUN find-typed-block (id &optional after-block) (WHEN (typed-block-access-ok) (IF (OR (NULL after-block) (EQ after-block :start)) (SETQ after-block NVRAM-Start-Typed-Block-Area) (SETQ after-block (get-next-typed-block after-block))) (WHEN after-block (LOOP for block = after-block then (get-next-typed-block block) until (NULL block) do (MULTIPLE-VALUE-BIND (typed-block block-id nil nil data-len) (typed-block-valid block) (WHEN (AND block-id ;ab 8-1-88 (= block-id id)) (RETURN (VALUES typed-block data-len)))) finally (RETURN nil)))) ) (DEFUN allocate-typed-block (id data-bytes &optional (init t)) (LOOP with typed-block = :start with data-length = 0 until (NULL typed-block) do (MULTIPLE-VALUE-SETQ (typed-block data-length) (find-typed-block Typed-Block-Available typed-block)) (WHEN (AND typed-block (>= data-length data-bytes)) (%allocate-and-initialize-typed-block id (* data-bytes 4) typed-block 0 init) (RETURN typed-block)) finally (RETURN nil)) ) (DEFUN deallocate-typed-block (typed-block) (WHEN (typed-block-valid typed-block) (DO ((prev nil block) (prev-len nil block-len) (prev-id nil block-id) (block NVRAM-Start-Typed-Block-Area next) (block-len (typed-block-length NVRAM-Start-Typed-Block-Area) (WHEN next next-len)) (block-id (typed-block-id NVRAM-Start-Typed-Block-Area) (WHEN next next-id)) (next (get-next-typed-block NVRAM-Start-Typed-Block-Area) (WHEN next (get-next-typed-block next))) (next-len) (next-id)) ((NULL block) nil) (COND ((AND next (typed-block-valid next)) (SETQ next-len (typed-block-length next) next-id (typed-block-id next))) (t (SETQ next nil))) (WHEN (= block typed-block) ;; Found block to deallocate. (COND ((AND prev next (= prev-id Typed-Block-Available) (= next-id Typed-Block-Available)) (%initialize-typed-block Typed-Block-Available (+ (- prev-len Typed-Block-Overhead-Length) block-len next-len) prev)) ((AND prev (= prev-id Typed-Block-Available)) (%initialize-typed-block Typed-Block-Available (+ (- prev-len Typed-Block-Overhead-Length) block-len) prev)) ((AND next (= next-id Typed-Block-Available)) (%initialize-typed-block Typed-Block-Available (+ (- block-len Typed-Block-Overhead-Length) next-len) block)) (t (%initialize-typed-block Typed-Block-Available (- block-len Typed-Block-Overhead-Length) block))) (RETURN t)) )) ) (DEFUN dump-typed-block (typed-block) (WHEN (typed-block-valid typed-block) (dump-nvram-contents typed-block (FLOOR (typed-block-length typed-block) 4.))) ) (DEFUN typed-block-end-p (typed-block) (AND (NUMBERP typed-block) (= typed-block NVRAM-Last-Typed-Block-Offset))) (DEFUN print-all-typed-blocks (&optional include-contents) (DO* ((typed-block NVRAM-Start-Typed-Block-Area) (block-id (typed-block-id typed-block) (typed-block-id typed-block)) (block-length (typed-block-length typed-block) (typed-block-length typed-block)) (data-length (tb-data-bytes block-length) (tb-data-bytes block-length)) (block-type (tb-type block-id) (tb-type block-id)) reason) ((NULL typed-block) reason) (FORMAT t "~%Start: #x~4x Length: #x~4x ~a Block type: #x~4x ~a" typed-block block-length (FORMAT nil "(#x~5x data bytes)" data-length) block-id (IF block-type (FORMAT nil "(~a)" block-type) "")) (COND ((typed-block-valid typed-block) (WHEN include-contents (dump-typed-block typed-block)) (MULTIPLE-VALUE-SETQ (typed-block reason) (get-next-typed-block typed-block nil))) (t (FORMAT t "~%*** INVALID TYPED BLOCK ***") (RETURN nil))) (WHEN (EQ reason :end) (RETURN reason)) )) )