;;; -*- Mode:common-LISP; Package:SYSTEM-INTERNALS; Base:10. -*- ;;; 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) 1986-1989 Texas Instruments Incorporated. All rights reserved. ;;; ;;; ;;; REVISION: ;;; 03/09/89 JLM Changed references from DISK-BLOCK-SIZE to DISK-BLOCK-BYTE-SIZE defined in QCOM ;;; 02-27-89 JLM Added MP support. ;;; Added page, file, and host parameters. ;;; Changed GET-MODULE-POINTER to also return cfg module number. ;;; Changed FORMAT-CFG-SUMMARY-FROM-RQB to use parameters instead of magic numbers. ;;; Added SET-CFG-HOST-NAME, SET-CFG-HOST-DATA, GET-CFG-HOST-DATA. ;;; 01-16-89 DAB Changed FORMAT-CFG-SUMMARY-FROM-RQB to printout page-band,file-bands and host-names for MX CFGs. ;;; 04-07-88 DAB Fixed Set-Cfg-Boot-Data and Set-Cfg-load-Data to initialize cfg-unit and cfg-band when ;;; these functions are call with NIL arguments. ;;; 03-02-88 DAB Fixed find-units-and-cfg-band. It would return nil cfg-unit when doing a set-current-band on ExpII. ;;; 02-29-88 ab Move CPU-TYPE, TRANSLATE-PHYSICAL-TO-LOGICAL to DISK-PARTITION. ;;; 09-15-87 DAB Changed CPU-TYPE to uses PROCESSOR-TYPE for the default. ;;; 09-10-87 DAB Fixed some error messages in Get-Cfg-Boot-Data. ;;; 07-27-87 DAB removed load band type from *CFG-controlled-partition-types-alist*. ;;; 06.03.87 MBC Make Show-Cfg-Summary handle slot-and-unit wild quirk correctly. ;;; If either one is wild then both must be wild. ;;; 04.01.87 DAB Added source fix for io patch 1-10 ;;; 03.20.87 DAB Added partition-name-string support. ;;; 3-19-87 MRR Changed INITIALIZE-CFG-PARTITION to create both Explorer I & II modules. ;;; 3-17-87 MRR Changed SET-CFG-BOOT-DATA to accept a string arg for unit number. ;;; Changed MERGE-BOOT-SLOT-AND-UNIT to try to find the slot from the unit. ;;; Changed SET-CFG-LOAD-DATA to take wildcard values and string arg for unit number. ;;; Changed TRANSLATE-PHYSICAL-TO-LOGICAL and TRANSLATE-LOGICAL-TO-PHYSICAL to look at ;;; the disk-type-table -- need to for MSC systems. ;;; 3-14-87 MRR Added PRIM-DEFAULT-P to check if Prim is the default microcode band on a unit. ;;; 3-03-87 MRR Many changes made to add support for Explorer II config modules. ;;; Also gave names to many of the conditions in the calls to FERROR so they ;;; can be caught. ;;; 2-09-87 MRR Made SHOW-CFG-SUMMARY and PRINT-CFG-PARTITION display the default ;;; config. partition if no arguments are specified. ;;; 2-04-87 HW Removed definition of NEXT-NUBUS-CRC. It's defined in SYS:NVRAM;INITS.LISP ;;; 1-20-87 MRR Fixed many bugs in advertised functions. ;;; 11-12-86 MBC Massive rehacking. Moved copy to/from file to "Cfg-File-Copy.Lisp" ;;; Create copy-module and get/set current load/mcr primitives. ;;; 2/86 RJG Original ;;; ;;; 04.15.87 DAB Fixed find-units-and-cfg-band to make use cpu type is GENERIC for string-equal will work. ;;; 04.22.87 DAB Changed Set-Cfg-Load-Data to work like set-cfg-boot-data. Accepts a USER-TYPE keyword. ;;; 04.23.87 DAB Fixed CHECK-ROM-CRC Array dimension to big. Fixed INITIALIZE-CFG-PARTITION- added partition comments, ;;; Fixed Get-Cfg-load-Data returns only partition name, not cpu type.Fixed FIND-MODULE-FROM-RQB ;;; to use string-equal instead of equal. ;;; ;;; ;;; ;;; Advertised functions: ;;; ---------------------- ;;; Copy-cfg-Module Copy a module from one cfg band to another ;;; ;;; Set-Cfg-Boot-Data Set Boot slot, unit, & partition name ;;; ;;; Get-Cfg-Boot-Data Get Boot name, unit, & slot ;;; ;;; Set-Cfg-Load-Data Set Load slot, unit, & partition name (Explorer CPU only) ;;; ;;; Get-Cfg-Load-Data Get Load name, unit, & slot (Explorer CPU only) ;;; ;;; Show-cfg-summary displays summary of configuration partition modules. ;;; ;;; Print-cfg-partition displays detailed information of a configuration partition ;;; ;;; Initialize-cfg-partition to initialize a configuration partition with an Explorer ;;; configuration module properly formatted ;;; Other useful functions: ;;; ----------------------- ;;; PRIM-P predicate for determining ;;; 1) whether there is a PRIM partition anywhere ;;; 2) if there is a PRIM on a unit. ;;; FIND-PRIM - returns the unit that has PRIM. ;;; ;;; FIND-CFG-BAND Finds all CFGs on specified unit, the default first and others ;;; in a list. ;;; ;;; FIND-DEFAULT-CFG Find the default CFG for the system. ;;; ;;; NVRAM-DEFAULT-UNIT Read NVRAM to find the default unit. ;;; ;;; get-disk-string-byte-addr to read a string from a RQB given a byte offset into the RQB ;;; ;;; put-disk-string-byte-addr to insert a string into a RQB at a byte offset into the RQB ;;; ;;; Set-CRC-codes Calculates and sets CRC for one module and the overhead in an RQB ;;; ;;; next-nubus-crc to calculate a Nubus CRC from a previous residue and a new data byte ;;; ;;; generate-crc-for-field-in-array to calculate a Nubus CRC for a range of bytes in a byte array ;;; ;;; check-rom-crc to check the Nubus CRC for the configuration ROM in a slot ;;; ;;; translate-physical-to-logical .. for converting disk and tape unit numbers. ;;; ;;; translate-logical-to-physical ;;; The information in a Configuration Partition must conform to a standard format so ;;; that many different programs can deal with the partition. This includes not only ;;; programs in Lisp, but also Explorer microcode (in both system and Primary microcode) ;;; as well as programs running other processors, such as the S1500 ( in both System 5 and ;;; Primary 68020 code). The following describes in detail the format of first the generic ;;; Configuration Partition overhead and module sections, and then of the Explorer-1 processor ;;; specific entries in the configuration module. ;;; Note: required Explorer-1 Minimal Secondary configuration partition parameters are noted by an "*" ;;; Configuration partition overhead information: ;;; -------------------------------------------- ;;; byte bit meaning ;;; offset contents type disp. ;;; ------------------------------------------------------------------------ ;;; +000 verification value ASCII 1 char "C", required verification value ;;; +001 verification value ASCII 1 char "N", required verification value ;;; +002 verification value ASCII 1 char "F", required verification value ;;; +003 verification value ASCII 1 char "G", required verification value ;;; +004 overhead Nubus CRC LSB binary 1 char LSB of Nubus CRC calculated over bytes 006-3FF ;;; +005 overhead Nubus CRC MSB binary 1 char MSB of Nubus CRC calculated over bytes 006-3FF ;;; +006 Generation, 1st char. ASCII 1 char "*", 1st character of format generation level ;;; +007 Generation, 2nd char. ASCII 1 char "*", 2nd character of format generation level ;;; +008 Revision, 1st char. ASCII 1 char "*", 1st character of format revision level ;;; +009 Revision, 2nd char. ASCII 1 char "A", 2nd character of format revision level ;;; +00A-049 Title/Comments ASCII 64 char user entered ASCII text configuration title ;;; or comments ;;; +04A-1FF reserved binary zero filled ;;; +200-3FF Configuration module pointers of 32 bytes each ;;; Configuration module pointer format: ;;; ------------------------------------ ;;; e+00 module block offset LSB binary 1 byte LSB of module offset for this slot (in blocks) ;;; e+01 module block offset MSB binary 1 byte MSB of module offset for this slot (in blocks) ;;; e+02 module block length LSB binary 1 byte LSB of module length for this slot (in blocks) ;;; e+03 module block length MSB binary 1 byte MSB of module length for this slot (in blocks) ;;; e+04 boot timeout, LSB binary 1 byte LSB of seconds boot timeout this slot ;;; e+05 boot timeout, MLB binary 1 byte MLB of seconds boot timeout this slot ;;; e+06 boot timeout, MHB binary 1 byte MHB of seconds boot timeout this slot ;;; e+07 boot timeout, MSB binary 1 byte MSB of seconds boot timeout this slot ;;; e+08 module entries, LSB binary 1 byte LSB of number of special entries in config. module ;;; e+09 module entries, MLB binary 1 byte MLB of number of special entries in config. module ;;; e+0A module entries, MHB binary 1 byte MHB of number of special entries in config. module ;;; e+0B module entries, MSB binary 1 byte MSB of number of special entries in config. module ;;; e+0C module Nubus CRC, LSB binary 1 byte LSB of Nubus CRC for entire module for this slot ;;; e+0D module Nubus CRC, MSB binary 1 byte MSB of Nubus CRC for entire module for this slot ;;; e+0E Board type, LSB binary 1 byte Has the user type code for the board in this slot ;;; e+0F Board type, MSB binary 1 byte ;;; e+10 Slot field, LSB binary 1 byte Contains a one bit for each slot this module is for ;;; e+11 Slot field, MSB binary 1 byte Bit 0 on means this module valid for slot 0 ;;; e+12 Flags field, LSB binary 1 byte Contains various flags: ;;; e+13 Flags field, MSB binary 1 byte bit0 = 1: module for secondary, bit1 = 1: for slave. ;;; e+14-1F reserved binary zeroes ;;; Configuration Module format ;;; --------------------------- ;;; module generic section: ;;; ----------------------- ;;; m+00-03 reserved 4 bytes reserved space for busy/status word in command buffer ;;; m+04 RAM base, LSB binary 1 byte LSB of RAM base ;;; m+05 RAM base, MDL binary 1 byte MDL of RAM base ;;; m+06 RAM base, MDH binary 1 byte MDH of RAM base ;;; m+07 RAM base, MSB binary 1 byte MSB of RAM base ;;; m+08-0B reserved 4 bytes reserved space for Monitor word in command buffer ;;; m+0C-0F reserved 4 bytes reserved space for Keyboard word in command buffer ;;; m+10 Boot unit, LSB binary 1 byte LSB of Physical unit number of boot device for this processor ;;; m+11 Boot unit, MID binary 1 byte MID of Physical unit number of boot device for this processor ;;; m+12 Boot unit, LSB binary 1 byte MSB of Physical unit number of boot device for this processor ;;; m+13 Boot device slot number binary 1 byte number of Nubus slot for boot device for this processor ;;; m+14 Boot name, 1st ASCII 1 char 1st char of boot partition name for this processor ;;; m+15 Boot name, 2nd ASCII 1 char 2nd char of boot partition name for this processor ;;; m+16 Boot name, 3rd ASCII 1 char 3rd char of boot partition name for this processor ;;; m+17 Boot name, 4th ASCII 1 char 4th char of boot partition name for this processor ;;; m+18 Cfg unit, LSB binary 1 byte LSB of Physical unit number of the configuration partition ;;; m+19 Cfg unit, MID binary 1 byte MID of Physical unit number of the configuration partition ;;; m+1A Cfg unit, LSB binary 1 byte MSB of Physical unit number of the configuration partition ;;; m+1B Cfg part. slot number binary 1 byte number of Nubus slot for configuration partition ;;; m+1C Cfg name, 1st ASCII 1 char 1st char of configuration partition name for this processor ;;; m+1D Cfg name, 2nd ASCII 1 char 2nd char of configuration partition name for this processor ;;; m+1E Cfg name, 3rd ASCII 1 char 3rd char of configuration partition name for this processor ;;; m+1F Cfg name, 4th ASCII 1 char 4th char of configuration partition name for this processor ;;; m+20-23 reserved 4 bytes reserved space for Synchronization flag pointer in buffer ;;; m+24-43 Hardware identification ASCII left justified board part number with 3 character device type ;;; code appended ;;; m+44-63 Software identification ASCII left justified software identification entry ;;; Entry 0 m+64-?? HW ID ASCII N entries of exactly 32 char each containing processor specific ;;; information and parameters. ;;; Explorer-1 processor specific module entries: ;;; --------------------------------------------- ;;; Note: This format is required by the system microcode. ;;; Note: All entries must contain ASCII printable characters in all 32 positions ;;; ;;; Entry:1 m+44-63 SW ID ASCII "Explorer Processor " ;;; Entry:2 m+64-83 slots owned ASCII "Slots owned:0123456789ABCDEF " ;;; user selectable: ^^^^^^^^^^^^^^^^ ("0"-"9","A"-"F",space) ;;; Entry:3 m+84-A3 load partiton slot ASCII "Load slot :0 " ;;; user selectable: ^ ("0"-"9","A"-"F") ;;; Entry:4 m+A4-C3 load partiton phys.unit ASCII "Load unit :000000 " ;;; user selectable: ^^^^^^ ("0"-"9","A"-"F") ;;; Entry:5 m+D4-F3 load partiton name ASCII "Load name :LOD1 " ;;; user selectable: ^^^^ (any ASCII printable char, "*" in first ;;; selectable char means use default) ; ;;; 06.16.87 DAB Defconstant - LX support (Defconstant %MAX-CFG-SLOTS 16) ; Maximum number of slots. (Defconstant %CFG-MODULE-START #x00) ; Overhead block offset (Defconstant %CFG-MODULE-LENGTH #x02) ; Overhead block offset ;; Partition Constants; (Defconstant %CFG-PARTITION-NAME-LENGTH #x04) ; Size of partition name ;; Config ROM constants; (Defconstant CROMO-CPU-TYPE-OFFSET (+ CROMO-BOARD-TYPE-OFFSET-NAME (Ash 6 2))) ;;; overhead block constants (defparameter cfg-generation "**") (defparameter cfg-revision "*A") (defparameter %CFG-Overhead-CRC-Start-Index 6.) (defparameter %CFG-Overhead-CRC-Length 1018.) (defparameter %CFG-BASE 0) (defparameter %CFG-OVERHEAD-CRC #x04) (defparameter %CFG-GENERATION #x06) (defparameter %CFG-REVISION #x08) (defparameter %CFG-TITLE #x0A) (defparameter %CFG-SLOT-LIST-OFFSET #x200) ;;; overhead block slot list constants (defparameter %CFG-SLOT-LIST-ENTRY-SIZE 32.) (defparameter %CFG-BOOT-TIMEOUT-OFFSET #x04) (defparameter %CFG-NUMBER-ENTRIES-OFFSET #x08) (defparameter %CFG-MODULE-CRC #x0C) (defparameter %CFG-BOARD-TYPE #x0E) (defparameter %CFG-MODULE-SLOTS #x10) (defparameter %CFG-MODULE-FLAGS #x12) ;;; module constants (defparameter %CFG-MODULE-TEXT-SIZE 32.) (defparameter %CFG-RAM-BASE-OFFSET #x04) (defparameter %CFG-BOOT-DEVICE-OFFSET #x10) (defparameter %CFG-BOOT-PARTITION-NAME-OFFSET #x14) (defparameter %CFG-CFG-PARTITION-NAME-OFFSET #x1C) (defparameter %CFG-MODULE-TEXT-ENTRIES-OFFSET #x24) (defparameter *MAX-CFG-SIZE* 17.) ;;; Entry information by entry number N (defparameter %CFG-PART-NUMBER-ENTRY 0) ;generic (defparameter %CFG-SW-ID-ENTRY 1) ;The rest are Explorer CPU specific (defparameter %CFG-SLOTS-OWNED-ENTRY 2) (defparameter %CFG-LOAD-PARTITION-SLOT-ENTRY 3) (defparameter %CFG-LOAD-PARTITION-UNIT-ENTRY 4) (defparameter %CFG-LOAD-PARTITION-NAME-ENTRY 5) (defparameter %CFG-PAGE-PARTITION-SLOT-ENTRY 6) ; jlm 2-27-89 (defparameter %CFG-PAGE-PARTITION-UNIT-ENTRY 7) (defparameter %CFG-PAGE-PARTITION-NAME-ENTRY 8) (defparameter %CFG-FILE-PARTITION-SLOT-ENTRY 9) (defparameter %CFG-FILE-PARTITION-UNIT-ENTRY 10) (defparameter %CFG-FILE-PARTITION-NAME-ENTRY 11) (defparameter %CFG-HOST-NAME-ENTRY 12) (defvar *CFG-controlled-partition-types-alist* `((,%BT-FILE-BAND "File") (,%BT-PAGE-BAND "Page")) ;07-27-87 DAB "Configuration partition controlled partition types for multiple processors.") (Defmacro MODULE-BLOCK-OFFSET (Pointer) "Accessor for Block-Offset value in POINTER." `(dpb (char-int (aref ,Pointer (+ %CFG-MODULE-START 1))) (byte 8 8) (char-int (aref ,Pointer %CFG-MODULE-START)))) (Defmacro MODULE-BLOCK-LENGTH (Pointer) "Accessor for Block-Length value in POINTER." `(dpb (char-int (aref ,Pointer (+ %CFG-MODULE-LENGTH 1))) (byte 8 8) (char-int (aref ,Pointer %CFG-MODULE-LENGTH)))) (Defmacro MODULE-ENTRIES (Pointer) "Accessor for Module-Entries value in POINTER." `(dpb (char-int (aref ,Pointer (+ %CFG-NUMBER-ENTRIES-OFFSET 3))) (byte 8 24) (dpb (char-int (aref ,Pointer (+ %CFG-NUMBER-ENTRIES-OFFSET 2))) (byte 8 16) (dpb (char-int (aref ,Pointer (+ %CFG-NUMBER-ENTRIES-OFFSET 1))) (byte 8 8) (char-int (aref ,Pointer %CFG-NUMBER-ENTRIES-OFFSET)))))) (Defmacro MODULE-BOARD-TYPE (Pointer) "Accessor for Board-Type value in POINTER." `(dpb (char-int (aref ,Pointer (+ %CFG-BOARD-TYPE 1))) (byte 8 8) (char-int (aref ,Pointer %CFG-BOARD-TYPE)))) (Defmacro MODULE-SLOT-FIELD (Pointer) "Accessor for Module-Slot field value in POINTER." `(dpb (char-int (aref ,Pointer (+ %CFG-MODULE-SLOTS 1))) (byte 8 8) (char-int (aref ,Pointer %CFG-MODULE-SLOTS)))) (Defmacro MODULE-ENTRY-START (Entry) "Returns a pointer to the element within the configuration module corresponding to the start of ENTRY." `(+ %CFG-MODULE-TEXT-ENTRIES-OFFSET (* ,Entry %CFG-MODULE-TEXT-SIZE)) ) ; Module-Entry-Start (Defmacro MODULE-ENTRY-END (Entry) "Returns a pointer to the element within the configuration module corresponding to the end of ENTRY." `(+ %CFG-MODULE-TEXT-SIZE (Module-Entry-Start ,Entry)) ) ; Module-Entry-End (Defmacro SEARCH-MODULE-ENTRY (Module Entry String) "Searches MODULE in ENTRY for STRING and returns its location within the module if found" `(Search ,String ,Module :Test 'String-Equal :Start2 (Module-Entry-Start ,Entry) :End2 (Module-Entry-End ,Entry)) ) ; Search-Module-Entry (Defmacro SEARCH-MODULE-ENTRIES (Module String) "Searches all entries in MODULE for STRING and returns its location within the module if found" `(Search ,String ,Module :Test 'String-Equal :Start2 (Module-Entry-Start 0)) ) ; Search-Module-Entries (Defun CROM-CPU-TYPE () ;06.16.87 DAB "Returns the CPU type for this processor as read from the configuration ROM." (Dpb (%Nubus-Read-8b-Careful PROCESSOR-SLOT-NUMBER (+ CROMO-CPU-TYPE-OFFSET 4)) (Byte 8 8) (%Nubus-Read-8b-Careful PROCESSOR-SLOT-NUMBER CROMO-CPU-TYPE-OFFSET))) (Defun GET-MODULE-POINTER (&Optional ; jlm 2-27-89 (Config (si:Get-Configuration)) (Cpu-SLot (Ldb (Byte 4 0) (system-communication-area %SYS-COM-PROCESSOR-SLOT)))) "Searches CONFIG string for the module pointer designated for this processor. The first pointer with an Explorer board-type and Module-Slots turned on for this slot is returned as a string. Nil is returned if the pointer could not be found." (Let ((Cpu-Type (Crom-Cpu-Type)) Pointer slot-val) (When Config (setq slot-val (Block Find-Pointer (Dotimes (Slot %MAX-CFG-SLOTS) (Let* ((Start (+ %CFG-SLOT-LIST-OFFSET (* Slot %CFG-SLOT-LIST-ENTRY-SIZE))) (End (+ Start %CFG-SLOT-LIST-ENTRY-SIZE))) (Setf Pointer (Nsubstring Config Start End)) ;; See if the Board type matches and if our slot ;; is turned on in this module (note that this slot ;; dispatching has different meaning from that ;; used with %Slots-I-Own): (When (And (Eq Cpu-Type (Module-Board-Type Pointer)) (Logbitp Cpu-Slot (Module-Slot-Field Pointer))) ;; We qualify for this module, so return its pointer as ;; a displaced 8-bit array substring: (Return-From Find-Pointer slot) ) ; when ) ; let ) ; dotimes )) ; Find-Pointer ) ; when Config (values Pointer slot-val) ) ; Let ) (DEFUN READ-CFG-PARTITION (cfg-name &optional (unit *default-disk-unit*) (ignore-old-garbage nil) (confirm-read t) &aux rqb user-type) ;03.20.87 DAB "Allocate an RQB and read a configuration partition CFG-NAME into it from UNIT and then returns the rqb." (setf (values nil user-type) (parse-partition-name cfg-name)) ;03.20.87 DAB (unless user-type ;03.20.87 DAB (setf cfg-name (string-append cfg-name "." "GEN"))) ;Look for CPU type of GENERIC (multiple-value-bind (start-block length-blocks) (find-disk-partition cfg-name nil unit nil nil confirm-read ;03.20.87 DAB :attribute %BT-Configuration-Band) (if start-block ;03.25.87 DAB FIND-disk-partition return t as the second arg if not found. Test first arg. (progn ; found the partition (setf rqb (get-disk-rqb length-blocks)) (DISK-READ rqb UNIT start-block length-blocks) ; Continue only if this looks like a valid configuration partition. (if (or ignore-old-garbage (And (String-Equal (Get-disk-String-byte-addr RQB %CFG-BASE 4.) "CNFG") (String-Equal ;when generation is different we're broke (Get-disk-String-byte-addr RQB %CFG-GENERATION 2.) CFG-GENERATION) (String<= CFG-REVISION (Get-disk-String-byte-addr RQB %CFG-REVISION 2.)))) rqb ; else, invalid config partition (ferror :invalid-partition "~%~a is not a valid configuration partition" cfg-name))) ; else, failed to find partition (ferror :partition-not-found "~%Could not find configuration partition ~a on unit ~d" cfg-name unit)))) ;;; Be sure your check sums are calculated before calling this... ;;; (defun write-cfg-partition (rqb cfg-name &optional (unit *default-disk-unit*) (confirm-read t)) ;03.20.87 DAB "Writes the content of RQB to the configuration partition CFG-NAME on UNIT." (OR (STRING-EQUAL (GET-DISK-STRING RQB 0 4) "CNFG") (ferror :invalid-partition "~%Attempt to write garbage configuration partition")) (let (user-type) (setf (values nil user-type) (parse-partition-name cfg-name)) ;03.20.87 DAB (unless user-type ;03.20.87 DAB (setf cfg-name (string-append cfg-name "." "GEN"))) ;Look for CPU type of GENERIC (multiple-value-bind (start-block length-blocks) (find-disk-partition cfg-name nil unit nil nil confirm-read ;03.20.87 DAB :attribute %BT-Configuration-Band) (when start-block ;03.25.87 DAB Did I find the right partition? (disk-write rqb unit start-block (min (rqb-npages rqb) length-blocks)))))) (defun PRINT-CFG-PARTITION (&optional cfg-name unit (stream *standard-output*)) "Prints the contents of the configuration partition CFG-NAME of UNIT to STREAM. If no arguments, then the default configuration partition is displayed." (unless cfg-name (multiple-value-setq (cfg-name unit) (find-default-cfg unit))) ;;if unit is still unspecified, guess. (unless unit (setq unit (sys:nvram-default-unit))) (with-rqb (rqb (read-cfg-partition cfg-name unit)) (when rqb (format-cfg-partition-from-rqb rqb cfg-name stream))) T) (defun SHOW-CFG-SUMMARY (&optional cfg-name unit (stream *standard-output*)) "Displays a summary of the modules in a configuration partition CFG-NAME of UNIT to STREAM. If no arguments, then the default configuration partition is displayed." (unless cfg-name (multiple-value-setq (cfg-name unit) (find-default-cfg unit))) ;;if unit is still unspecified, guess. (unless unit (setq unit (sys:nvram-default-unit))) (with-rqb (rqb (read-cfg-partition cfg-name unit)) (when rqb (format-cfg-summary-from-rqb rqb cfg-name stream))) T) (Defun GET-CONFIG-MODULE (&Optional (Config (Get-Configuration)) (Pointer (Get-Module-Pointer Config))) "Searches CONFIG string for the module designated for this processor. The first module with a pointer having this CPU board-type and Module-Slots turned on for this slot is returned as a string. If the config module could not be found, Nil is returned." (When (And Config Pointer) (Let* ((Start (* DISK-BLOCK-BYTE-SIZE ; jlm 3/09/89 (Module-Block-Offset Pointer))) (End (+ Start (* DISK-BLOCK-BYTE-SIZE ; jlm 3/09/89 (Module-Block-Length Pointer))))) (Nsubstring Config Start End) ) ; let ) ; when ) (Defun READ-MODULE-ENTRY (Module Entry Label) "Returns the value string for LABEL from configuration module string MODULE starting at index ENTRY. LABEL is a string like 'Unit', 'Name', 'Slot', or 'Slots' that precedes the colon." (Let (Data-Start Data-Position Label-Position (Data-End (Module-Entry-End Entry))) (When (Setf Data-Start (When (Setf Data-Position (When (Setf Label-Position (Search-Module-Entry Module Entry Label) ) ; label-position (Position #\: Module :Start Label-Position :End Data-End) ) ; when label-position ) ; data-position (+ 1 Data-Position) ) ; when data-position ) ; data-start (Nsubstring Module Data-Start Data-End) ) ; when data-start ) ; let ) (Defun FIND-MODULE-FROM-RQB (rqb &optional &key pn type entry-number Chassis-slots) "Perform search based on keywords: PN Part Number found in Module entry 0 (ascii string) TYPE Controlled board type found in Module Pointer. This can be a number or a valid user/cpu extension. ENTRY-NUMBER Module Pointer Entry number CHASSIS-SLOTS Chassis Slots this module is valid for. Keywords omitted makes that field a don't care. When a match occurs returns module pointer entry, block number, length of the module and board type, otherwise NIL." ;03.25.87 DAB (setf type (select-user-type type)) ;03.25.87 DAB Allows user to use cpu extensions. (unless (or pn type entry-number chassis-slots) (return-from find-module-from-rqb nil)) (dotimes (slot-index 16.) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (ldb (byte 16. 16.) start-and-length)) (block-start (ldb (byte 16. 0) start-and-length)) (temp (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-SLOTS) 4.))) (module-slots (ldb (byte 16. 0) temp)) (board-type (ldb (byte 16. 16.) (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-CRC) 4.)))) done) (unless (zerop block-length) (setf done (and (cond (pn (string-equal pn (access-entry rqb slot-index %CFG-PART-NUMBER-ENTRY))) ;04.23.87 DAB (T T)) (cond (type (equal type board-type)) (T T)) (cond (entry-number (equal entry-number slot-index)) (T T)) (cond (chassis-slots (not (zerop (logand chassis-slots module-slots)))) (T T))))) (when done (return (values slot-index block-start block-length board-type)))))) ;06.12.87 DAB (defun mp-slot-use (rqb entry) (ldb (byte 16. 0) (get-disk-fixnum rqb (/ (+ (+ %CFG-SLOT-LIST-OFFSET (* entry %CFG-SLOT-LIST-ENTRY-SIZE)) %CFG-MODULE-SLOTS) 4.)))) (defun mp-type (rqb entry) (ldb (byte 16. 16.) (get-disk-fixnum rqb (/ (+ (+ %CFG-SLOT-LIST-OFFSET (* entry %CFG-SLOT-LIST-ENTRY-SIZE)) %CFG-MODULE-CRC) 4.)))) ;;; Returns NIL if entry number is not valid for the module. ;;; If NEW-VALUE then put it in the entry field.. should be "prompt :value" ;;; Return value of an entry at module represented by module pointer number. (defun access-entry (rqb module-pointer entry-number &optional New-Value) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* module-pointer %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-number (ldb (byte 16. 0) start-and-length)) (number-entries (get-disk-fixnum rqb (/ (+ slot-base %CFG-NUMBER-ENTRIES-OFFSET) 4.)))) (if (or (minusp entry-number) (> (1+ entry-number) number-entries)) ;not that many entries NIL (if new-value (put-entry-by-block rqb block-number entry-number new-value) (get-entry-by-block rqb block-number entry-number))))) (defun PUT-entry-by-block (rqb block-number entry-number new-value) (PUT-disk-string-byte-addr rqb new-value (+ (* block-number 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* entry-number %CFG-MODULE-TEXT-SIZE)) %CFG-MODULE-TEXT-SIZE)) (defun get-entry-by-block (rqb block-number entry-number) (Get-disk-string-byte-addr rqb (+ (* block-number 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* entry-number %CFG-MODULE-TEXT-SIZE)) %CFG-MODULE-TEXT-SIZE)) (defun Find-a-new-Module (rqb length) "Looks in cfg rqb for a free entry and module space of LENGTH and returns the ENTRY-NUMBER and MODULE-START-BLOCK or NIL if failed." (let (free-slot used-blocks start-block) (dotimes (slot-index 16.) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (ldb (byte 16. 16.) start-and-length)) (block-number (ldb (byte 16. 0) start-and-length))) (if (zerop block-number) (unless free-slot (setf free-slot slot-index)) ;Found a free Module entry (setf used-blocks ;list of block numbers that are in use (union used-blocks (let (used) (dotimes (i block-length) ;Look for rest of blocks used (setf used (cons (+ i block-number) used))) used)))))) (setf start-block (find-a-hole length used-blocks)) (if (and free-slot start-block) (values free-slot start-block)))) ;;; Find a hole LENGTH can fit in and return its first block # (defun find-a-hole (length used-blocks) (setf used-blocks (sort used-blocks #'<)) (unless (zerop (car used-blocks)) (push 0 used-blocks)) (dotimes (i (length used-blocks)) (let ((next-used (or (nth (1+ i) used-blocks) *MAX-CFG-SIZE*)) (this-used (nth i used-blocks))) (when (> (- next-used this-used) length) ;look for a big enuf hole (return-from find-a-hole (1+ this-used)))))) (defun copy-mp-entry (from-rqb from-slot to-rqb to-slot) (let* ((from-slot-base (+ %CFG-SLOT-LIST-OFFSET (* from-slot %CFG-SLOT-LIST-ENTRY-SIZE))) (to-slot-base (+ %CFG-SLOT-LIST-OFFSET (* to-slot %CFG-SLOT-LIST-ENTRY-SIZE)))) (COPY-ARRAY-PORTION (RQB-8-BIT-BUFFER FROM-RQB) from-slot-base (+ from-slot-base %CFG-SLOT-LIST-ENTRY-SIZE) (RQB-8-BIT-BUFFER TO-RQB) to-slot-base (+ to-slot-base %CFG-SLOT-LIST-ENTRY-SIZE)))) (defun copy-module-data (from-rqb from-start-block from-block-length to-rqb to-start-block) (let* ((from-module-base (* from-start-block 1024.)) (to-module-base (* to-start-block 1024.)) (from-length (* from-block-length 1024.))) (COPY-ARRAY-PORTION (RQB-8-BIT-BUFFER FROM-RQB) from-module-base (+ from-module-base from-length) (RQB-8-BIT-BUFFER TO-RQB) to-module-base (+ to-module-base from-length)))) (defun COPY-CFG-MODULE (from-band from-unit to-band to-unit &key pn type) "Find the module which matches PN (ascii part-number) and/or TYPE, the cpu type, in FROM-BAND on FROM-UNIT and copy into TO-BAND on TO-UNIT." (setq type (select-user-type type)) ;03.25.87 DAB Allows users to user cpu extension,instead of numbers. (with-rqb (from-rqb (READ-CFG-PARTITION from-band from-unit)) (multiple-value-bind (from-slot from-start from-length) (find-module-from-rqb from-rqb :pn pn :type type) (unless from-slot (ferror :cfg-module-not-found "Source module not found in ~a on unit ~a" from-band from-unit)) (with-rqb (to-rqb (READ-CFG-PARTITION to-band to-unit)) (let ((from-type (mp-type from-rqb from-slot))) ;Guarantee Slot-Use-Integrity-check by looking for from-type only (multiple-value-bind (to-slot to-start) (find-module-from-rqb to-rqb :type from-type) (if to-slot (progn ;module already exist: prompt for replace (format-cfg-module-pointer to-rqb to-slot *standard-output*) (format-cfg-module to-rqb to-slot *standard-output*) (unless (yes-or-no-p "~&Module already exist. Replace it?") (format *standard-output* "~&Module not copied.") (return-from copy-cfg-module NIL))) (multiple-value-setq (to-slot to-start) (Find-a-new-Module to-rqb from-length))) (copy-mp-entry from-rqb from-slot to-rqb to-slot) (let ((slot-base (/ (+ %CFG-SLOT-LIST-OFFSET (* to-slot %CFG-SLOT-LIST-ENTRY-SIZE)) 4.))) (put-disk-fixnum to-rqb ;Point at module's start block in target config band. (dpb to-start (byte 16. 0) (get-disk-fixnum to-rqb slot-base)) slot-base)) (copy-module-data from-rqb from-start from-length to-rqb to-start) (set-crc-codes to-rqb to-slot))) (write-CFG-PARTITION to-rqb to-band to-unit)))) T) (defun format-cfg-module-pointer (rqb slot-index stream) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (ldb (byte 16. 16.) start-and-length)) (block-number (ldb (byte 16. 0) start-and-length)) (boot-timeout (get-disk-fixnum rqb (/ (+ slot-base %CFG-BOOT-TIMEOUT-OFFSET) 4.))) (number-entries (get-disk-fixnum rqb (/ (+ slot-base %CFG-NUMBER-ENTRIES-OFFSET) 4.))) (board-type (ldb (byte 16. 16.) (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-CRC) 4.)))) (temp (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-SLOTS) 4.))) (module-slots (ldb (byte 16. 0) temp)) (module-flags (ldb (byte 16. 16.) temp))) (unless (zerop block-length) (format stream "~%~% Module Pointer # (decimal) = <~d>" slot-index) (format stream "~% Module Offset (decimal) = <~d> block~:p" block-number) (format stream "~% Module Length (decimal) = <~d> block~:p" block-length) (format stream "~% Boot Timeout (decimal) = <~d> second~:p" boot-timeout) (format stream "~% # Module Entries (decimal) = <~d> entr~:@p" number-entries) (format stream "~% Board Type (hex) = <~x>" board-type) (format stream "~% Module Slots (hex) = <~x>" module-slots) (format stream "~% Module Flags (hex) = <~x>" module-flags)))) (defun format-cfg-module (rqb slot-index stream &optional module-list) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (* (ldb (byte 16. 16.) start-and-length) 1024.)) (block-start (* (ldb (byte 16. 0) start-and-length) 1024.)) (number-entries (get-disk-fixnum rqb (/ (+ slot-base %CFG-NUMBER-ENTRIES-OFFSET) 4.)))) (unless (zerop block-length) (unless (member block-start module-list) ; Format each configuration module only once (setq module-list (cons block-start module-list)) (format stream "~%~% Configuration Module with Offset = <~d> block~:p" (/ block-start 1024.)) (format stream "~% RAM Base (hex) = <~x>" (get-disk-fixnum rqb (/ (+ block-start %CFG-RAM-BASE-OFFSET) 4.))) (let ((slot-and-unit (get-disk-fixnum rqb (/ (+ block-start %CFG-BOOT-DEVICE-OFFSET) 4.))) boot-slot boot-unit) (setf boot-slot (ldb (byte 8. 24.) slot-and-unit) boot-unit (ldb (byte 24. 0) slot-and-unit)) (if (or (= boot-slot #xFF) ;both values are WILD ;06.12.87 DAB (= boot-unit #xFFFFFF)) ;both values are WILD (setf boot-slot #\* boot-unit #\*) (setf boot-slot (ldb (byte 8. 24.) slot-and-unit) boot-unit (ldb (byte 24. 0) slot-and-unit))) (format stream "~% Boot Partition Slot (decimal) = <~d>" boot-slot) (format stream "~% Boot Partition Unit (decimal) = <~d>" boot-unit)) (format stream "~% Boot Partition Name (text) = <~a>" (Get-disk-string-byte-addr rqb (+ block-start %CFG-BOOT-PARTITION-NAME-OFFSET) 4.)) (setf block-start (/ block-start 1024.)) (dotimes (entry-index number-entries) (format stream "~% Entry ~3d (text) = <~a>" entry-index (get-entry-by-block rqb block-start entry-index) ))))) module-list) (Defun FORMAT-CFG-PARTITION-FROM-RQB (rqb cfg &optional (stream *standard-output*)) "Extracts configuration band information from RQB (previously read) and prints it with labels for the various fields to STREAM" (Terpri stream) (format stream "~%CONFIGURATION PARTITION OVERHEAD FOR \"~a\"" cfg) (format stream "~%~% Title (text) = <~a>" (Get-disk-string-byte-addr rqb %CFG-TITLE 64.)) (Format stream "~% Generation (text) = <~a>~% Revision (text) = <~a>" (Get-disk-String-byte-addr rqb %CFG-GENERATION 2.) (Get-disk-String-byte-addr rqb %CFG-REVISION 2.)) ;; Format slot table (format stream "~%~%CONFIGURATION MODULE POINTERS") ;; The configuration module pointers reside in the disk config-partition buffer starting ;; at address #x200 (dotimes (slot-index 16.) (format-cfg-module-pointer rqb slot-index stream)) ;; Format configuration modules (let ((module-list nil)) (format stream "~%~%CONFIGURATION MODULES") (dotimes (slot-index 16.) (setf module-list (format-cfg-module rqb slot-index stream module-list))))) (defun FORMAT-CFG-SUMMARY-FROM-RQB (rqb name &optional (stream *standard-output*)) "Extracts configuration band information and just prints a summary of the fields to STREAM." (Terpri stream) (format stream "~%CONFIGURATION PARTITION SUMMARY FOR \"~a\" " name) (format stream "~%~% Title : ~a" (Get-disk-string-byte-addr rqb %CFG-TITLE 64.)) (dotimes (slot-index 16.) (let* ((slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (* (ldb (byte 16. 16.) start-and-length) 1024.)) (block-start (* (ldb (byte 16. 0) start-and-length) 1024.)) (number-entries (get-disk-fixnum rqb (/ (+ slot-base %CFG-NUMBER-ENTRIES-OFFSET) 4.))) (board-type (ldb (byte 16. 16.) (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-CRC) 4.)))) (temp (get-disk-fixnum rqb (/ (+ slot-base %CFG-MODULE-SLOTS) 4.))) (module-slots (ldb (byte 16. 0) temp)) (module-flags (ldb (byte 16. 16.) temp)) (slot-and-unit (get-disk-fixnum rqb (/ (+ block-start %CFG-BOOT-DEVICE-OFFSET) 4.))) (boot-name (Get-disk-string-byte-addr rqb (+ block-start %CFG-BOOT-PARTITION-NAME-OFFSET) 4.)) (entry-start (/ block-start 1024)) (pn (get-entry-by-block rqb entry-start 0)) boot-slot boot-unit load-unit page-unit ; DAB 01-16-89 file-unit ; DAB 01-16-89 host-name ; DAB 01-16-89 ) (unless (zerop block-length) (format stream "~%~% Module Number : ~d" slot-index) (format stream "~% Board Type : ~d" board-type) (when (member board-type (list %cpu-explorer %cpu-ti-explorer-II)) (format stream " Explorer") (when (= board-type %cpu-ti-explorer-II) (format stream " II"))) (format stream "~% Part Number : ~a" pn) (format stream "~% Applies to ~a in ~a." (case module-flags (1 "a bootable processor") (2 "a slave device")) (case module-slots (#xFFFF "any slot") (#x40 "slot 6") (otherwise (format nil "slots ~d" module-slots)))) ;;; If either of these fields is Fs then both values are wild. 6.3.87 (setf boot-slot (ldb (byte 8. 24.) slot-and-unit) boot-unit (ldb (byte 24. 0) slot-and-unit)) (if (or (= boot-slot #xFF) (= boot-unit #xFFFFFF)) (setf boot-slot #\* boot-unit #\*)) ;6.3.87 (format stream "~% Boot Partition Slot : ~a" boot-slot) (format stream "~% Boot Partition Unit : ~a" boot-unit) (format stream "~% Boot Partition Name : ~a" (if (string-equal boot-name "") "uses default" boot-name)) (when (and (member board-type (list %cpu-explorer %cpu-ti-explorer-II)) ;Explorer cpu module (>= number-entries 6)) (when (numberp (setq load-unit (parse-entry (get-entry-by-block rqb entry-start %CFG-LOAD-PARTITION-UNIT-ENTRY)))) (setq load-unit (translate-physical-to-logical load-unit)) (format stream "~% Load Partition Slot : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-LOAD-PARTITION-SLOT-ENTRY))) (format stream "~% Load Partition Unit : ~a" load-unit) (format stream "~% Load Partition Name : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-LOAD-PARTITION-NAME-ENTRY)))) (when (numberp ; DAB 01-16-89 Support MX CFGs (setq page-unit (parse-entry (get-entry-by-block rqb entry-start %CFG-PAGE-PARTITION-UNIT-ENTRY)))) (format stream "~% Page Partition Slot : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-PAGE-PARTITION-SLOT-ENTRY))) (format stream "~% Page Partition Unit : ~a" Page-unit) (format stream "~% Page Partition Name : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-PAGE-PARTITION-NAME-ENTRY)))) (when (numberp ; DAB 01-16-89 Support MX CFGs (setq file-unit (parse-entry (get-entry-by-block rqb entry-start %CFG-FILE-PARTITION-UNIT-ENTRY)))) (format stream "~% File Partition Slot : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-FILE-PARTITION-SLOT-ENTRY))) (format stream "~% File Partition Unit : ~a" File-unit) (format stream "~% File Partition Name : ~a" (parse-entry (get-entry-by-block rqb entry-start %CFG-FILE-PARTITION-NAME-ENTRY)))) (when (stringp ; DAB 01-16-89 Support MX CFGs (setq host-name (parse-entry (get-entry-by-block rqb entry-start %CFG-HOST-NAME-ENTRY)))) (format stream "~% Host Name : ~a" host-name)) ))))) (defun Get-Cfg-Boot-Data (&optional (cfg-band (find-default-cfg)) (cfg-unit (nvram-default-unit)) (module-number nil)) ;06.12.87 DAB "... Return boot partition name, unit, and slot for module number MODULE-NUMBER. If MODULE-NUMBER is nil the first module of a board type equal to the current processor is selected. If slot and unit are wild, the character * is returned for each." (let (user-type (select-type (cpu-type))) (when (and module-number (not (numberp module-number))) ;06.12.87 DAB (setf module-number nil)) (when module-number (setf select-type nil)) (setf (values nil user-type) (parse-partition-name cfg-band)) ;03.20.87 DAB (unless user-type (setq cfg-band (string-append cfg-band "." "gen"))) ;03.25.87 DAB (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (multiple-value-bind (MP-number block-number) (find-module-from-rqb rqb :type select-type :entry-number module-number) ;06.12.87 DAB (unless mp-number (let ((error-string (format nil "Give up on reading the config band ~a" cfg-band))) ;09-10-87 DAB (unless ;04.01.87 DAB (cerror error-string "A configuration module for ~a not found in partition ~a on unit ~a." (select user-type (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor") (otherwise (format nil "type ~a " user-type))) cfg-band cfg-unit) (return-from Get-Cfg-boot-Data nil nil nil))) ) (let* ((block-start (* block-number 1024.)) (slot-and-unit (get-disk-fixnum rqb (/ (+ block-start %CFG-BOOT-DEVICE-OFFSET) 4.))) (boot-band (string-append (Get-disk-string-byte-addr rqb (+ block-start %CFG-BOOT-PARTITION-NAME-OFFSET) 4.) "." (keyword-user-type (cpu-type)))) ;03.26.87 DAB boot-slot boot-unit) (setf boot-slot (ldb (byte 8. 24.) slot-and-unit) boot-unit (ldb (byte 24. 0) slot-and-unit)) (if (or (= boot-slot #xFF) ;both values are WILD (= boot-unit #xFFFFFF)) ;both values are WILD (setf boot-slot "*" boot-unit "*") (setf boot-slot (ldb (byte 8. 24.) slot-and-unit) boot-unit (ldb (byte 24. 0) slot-and-unit))) (values boot-band boot-unit boot-slot)) ))) ) (defun Set-Cfg-Boot-Data (cfg-band cfg-unit &key boot-unit boot-slot boot-name (user-type (cpu-type)) (module-number nil)) "Sets the microcode boot name, slot, and unit in the configuration band CFG-BAND on unit CFG-UNIT. BOOT-NAME can be a string or a symbol. BOOT-UNIT should be a logical unit number. The module number can be selected by entering USER-TYPE or MODULE-NUMBER. Returns T." (unless (and cfg-unit (numberp cfg-unit)) ;03-25-88 DAB (setq cfg-unit (nvram-default-unit))) (unless cfg-band ;03-25-88 DAB (setq cfg-band (find-cfg-band cfg-unit))) ;03-25-88 DAB (check-boot-name-for-wild boot-name) (when (and module-number (not (numberp module-number))) ;06.12.87 DAB (setf module-number nil)) (when module-number (setf user-type nil)) ;06.12.87 DAB (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (setq user-type (select-user-type user-type)) ;03.25.87 DAB Allows cpu extensions (multiple-value-bind (MP-number block-number nil) (find-module-from-rqb rqb :type user-type :entry-number module-number) ;06.12.87 DAB (unless mp-number (ferror :cfg-module-not-found "A configuration module for ~a not found in partition ~a on unit ~a." (select user-type (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor") (otherwise (format nil "type ~a " user-type))) cfg-band cfg-unit)) (let* ((block-start (* block-number 1024.)) (old-slot-and-unit (get-disk-fixnum rqb (/ (+ block-start %CFG-BOOT-DEVICE-OFFSET) 4.))) old-boot-slot old-boot-unit) (when (or boot-slot boot-unit) (setf old-boot-slot (ldb (byte 8. 24.) old-slot-and-unit) old-boot-unit (ldb (byte 24. 0) old-slot-and-unit)) ;mrr3.16.87 (when (and (stringp boot-unit) (not (equal (string boot-slot) "*")) (numberp (read-from-string boot-unit))) (setq boot-unit (read-from-string boot-unit))) (put-disk-fixnum rqb (merge-boot-slot-and-unit boot-slot boot-unit old-boot-slot old-boot-unit) (/ (+ block-start %CFG-BOOT-DEVICE-OFFSET) 4.))) (when boot-name (setq boot-name (IF *PARTITION-NAME-CASE-SENSITIVE* (STRING boot-name) (STRING-UPCASE (STRING boot-name)))) (Put-disk-string-byte-addr rqb (pad-string (parse-partition-name boot-name) #\space 4) ;06.12.87 DAB (+ block-start %CFG-BOOT-PARTITION-NAME-OFFSET) 4.))) (set-crc-codes rqb mp-number) (write-CFG-PARTITION rqb cfg-band cfg-unit))) T) ;;; Since PRIM by definition is the default mcr, putting wild in the cfg module ;;; will be a BIG loser (unless the cfg band is on a different unit than the mcr.) ;;; (defun check-boot-name-for-wild (arg) (unless (cond ((stringp arg) (if (string-equal "*" arg :end2 1) nil T)) ((characterp arg) (if (char-equal #\* arg) nil T)) (T T)) (ferror :invalid-name "Microcode name cannot be wild."))) (defun merge-boot-slot-and-unit (boot-slot boot-unit old-boot-slot old-boot-unit) (let (slot-and-unit) (cond ((or (stringp boot-slot) (characterp boot-slot)) (if (equal (string boot-slot) "*") (setf slot-and-unit #xFFFFFFFF) (merge-boot-error boot-slot))) ((or (stringp boot-unit) (characterp boot-unit)) (if (equal (string boot-unit) "*") (setf slot-and-unit #xFFFFFFFF) (merge-boot-error boot-unit))) (T (when (and boot-unit (null boot-slot)) ;mrr 3.17.87 Try to get the slot number from the unit. (setq boot-slot (get-device-slot-number boot-unit))) (when (and (or (null boot-slot) (null boot-unit)) (= old-boot-slot #xff)) (ferror nil "Since old boot slot and unit were wild, both slot and unit must be specified.")) (setf slot-and-unit (dpb (or boot-slot old-boot-slot) (byte 8. 24.) (or boot-unit old-boot-unit))))))) (defun merge-boot-error (slot-or-unit) (ferror :invalid-device "Slot or unit, ~a, is invalid. Must be a number or \"*\"." slot-or-unit)) (defun Get-Cfg-load-Data (&optional (cfg-band (find-default-cfg)) (cfg-unit (nvram-default-unit)) (module-number nil)) "... Return load partition name, unit, and slot for module number MODULE-NUMBER. If MODULE-NUMBER is nill, the first module number of the current processor type is selected. If slot and unit are wild, the character * is returned for each" (let (user-type (select-type (cpu-type))) (when (and module-number (not (numberp module-number))) ;06.12.87 DAB (setf module-number nil)) (when module-number (setf select-type nil)) ;06.12.87 DAB (setf (values nil user-type) (parse-partition-name cfg-band)) ;03.20.87 DAB (unless user-type ;03.20.87 DAB (setf cfg-band (string-append cfg-band "." "GEN"))) ;Look for CPU type of GENERIC (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (multiple-value-bind (MP-number nil nil) ;block-number block-length) (find-module-from-rqb rqb :TYPE select-type :entry-number module-number) ;06.12.87 DAB (unless mp-number (cerror "Give up on reading the config band ~a" "A configuration module for ~a not found in partition ~a on unit ~a." cfg-band (select (cpu-type) (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor") (otherwise (format nil "type ~a " (cpu-type)))) cfg-band cfg-unit)) ;04.01.87 DAB (let* ((load-slot (access-entry rqb mp-number %CFG-LOAD-PARTITION-SLOT-ENTRY)) (load-unit (access-entry rqb mp-number %CFG-LOAD-PARTITION-UNIT-ENTRY)) (load-name (access-entry rqb mp-number %CFG-LOAD-PARTITION-NAME-ENTRY))) ;04.23.87 DAB (values (parse-entry load-name) (if (string-equal "*" (parse-entry load-unit)) "*" (translate-physical-to-logical (parse-entry load-unit))) (parse-entry load-slot))) ))) ) (defun Set-Cfg-Load-Data (cfg-band cfg-unit &key load-unit load-slot load-name (user-type (cpu-type)) (module-number nil)) "Sets the load name, unit, and slot in module number MODULE-NUMBER or first occurrence of USER-TYPE in the configuration band CFG-BAND which is on unit CFG-UNIT. LOAD-NAME can be a string or a symbol. LOAD-UNIT should be a logical unit number --in it is translated to a physical unit number when it is stored in the CFG-BAND,-- or it may be wild, *. The CPU type is calculated from the environment. Returns T." (let (cfg-user-type) ;03.20.87 DAB (unless (and cfg-unit (numberp cfg-unit)) ;03-25-88 DAB (setq cfg-unit (nvram-default-unit))) (unless cfg-band ;03-25-88 DAB (setq cfg-band (find-cfg-band cfg-unit))) ;03-25-88 DAB (setf (values nil cfg-user-type) (parse-partition-name cfg-band)) ;03.20.87 DAB (unless cfg-user-type ;03.20.87 DAB (setf cfg-band (string-append cfg-band "." "GEN"))) ;Look for CPU type of GENERIC (when (and module-number (not (numberp module-number))) ;06.12.87 (setf module-number nil)) (when module-number (setf user-type nil)) ;06.12.87 DAB (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (setq user-type (select-user-type user-type)) ;04.22.87 DAB (multiple-value-bind (MP-number nil nil) (find-module-from-rqb rqb :TYPE user-type :entry-number module-number) ;06.12.87 DAB ;;; (CHECK-ARG SSSS????? (unless mp-number (ferror :cfg-module-not-found "A configuration module for ~a not found in partition ~a on unit ~a." (select user-type (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor")) cfg-band cfg-unit)) (when load-slot (merge-entry-prompt-with-value rqb mp-number %CFG-LOAD-PARTITION-SLOT-ENTRY load-slot)) (when load-unit (cond ((and (stringp load-unit) ;mrr 3-15-87 (string-equal load-unit #\*)) nil) ;just check this case, but don't do any thing. ((and (stringp load-unit) (numberp (read-from-string load-unit))) (setq load-unit (translate-logical-to-physical (read-from-string load-unit)))) ((numberp load-unit) (setq load-unit (translate-logical-to-physical load-unit))) (t (ferror nil "Bad arg"))) (merge-entry-prompt-with-value rqb mp-number %CFG-LOAD-PARTITION-UNIT-ENTRY load-unit)) (when load-name (setq load-name (IF *PARTITION-NAME-CASE-SENSITIVE* (STRING load-name) (STRING-UPCASE (STRING load-name)))) (merge-entry-prompt-with-value rqb mp-number %CFG-LOAD-PARTITION-NAME-ENTRY (parse-partition-name load-name))) ;03.26.87 DAB (set-crc-codes rqb mp-number) (write-CFG-PARTITION rqb cfg-band cfg-unit)))) T) (defun Get-Cfg-Host-Data (&optional (cfg-band (find-default-cfg)) (cfg-unit (nvram-default-unit)) (module-number nil)) "... Return host name for module number MODULE-NUMBER. If MODULE-NUMBER is nill, the first module number of the current processor type is selected. If slot and unit are wild, the character * is returned for each" (let (user-type (select-type (cpu-type))) (when (and module-number (not (numberp module-number))) (setf module-number nil)) (when module-number (setf select-type nil)) (setf (values nil user-type) (parse-partition-name cfg-band)) (unless user-type (setf cfg-band (string-append cfg-band "." "GEN"))) ;Look for CPU type of GENERIC (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (multiple-value-bind (MP-number nil nil) ;block-number block-length) (find-module-from-rqb rqb :TYPE select-type :entry-number module-number) (unless mp-number (cerror "Give up on reading the config band ~a" "A configuration module for ~a not found in partition ~a on unit ~a." cfg-band (select (cpu-type) (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor") (otherwise (format nil "type ~a " (cpu-type)))) cfg-band cfg-unit)) (parse-entry (access-entry rqb mp-number %CFG-HOST-NAME-ENTRY))) ))) (defun set-cfg-host-name (name) "Sets the Host Name entry of the config module for this processor" (let* ((Unit-Offset (+ %COUNTER-BLOCK-A-MEM-ADDRESS (Position '%CNFG-PARTITION-SLOT-UNIT A-MEMORY-COUNTER-BLOCK-NAMES :Test #'EQ))) ;; Read unit from A-memory and convert to logical unit: (Unit (Get-Logical-Unit (Without-Interrupts (Dpb (%P-Ldb (Byte 8 16) (+ A-MEMORY-VIRTUAL-ADDRESS Unit-Offset)) (Byte 8 16) (%P-Ldb (Byte 16 0) (+ A-MEMORY-VIRTUAL-ADDRESS Unit-Offset)))))) ;; Get offset of partition name field in A-memory: (Name-Offset (+ %COUNTER-BLOCK-A-MEM-ADDRESS (Position '%CNFG-PARTITION-NAME A-MEMORY-COUNTER-BLOCK-NAMES :Test #'EQ))) ;; Initially set name to a string of spaces: (cfg-Name (Make-String %CFG-PARTITION-NAME-LENGTH :Initial-Element #\Space))) (Dotimes (I %CFG-PARTITION-NAME-LENGTH) (Setf (Aref cfg-Name I) (Without-Interrupts (%P-Ldb (Byte 8 (Ash I 3)) (+ A-MEMORY-VIRTUAL-ADDRESS Name-Offset)) ) ; w/o interrupts ) ; setf ) (set-cfg-host-data cfg-name unit :host-name name :module-number (second (multiple-value-list (get-module-pointer)))) )) (defun set-cfg-host-data (cfg-band cfg-unit &key host-name (user-type (cpu-type)) (module-number nil)) "Sets the Host name in module number MODULE-NUMBER or first occurrence of USER-TYPE in the configuration band CFG-BAND which is on unit CFG-UNIT. HOST-NAME can be a string or a symbol. Returns T." (let (cfg-user-type) (unless (and cfg-unit (numberp cfg-unit)) (setq cfg-unit (nvram-default-unit))) (unless cfg-band (setq cfg-band (find-cfg-band cfg-unit))) (setf (values nil cfg-user-type) (parse-partition-name cfg-band)) (unless cfg-user-type (setf cfg-band (string-append cfg-band "." "GEN"))) ;Look for CPU type of GENERIC (when (and module-number (not (numberp module-number))) (setf module-number nil)) (when module-number (setf user-type nil)) (with-rqb (rqb (read-cfg-partition cfg-band cfg-unit)) (setq user-type (select-user-type user-type)) (multiple-value-bind (MP-number nil nil) (find-module-from-rqb rqb :TYPE user-type :entry-number module-number) (unless mp-number (ferror :cfg-module-not-found "A configuration module for ~a not found in partition ~a on unit ~a." (select user-type (%cpu-explorer "an Explorer processor") (%cpu-ti-explorer-II "an Explorer II processor")) cfg-band cfg-unit)) (when host-name (setq host-name (STRING-UPCASE (STRING host-name))) (merge-entry-prompt-with-value rqb mp-number %CFG-HOST-NAME-ENTRY (parse-partition-name host-name))) (set-crc-codes rqb mp-number) (write-CFG-PARTITION rqb cfg-band cfg-unit)))) T) ;;; Retrieve this module-pointer-number's entry's prompt from the rqb ;;; merge the in new value and replace the entry in the rqb. (defun merge-entry-prompt-with-value (rqb mp-number entry-number value) (multiple-value-bind (nil prompt) (parse-entry (access-entry rqb mp-number entry-number)) (let ((new-entry (with-output-to-string (s) (princ prompt s) (princ #\: s) (princ value s)))) (if (> (length new-entry) %CFG-MODULE-TEXT-SIZE) (ferror nil "Prompt and new value, \"~a\", has length ~d. which exeeds ~a." new-entry (length new-entry) %CFG-MODULE-TEXT-SIZE) (setq new-entry (pad-string new-entry #\space %CFG-MODULE-TEXT-SIZE))) (access-entry rqb mp-number entry-number new-entry)))) (defun pad-string (string pad-char to-length) "Pad the string with pad-char upto to-length. Returns padded string." (let ((len (length string)) padded-string) (if (>= len to-length) (return-from pad-string string) (setq padded-string (make-string (- to-length len) :initial-element pad-char)) (string-append string padded-string)))) ;;; return 2 values: first is entry's value, second is its prompt (defun parse-entry (entry) (let ((colon-pos (position #\: entry))) (if colon-pos (let ((entry-value (read-from-string entry NIL NIL :start (1+ colon-pos)))) (setf entry-value (if (typep entry-value 'fixnum) entry-value (subseq entry (1+ colon-pos)))) (values entry-value (subseq entry 0 colon-pos)))))) ;;; Set overhead CRC and the CRC for module pointer at slot-base in the RQB's buffer. (defun set-crc-codes (rqb slot-index) (let* ((buffer (rqb-8-bit-buffer rqb)) (slot-base (+ %CFG-SLOT-LIST-OFFSET (* slot-index %CFG-SLOT-LIST-ENTRY-SIZE))) (start-and-length (get-disk-fixnum rqb (/ slot-base 4.))) (block-length (ldb (byte 16. 16.) start-and-length)) (block-start (ldb (byte 16. 0) start-and-length)) (module-crc (generate-crc-for-field-in-array buffer (* block-start 1024.) 1 (* block-length 1024.)))) ;array start step count (setf (aref buffer (+ slot-base %CFG-MODULE-CRC)) (ldb (byte 8. 0.) module-crc) (aref buffer (+ slot-base %CFG-MODULE-CRC 1)) (ldb (byte 8. 8.) module-crc)) (let ((overhead-crc (generate-crc-for-field-in-array buffer %CFG-Overhead-CRC-Start-Index 1 %CFG-Overhead-CRC-Length))) (setf (aref buffer %CFG-OVERHEAD-CRC) (ldb (byte 8. 0.) overhead-crc) (aref buffer (1+ %CFG-OVERHEAD-CRC)) (ldb (byte 8. 8.) overhead-crc))))) (DEFUN GET-DISK-STRING-BYTE-ADDR (RQB BYTE-ADDRESS N-CHARACTERS &OPTIONAL (SHARE-P NIL)) "Return a string containing the contents of a part of RQB's data. The data consists of N-CHARACTERS characters starting at data BYTE-ADDRESS. /(The first word of data is BYTE-ADDRESS = 0). SHARE-P non-NIL means return an indirect array that overlaps the RQB." (COND (SHARE-P (NSUBSTRING (RQB-8-BIT-BUFFER RQB) BYTE-ADDRESS (+ BYTE-ADDRESS N-CHARACTERS))) (T (LET* ((STR (SUBSEQ (RQB-8-BIT-BUFFER RQB) BYTE-ADDRESS (+ BYTE-ADDRESS N-CHARACTERS))) (IDX1 (position 0 STR :test-not #'eql :from-end t)) (IDX2 (position #\SPACE STR :test-not #'eql :from-end t))) (IF (NULL IDX1) (SETF IDX1 0)) (IF (NULL IDX2) (SETF IDX2 0)) (ADJUST-ARRAY STR (1+ (MIN IDX1 IDX2))) STR))) ) (DEFUN PUT-DISK-STRING-BYTE-ADDR (RQB STR BYTE-ADDRESS N-CHARACTERS) "Store the contents of string STR into RQB's data at BYTE-ADDRESS. N-CHARACTERS characters are stored, padding STR with zeros if it is not that long." (LET ((START BYTE-ADDRESS) (END (+ BYTE-ADDRESS N-CHARACTERS))) (ARRAY-INITIALIZE (RQB-8-BIT-BUFFER RQB) 0 START END) (COPY-ARRAY-PORTION STR 0 (LENGTH STR) (RQB-8-BIT-BUFFER RQB) START (MIN END (+ START (LENGTH STR)))))) (defun GENERATE-CRC-FOR-FIELD-IN-ARRAY (array field-start step-size count) "This function calculates and returns a Nubus CRC for COUNT elements in a byte ARRAY starting with FIELD-START element. CRCs are generated in ascending element order." (do ((crc 0) (address field-start (+ address step-size)) (counter count (1- counter))) ((zerop counter) crc) (setf crc (next-nubus-crc crc (aref array address))))) (defun CHECK-ROM-CRC (slot &optional (messages nil)) "This function checks the configuration ROM Nubus CRC for the specified slot, returning true if the CRC verifies correctly, otherwise nil. If messages is non-nil informational messages are returned instead of t or nil." (let ((array (make-array #xFFFFFe :type art-8b ;04.23.87 DAB :displaced-to-physical-address (dpb (logand #x0f slot) (byte 4. 24.) #x0F0000000)))) (when (= (aref array #xFFFF04) #xC3) (when messages (format t "~% C3 ok")) (let* ((count (rot 1 (aref array #xFFFFB4))) (start-offset (- #x01000000 (* count 4.))) (generated-crc (generate-crc-for-field-in-array array start-offset 4. (- count 18.))) (rom-crc (dpb (aref array #xFFFFBC) (byte 8. 8.) (aref array #xFFFFB8)))) (when messages (format t "~% ROM length= ~D, ~% starting offset= #x~6,'0X,~% generated CRC= #x~4,'0X, ~% ROM CRC= #x~4,'0X" count start-offset generated-crc rom-crc)) (= rom-crc generated-crc))))) ;; mrr 3.19.87 Make two initial modules - for Explorer I & II. (Defun INITIALIZE-CFG-PARTITION (cfg-name &optional (unit *default-disk-unit*) (ignore-old-garbage nil) (module-pointers '(0 1)) (cpu-types (list %cpu-explorer %cpu-ti-explorer-II))) "Initialize contents of CFG-NAME partition on UNIT to default Explorer values. If IGNORE-OLD-GARBAGE is non-nil then the CFG-NAME partition is used even if it has garbage contents." (let (slot-base block-offset) (with-rqb (rqb (read-cfg-partition cfg-name unit ignore-old-garbage)) (when rqb (array-initialize (rqb-8-bit-buffer rqb) 0) ;set background value of zeros (put-disk-string-byte-addr rqb "CNFG" %CFG-BASE 4.) (put-disk-string-byte-addr rqb "**" %CFG-GENERATION 2.) (put-disk-string-byte-addr rqb "*A" %CFG-REVISION 2.) (put-disk-string-byte-addr rqb "Initial Configuration partition for the Explorer Lisp Machine OS" %CFG-TITLE 64.) (mapcar #'(lambda (module-pointer cpu-type) (setq slot-base (+ %CFG-SLOT-LIST-OFFSET (* module-pointer %CFG-SLOT-LIST-ENTRY-SIZE)) ; use slot module-pointer block-offset (+ 1 module-pointer)) ; block offset=was 1 (put-disk-fixnum rqb (dpb 1 (byte 16. 16.) block-offset) (/ slot-base 4.)) (put-disk-fixnum rqb 256. (/ (+ slot-base %CFG-BOOT-TIMEOUT-OFFSET) 4.)) ;timeout = 256 seconds (put-disk-fixnum rqb 6. (/ (+ slot-base %CFG-NUMBER-ENTRIES-OFFSET) 4.)) ;number of text entries = 6 (put-disk-fixnum rqb (dpb cpu-type (byte 16. 16.) #x00000000) ; left = board type, right = CRC (/ (+ slot-base %CFG-MODULE-CRC) 4.)) ; clear CRC; set BOARD TYPE according to cpu-type (put-disk-fixnum rqb #x00010040 ;0001 = flags, 0040 = slot bits (/ (+ slot-base %CFG-MODULE-SLOTS) 4.)) ; slot = 6, flags = bootable processor ;; Config module (put-disk-fixnum rqb #xF4000000 (/ (+ (* block-offset 1024.) %CFG-RAM-BASE-OFFSET) 4.)) ; RAM base = #xF4000000 (put-disk-fixnum rqb #xFFFFFFFF ;slot=WILD, unit=WILD (/ (+ (* block-offset 1024.) %CFG-BOOT-DEVICE-OFFSET) 4.)) (put-disk-string-byte-addr rqb "MCR1" (+ (* block-offset 1024.) %CFG-BOOT-PARTITION-NAME-OFFSET) 4.) ;micro-code= MCR1 (put-disk-string-byte-addr rqb (select cpu-type (%cpu-explorer "00002236412-0001CPU ") (%cpu-ti-explorer-II "00002540830-0001CPU ")) (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET) %CFG-MODULE-TEXT-SIZE) (put-disk-string-byte-addr rqb (select cpu-type (%cpu-explorer "Explorer Processor ") (%cpu-ti-explorer-II "Explorer II Processor ")) (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET %CFG-MODULE-TEXT-SIZE) %CFG-MODULE-TEXT-SIZE) (put-disk-string-byte-addr rqb "Slots owned:2 3 4 5 6 " (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* %CFG-MODULE-TEXT-SIZE 2.)) %CFG-MODULE-TEXT-SIZE) (put-disk-string-byte-addr rqb "Load Slot :* " (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* %CFG-MODULE-TEXT-SIZE 3.)) %CFG-MODULE-TEXT-SIZE) (put-disk-string-byte-addr rqb "Load Unit :* " (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* %CFG-MODULE-TEXT-SIZE 4.)) %CFG-MODULE-TEXT-SIZE) (put-disk-string-byte-addr rqb "Load Name :* " (+ (* block-offset 1024.) %CFG-MODULE-TEXT-ENTRIES-OFFSET (* %CFG-MODULE-TEXT-SIZE 5.)) %CFG-MODULE-TEXT-SIZE) (set-crc-codes rqb module-pointer) ) module-pointers cpu-types) ;debugging (format-cfg-partition-from-rqb rqb cfg-name *standard-output*) (write-cfg-partition rqb cfg-name unit) (update-partition-comment cfg-name (format nil "Initialized:~a" (time:print-current-time nil)) unit) ;04.23.87 DAB ))) T) (defun prim-default-p (&optional (unit (nvram-default-unit))) (equal (second (get-default-partition unit %bt-microload %cpu-explorer)) "PRIM")) (defun prim-p (&optional unit) "Returns T if this UNIT has a PRIM partition on it, designated as a microload partition and an Explorer CPU-type. If no unit is specified, all units are checked." (if unit (not (null (member "PRIM" (get-partition-list-of-unit unit %BT-microload %cpu-explorer) :test #'string-equal :key #'second))) (not (null (member "PRIM" (get-partition-list %BT-microload %cpu-explorer) :test #'string-equal :key #'second))))) (defun boot-p (&optional unit) "Returns T if this UNIT has a BOOT partition on it, designated as a microload partition and an Explorer CPU-type. If no unit is specified, all units are checked." (if unit (not (null (member "BOOT" (get-partition-list-of-unit unit %BT-microload %cpu-explorer) :test #'string-equal :key #'second))) (not (null (member "BOOT" (get-partition-list %BT-microload %cpu-explorer) :test #'string-equal :key #'second))))) (defun find-prim () "Returns the unit that has the default PRIM, or if no default, then any PRIM." (let ((unit (NVRAM-DEFAULT-UNIT))) ;first check the default disk for the default microcode (cond ((equal (second (get-default-partition unit %bt-microload %cpu-explorer)) "PRIM") unit) ;then check the current disk -- it may be different. ((equal (second (get-default-partition *default-disk-unit* %bt-microload %cpu-explorer)) "PRIM") *default-disk-unit*) ;then check the default disk for any PRIM ((prim-p unit) unit) ;then check the current disk for any PRIM ((prim-p *default-disk-unit*) *default-disk-unit*) ;finally check other disks ((prim-p) (first (find "PRIM" (get-partition-list %BT-microload %cpu-explorer) :key #'second :test #'string-equal))) (t (ferror :partition-not-found "No partition named PRIM was found on any disk."))))) (defun find-cfg-band (unit) "Find a CFG band on the specified UNIT. Band has proper attributes and name starts with \"CFG\". Returns the band name of the either the default CFG band or the first one found, and if more than one band is found then the second value is a list of the other names. Returns nil if none found." (let ((default (Default-Cfg-in-ptbl unit)) (cfg-bands (get-partition-list-of-unit unit %BT-configuration-band %cpu-generic-band)) temp) (cond ((null cfg-bands) nil) ;; check again, just in case. ;; just one possibility? ((= 1 (length cfg-bands)) (if (string= "CFG" (second (car cfg-bands)) :end1 3 :end2 3) (seventh (car cfg-bands)) ;03.20.87 DAB return partition-name-string nil)) ;; get all matches and return them ((setq temp (remove nil (mapcar #'(lambda (x) (cond ((string= "CFG" (second x) :end1 3 :end2 3) (seventh x)) (t nil))) cfg-bands))) (if default (values default (remove default temp :test #'string-equal)) (if (> (length temp) 1) (values (car temp) (cdr temp)) (car temp)))) ))) (Defun GET-CONFIGURATION () "Returns the configuration partition defined for this processor. If no config partition could be found, nil is returned." ;; Get offset of Slot-Unit field in A-memory: (Let* ((Unit-Offset (+ %COUNTER-BLOCK-A-MEM-ADDRESS (Position '%CNFG-PARTITION-SLOT-UNIT A-MEMORY-COUNTER-BLOCK-NAMES :Test #'EQ))) ;; Read unit from A-memory and convert to logical unit: (Unit (Get-Logical-Unit (Without-Interrupts (Dpb (%P-Ldb (Byte 8 16) (+ A-MEMORY-VIRTUAL-ADDRESS Unit-Offset)) (Byte 8 16) (%P-Ldb (Byte 16 0) (+ A-MEMORY-VIRTUAL-ADDRESS Unit-Offset)))))) ;; Get offset of partition name field in A-memory: (Name-Offset (+ %COUNTER-BLOCK-A-MEM-ADDRESS (Position '%CNFG-PARTITION-NAME A-MEMORY-COUNTER-BLOCK-NAMES :Test #'EQ))) ;; Initially set name to a string of spaces: (Name (Make-String %CFG-PARTITION-NAME-LENGTH :Initial-Element #\Space))) ;; Create partition name; get little-endian ASCII bytes from A-memory: (Dotimes (I %CFG-PARTITION-NAME-LENGTH) (Setf (Aref Name I) (Without-Interrupts (%P-Ldb (Byte 8 (Ash I 3)) (+ A-MEMORY-VIRTUAL-ADDRESS Name-Offset)) ) ; w/o interrupts ) ; setf ) ; dotimes ;; If the partition exists, return its contents as a string: (When (And Unit (Find-Disk-Partition Name nil Unit)) (Rqb-8-Bit-buffer (Read-Cfg-Partition Name Unit) ) ; read-cfg-partition ) ; Rqb-8-Bit-Buffer ) ; let ) (defun find-default-cfg (&optional unit) "Returns the name and unit of the cfg-band that has the default CFG. We use the rule that the default CFG is on the same unit as the default PRIM." (unless unit (setq unit (nvram-default-unit))) ;03.19.87 MRR (values (find-cfg-band unit) unit)) (defun find-units-and-cfg-band (&optional (unit (nvram-default-unit)) cfg-unit cfg-band) ;03.19.87 MRR "Returns two items, the unit that has the default configuration band and the default configuration band. If neither CFG-UNIT or CFG-BAND are specifed, then search for them on UNIT and elsewhere. If a CFG band can't be found, return nil." (when cfg-band ;03.20.87 DAB (multiple-value-bind (name) ;04.15.87 DAB (parse-partition-name cfg-band :keyword) ;to make sure string equal will work with all kinds of cpu extensions. (setq cfg-band (string-append name "." "GENERIC")))) ;03.25.87 DAB (when (and (stringp cfg-band) (not *PARTITION-NAME-CASE-SENSITIVE*)) (setq cfg-band (STRING-UPCASE cfg-band))) (let (prim-unit found-cfg-band otherbands) (unless (or (= (cpu-type) %cpu-ti-explorer-II) ;Explorer II environment (= 2 si:microcode-type-code)) ;LX environment (if (not (prim-p unit)) ;if PRIM is not on UNIT, then (setq prim-unit (find-prim)) (setq prim-unit unit))) (cond ((null (or cfg-unit cfg-band)) ; when neither cfg-unit or cfg-band are specified, then ... (setq cfg-unit (or prim-unit unit));03-02-88 DAB ; set the cfg-unit to the prim-unit and find the cfg-band. (if (multiple-value-setq (cfg-band otherbands) (find-cfg-band cfg-unit)) (values cfg-unit cfg-band) nil)) ((and cfg-band cfg-unit) ; when both cfg-unit and cfg-band are specified, then verify. (if (multiple-value-setq (found-cfg-band otherbands) (find-cfg-band cfg-unit)) (when (or (string-equal found-cfg-band cfg-band) (find cfg-band otherbands :test #'string-equal)) ; see if the specified cfg-band is in the list. (values cfg-unit cfg-band)) nil)) (cfg-unit (if (multiple-value-setq (cfg-band otherbands) (find-cfg-band cfg-unit)) (values cfg-unit cfg-band) nil)) (cfg-band (setq cfg-unit prim-unit) (if (multiple-value-setq (found-cfg-band otherbands) (find-cfg-band cfg-unit)) (when (or (string-equal found-cfg-band cfg-band) (find cfg-band otherbands :test #'string-equal)) ; see if the specified cfg-band is in the list. (values cfg-unit cfg-band)) nil)) )) ) ;;; Here comes the dirty part. (defun confirm-units-are-on-same-host (u1 u2) (or (null u1) (null u2) (cond ((and (numberp u1) (numberp u2)) T) ((and (closurep u1) (closurep u2)) (eql (chaos:foreign-address (symeval-in-closure u1 'si:remote-disk-conn)) (chaos:foreign-address (symeval-in-closure u2 'si:remote-disk-conn)))) (T NIL)))) (defun Default-Cfg-in-ptbl (unit) "Return the default configuration band or Nil if not found." (seventh (get-default-partition unit %BT-Configuration-Band %CPU-Generic-Band))) ;03.20.87 return partition-name-string ;;;;;; return: '(Unit Name Attributes Start Length Comment) (defun get-default-partition (unit function-type user-type) (let ((partitions (Get-Partition-List-Of-Unit unit function-type user-type))) (dolist (part partitions) (when (LDB-TEST %%DEFAULT-INDICATOR (third part)) (return part))))) ;;; New FNC based on Get-Partition-List from Disk-Label-Primitives ---> ;;;;;;;;; Return: list of partitions as '(Unit Name Attributes Start Length Comment) ;;; Unit will be a closure for remote hosts, which is already disposed of.. so don't use it!! (DEFUN GET-PARTITION-LIST-OF-UNIT (&OPTIONAL (UNIT si:*default-disk-unit*) FUNCTION-TYPE (USER-TYPE %CPU-EXPLORER)) "Returns all of the partitions of type, FUNCTION-TYPE, and processor type, USER-TYPE, from a unit. You have to pass the FUNCTION-TYPE as one of the %PT-type-mumble types as defined in QDEV or if its NIL return everything. USER-TYPE should a cpu type or if NIL partitions will be returned regardless of their user (cpu) type. A unit can be a disk drive number, a string containing the name of a machine, or a string containing the remote machine name, colon, remote unit id. Returns: unit name attributes start length comments partition-name-string." ;;%BT-Microload %BT-Load-Band --- Functions-Types ;;%Cpu-Generic-Band %CPU-EXPLORER --- User-Types (get-partition-list function-type user-type unit)) ;03.25.87 DAB (DEFUN GET-PARTITION-LIST-OF-RQB (RQB &OPTIONAL FUNCTION-TYPE (USER-TYPE %CPU-EXPLORER)) ;03.25.87 DAB "Returns all of the partitions of type, FUNCTION-TYPE, and processor type, USER-TYPE, from a rqb. You have to pass the FUNCTION-TYPE as one of the %PT-type-mumble types as defined in QDEV or if its NIL return everything. USER-TYPE should a cpu type or if NIL partitions will be returned regardless of their user (cpu) type. Returns a list of lists ( )." ;;%BT-Microload %BT-Load-Band --- Functions-Types ;;%Cpu-Generic-Band %CPU-EXPLORER --- User-Types (partition-list-from-rqb rqb function-type user-type)) (Defun PARTITION-OWNED-P (Type Name Unit Slot &Optional (Default-P nil) (Config (Get-Configuration))) "Looks up the TYPE partition assigned by the module in CONFIG and compares it to the partition described by TYPE, NAME, UNIT, and SLOT. Set DEFAULT-P to T if it is a default partition. TYPE can be %BT-Load-Band, %BT-Page-Band, or %BT-File-Band. If the configuration module cannot be found, T is returned as default for all bands." (Let* ((Key (second (assoc type *CFG-controlled-partition-types-alist* :test #'EQ))) (Pointer (Get-Module-Pointer Config)) (Module (Get-Config-Module Config Pointer)) (Entries (When Pointer (Module-Entries Pointer))) Part-Slot Part-Unit Part-Name) ;; If there is a module and it contains an entry for this type of band: (If (And Module Key (Search-Module-Entries Module Key)) (Block Verify-Parameters (Dotimes (Entry Entries) ;; Search each entry until a mention of the band type is found. (When (Search-Module-Entry Module Entry Key) ;; Look up the data for that band type: (Cond ((And (Null Part-Slot) (Setf Part-Slot (Read-Module-Entry Module Entry "Slot")))) ((And (Null Part-Unit) (Setf Part-Unit (Read-Module-Entry Module Entry "Unit")))) ((And (Null Part-Name) (Setf Part-Name (Read-Module-Entry Module Entry "Name")))) ) ; cond ) ; when ;; When all parameters have been found or we've run out of entries; (When (Or (And Part-Slot Part-Unit Part-Name) (Eq Entry Entries)) ;; If end of the line, attempt to use defaults. (Setf Part-Slot (Or Part-Slot "*") Part-Unit (Or Part-Unit "*") Part-Name (Or Part-Name "*")) ;; Check to see if this band matches. (If (And (= Slot (If (String-Equal (Read-From-String Part-SLot) "*") (Ldb (Byte 4 0) NUPI-SLOT-NUMBER) (Read-From-String Part-Slot))) (= Unit (If (String-Equal (Read-From-String Part-Unit) "*") *Default-Disk-Unit* (Read-From-String Part-Unit))) (If (String-Equal (Read-From-String Part-Name) "*") Default-P (String-Equal (Read-From-String Part-Name) Name))) (Return-From Verify-Parameters T) ;; It's doesn't, so look for another one. (Setf Part-slot Nil Part-Unit Nil Part-Name Nil) ) ; if ) ; when ) ; dotimes ) ; get-parameters T) ; no config for this type of band; default to T ) ; let ) ;;;;;;;;;; ;;;; This belongs in NVRAM code (Defun NVRAM-DEFAULT-UNIT () "Returns the current default Unit 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)) (unless (cerror "Initialize NVRAM and continue." "~%NVRAM has not been initialized. Use SI:Setup-NVRAM.") (si:setup-nvram) (si:get-logical-unit (Read-NVRAM-Field si:NVRAM-Boot-Unit))) (si:get-logical-unit (Read-NVRAM-Field si:NVRAM-Boot-Unit)))))