source: trunk/lisp/lcadr/nldbg.lisp @ 204

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

Update.

File size: 11.3 KB
Line 
1;;; Routines for hacking the pseudo-debugger          -*-LISP-*-
2
3;;; The following are the active locations:
4;;; 766100  Reads or writes the debuggee-Unibus location addressed by the registers below.
5;;; 766114  (Write only) Contains bits 1-16 of the debuggee-Unibus address
6;;;         to be accessed.  Bit 0 of the address is always zero.
7;;; 766110  (Write only) Contains additional modifier bits, as follows.
8;;;         These bits are reset to zero when the debuggee's Unibus is reset.
9;;;         1  Bit 17 of the debuggee-Unibus address.
10;;;         2  Resets the debuggee's Unibus and bus interface.  Write a 1 here then write a 0.
11;;;         4  Timeout inhibit.  This turns off the NXM timeout for all Xbus and Unibus cycles
12;;;            done by the debuggee's bus interface (not just those by the debugger).
13;;; 766104  (Read only) These contain the status for bus cycles executed on the debuggee's
14;;;         busses.  These bits are cleared by writing into location 766044 (Error Status)
15;;;         on the debuggee's Unibus.  They are not cleared by power up.
16;;;         1  Xbus NXM Error.  Set when an Xbus cycle times out for lack of response.
17;;;         2  Xbus Parity Error.  Set when an Xbus read receives a word with bad parity,
18;;;            and the Xbus ignore-parity line was not asserted.  Parity Error is also set
19;;;            by Xbus NXM Error.
20;;;         4  CADR Address Parity Error.  Set when an address received from the processor
21;;;            has bad parity.
22;;;        10  Unibus NXM Error.  Set when a Unibus cycle times out for lack of response.
23;;;        20  CADR Parity Error.  Set when data received from the processor has bad parity.
24;;;        40  Unibus Map Error.  Set when an attempt to perform an Xbus cycle through the
25;;;            Unibus map is refused because the map specifies invalid or write-protected.
26;;;        The remaining bits are random (not necessarily zero).
27
28(DECLARE (SPECIAL DBG-NXM-INHIBIT DBG-ACCESS-PATH DBG-DL11-HIGH-BIT DBG-HOST
29                  DBG-CHAOS-STRING DBG-CHAOS-16 DBG-UNIQUE-ID))
30(SETQ DBG-NXM-INHIBIT NIL
31      DBG-ACCESS-PATH 'BUSINT                   ;Possible values: BUSINT, DL11, CHAOS
32      DBG-DL11-HIGH-BIT -1
33      DBG-HOST NIL
34      DBG-CHAOS-STRING (MAKE-ARRAY NIL 'ART-STRING
35                                   (* 2 CHAOS:MAX-DATA-WORDS-PER-PKT) NIL '(2))
36      DBG-CHAOS-16 (MAKE-ARRAY NIL 'ART-16B  CHAOS:MAX-DATA-WORDS-PER-PKT DBG-CHAOS-STRING)
37      DBG-UNIQUE-ID NIL)
38
39;;; Reset the state of the internal variables
40(DEFUN DBG-CC-RESET ()
41  (SETQ DBG-DL11-HIGH-BIT -1
42        DBG-UNIQUE-ID NIL))
43
44;;; Read a location on the debuggee's Unibus
45(DEFUN DBG-READ (ADR &OPTIONAL (CHAOS-DBG-TYPE 'DATA))
46  (SELECTQ DBG-ACCESS-PATH
47    (DL11
48      (DBG-UPDATE-HIGH-BIT ADR)
49      (FORMAT 'DL11-STREAM "~O" (LSH ADR -1))
50      (READ 'DL11-STREAM))
51    (BUSINT
52      (%UNIBUS-WRITE 766110 (+ (LSH ADR -17.) (COND (DBG-NXM-INHIBIT 4) (T 0))))
53      (%UNIBUS-WRITE 766114 (LSH ADR -1))
54      (%UNIBUS-READ 766100))
55    (CHAOS
56      (LET ((PKT (DBG-CHAOS CHAOS-DBG-TYPE ADR)))
57        (PROG1 (AREF PKT CHAOS:FIRST-DATA-WORD-IN-PKT)
58               (CHAOS:RETURN-PKT PKT))))
59    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH))))
60
61;;; Write a location on the debuggee's Unibus
62(DEFUN DBG-WRITE (ADR VAL &OPTIONAL (CHAOS-DBG-TYPE 'DATA))
63  (SELECTQ DBG-ACCESS-PATH
64    (DL11
65      (DBG-UPDATE-HIGH-BIT ADR)
66      (FORMAT 'DL11-STREAM "~O:~O:" (LSH ADR -1) VAL))
67    (BUSINT
68      (%UNIBUS-WRITE 766110 (+ (LSH ADR -17.) (COND (DBG-NXM-INHIBIT 4) (T 0))))
69      (%UNIBUS-WRITE 766114 (LSH ADR -1))
70      (%UNIBUS-WRITE 766100 (LOGAND VAL 177777)))
71    (CHAOS
72     (DBG-CHAOS CHAOS-DBG-TYPE ADR VAL))
73    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))   
74  T)
75
76;;; Reset the debuggee's Unibus
77(DEFUN DBG-RESET ()
78  (SETQ CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
79  (SELECTQ DBG-ACCESS-PATH
80    (DL11
81      (FORMAT 'DL11-STREAM "2S")
82      (FORMAT 'DL11-STREAM "~OS" (+ (ABS DBG-DL11-HIGH-BIT)
83                                    (COND (DBG-NXM-INHIBIT 4) (T 0)))))
84    (BUSINT (%UNIBUS-WRITE 766110 2)
85            (%UNIBUS-WRITE 766110 (COND (DBG-NXM-INHIBIT 4) (T 0))))
86    (CHAOS
87     (DBG-CHAOS 'RESET 0 0))
88    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))
89  T)
90
91;;; Print the error status bits
92(DEFUN DBG-PRINT-STATUS ()
93   (CC-PRINT-SET-BITS (SELECTQ DBG-ACCESS-PATH
94                        (DL11 (USER:DL11-TYO #/R)
95                              (READ 'DL11-STREAM))
96                        (BUSINT (%UNIBUS-READ 766104))
97                        (CHAOS (LET ((PKT (DBG-CHAOS 'STATUS 0)))
98                                 (PROG1 (AREF PKT CHAOS:FIRST-DATA-WORD-IN-PKT)
99                                        (CHAOS:RETURN-PKT PKT))))
100                        (OTHERWISE
101                          (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))
102                      '(XBUS-NXM-ERR XBUS-PARITY-ERR CADR-ADDRESS-PARITY-ERR
103                        UNIBUS-NXM-ERR CADR-DATA-PARITY-ERR UNIBUS-MAP-ERR
104                        NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)))
105
106;;; Reset the error status
107(DEFUN DBG-RESET-STATUS ()
108  (SELECTQ DBG-ACCESS-PATH
109    (DL11)
110    (BUSINT (DBG-WRITE 766044 0))
111    (CHAOS (DBG-CHAOS 'STATUS 0 0))))
112
113;;; Setup the high bit of the DL11 debugger correctly
114(DEFUN DBG-UPDATE-HIGH-BIT (ADR &AUX (HIGH (LDB 2101 ADR)))
115  (OR (= HIGH DBG-DL11-HIGH-BIT)
116      (FORMAT 'DL11-STREAM "~OS" (+ (SETQ DBG-DL11-HIGH-BIT HIGH)
117                                    (COND (DBG-NXM-INHIBIT 4) (T 0))))))
118
119;;; Dummy stream for DL11 I/O
120(DEFUN DL11-STREAM (OP &OPTIONAL ARG1)
121  (SELECTQ OP
122    (:WHICH-OPERATIONS '(TYI TYO))
123    (:STRING-OUT (DOTIMES (I (STRING-LENGTH ARG1))
124                   (USER:DL11-TYO (CHARACTER-ODD-PARITY (AREF ARG1 I)))))
125    (:TYI (DO ((CHAR (USER:DL11-GET-CHAR) (USER:DL11-GET-CHAR)))
126              (NIL)
127;           (OR (ODDP (CHARACTER-PARITY CHAR))
128;               (FERROR NIL "BAD PARITY RECEIVED - ~O" CHAR))
129            (SELECTQ (SETQ CHAR (LOGAND CHAR 177))
130              (7 (FERROR NIL "ERRORNEOUS COMMAND RECEIVED BY DEBUGGER"))
131              (10 (USER:DL11-TYO 33)
132                  (FERROR NIL "DEBUGGER GOT PARITY ERROR, RESETTING DEBUGGER"))
133              (15)
134              (T (RETURN CHAR)))))
135    (:TYO (USER:DL11-TYO (CHARACTER-ODD-PARITY ARG1)))))
136
137(DEFUN CHARACTER-PARITY (CHAR &AUX (PARITY 0))
138  (DOTIMES (I 8.)
139    (SETQ PARITY (LOGXOR CHAR PARITY))
140    (SETQ CHAR (LSH CHAR -1)))
141  (LOGAND PARITY 1))
142
143(DEFUN CHARACTER-ODD-PARITY (CHAR)
144  (DPB (LOGXOR 1 (CHARACTER-PARITY (LOGAND CHAR 177))) 0701 CHAR))
145
146;;; DBG-CHAOS: Take a debug cycle over the Chaos net
147;;; First arg is type of cycle (DATA, STATUS, RESET, ANALOG, INTERNAL-8748,EXTERNAL-8748)
148;;;  second is address, third is value
149(DEFUN DBG-CHAOS (TYPE ADR &OPTIONAL DATA
150                  &AUX PKT (TIMEOUT (COND (DBG-NXM-INHIBIT 4) (T 0))))
151  (SETQ TIMEOUT (LOGIOR TIMEOUT (LDB 2101 ADR)))
152  (COND ((NULL DBG-HOST)
153         (FORMAT QUERY-IO "~&Chaos host to debug? ")
154         (SETQ DBG-HOST (CHAOS:ADDRESS-PARSE (READLINE QUERY-IO)))))
155  (COND ((= (ARRAY-LEADER DBG-CHAOS-STRING 0) 2)
156         (COND ((OR (NULL DBG-UNIQUE-ID) (> DBG-UNIQUE-ID 370))
157                (ASET #/$ DBG-CHAOS-STRING 0)
158                (ASET #\SPACE DBG-CHAOS-STRING 1)
159                (ASET 1_8. DBG-CHAOS-16 1)              ;0 Unique ID, Reset
160                (STORE-ARRAY-LEADER 4 DBG-CHAOS-STRING 0)
161                (CHAOS:RETURN-PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
162                (STORE-ARRAY-LEADER 2 DBG-CHAOS-STRING 0)
163                (SETQ DBG-UNIQUE-ID 0)))
164         (SETQ DBG-UNIQUE-ID (1+ DBG-UNIQUE-ID))
165         (ASET (+ 1_8. DBG-UNIQUE-ID) DBG-CHAOS-16 1)
166         (ASET #/$ DBG-CHAOS-STRING 0)
167         (ASET #\SPACE DBG-CHAOS-STRING 1)
168         (STORE-ARRAY-LEADER 4 DBG-CHAOS-STRING 0)))
169  (SELECTQ TYPE
170    (RESET (SETQ TIMEOUT (LOGIOR TIMEOUT DATA))
171           (SETQ TYPE 120))
172    (DATA (SETQ TYPE (IF DATA 200 000)))
173    (ANALOG (SETQ TYPE 040)                     ; ADR specifies which channel
174            (SETQ ADR (LOGIOR 400 (LSH ADR 1))))
175    (STATUS (SETQ TYPE (IF DATA 240 040)
176                  ADR 2))
177    (DEBUGGER-HIBERNATE (SETQ TYPE 040)
178                        (SETQ ADR 200))
179    (INTERNAL-8748 (SETQ TYPE (IF DATA 300 100))  ; DATA specifies address
180                   (SETQ ADR (LSH ADR 1)))
181    (EXTERNAL-8748 (SETQ TYPE (IF DATA 340 140))
182                   (SETQ ADR (LSH ADR 1)))
183    (OTHERWISE (FERROR NIL "Unknown request type ~S" TYPE)))
184  (LET ((WORD (AREF DBG-CHAOS-16 1))
185        (PTR))
186    (SETQ PTR (1- (LSH WORD -8.)))
187    (ASET (+ (LSH TYPE 8.) TIMEOUT) DBG-CHAOS-16 (+ 2 (* PTR 3)))
188    (ASET (LSH ADR -1) DBG-CHAOS-16 (+ 3 (* PTR 3)))
189    (AND DATA (ASET (LOGAND DATA 177777) DBG-CHAOS-16 (+ 4 (* PTR 3))))
190    (ASET (DPB (SETQ PTR (+ PTR 2)) 1010 WORD) DBG-CHAOS-16 1)
191    (COND ((OR (> (+ PTR 3) (// CHAOS:MAX-DATA-WORDS-PER-PKT 3))
192               (NOT (BIT-TEST TYPE 200)))
193           ;; Conservative, or a read
194           (STORE-ARRAY-LEADER (+ 4 (* (1- PTR) 6)) DBG-CHAOS-STRING 0)
195           (SETQ PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
196           (AND (BIT-TEST TYPE 200) (CHAOS:RETURN-PKT PKT))
197           (STORE-ARRAY-LEADER 2 DBG-CHAOS-STRING 0)
198           PKT))))
199
200(DEFUN DBG-CHAOS-WRITE-FROB ()
201  (ASET 340_8. DBG-CHAOS-16 2)
202  (ASET 060 DBG-CHAOS-16 3)
203  (ASET 525252 DBG-CHAOS-16 4)
204  (DO () (())
205    (ERRSET
206      (PROGN
207        (SETQ DBG-UNIQUE-ID (1+ DBG-UNIQUE-ID))
208        (ASET (+ 2_8 DBG-UNIQUE-ID) DBG-CHAOS-16 1)
209        (CHAOS:RETURN-PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING)))
210      NIL)))
211
212(DEFUN DBG-ANALOG ()
213   (DOLIST (X '(0 1 2 3 4 5 6 7))
214     (DBG-WRITE (LOGIOR 20 X) 0 'EXTERNAL-8748)
215     (DBG-WRITE 30 -1 'EXTERNAL-8748)
216     (PRINT (LDB 0010 (DBG-READ 40 'EXTERNAL-8748)))))
217
218;;; Higher-level operations
219
220;;; The Unibus map is 16 words at 766140.  It consists of 14 address bits, write-ok, and valid
221;;; It controls locations 140000-177777 (2000 byte locations per page).
222(DEFUN DBG-READ-UNIBUS-MAP (LOC)
223  (DBG-READ (+ 766140 (* 2 LOC))))
224
225(DEFUN DBG-WRITE-UNIBUS-MAP (LOC VAL)
226  (SETQ CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)        ;Caprine necrophilia
227  (DBG-WRITE (+ 766140 (* 2 LOC)) VAL))
228
229;; Returns unibus location mapped into specified xbus location
230(DEFUN DBG-SETUP-UNIBUS-MAP (LOC XBUS-LOC)
231  (DBG-WRITE-UNIBUS-MAP LOC (+ 140000 (LDB 1016 XBUS-LOC)))
232  (+ 140000 (* LOC 2000) (* 4 (LOGAND 377 XBUS-LOC))))
233
234(DEFUN DBG-PRINT-UNIBUS-MAP ()
235  (DO ((LOC 0 (1+ LOC))
236       (CONTENTS))
237      ((= LOC 20))
238    (SETQ CONTENTS (DBG-READ-UNIBUS-MAP LOC))
239    (PRINT LOC)
240    (PRIN1-THEN-SPACE (COND ((ZEROP (LDB 1701 CONTENTS)) 'NOT-VALID) (T 'VALID)))
241    (PRIN1-THEN-SPACE (COND ((ZEROP (LDB 1601 CONTENTS)) 'READ-ONLY) (T 'WRITE-OK)))
242    (PRIN1 (ASH (LOGAND 37777 CONTENTS) 8))))
243
244;;; Routines to read and write the Xbus using Unibus map location 17
245
246(DEFVAR DBG-UNIBUS-MAP-NUMBER 17)       ;This can be changed by diagnostics
247
248(DEFUN DBG-READ-XBUS (XBUS-LOC)
249  (LET ((UBUS-LOC (DBG-SETUP-UNIBUS-MAP DBG-UNIBUS-MAP-NUMBER XBUS-LOC))
250        (RES NIL))
251    (SETQ RES (DBG-READ UBUS-LOC))
252    (LOGDPB (DBG-READ (+ UBUS-LOC 2)) 2020 RES)))
253
254(DEFUN DBG-WRITE-XBUS (XBUS-LOC VAL)
255  (LET ((UBUS-LOC (DBG-SETUP-UNIBUS-MAP DBG-UNIBUS-MAP-NUMBER XBUS-LOC)))
256    (DBG-WRITE UBUS-LOC (LOGLDB 0020 VAL))
257    (DBG-WRITE (+ UBUS-LOC 2) (LDB 2020 VAL))))
258
259;;; Accessing the interrupt-control and so forth registers
260;;; 766040  Interrupt control
261;;;             1  Disable Interrupt Grant
262;;;             2  Local Enable (read only)
263;;;          1774  Interrupt Vector of last interrupt
264;;;          2000  Enable Unibus Interrupts
265;;;          4000  Interrupt Stops Grants
266;;;         30000  Interrupt level (0,4,5,6)
267;;;         40000  Xbus interrupt (read only)
268;;;        100000  Unibus Interrupt
269;;;                Only bits masked by 36001 can be written at this address.
270;;; 766042  Interrupt control 2 (write only)
271;;;                Writes bits masked by 101774 of the above register.
272;;; 766044  Error register (writing clears)  (see 764542 above)
273
274(DEFUN DBG-PRINT-INTERRUPT-STATUS ()
275  ((LAMBDA (INTC)
276      (TERPRI)
277      (CC-PRINT-SET-BITS INTC
278                         '( DISABLE-INT-GRANT LOCAL-ENABLE NIL NIL NIL NIL NIL NIL NIL NIL
279                            ENABLE-UNIBUS-INT INT-STOPS-GRANTS NIL NIL XBUS-INT UNIBUS-INT ))
280      (PRINC '| LEVEL=|)
281      (PRIN1 (LOGLDB 1402 INTC))
282      (PRINC '| VECTOR=|)
283      (PRIN1 (LOGAND 1774 INTC)))
284   (DBG-READ 766040)))
Note: See TracBrowser for help on using the repository browser.