LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032958. :SYSTEM-TYPE :LOGICAL :VERSION 5. :TYPE "LISP" :NAME "CONFIG-ROM" :DIRECTORY ("REL3-PUBLIC" "TEST") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758053854. :AUTHOR "REL3" :LENGTH-IN-BYTES 14121. :LENGTH-IN-BLOCKS 14. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ;;; -*- Mode: Lisp; Package: user; Base: 10.; Patch-File: T -*-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; code to test the serial number and revision letter fields in the config rom;;; also performs cyclic redundancy check (crc) on rest of rom;;; as per system architecture spec 2536702-0001 15 april 1985;;;    mark young 5/28/85;;; typical usage: (sn 5);;;    above will display and checksum the sib ( slot 5 ) config rom.;;; typical usage: (crc 5);;;    above will crc and display the crc chars of the config rom in slot 5;;;;;;  7/29/85 added display ram size for 2-8mb assemblies;;;  9-30-86 made sn go into debugger if serial number appears to be invalid;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defparameter size-of-barcode 32.)(defparameter size-of-serial-number 13.);(setq size-of-barcode 32.);(setq size-of-serial-number 13.) ;  0  1 2 3 4 5 6 7 8 9 10 11   12;                                      w w y S S S s s s  s  s    c;                                     week y site  sequence #    checksum char;                                          e                     for digits 1-11;                                          a;                                          r; 11 hex digits plus checkchar plus zeroth array location is not used(defvar bite)(defvar is-mem)(defvar addr)(defvar error-char);set to non-zero if error in char occurs(defvar accu)(defconst *non-crc* 18.) ; number of bytes to skip crc over - serial number and rev letters(defconst *crc-bits* #x+5593) ; bits participating in parity and xor(defconst *barcode-array* ; '#/0' works with HAL ',(Character "0")' works with ICE  (fillarray (make-array size-of-barcode ':type  ':art-8b )  `(,(Character "0") ,(Character "1") ,(Character "2") ,(Character "3")      ,(Character "4") ,(Character "5") ,(Character "6") ,(Character "7")    ,(Character "8") ,(Character "9") ,(Character "A") ,(Character "B")    ,(Character "C") ,(Character "D") ,(Character "E") ,(Character "F")    ,(Character "H") ,(Character "K") ,(Character "L") ,(Character "M")    ,(Character "N") ,(Character "P") ,(Character "R") ,(Character "S")    ,(Character "T") ,(Character "U") ,(Character "V") ,(Character "W")    ,(Character "X") ,(Character "Y") ,(Character "Z") ,(Character "_"))))(defvar sn-array(make-array size-of-serial-number ':type ':art-8b )); check ascii for illegal chars gijoqGIJOQ(defun print-barcode-char (ascii)  (if (or (= ascii (Character "G"))          (= ascii (Character "I"))  (= ascii (Character "J"))  (= ascii (Character "O"))  (= ascii (Character "Q"))  (= ascii (Character "g"))  (= ascii (Character "i"))  (= ascii (Character "j"))  (= ascii (Character "o"))  (= ascii (Character "q")))      (setq error-char ascii))  ; save for later error printout   (format t "~c" ascii))(defun print-hex-digit (value)  (format t "~c" (if (> value 9.)     (+ (Character "A") (- value 10.))     (+ (Character "0") value))))     ;(defunp getb (slot addr) ; this works with HAL but not ICE;  (ldb #o0008 (si:%nubus-read (+ #x+f0 slot) addr)))(defun getb (slot addr)  (prog ()  (return (ldb #o0008 (si:%nubus-read (+ #x+f0 slot) addr)))))(defun print-rev-letter (slot); print two ascii letters from config rom at f(slot)ffffco-d8  (format t "  REV = ")  (let ((rev-start #X+ffffc0)(rev-end #X+ffffd8))    (setq addr rev-start)    (setq bite (getb slot addr))          ; get first rev letter    (format t "~c" bite)                  ; print first rev letter    (setq addr rev-end)                   ; get 2nd rev letter starting from other end of field    (loop      (setq bite    (getb slot addr))             ; get next byte from rev field      (setq addr (- addr 4))              ; next addr ...      (if (or (< addr rev-start)          ; if end of rev letter field or  ...      (and (not (= bite #x+00))   ; found a blown rev letter   (not (= bite #x+ff)))) ; 00 and ff are possible unblown eprom values  (block letter2    (format t "~c" bite)    (return-from print-rev-letter))))))(defun print-size-if-mem (slot) "Print mem size from config rom at f(slot)ffff90.  Will return t if error occurs."  (format t "  MEMSIZE = ")  (let ((mem-size-addr #X+ffff90)(mem-size 1)(mem-size-max #x1f)(mem-type #X1a)  ;1a=1mb, 1b=2mb, 1c=4mb, 1d=8mb, 1f=32mb        )    (setq bite (getb slot mem-size-addr))          ; get first rev letter    (loop      (when (equalp bite mem-type)  (format t "~d megabyte" mem-size)  (return-from print-size-if-mem))      (setq mem-size (* 2 mem-size))      (incf mem-type)      (when (equalp mem-type (+ 1 mem-size-max))  (format t "Invalid mem-size byte = ~16,2,'0r" bite)          (format t "~%    === ERROR : Ram size is invalid at addr = f~16r~16,2,'0r " slot mem-size-addr)  (return-from print-size-if-mem t)) ; return nil to signify error      ))  nil) ; normal return value          (defun print-serial-number (slot); print serial number in same format as printed on board; wwysssSSSSSc;            |__ checksum - ascii                                         fsffffdc;          ||___ sequence number - two lsd hex digits                     fsffffe0;        ||_____ sequence number - two middle hex digits                  fsffffe4;       |_______ sequence number - right nibble is sequence msd digit     fsffffe8;      |________ site code - lsb - ascii                                  fsffffec;     |_________ site code - middle - ascii                               fsfffff0;    |__________ site code - msb - ascii                                  fsfffff4 ;   |___________ year - ascii (3-Z)                                       fsfffff8; ||____________ week - msd,lsd - both are packed in same byte in decimal fsfffffc;  (let ((sn-start #x+fffffc)(bite 0)(y 1)) ; start with array[1] location;;;(sn-end #X+ffffdc))    (format t " Serial Number and Checksum Character = " slot)    (setq addr sn-start)    (setq bite (getb slot addr))    (aset (ldb #o0404 bite) sn-array y)                 ; week mds    (print-hex-digit (aref sn-array y))    (setq y (+ y 1))    (aset (ldb #o0004 bite) sn-array y)                 ; week lsd    (print-hex-digit (aref sn-array y))    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))                    (aset (barcode-to-weight bite) sn-array y)          ;year    (print-barcode-char bite)    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))             (aset (barcode-to-weight bite) sn-array y)          ; site msd    (print-barcode-char bite)                         (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))                           (aset (barcode-to-weight bite) sn-array y)          ; site    (print-barcode-char bite)    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))    (aset (barcode-to-weight bite) sn-array y)          ; site lsd    (print-barcode-char bite)    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))    (aset (ldb #o0004 bite) sn-array y)                 ; seq msd     (print-hex-digit (aref sn-array y))    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))    (aset (ldb #o0404 bite) sn-array y)                 ; seq msd-1    (print-hex-digit (aref sn-array y))      (setq y (+ y 1))    (aset (ldb #o0004 bite) sn-array y)                 ; seq msd-2    (print-hex-digit (aref sn-array y))    (setq y (+ y 1))    (setq addr (- addr 4))    (setq bite (getb slot addr))    (aset (ldb #o0404 bite) sn-array y)                 ; seq msd-3    (print-hex-digit (aref sn-array y))    (setq y (+ y 1))    (aset (ldb #o0004 bite) sn-array y)                 ; seq lsb    (print-hex-digit (aref sn-array y))    (setq y (+ y 1))     (setq addr (- addr 4))    (setq bite (getb slot addr))    (aset bite sn-array y)                              ; check char, y=12    (print-barcode-char bite)))(defun barcode-to-weight (barcode)    (do ((index 0 (+ index 1)))         ((= index 32.))        (if (= barcode (aref *barcode-array* index))    (return-from barcode-to-weight index )))    32.) ; return index to '_' char if no match(defun weight-to-barcode (weight)  (if (or (< weight 0)  (> weight 31.))      (aref *barcode-array* 32.)         ; invalid weight returns '_'      (aref *barcode-array* weight)))   ;  valid  weight returns ascii barcode(defun hex-digit-to-ascii (hex)  (if (> hex 9.)      (+ (Character "A") (- hex 10.))      (+ (Character "0") hex)))      (defun print-slot-header (slot); print slot, board type,  part number, and vendor  (let ((addr #x+ffff84)(board-type ""))    (format t "~% SLOT ~D  " slot)    ; BOARD TYPE    (do ((i 0 (+ i 4)))((= i (* 4 3)))      (setq board-type (string-append board-type (getb slot (+ addr i)))))    (format t "~a" board-type)    (if (string-equal "MEM" board-type)(setq is-mem t)    ;else(setq is-mem nil))    ; PART NUMBER    (setq addr #x+ffff44)    (format t " ")    (do ((i 0 (+ i 4)))((= i (* 4 16.)))      (format t "~c" (getb slot (+ addr i))))    ; VENDOR    (setq addr #x+ffffa4)    (format t " ")     (do ((i 0 (+ i 4)))((= i (* 4 4)))      (format t "~c" (getb slot (+ addr i))))))(defun sn (slot)  "Print NuBus configuration rom serial number and checksum character. Serial number   is checked for errors in checksum. Returns t if any error is found."  (let ((errors nil)(sum 0)(romchar 0))    (setq error-char 0)    (print-slot-header slot)    (print-serial-number slot) ; may set error-char here    (print-rev-letter slot)        (if is-mem(or (print-size-if-mem slot) errors)) ; set errors flag if error occurrs        (if (not (zerop error-char))         (format t "~%    === ERROR : serial number char` ~c`, hex ~16R is invalid " error-char error-char))  ; checksum starts with week msd and ends with lsd of seq = 11 digits.  ; each digit is replaced with numeric weight y which is the index into   ; *barcode-array*. the checksum is then computed by :  ; sum = the char with the barcode weight of -> remainder of -> ( 1xy1 + 2xy2 + ... 11xy11 )/31  ;       where each y is the barcode weight of the ascii char that represents one of the 11 hex digits.  ; each hex digit has been already placed in sn-array by print-serial-number    (do ((y 1 (+ y 1)))         ((> y 11.))   ; 1,2, ... 11      (setq sum ( + (* y (barcode-to-weight (hex-digit-to-ascii (aref sn-array y)))) sum)))    (setq sum (remainder sum 31.)) ; using '\' instead of 'remainder' works with HAL but not with ICE !    (setq sum (weight-to-barcode sum)) ; sum should equal checkchar    (setq romchar (aref sn-array 12.))    (when (not (= sum romchar))      (setq errors t)      (format t "~%    === ERROR : rom checksum char `~c` is invalid, expected `~c`" romchar sum))    errors; return errors if any    ));;;;;;;;; perform crc of rom as per system architecture spec 2536702-0001 15 april 1985;;;(defun crc (slot)  "Cyclic redundancy check (CRC) of the config rom. This does not include revision or serial number fields.   Returns t if errors are found."        (let ((addr-rom-size #x+ffffb4)      (crc-start 0)      (crc-end #x+fffffc) ; last word-aligned byte in rom      (bytes-to-crc 0)      (parity 0)      (abyte 0)      (error nil)      (temp 0)      (romcrc 0)      (rom-size-error 0)      (rom-size 0))  (setq accu 0)  (setq rom-size (getb slot addr-rom-size))  (if (or (< rom-size 6)   ; minimum rom size  (> rom-size 24.)) ; maximum rom size      (setq rom-size 1))   ; set error flag, print later  (format t "~% SLOT ~D Rom Size = ~16R" slot rom-size)  (setq bytes-to-crc (^ 2 rom-size)); compute bytes-to-crc = 2^rom-size  (setq bytes-to-crc (* 4 bytes-to-crc))                  ; one byte per word address  (setq crc-start  (- #x+1000000 bytes-to-crc))           ; one byte per word  (setq crc-end (+ crc-start (- bytes-to-crc (* 4 *non-crc*))))  (do ((addr crc-start (+ addr 4)))      ((= addr crc-end))    (setq parity 0)    (setq temp (logand accu *crc-bits*))    (loop       (if (zerop temp)  (return))      (setq parity (logxor parity (logand temp 1)))             ; compute parity of bits; even=0 or odd=1      (setq temp (ash temp -1))    )                               ; loop as long as temp has ones in it    (setq abyte (getb slot addr))    (setq accu (logior (ash accu -1) (ash parity 15.))) ;shift accu right and 'OR' in parity bit at bit 16    (setq accu (logxor accu (logior (ldb #o0002 abyte) (ash (ldb #o0201 abyte) 4)(ash (ldb #o0302 abyte) 7) (ash (ldb #o0501 abyte) 10.)(ash (ldb #o0601 abyte) 12.) (ash (ldb #o0701 abyte) 14.))))    )  (setq addr crc-end)     ; addr should now be pointing to rom crc now (lsb)  (setq romcrc (logior (* (getb slot (+ addr 4)) (^ 2 8)) (getb slot addr))) ; assemble romcrc = @addr+4:@addr  (if (not (= romcrc accu))      (progn(format t " Rom CRC = ~16,4,'0R BAD, calculated = ~16,4,'0R " romcrc accu)(setq error t))  ;else       (format t " Rom CRC = ~16,4,'0R is OK " romcrc))   (when (not (zerop rom-size-error))       (format t "~%    === ERROR : rom size ~16R is invalid" rom-size)      (setq error t))  error; return errors if any))(defun serial-number(&optional (crc nil))   " Perform serial number display and checksum verification for all slots (0-6).    Do crc checking for all slots if CRC is t. Enter debugger if any errors are found.  "  (let ((errors nil))    (dolist (slot '(0 1 2 3 4 5 6))      (if (equal #xC3 (si:%nubus-read-8b-careful (+ #xf0 slot) #xffff04))  (progn     (or (sn slot) errors)    (if crc (or (crc slot) errors)))      ;else  (format t "~% SLOT ~d  is empty slot." slot)))    (format t "~%")    (and errors (cerror :yes nil nil" Config rom error encountered "))    ))  DIS-TEXT) (DEFVAR *PL1DCL*) (DEFCOM COM-PL1DCL "Complete Multics PLI declaration for system entrypoint." ()  (LET ((BP (COPY-BP (POINT)))(THE-ENTRY))    (LET ((BP1 (FORWARD-WORD BP -1)))      (SETQ THE