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

Update.

File:
1 edited

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
Note: See TracChangeset for help on using the changeset viewer.