source: trunk/lisp/lmcons/cadld.lisp @ 271

Last change on this file since 271 was 271, checked in by rjs, 7 years ago

Update from System 78.

File size: 8.7 KB
Line 
1;;; -*- MODE: LISP; PACKAGE: CADR; BASE: 8 -*- Patch file for CADR microcode loader
2
3(INCLUDE |LMDOC;.COMPL PRELUD|)
4
5(IF-FOR-MACLISP (DECLARE (EVAL (READ))))
6(IF-FOR-MACLISP (DEFUN **STRING** MACRO (X) `',(CADR X)) ;Bubbles in my brain
7)
8
9(INCLUDE ((LMCONS)CADMAC >))
10(DECLARE (SPECIAL CC-SYMBOL-TABLE CC-FILE-SYMBOLS-LOADED-FROM CC-UINST-DESC))
11(DECLARE (FIXNUM (READ-FIXNUM NOTYPE)))
12
13(DEFUN CC-UCODE-LOADER (MODE FILE-NAME MERGEP)  ;MODE -> NIL IS REGULAR LOAD
14  (PROG (ITEM LOAD-WITHOUT-SYMBOLS-FLAG TEM FILE)
15        (DECLARE (FIXNUM ITEM))
16  #M    (COND ((NULL FILE-NAME) (SETQ FILE-NAME '(UCADR ULOAD DSK LISPM1)))
17              ((= (LENGTH FILE-NAME) 1)
18                (SETQ FILE-NAME (APPEND FILE-NAME '(ULOAD DSK LISPM1)))))
19  #Q    (SETQ FILE-NAME
20              (FS:MERGE-PATHNAME-DEFAULTS (OR FILE-NAME "SYS: UBIN; UCADR ULOAD >")))
21        (COND ((EQ MODE 'LOAD-WITHOUT-SYMBOLS)
22                (SETQ LOAD-WITHOUT-SYMBOLS-FLAG T)
23                (SETQ MODE NIL))
24              ((EQ MODE 'COMPARE) (SETQ LOAD-WITHOUT-SYMBOLS-FLAG T)))
25        (SETQ FILE (OPEN FILE-NAME 'IN))
26  L     (AND (< (SETQ ITEM (READ-FIXNUM FILE)) 0) (GO COM))
27        (COND ((NOT MODE)                       ;IF LOADING, SORT BY REG ADR FOR SPEED
28               (COND ((< ITEM RACME)  ;KLUDGE SIGH.  AVOID BIGNUM CONSING.
29                      (CC-WRITE-C-MEM-3-16BIT-WORDS (- ITEM RACMO)
30                                                    (READ-FIXNUM FILE)
31                                                    (READ-FIXNUM FILE)
32                                                    (READ-FIXNUM FILE)))
33                     ((< ITEM RADME)
34                      (CC-WRITE-D-MEM (- ITEM RADMO)
35                                      (LOGDPB (READ-FIXNUM FILE) 4020
36                                         (LOGDPB (READ-FIXNUM FILE) 2020
37                                             (READ-FIXNUM FILE)))))
38                     ((AND (NOT (< ITEM RAAMO)) (< ITEM RAAME))
39                      (LET ((DATA (LOGDPB (READ-FIXNUM FILE) 4020
40                                          (LOGDPB (READ-FIXNUM FILE) 2020
41                                                  (READ-FIXNUM FILE)))))
42                        (CC-WRITE-A-MEM (- ITEM RAAMO) DATA)
43                        (AND (< (- ITEM RAAMO) 40)      ;M=A
44                             (CC-WRITE-M-MEM (- ITEM RAAMO) DATA))))
45                     ((AND (NOT (< ITEM RAMMO)) (< ITEM RAMME))
46                      (CC-WRITE-M-MEM (- ITEM RAMMO)
47                                      (LOGDPB (READ-FIXNUM FILE) 4020
48                                         (LOGDPB (READ-FIXNUM FILE) 2020
49                                             (READ-FIXNUM FILE)))))
50                     (T (ERROR '|BAD REGISTER ADDRESS IN ULOAD| ITEM))))
51              ((EQ MODE 'COMPARE)
52                (CC-COMPARE-UCODE-WD ITEM (READ-FIXNUM FILE) (READ-FIXNUM FILE) (READ-FIXNUM FILE)))
53              (T (READ-FIXNUM FILE) (READ-FIXNUM FILE) (READ-FIXNUM FILE)))
54        (GO L)
55  COM   (COND ((= ITEM -1) (GO FIN))
56              ((= ITEM -2) (GO SYMLOD))
57              ((= ITEM -3)
58               (COND ((NOT MODE) ;LOAD MICRO-CODE-SYMBOL AREA
59                      (SETQ ITEM (CC-MAIN-MEMORY-LOAD FILE))
60                      (GO COM))
61                     ((EQ MODE 'COMPARE)
62                      (SETQ ITEM (CC-COMPARE-MAIN-MEMORY-LOAD FILE))
63                      (GO COM))
64                     (T (GO SK)))) ;SKIP TO NEXT NEGATIVE CODE
65              ((= ITEM -4)
66               (READ FILE)      ;FLUSH ASSEMBLER STATE INFO
67               (GO SK))
68              ((BREAK BAD-UCODE-LOAD T)))
69  SK    (AND (< (SETQ ITEM (READ-FIXNUM FILE)) 0) (GO COM))
70        (GO SK)
71  FIN   (CLOSE FILE)
72        (RETURN T)
73 SYMLOD (COND (LOAD-WITHOUT-SYMBOLS-FLAG (GO FIN)))     ;LOADING BOOTSTRAP, DONT
74                        ;AFFECT CURRENT SYMBOLS.
75        #Q (PROCESS-ALLOW-SCHEDULE)  ;Come up for a breath
76
77        (SETQ CC-FILE-SYMBOLS-LOADED-FROM NIL)   ;In case bomb out or something.
78        (COND ((NOT (AND MERGEP (BOUNDP 'CC-SYMBOLS-NAME)))
79               (CC-INITIALIZE-SYMBOL-TABLE T)))
80        #Q (PROCESS-ALLOW-SCHEDULE)  ;Come up for a breath
81 SYML1 (COND ((NUMBERP (SETQ TEM (READ FILE)))
82               (SETQ ITEM TEM)
83               #Q (PROCESS-ALLOW-SCHEDULE)  ;Come up for a breath
84               (CC-END-ADDING-SYMBOLS)
85               (SETQ CC-FILE-SYMBOLS-LOADED-FROM
86                     #M FILE-NAME
87                     #Q (FUNCALL FILE ':TRUENAME))      ;So EQ will work later
88               (GO COM)))
89        (CC-ADD-TYPED-SYMBOL TEM (READ FILE) (READ-FIXNUM FILE))
90        (GO SYML1)
91; SYML1 (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0)
92;              (CC-END-ADDING-SYMBOLS)
93;              (GO COM)))
94;       (CC-ADD-SYMBOL (READ FILE) ITEM)
95;       (GO SYML1)
96))
97
98(DEFUN CC-ADD-TYPED-SYMBOL (SYM TYPE VAL)
99   (COND ((EQ TYPE 'I-MEM) (SETQ VAL (+ VAL RACMO)))
100         ((EQ TYPE 'A-MEM) (SETQ VAL (+ VAL RAAMO)))
101         ((EQ TYPE 'M-MEM) (SETQ VAL (+ VAL RAMMO)))
102         ((EQ TYPE 'D-MEM) (SETQ VAL (+ VAL RADMO)))
103         ((EQ TYPE 'NUMBER))
104         (T (PRINT (LIST SYM TYPE VAL))
105            (BREAK BAD-SYMBOL-TYPE T)))
106   (CC-ADD-SYMBOL SYM VAL))
107
108;only wins on LISP machine
109(IF-FOR-LISPM
110(DEFUN COMPARE-MCR-FILE (FILE-NAME)
111  (PROG (STREAM HCODE LCODE HADR LADR HCOUNT LCOUNT HD LD
112                UDSP-NBLKS UDSP-RELBLK FILE MACH)
113        (COND ((NUMBERP FILE-NAME)
114               (SETQ FILE-NAME (FORMAT NIL "LISPM1;UCADR ~DMCR" FILE-NAME))))
115        (SETQ STREAM (OPEN FILE-NAME '(:IN :BLOCK :FIXNUM :BYTE-SIZE 16. )))
116    L0  (SETQ HCODE (FUNCALL STREAM 'TYI) LCODE (FUNCALL STREAM 'TYI))
117        (COND ((OR (NOT (ZEROP HCODE)) (< LCODE 0) (> LCODE 5))
118               (FERROR NIL "BAD CODE HCODE=~O LCODE=~O" HCODE LCODE)))
119        (SETQ HADR (FUNCALL STREAM 'TYI) LADR (FUNCALL STREAM 'TYI))
120        (SETQ HCOUNT (FUNCALL STREAM 'TYI) LCOUNT (FUNCALL STREAM 'TYI))
121        (COND ((OR (NOT (ZEROP HADR))
122                   (NOT (ZEROP HCOUNT)))
123               (FERROR NIL "BAD HEADER SA ~O,~O COUNT ~O,~O"
124                       HADR LADR HCOUNT LCOUNT)))
125        (FORMAT T "~%CODE: ~D, ADR: ~D, COUNT: ~D" LCODE LADR LCOUNT)
126        (COND ((ZEROP LCODE)
127               (COND (UDSP-NBLKS
128                      (FUNCALL STREAM ':SET-POINTER (* 2 UDSP-RELBLK SI:PAGE-SIZE))
129                      (DO ((ADR 1400 (1+ ADR))
130                           (FIN (+ 1400 (* UDSP-NBLKS SI:PAGE-SIZE))))
131                          ((= ADR FIN))
132                        (COND ((NOT (= (SETQ MACH (DBG-READ-XBUS ADR))
133                                       (SETQ FILE (DPB (FUNCALL STREAM 'TYI) 2020
134                                                       (FUNCALL STREAM 'TYI)))))
135                               (FORMAT T "~%Main mem adr ~S// file ~S machine ~S"
136                                       ADR FILE MACH))))))
137               (CLOSE STREAM)
138               (RETURN T))
139              ((= LCODE 1) (GO LI))     ;I-MEM
140              ((= LCODE 2) (GO LD))     ;D-MEM
141              ((= LCODE 3) ;HACK MAIN MEMORY LOAD LATER.
142               (SETQ UDSP-NBLKS LADR)
143               (SETQ UDSP-RELBLK LCOUNT)
144               (SETQ HD (FUNCALL STREAM 'TYI) LD (FUNCALL STREAM 'TYI)) ;PHYS MEM ADR
145               (GO L0))
146              ((= LCODE 4) (GO LA))     ;A-MEM
147              (T (FERROR NIL "BAD CODE ~S" LCODE)))
148    LD  (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0)
149               (GO L0)))
150        (CC-COMPARE-UCODE-WD (+ LADR RADMO)
151                               0
152                               (FUNCALL STREAM 'TYI)
153                               (FUNCALL STREAM 'TYI))
154        (SETQ LADR (1+ LADR))
155        (GO LD)
156    LA  (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0)
157               (GO L0)))
158        (CC-COMPARE-UCODE-WD (+ LADR RAAMO)
159                               0
160                               (FUNCALL STREAM 'TYI)
161                               (FUNCALL STREAM 'TYI))
162        (SETQ LADR (1+ LADR))
163        (GO LA)
164    LI  (COND ((< (SETQ LCOUNT (1- LCOUNT)) 0)
165               (GO L0)))
166        (CC-COMPARE-UCODE-WD (+ LADR RACMO)
167                               (PROG2 (FUNCALL STREAM 'TYI) (FUNCALL STREAM 'TYI))
168                               (FUNCALL STREAM 'TYI)
169                               (FUNCALL STREAM 'TYI))
170        (SETQ LADR (1+ LADR))
171        (GO LI)
172)) )
173
174(DEFUN CC-COMPARE-UCODE-WD (REG-ADR WD3 WD2 WD1)
175  (DECLARE (FIXNUM REG-ADR))
176  (PROG (RD1 RD2 RD3 WD)
177        (DECLARE (FIXNUM RD1 RD2 RD3))
178        (SETQ WD (CC-R-E REG-ADR))
179        (SETQ RD1 (LOGLDB 0020 WD)
180              RD2 (LOGLDB 2020 WD)
181              RD3 (LOGLDB 4020 WD))
182        (COND  ((< REG-ADR RACME) )
183               ((< REG-ADR RADME)
184                (SETQ WD2 (LOGAND WD2 1))       ;REST IS PARITY
185               ;(SETQ RD1 (LOGAND 77777 RD1))   ;FLUSH PARITY
186               ;(RETURN NIL) ;DISPATCH MEMORY CAN'T BE READ
187               )
188              (T (SETQ RD3 0)))                         ;A OR M MEM ONLY 32 BITS
189        (COND ((AND (NOT (AND (= WD1 RD1) (= WD2 RD2) (= WD3 RD3))) ;IF DOESN'T MATCH
190                    (NOT (AND (= WD1 0) (= WD2 0) (= WD3 0))))  ;AND NOT LOADED ZERO
191                                                        ; WHICH WOULD PROBABLY BE A
192                                                        ; VARIABLE WHICH IS OK TO CHANGE
193               (TERPRI)
194               (CC-PRINT-ADDRESS REG-ADR)
195               (PRINC '|// FILE |)
196               (SETQ WD (LOGDPB WD3 4020 (LOGDPB WD2 2020 WD1)))
197               (PRIN1-THEN-SPACE WD)
198               (AND (< REG-ADR RACME)
199                    (CC-TYPE-OUT WD CC-UINST-DESC T T))
200               (PRINT 'MACHINE)
201               (SETQ WD (LOGDPB RD3 4020 (LOGDPB RD2 2020 RD1)))
202               (PRIN1-THEN-SPACE WD)
203               (AND (< REG-ADR RACME)
204                    (CC-TYPE-OUT WD CC-UINST-DESC T T))
205               (PRINT '-----))))
206  (AND (NOT (< REG-ADR RAMMO))                          ;IF LOADING M, ALSO CHECK A
207       (CC-COMPARE-UCODE-WD (+ (- REG-ADR RAMMO) RAAMO) WD3 WD2 WD1)))
208
209(DEFUN CC-MAIN-MEMORY-LOAD (FILE)
210  (PROG (ADR ITEM)
211        (DECLARE (FIXNUM ADR ITEM))
212        (SETQ ADR (READ-FIXNUM FILE))
213  L     (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0) (RETURN ITEM)))
214        (DBG-WRITE-XBUS ADR ITEM)
215        (SETQ ADR (1+ ADR))
216        (GO L)))
217
218(DEFUN CC-COMPARE-MAIN-MEMORY-LOAD (FILE)
219  (PROG (ADR ITEM TEM)
220        (DECLARE (FIXNUM ADR ITEM TEM))
221        (SETQ ADR (READ-FIXNUM FILE))
222  L     (COND ((< (SETQ ITEM (READ-FIXNUM FILE)) 0) (RETURN ITEM)))
223        (COND ((NOT (= ITEM (SETQ TEM (DBG-READ-XBUS ADR))))
224               (TERPRI)
225               (PRINC '|MAIN MEM ADR |)
226               (PRIN1 ADR)
227               (PRINC '|// FILE |)
228               (PRIN1-THEN-SPACE ITEM)
229               (PRINT 'MACHINE)
230               (PRIN1-THEN-SPACE TEM)))
231        (SETQ ADR (1+ ADR))
232        (GO L)))
233
Note: See TracBrowser for help on using the repository browser.