source: tags/system-46/lmcons/cadrd.lisp

Last change on this file was 213, checked in by rjs, 3 years ago

Update.

File size: 49.0 KB
Line 
1;*CAUTION** THIS FILE ONLY FOR MACLISP!!  LCADR;LCADRD FOR LISPM!! -*-LISP-*-
2;       ** (c) Copyright 1980 Massachusetts Institute of Technology **
3;LOW-LEVEL CADR-MUNGING ROUTINES FOR CC
4; FOR TEMPORARY DIAG INTERFACE, NO DIRECT PATH TO MD
5; FOR NOW, MEMORY MAPPING ETC. STUFF NOT YET CONVERTED.
6; DOESN'T TRY TO WIN WITH LPC, OPCS, INTERRUPT CONTROL REGISTER, LC, HAIR LIKE THAT.  LATER.
7; ^ DOES NOW, NO?
8; NO STATISTICS COUNTER STUFF
9;CC-CLEAR-CORE AND CL-LOAD-STRAIGHT-MAP ARE NOT GOING TO WIN!
10
11(DECLARE (EVAL (READ)))
12(PROGN (LOAD '(MACROS > DSK LISPM))
13       (LOAD '(DEFMAC FASL DSK LISPM2))
14       (LOAD '(LMMAC > DSK LISPM2)))
15
16(DECLARE (EVAL (READ)))
17       (DEFUN **STRING** MACRO (X) `',(CADR X)) ;Bubbles in my brain
18
19(DECLARE (EVAL (READ)))
20(SETQ CC-GENERATE-CONS-SYMBOLS-SETQ-FLAG T) ;IN THIS FILE, SEND CONS SYMBOLS OVER
21
22(INCLUDE ((LMCONS)CADMAC >))
23
24(COMMENT DIAGNOSTIC INTERFACE DEFINITION)
25
26;SEE LMDOC;CADR > FOR CADR DIAGNOSTIC INTERFACE.
27
28;THIS CODE OPERATES ON THE THINGS ACCESSIBLE THROUGH THE SPY BUS.
29;THE SPY BUS CAN BE GOTTEN AT IN ONE OF 3 WAYS:
30;  THROUGH THE TEMPORARY DEBUGGING KLUDGE, WITH NO BUS INTERFACE
31;  THROUGH THE BUS INTERFACE, VIA THE TEMPORARY DEBUGGING KLUDGE IN ITS OTHER MODE
32;  DIRECTLY VIA A 10-11 INTERFACE
33;MORE WAYS MAY EXIST IN THE FUTURE.
34
35;THE FUNCTIONS SPY-READ AND SPY-WRITE TAKE A SPY-ADDRESS (0 TO 17) AND
36;DEPENDING ON THE VALUE OF THE SYMBOL SPY-ACCESS-PATH (NO-BUSINT, BUSINT, TEN11)
37;THEY WILL DO THE APPROPRIATE THING.
38
39;HERE ARE SYMBOLS FOR THE DIAGNOSTIC (SPY) REGISTERS
40(DECLARE (LET ((SQ (READ)))
41            (DO L (CDR SQ) (CDDR L) (NULL L)
42                (APPLY 'SPECIAL (LIST (CAR L)))
43                (APPLY 'FIXNUM (LIST (CAR L))))
44            (COUTPUT SQ)))
45(SETQ   ;READING
46        SPY-IR-LOW      0
47        SPY-IR-MED      1
48        SPY-IR-HIGH     2
49        SPY-OPC         4
50        SPY-PC          5
51        SPY-OB-LOW      6
52        SPY-OB-HIGH     7
53        SPY-FLAG-1      10
54        SPY-FLAG-2      11
55        SPY-M-LOW       12
56        SPY-M-HIGH      13
57        SPY-A-LOW       14
58        SPY-A-HIGH      15
59        SPY-STAT-LOW    16
60        SPY-STAT-HIGH   17
61        ;WRITING
62        ;SPY-IR-LOW     0
63        ;SPY-IR-MED     1
64        ;SPY-IR-HIGH    2
65        SPY-CLK         3
66        SPY-OPC-CONTROL 4
67        SPY-MODE        5
68)
69
70(COMMENT DECLARATIONS)
71
72(DECLARE (SPECIAL CC-NOOP-FLAG CC-MODE-REG CC-RUNNING CC-LOW-LEVEL-FLAG
73                  CC-PASSIVE-SAVE-VALID CC-FULL-SAVE-VALID
74                  CC-PDL-BUFFER-INDEX-CHANGED-FLAG ;NIL IF NOT SAVED YET
75                  CC-SAVED-PDL-BUFFER-INDEX  ;SAVED HERE WHEN IT IS SAVED
76                  CC-MICRO-STACK-SAVED-FLAG  ;NIL IF POINTER AND STACK NOT SAVED YET
77                  CC-SAVED-MICRO-STACK-PTR      ;SAVED HERE WHEN IT IS SAVED
78                  CC-SAVED-DISPATCH-CONSTANT    ;NIL IF NOT SAVED, ELSE ASSUMED CHANGED
79                  CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG     ;NIL IF NOT SAVED YET
80                  CC-SAVED-LEVEL-1-MAP-LOC-0
81                  CC-ERROR-STATUS CC-SAVED-PC CC-SAVED-IR CC-SAVED-OBUS CC-SAVED-NOOP-FLAG
82                  CC-SAVED-A-MEM-LOC-1 CC-SAVED-M-MEM-LOC-0
83                  CC-SAVED-VMA CC-SAVED-MD CC-SAVED-MAP-AND-FAULT-STATUS
84                  CC-VMA-CHANGED-FLAG CC-UPDATE-DISPLAY-FLAG CC-UNIBUS-MAP-TO-MD-OK-FLAG
85                  CC-REG-ADR-PHYS-MEM-OFFSET CTALK-BARF-AT-WRITE-ERRORS
86))
87
88(SETQ CC-PASSIVE-SAVE-VALID NIL CC-FULL-SAVE-VALID NIL CC-RUNNING NIL
89      CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
90
91(ARRAY CC-SAVED-OPCS FIXNUM 8)
92(ARRAY CC-MICRO-STACK FIXNUM 32.)
93;COMPILER APPARENTLY DOES THE FOLLOWING ITSELF
94;(DECLARE (ARRAY* (FIXNUM CC-SAVED-OPCS 8) (FIXNUM CC-MICRO-STACK 32.)))
95
96;THESE CAN BE REF'ED IF SWITCH BETWEEN TEN MODE AND 11 MODE.  TRY TO MINIMIZE RESULTING
97; CONFUSION.
98         (SETQ   CC-NOOP-FLAG NIL
99                 CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL
100                 CC-MICRO-STACK-SAVED-FLAG NIL
101                 CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL
102                 CC-ERROR-STATUS 0
103                 CC-SAVED-IR 0
104                 CC-SAVED-NOOP-FLAG NIL
105                 CC-VMA-CHANGED-FLAG NIL
106                 CC-MODE-REG 46 ;NORMAL SPEED, ERROR TRAPS ENABLED, PROM DISABLED
107                 CC-SAVED-PC 0
108                 CC-SAVED-OBUS 0
109                 CC-SAVED-PDL-BUFFER-INDEX 0
110                 CC-SAVED-MICRO-STACK-PTR 0
111                 CC-SAVED-DISPATCH-CONSTANT NIL
112                 CC-SAVED-A-MEM-LOC-1 0
113                 CC-SAVED-M-MEM-LOC-0 0
114                 CC-SAVED-LEVEL-1-MAP-LOC-0 0
115                 CC-SAVED-VMA 0
116                 CC-SAVED-MD 0
117                 CC-SAVED-MAP-AND-FAULT-STATUS 0)
118
119(COMMENT BASIC SPY I&O ROUTINES)
120
121(DECLARE (FIXNUM (SPY-READ FIXNUM) (DBG-READ FIXNUM) (DBG-READ-XBUS FIXNUM)
122                 (DBG-READ-UNIBUS-MAP FIXNUM))
123         (NOTYPE (SPY-WRITE FIXNUM FIXNUM) (DBG-WRITE FIXNUM) (DBG-WRITE-XBUS FIXNUM FIXNUM)
124                 (DBG-WRITE-UNIBUS-MAP FIXNUM FIXNUM))
125         (SPECIAL SPY-ACCESS-PATH))
126
127(DEFUN SPY-NO-BUSINT NIL        ;SWITCH TO NO-BUSINT FLAVOR ACCESS
128  (SETQ SPY-ACCESS-PATH 'NO-BUSINT)
129  (CNSUSP)
130  (FASLOAD CTALK FASL DSK LMCONS)  ;LOAD THE FLAVOR THAT TALKS VIA CONS
131  (CNSINI)
132  T)
133
134;(SETQ SPY-ACCESS-PATH 'BUSINT)
135
136(DEFUN SPY-READ (REGN)
137  (COND ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
138         (CNSUBR (+ 764500 (LSH REGN 1))))
139        ((EQ SPY-ACCESS-PATH 'BUSINT)
140         (DBG-READ (+ 766000 (LSH REGN 1))))
141        ((EQ SPY-ACCESS-PATH 'TEN11)
142         (CNSUBR (+ 766000 (LSH REGN 1))))
143        (T (ERROR '|bad value for SPY-ACCESS-PATH| SPY-ACCESS-PATH))))
144
145(DEFUN SPY-WRITE (REGN VAL)
146  (COND ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
147         (CNSUBW (+ 764500 (LSH REGN 1)) VAL))
148        ((EQ SPY-ACCESS-PATH 'BUSINT)
149         (DBG-WRITE (+ 766000 (LSH REGN 1)) VAL))
150        ((EQ SPY-ACCESS-PATH 'TEN11)
151         (CNSUBW (+ 766000 (LSH REGN 1)) VAL))
152        (T (ERROR '|bad value for SPY-ACCESS-PATH| SPY-ACCESS-PATH)))
153  T) ;Don't number cons result of CNSUBW!!
154
155(COMMENT ROUTINES WHICH MANIPULATE THE MACHINE DIRECTLY)
156
157;READ OBUS AS A FIXNUM
158(DEFUN CC-READ-OBUS ()
159  (LET ((LOW (SPY-READ SPY-OB-LOW))
160        (HIGH (SPY-READ SPY-OB-HIGH)))
161     (DECLARE (FIXNUM LOW HIGH))
162     (+ (LSH HIGH 16.) LOW)))
163
164;READ A-BUS AS A FIXNUM
165(DEFUN CC-READ-A-BUS ()
166  (LET ((LOW (SPY-READ SPY-A-LOW))
167        (HIGH (SPY-READ SPY-A-HIGH)))
168     (DECLARE (FIXNUM LOW HIGH))
169     (+ (LSH HIGH 16.) LOW)))
170
171;READ M-BUS AS A FIXNUM
172(DEFUN CC-READ-M-BUS ()
173  (LET ((LOW (SPY-READ SPY-M-LOW))
174        (HIGH (SPY-READ SPY-M-HIGH)))
175     (DECLARE (FIXNUM LOW HIGH))
176     (+ (LSH HIGH 16.) LOW)))
177
178;READ IR AS A BIGNUM
179(DEFUN CC-READ-IR ()
180  (LET ((LOW (SPY-READ SPY-IR-LOW))
181        (MIDDLE (SPY-READ SPY-IR-MED))
182        (HIGH (SPY-READ SPY-IR-HIGH)))
183     (DECLARE (FIXNUM LOW MIDDLE HIGH))
184     (LOGDPB HIGH 4020 (+ (LSH MIDDLE 16.) LOW))))
185
186;READ PC AS A FIXNUM
187(DEFUN CC-READ-PC ()
188 (SPY-READ SPY-PC)))
189
190;GET 32-BIT ERROR STATUS WORD
191;THIS IS FLAG1_16.+FLAG2
192(DEFUN CC-READ-STATUS ()
193  (LET ((FLAG1 (SPY-READ SPY-FLAG-1))
194        (FLAG2 (SPY-READ SPY-FLAG-2)))
195     (DECLARE (FIXNUM FLAG1 FLAG2))
196     (AND (BIT-TEST 100 (SPY-READ SPY-IR-LOW))
197          (SETQ FLAG2 (LOGXOR 4 FLAG2))) ;Hardware reads JC-TRUE incorrectly
198     (+ FLAG2 (LSH FLAG1 16.))))
199
200;WRITE DIAG IR FROM A BIGNUM
201(DEFUN CC-WRITE-DIAG-IR (IR)
202  (SPY-WRITE SPY-IR-LOW (LOGLDB 0020 IR))
203  (SPY-WRITE SPY-IR-MED (LOGLDB 2020 IR))
204  (SPY-WRITE SPY-IR-HIGH (LOGLDB 4020 IR))
205  T)
206
207(DEFUN CC-WRITE-IR (IR)
208  (CC-WRITE-DIAG-IR IR)
209  (CC-NOOP-DEBUG-CLOCK)
210  T)
211
212;THIS FUNCTION WRITES INTO THE MD.  IF SPY-ACCESS-PATH IS NO-BUSINT, IT HAS TO
213;SHIFT IT IN A BIT AT A TIME.  OTHERWISE IT IS BROUGHT IN THROUGH THE BUS INTERFACE,
214;USING MAPPING REGISTER 7.
215(DEFUN CC-WRITE-MD (NUM)
216  (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
217         (COND ((NOT CC-UNIBUS-MAP-TO-MD-OK-FLAG)
218                (DBG-WRITE-UNIBUS-MAP 7 177000) ;MR7 := VALID + WR-ENB
219                                                ; + MAGIC HIGH 5 1'S TO ADDRESS MD
220                (SETQ CC-UNIBUS-MAP-TO-MD-OK-FLAG T)))
221         (DBG-WRITE 156000 NUM)  ;WRITE LOW HALF-WORD
222         (DBG-WRITE 156002 (LSH NUM -16.))) ;THEN HIGH HALF-WORD
223        ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
224         (CC-WRITE-MD-SHIFTING NUM)
225         NIL)
226        ((EQ SPY-ACCESS-PATH 'TEN11)
227         (LET ((CTALK-BARF-AT-WRITE-ERRORS NIL))  ;CAN'T READ IT BACK VIA THIS KLUDGE
228           (CNSPMW 17400000 NUM)))        ;THIS IS UNIBUS SPACE ON THE XBUS,
229                                          ; SO IT JUST LOADS THE MD
230        (T (ERROR '|SPY-ACCESS-PATH NOT KNOWN ABOUT IN CC-WRITE-MD| SPY-ACCESS-PATH))))
231
232(DEFUN CC-WRITE-MD-SHIFTING (NUM)
233       (SETQ NUM (LOGAND 37777777777 NUM))              ;MAKE SURE ONLY 32 BITS
234       (COND ((ZEROP (LOGAND 1_31. NUM))
235              (CC-EXECUTE (WRITE)
236                          CONS-IR-OB CONS-OB-ALU
237                          CONS-IR-ALUF CONS-ALU-SETZ
238                          CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD))
239             (T
240              (CC-EXECUTE (WRITE)
241                          CONS-IR-OB CONS-OB-ALU
242                          CONS-IR-ALUF CONS-ALU-SETO
243                          CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD)))
244       (COND ((ZEROP NUM))                              ;ALREADY THERE
245             ((= NUM 37777777777))
246             ((DO ((I 31. (1- I))                       ;SHIFT IN REMAINING 31 BITS
247                   (N NUM (LSH N 1)))
248                  ((ZEROP I))
249                  (DECLARE (FIXNUM I N))
250                  (COND ((ZEROP (LOGAND 1_30. N))
251                         (CC-EXECUTE (WRITE)
252                                     CONS-IR-OB CONS-OB-ALU
253                                     CONS-IR-ALUF CONS-ALU-M+M
254                                     CONS-IR-M-SRC CONS-M-SRC-MD
255                                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD))
256                        (T
257                         (CC-EXECUTE (WRITE)
258                                     CONS-IR-OB CONS-OB-ALU
259                                     CONS-IR-ALUF CONS-ALU-M+M+1
260                                     CONS-IR-M-SRC CONS-M-SRC-MD
261                                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD)))))))
262
263;TICK CLOCK IN DEBUG MODE (EXECUTE IR, LOAD IR FROM DIAG IR)
264(DEFUN CC-DEBUG-CLOCK ()
265  (SPY-WRITE SPY-CLK 12) ;DEBUG ON, STEP
266  (SPY-WRITE SPY-CLK 0)  ;STEP OFF, PRESUMABLY MACHINE HAS EXECUTED IT BY NOW
267  T)
268
269;TICK CLOCK IN NOOP-DEBUG MODE, WHICH FINISHES WRITES
270(DEFUN CC-NOOP-DEBUG-CLOCK ()
271  (SPY-WRITE SPY-CLK 16) ;DEBUG, NOOP, STEP
272  (SPY-WRITE SPY-CLK 0)  ;CLEAR STEP, PRESUMABLY MACHINE HAS EXECUTED IT BY NOW
273  T)
274
275;NORMAL-MODE CLOCK
276(DEFUN CC-CLOCK ()
277  (SPY-WRITE SPY-CLK 2) ;STEP
278  (SPY-WRITE SPY-CLK 0) ;CLEAR STEP
279  T)
280
281;TICK CLOCK IN NORMAL-NOOP MODE
282(DEFUN CC-NOOP-CLOCK ()
283  (SPY-WRITE SPY-CLK 6)  ;NOOP, STEP
284  (SPY-WRITE SPY-CLK 0)  ;CLEAR STEP
285  T)
286
287;SINGLE-STEP THE MACHINE (USES CC-NOOP-FLAG)
288(DEFUN CC-SINGLE-STEP ()
289  (COND (CC-NOOP-FLAG
290           (CC-NOOP-CLOCK))
291        (T (CC-CLOCK)))
292  (SETQ CC-ERROR-STATUS (CC-READ-STATUS)
293        CC-NOOP-FLAG (BIT-TEST 20 CC-ERROR-STATUS)))
294
295(COMMENT ROUTINE TO EXECUTE A SYMBOLIC INSTRUCTION)
296
297;CALL THESE VIA THE CC-EXECUTE MACRO
298
299;FOR READING.  WILL LEAVE THE DESIRED DATA ON THE OBUS
300(DEFUN CC-EXECUTE-R (LOW MIDDLE HIGH)
301  (SPY-WRITE SPY-IR-LOW LOW)    ;PUT INSTRUCTION INTO MACHINE
302  (SPY-WRITE SPY-IR-MED MIDDLE)
303  (SPY-WRITE SPY-IR-HIGH HIGH)
304  (CC-NOOP-DEBUG-CLOCK))        ;PUT IT INTO IR, IT WILL THEN ROUTE PROPER STUFF TO OBUS
305
306;FOR WRITING.  WILL CLOCK THE MACHINE IN NON-DEBUG MODE WHICH IS
307;GOOD FOR READING AND WRITING CONTROL MEMORY.
308(DEFUN CC-EXECUTE-W (LOW MIDDLE HIGH)
309  (SPY-WRITE SPY-IR-LOW LOW)    ;PUT INSTRUCTION INTO MACHINE
310  (SPY-WRITE SPY-IR-MED MIDDLE)
311  (SPY-WRITE SPY-IR-HIGH HIGH)
312  (CC-NOOP-DEBUG-CLOCK)         ;PUT IT INTO IR, IT WILL START EXECUTING
313  (CC-CLOCK)                    ;CLOCK THAT INSTRUCTION, GARBAGE TO IR
314  (CC-NOOP-CLOCK)               ;CLOCK MACHINE AGAIN TO CLEAR PASS AROUND PATH, LOAD IR
315  T)                            ; WITH INSTRUCTION JUMPED TO, ETC.
316
317(COMMENT READ AND WRITE RAMS)
318
319;READ M-MEMORY DIRECTLY OUT OF MACHINE
320;WE USE THIS FOR READING FUNCTIONAL SOURCES ALSO
321(DEFUN CC-READ-M-MEM (ADR)
322  (CC-EXECUTE CONS-IR-M-SRC ADR ;PUT IT ONTO THE OBUS
323              CONS-IR-ALUF CONS-ALU-SETM
324              CONS-IR-OB CONS-OB-ALU)
325  (CC-READ-OBUS))
326
327;WRITE INTO M-MEMORY
328(DEFUN CC-WRITE-M-MEM
329 (LOC VAL)
330  (CC-WRITE-MD VAL)             ;PUT VALUE INTO THE MRD REGISTER
331  (CC-EXECUTE (WRITE)
332              CONS-IR-M-SRC CONS-M-SRC-MD       ;MOVE IT TO DESIRED PLACE
333              CONS-IR-ALUF CONS-ALU-SETM
334              CONS-IR-OB CONS-OB-ALU
335              CONS-IR-M-MEM-DEST LOC))
336
337;READ A-MEMORY
338(DEFUN CC-READ-A-MEM (ADR)
339  (CC-EXECUTE CONS-IR-A-SRC ADR ;PUT IT ONTO THE OBUS
340              CONS-IR-ALUF CONS-ALU-SETA
341              CONS-IR-OB CONS-OB-ALU)
342  (CC-READ-OBUS))
343
344;WRITE INTO A-MEMORY
345(DEFUN CC-WRITE-A-MEM (LOC VAL)
346  (CC-WRITE-MD VAL)             ;PUT VALUE INTO THE MRD REGISTER
347  (CC-EXECUTE (WRITE)
348              CONS-IR-M-SRC CONS-M-SRC-MD       ;MOVE IT TO DESIRED PLACE
349              CONS-IR-ALUF CONS-ALU-SETM
350              CONS-IR-OB CONS-OB-ALU
351              CONS-IR-A-MEM-DEST (+ CONS-A-MEM-DEST-INDICATOR LOC)))
352
353;READ CONTROL-MEMORY
354(DEFUN CC-READ-C-MEM (ADR)
355  (CC-EXECUTE (WRITE)
356              CONS-IR-OP CONS-OP-JUMP   ;DO JUMP INSTRUCTION TO DESIRED PLACE
357              CONS-IR-JUMP-ADDR ADR
358              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC)
359  (CC-READ-IR))                 ;RETURN CONTENTS
360
361;WRITE CONTROL-MEMORY
362(DEFUN CC-WRITE-C-MEM (ADR VAL)
363  (CC-WRITE-A-MEM 1 (LOGLDB 4020 VAL))  ;1@A GETS HIGH 16 BITS
364  (CC-WRITE-M-MEM 0 (LOGLDB 0040 VAL))  ;0@M GETS LOW 32 BITS
365  (CC-EXECUTE (WRITE)
366              CONS-IR-OP CONS-OP-JUMP   ;EXECUTE MAGIC FLAVOR OF JUMP INSTRUCTION
367              CONS-IR-JUMP-ADDR ADR
368              CONS-IR-P 1               ;R+P=WRITE C MEM
369              CONS-IR-R 1
370              CONS-IR-A-SRC 1
371              ;CONS-IR-M-SRC 0
372              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC))
373
374;THIS ONE IS DIFFERENT FROM EVERYTHING ELSE.  IT AGREES WITH THE ULOAD FORMAT.
375;NOTE THAT THE CC-EXECUTE MACRO CAN CALL THIS WITH VALUES WITH BITS
376;ON IN OTHER THAN THE LOW 16 BITS.  THE LOGIOR CAUSES THE RIGHT THING TO HAPPEN.
377(DEFUN CC-WRITE-C-MEM-3-16BIT-WORDS (ADR HIGH MIDDLE LOW)
378  (CC-WRITE-A-MEM 1 HIGH)               ;1@A GETS HIGH 16 BITS
379  (CC-WRITE-MD (LOGIOR (LSH MIDDLE 16.) LOW))  ;MD GETS LOW 32 BITS
380  (CC-EXECUTE (WRITE)
381              CONS-IR-OP CONS-OP-JUMP   ;EXECUTE MAGIC FLAVOR OF JUMP INSTRUCTION
382              CONS-IR-JUMP-ADDR ADR
383              CONS-IR-P 1               ;R+P=WRITE C MEM
384              CONS-IR-R 1
385              CONS-IR-A-SRC 1
386              CONS-IR-M-SRC CONS-M-SRC-MD
387              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC))
388
389;WRITE INTO MACHINE'S PC
390(DEFUN CC-WRITE-PC (PC)
391  (LET ((TEM NIL))
392    (SETQ PC (LOGAND 37777 PC)) ;14 BITS
393    (CC-EXECUTE CONS-IR-OP CONS-OP-JUMP ;JUMP INSTRUCTION TO IR
394                CONS-IR-JUMP-ADDR PC
395                CONS-IR-JUMP-COND CONS-JUMP-COND-UNC)
396    (CC-DEBUG-CLOCK)            ;CLOCK INTO PC
397    (OR (= PC (SETQ TEM (CC-READ-PC)))  ;CHECK?
398        (ERROR '|CORRECT . ACTUAL - LOSSAGE - CC-WRITE-PC| (CONS PC TEM) 'FAIL-ACT))
399    T))
400
401(DEFUN CC-WRITE-FUNC-DEST (ADR VAL)
402  (CC-WRITE-MD VAL)
403  (CC-EXECUTE (WRITE)
404        CONS-IR-M-SRC CONS-M-SRC-MD
405        CONS-IR-ALUF CONS-ALU-SETM
406        CONS-IR-OB CONS-OB-ALU
407        CONS-IR-FUNC-DEST ADR))
408
409(DEFUN CC-WRITE-Q (VAL)
410  (CC-WRITE-MD VAL)
411  (CC-EXECUTE (WRITE)
412        CONS-IR-M-SRC CONS-M-SRC-MD
413        CONS-IR-ALUF CONS-ALU-SETM
414        CONS-IR-OB CONS-OB-ALU
415        CONS-IR-Q CONS-Q-LOAD))
416
417(DEFUN CC-WRITE-STAT-COUNTER (VAL)
418  (CC-WRITE-MD VAL)     ;GET VALUE ON M-SIDE
419  (CC-EXECUTE
420        CONS-IR-M-SRC CONS-M-SRC-MD)
421  (CC-NOOP-CLOCK)       ;IWR GETS M
422  (SPY-WRITE SPY-CLK 26)        ;CLOCK MACHINE WITH LDSTAT SET
423  (SPY-WRITE SPY-CLK 0))        ;CLEAR STEP, LDSTAT
424
425;SAVE THE PDL-BUFFER-INDEX INTO CC-SAVED-PDL-BUFFER-INDEX
426(DEFUN CC-SAVE-PDL-BUFFER-INDEX ()
427  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-PDL-BUFFER-INDEX ;PUT PDL INDEX ONTO OBUS BITS 9-0
428              CONS-IR-ALUF CONS-ALU-SETM
429              CONS-IR-OB CONS-OB-ALU)
430  (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG T
431        CC-SAVED-PDL-BUFFER-INDEX (CC-READ-OBUS)))
432
433;WRITE INTO PDL-BUFFER-INDEX
434(DEFUN CC-WRITE-PDL-BUFFER-INDEX (VAL)
435  (CC-WRITE-MD VAL)                                     ;PUT VALUE INTO MD
436  (CC-EXECUTE (WRITE)
437              CONS-IR-M-SRC CONS-M-SRC-MD               ;MOVE INTO PDL INDEX
438              CONS-IR-ALUF CONS-ALU-SETM
439              CONS-IR-OB CONS-OB-ALU
440              CONS-IR-FUNC-DEST CONS-FUNC-DEST-PDL-BUFFER-INDEX))
441
442;READ THE PDL BUFFER
443(DEFUN CC-READ-PDL-BUFFER (ADR)
444  (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG
445      (CC-SAVE-PDL-BUFFER-INDEX))                       ;SAVE PDL INDEX IF NECESSARY
446  (CC-WRITE-PDL-BUFFER-INDEX ADR)                       ;ADDRESS THE PDL
447  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-C-PDL-BUFFER-INDEX       ;READ IT OUT
448              CONS-IR-ALUF CONS-ALU-SETM
449              CONS-IR-OB CONS-OB-ALU)
450  (CC-READ-OBUS))                                       ;RETURN CONTENTS
451
452;WRITE THE PDL BUFFER
453(DEFUN CC-WRITE-PDL-BUFFER (ADR VAL)
454  (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG (CC-SAVE-PDL-BUFFER-INDEX)) ;SAVE PDL INDEX IF NECESSARY
455  (CC-WRITE-PDL-BUFFER-INDEX ADR)                       ;ADDRESS THE PDL
456  (CC-WRITE-MD VAL)                                     ;PUT VALUE INTO MRD
457  (CC-EXECUTE (WRITE)
458              CONS-IR-M-SRC CONS-M-SRC-MD               ;STORE INTO PDL BUFFER
459              CONS-IR-ALUF CONS-ALU-SETM
460              CONS-IR-OB CONS-OB-ALU
461              CONS-IR-FUNC-DEST CONS-FUNC-DEST-C-PI))
462
463;READ OUT THE MICRO STACK POINTER
464(DEFUN CC-READ-MICRO-STACK-PTR ()
465  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK      ;READ OUT THE MICRO STACK PTR
466              CONS-IR-ALUF CONS-ALU-SETM
467              CONS-IR-OB CONS-OB-ALU)
468  (LOGLDB-FROM-FIXNUM CONS-US-POINTER-BYTE (CC-READ-OBUS)))
469
470;SAVE THE ENTIRE MICRO STACK (AND THE POINTER)
471(DEFUN CC-SAVE-MICRO-STACK ()
472  (COND ((NOT CC-MICRO-STACK-SAVED-FLAG)        ;DON'T DO IF DID ALREADY
473         (SETQ CC-MICRO-STACK-SAVED-FLAG T)
474         (SETQ CC-SAVED-MICRO-STACK-PTR (CC-READ-MICRO-STACK-PTR))
475         (DO ((COUNT 32. (1- COUNT))    ;NOW READ OUT THE WHOLE STACK
476              (IDX CC-SAVED-MICRO-STACK-PTR (LOGAND 37 (1- IDX))))
477             ((= 0 COUNT))
478           (DECLARE (FIXNUM COUNT IDX))
479           (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK-POP
480                       CONS-IR-ALUF CONS-ALU-SETM
481                       CONS-IR-OB CONS-OB-ALU)
482           (STORE (CC-MICRO-STACK IDX)
483                  (LOGLDB-FROM-FIXNUM CONS-US-DATA-BYTE (CC-READ-OBUS)))
484           (CC-CLOCK)))))               ;NOW DECREMENT USP
485
486
487;RESTORE THE MICRO STACK AND THE POINTER
488(DEFUN CC-RESTORE-MICRO-STACK ()
489  (COND (CC-MICRO-STACK-SAVED-FLAG
490         (DO ()                                         ;UNTIL USP EQUALS THE DESIRED VALUE,
491             ((= CC-SAVED-MICRO-STACK-PTR (CC-READ-MICRO-STACK-PTR)))
492             (CC-EXECUTE (WRITE) CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK-POP)) ;KEEP POPPING IT
493         (DO ((COUNT 32. (1- COUNT))                    ;NOW RESTORE THE WHOLE STACK
494              (IDX CC-SAVED-MICRO-STACK-PTR))
495             ((= COUNT 0))
496             (DECLARE (FIXNUM COUNT IDX))
497             (SETQ IDX (LOGAND 37 (1+ IDX)))            ;SIMULATE HARDWARE PUSH OPERATION
498             (CC-WRITE-MD (CC-MICRO-STACK IDX)) ;GET DATA INTO MRD
499             (CC-EXECUTE (WRITE)
500                         CONS-IR-M-SRC CONS-M-SRC-MD    ;PUSH IT
501                         CONS-IR-ALUF CONS-ALU-SETM
502                         CONS-IR-OB CONS-OB-ALU
503                         CONS-IR-FUNC-DEST CONS-FUNC-DEST-MICRO-STACK-PUSH))
504         (SETQ CC-MICRO-STACK-SAVED-FLAG NIL))))
505
506;SAVE THE DISPATCH CONSTANT IF NOT SAVED ALREADY
507;RETURNS THE VALUE
508(DEFUN CC-SAVE-DISPATCH-CONSTANT ()
509  (COND (CC-SAVED-DISPATCH-CONSTANT)
510        (T
511         (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-DISP-CONST
512                     CONS-IR-ALUF CONS-ALU-SETM
513                     CONS-IR-OB CONS-OB-ALU)
514         (SETQ CC-SAVED-DISPATCH-CONSTANT (CC-READ-OBUS)))))
515
516;RESTORE DISPATCH CONSTANT IF IT WAS SAVED.  BASHES PC, POSSIBLY MICRO-STACK.
517(DEFUN CC-RESTORE-DISPATCH-CONSTANT ()
518  (COND (CC-SAVED-DISPATCH-CONSTANT
519         (CC-SAVE-MICRO-STACK)
520         (CC-EXECUTE (WRITE)
521                     CONS-IR-OP CONS-OP-DISPATCH
522                     CONS-IR-DISP-CONST CC-SAVED-DISPATCH-CONSTANT)
523         (SETQ CC-SAVED-DISPATCH-CONSTANT NIL))))
524
525;READ OUT DISPATCH MEMORY
526;(IF R BIT IS ON, DPC CONTAINS RANDOMNESS, SO WE WILL CLEAR IT.)
527(DEFUN CC-READ-D-MEM (ADR)
528  (LET ((PCS 0)
529        (FLAG2 0)
530        (RPN 0))
531     (DECLARE (FIXNUM DC PCS RPN FLAG2))
532     (CC-SAVE-MICRO-STACK)              ;AVOID SMASHING MICRO STACK
533     (CC-SAVE-DISPATCH-CONSTANT)        ;AVOID SMASHING DISPATCH CONSTANT
534     (CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH    ;EXECUTE A DISPATCH WITH BYTE SIZE ZERO
535                 CONS-IR-DISP-ADDR ADR)
536             ;AT THIS POINT THE DISP IS IN IR BUT HAS NOT YET BEEN EXECUTED.
537             ;WE'LL EXECUTE IT IN A MOMENT, BUT FIRST CHECK OUT THE PC SELECT BITS.
538     (SETQ PCS (LOGLDB-FROM-FIXNUM 0002 (SPY-READ SPY-FLAG-2))) ;GET PC SELECT BITS
539     (SETQ RPN (NTH PCS '(4             ;R (POPJ)
540                          0             ;(JUMP VIA IR??)
541                          0             ;(JUMP VIA D-MEM)
542                          6)))          ;R+P, DROP THROUGH
543     (CC-CLOCK)                         ;CLOCK IT SO PC LOADS FROM DISP MEM
544     (SETQ FLAG2 (SPY-READ SPY-FLAG-2)) ; THEN PICK UP NOOP AND SPUSHD FLAGS
545     (AND (BIT-TEST 20 FLAG2)           ;SEE IF NOOP FLAG ON
546          (SETQ RPN (LOGIOR RPN 1)))    ;TURN ON N BIT
547     (AND (BIT-TEST 400 FLAG2)          ;SEE IF SPUSHD IS ON
548          (SETQ RPN (LOGIOR RPN 2)))
549     (LOGDPB-INTO-FIXNUM RPN            ;RETURN R,P,N BITS MERGED WITH PC
550                 CONS-DISP-RPN-BITS
551                 (COND ((OR (= PCS 0) (= PCS 3)) 0) ;IF R OR R+P, DPC IS MEANINGLESS, USE 0
552                       ((CC-READ-PC))))))
553
554;WRITE INTO DISPATCH MEMORY
555(DEFUN CC-WRITE-D-MEM (ADR VAL)
556     (CC-SAVE-MICRO-STACK)              ;DON'T SMASH MICRO STACK
557     (CC-SAVE-DISPATCH-CONSTANT)        ;DON'T SMASH DISPATCH CONSTANT
558     (SETQ VAL                          ;COMPUTE PARITY
559           (LOGDPB-INTO-FIXNUM (DO ((COUNT 17. (1- COUNT))
560                                    (X VAL (LOGXOR VAL (LSH X -1))))
561                                   ((= COUNT 0)
562                                    (LOGXOR 1 X)))      ;ODD PARITY
563                               CONS-DISP-PARITY-BIT
564                               VAL))
565     (CC-WRITE-A-MEM 0 VAL)             ;DATA TO BE WRITTEN TO A-LOC 0
566     ;PUT INSTRUCTION IN DIB AND IR
567     (CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH
568                 CONS-IR-A-SRC 0
569                 CONS-IR-DISP-ADDR ADR
570                 CONS-IR-MF 2)  ;MF2 IS WRITE D-MEM
571     ;GENERATE A CLOCK FOLLOWED BY A WRITE PULSE, WITHOUT CHANGING IR
572     ;NOTE THAT WRITING D MEM IS DIFFERENT FROM WRITING ANYTHING ELSE
573     ;BECAUSE THE WRITE IS NOT DELAYED, BUT DOES USE WP.
574     (CC-DEBUG-CLOCK))
575
576(COMMENT RESET START AND STOP)
577
578;RESET THE MACHINE
579(DEFUN CC-RESET-MACH ()
580  (SPY-WRITE SPY-MODE 100) ;RESET HIGH
581  (CC-WRITE-MODE-REG CC-MODE-REG)
582  (COND ((NOT (EQ SPY-ACCESS-PATH 'NO-BUSINT))
583         (DBG-RESET-STATUS))))          ;ALSO RESET UNIBUS, XBUS  PARERRS AND NXMS
584
585;STORE MODE-REG VALUE INTO THE MACHINE
586;CADR MODE REGS ARE THOROUGHLY INCOMPATIBLE WITH CONS MODE REGS
587(DEFUN CC-WRITE-MODE-REG (MODE)
588  (SPY-WRITE SPY-MODE MODE))
589
590;STOP THE MACHINE
591(DEFUN CC-STOP-MACH ()
592  (SPY-WRITE SPY-CLK 0)         ;STOP CLOCK
593  (SETQ CC-RUNNING NIL))        ;NOT RUNNING NOW
594
595;START THE MACHINE.
596(DEFUN CC-START-MACH ()
597  (CC-FULL-RESTORE)             ;RESTORE MACHINE IF TRYING TO RUN
598  (CC-SINGLE-STEP)              ;CLOCK ONCE, OBEYING SAVED NOOP FLAG
599  (CC-CLOCK)                    ;CLOCK AGAIN
600  (SPY-WRITE SPY-CLK 1)         ;TAKE OFF
601  (SETQ CC-RUNNING T))))
602
603;ARG IF SMALL IS A COUNT OTHERWISE IT IS THE REGISTER ADDRESS OF PC TO STOP AT.
604;LATER ON THIS SHOULD USE THE STAT COUNTER?
605(DEFUN CC-STEP-MACH (ARG)
606  (COND ((< ARG RAORG)
607         (DO N (MAX ARG 1) (1- N) (= N 0)
608           (CC-SINGLE-STEP)))
609        (T (SETQ ARG (- ARG RACMO))     ;STOP PC
610           (PROG NIL    ;ALWAYS EXECUTE AT LEAST ONCE
611            LP (CC-SINGLE-STEP)
612               (AND (CC-HALTED)
613                    (RETURN NIL))       ;MACHINE LOSSAGE, STOP
614               (OR (= (CC-READ-PC) ARG)
615                   (GO LP))
616               (CC-SINGLE-STEP)         ;CLOCK ONCE MORE TO FETCH DESIRED INSTR
617               (AND CC-NOOP-FLAG
618                    (GO LP))            ;NOOP FLAG SET, NOT REALLY EXECUTING IT
619               (RETURN T)))))           ;REACHED DESIRED PC, STOP
620
621(DEFUN CC-HALTED ()
622  (BIT-TEST 6000 (LOGXOR 4000 (SPY-READ SPY-FLAG-1))))
623
624(COMMENT VIRTUAL MEMORY MAP MANIPULATION)
625
626;READ OUT CONTENTS OF LEVEL 1 MAP
627(DEFUN CC-READ-LEVEL-1-MAP (ADR)
628  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-1-BYTE 0))        ;ADDRESS VIA MD
629  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP      ;READ OUT MAP DATA
630              CONS-IR-ALUF CONS-ALU-SETM
631              CONS-IR-OB CONS-OB-ALU)
632  (LOGLDB-FROM-FIXNUM CONS-MAP-LEVEL-1-BYTE (CC-READ-OBUS)))
633
634;WRITE INTO LEVEL 1 MAP
635(DEFUN CC-WRITE-LEVEL-1-MAP (ADR VAL)
636  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM VAL          ;DATA TO WRITE
637                                   CONS-MAP-LEVEL-1-BYTE-FOR-WRITING
638                                   CONS-VMA-WRITE-LEVEL-1-MAP-BIT))
639  (SETQ CC-VMA-CHANGED-FLAG T)
640  (CC-EXECUTE (WRITE)                           ;MOVE WRITE DATA FROM MD TO VMA
641              CONS-IR-M-SRC CONS-M-SRC-MD
642              CONS-IR-ALUF CONS-ALU-SETM
643              CONS-IR-OB CONS-OB-ALU
644              CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)
645  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-1-BYTE 0))        ;ADDRESS VIA MD
646  (CC-EXECUTE (WRITE)
647              CONS-IR-M-SRC CONS-M-SRC-MD       ;DO A MD-WRITE-MAP
648              CONS-IR-ALUF CONS-ALU-SETM
649              CONS-IR-OB CONS-OB-ALU
650              CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD-WRITE-MAP))
651
652;SUBROUTINE TO SET UP ADDRESS FOR LEVEL 2 MAP (USING LEVEL 1 MAP LOCATION 0)
653;RETURNS VALUE TO GO INTO MD AS ADDRESS SOURCE
654(DEFUN CC-ADDRESS-LEVEL-2-MAP (ADR)
655  (COND ((NOT CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG)        ;SAVE AND SET CLOBBERED FLAG
656         (SETQ CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG T)
657         (SETQ CC-SAVED-LEVEL-1-MAP-LOC-0 (CC-READ-LEVEL-1-MAP 0))))
658  (CC-WRITE-LEVEL-1-MAP 0 (LSH ADR -5)) ;HIGH 5 BITS OF ADDRESS TO LEVEL 1 MAP ENTRY 0
659  (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-2-BYTE 0))     ;LOW 5 BITS OF ADDRESS TO RETURN VALUE
660
661;READ OUT CONTENTS OF LEVEL 2 MAP
662(DEFUN CC-READ-LEVEL-2-MAP (ADR)
663  (CC-WRITE-MD (CC-ADDRESS-LEVEL-2-MAP ADR))    ;SET UP MD
664  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP      ;READ OUT MAP
665              CONS-IR-ALUF CONS-ALU-SETM
666              CONS-IR-OB CONS-OB-ALU)
667  (LOGLDB-FROM-FIXNUM CONS-MAP-LEVEL-2-BYTE (CC-READ-OBUS)))
668
669;WRITE INTO LEVEL 2 MAP
670(DEFUN CC-WRITE-LEVEL-2-MAP (ADR VAL)
671  (LET ((MAPADR (CC-ADDRESS-LEVEL-2-MAP ADR)))  ;SET UP ADDRESS (DON'T STORE IN HARDW YET)
672     (DECLARE (FIXNUM MAPADR))
673     (CC-WRITE-MD (LOGDPB-INTO-FIXNUM VAL       ;DATA TO WRITE
674                                      CONS-MAP-LEVEL-2-BYTE
675                                      CONS-VMA-WRITE-LEVEL-2-MAP-BIT))
676     (SETQ CC-VMA-CHANGED-FLAG T)               ;MOVE WRITE-DATA INTO VMA
677     (CC-EXECUTE (WRITE)
678                 CONS-IR-M-SRC CONS-M-SRC-MD
679                 CONS-IR-ALUF CONS-ALU-SETM
680                 CONS-IR-OB CONS-OB-ALU
681                 CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)
682     (CC-WRITE-MD MAPADR)                       ;NOW SET UP MD
683     (CC-EXECUTE (WRITE)
684                 CONS-IR-M-SRC CONS-M-SRC-MD    ;DO A MD-WRITE-MAP
685                 CONS-IR-ALUF CONS-ALU-SETM
686                 CONS-IR-OB CONS-OB-ALU
687                 CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD-WRITE-MAP)))
688
689(COMMENT SAVE AND RESTORE THE STATE OF THE MACHINE)
690
691;SAVE THINGS WHICH CAN BE SAVED WITHOUT MODIFYING THE STATE OF THE MACHINE
692(DEFUN CC-PASSIVE-SAVE ()
693  (COND ((NOT CC-PASSIVE-SAVE-VALID)
694         (CNSPMI)  ;FLUSH UNIBUS MAP LOOKBEHIND
695         (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL     ;FIRST OF ALL, CLEAR FLAGS
696               CC-MICRO-STACK-SAVED-FLAG NIL            ; WHICH MARK AUXILIARY PORTIONS
697               CC-SAVED-DISPATCH-CONSTANT NIL           ; OF THE MACHINE NEED RESTORATION
698               CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL
699               CC-VMA-CHANGED-FLAG NIL ;MRD ALMOST ALWAYS CHANGED, ALWAYS RESTORE IT
700               CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
701         (SETQ CC-ERROR-STATUS (CC-READ-STATUS)
702               CC-SAVED-PC (CC-READ-PC)
703               CC-SAVED-IR (CC-READ-IR)
704               CC-SAVED-OBUS (CC-READ-OBUS)
705               CC-SAVED-NOOP-FLAG (BIT-TEST 20 CC-ERROR-STATUS))
706         (SETQ CC-PASSIVE-SAVE-VALID T))))
707
708;FULL SAVE
709(DEFUN CC-FULL-SAVE ()
710  (COND ((NOT CC-FULL-SAVE-VALID)
711         (CC-STOP-MACH)
712         (CC-PASSIVE-SAVE)
713         (CC-SAVE-OPCS)
714         (SETQ CC-SAVED-A-MEM-LOC-1 (CC-READ-A-MEM 1))
715         (SETQ CC-SAVED-M-MEM-LOC-0 (CC-READ-M-MEM 0))
716         (CC-SAVE-MEM-STATUS)
717         (SETQ CC-FULL-SAVE-VALID T))))
718
719(DEFUN CC-ENTER ()
720  (COND ((EQ CC-LOW-LEVEL-FLAG 'VERY)
721         (CC-STOP-MACH)
722         (CC-PASSIVE-SAVE))
723        ((NULL CC-FULL-SAVE-VALID)
724         (CC-FULL-SAVE))))
725
726;Put everything back in the real machine, but dont completely forget
727; about it.
728(DEFUN CC-REPLACE-STATE NIL
729  (LET ((CC-FULL-SAVE-VALID CC-FULL-SAVE-VALID)
730        (CC-PASSIVE-SAVE-VALID CC-PASSIVE-SAVE-VALID))
731    (CC-FULL-RESTORE)))
732
733;RESTORE THAT
734(DEFUN CC-FULL-RESTORE ()
735  (COND (CC-FULL-SAVE-VALID
736         (AND CC-SAVED-DISPATCH-CONSTANT
737              (CC-RESTORE-DISPATCH-CONSTANT))
738         (AND CC-MICRO-STACK-SAVED-FLAG
739              (CC-RESTORE-MICRO-STACK))
740         (AND CC-PDL-BUFFER-INDEX-CHANGED-FLAG
741              (CC-WRITE-PDL-BUFFER-INDEX CC-SAVED-PDL-BUFFER-INDEX))
742         (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL)
743         (CC-WRITE-A-MEM 1 CC-SAVED-A-MEM-LOC-1) ;ON NEXT MACHINE, THIS LINE HAS TO CHANGE?
744         (CC-WRITE-M-MEM 0 CC-SAVED-M-MEM-LOC-0)
745         (CC-RESTORE-MEM-STATUS)
746         (SETQ CC-FULL-SAVE-VALID NIL)))
747  (COND (CC-PASSIVE-SAVE-VALID
748         (CC-WRITE-PC (1- CC-SAVED-PC)) ;GETS INCREMENTED WHEN IR IS LOADED
749         (CC-EXECUTE-R (LOGLDB 0020 CC-SAVED-IR)        ;RESTORE IR
750                       (LOGLDB 2020 CC-SAVED-IR)
751                       (LOGLDB 4020 CC-SAVED-IR))
752         (SETQ CC-NOOP-FLAG CC-SAVED-NOOP-FLAG
753               CC-PASSIVE-SAVE-VALID NIL
754               CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL))))
755
756(DEFUN CC-SAVE-OPCS ()
757  (DO I 0 (1+ I) (= I 8)
758    (DECLARE (FIXNUM I))
759    (STORE (CC-SAVED-OPCS I) (SPY-READ SPY-OPC))
760    (SPY-WRITE SPY-OPC-CONTROL 2)       ;CLOCK OPCS
761    (SPY-WRITE SPY-OPC-CONTROL 0)))
762
763(DEFUN CC-SAVE-MEM-STATUS ()
764  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-VMA
765              CONS-IR-ALUF CONS-ALU-SETM
766              CONS-IR-OB CONS-OB-ALU)
767  (SETQ CC-SAVED-VMA (CC-READ-OBUS))
768  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP
769              CONS-IR-ALUF CONS-ALU-SETM
770              CONS-IR-OB CONS-OB-ALU)
771  (SETQ CC-SAVED-MAP-AND-FAULT-STATUS (CC-READ-OBUS))
772  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MD
773              CONS-IR-ALUF CONS-ALU-SETM
774              CONS-IR-OB CONS-OB-ALU)
775  (SETQ CC-SAVED-MD (CC-READ-OBUS)))
776
777(DEFUN CC-RESTORE-MEM-STATUS ()
778  (AND CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG
779       (CC-WRITE-LEVEL-1-MAP 0 CC-SAVED-LEVEL-1-MAP-LOC-0))
780  (SETQ CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL)
781  (COND (CC-VMA-CHANGED-FLAG
782         (CC-WRITE-MD CC-SAVED-VMA)
783         (CC-EXECUTE (WRITE)
784                     CONS-IR-M-SRC CONS-M-SRC-MD
785                     CONS-IR-ALUF CONS-ALU-SETM
786                     CONS-IR-OB CONS-OB-ALU
787                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)))
788  (SETQ CC-VMA-CHANGED-FLAG NIL)
789  (CC-WRITE-MD CC-SAVED-MD)
790  ;If we haven't executed any memory cycles via the processor, the page fault
791  ;status bits will still be good.  If we have, tough noogies.  Attempting to
792  ;restore them will bash the MD register and probably isn't needed anyway.
793)
794
795(COMMENT REGISTER ADDRESS INTERFACE)
796
797;CC-REGISTER-EXAMINE
798(DEFUN CC-R-E (ADR)
799  (COND ((< ADR RAORG)
800         (PRINT ADR) (PRINC "excessively small register address.")
801         0)
802        ((< ADR RAFSO)  ;RAMS
803         (COND ((< ADR RAM2O)
804                (COND ((< ADR RACME)
805                       (CC-READ-C-MEM (- ADR RACMO)))
806                      ((< ADR RADME)
807                       (CC-READ-D-MEM (- ADR RADMO)))
808                      ((< ADR RAPBE)
809                       (CC-READ-PDL-BUFFER (- ADR RAPBO)))
810                      ((CC-READ-LEVEL-1-MAP (- ADR RAM1O)))))
811               ((< ADR RAM2E)
812                (CC-READ-LEVEL-2-MAP (- ADR RAM2O)))
813               ((< ADR RAAME)
814                (COND ((AND (= (SETQ ADR (- ADR RAAMO)) 0) (NOT CC-LOW-LEVEL-FLAG))
815                       CC-SAVED-M-MEM-LOC-0) ;M=A
816                      ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR 1))
817                       CC-SAVED-A-MEM-LOC-1)
818                      ((CC-READ-A-MEM ADR))))
819               ((< ADR RAUSE)
820                (CC-SAVE-MICRO-STACK)
821                (CC-MICRO-STACK (- ADR RAUSO)))
822               ((AND (= (SETQ ADR (- ADR RAMMO)) 0) (NOT CC-LOW-LEVEL-FLAG))
823                CC-SAVED-M-MEM-LOC-0)
824               ((CC-READ-M-MEM ADR))))
825        ((< ADR RAFSE)  ;FUNCTIONAL SOURCES
826         (SETQ ADR (- ADR RAFSO))
827         (COND (CC-LOW-LEVEL-FLAG (CC-READ-M-MEM (+ ADR CONS-FUNC-SRC-INDICATOR)))
828               ((= ADR CONS-M-SRC-MD) CC-SAVED-MD)
829               ((= ADR CONS-M-SRC-VMA) CC-SAVED-VMA)
830               ((= ADR CONS-M-SRC-MAP) CC-SAVED-MAP-AND-FAULT-STATUS)
831               ((AND (= ADR CONS-M-SRC-PDL-BUFFER-INDEX)
832                     CC-PDL-BUFFER-INDEX-CHANGED-FLAG)
833                CC-SAVED-PDL-BUFFER-INDEX)
834               ((AND (OR (= ADR CONS-M-SRC-MICRO-STACK)
835                         (= ADR CONS-M-SRC-MICRO-STACK-POP))
836                     CC-MICRO-STACK-SAVED-FLAG)
837                (PROG1 (LOGDPB-INTO-FIXNUM CC-SAVED-MICRO-STACK-PTR CONS-US-POINTER-BYTE
838                                           (CC-MICRO-STACK CC-SAVED-MICRO-STACK-PTR))
839                       (AND (= ADR CONS-M-SRC-MICRO-STACK-POP)
840                            (SETQ CC-SAVED-MICRO-STACK-PTR
841                                  (LOGAND 37 (1- CC-SAVED-MICRO-STACK-PTR))))))
842               ((AND (= ADR CONS-M-SRC-C-PDL-BUFFER-INDEX)
843                     CC-PDL-BUFFER-INDEX-CHANGED-FLAG)
844                (CC-READ-PDL-BUFFER CC-SAVED-PDL-BUFFER-INDEX))
845               (T (CC-READ-M-MEM (+ ADR CONS-FUNC-SRC-INDICATOR)))))
846        ((< ADR RAFDE)  ;FUNCTIONAL DESTINATIONS
847         (SETQ ADR (- ADR RAFDO))
848         (COND (CC-LOW-LEVEL-FLAG
849                (CC-READ-M-MEM
850                        (COND ((= ADR CONS-FUNC-DEST-MD) CONS-M-SRC-MD)
851                              ((= ADR CONS-FUNC-DEST-VMA) CONS-M-SRC-VMA)
852                              ((= ADR CONS-FUNC-DEST-PDL-BUFFER-POINTER)
853                               CONS-M-SRC-PDL-BUFFER-POINTER)
854                              ((= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX)
855                               CONS-M-SRC-PDL-BUFFER-INDEX)
856                              ((= ADR CONS-FUNC-DEST-LC) CONS-M-SRC-LC)
857                              (T (PRINT 'LOSE) 0))))
858               ((= ADR CONS-FUNC-DEST-MD) CC-SAVED-MD)
859               ((= ADR CONS-FUNC-DEST-VMA) CC-SAVED-VMA)
860               ((= ADR CONS-FUNC-DEST-PDL-BUFFER-POINTER)
861                (CC-READ-M-MEM CONS-M-SRC-PDL-BUFFER-POINTER))
862               ((= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX)
863                (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG (CC-SAVE-PDL-BUFFER-INDEX))
864                CC-SAVED-PDL-BUFFER-INDEX)
865               (T (PRINT (+ ADR RAFDO)) (PRINC "attempt to examine functional destination")
866                  0)))
867        ((< ADR RARGE)  ;INDIVIDUAL REGISTERS
868         (COND ((= ADR RAPC)
869                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-PC))
870                      (T CC-SAVED-PC)))
871               ((= ADR RAUSP)
872                (COND (CC-MICRO-STACK-SAVED-FLAG
873                       CC-SAVED-MICRO-STACK-PTR)
874                      ((CC-READ-MICRO-STACK-PTR))))
875               ((= ADR RAIR)
876                (CC-READ-IR))  ;HARDWARE IR
877               ((= ADR RASIR)
878                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-IR))
879                      (T CC-SAVED-IR)))   ;PROGRAM IR
880               ((= ADR RAQ)
881                (CC-READ-M-MEM CONS-M-SRC-Q))
882               ((= ADR RALC)
883                (CC-READ-M-MEM CONS-M-SRC-LC))
884               ((= ADR RADC)
885                (CC-SAVE-DISPATCH-CONSTANT))
886               ((= ADR RASTS) CC-ERROR-STATUS)
887               ((= ADR RAOBS)
888                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-OBUS))
889                      (T CC-SAVED-OBUS)))
890               ((= ADR RAREALOBUS) (CC-READ-OBUS))
891               ((= ADR RAABUS) (CC-READ-A-BUS))
892               ((= ADR RAMBUS) (CC-READ-M-BUS))
893               ((= ADR RASTAT) (+ (LSH (SPY-READ SPY-STAT-HIGH) 16.) (SPY-READ SPY-STAT-LOW)))
894               ((= ADR RAGO)  ;Determine whether the machine is currently running
895                (COND ((AND CC-RUNNING (NOT (CC-HALTED))) 1)
896                      (T 0)))
897               ((= ADR RAMOD) CC-MODE-REG)
898               ((AND (>= ADR RAUBMO) (< ADR RAUBME))
899                (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
900                       (DBG-READ-UNIBUS-MAP (- ADR RAUBMO)))
901                      ((EQ SPY-ACCESS-PATH 'TEN11)
902                       (CNSUBR (+ 766140 (* 2 (- ADR RAUBMO)))))
903                      (T (ERROR '|UNKNOWN SPY-ACCESS-PATH EXAMINING UNIBUS MAP|
904                                SPY-ACCESS-PATH))))
905               (T (PRINT 'LOSE) 0)))
906        ((< ADR RAOPCO)
907         (PRINT ADR) (PRINC "is among the unimplemented registers.")
908         0)
909        ((< ADR RAOPCE)
910         (CC-SAVED-OPCS (- ADR RAOPCO)))
911        ((>= ADR CC-REG-ADR-PHYS-MEM-OFFSET)  ;REFERENCING XBUS FROM TEST PROGRAM
912         (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
913                (DBG-READ-XBUS (- ADR CC-REG-ADR-PHYS-MEM-OFFSET)))
914               ((EQ SPY-ACCESS-PATH 'TEN11)
915                (CNSPMR (- ADR CC-REG-ADR-PHYS-MEM-OFFSET)))
916               (T
917                (ERROR '|UNKNOWN SPY-ACCESS-PATH EXAMINING XBUS| SPY-ACCESS-PATH))))
918        (T (PRINT ADR) (PRINC "is an excessively large register address")
919           0)))
920
921;CC-REGISTER-DEPOSIT
922;WHEN TO SAVE & RESTORE STATE OF MACHINE IS FUZZY IN THIS FUNCTION
923(DEFUN CC-R-D (ADR VAL)
924  (COND ((< ADR RAORG)
925         (PRINT ADR) (PRINC "excessively small register address.  Depositing ") (PRIN1 VAL))
926        ((< ADR RAFSO)  ;RAMS
927         (COND ((< ADR RAM2O)
928                (COND ((< ADR RACME)
929                       (CC-WRITE-C-MEM (- ADR RACMO) VAL))
930                      ((< ADR RADME)
931                       (CC-WRITE-D-MEM (- ADR RADMO) VAL))
932                      ((< ADR RAPBE)
933                       (CC-WRITE-PDL-BUFFER (- ADR RAPBO) VAL))
934                      ((CC-WRITE-LEVEL-1-MAP (- ADR RAM1O) VAL))))
935               ((< ADR RAM2E)
936                (CC-WRITE-LEVEL-2-MAP (- ADR RAM2O) VAL))
937               ((< ADR RAAME)
938                (COND ((AND (= (SETQ ADR (- ADR RAAMO)) 1)
939                            (NOT CC-LOW-LEVEL-FLAG))
940                       (SETQ CC-SAVED-A-MEM-LOC-1 VAL))
941                      ((CC-WRITE-A-MEM ADR VAL))))
942               ((< ADR RAUSE)
943                (CC-SAVE-MICRO-STACK)
944                (STORE (CC-MICRO-STACK (- ADR RAUSO)) VAL)
945                (AND CC-LOW-LEVEL-FLAG (CC-RESTORE-MICRO-STACK)))
946               (T
947                (SETQ ADR (- ADR RAMMO))
948                (COND ((AND (= ADR 0) (NOT CC-LOW-LEVEL-FLAG))
949                       (SETQ CC-SAVED-M-MEM-LOC-0 VAL))
950                      (T (AND (= ADR 1) (SETQ CC-SAVED-A-MEM-LOC-1 VAL))
951                         (CC-WRITE-M-MEM ADR VAL))))))
952        ((< ADR RAFSE)  ;FUNCTIONAL SOURCES
953         (PRINT ADR) (PRINC "attempt to deposit in functional source ignored"))
954        ((< ADR RAFDE)  ;FUNCTIONAL DESTINATIONS
955         (SETQ ADR (- ADR RAFDO))
956         (COND ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-MD))
957                (SETQ CC-SAVED-MD VAL))
958               ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-VMA))
959                (SETQ CC-SAVED-VMA VAL))
960               ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX))
961                (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG T
962                      CC-SAVED-PDL-BUFFER-INDEX VAL))
963               (T
964                (CC-WRITE-MD VAL)
965                (CC-EXECUTE (WRITE)
966                            CONS-IR-M-SRC CONS-M-SRC-MD
967                            CONS-IR-ALUF CONS-ALU-SETM
968                            CONS-IR-OB CONS-OB-ALU
969                            CONS-IR-FUNC-DEST ADR)) ))
970        ((< ADR RARGE)  ;INDIVIDUAL REGISTERS
971         (COND ((= ADR RAPC)
972                (COND (CC-LOW-LEVEL-FLAG (CC-WRITE-PC (LOGAND 37777 VAL)))
973                      (T (SETQ CC-SAVED-PC (LOGAND 37777 VAL)))))
974               ((= ADR RAUSP)
975                (CC-SAVE-MICRO-STACK)
976                (SETQ CC-SAVED-MICRO-STACK-PTR (LOGAND 37 VAL)))
977               ((= ADR RAIR)
978                (CC-WRITE-DIAG-IR VAL)
979                (CC-NOOP-DEBUG-CLOCK))
980               ((= ADR RAQ)
981                (CC-WRITE-Q VAL))
982               ((= ADR RALC)
983                (CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC VAL))
984               ((= ADR RADC)
985                (SETQ CC-SAVED-DISPATCH-CONSTANT VAL)
986                (AND CC-LOW-LEVEL-FLAG (CC-RESTORE-DISPATCH-CONSTANT)))
987               ((= ADR RARSET)
988                (CC-ZERO-ENTIRE-MACHINE))
989               ((= ADR RARS)
990                (CC-RESET-MACH)
991                (SETQ CC-PASSIVE-SAVE-VALID NIL CC-FULL-SAVE-VALID NIL
992                      CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
993                (CC-FULL-SAVE))
994               ((= ADR RASTEP)
995                (CC-FULL-RESTORE)
996                (CC-STEP-MACH VAL)
997                (CC-FULL-SAVE))
998               ((= ADR RASTOP)
999                (CC-FULL-SAVE)) ;STOP & SAVE
1000               ((= ADR RASA)  ;SET START ADDR
1001                (SETQ CC-SAVED-NOOP-FLAG T
1002                      CC-ERROR-STATUS (LOGIOR 20 CC-ERROR-STATUS) ;SET NOP BIT
1003                      CC-SAVED-PC (LOGAND 37777 VAL)))
1004               ((= ADR RAGO)
1005                (CC-START-MACH))
1006               ((= ADR RASTAT) (CC-WRITE-STAT-COUNTER VAL))
1007               ((= ADR RAMOD)
1008                (CC-WRITE-MODE-REG (SETQ CC-MODE-REG VAL)))
1009               ((AND (>= ADR RAUBMO) (< ADR RAUBME))
1010                (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
1011                       (DBG-WRITE-UNIBUS-MAP (- ADR RAUBMO) VAL))
1012                      ((EQ SPY-ACCESS-PATH 'TEN11)
1013                       (CNSUBW (+ 766140 (* 2 (- ADR RAUBMO))) VAL))
1014                      (T (ERROR '|UNKNOWN SPY-ACCESS-PATH DEPOSITING UNIBUS MAP|
1015                                SPY-ACCESS-PATH))))
1016               (T (PRINT ADR) (PRINC "is an unimplemented register - deposit."))))
1017        ((>= ADR CC-REG-ADR-PHYS-MEM-OFFSET)  ;REFERENCING XBUS FROM TEST PROGRAM
1018         (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
1019                (DBG-WRITE-XBUS (- ADR CC-REG-ADR-PHYS-MEM-OFFSET) VAL))
1020               ((EQ SPY-ACCESS-PATH 'TEN11)
1021                (CNSPMW (- ADR CC-REG-ADR-PHYS-MEM-OFFSET) VAL))
1022               (T (ERROR '|UNKNOWN SPY-ACCESS-PATH DEPOSITING XBUS| SPY-ACCESS-PATH))))
1023        (T (PRINT ADR)
1024           (PRINC "is an excessively large or unimplemented register address - deposit."))))
1025
1026(COMMENT *** PATCHES TO CC)
1027
1028;NEW REGISTERS:
1029; .A, .M, .OBUS (EXAMINE ONLY)
1030; .IR MAY BE DEPOSITED
1031;NEW COMMANDS:
1032; :EX CLOCK THE MACHINE, EXECUTING WHAT'S IN .IR
1033; :SCOPE RUN MACHINE AT FULL SPEED, REPEATING INSTRUCTION IN .IR
1034; adr :START   START MACHINE, LET IT RUN
1035; :LOWLEVEL T TURNS ON LOW-LEVEL MODE, IN WHICH READING MOST REGISTERS
1036;  GETS WHAT IS CURRENTLY IN THE MACHINE RATHER THAN WHAT IS SAVED,
1037;  WRITING IS UNAFFACTED.  MAKES THE DISPLAY AT THE BOTTOM OF THE SCREEN USEFUL WITH :EX
1038; :MODE DISPLAY THE CURRENT MODE-REGISTER (DECODED)
1039; :CHMODE APPLIES THE BIT-FIELD-EDITOR TO THE MODE-REGISTER.
1040; :RESTORE DOES A FULL-RESTORE, GETTING SOFTWARE STATE INTO HARDWARE
1041;UPDATES THE ERROR STATUS BITS AND MICROINSTRUCTION FORMAT FOR THE NEW MACHINE.
1042;NOTE THAT THE OFFSET FOR PHYSICAL MEMORY IS NOW 200000 INSTEAD OF 100000
1043;PERHAPS THE PHYSICAL MEMORY AND REGISTER-ADDRESS SPACE SHOULD BE MOVED
1044;TO HUGE ADDRESSES AND THE VIRTUAL-MEMORY OFFSET MOVED TO 0?
1045
1046(DEFPROP START CC-COLON-START CC-COLON-CMD)
1047
1048(DEFUN CC-COLON-START (PC)
1049  (CC-RESET-MACH)
1050  (CC-WRITE-PC PC)
1051  (CC-NOOP-CLOCK)
1052  (CC-CLOCK)
1053  (SPY-WRITE SPY-CLK 1))
1054
1055;EXECUTE .IR (I.E. CLOCK MACHINE ONCE)
1056(DEFPROP EX CC-EXECUTE-DOT-IR CC-COLON-CMD)
1057
1058(DEFUN CC-EXECUTE-DOT-IR (ARG)
1059  (CC-CLOCK))
1060
1061;******* THE FOLLOWING WILL HAVE TO BE CHANGED FOR NEW CC SYMBOL TABLE FORMAT *******
1062(SETQ CC-INITIAL-SYMS '( (RESET .  RARSET) (VMA . RAVMA) (MD . RAMD) (RAIDR . RARDRO)
1063                ;(PSV . RAPSVAL) (FSV . RAFSVAL) (LLMOD . RALLMOD)
1064                ;(RUNNING . RARUN) (TRYING-TO-RUN . RATRUN) (NOOPF . RANOOPF)
1065                (OPC . RAOPCO) (/.IR . RAIR) (IR . RASIR)
1066                (/.OBUS . RAREALOBUS) (/.A . RAABUS) (/.M . RAMBUS) (STATC . RASTAT)
1067                (FDEST . RAFDO) (FSRC . RAFSO)
1068                (PC . RAPC) (USP . RAUSP) (Q . RAQ) (DC . RADC)
1069                (PP . RAPP) (PI . RAPI) (CIB . RACIBO) (MODE . RAMOD)
1070                (LC . RALC) (UBM . RAUBMO)
1071;FUNCTIONAL SOURCE SYMS FOR TYPOUT
1072        (FS-DC . (+ RAFSO 0)) (FS-US . (+ RAFSO 1)) (FS-PP . (+ RAFSO 2)) (FS-PI . (+ RAFSO 3))
1073        (FS-C-PI . (+ RAFSO 5)) (FS-C-PP . (+ RAFSO 25)) (FS-C-PP-POP . (+ RAFSO 24))
1074        (FS-OPC . (+ RAFSO 6)) (FS-Q . (+ RAFSO 7))
1075        (FS-VMA . (+ RAFSO 10)) (FS-MAP . (+ RAFSO 11)) (FS-MD . (+ RAFSO 12))
1076        (FS-LC . (+ RAFSO 13)) (FS-US-POP . (+ RAFSO 14))
1077;FUNCTIONAL DESTINATIONS FOR TYPEOUT
1078        (FD-LC . (+ RAFDO 1)) (FD-INT-CTL . (+ RAFDO 2))
1079        (FD-C-PP . (+ RAFDO 10)) (FD-C-PP-PUSH . (+ RAFDO 11))
1080        (FD-C-PI . (+ RAFDO 12)) (FD-PI . (+ RAFDO 13)) (FD-PP . (+ RAFDO 14))
1081        (FD-US-PUSH . (+ RAFDO 15)) (FD-OA-LOW . (+ RAFDO 16)) (FD-OA-HIGH . (+ RAFDO 17))
1082        (FD-VMA . (+ RAFDO 20)) (FD-VMA-RD . (+ RAFDO 21)) (FD-VMA-WRT . (+ RAFDO 22))
1083        (FD-VMA-WRT-MAP . (+ RAFDO 23)) (FD-MD . (+ RAFDO 30)) (FD-MD-RD . (+ RAFDO 31))
1084        (FD-MD-WRT . (+ RAFDO 32)) (FD-MD-WRT-MAP . (+ RAFDO 33))
1085))
1086
1087(CC-INITIALIZE-SYMBOL-TABLE NIL)
1088
1089(SETQ CC-LOW-LEVEL-FLAG NIL)
1090
1091(DEFPROP LOWLEVEL CC-SET-LOW-LEVEL-MODE CC-COLON-CMD)
1092
1093(DEFUN CC-SET-LOW-LEVEL-MODE (ARG)
1094  (PRIN1 '(T OR NIL))
1095  (SETQ CC-LOW-LEVEL-FLAG (READ)))
1096
1097(SETQ PDP11-DISABLE T) ;CLEARLY
1098
1099(DEFUN CC-PRINT-ERROR-STATUS (ERR-STS)
1100       (COND (CC-LOW-LEVEL-FLAG
1101              (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE)
1102             ;(SETQ ERR-STS (CC-READ-STATUS))
1103              )) ;GET LATEST WORD, IN LOW-LEVEL MODE
1104       (CC-PRINT-SET-BITS ERR-STS '(
1105        ;FLAG2
1106        NIL NIL ;PCS0, PCS1
1107        JC-TRUE P-FLT NO-OP IR48 NIL NIL ;NC NC
1108        SPUSHD PDLWRITED IMODD IWRITED DESTSPCD WMAPD NIL NIL ;NC NC
1109        ;FLAG1
1110;NOTE THAT THE BUS DRIVER WHICH DRIVES THE LOW ORDER 8 BITS IS AN INVERTING BUS FRYER.
1111         A-MEM-PAR M-MEM-PAR PDL-BUF-PAR SPC-PAR
1112         DISP-PAR C-MEM-PAR MN-MEM-PAR HIGH-ERR
1113        S-RUN SSDONE ANY-ERR (NOT STAT-HALT)
1114        (NOT PROM-ENABLE) (NOT LVL-1-MAP-PAR) (NOT LVL-2-MAP-PAR) (NOT CLOCK-WAIT))))
1115
1116(DECLARE (SPECIAL CC-MODE-REG-DESC))
1117
1118(SETQ CC-MODE-REG-DESC
1119      '( (SELECT-FIELD SPEED 0002 (ULTRA-SLOW SLOW NORMAL FAST))
1120         (SELECT-FIELD ERROR-STOP-ENABLE 0201 (NIL ERROR-STOP-ENABLE))
1121         (SELECT-FIELD STAT-STOP-ENABLE 0301 (NIL STAT-STOP-ENABLE))
1122         (SELECT-FIELD PARITY-TRAP-ENABLE 0401 (NIL PARITY-TRAP-ENABLE))
1123         (SELECT-FIELD PROM-DISABLE 0501 (PROM-ENABLE PROM-DISABLE))
1124         (SELECT-FIELD RESET-BIT 0601 (NIL RESET-BIT)) ;HA
1125         (SELECT-FIELD BOOT-BIT 0701 (NIL BOOT-BIT)) ;HA
1126         ))
1127
1128(DEFPROP MODE CC-SHOW-MODE CC-COLON-CMD)
1129
1130(DEFUN CC-SHOW-MODE (ARG)
1131  (AND CC-LOW-LEVEL-FLAG (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE))
1132  (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL))
1133
1134(DEFPROP CHMODE CC-EDIT-MODE CC-COLON-CMD)
1135
1136(DEFUN CC-EDIT-MODE (ARG)
1137  (SPY-WRITE SPY-MODE (SETQ CC-MODE-REG (CC-TYPE-IN CC-MODE-REG-DESC CC-MODE-REG T))))
1138
1139(DEFPROP RESTORE CC-RESTORE-CMD CC-COLON-CMD)
1140
1141(DEFUN CC-RESTORE-CMD (ARG)
1142  (CC-FULL-RESTORE))
1143
1144;PATCH MICRO-INSTRUCTION FORMAT TABLES FOR NEW MACHINE
1145
1146(SETQ CC-O-UINST-DESC '( (SELECT-FIELD POPJ-AFTER-NEXT 5201 (NIL PJ))
1147                       (COND OPCD 5302 (CC-O-ALU-DESC
1148                                   CC-O-JMP-DESC
1149                                   CC-O-DSP-DESC
1150                                   CC-O-BYT-DESC))
1151                       (SELECT-FIELD ILONG 5501 (NIL ILONG))
1152                       (SELECT-FIELD STAT-BIT 5601 (NIL STAT-BIT))
1153                       (SELECT-FIELD BIT-47 5701 (NIL BIT-47)) ))
1154       
1155(SETQ CC-O-ALU-DESC '((TYPE ALU)
1156                      (TYPE-FIELD A 4012 RAAMO)
1157                      (TYPE-FIELD M 3206 RAMMO)
1158                      (SELECT-FIELD OB 1402 (MSK NIL ALUR1 ALUL1))
1159                      (SUB-FIELD CC-O-DEST-DESC)
1160                      (SELECT-FIELD ALUF 0306
1161                                (SETZ AND ANDCA SETM ANDCM SETA XOR IOR
1162                                 ANDCB EQV SETCA ORCA SETCM ORCM ORCB SETO
1163                                 T T T T T T SUB T
1164                                 T ADD T T INCM T T LSHM
1165                                 MUL DIV T T T DIVRC T T
1166                                 T DIVFS T T T T T T
1167                                 T T T T T T T T T T T T T T T T))
1168                      (SELECT-FIELD CARRY 0201 (C0 C1))
1169                      (SELECT-FIELD Q 0002 (NIL QLEFT QRIGHT LOADQ))
1170                      (SELECT-FIELD MF 1202 (NIL T T T))
1171))
1172
1173(SETQ CC-O-DSP-DESC '((TYPE DSP)
1174                      (TYPE-FIELD DC 4012 NIL)
1175                      (TYPE-FIELD M 3206 RAMMO)
1176                      (TYPE-FIELD DO 1413 RADMO)
1177                      (TYPE-FIELD BYTL 0503 NIL)
1178                      (TYPE-FIELD MROT 0005 NIL)
1179                      (SELECT-FIELD LPC 3101 (NIL LPC))
1180                      (SELECT-FIELD IFETCH 3001 (NIL IFETCH))
1181                      (SELECT-FIELD MAP 1002 (NIL MAP-14 MAP-15 MAP-BOTH-14-AND-15))
1182                      (SELECT-FIELD MF 1202 (NIL T D-MEM-WRITE LOW-PC-BIT-SEL-HW))
1183))
1184
1185(SETQ CC-O-JMP-DESC '((TYPE JMP)
1186                      (TYPE-FIELD A 4012 RAAMO)
1187                      (TYPE-FIELD M 3206 RAMMO)
1188                      (TYPE-FIELD J-ADR 1416 RACMO)
1189                      (SELECT-FIELD R 1101 (NIL R))
1190                      (SELECT-FIELD P 1001 (NIL P))
1191                      (SELECT-FIELD N 0701 (NIL N))
1192                      (SELECT-FIELD INV 0601 (NIL INV))
1193                      (COND TC 0501 (CC-O-JMP-BIT-DESC CC-O-JMP-ALU-DESC))
1194                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
1195))
1196
1197(SETQ CC-O-JMP-BIT-DESC '( (TYPE MROT) (NUM 0005)       ;CAN'T USE TYPE-FIELD DUE TO TYPEIN BUG
1198))
1199
1200(SETQ CC-O-JMP-ALU-DESC '( (SELECT-FIELD CONDITION 0003
1201                                (T M<A M<=A M=A PF INT-OR-PF SB-OR-INT-OR-PF UNC))
1202))
1203
1204(SETQ CC-O-BYT-DESC '((TYPE BYT)
1205                      (TYPE-FIELD A 4012 RAAMO)
1206                      (TYPE-FIELD M 3206 RAMMO)
1207                      (SUB-FIELD CC-O-DEST-DESC)
1208                      (SELECT-FIELD BYTM 1402 (NIL LDB SSUB DPB))
1209                      (TYPE-FIELD BYTL 0505 NIL)
1210                      (TYPE-FIELD MROT 0005 NIL)
1211                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
1212))
1213
1214(SETQ CC-O-DEST-DESC '( (COND DEST 3101 (CC-O-M-DEST-DESC CC-O-A-DEST-DESC))))
1215
1216(SETQ CC-O-M-DEST-DESC '( (TYPE-FIELD DM 1605 RAMMO)
1217                        (TYPE-FIELD FD 2305 RAFDO)
1218))
1219
1220(SETQ CC-O-A-DEST-DESC '( (TYPE-FIELD DA 1612 RAAMO)
1221))
1222
1223;New assembler-style micro-instruction type-out and type-in.
1224(SETQ CC-UINST-DESC '( (CTYPE | (|)
1225                       (SELECT-FIELD POPJ-AFTER-NEXT? 5201 (NIL (POPJ-AFTER-NEXT YES)))
1226                       (COND OPCLASS 5302 (CC-ALU-DESC
1227                                           CC-JMP-DESC
1228                                           CC-DSP-DESC
1229                                           CC-BYT-DESC))
1230                       (SELECT-FIELD STAT-BIT 5601 (NIL (STAT-BIT YES)))
1231                       (SELECT-FIELD BIT-47 5701 (NIL (BIT-47 YES)))
1232                       (CTYPE |) |) ))
1233
1234(SETQ CC-ALU-DESC '(  (INPUT (TYPE ALU))
1235                      (OUTPUT (SUB-FIELD CC-DEST-DESC))
1236                      (SELECT-FIELD ALU-FUNCTION 0306
1237                                (SETZ AND ANDCA SETM ANDCM (SETA NIL) XOR IOR
1238                                 ANDCB EQV SETCA ORCA SETCM ORCM ORCB SETO
1239                                 T T T T T T SUB T
1240                                 T ADD T T INCM T T LSHM
1241                                 MUL DIV T T T DIVRC T T
1242                                 T DIVFS T T T T T T
1243                                 T T T T T T T T T T T T T T T T))
1244                      (INPUT (SUB-FIELD CC-DEST-DESC))
1245                      (IF-EQUAL ALU 0306 26 CC-SUB-CARRY-DESC CC-NORMAL-CARRY-DESC)
1246                      (SELECT-FIELD OUTPUT-SELECTOR 1402
1247                                    (T NIL OUTPUT-SELECTOR-RIGHTSHIFT-1
1248                                       OUTPUT-SELECTOR-LEFTSHIFT-1))
1249                      (OUTPUT (SELECT-FIELD Q 0002 (NIL SHIFT-Q-LEFT SHIFT-Q-RIGHT NIL)))
1250                      (INPUT (SELECT-FIELD Q 0002 (NIL SHIFT-Q-LEFT SHIFT-Q-RIGHT LOAD-Q)))
1251                      (SUB-FIELD CC-M-SOURCE-DESC)
1252                      (TYPE-FIELD A 4012 RAAMO)
1253                      (SELECT-FIELD MF 1202 (NIL T T T))
1254                      (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) (ILONG YES)))
1255))
1256
1257(SETQ CC-SUB-CARRY-DESC '((SELECT-FIELD CARRY 0201 (ALU-CARRY-IN-ZERO
1258                                                    (ALU-CARRY-IN-ONE NIL)))))
1259
1260(SETQ CC-NORMAL-CARRY-DESC '((SELECT-FIELD CARRY 0201 ((NIL ALU-CARRY-IN-ZERO)
1261                                                       ALU-CARRY-IN-ONE))))
1262
1263(SETQ CC-DSP-DESC '(  (TYPE DISPATCH)
1264                      (IF-EQUAL DISP-CONST 4012 0 NIL CC-DSP-CONST-DESC)
1265                      (CALL CC-BYTE-FIELD-OUT 0010 T NIL)
1266                      (SUB-FIELD CC-M-SOURCE-DESC)
1267                      (TYPE-FIELD D 1413 RADMO)
1268                      (SELECT-FIELD PUSH-OWN-ADDRESS? 3101 (NIL (PUSH-OWN-ADDRESS YES)))
1269                      (SELECT-FIELD IFETCH? 3001 (NIL (IFETCH YES)))
1270                      (SELECT-FIELD MAP 1002 (NIL MAP-14 MAP-15 MAP-BOTH-14-AND-15))
1271                      (SELECT-FIELD MF 1202 (NIL T D-MEM-WRITE LOW-PC-BIT-SEL-HW))
1272                      (SELECT-FIELD ILONG 5501 (NO-ILONG (ILONG NIL YES)))))
1273
1274(SETQ CC-DSP-CONST-DESC '((CTYPE | (|)
1275                          (TYPE-FIELD I-ARG 4012 NIL)
1276                          (CTYPE |) |)))
1277
1278(SETQ CC-JMP-DESC '(  (INPUT (TYPE JUMP)
1279                             (SELECT-FIELD CALL-RETURN 1002
1280                                           ((JUMP NIL) CALL RETURN T))
1281                             (COND COND 0501 (((SELECT-FIELD SENSE 0601 (BIT-SET BIT-CLEAR))
1282                                               (CALL CC-BYTE-FIELD-OUT 0005 T T))
1283                                              ((COND COND 0601
1284                                                  (((SELECT-FIELD COND 0003
1285                                                      (T LESS-THAN LESS-OR-EQUAL EQUAL
1286                                                       PAGE-FAULT PAGE-FAULT-OR-INTERRUPT
1287                                                       |SEQUENCE-BREAK-OR-...|
1288                                                       (ALWAYS NIL))))
1289                                                   ((SELECT-FIELD COND 0003
1290                                                      (T GREATER-OR-EQUAL
1291                                                       GREATER-THAN NOT-EQUAL
1292                                                       NO-PAGE-FAULT NO-PAGE-FAULT-OR-INTERRUPT
1293                                                       |NO-SEQUENCE-BREAK-OR-...|
1294                                                       NEVER))))))))
1295                             (SELECT-FIELD DONT-XCT-NEXT 0701 (XCT-NEXT (DONT-XCT-NEXT NIL))))
1296                      (OUTPUT (CALL CC-TYPE-JUMP-CONDITION 0012))
1297                      (SUB-FIELD CC-M-SOURCE-DESC)
1298                      (TYPE-FIELD A 4012 RAAMO)
1299                      (TYPE-FIELD J 1416 RACMO)
1300                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
1301                      (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) (ILONG YES)))
1302))
1303
1304(SETQ CC-BYT-DESC '((INPUT (TYPE BYTE))
1305                    (OUTPUT (SUB-FIELD CC-DEST-DESC))
1306                    (SELECT-FIELD BYTE-OPERATION 1402 (T LDB SELECTIVE-DEPOSIT DPB))
1307                    (INPUT (SUB-FIELD CC-DEST-DESC))
1308                    (CALL CC-BYTE-FIELD-OUT 0012 NIL T)
1309                    (SUB-FIELD CC-M-SOURCE-DESC)
1310                    (TYPE-FIELD A 4012 RAAMO)
1311                    (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
1312                    (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) ILONG))
1313))
1314
1315(SETQ CC-DEST-DESC '((OUTPUT (IF-EQUAL DEST 1613 0 CC-Q-DEST-DESC CC-DEST-DESC-1))
1316                     (INPUT (IF-EQUAL DEST 1613 0 NIL CC-DEST-DESC-1))))
1317(SETQ CC-DEST-DESC-1 '((CTYPE | (|)
1318                       (COND DEST 3101 (CC-M-DEST-DESC CC-A-DEST-DESC))
1319                       (OUTPUT (IF-EQUAL ALU 5302 0
1320                                         ((IF-EQUAL DEST 0002 3 ((TYPE Q-R)) NIL))
1321                                         NIL))
1322                       (CTYPE |) |)))
1323
1324(SETQ CC-Q-DEST-DESC '((IF-EQUAL ALU 5302 0
1325                                 ((IF-EQUAL DEST 0002 3 ((CTYPE | (Q-R) |)) NIL))
1326                                 NIL)))
1327
1328(SETQ CC-M-DEST-DESC '((TYPE-FIELD M 1605 RAMMO)
1329                       (SELECT-FIELD FDEST 2305
1330                            (NIL LOCATION-COUNTER INTERRUPT-CONTROL T T T T T   ;0 - 7
1331                             C-PDL-BUFFER-POINTER C-PDL-BUFFER-POINTER-PUSH     ;10, 11
1332                             C-PDL-BUFFER-INDEX PDL-BUFFER-INDEX                ;12, 13
1333                             PDL-BUFFER-POINTER MICRO-STACK-DATA-PUSH           ;14, 15
1334                             OA-REG-LOW OA-REG-HI                               ;16, 17
1335                             VMA VMA-START-READ VMA-START-WRITE VMA-WRITE-MAP T T T T ;20 - 27
1336                             MD T MD-START-WRITE MD-WRITE-MAP T T T T))))       ;30 - 37
1337
1338(SETQ CC-A-DEST-DESC '((TYPE-FIELD A 1612 RAAMO)))
1339
1340(SETQ CC-M-SOURCE-DESC '((COND M 3701
1341                               (((TYPE-FIELD M 3206 RAMMO))
1342                                ((SELECT-FIELD FSOURCE 3205
1343                                      (READ-I-ARG MICRO-STACK-PNTR-AND-DATA     ;0, 1
1344                                       PDL-BUFFER-POINTER PDL-BUFFER-INDEX
1345                                       T C-PDL-BUFFER-INDEX
1346                                       C-OPC-BUFFER Q-R
1347                                       VMA MEMORY-MAP-DATA                      ;10, 11
1348                                       MD LOCATION-COUNTER
1349                                       MICRO-STACK-PNTR-AND-DATA-POP T
1350                                       T T
1351                                       T T                                      ;20, 21
1352                                       T T
1353                                       C-PDL-BUFFER-POINTER-POP C-PDL-BUFFER-POINTER
1354                                       T T
1355                                       T T T T T T T T)))))))                   ;30 - 37
1356
1357; :SCOPE causes the machine to execute whatever is in DEBUG-IR
1358; repeatedly at full speed.  Deposit in .IR just before doing this.
1359
1360(DEFPROP SCOPE CC-SCOPE-LOOP CC-COLON-CMD)
1361
1362(DEFUN CC-SCOPE-LOOP (ARG)
1363  (CC-NOOP-DEBUG-CLOCK) ;LOAD IR FROM DEBUG-IR JUST OUT OF SUPERSTITION
1364  (SPY-WRITE SPY-CLK 11)        ;SET RUN AND DEBUG
1365  (TERPRI)
1366  (PRINC '|--RUN--|)
1367  (TYI)                 ;WAIT FOR INPUT, EVEN IF MACHINE GETS ERROR
1368  (SPY-WRITE SPY-CLK 10)        ;CLEAR RUN, BUT LEAVE DEBUG SET
1369  (TERPRI)
1370  (SETQ CC-UPDATE-DISPLAY-FLAG T)
1371  NIL)
1372
1373; General purpose looping construct which is faster than interpreted
1374; PROG.  We also try to avoid number consing.
1375; The function to be looped may have up to 3 args, we always pass all 3
1376; knowing that the subr calling sequence doesn't care if there are too many.
1377
1378(DEFUN LOOP (FORM)
1379  (LET ((FCN (CAR FORM))
1380        (SUBR NIL)
1381        (ARG1 (EVAL (CADR FORM)))
1382        (ARG2 (EVAL (CADDR FORM)))
1383        (ARG3 (EVAL (CADDDR FORM))))
1384    (OR (SETQ SUBR (GET FCN 'SUBR))
1385        (ERROR '|not a SUBR| FCN))
1386    (COND ((= (EXAMINE (MAKNUM SUBR)) (+ 261600_18. (GETDDTSYM 'CFIX1)))
1387           (PROG NIL A (SUBRCALL FIXNUM SUBR ARG1 ARG2 ARG3) (GO A)))
1388          ((PROG NIL A (SUBRCALL T SUBR ARG1 ARG2 ARG3) (GO A))))))
1389
Note: See TracBrowser for help on using the repository browser.