Show
Ignore:
Timestamp:
08/18/11 04:36:51 (3 years ago)
Author:
rjs
Message:

Update.

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lcadr/nldbg.lisp

    r203 r204  
    3232      DBG-DL11-HIGH-BIT -1 
    3333      DBG-HOST NIL 
    34       DBG-CHAOS-STRING (STRING-APPEND "$ UISCAADD") 
    35       DBG-CHAOS-16 (MAKE-ARRAY NIL 'ART-16B 5 DBG-CHAOS-STRING) 
     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) 
    3637      DBG-UNIQUE-ID NIL) 
    3738 
     
    4243 
    4344;;; Read a location on the debuggee's Unibus 
    44 (DEFUN DBG-READ (ADR) 
     45(DEFUN DBG-READ (ADR &OPTIONAL (CHAOS-DBG-TYPE 'DATA)) 
    4546  (SELECTQ DBG-ACCESS-PATH 
    4647    (DL11 
     
    5354      (%UNIBUS-READ 766100)) 
    5455    (CHAOS 
    55       (LET ((PKT (DBG-CHAOS 'DATA ADR))) 
     56      (LET ((PKT (DBG-CHAOS CHAOS-DBG-TYPE ADR))) 
    5657        (PROG1 (AREF PKT CHAOS:FIRST-DATA-WORD-IN-PKT) 
    5758               (CHAOS:RETURN-PKT PKT)))) 
    5859    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))) 
    5960 
    60  
    6161;;; Write a location on the debuggee's Unibus 
    62 (DEFUN DBG-WRITE (ADR VAL) 
     62(DEFUN DBG-WRITE (ADR VAL &OPTIONAL (CHAOS-DBG-TYPE 'DATA)) 
    6363  (SELECTQ DBG-ACCESS-PATH 
    6464    (DL11 
     
    7070      (%UNIBUS-WRITE 766100 (LOGAND VAL 177777))) 
    7171    (CHAOS 
    72       (CHAOS:RETURN-PKT (DBG-CHAOS 'DATA ADR VAL))) 
     72     (DBG-CHAOS CHAOS-DBG-TYPE ADR VAL)) 
    7373    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))     
    7474  T) 
     
    8585            (%UNIBUS-WRITE 766110 (COND (DBG-NXM-INHIBIT 4) (T 0)))) 
    8686    (CHAOS 
    87       (CHAOS:RETURN-PKT (DBG-CHAOS 'RESET 0 0))) 
     87     (DBG-CHAOS 'RESET 0 0)) 
    8888    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH))) 
    8989  T) 
     
    144144  (DPB (LOGXOR 1 (CHARACTER-PARITY (LOGAND CHAR 177))) 0701 CHAR)) 
    145145 
    146 ;;; DBG-CHAOS: Take a unibus cycle over the Chaos net 
    147 ;;; First arg is type of cycle (DATA, STATUS, RESET), second is address, third is value 
     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 
    148149(DEFUN DBG-CHAOS (TYPE ADR &OPTIONAL DATA 
    149150                  &AUX PKT (TIMEOUT (COND (DBG-NXM-INHIBIT 4) (T 0)))) 
     
    152153         (FORMAT QUERY-IO "~&Chaos host to debug? ") 
    153154         (SETQ DBG-HOST (CHAOS:ADDRESS-PARSE (READLINE QUERY-IO))))) 
    154   (COND ((OR (NULL DBG-UNIQUE-ID) (> DBG-UNIQUE-ID 370)) 
    155          (ASET 2_8. DBG-CHAOS-16 1)             ;0 Unique ID, Reset 
    156          (CHAOS:RETURN-PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING)) 
    157          (SETQ DBG-UNIQUE-ID 0))) 
    158   (SETQ DBG-UNIQUE-ID (1+ DBG-UNIQUE-ID)) 
    159   (ASET (+ 2_8. DBG-UNIQUE-ID) DBG-CHAOS-16 1) 
     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))) 
    160169  (SELECTQ TYPE 
    161170    (RESET (SETQ TIMEOUT (LOGIOR TIMEOUT DATA)) 
    162171           (SETQ TYPE 120)) 
    163172    (DATA (SETQ TYPE (IF DATA 200 000))) 
     173    (ANALOG (SETQ TYPE 040)                     ; ADR specifies which channel 
     174            (SETQ ADR (LOGIOR 400 (LSH ADR 1)))) 
    164175    (STATUS (SETQ TYPE (IF DATA 240 040) 
    165176                  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))) 
    166183    (OTHERWISE (FERROR NIL "Unknown request type ~S" TYPE))) 
    167   (ASET (+ (LSH TIMEOUT 8.) TYPE) DBG-CHAOS-16 2) 
    168   (ASET (LSH ADR -1) DBG-CHAOS-16 3) 
    169   (AND DATA (ASET (LOGAND DATA 177777) DBG-CHAOS-16 4)) 
    170   (SETQ PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING)) 
    171   (AND (STRINGP PKT) 
    172        (FERROR NIL "~S" PKT)) 
    173   PKT) 
     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)))) 
    174199 
    175200(DEFUN DBG-CHAOS-WRITE-FROB () 
    176   (ASET 340 DBG-CHAOS-16 2) 
     201  (ASET 340_8. DBG-CHAOS-16 2) 
    177202  (ASET 060 DBG-CHAOS-16 3) 
    178   (ASET -1 DBG-CHAOS-16 4) 
     203  (ASET 525252 DBG-CHAOS-16 4) 
    179204  (DO () (()) 
    180205    (ERRSET 
     
    185210      NIL))) 
    186211 
     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))))) 
    187217 
    188218;;; Higher-level operations