LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031312. :SYSTEM-TYPE :LOGICAL :VERSION 18. :TYPE "LISP" :NAME "DISK-IO" :DIRECTORY ("REL3-SOURCE" "IO") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758637027. :AUTHOR "REL3" :LENGTH-IN-BYTES 39272. :LENGTH-IN-BLOCKS 39. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ;;; -*- 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 (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151; Copyright (C) 1980, Massachusetts Institute of Technology; Copyright (C) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;; "User" Disk I/O routines for Lisp machine -- macrocode portion;;; See QCOM for documentation on disk rqb's and symbol definitions.;;; Also see QDEV and DISKDEFS for other symbols and label information.;;; The label-editor and related routines have been moved out of here into DLEDIT;;; Revision:;;;  Fix GET-DISK-RQB to properly traverse the *IN-USE-RQBS-LIST* and;;;also set %%IO-RQ-Done bit in each RQB as it is allocated.  12-5-85 MBC;;;  Re-arrange PRINT-HERALD to do legal notice first. 5.22.85 MBC;;;  Fix CONFIGURE-DISK-SYSTEM to fix phantom disk problem.  Add two error codes to decode. 5.21.85 MBC-j;;;  WIRE-NUPI-RQB & CHECK-AND-MAYBE-SIGNAL-ERROR replaced for I build, to support re-wire rqb;;;    after error.  Number of blocks wired is saved in new rqb array leader cell. 3/11/85 MBC;;;  GET-REAL-UNIT now does unit checking using UNIT-ERROR flavors.  Then it calls Get-Real-Unit-No-Check;;;    to do actual aref into disk-type-table.  - 2/26/85 MBC;;;  Read-Default-Disk-Unit-From-Mem now returns logical unit number. - 2/20/85;;;  Changes to support real *LOADED-BAND* variable.  8/22/85, ab;;;  Fixed get-real-unit array-out-of-bounds error.  Added function convert-logical-unit-to-physical;;;;;; Edit History;;;;;;                   Patch;;;   Date    Author  Number   Description;;;---------------------------------------------------------------------------;;; 01-30-86   DRP      --     - Common Lisp conversion for VM2.;;;                            Broken off from IO;DISK.;;; 10-15-86   ab       --     - Changes for 2K page-size.;;; 12-11-86   ab       --     - Fix bug in Wire-Nupi-RQB when used with non-0 OFFSET.;;;                            Also added some test code (Wire-RQB-Test) for assuring;;;                            correct pages are wired & represented in scatter list.;;;                            The code is commented out here in this file.;;; 02-17-87  DAB       --     Cahnged to abse 10.;;;*** Errors should be metered, do this after the microcode is revised ***;;; The following routines are likely to be of general interest:;;; POWER-UP-DISK - makes sure a drive is powered up;;; CLEAR-DISK-FAULT - attempts to reset select-lock (fault, unsafe, device-check);;; These are interesting if you really want to do I/O;;; DISK-READ;;; DISK-WRITE;;; These are interesting if you really want to look at device tables, real vs. logical units etc.;;; NUPI-DISKP ;;; GET-REAL-UNIT ;;; RQB-REAL-UNIT ;;; GET-LOGICAL-UNIT ;;; --------------------------------------------------;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; I/O Routines;;;;(DEFUN WAIT-AND-CHECK-ERRORS (RQB &OPTIONAL (REAL-UNIT (RQB-REAL-UNIT RQB)))  "Wait for completion & check errors of rqbs initiated to Nupi."  (LET ((LOGICAL-UNIT (GET-LOGICAL-UNIT REAL-UNIT)))    (COND      ((NUPI-DISKP LOGICAL-UNIT)       (WAIT-IO-DONE RQB (case (GET-DEVICE-type LOGICAL-UNIT)       (1 "Tape Initiate")   ;tape-id       (2 "Disk Initiate")   ;disk-id               (t "Unknown Initiate")))       (CHECK-AND-MAYBE-SIGNAL-ERROR RQB LOGICAL-UNIT))      (T (FERROR "Illegal logical unit number: ~S" LOGICAL-UNIT)))))  (DEFUN DISK-READ (RQB UNIT ADDRESS &OPTIONAL (nblocks (RQB-nblocks RQB)) IGNORE (OFFSET 0.) (INITIATE NIL))  "Read data from disk UNIT at block ADDRESS into RQB.The length of data read must be <= #blocks in the RQB.UNIT can be either a disk unit number or a function to performthe transfer.  That is how transfers to other machines' disks are done."  (COND    ((NUMBERP UNIT)     (COND       ((NUPI-DISKP UNIT)(UNWIND-PROTECT (PROGN (IF (> nblocks (RQB-nblocks RQB))   (FERROR    "Attempted to wire ~d block~p when only ~d block~p exist~:[~;s~] in RQB."    nblocks nblocks (RQB-nblocks RQB) (RQB-nblocks RQB)   (= 1. (RQB-nblocks RQB)))) (WIRE-NUPI-RQB RQB nblocks T T OFFSET) (NUPI-READ-WIRED RQB (GET-REAL-UNIT UNIT) UNIT ADDRESS INITIATE))  (UNLESS INITIATE    (UNWIRE-DISK-RQB RQB)))RQB)       (T (FERROR "Illegal unit number passed to disk read: ~S" UNIT))))    ((FUNCALL UNIT :READ RQB ADDRESS OFFSET nblocks)))) (DEFUN DISK-WRITE (RQB UNIT ADDRESS &OPTIONAL (nblocks (RQB-nblocks RQB)) IGNORE (OFFSET 0.) (INITIATE NIL))  "Write data from disk UNIT at block ADDRESS into RQB.The length of data read must be <= #blocks in the RQB.UNIT can be either a disk unit number or a function to performthe transfer.  That is how transfers to other machines' disks are done.The unit is checked whether it is a NUPI device or old style disk."  (COND    ((NUMBERP UNIT)     (COND       ((NUPI-DISKP UNIT)(UNWIND-PROTECT (PROGN (IF (> nblocks (RQB-nblocks RQB))   (FERROR    "Attempted to wire ~d block~p when only ~d block~p exist~:[~;s~] in RQB."    nblocks nblocks (RQB-nblocks RQB) (RQB-nblocks RQB)   (= 1. (RQB-nblocks RQB)))) (WIRE-NUPI-RQB RQB nblocks T T OFFSET) (NUPI-WRITE-WIRED RQB (GET-REAL-UNIT UNIT) UNIT ADDRESS INITIATE))  (UNLESS INITIATE    (UNWIRE-DISK-RQB RQB)))RQB)       (T (FERROR "illegal unit number passed to disk write: ~S" UNIT))))    ((FUNCALL UNIT :WRITE RQB ADDRESS OFFSET nblocks))))  ;;;;;;  Display the data returned by the nupi command device status, opcode = 2.;;;(DEFUN DISPLAY-DEVICE-STATUS (&OPTIONAL (LOGICAL-UNIT 0)) "Issues device status and displays raw information from LOGICAL-UNIT." (LET  ((BUFFER (CASE (GET-IF-TYPE LOGICAL-UNIT)                    (:NPI (GET-DEVICE-STATUS LOGICAL-UNIT))                    ((:MSC :NPE) (GET-MSC-NUPI2-DEVICE-STATUS LOGICAL-UNIT))))   )  (CASE   (GET-IF-TYPE LOGICAL-UNIT)   (:NPI    (FORMAT     T     "~%Halfword index       Value         - Nupi I Device Status (in hex) for unit ~d."     LOGICAL-UNIT)    (DOTIMES (I  %NUPI-LENGTH-RQ-DEV-STATUS)      (FORMAT T "~&   ~d ~22,8T~16r" I (AREF BUFFER I))))   ((:MSC :NPE)    (FORMAT     T     "~%Fullword index       Value         - MSC  Nupi II Device Status (in hex) for unit ~d."     LOGICAL-UNIT)    (LET     ((DESC-BLOCK-LENGTH 0) (ENTRY-LENGTH 0) (STATUS-WORD 0) (OFFSET 0))     (DOTIMES (I  3)       (SETQ DESC-BLOCK-LENGTH (DPB (AREF BUFFER I) (BYTE 8. (* 8. I)) DESC-BLOCK-LENGTH)))     (DOTIMES (I  4)       (SETF STATUS-WORD             (DPB (AREF BUFFER (+ I %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET))                  (BYTE 8. (* 8. I))                  STATUS-WORD)))     (FORMAT T "~&   ~a ~22,8T~16r" 'CURRENT STATUS-WORD)     (SETQ OFFSET DESC-BLOCK-LENGTH)     (DOTIMES (I  3)       (SETQ DESC-BLOCK-LENGTH (DPB (AREF BUFFER (+ OFFSET I))                                    (BYTE 8. (* 8. I))                                    DESC-BLOCK-LENGTH)))     (SETQ ENTRY-LENGTH (quotient DESC-BLOCK-LENGTH                            (AREF BUFFER                                  (+ OFFSET %MSC-NUPI-DESC-BLOCK-ENTRY-SIZE-OFFSET))))     (DOTIMES (COUNT  ENTRY-LENGTH)       (DOTIMES (I  4)         (SETF STATUS-WORD               (DPB (AREF BUFFER (+ I OFFSET %MSC-NUPI-DESC-BLOCK-DEVICE-OFFSET))                    (BYTE 8. (* 8. I))                    STATUS-WORD)))       (FORMAT T "~&   ~d ~22,8T~16r" COUNT STATUS-WORD)))))));;;;;; Wire down the rqb and get the device-status;;;  Use this if you write a routine to translate the information into English.;;;(DEFUN GET-DEVICE-STATUS (&OPTIONAL (LOGICAL-UNIT 0.))  "Issues a device status to LOGICAL-UNIT and returns the result as an array."  (with-rqb (RQB (GET-DISK-RQB))    (LET (RESULT)      (WIRE-NUPI-RQB RQB)      (DEVICE-STATUS-WIRED RQB (GET-REAL-UNIT LOGICAL-UNIT) logical-unit)      (UNWIRE-DISK-RQB RQB)      (SETQ RESULT (RQB-BUFFER RQB))      (RETURN-DISK-RQB RQB)      RESULT)))  (DEFUN GET-MSC-NUPI2-DEVICE-STATUS (&OPTIONAL (LOGICAL-UNIT 0))  "Issues a device status to LOGICAL-UNIT and returns the result as an array."  ;;Command #x83 is used wth a descriptor code of 00.  (with-rqb (RQB (GET-DISK-RQB))    (LET (RESULT)      (WIRE-NUPI-RQB RQB)      (DEVICE-MSC-NUPI2-STATUS-WIRED RQB (GET-REAL-UNIT LOGICAL-UNIT) LOGICAL-UNIT)      (UNWIRE-DISK-RQB RQB)      (setf result (RQB-8-BIT-BUFFER RQB))      (RETURN-DISK-RQB RQB)      RESULT      )));;;;;;  We must have the correct length or the nupi command will die.;;;(DEFUN DEVICE-STATUS-WIRED (RQB REAL-UNIT LOGICAL-UNIT)  (SETF (AREF RQB %IO-RQ-TRANSFER-LENGTH) %NUPI-LENGTH-RQ-DEV-STATUS)  (SETF (AREF RQB %IO-RQ-TRANSFER-LENGTH-HIGH) 0.)  (NUPI-RUN RQB REAL-UNIT LOGICAL-UNIT 0. %NUPI-COMMAND-RQ-DEV-STATUS "Device Status"))  (DEFUN DEVICE-MSC-NUPI2-STATUS-WIRED (RQB REAL-UNIT LOGICAL-UNIT)  (LET* ((SLOT (GET-DEVICE-SLOT-NUMBER LOGICAL-UNIT))         (DESCRIPTOR-BLOCK (AREF CONTROLLER-SLOT-TABLE SLOT 1)))    (setf (Aref rqb  %IO-RQ-TRANSFER-LENGTH)  %MSC-NUPI2-LENGTH-RQ-STATUS)    (setf (Aref rqb  %IO-RQ-TRANSFER-LENGTH-HIGH) 0)    (setf (Aref rqb  %IO-RQ-DEVICE-ADDRESS-WORD) 0)    (BLOCK-NUPI-RUN RQB                    REAL-UNIT                    SLOT                    DESCRIPTOR-BLOCK                    0                    %NUPI-COMMAND-RQ-DEVICE-STATUS                    "Device Status"))) ;;;;;; Wire down the rqb and get the nupi-status;;;(DEFUN GET-NUPI-STATUS (RQB &OPTIONAL (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*) (nblocks 1.) (OFFSET 0.))  (WIRE-NUPI-RQB RQB nblocks T T OFFSET)  (NUPI-STATUS-WIRED RQB CONTROLLER-SLOT)  (UNWIRE-DISK-RQB RQB)  (RQB-BUFFER RQB))  (DEFUN GET-MSC-NUPI2-STATUS (RQB &OPTIONAL (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*)                              (DESCRIPTOR-CODE 0) (NPAGES 0.1) (OFFSET 0))  (WIRE-NUPI-RQB RQB NPAGES T T OFFSET)  (MSC-NUPI-STATUS-WIRED RQB DESCRIPTOR-CODE CONTROLLER-SLOT)  (UNWIRE-DISK-RQB RQB)  (LET ((BUFFER (RQB-8-BIT-BUFFER RQB)))    (DO* ((BLOCK-LENGTH 0)          (BUFFER-OFFSET 0 (+ BUFFER-OFFSET BLOCK-LENGTH)))         ((>= BUFFER-OFFSET (ARRAY-DIMENSION BUFFER 0)) BUFFER)      (SETF BLOCK-LENGTH            (DPB (AREF BUFFER (+ BUFFER-OFFSET 0))                 #o10                 (DPB (AREF BUFFER (+ BUFFER-OFFSET 1))                      #o1010                      (DPB (AREF BUFFER (+ BUFFER-OFFSET 2)) #o2010 BLOCK-LENGTH))))      (CASE (char-int (AREF BUFFER (+ BUFFER-OFFSET 3)))               (1 (SETF *MSC-UNIT-SELECT-DEVICE-TYPE-OFFSET* BUFFER-OFFSET))               (2 (SETF *MSC-DEVICE-STATUS-OFFSET* BUFFER-OFFSET))               (#o101 (SETF *MSC-FORMATTER-CONTROLLER-SELECT-DEVICE-TYPE-OFFSET* BUFFER-OFFSET))               (#o102 (SETF *MSC-FORMATTER-CONTROLLER-STATUS-OFFSET* BUFFER-OFFSET))               (T (RETURN BUFFER))))));;;;;;  We must have the correct length or the nupi command will die.;;;(DEFUN NUPI-STATUS-WIRED (RQB &OPTIONAL (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*))  (SETF (AREF RQB %IO-RQ-TRANSFER-LENGTH) %NUPI-LENGTH-RQ-NUPI-STATUS)  (SETF (AREF RQB %IO-RQ-TRANSFER-LENGTH-HIGH) 0.)  (BLOCK-NUPI-RUN RQB                  0                  CONTROLLER-SLOT                  (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 1)                  0                  %NUPI-COMMAND-RQ-NUPI-STATUS                  "Nupi status"))(DEFUN MSC-NUPI-STATUS-WIRED (RQB &OPTIONAL (DESCRIPTOR-CODE 0)                               (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*))  (setf (Aref RQB %IO-RQ-TRANSFER-LENGTH) %MSC-NUPI2-LENGTH-RQ-STATUS)  (setf (Aref RQB %IO-RQ-TRANSFER-LENGTH-HIGH) 0)  (BLOCK-NUPI-RUN RQB                  0                  CONTROLLER-SLOT                  (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 1)                  DESCRIPTOR-CODE                  %NUPI-COMMAND-RQ-CNTL-STATUS                  "MSC Status"))(DEFUN NUPI-WRITE-WIRED (RQB UNIT LOGICAL-UNIT ADDRESS &OPTIONAL INITIATE)  (NUPI-RUN RQB UNIT LOGICAL-UNIT ADDRESS %NUPI-COMMAND-WRITE "write" INITIATE))  (DEFUN NUPI-READ-WIRED (RQB UNIT LOGICAL-UNIT ADDRESS &OPTIONAL INITIATE)  (NUPI-RUN RQB UNIT LOGICAL-UNIT ADDRESS %NUPI-COMMAND-READ "read" INITIATE))  (DEFUN WIRE-NUPI-RQB (rqb &optional (n-blocks (ARRAY-LEADER rqb %Io-Rq-Leader-N-Blocks))      (wire-p t) set-modified (offset 0.))  "RQB is the disk request buffer; N-BLOCKS is the number of disk blocks in the IO.  WIRE-Pdictates to wire or unwire the blocks; the set-modified will mark the page as modified if requested. The offset parameter is the block offset within the array at which to start the scatter list and begin wiring pages."  ;; Make sure user has provided consistent io-length/offset parameters.  (SETQ n-blocks (MIN n-blocks (- (rqb-nblocks rqb) offset)))  (LET* ((command-block-addr   (logand (%pointer rqb) (- page-size))) (data-block-0-addr   (%pointer-plus command-block-addr page-size)) (data-block-offset-addr   (%pointer-plus data-block-0-addr (* offset disk-block-word-size))) (odd-offset-blocks (mod offset disk-blocks-per-page)) (n-pages-to-wire   (ceiling (+ n-blocks odd-offset-blocks) disk-blocks-per-page)))        ;; First wire data pages (= 2 blocks each) starting at offset to end of RQB.    (DO ((loc data-block-offset-addr      (%pointer-plus loc page-size)) (npages 0 (1+ npages)))((>= npages n-pages-to-wire))      (WIRE-PAGE loc wire-p set-modified))    ;; Now wire command block.    (WIRE-PAGE command-block-addr wire-p set-modified)    ;; Fix up the RQB overhead info & make the scatter list.    (WHEN wire-p      (SETF (rqb-n-blocks-wired rqb) n-blocks);; actual # blocks in IO.      (DO* ((count 0 (1+ count))    (vadr data-block-offset-addr  (%pointer-plus vadr disk-block-word-size))    (padr) (entry 0.) (bytes 0.) (old-padr 0.))   ((>= count n-blocks)    (IF (= entry 1.);; Do not set scatter bit if only 1 entry(PROGN  ;; Buffer pointer word gets physical address, #bytes to transfer count word.  ;; Are copied from scatter list entry 0 (where we built them).  Also reset scatter bit.  (SETF (rq-buffer rqb) (rq-scatter-entry-address rqb 0))  (SETF (rq-transfer-length rqb) (rq-scatter-entry-bytes rqb 0))  (clear-rq-scatter-bit rqb))(PROGN  ;; Transfer word gets TOTAL transfer length, buffer pointer gets physical address  ;; of parameter list (ie, in RQB).  And set scatter bit.  (SETF (rq-transfer-length rqb) (* n-blocks disk-block-byte-size))  (SETF (rq-buffer rqb)(get-physical-address rqb %io-rq-parameter-list-word))  (set-rq-scatter-bit rqb))));; Body of DO.(SETQ padr (%physical-address vadr))(IF (= padr (+ old-padr disk-block-byte-size))    ;; Contiguous memory.  Continue this scatter entry.    (PROGN      (SETQ bytes (+ bytes disk-block-byte-size));; accumulate bytes      (SETF (rq-scatter-entry-bytes rqb (1- entry)) bytes)      (SETQ old-padr (+ old-padr disk-block-byte-size)))    ;; Not contiguous.  Start next scatter entry.    (PROGN      (SETF (rq-scatter-entry-address rqb entry) padr)      (SETF (rq-scatter-entry-bytes rqb entry) disk-block-byte-size)      (SETQ bytes disk-block-byte-size)      (INCF entry)      (SETQ old-padr padr)))))    ));;; This will return the nubus physical address(DEFUN get-physical-address (array &optional (offset 0.)     (long-array-flag (%p-ldb-offset %%array-long-length-flag array 0)))  (%physical-address    (%POINTER-PLUS array (+ long-array-flag 1 offset))))(DEFUN unwire-disk-rqb (rqb)  (WHEN (%io-done rqb)    (LET* ((pages-to-unwire;; round up & add 1 for command page.     (1+ (CEILING (rqb-n-blocks rqb) disk-blocks-per-page))))      (DO ((loc (LOGAND (%POINTER rqb) (- page-size))(%POINTER-PLUS loc page-size))   (pg 0 (1+ pg)))  ((>= pg pages-to-unwire))(unwire-page loc))      (SETF (rqb-n-blocks-wired rqb) 0))  ));;;;;;;;;;;;;;;;;;;;;; ;;; Test code;;;;;(defun wire-rqb-test (rqb-size &optional (display nil));;  (loop for offset from 0 to (1- rqb-size);;with r = (get-disk-rqb rqb-size);;do;;(loop for io-size from 1 to (- (rqb-n-blocks r) offset);;      with cmd-block-adr = nil;;      with data0-adr = nil;;      do;;      (format t "~%RQB #blocks: ~a, IO size ~a starting block ~a";;      (rqb-n-blocks r) io-size offset);;      (wire-nupi-rqb r io-size t nil offset);;      (when display (print-rqb r));;      ;;;;      ;; Make sure all RQB blocks are wired.;;      (setq cmd-block-adr (logand (%pointer r) (- page-size));;    data0-adr (%pointer-plus cmd-block-adr page-size));;      ;;;;      ;; Make sure command block is wired.;;      (unless (= 5 (ldb (byte 3 0) (%page-status cmd-block-adr)));wired;;(format t "~%RQB command block page not wired."));;      ;;;;      ;; Make sure all blocks in this io are wired.;;      (loop for bl = offset then (1+ bl);;    for count = 0 then (1+ count);;    for adr = (%pointer-plus data0-adr (* offset disk-block-word-size));;        then (%pointer-plus adr disk-block-word-size);;    until (= count io-size);;    do;;    (unless (= 5 (ldb (byte 3 0) (%page-status adr)));;      (format t "~%RQB data block ~a not wired." bl)));;      ;;;;      ;; Check scatter table integrity;;      (wire-rqb-test-scatter-table r offset io-size data0-adr);;      ;;;;      ;; Unwire RQB, then make sure all pages are unwired;;      (setf (aref r %io-rq-information);;    (dpb 1 %%io-rq-done (aref r %io-rq-information)));;      (unwire-disk-rqb r);;      (loop for pg from 0 below (1+ (ceiling rqb-size disk-blocks-per-page));;    do;;    (when (= 5 (ldb (byte 3 0) (%page-status cmd-block-adr)));;      (format t "~%RQB page ~a still wired" pg)));;      (clear-rqb-command-block r);;finally (return-disk-rqb r));;  ));;(defun wire-rqb-test-scatter-table (r offset io-size data0-adr);;  (loop with first-vadr = (%pointer-plus data0-adr (* offset disk-block-word-size));;with very-first-padr = (when (%page-status first-vadr) (%physical-address first-vadr));;with scatter = 0;;with scat-entry = 0;;with contig-flag = nil;;with this-scatter-io-length = 0;;        with this-scatter-start-padr = very-first-padr;;with total-io-bytes = (* io-size disk-block-byte-size);;with scatter-table-start =;;     (get-physical-address r %io-rq-parameter-list-word);;with rqb-scatter-bit = (ldb %%io-rq-command-scatter-bit (high (rq-command r)));;with rqb-scatter-bytes = (rq-scatter-entry-bytes r scat-entry);;with rqb-scatter-padr = (rq-scatter-entry-address r scat-entry);;with rqb-buffer-adr = (rq-buffer r);;with rqb-transfer-size = (rq-transfer-length r);;for bl = offset then (1+ bl);;for count = 0 then (1+ count);;for vadr = first-vadr;;    then (%pointer-plus vadr disk-block-word-size);;for padr = very-first-padr;;    then (when (%page-status vadr) (%physical-address vadr))    ;;until (= count io-size);;do;;(when (null padr);;  (ferror nil "~%RQB data block ~a not in in memory." bl));;        (if (= padr (+ this-scatter-start-padr this-scatter-io-length));;    (progn;;      ;; contiguous just add to markers;;      (setq this-scatter-io-length (+ this-scatter-io-length disk-block-byte-size);;    contig-flag t));;    ;; not contiguous.  make sure entry matches now & start next one.;;    (progn;;      (unless (= rqb-scatter-padr this-scatter-start-padr);;(format t "~%Scatter entry ~a is #x~x, should be #x~x";;scat-entry rqb-scatter-padr this-scatter-start-padr));;      (unless (= rqb-scatter-bytes this-scatter-io-length);;(format t "~%Scatter entry ~a is #x~x bytes, should be #x~x";;scat-entry rqb-scatter-bytes this-scatter-io-length));;      (setq this-scatter-io-length disk-block-byte-size;;    this-scatter-start-padr padr;;    scat-entry (1+ scat-entry);;    contig-flag nil;;    rqb-scatter-bytes (rq-scatter-entry-bytes r scat-entry);;    rqb-scatter-padr (rq-scatter-entry-address r scat-entry))));;finally;;;;;;;; Check last scatter entry.;;(when contig-flag;;  (unless (= rqb-scatter-padr this-scatter-start-padr);;    (format t "~%Scatter entry ~a is #x~x, should be #x~x";;    scat-entry rqb-scatter-padr this-scatter-start-padr));;  (unless (= rqb-scatter-bytes this-scatter-io-length);;    (format t "~%Scatter entry ~a is #x~x bytes, should be #x~x";;    scat-entry rqb-scatter-bytes this-scatter-io-length)));;;;;;;; Verify total transfer size;;(unless (= rqb-transfer-size total-io-bytes);;  (format t "~%Total transfer length is #x~x, should be #x~x";;  rqb-transfer-size total-io-bytes));;;;;;;; Verify scatter-bit setting correct, and that scatter buffer adr is right;;(if (>= scat-entry 1) (setq scatter 1));;(unless (= rqb-scatter-bit scatter);;  (format t "~%Scatter bit is ~a when it should be ~a" rqb-scatter-bit scatter));;(if (= scatter 1);;    (unless (= rqb-buffer-adr scatter-table-start);;      (format t "~%Scatter on, Scatter buffer address is #x~x, should be #x~x";;      rqb-buffer-adr scatter-table-start));;    (unless (= rqb-buffer-adr very-first-padr);;      (format t "~%Scatter off, Scatter buffer address is #x~x, should be #x~x";;      rqb-buffer-adr very-first-padr))));;  )(Defun Check-And-Maybe-Signal-Error (Rqb Logical-Unit &Optional Address ignore CMD-NAME)  "If a wired rqb has an error, signal it. Parse device type. If retry is indicated return T, else nil"  (If (Not (Ldb-Test %%Nupi-Status-High-Complete (AREF Rqb %Io-Rq-Status-High)))      (Ferror () "~A request went to done state but status complete bit not set: ~s"      (Get-Device-Name Logical-Unit) Rqb))  (Select (Get-Device-Type Logical-Unit)    (Tape-Id (Handle-Tape-Error Rqb));handle tape error or status    ((Disk-Id Nil);assume NIL is a disk     (If (Ldb-Test %%Nupi-Status-High-Error (AREF Rqb %Io-Rq-Status-High)) (Let ((Cmd-And-Options (AREF Rqb %Io-Rq-Command-High)))   (WHEN (FBOUNDP 'log-a-disk-error) (LOG-A-DISK-ERROR rqb))   ;; RQB *MUST* still be wired.  If the OFFSET option to disk-read, etc, was   ;; used, the RQB overhead information is not complete enough to deduce   ;; both the offset and the IO length, which both must be known in order   ;; to perform the wiring correctly! (The RQB overhead just contains the   ;; number of blocks, and the number of wired blocks (io length); it does   ;; not indicate the block offset where the io began.;;   (Wire-Nupi-Rqb Rqb;;  (Min (Array-Leader Rqb %Disk-Rq-Leader-N-BLOCKS);;       (Array-Leader Rqb %Disk-Rq-Leader-N-blocks-Wired)))   (Setf (AREF Rqb %Io-Rq-Command-High) Cmd-And-Options)   (Cerror :Retry-Disk-Operation () 'Disk-Error   "Nupi error: disk unit ~D, address: ~O, ~%        ~A on ~A command."   Logical-Unit Address (Decode-Nupi-Status Rqb) CMD-NAME)   T)))    (Otherwise     (Ferror ()     "Device type unknown in disk-type-table, unit ~A, device type ~A associated RQB ~A "     Logical-Unit (Get-Device-Type Logical-Unit) Rqb))))  ;(Defconstant NUPI-EORM+EOF 78.)  (defvar  DEFECT%Lost-One 0)(defun LOG-A-DISK-ERROR (rqb)  "Log in system LOG. Sometimes add to log for formatting disk."  (Let* ((Device-Error (Ldb %%Nupi-Status-Low-Dev-Error (Aref Rqb %Io-Rq-Status))) (Status-Word (Dpb (Aref Rqb %Io-Rq-Status-high) (Byte 16. 16.) (Aref Rqb %Io-Rq-Status))) (command-word (dpb (Aref Rqb %IO-RQ-command-high)    #o2020    (Aref Rqb %IO-RQ-command))) (residue-count    ;;; Residue-Count is the number of bytes not transfered.  It should   ;;;   always be a mulitiple of the device's native block size.   (dpb (Aref Rqb %IO-RQ-TRANSFER-LENGTH-HIGH)#o2020(Aref Rqb %IO-RQ-TRANSFER-LENGTH))) (disk-address (dpb (Aref Rqb %IO-RQ-DEVICE-ADDRESS-HIGH)    #o2020    (Aref Rqb %IO-RQ-DEVICE-ADDRESS))) (device-address (DEFECT%Calculate-Device-Block Residue-Count disk-Address)) (real-unit (Ldb si:%%nupi-unit-select command-word)))    (when       (and (>= Device-Error #xC1);If in range for "grown" defect,   (<= Device-Error #xCA))      (Unless (DEFECT%Log-One;..add to log of formatable records.Real-Unitdevice-address   Status-Word)(incf DEFECT%Lost-One)));;    (syslog:add-record :disk-error;Always try to put in system log;;       (list;; '(:format-f syslog:disk-error-log-display);; (list :real-unit real-unit);; (list :status-word status-word);; (list :residue-count residue-count);; (list :disk-address disk-address);; (list :device-address device-address)))    ))(defun DEFECT%Calculate-Device-Block (residue-count disk-address )  "Return the device-block-address where the defect occurred."  (let* ((x (ceiling (mod residue-count 1024.) 256.)) (device-block-address (* disk-address 4)))    (if (zerop x)device-block-address(- (+ device-block-address 4) x))))(defun DEFECT%Log-One (ignore &rest ignore);real-unit status-word device-block-address)  "Dummy function"  T);;(defun syslog:disk-error-log-display (event-record log-stream);;  (format log-stream;;  "~%~% Disk Error occurred on logical unit ~D.~% Time Recorded: ";;  (get-logical-unit (second (assoc :real-unit event-record))));;  (time:print-universal-time;;    (second (assoc :time event-record)) log-stream);;  (let* ((status (second (assoc :status-word event-record)));; (nupi-error (ldb (byte 8. 16.) status));; (device-error (ldb (byte 8. 8.) status)));;    (unless (zerop nupi-error);;      (format log-stream;;      "~% Nupi Error: ~a" (decode-nupi-controller-error nupi-error)));;    (unless (zerop device-error);;      (format log-stream;;      "~% Device Error: ~a" (decode-nupi-device-error device-error)));;    (format log-stream ;;    "~% Real Unit:~18T~d.   ";;    (second (assoc :real-unit event-record)));;    (format log-stream ;;    "~1,34TRQB Status (hex): ~16r,";;    status);;    (format log-stream ;;    "~% Disk Address:~18T~d.";;    (second (assoc :Disk-address event-record)));;    (format log-stream ;;    "~1,34TDevice Address:   ~d.";;    (second (assoc :Device-address event-record)));;    (format log-stream ;;    "~% Residue Count:~18T~d.";;    (second (assoc :residue-count event-record)))))(DEFUN HANDLE-TAPE-ERROR (RQB)  "Handle a tape error.  Either just set status info, returning nil, or a Cerror on a real error."; On "formatter failed to connect" try operation one more time before reporting error.  (LET* ((ERROR-CODE (LDB %%NUPI-STATUS-LOW-DEV-ERROR (AREF RQB %IO-RQ-STATUS))) (REAL-UNIT (RQB-REAL-UNIT RQB)) (UNIT (GET-LOGICAL-UNIT REAL-UNIT)) (LAST-ERROR (GET-LAST-ERROR UNIT)) (HARD-ERROR NIL))    (SET-LAST-ERROR UNIT ())    (SELECT ERROR-CODE (NUPI-EOF (SET-LAST-ERROR UNIT :EOF))    (NUPI-EORM (SET-LAST-ERROR UNIT :END-OF-RECORDED-MEDIA)       ;;; Half inch tape drive returns eorm, 4A, instead of End-Of-Tape       ;;; when it writes to the end of the tape.       ;;; Nupi does not set the error bit, so we check for write and signal error.       ;;;4.14.87       (when (= (LDB %%IO-RQ-COMMAND-COMMAND (AREF RQB %IO-RQ-COMMAND-HIGH))%NUPI-COMMAND-WRITE) (SETF (AREF RQB %IO-RQ-STATUS-HIGH) (DPB 1 %%NUPI-STATUS-HIGH-ERROR (AREF RQB %IO-RQ-STATUS-HIGH))) (SIGNAL-TAPE-ERROR RQB)))     (NUPI-EORM+EOF (SET-LAST-ERROR UNIT :END-OF-RECORDED-MEDIA))    (NUPI-FORMATTER-NOT-RESPONDING     (SET-LAST-ERROR UNIT :FORMATTER-NOT-RESPONDING)     (SETQ HARD-ERROR T)     (IF (NEQ LAST-ERROR :FORMATTER-NOT-RESPONDING) (PROCESS-ALLOW-SCHEDULE);give formatter a chance to wakeup (SIGNAL-TAPE-ERROR RQB)));failed twice --> tell user    (OTHERWISE     (SET-LAST-ERROR UNIT (LDB %%NUPI-STATUS-HIGH-CNTL-ERROR (AREF RQB %IO-RQ-STATUS-HIGH)))     (SIGNAL-TAPE-ERROR RQB)))    HARD-ERROR))  (DEFUN SIGNAL-TAPE-ERROR (RQB)  (IF (LDB-TEST %%NUPI-STATUS-HIGH-ERROR (AREF RQB %IO-RQ-STATUS-HIGH))    (CERROR () () 'TAPE-ERROR "Nupi tape error:  ~%        ~A on tape unit ~d."    (DECODE-NUPI-STATUS RQB) (GET-LOGICAL-UNIT (RQB-REAL-UNIT RQB)))))  (DEFUN NUPI-RUN (RQB UNIT LOGICAL-UNIT ADDRESS CMD CMD-NAME &OPTIONAL (INITIATE NIL))  "This is the lowest level interface to the io system. It uses the nupi command blockinterface, and will issue as many nupi requests as it takes to satisfy the number of blocksparameter. The scatter list must be set up and all pages wired."  (PROG ()    FULL-RETRY    (SETF (AREF RQB %IO-RQ-COMMAND-HIGH)  (DPB CMD %%IO-RQ-COMMAND-COMMAND (AREF RQB %IO-RQ-COMMAND-HIGH)))    (SETF (AREF RQB %IO-RQ-COMMAND) UNIT)    (SETF (AREF RQB %IO-RQ-INFORMATION)  (DPB %IO-RQ-PRIORITY-LOCAL-FILE %%IO-RQ-INFO-PRIORITY (AREF RQB %IO-RQ-INFORMATION)))    (SETF (AREF RQB %IO-RQ-DEVICE-ADDRESS) (LDB %%Q-Low-Half ADDRESS))    (SETF (AREF RQB %IO-RQ-DEVICE-ADDRESS-HIGH) (LDB %%Q-High-Half ADDRESS))    (SETF (AREF RQB %IO-RQ-STATUS) 0.)    (SETF (AREF RQB %IO-RQ-STATUS-HIGH) 0.)    (%IO RQB (AREF DISK-TYPE-TABLE LOGICAL-UNIT 7.))    (UNLESS INITIATE      (WAIT-IO-DONE RQB (DEVICE-TYPE-WAIT-STRING (GET-DEVICE-TYPE  LOGICAL-UNIT))    (GET-IF-TYPE LOGICAL-UNIT))      (IF (CHECK-AND-MAYBE-SIGNAL-ERROR RQB LOGICAL-UNIT ADDRESS CMD CMD-NAME)(GO FULL-RETRY)))))  (DEFUN BLOCK-NUPI-RUN (RQB UNIT CONTROLLER-SLOT DESCRIPTOR-BLOCK ADDRESS CMD CMD-NAME &OPTIONAL (INITIATE NIL)) "This is the lowest level interface to the io system. It uses the nupi command blockinterface, and will issue as many nupi requests as it takes to satisfy the number of pagesparameter. The scatter list must be set up and all pages wired.This function is using during status request for a controller or formatter. The descriptor-block isstored in Controller-slot-table." (PROG NIL  FULL-RETRY       (setf (Aref RQB %IO-RQ-COMMAND-HIGH) (DPB CMD %%IO-RQ-COMMAND-COMMAND (AREF RQB %IO-RQ-COMMAND-HIGH)))       (setf (Aref RQB %IO-RQ-COMMAND) UNIT)       (setf (Aref RQB %IO-RQ-INFORMATION)     (DPB %IO-RQ-PRIORITY-LOCAL-FILE                  %%IO-RQ-INFO-PRIORITY                  (AREF RQB %IO-RQ-INFORMATION)))       (setf (Aref RQB %IO-RQ-DEVICE-ADDRESS) (LDB #o20 ADDRESS))       (setf (Aref RQB %IO-RQ-DEVICE-ADDRESS-HIGH) (LDB #o2020 ADDRESS))       (setf (Aref RQB %IO-RQ-STATUS) 0)       (setf (Aref RQB %IO-RQ-STATUS-HIGH) 0)       (%IO RQB DESCRIPTOR-BLOCK)       (UNLESS INITIATE    (PROGN (WAIT-IO-DONE RQB CMD-NAME (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 0))           (IF (CHECK-AND-MAYBE-SIGNAL-ERROR RQB 0 ADDRESS CMD CMD-NAME) (GO FULL-RETRY))))));;Changed to call new functions decode-nupi-controller-error or decode-nupi-device-error.  ;;Did this so new functions could be called elsewhere without duplicating code.  -ab, 8-8-85(DEFUN DECODE-NUPI-STATUS (RQB)  "Decodes the status returned by the nupi board. This info based on 5/24/84 version  of the NuBus Peripheral Interface spec."  (IF (LDB-TEST %%NUPI-STATUS-HIGH-CNTL-ERROR (AREF RQB %IO-RQ-STATUS-HIGH))    (FORMAT () "controller error: ~A"    (DECODE-NUPI-CONTROLLER-ERROR     (LDB %%NUPI-STATUS-HIGH-CNTL-ERROR (AREF RQB %IO-RQ-STATUS-HIGH))))    (FORMAT () "device error: ~A"    (DECODE-NUPI-DEVICE-ERROR (LDB %%NUPI-STATUS-LOW-DEV-ERROR (AREF RQB %IO-RQ-STATUS))))))  ;; Added these next two.  8-8-85, -ab(defun decode-nupi-controller-error (error)   (select error    ( (#x20 #x21 #X22 #x23 #x24 #x25) "self test error")    ( #x61 "NuBus time out")    ( #X62 "NuBus bus error")    ( #X63 "SCSI bus error")    ( #X64 "Formatter busy")    ( #X65 "Rate error")    ( #x66 "Bus error trap occurred")    ( #x80 "Command aborted due to abort device command queued")    ( #X81 "Command aborted")    ( #X82 "Invalid command")    ( #X83 "Invalid parameter")    ( #x84 "SCSI command completed w/o transfer")    ( #x85 "Multiple Active Command");;; 8C and 8D are obsolete, but keep them for machines w/old FW in the field. 5-2-86    ( #x8C "Attempted a Read and Hold Command with one pending")    ( #x8D "Attempted a Write & Swap of Buffer to NuBus command without a valid buffer reserved by Read & Hold")    ( #XA1 "Illegal interrupt")    ( #XA2 "SCSI Function Complete Without Cause")    ( #XA3 "Timeout on NCR 5385 Data Register Full Wait")    ( #XA4 "SCSI Invalid Command Interrupt")    ( #XA5 "Software error trap occurred")    ( #XA6 "Hardware error trap occurred")    ( #XA7 "Queue overflow occurred")    ( #XA8 "Address error trap occurred")    ( #XA9 "Illegal instruction error trap occurred")    ( #XAA "NuBus DMA locked up; may need HW reset")    (otherwise "unknown or reserved error code."))) (DEFUN DECODE-NUPI-DEVICE-ERROR (ERROR)  (SELECT ERROR    ((32. 33. 34. 35. 36. 37.) "self test error")    (65. "No selected unit")     (66. "Media not loaded")     (67. "Write protected")     (68. "Mass storage enclosure power reset")     (69. "Media change")     (70. "Temperature fault")     (71. "Invalid media type");non-errors not included     (74. "Tape EOM (end of medium)")     (80. "SCSI Bus hung, needs hardware reset")     (81. "SCSI Device won't reconnect")     (82. "SCSI Device won't complete")     (83. "Status: Non-extended error code is zero")     (84. "Device has multiple block descriptors")     (85. "Device has undefined block length")     (86. "Media change")     (87. "Mode select parameter change")     (97. "SCSI bus parity error")     (98. "Drive not ready")     (99. "Rate error")     (100. "Invalid SCSI interrupt: selected")     (101. "Device Offline")     (102. "Invalid SCSI testability interrupt")     (103. "Invalid SCSI disconnect")     (104. "Invalid mode for SCSI status")     (105. "Invalid mode for SCSI command byte request")     (106. "Sequence error: SCSI completion address")     (107. "Sequence error: SCSI requested data")     (108. "Sequence error: SCSI DMA start-stop address")     (112. "Unknown MSG Received from Formatter")     (113. "Invalid mode on SCSI message in")     (114. "Excess SCSI status")     (115. "Excess SCSI command bytes requested")     (116. "Expected SCSI restore message but not received")     (117. "Reconnected to unit not waiting for it")     (118. "Expected SCSI cmd complete msg; did not receive it")     (119. "Illegal SCSI message for reconnected state")     (120. "Reselected without valid SCSI ID")     (121. "Invalid mode on SCSI message out")     (122. "Invalid mode on SCSI data transfer")     (129. "Command aborted")     (130. "Invalid command")     (131. "Illegal command sequence or Invalid parameter");changed slightly     (132. "Illegal block address")     (133. "Volume overflow")     (138. "Formatter failed to connect")     (142. "Unknown error code returned from formatter")     (143. "Formatter busy")     (161. "Missing index signal")     (162. "No seek complete")     (163. "Write fault")     (164. "Track 0 not found")     (165. "Multiple units selected")     (166. "Seek error")     (167. "Formatter hardware error")     (168. "Msg rejected")     (169. "Select/reselect failed")     (170. "Unsuccesful software reset")     (172. "Initiator detected an error")     (173. "Inappropriate or illegal msg.")     (193. "ID error")     (194. "Uncorrectable data error")     (195. "ID address mark not found")     (196. "Data address mark not found")     (197. "Sector address not found")     (198. "Bad block not found")     (199. "Format error")     (200. "Correctable data check")     (201. "Interleave error")     (202. "Media error")     (204. "Primary defect list not found")     (205. "Defect list error (grown)")     (206. "No defect spare available")     (OTHERWISE "Unknown or reserved error code."))) (DEFUN PRINT-NUPI-STATUS (&OPTIONAL (STREAM *STANDARD-OUTPUT*)  (CONTROLLER-SLOT *DEFAULT-CONTROLLER-SLOT*))  (WITH-RQB (RQB (GET-DISK-RQB))    (CASE (AREF CONTROLLER-SLOT-TABLE CONTROLLER-SLOT 0)            (:NPI (FORMAT-NUPI-STATUS STREAM (GET-NUPI-STATUS RQB CONTROLLER-SLOT)))            ((:NPE :MSC) (FORMAT-MSC-NUPI2-STATUS STREAM                                                  (GET-MSC-NUPI2-STATUS RQB                                                                        CONTROLLER-SLOT))))))(DEFUN FORMAT-MSC-NUPI2-STATUS (STREAM STATUS)  stream status)  (DEFUN FORMAT-NUPI-STATUS (STREAM STATUS) ;; Status is an (16b) array of the status buffer from a NuPI status request. ;; 32b references are used.  (FORMAT STREAM "~&NuPI Status Summary")  ;; List special events detected.  (LET ((SPECIAL-EVENT-WORD (LDB %%Q-Low-Half (AREF-32B STATUS %NUPI-STATUS-ERROR-STATUS))))    (DOLIST (SPECIAL-EVENT ERROR-STATUS-LIST)      (IF (LDB-TEST (CAR SPECIAL-EVENT) SPECIAL-EVENT-WORD)(FORMAT STREAM "~&~a" (CADR SPECIAL-EVENT)))))  ;; Show self test status.  (LET ((SELF-TEST-STATUS (LDB %%Q-High-Half (AREF-32B STATUS %NUPI-STATUS-SELFTEST-STATUS))))    (FORMAT STREAM "~&Last selftest: ~d., ~d." (LDB %%Q-High-Half SELF-TEST-STATUS)    (LDB %%Q-Low-Half SELF-TEST-STATUS)))  ;; Show Formatter status.  (DOTIMES (I 7.)    (LET ((FORMATTER-STATUS (AREF-32B STATUS (+ %NUPI-STATUS-FORMATTER-STATUS I)))  (FORMATTER-NUMBER (IF (< I 5.)      I      (1+ I))))      (FORMAT STREAM "~&Formatter ~d - " FORMATTER-NUMBER)      (IF (LDB-TEST %%NUPI-DEVICE-OFFLINE FORMATTER-STATUS)(FORMAT STREAM "Offline.")(PRINT-DEVICE-STATUS STREAM FORMATTER-STATUS)))    (DOTIMES (J 2.)      (LET ((DEVICE-STATUS (AREF-32B STATUS (+ %NUPI-STATUS-DEVICE-STATUS (+ I I J)))))(FORMAT STREAM "~&   Device ~d - " J)(IF (LDB-TEST %%NUPI-DEVICE-OFFLINE DEVICE-STATUS)  (FORMAT STREAM "Offline.")  (PRINT-DEVICE-STATUS STREAM DEVICE-STATUS)))))  (FORMAT T "~&End of NuPI status."))  (DEFPARAMETER *DEVICE-TYPE* '("Formatter" "Tape" "Disk" "Printer" "Optical R/W" "Optical RO"))  (DEFUN PRINT-DEVICE-STATUS (STREAM STATUS)  (LET ((*PRINT-BASE* 16.))    (FORMAT STREAM "~a~a~a~a~a~a~a"    (OR (NTH (LDB %%NUPI-DEVICE-TYPE STATUS) *DEVICE-TYPE*) "**Invalid Device Type**")    (IF (LDB-TEST %%NUPI-DEVICE-ERROR-OCCURRED STATUS)      ", Error Occurred"      "")    (IF (LDB-TEST %%NUPI-DEVICE-SELFTEST-FAILURE STATUS)      ", Self Test failure"      "")    (IF (LDB-TEST %%NUPI-DEVICE-OVERTEMPERATURE STATUS)      ", Overtemperature"      "")    (IF (LDB-TEST %%NUPI-DEVICE-WRITE-PROTECTED STATUS)      ", write protected"      "")    (IF (LDB-TEST %%NUPI-DEVICE-HARDWARE-UNSAFE STATUS)      ", hardware unsafe"      "")    (LET ((LAST-COMMAND (LDB %%NUPI-DEVICE-LAST-COMMAND STATUS)))      (IF (= 0. LAST-COMMAND)""(FORMAT () ", Last Command: ~a, last options: ~a" LAST-COMMAND(LDB %%NUPI-DEVICE-LAST-OPTIONS STATUS)))))))  ,-- or it may be wild, *.  The CPU type is calculated from the environment. Returns T."  (let (cfg-user-type);03.20.87 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    (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)    ;;; (CHECK-ARG SSSS?????(unless mp-number  (ferror :cfg-module-not-found  "A configuration modu