;;; -*- Mode:Common-Lisp; Package:SI; Base:10.; Cold-Load: T -*- ;;; 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. ;;; ;;; Edit History ;;; ;;; Patch ;;; Date Author Number Description ;;;------------------------------------------------------------------------------ ;;; 04-20-89 DAB Added support for the NUPI 2. ;;; 8/29/88 ab D-IO 5-1 Fix CPU-TYPE not to error if mX. ;;; 04-22-88 ab disk-io 4-9 ;;; o Set up *MCR-UNIT* for both Explorer and microExplorer. ;;; o Change way *default-disk-unit* set up for microExplorer slightly: ;;; It will always be a logical unit, so don't "fix it up" later. ;;; o Add phys-to-logical translations for mX nupi-emulator (will have to ;;; be used before DISK-TYPE-TABLE set up. ;;; 02-29-88 ab Move CPU-TYPE, TRANSLATE-PHYSICAL-TO-LOGICAL here from CFG-PRIMITIVES. ;;; 01.25.88 MBC New forms to ask MAC for Startup info, default device and host name. ;;; 01.11.88 MBC Use Resource-Present-P conditionals. ;;; 10.14.87 MBC Conditional load for addin differences. ;;; 09-25-87 DAB Changed CONFIGURE-NUPI-DISK-SYSTEM to alway put the real unit in the table. ;;; 09-09-87 DAB Added a new function call INSERT-device. NOn-destructively adds devices to disk-type-table. ;;; 06-25-87 ab Changed definition of VIRTUAL-MEMORY-SIZE variable slightly, and since ;;; it is a constant value, change DISK-INIT not to set it. ;;; 03.09.87 DAB Changes read-default-disk-unit-from-mem to always return a physical unit. ;;; 02-24-87 DAB Changed Convert-logical-unit-to-physical to call get-real-unit-no-check. ;;; 02-17-87 DAB Changed to base 10. ;;; 02-06-87 DAB ALL-DISK-UNITS needs to call ON-LINE with retest argument set to nil. ;;; 01-30-87 DAB Made obsolete Configure-disk-system. Change configure-disk-system to configure-disk-system-1. ;;; Alway call Initialize-disk-system. ;;; 01-28-87 Bice Added *Loaded-MCR-Band* and initialized it. ;; ;; These are the initializations for each of the device tables. It is called ;; during lisp-reinitialize. ;; (DEFVAR DISK-PACK-NAME :UNBOUND "Remembers name of pack for PRINT-LOADED-BAND") (DEFVAR *DEFAULT-UNIT-FROM-MEM* ()) ;holds the logical unit# gotten from booting (DEFVAR DISK-TYPE-TABLE) (DEFconstant DISK-TYPE-TABLE-LENGTH 16.) (DEFCONSTANT CONTROLLER-SLOT-TABLE-LENGTH 17.) (DEFPARAMETER TAPE-ID 1.) (DEFPARAMETER DISK-Id 2.) (DEFVAR *DEFAULT-CONTROLLER-SLOT* 2 "Use this for the default value of controller slot for *default-disk-unit*.") (DEFVAR CONTROLLER-SLOT-TABLE) (DEFVAR DISK-TYPE-TABLE-INDEX 0) (DEFVAR %MSC-NUPI2-LENGTH-RQ-STATUS #o2000) ;move to qdev ;;;The following four defvars are used get-msc-nupi2-status. The #x83 command with descriptor code #x00 ;;; returns a several device and formatter information and status blocks. The block arrangement is variable. ;;; The vars below will point to the beginning of the appropriate starting offset in the rqb buffer corresponding ;;; to the appropriate type of block. (DEFVAR *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* 0) (DEFVAR *MSC-DEVICE-STATUS-OFFSET* 0) (DEFVAR *MSC-FORMATTER-CONTROLLER-SELECT-DEVICE-TYPE-OFFSET* 0) (DEFVAR *MSC-FORMATTER-CONTROLLER-STATUS-OFFSET* 0) (DEFCONSTANT DEVICE-TYPE-ID-ALIST `(("Tape" ,TAPE-ID "Tape Wait") ("Disk" ,DISK-ID "Disk Wait") (NIL "Unknown" "Nupi Wait"))) (DEFPARAMETER DEVICE-TYPE-STRING-ALIST `((,TAPE-ID "Tape" "Tape Wait") (,DISK-ID "Disk" "Disk Wait") (NIL "Unknown" "Nupi Wait"))) (DEFSUBST DEVICE-TYPE-STRING (UNIT-ID) (SECOND (ASSOC UNIT-ID DEVICE-TYPE-STRING-ALIST :TEST #'EQ))) (DEFSUBST DEVICE-TYPE-ID (UNIT-NAME) (SECOND (ASSoc UNIT-NAME DEVICE-TYPE-ID-ALIST :test #'STRING-EQUAL))) (DEFSUBST DEVICE-TYPE-WAIT-STRING (UNIT-ID) (THIRD (ASSOC UNIT-ID DEVICE-TYPE-STRING-ALIST :TEST #'EQ))) ;; ;; These are access functions for the disk-type-table ;; (DEFUN RQB-REAL-UNIT (RQB) "Return real unit from rqb: Warning, it may not be valid." (LDB (BYTE 6. 0.) (AREF RQB %IO-RQ-COMMAND))) (DEFSUBST GET-IF-TYPE (LOGICAL-UNIT) "Return interface-type" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 0.)) (DEFSUBST SET-IF-TYPE (LOGICAL-UNIT IF-TYPE) "Set interface-type in device table" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 0.) IF-TYPE)) (DEFSUBST SET-REAL-UNIT (LOGICAL-UNIT REAL-UNIT) "Set real-unit in device table" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 1.) REAL-UNIT)) (DEFSUBST GET-DEVICE-NAME (LOGICAL-UNIT) "Return last device type name" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 2.)) (DEFSUBST SET-DEVICE-NAME (LOGICAL-UNIT DEVICE-NAME) "Save device type name" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 2.) DEVICE-NAME)) (DEFSUBST GET-STATUS (LOGICAL-UNIT) "Return last device status" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 3.)) (DEFSUBST SET-STATUS (LOGICAL-UNIT STATUS) "Save device status" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 3.) STATUS)) (DEFSUBST GET-LAST-ERROR (LOGICAL-UNIT) "Return last device last-error" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 4.)) (DEFSUBST SET-LAST-ERROR (LOGICAL-UNIT LAST-ERROR) "Save device last-error" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 4.) LAST-ERROR)) (DEFSUBST GET-DEVICE-TYPE (LOGICAL-UNIT) "Return device type number" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 5.)) (DEFSUBST SET-DEVICE-TYPE (LOGICAL-UNIT DEVICE-TYPE) "Save device-type" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 5.) DEVICE-TYPE)) (DEFSUBST GET-PACK-NAME-FROM-TABLE (LOGICAL-UNIT) "Return last device pack-name" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 6.)) (DEFSUBST SET-PACK-NAME-FROM-TABLE (LOGICAL-UNIT PACK-NAME) "Save device pack-name" (SETF (AREF DISK-TYPE-TABLE LOGICAL-UNIT 6.) PACK-NAME)) (DEFSUBST GET-DEVICE-DESCRIPTOR-NAME (LOGICAL-UNIT) "Return device descriptor name" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 7.)) (DEFSUBST SET-DEVICE-DESCRIPTOR-NAME (LOGICAL-UNIT NAME) "Save device descriptor name" (setf (Aref DISK-TYPE-TABLE LOGICAL-UNIT 7.) NAME)) (DEFSUBST GET-DEVICE-PROPERTY-LIST (LOGICAL-UNIT) "Return device property list" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 8.)) (DEFSUBST SET-DEVICE-PROPERTY-LIST (LOGICAL-UNIT P-LIST) "Save device property list" (setf (Aref DISK-TYPE-TABLE LOGICAL-UNIT 8.) P-LIST)) (DEFSUBST GET-DEVICE-SLOT-NUMBER (LOGICAL-UNIT) "Return device slot number" (AREF DISK-TYPE-TABLE LOGICAL-UNIT 9.)) (DEFSUBST SET-DEVICE-SLOT-NUMBER (LOGICAL-UNIT SLOT) "Save device controller slot number" (setf (Aref DISK-TYPE-TABLE LOGICAL-UNIT 9.) SLOT)) (defun cpu-type (&optional mcr-type-code) "Returns the board type (an integer) of the CPU that is running this software environment." (case (or mcr-type-code (processor-type)) (:explorer-i %cpu-explorer) (:explorer-ii %cpu-ti-explorer-II) (:micro-explorer %cpu-ti-explorer-II) ;ab 8/29/88 (:otherwise (FERROR nil "Unknown processor type ~a" (processor-type))))) (DEFUN UNIT-ONLINE (UNIT &optional (retest t)) "Will return T if the logical unit is online. If retest is nil the device status used was the result of the last IO done to the device. If retest is non-nil a current device status is obtained and the disk system is re-initialized if the status has changed." (when retest (LET ((DEVICE-STATUS 0)) (case (GET-IF-TYPE UNIT) (:NPI (LET ((STATUS (IGNORE-ERRORS (GET-DEVICE-STATUS UNIT)))) (COND ((NULL STATUS) (SETQ DEVICE-STATUS NIL)) (T (IF (or (LDB-TEST %%NUPI-DEVICE-OFFLINE (AREF-32B STATUS 0)) (LDB-TEST %%NuPI-Device-Not-Ready (AREF-32B STATUS 0))) (SETQ DEVICE-STATUS :OFFLINE) (SETQ DEVICE-STATUS :ONLINE)))))) ((:NPE :MSC :NP2) ; DAB 04-19-89 (LET ((BUFFER (IGNORE-ERRORS (GET-MSC-NUPI2-DEVICE-STATUS UNIT)))) (IF BUFFER (PROGN (DOTIMES (I (AREF BUFFER %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET)) (SETQ DEVICE-STATUS (DPB (AREF BUFFER (+ I %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET)) (BYTE 8. (* 8. I)) DEVICE-STATUS))) (IF (or (LDB-TEST %%NUPI-DEVICE-OFFLINE DEVICE-STATUS) (ldb-test %%NuPI-Device-Not-Ready device-status)) (SETQ DEVICE-STATUS :OFFLINE) (SETQ DEVICE-STATUS :ONLINE))) (SETQ DEVICE-STATUS NIL))))) (when (and retest (not (EQ DEVICE-STATUS (GET-STATUS UNIT)))) (initialize-disk-system) ) )) (EQ (GET-STATUS UNIT) :ONLINE)) (DEFUN DISK-ONLINE (UNIT) "will return T if the logical unit is a disk and is online." (AND (EQ (GET-STATUS UNIT) :ONLINE) (EQUAL (GET-DEVICE-TYPE UNIT) DISK-ID))) ;;; returns T if the logical unit is a nupi device - nil if otherwise (DEFUN NUPI-DISKP (LOGICAL-UNIT) "Return T if logical-unit is valid nupi or msc device." (WHEN (AND (< LOGICAL-UNIT (ARRAY-DIMENSION DISK-TYPE-TABLE 0)) (MEMBER (AREF DISK-TYPE-TABLE LOGICAL-UNIT 0) '(:NPI :NPE :MSC :NP2))) ; DAB 04-19-89 T)) (DEFUN ALL-UNITS () "returns a list of all online devices by their logical unit numbers." (LOOP FOR INDEX FROM 0. BELOW (ARRAY-DIMENSION DISK-TYPE-TABLE 0.) WHEN (UNIT-ONLINE INDEX nil) COLLECT INDEX INTO UNIT-LIST FINALLY (RETURN UNIT-LIST))) (DEFUN ALL-DISK-UNITS () "returns a list of all online devices by their logical unit numbers." (LOOP FOR INDEX FROM 0. BELOW (ARRAY-DIMENSION DISK-TYPE-TABLE 0.) WHEN (DISK-ONLINE INDEX ) COLLECT INDEX INTO UNIT-LIST FINALLY (RETURN UNIT-LIST))) (DEFUN ALL-TAPE-UNITS () "Returns a list of all online TAPE devices by their logical unit numbers." (LOOP FOR INDEX FROM 0. BELOW (ARRAY-DIMENSION DISK-TYPE-TABLE 0.) WHEN (TAPE-ONLINE INDEX ) COLLECT INDEX INTO UNIT-LIST FINALLY (RETURN UNIT-LIST))) (DEFUN TAPE-ONLINE (UNIT) "Will return T if the logical unit is a TAPE and is ONLINE." (AND (EQ (GET-STATUS UNIT) :ONLINE) (EQUAL (GET-DEVICE-TYPE UNIT) TAPE-ID))) (DEFSUBST GET-REAL-UNIT-NO-CHECK (LOGICAL-UNIT) (AREF DISK-TYPE-TABLE LOGICAL-UNIT 1.)) ;; Patch 1-106. Change > to >= to fix array bounds error, -ab ;; ;;; Returns the actual unit id from the disk-type-table. Flavors UNIT-ERROR, UNIT-BAD-NMBER-ERROR, and ;;; UNIT-OFFLINE-ERROR must be in window;ehf, but later in EH;EHF (DEFUN GET-REAL-UNIT (LOGICAL-UNIT) "Return physical unit number, allowing input if logical-unit has a bad value. If logical-unit is offline, si:configure-disk-table may be called to look for new online status." (LET (ERR-CONDITION) (COND ((NOT (NUMBERP LOGICAL-UNIT)) (SETQ ERR-CONDITION (MAKE-CONDITION 'EH:BAD-NUMBER-ERROR "Unit ~D is an invalid value." LOGICAL-UNIT)) (SIGNAL ERR-CONDITION) (SETQ LOGICAL-UNIT (SEND ERR-CONDITION ':UNIT)))) (COND ((OR (< LOGICAL-UNIT 0) (>= LOGICAL-UNIT (ARRAY-DIMENSION DISK-TYPE-TABLE 0))) (SETQ ERR-CONDITION (MAKE-CONDITION 'EH:BAD-NUMBER-ERROR "Unit ~D is out of range" LOGICAL-UNIT)) (SIGNAL ERR-CONDITION) (SETQ LOGICAL-UNIT (SEND ERR-CONDITION ':UNIT)))) (DO-FOREVER (IF (EQ (GET-STATUS LOGICAL-UNIT) :ONLINE) (RETURN)) (SETQ ERR-CONDITION (MAKE-CONDITION 'EH:OFFLINE-ERROR "Unit ~D is offline" LOGICAL-UNIT)) (SIGNAL ERR-CONDITION) (SETQ LOGICAL-UNIT (SEND ERR-CONDITION ':UNIT)))) (GET-REAL-UNIT-NO-CHECK LOGICAL-UNIT)) (DEFUN GET-LOGICAL-UNIT (REAL-UNIT &optional slot) "returns the logical unit number for a given physical unit number." (DECLARE (SPECIAL DISK-TYPE-TABLE)) (DOTIMES (I (ARRAY-DIMENSION DISK-TYPE-TABLE 0) NIL) (IF (and (equal (GET-REAL-UNIT-NO-CHECK I) REAL-UNIT) (if slot (equal (GET-DEVICE-SLOT-NUMBER real-unit) slot) t)) (RETURN I)))) ;; New fn, 9-19-85, -ab Patch 1-106 (DEFUN CONVERT-LOGICAL-UNIT-TO-PHYSICAL (LOGICAL-UNIT) "Returns physical disk unit corresponding to LOGICAL-UNIT. No error checking." (GET-REAL-UNIT-NO-CHECK LOGICAL-UNIT)) ;;; Disk-Type-Table SLOTS ;; ELEMENT NUMBER = 0 1 2 3 4 5 6 7 8 9 ;; USE: I/F-type real-unit name status last-error device-type pack-name Descriptor Property Slot ;; TYPE: key number string key hex number number string Name list Number ;; ;;; The disk type table keeps information on logical to actual disk unit mapping. ;;; The array is indexed by the logical unit id and contains a ;;; disk descriptor and the read access unit id. (defun translate-logical-to-physical (unit) "Converts a logical unit number to physical unit number. Returns the physical unit number." (unless (typep unit `(integer 0 ,(array-dimension si:disk-type-table 0))) ;03.25.87 DAB (ferror :invalid-device "Unit, ~a, is not a valid logical unit number." unit)) (cond ((get-real-unit-no-check unit) ;this might be nil if unit is not in disk type table. (format nil "~6,48x" (get-real-unit-no-check unit))) ;;otherwise use the NUPI translation table -- this is guessing because they might have an MSC. (t (nth unit '("000000" ;0 ;03.25.87 DAB "000001" ;1 "000008" ;2 "000009" ;3 "000010" ;4 "000011" ;5 "000018" ;6 "000019" ;7 "000020" ;8 "000021" ;9 ;#X28 and #x29 reserved for formatter "000030" ;10 "000031" ;11 "000038" ;12 "000039") ;13 )))) (defun translate-physical-to-logical (unit) "Converts a physical unit number to logical unit number. UNIT is either a string representing hexidecimal digits, or it is a decimal number whose digits can be taken literally as hex. For example, \"000010\" is the same as 10, both of which can be treated as #x10. Returns the logical unit number or :DEVICE-NOT-VALID if the unit is not in the disk-type-table." (cond ((typep unit '(member 0 1 8 9 10 11 18 19 20 21 30 31 38 39 80 81)) ;unit is a hex but it looks like a decimal, so convert it to a hex. (setq unit (let ((*read-base* #x10)) (read-from-string (format nil "#x~d" unit))))) ((stringp unit) (setq unit (let ((*read-base* #x10)) (read-from-string unit)))) (t (ferror :invalid-device "Unit, ~a, is not a valid physical unit number." unit))) (if (null (get-logical-unit unit)) :DEVICE-NOT-VALID (get-logical-unit unit))) ;;ab new 4/18/88 disk-io 4-9 ;;Physical-to-logical unit mappings for mX nupi-emulator (DEFPARAMETER *npi-unit-mappings* '((#o00 . 0.) (#o01 . 1.) (#o10 . 2.) (#o11 . 3.) (#o20 . 4.) (#o21 . 5.) (#o30 . 6.) (#o31 . 7.) (#o40 . 8.) (#o41 . 9.) ;; fmt 5 = controller (#o60 . 12.)(#o61 . 13.) (#o70 . 14.)(#o71 . 14.))) (DEFUN npi-phys-to-log (phys) (CDR (ASSOC phys *npi-unit-mappings* :test #'=))) (DEFUN npi-log-to-phys (log) (CAR (RASSOC log *npi-unit-mappings* :test #'=))) (DEFUN SET-DISK-TABLE (UNIT-ID IF-TYPE REAL-UNIT &OPTIONAL (DEVICE-TYPE DISK-ID) (STATUS :OFFLINE) DESCRIPTOR-NAME (PROPERTY-LIST NIL) (SLOT-NUMBER 2)) (unless descriptor-name (ferror nil "Attempt to use NIL as a device-descriptor.")) (COND ((AND (NUMBERP UNIT-ID) (< UNIT-ID (ARRAY-DIMENSION DISK-TYPE-TABLE 0))) (case IF-TYPE ((:NPI :NPE :MSC :NP2) ; DAB 04-19-89 (SET-IF-TYPE UNIT-ID IF-TYPE) (SET-REAL-UNIT UNIT-ID REAL-UNIT) (SET-DEVICE-NAME UNIT-ID (IF (NUMBERP DEVICE-TYPE) (DEVICE-TYPE-STRING DEVICE-TYPE) DEVICE-TYPE)) (SET-STATUS UNIT-ID STATUS) (SET-DEVICE-TYPE UNIT-ID (IF (NUMBERP DEVICE-TYPE) DEVICE-TYPE (DEVICE-TYPE-ID DEVICE-TYPE))) (SET-DEVICE-DESCRIPTOR-NAME UNIT-ID DESCRIPTOR-NAME) (SET-DEVICE-PROPERTY-LIST UNIT-ID PROPERTY-LIST) (SET-DEVICE-SLOT-NUMBER UNIT-ID SLOT-NUMBER)) (T (FERROR NIL "error in disk type argument: use :NPI,:NPE, :NP2 or :MSC")))) (T (FERROR NIL "error in unit id argument: use a unit id in the range of 0 to ~S" (ARRAY-DIMENSION DISK-TYPE-TABLE 0))))) (DEFUN PRINT-DISK-TYPE-TABLE () (DOTIMES (INDEX DISK-TYPE-TABLE-LENGTH) (IF (AREF DISK-TYPE-TABLE INDEX 0) (PROGN (FORMAT *TERMINAL-IO* "~% logical-device ~d. physical device #x~16r" ;03.09.87 DAB INDEX (GET-REAL-UNIT-NO-CHECK INDEX)) (FORMAT *TERMINAL-IO* " device-status: ~a device-type: ~a slot-number: ~a" (GET-STATUS INDEX) (GET-DEVICE-NAME INDEX) (GET-DEVICE-SLOT-NUMBER INDEX)) (IF (GET-PACK-NAME-FROM-TABLE INDEX) (FORMAT *TERMINAL-IO* " pack-name: ~s" (GET-PACK-NAME-FROM-TABLE INDEX))) (IF (GET-DEVICE-PROPERTY-LIST INDEX) (FORMAT *TERMINAL-IO* " property-list: ~a" (GET-DEVICE-PROPERTY-LIST INDEX))))))) ;;AB 06/25/87. Changed this to be the maximum virtual memory size. (DEFPARAMETER VIRTUAL-MEMORY-SIZE (1+ (byte-mask %%q-pointer)) "Maximum size of virtual memory.") (DEFVAR *DEFAULT-DISK-UNIT* 1. "Use this for the default value of (logical) UNIT in functions that default unit number.") (DEFVAR *mcr-unit* 0 "Logical disk unit from which microcode was loaded.") ;ab 4/18/88 disk-io 4-9 ;; System patch 2-61, ab ;; Use new symbolic names for A-memory addresses. ;; Microcode stores information about the lod and mcr units in processor A-Memory. ;; Must read default unit once and only once before mouse movement wipes out the info. ;; Returns a physical unit number. Return itself if it already exist. ;;(DEFUN (:cond (NOT (resource-present-p :disk)) READ-DEFAULT-DISK-UNIT-FROM-MEM) () ;; (setq *default-unit-from-mem* ;; (first (get-booted-load-band-info)))) ;; These should only be called for Explorer--not for microExplorer. ab 4/18/88 (DEFUN READ-DEFAULT-DISK-UNIT-FROM-MEM () ;ab 4/18/88 disk-io 4-9 (IF *DEFAULT-UNIT-FROM-MEM* (IF (LISTP *DEFAULT-DISK-UNIT*) (CADR *DEFAULT-DISK-UNIT*) (get-real-unit-no-check *DEFAULT-DISK-UNIT*)) ;03.09.87 DAB (IF (= #o177777 (%P-LDB %%Q-LOW-HALF (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-COMMAND-BLOCK-ADDRESS))) (SETQ *DEFAULT-UNIT-FROM-MEM* (%P-LDB %%Q-LOW-HALF (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-LOAD-DEVICE-ADDRESS))) (SETQ *DEFAULT-UNIT-FROM-MEM* (%P-LDB %%Q-LOW-HALF (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-MCR-DEVICE-ADDRESS)))))) (DEFUN READ-MCR-UNIT-FROM-MEM () ;ab 4/18/88 disk-io 4-9 (SETQ *mcr-unit* (%P-LDB %%Q-LOW-HALF (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-MCR-DEVICE-ADDRESS)))) (define-when :DISK (defun INSERT-DEVICE () ;09-09-87 DAB "Non-destructively add any new devices to the SI:Disk-type-table. Builds a temporary disk-type-table and insert any new devices into the normal SI:DISK-TYPE-TABLE" (let (save-disk-type-table) (let ((disk-type-table (MAKE-ARRAY `(,DISK-TYPE-TABLE-LENGTH 10.) ;create a local variable for disk-type-table. ':TYPE 'ART-Q ':INITIAL-VALUE NIL)) (*default-disk-unit* ;We need this so get-default-disk-unit-from-mem will work properly. (list si:*DEFAULT-CONTROLLER-SLOT* si:*default-disk-unit*))) (initialize-disk-system) ;now initialize the disk system (setq save-disk-type-table disk-type-table)) (dotimes (x (array-dimension save-disk-type-table 0)) ;compare new table with old. (when (aref save-disk-type-table x 2) ;update old table if old-table in nil. (when (or (not (aref si:disk-type-table x 2)) (equal (aref si:disk-type-table x 3) :OFFLINE)) (dotimes (Y (array-dimension save-disk-type-table 1)) (setf (aref si:disk-type-table x y) (aref save-disk-type-table x y)))))))) ;; End of DEFINE-WHEN ) (DEFUN INITIALIZE-DISK-SYSTEM (&AUX (DEFAULT-BOOT-CONTROLLER-DESCRIPTOR-BLOCK (MAKE-ARRAY 40. ':TYPE 'ART-16B ':DISPLACED-TO (SYSTEM-COMMUNICATION-AREA %SYS-COM-SYSTEM-NUPI-DESCRIPTOR))) SLOT-ADDRESS (CONTROLLER-TYPE (MAKE-STRING 3 :INITIAL-ELEMENT #o40)) (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*)) "Re-creates disk-type-table and initializes it dynamically for nupi." (DECLARE (SPECIAL DISK-TYPE-TABLE)) ;;ab 4/18/88. Set up *mcr-unit*. ;; Note: in code below, both units will first be a physical units for ;; Explorer, but fixed to be logical later in CONFIGURE-DISK-SYSTEM variants ;; (for *default-disk-unit*) and below (for *mcr-unit*). ;; For microExplorer, both are logical units from the start. (COND ((resource-present-p :disk) ;regular Explorer case (SETQ *DEFAULT-DISK-UNIT* (READ-DEFAULT-DISK-UNIT-FROM-MEM)) ;03.09.87 DAB (SETQ *MCR-UNIT* (read-mcr-unit-from-mem))) (t ;microexplorer (SETQ *default-disk-unit* (FIRST (get-booted-load-band-info))) (SETQ *mcr-unit* (FIRST (get-booted-microcode-band-info))))) (without-interrupts ;no disk io can be done until this completes (or (boundp 'disk-type-table) (SETF DISK-TYPE-TABLE (MAKE-ARRAY `(,DISK-TYPE-TABLE-LENGTH 10.) ':TYPE 'ART-Q ':INITIAL-VALUE NIL))) (SI:ARRAY-INITIALIZE SI:DISK-TYPE-TABLE NIL) ;MBC 12.11.86 Make sure we don't use bogus descriptors. (or (boundp 'controller-slot-table) (SETF CONTROLLER-SLOT-TABLE (MAKE-ARRAY `(,CONTROLLER-SLOT-TABLE-LENGTH 2) ':TYPE 'ART-Q ':INITIAL-VALUE NIL))) (SI:ARRAY-INITIALIZE SI:controller-slot-TABLE NIL) (SETq DISK-TYPE-TABLE-INDEX 0) (SETq SLOT-ADDRESS (if (resource-present-p :DISK) (LDB %%NUBUS-F-AND-SLOT-BITS (AREF-32B DEFAULT-BOOT-CONTROLLER-DESCRIPTOR-BLOCK %NUPI-CONTROL-SPACE-ADDRESS)) #xF2)) (SETq CONTROLLER-SLOT (if (resource-present-p :DISK) (LDB %%NUBUS-ADDRESS-SLOT-BITS (AREF-32B DEFAULT-BOOT-CONTROLLER-DESCRIPTOR-BLOCK %NUPI-CONTROL-SPACE-ADDRESS)) 2)) (DOTIMES (I 3) (setf (Aref CONTROLLER-TYPE I) (if (resource-present-p :DISK) (%NUBUS-READ-8B SLOT-ADDRESS (+ %NUPI-CONFIGURATION-ROM-BOARD-TYPE (* I 4))) (aref "NPI" i)))) (SETF CONTROLLER-TYPE (COND ((STRING-EQUAL CONTROLLER-TYPE "NPI") :NPI) ((STRING-EQUAL CONTROLLER-TYPE "NPE") :NPE) ((STRING-EQUAL CONTROLLER-TYPE "MSC") :MSC) ((STRING-EQUAL CONTROLLER-TYPE "NP2") :NP2) ; DAB 04-19-89 (T (FERROR NIL "Invalid controller type ~s." CONTROLLER-TYPE)))) (setf (Aref CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 0) CONTROLLER-TYPE) (setf (Aref CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 1) DEFAULT-BOOT-CONTROLLER-DESCRIPTOR-BLOCK) (WHEN (resource-present-p :disk) (SETQ *DEFAULT-DISK-UNIT* (LIST CONTROLLER-SLOT *DEFAULT-DISK-UNIT*))) (SETQ *DEFAULT-CONTROLLER-SLOT* CONTROLLER-SLOT) (PROG1 (CONFIGURE-DISK-SYSTEM-1 CONTROLLER-TYPE CONTROLLER-SLOT) (WHEN (resource-present-p :disk) (SETQ *mcr-unit* (get-logical-unit *mcr-unit*)))) ;ab 4/18/88 disk-io 4-9 )) (DEFUN CONFIGURE-NUPI-DISK-SYSTEM (CONTROLLER-TYPE CONTROLLER-SLOT) (WITH-RQB (RQB (GET-DISK-RQB)) (LET ((BUFFER (GET-NUPI-STATUS RQB CONTROLLER-SLOT))) (DOLIST (FORMATTER '((0 . 0) (1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 6) (6 . 7))) (LET ((FORMATTER-STATUS (AREF-32B BUFFER (+ 2 (CAR FORMATTER))))) (IF (NOT (LDB-TEST %%NUPI-DEVICE-OFFLINE FORMATTER-STATUS)) (DOTIMES (DEVICE 2) (LET ((DEVICE-STATUS (AREF-32B BUFFER (+ 9. (* 2 (CAR FORMATTER)) DEVICE))) REAL-UNIT) (IF (NOT (OR (LDB-TEST %%NUPI-DEVICE-OFFLINE DEVICE-STATUS) (LDB-TEST %%NUPI-DEVICE-NOT-READY DEVICE-STATUS))) (LET ((LOG-UNIT DISK-TYPE-TABLE-INDEX)) (SET-DISK-TABLE LOG-UNIT CONTROLLER-TYPE (SETQ REAL-UNIT (+ (* (CDR FORMATTER) 8.) DEVICE)) (LDB %%NUPI-DEVICE-TYPE DEVICE-STATUS) :ONLINE (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 1) NIL CONTROLLER-SLOT) (WHEN (AND (resource-present-p :DISK) ;; don't do this for ADDIN (EQ (GET-DEVICE-TYPE LOG-UNIT) DISK-ID) (UNIT-ONLINE LOG-UNIT nil)) (IGNORE-ERRORS (SET-PACK-NAME-FROM-TABLE LOG-UNIT (GET-PACK-NAME LOG-UNIT)))) (WHEN (AND (LISTP *DEFAULT-DISK-UNIT*) (resource-present-p :disk) ;ab 4/18/88 disk-io 4-9 (= CONTROLLER-SLOT (CAR *DEFAULT-DISK-UNIT*)) (= REAL-UNIT (CADR *DEFAULT-DISK-UNIT*))) (SETQ *DEFAULT-DISK-UNIT* LOG-UNIT))))) (SETF DISK-TYPE-TABLE-INDEX (1+ DISK-TYPE-TABLE-INDEX))) (DOTIMES (DEVICE 2) (SET-STATUS (+ (* 2 (CDR FORMATTER)) DEVICE) :OFFLINE) (set-real-unit (+ (* 2 (CDR FORMATTER)) DEVICE) (+ (* (CDR FORMATTER) 8.) DEVICE)) ;09-25-87 DAB (SETF DISK-TYPE-TABLE-INDEX (1+ DISK-TYPE-TABLE-INDEX)))))))) (unless (resource-present-p :DISK) (SET-ALL-PACK-NAMES))) (define-unless :DISK (defun SET-ALL-PACK-NAMES () "Ask the HOST for info to fill in all online unit packnames." (LOOP FOR LOG-UNIT FROM 0. BELOW (ARRAY-DIMENSION DISK-TYPE-TABLE 0.) WHEN (UNIT-ONLINE LOG-UNIT nil) DO (SETF (AREF DISK-TYPE-TABLE LOG-UNIT 6.) (get-volume-name-from-host (get-real-unit-no-check log-unit))))) ;;; Addin added 12.4.87 MBC (DEFUN get-all-volume-names () (LET (result) (LOOP FOR LOG-UNIT FROM 0. BELOW (ARRAY-DIMENSION DISK-TYPE-TABLE 0.) WHEN (UNIT-ONLINE LOG-UNIT nil) DO (PUSH (GET-PACK-NAME-FROM-TABLE log-unit) result)) (REVERSE result))) ;;End of DEFINE-UNLESS ) (define-when :DISK (DEFUN CONFIGURE-MSC-NUPI2-DISK-SYSTEM (CONTROLLER-TYPE CONTROLLER-SLOT) (WITH-RQB (RQB (GET-DISK-RQB)) (LET ((BUFFER (GET-MSC-NUPI2-STATUS RQB CONTROLLER-SLOT)) ;Command #x83 ,descriptor code 0. (DEVICE-NAME (make-string 10. :initial-element '#\)) (DEVICE-OFFSET 0) (DEVICE-STATUS 0) (DEVICE-STATUS-OFFSET 0) REAL-UNIT (DESC-BLOCK-LENGTH 0) (NUMBER-OF-DEVICES 0)) (DOTIMES (I 3) (SETQ DESC-BLOCK-LENGTH (DPB (AREF BUFFER (+ *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* I)) (BYTE 8. (* 8. I)) DESC-BLOCK-LENGTH))) (SETQ NUMBER-OF-DEVICES (quotient (- DESC-BLOCK-LENGTH %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET) (AREF BUFFER (+ *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET)))) (SETQ DEVICE-OFFSET (+ *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET)) (SETQ DEVICE-STATUS-OFFSET (+ *MSC-DEVICE-STATUS-OFFSET* %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET)) (DOTIMES (DEVICE NUMBER-OF-DEVICES) (array-initialize DEVICE-NAME #\) ;reinitialize string to spaces. (SETQ DEVICE-STATUS 0) (SET-DISK-TABLE DISK-TYPE-TABLE-INDEX CONTROLLER-TYPE (SETQ REAL-UNIT (char-int (AREF BUFFER DEVICE-OFFSET))) (STRING-RIGHT-TRIM '(#\) (DOTIMES (I (1- (AREF BUFFER ;length of device name in status block (+ *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET))) DEVICE-NAME) ;return the string just built (SETf (aref DEVICE-NAME i) (AREF BUFFER (+ DEVICE-OFFSET 1 I))))) (IF (AND (DOTIMES (I (AREF BUFFER (+ *MSC-DEVICE-STATUS-OFFSET* %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET)) DEVICE-STATUS) (SETQ DEVICE-STATUS (DPB (AREF BUFFER (+ I DEVICE-STATUS-OFFSET)) (BYTE 8. (* 8. I)) DEVICE-STATUS))) (or (LDB-TEST %%NUPI-DEVICE-OFFLINE DEVICE-STATUS) (LDB-TEST %%NUPI-DEVICE-NOT-READY DEVICE-STATUS))) :OFFLINE :ONLINE) (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 1) NIL CONTROLLER-SLOT) (WHEN (AND (EQ (GET-DEVICE-TYPE DISK-TYPE-TABLE-INDEX) DISK-ID) (UNIT-ONLINE DISK-TYPE-TABLE-INDEX nil)) (IGNORE-ERRORS (SET-PACK-NAME-FROM-TABLE DISK-TYPE-TABLE-INDEX (GET-PACK-NAME DISK-TYPE-TABLE-INDEX)))) (WHEN (AND (LISTP *DEFAULT-DISK-UNIT*) (resource-present-p :disk) ;ab 4/18/88 disk-io 4-9 (= CONTROLLER-SLOT (CAR *DEFAULT-DISK-UNIT*)) (= REAL-UNIT (CADR *DEFAULT-DISK-UNIT*))) (SETQ *DEFAULT-DISK-UNIT* DISK-TYPE-TABLE-INDEX)) (SETQ DEVICE-OFFSET (+ DEVICE-OFFSET (AREF BUFFER (+ *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET)))) (SETQ DEVICE-STATUS-OFFSET (+ DEVICE-STATUS-OFFSET (AREF BUFFER (+ *MSC-DEVICE-STATUS-OFFSET* %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET)))) (SETF DISK-TYPE-TABLE-INDEX (1+ DISK-TYPE-TABLE-INDEX)))))) ;;End of DEFINE-WHEN ) (make-obsolete CONFIGURE-DISK-SYSTEM "use initialize-disk-system with no arguments instead") (DEFUN (:COND (resource-present-p :DISK) CONFIGURE-DISK-SYSTEM-1) (&OPTIONAL (CONTROLLER-TYPE (GET-IF-TYPE *DEFAULT-DISK-UNIT*)) (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*)) "Populates the SI:DISK-TYPE-TABLE. Controller-type is a string with the following values: :NPI,:NPE and :MSC. Controller-slot is an integer from 0 to 15." (case CONTROLLER-TYPE (:NPI (CONFIGURE-NUPI-DISK-SYSTEM CONTROLLER-TYPE CONTROLLER-SLOT)) ((:NPE :MSC :NP2) (CONFIGURE-MSC-NUPI2-DISK-SYSTEM CONTROLLER-TYPE CONTROLLER-SLOT)))) (DEFUN (:COND (NOT (resource-present-p :DISK)) CONFIGURE-DISK-SYSTEM-1) (&OPTIONAL (CONTROLLER-TYPE (GET-IF-TYPE *DEFAULT-DISK-UNIT*)) (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*)) (case CONTROLLER-TYPE (:NPI (CONFIGURE-NUPI-DISK-SYSTEM CONTROLLER-TYPE CONTROLLER-SLOT)))) ;;AB 6/25/87. Don't mess with VIRTUAL-MEMORY-SIZE here. It is already set up. (DEFUN DISK-INIT (&OPTIONAL (UNIT *DEFAULT-DISK-UNIT*)) (SETQ *DEFAULT-UNIT-FROM-MEM* ()) ;be sure and try to get it from memory! (UNWIND-PROTECT ;what is this protecting? (INITIALIZE-DISK-SYSTEM) ;; ...initialize-disk-system may have a new value for us! (SETQ UNIT *DEFAULT-DISK-UNIT*)) (SETQ DISK-PACK-NAME (GET-PACK-NAME UNIT))) ;; Rel 2.0 patch 3-11, -ab. ;; This MUST not be run on warm boot BEFORE the process system is initialized. ;; It has to be this way because info about the scheduler state is inconsistent ;; on warm boot until the scheduler is initialized by the PROCESS init, which ;; should come before this one on the system inits. ;; Disk-init can't be called until scheduler info is consistent. ;; ;; Patch 1-75 to implement real *LOADED-BAND* variable. (Rel 1.0) ;; Requires MCR 216 or later (although the patch version won't have this restriction). ;; Set up System Initializations so that Process init comes BEFORE Disk Init. ;; First delete process init. (delete-initialization "Process" '(SYSTEM)) ;; Now add disk init to front of list (ADD-INITIALIZATION "DISK-INIT" '(DISK-INIT) '(SYSTEM NORMAL HEAD-OF-LIST)) ;; Now add Process to front of list (will be before disk init) (ADD-INITIALIZATION "Process" '(PROCESS-INITIALIZE) '(SYSTEM NORMAL HEAD-OF-LIST)) (DEFVAR *LOADED-BAND* () "String naming the currently loaded Lisp world partition") (DEFVAR *LOADED-MCR-BAND* () "String naming the currently loaded microcode partition") (define-unless :DISK (defun get-volume-name-from-host (&optional real-unit) (declare (special disk-channel)) (let ((acb (add:get-acb Small-Disk-Command-Size t)) (ch (add:find-channel Disk-Channel))) (unwind-protect (progn ;; Fill in command overhead (add:init-acb acb %MC-Disk-Cmd %DC-Get-Volume-Name) ;; Input parameters (add:load-parms-16b acb real-unit) ;; Execute command (add:transmit-packet-and-wait acb ch) (add:check-error acb) ;; Return values (add:get-acb-string acb (+ %GPL-Physical-Unit 2))) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb)))) (DEFUN Get-Volume-Name (&optional logical-unit) "Returns volume name string for DISK-UNIT." (IF logical-unit (SETQ logical-unit (get-real-unit logical-unit)) (SETQ logical-unit load-unit)) (get-volume-name-from-host logical-unit)) (DEFUN Get-Booted-Load-Band-Info () "Returns partition descriptor for the currently running load band." (declare (special disk-channel)) (let ((acb (add:get-acb Small-Disk-Command-Size t)) (ch (add:find-channel Disk-Channel))) (unwind-protect (progn ;; Init command overhead (add:init-acb acb %MC-Disk-Cmd %DC-Get-Booted-Load-Band-Info) (add:transmit-packet-and-wait acb ch) (add:check-error acb)) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb)) ;; Return values (get-partition-descriptor 0 acb 0))) (DEFUN Get-Booted-Microcode-Band-Info () "Returns partition descriptor for the currently running microcode band." (declare (special disk-channel)) (let ((acb (add:get-acb Small-Disk-Command-Size t)) (ch (add:find-channel Disk-Channel))) (unwind-protect (progn ;; Init command overhead (add:init-acb acb %MC-Disk-Cmd %DC-Get-Booted-Mcr-Band-Info) (add:transmit-packet-and-wait acb ch) (add:check-error acb) ;; Return values (get-partition-descriptor 0 acb 0)) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb)))) ;;; New forms to ask MAC for Startup info. 1.25.88 MBC ;;ab 3/17/88. Fix so will never return empty string. If ;; there was no entry in startup file, default to the ;; name of the boot disk. (DEFUN Get-Startup-Default-Device (&aux dev-string) "Returns Default Device name string." (declare (special disk-channel)) (SETQ dev-string (let ((acb (add:get-acb Small-Disk-Command-Size t)) (ch (add:find-channel Disk-Channel))) (unwind-protect (progn (add:init-acb acb %MC-Disk-Cmd %DC-Get-Startup-Default-Device-Info) (add:transmit-packet-and-wait acb ch) (add:check-error acb) (add:get-acb-string acb (+ %GPL-Physical-Unit 2))) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb)))) (WHEN (ZEROP (LENGTH (THE string dev-string))) (SETQ dev-string (get-volume-name-from-host 0))) dev-string) (DEFUN Get-Startup-Host-Name () "Returns Host Name string." (declare (special disk-channel)) (let ((acb (add:get-acb Small-Disk-Command-Size t)) (ch (add:find-channel Disk-Channel))) (unwind-protect (progn (add:init-acb acb %MC-Disk-Cmd %DC-Get-Startup-Host-Name-Info) (add:transmit-packet-and-wait acb ch) (add:check-error acb) (add:get-acb-string acb (+ %GPL-Physical-Unit 2))) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb)))) ;;End of DEFINE-UNLESS ) (defun (:cond (not (resource-present-p :DISK)) GET-LOADED-BAND-FROM-A-MEMORY) () (setq *loaded-band* (second (get-booted-load-band-info))) (setq *loaded-mcr-band* (second (get-booted-microcode-band-info))) *loaded-band*) (DEFUN (:cond (resource-present-p :DISK) GET-LOADED-BAND-FROM-A-MEMORY) () ;; Fortunately, the A-memory address below will NOT change unless the ;; boot PROMs or processor architecture change. ;; The Ucode (after MCR 216) stores a 32-bit integer representing the load ;; band name in a special location in high a-memory during the boot process. (LET ((LOADED-BAND-LOCATION (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-LOAD-NAME-ADDRESS)) (LOADED-MCR-LOCATION (+ A-MEMORY-VIRTUAL-ADDRESS %A-BOOT-MCR-NAME-ADDRESS))) (SETQ *LOADED-BAND* (MAKE-STRING 4.)) (SETF (AREF *LOADED-BAND* 0.) (INT-CHAR (%P-LDB (BYTE 8. 0.) LOADED-BAND-LOCATION))) (SETF (AREF *LOADED-BAND* 1.) (INT-CHAR (%P-LDB (BYTE 8. 8.) LOADED-BAND-LOCATION))) (SETF (AREF *LOADED-BAND* 2.) (INT-CHAR (%P-LDB (BYTE 8. 16.) LOADED-BAND-LOCATION))) (SETF (AREF *LOADED-BAND* 3.) (INT-CHAR (%P-LDB (BYTE 8. 24.) LOADED-BAND-LOCATION))) (SETQ *LOADED-MCR-BAND* (MAKE-STRING 4.)) (SETF (AREF *LOADED-MCR-BAND* 0.) (INT-CHAR (%P-LDB (BYTE 8. 0.) LOADED-MCR-LOCATION))) (SETF (AREF *LOADED-MCR-BAND* 1.) (INT-CHAR (%P-LDB (BYTE 8. 8.) LOADED-MCR-LOCATION))) (SETF (AREF *LOADED-MCR-BAND* 2.) (INT-CHAR (%P-LDB (BYTE 8. 16.) LOADED-MCR-LOCATION))) (SETF (AREF *LOADED-MCR-BAND* 3.) (INT-CHAR (%P-LDB (BYTE 8. 24.) LOADED-MCR-LOCATION))) ;; Now return the loaded band name. *LOADED-BAND*)) (define-unless :DISK ;;; ;;; MX Initialization ;;; (defun enable-misc () (declare (special disk-channel)) ;06-13-88 DAB (send (add:find-channel Disk-Channel) :reset t) (send (add:find-channel Disk-Channel) :turn-debug-on)) (ADD-INITIALIZATION "Add Disk-Channel reset init" '(when (and (addin-p) (add:find-channel Disk-Channel)) (send (add:find-channel DISK-CHANNEL) :add-reset-init "Initialize MISC Channel" '(send (add:find-channel Disk-Channel) :turn-debug-on))) '(:once)) ;;End of DEFINE-UNLESS ) ;; Needs to come before anything that may use it. Best on COLD init, ;; since crash function which runs on warm init refers to it. (ADD-INITIALIZATION "Initialize *LOADED-BAND* variable" '(GET-LOADED-BAND-FROM-A-MEMORY) '(:COLD :HEAD-OF-LIST))