;;; -*- MODE: LISP; PACKAGE: CADR; BASE: 8 -*- Patch file for CADR microcode loader (INCLUDE |LMDOC;.COMPL PRELUD|) (IF-FOR-MACLISP (DECLARE (EVAL (READ)))) (IF-FOR-MACLISP (DEFUN **STRING** MACRO (X) `',(CADR X)) ;Bubbles in my brain ) (INCLUDE ((LMCONS)CADMAC >)) (DECLARE (SPECIAL CC-SYMBOL-TABLE CC-FILE-SYMBOLS-LOADED-FROM CC-UINST-DESC)) (DECLARE (FIXNUM (READ-FIXNUM NOTYPE))) (DEFUN CC-UCODE-LOADER (MODE FILE-NAME MERGEP) ;MODE -> NIL IS REGULAR LOAD (PROG (ITEM LOAD-WITHOUT-SYMBOLS-FLAG TEM FILE) (DECLARE (FIXNUM ITEM)) #M (COND ((NULL FILE-NAME) (SETQ FILE-NAME '(UCADR ULOAD DSK LISPM1))) ((= (LENGTH FILE-NAME) 1) (SETQ FILE-NAME (APPEND FILE-NAME '(ULOAD DSK LISPM1))))) #Q (SETQ FILE-NAME (FS:MERGE-PATHNAME-DEFAULTS (OR FILE-NAME "SYS: UBIN; UCADR ULOAD >"))) (COND ((EQ MODE 'LOAD-WITHOUT-SYMBOLS) (SETQ LOAD-WITHOUT-SYMBOLS-FLAG T) (SETQ MODE NIL)) ((EQ MODE 'COMPARE) (SETQ LOAD-WITHOUT-SYMBOLS-FLAG T))) (SETQ FILE (OPEN FILE-NAME 'IN)) L (AND (< (SETQ ITEM (READ-FIXNUM FILE)) 0) (GO COM)) (COND ((NOT MODE) ;IF LOADING, SORT BY REG ADR FOR SPEED (COND ((< ITEM RACME) ;KLUDGE SIGH. AVOID BIGNUM CONSING. (CC-WRITE-C-MEM-3-16BIT-WORDS (- ITEM RACMO) (READ-FIXNUM FILE) (READ-FIXNUM FILE) (READ-FIXNUM FILE))) ((< ITEM RADME) (CC-WRITE-D-MEM (- ITEM RADMO) (LOGDPB (READ-FIXNUM FILE) 4020 (LOGDPB (READ-FIXNUM FILE) 2020 (READ-FIXNUM FILE))))) ((AND (NOT (< ITEM RAAMO)) (< ITEM RAAME)) (LET ((DATA (LOGDPB (READ-FIXNUM FILE) 4020 (LOGDPB (READ-FIXNUM FILE) 2020 (READ-FIXNUM FILE))))) (CC-WRITE-A-MEM (- ITEM RAAMO) DATA) (AND (< (- ITEM RAAMO) 40) ;M=A (CC-WRITE-M-MEM (- ITEM RAAMO) DATA)))) ((AND (NOT (< ITEM RAMMO)) (< ITEM RAMME)) (CC-WRITE-M-MEM (- ITEM RAMMO) (LOGDPB (READ-FIXNUM FILE) 4020 (LOGDPB (READ-FIXNUM FILE) 2020 (READ-FIXNUM FILE))))) (T (ERROR '|BAD REGISTER ADDRESS IN ULOAD| ITEM)))) ((EQ MODE 'COMPARE) (CC-COMPARE-UCODE-WD ITEM (READ-FIXNUM FILE) (READ-FIXNUM FILE) (READ-FIXNUM FILE))) (T (READ-FIXNUM FILE) (READ-FIXNUM FILE) (READ-FIXNUM FILE))) (GO L) COM (COND ((= ITEM -1) (GO FIN)) ((= ITEM -2) (GO SYMLOD)) ((= ITEM -3) (COND ((NOT MODE) ;LOAD MICRO-CODE-SYMBOL AREA (SETQ ITEM (CC-MAIN-MEMORY-LOAD FILE)) (GO COM)) ((EQ MODE 'COMPARE) (SETQ ITEM (CC-COMPARE-MAIN-MEMORY-LOAD FILE)) (GO COM)) (T (GO SK)))) ;SKIP TO NEXT NEGATIVE CODE ((= ITEM -4) (READ FILE) ;FLUSH ASSEMBLER STATE INFO (GO SK)) ((BREAK BAD-UCODE-LOAD T))) SK (AND (< (SETQ ITEM (READ-FIXNUM FILE)) 0) (GO COM)) (GO SK) FIN (CLOSE FILE) (RETURN T) SYMLOD (COND (LOAD-WITHOUT-SYMBOLS-FLAG (GO FIN))) ;LOADING BOOTSTRAP, DONT ;AFFECT CURRENT SYMBOLS. #Q (PROCESS-ALLOW-SCHEDULE) ;Come up for a breath (SETQ CC-FILE-SYMBOLS-LOADED-FROM NIL) ;In case bomb out or something. (COND ((NOT (AND MERGEP (BOUNDP 'CC-SYMBOLS-NAME))) (CC-INITIALIZE-SYMBOL-TABLE T))) #Q (PROCESS-ALLOW-SCHEDULE) ;Come up for a breath SYML1 (COND ((NUMBERP (SETQ TEM (READ FILE))) (SETQ ITEM TEM) #Q (PROCESS-ALLOW-SCHEDULE) ;Come up for a breath (CC-END-ADDING-SYMBOLS) (SETQ CC-FILE-SYMBOLS-LOADED-FROM #M FILE-NAME #Q (FUNCALL FILE ':TRUENAME)) ;So EQ will work later (GO COM))) (CC-ADD-TYPED-SYMBOL TEM (READ FILE) (READ-FIXNUM FILE)) (GO SYML1) ; SYML1 (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0) ; (CC-END-ADDING-SYMBOLS) ; (GO COM))) ; (CC-ADD-SYMBOL (READ FILE) ITEM) ; (GO SYML1) )) (DEFUN CC-ADD-TYPED-SYMBOL (SYM TYPE VAL) (COND ((EQ TYPE 'I-MEM) (SETQ VAL (+ VAL RACMO))) ((EQ TYPE 'A-MEM) (SETQ VAL (+ VAL RAAMO))) ((EQ TYPE 'M-MEM) (SETQ VAL (+ VAL RAMMO))) ((EQ TYPE 'D-MEM) (SETQ VAL (+ VAL RADMO))) ((EQ TYPE 'NUMBER)) (T (PRINT (LIST SYM TYPE VAL)) (BREAK BAD-SYMBOL-TYPE T))) (CC-ADD-SYMBOL SYM VAL)) ;only wins on LISP machine (IF-FOR-LISPM (DEFUN COMPARE-MCR-FILE (FILE-NAME) (PROG (STREAM HCODE LCODE HADR LADR HCOUNT LCOUNT HD LD UDSP-NBLKS UDSP-RELBLK FILE MACH) (COND ((NUMBERP FILE-NAME) (SETQ FILE-NAME (FORMAT NIL "LISPM1;UCADR ~DMCR" FILE-NAME)))) (SETQ STREAM (OPEN FILE-NAME '(:IN :BLOCK :FIXNUM :BYTE-SIZE 16. ))) L0 (SETQ HCODE (FUNCALL STREAM 'TYI) LCODE (FUNCALL STREAM 'TYI)) (COND ((OR (NOT (ZEROP HCODE)) (< LCODE 0) (> LCODE 5)) (FERROR NIL "BAD CODE HCODE=~O LCODE=~O" HCODE LCODE))) (SETQ HADR (FUNCALL STREAM 'TYI) LADR (FUNCALL STREAM 'TYI)) (SETQ HCOUNT (FUNCALL STREAM 'TYI) LCOUNT (FUNCALL STREAM 'TYI)) (COND ((OR (NOT (ZEROP HADR)) (NOT (ZEROP HCOUNT))) (FERROR NIL "BAD HEADER SA ~O,~O COUNT ~O,~O" HADR LADR HCOUNT LCOUNT))) (FORMAT T "~%CODE: ~D, ADR: ~D, COUNT: ~D" LCODE LADR LCOUNT) (COND ((ZEROP LCODE) (COND (UDSP-NBLKS (FUNCALL STREAM ':SET-POINTER (* 2 UDSP-RELBLK SI:PAGE-SIZE)) (DO ((ADR 1400 (1+ ADR)) (FIN (+ 1400 (* UDSP-NBLKS SI:PAGE-SIZE)))) ((= ADR FIN)) (COND ((NOT (= (SETQ MACH (DBG-READ-XBUS ADR)) (SETQ FILE (DPB (FUNCALL STREAM 'TYI) 2020 (FUNCALL STREAM 'TYI))))) (FORMAT T "~%Main mem adr ~S// file ~S machine ~S" ADR FILE MACH)))))) (CLOSE STREAM) (RETURN T)) ((= LCODE 1) (GO LI)) ;I-MEM ((= LCODE 2) (GO LD)) ;D-MEM ((= LCODE 3) ;HACK MAIN MEMORY LOAD LATER. (SETQ UDSP-NBLKS LADR) (SETQ UDSP-RELBLK LCOUNT) (SETQ HD (FUNCALL STREAM 'TYI) LD (FUNCALL STREAM 'TYI)) ;PHYS MEM ADR (GO L0)) ((= LCODE 4) (GO LA)) ;A-MEM (T (FERROR NIL "BAD CODE ~S" LCODE))) LD (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0) (GO L0))) (CC-COMPARE-UCODE-WD (+ LADR RADMO) 0 (FUNCALL STREAM 'TYI) (FUNCALL STREAM 'TYI)) (SETQ LADR (1+ LADR)) (GO LD) LA (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0) (GO L0))) (CC-COMPARE-UCODE-WD (+ LADR RAAMO) 0 (FUNCALL STREAM 'TYI) (FUNCALL STREAM 'TYI)) (SETQ LADR (1+ LADR)) (GO LA) LI (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0) (GO L0))) (CC-COMPARE-UCODE-WD (+ LADR RACMO) (PROG2 (FUNCALL STREAM 'TYI) (FUNCALL STREAM 'TYI)) (FUNCALL STREAM 'TYI) (FUNCALL STREAM 'TYI)) (SETQ LADR (1+ LADR)) (GO LI) )) ) (DEFUN CC-COMPARE-UCODE-WD (REG-ADR WD3 WD2 WD1) (DECLARE (FIXNUM REG-ADR)) (PROG (RD1 RD2 RD3 WD) (DECLARE (FIXNUM RD1 RD2 RD3)) (SETQ WD (CC-R-E REG-ADR)) (SETQ RD1 (LOGLDB 0020 WD) RD2 (LOGLDB 2020 WD) RD3 (LOGLDB 4020 WD)) (COND ((< REG-ADR RACME) ) ((< REG-ADR RADME) (SETQ WD2 (LOGAND WD2 1)) ;REST IS PARITY ;(SETQ RD1 (LOGAND 77777 RD1)) ;FLUSH PARITY ;(RETURN NIL) ;DISPATCH MEMORY CAN'T BE READ ) (T (SETQ RD3 0))) ;A OR M MEM ONLY 32 BITS (COND ((AND (NOT (AND (= WD1 RD1) (= WD2 RD2) (= WD3 RD3))) ;IF DOESN'T MATCH (NOT (AND (= WD1 0) (= WD2 0) (= WD3 0)))) ;AND NOT LOADED ZERO ; WHICH WOULD PROBABLY BE A ; VARIABLE WHICH IS OK TO CHANGE (TERPRI) (CC-PRINT-ADDRESS REG-ADR) (PRINC '|// FILE |) (SETQ WD (LOGDPB WD3 4020 (LOGDPB WD2 2020 WD1))) (PRIN1-THEN-SPACE WD) (AND (< REG-ADR RACME) (CC-TYPE-OUT WD CC-UINST-DESC T T)) (PRINT 'MACHINE) (SETQ WD (LOGDPB RD3 4020 (LOGDPB RD2 2020 RD1))) (PRIN1-THEN-SPACE WD) (AND (< REG-ADR RACME) (CC-TYPE-OUT WD CC-UINST-DESC T T)) (PRINT '-----)))) (AND (NOT (< REG-ADR RAMMO)) ;IF LOADING M, ALSO CHECK A (CC-COMPARE-UCODE-WD (+ (- REG-ADR RAMMO) RAAMO) WD3 WD2 WD1))) (DEFUN CC-MAIN-MEMORY-LOAD (FILE) (PROG (ADR ITEM) (DECLARE (FIXNUM ADR ITEM)) (SETQ ADR (READ-FIXNUM FILE)) L (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0) (RETURN ITEM))) (DBG-WRITE-XBUS ADR ITEM) (SETQ ADR (1+ ADR)) (GO L))) (DEFUN CC-COMPARE-MAIN-MEMORY-LOAD (FILE) (PROG (ADR ITEM TEM) (DECLARE (FIXNUM ADR ITEM TEM)) (SETQ ADR (READ-FIXNUM FILE)) L (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0) (RETURN ITEM))) (COND ((NOT (= ITEM (SETQ TEM (DBG-READ-XBUS ADR)))) (TERPRI) (PRINC '|MAIN MEM ADR |) (PRIN1 ADR) (PRINC '|// FILE |) (PRIN1-THEN-SPACE ITEM) (PRINT 'MACHINE) (PRIN1-THEN-SPACE TEM))) (SETQ ADR (1+ ADR)) (GO L)))