! FILE 'DBUG5S'
!*****************************
!*       DBUG4S              *
!*DATE:  04.DEC.79           *
!*****************************
!! STK = 300, STR = 1
CONTROL  K'100001'

PERMROUTINESPEC  SVC(INTEGER  EP, R0, R1)
PERMINTEGERMAPSPEC  INTEGER
PERMBYTEINTEGERMAPSPEC  BYTEINTEGER
PERMINTEGERFNSPEC  ADDR
PERMINTEGERFNSPEC  ACC
SYSTEMROUTINESPEC  MAPHWR(INTEGER  SEG)


BEGIN 
     CONSTINTEGER  MAP PSECT = 16;     ! SUPERVISOR CALL TO MAP TO PSECT

     CONSTBYTEINTEGERNAME  ID = K'160030'
     CONSTINTEGER  VIR DISP=K'22';    ! DISP TO 1ST VERSION NO

      CONSTBYTEINTEGERNAME  INT = K'160060'

     ROUTINESPEC  PSECT
     ROUTINESPEC  DREG
     ROUTINESPEC  DSTACK
     ROUTINESPEC  OCTAL(INTEGER  N)
     INTEGERFNSPEC  ROCTAL
     ROUTINESPEC  DUMP(INTEGER  LOW, QUANT)
     ROUTINESPEC  REGISTERS
     ROUTINESPEC  BREAK POINT
     ROUTINESPEC  CLEAR(INTEGER  P)
     ROUTINESPEC  WAIT
     ROUTINESPEC  CORE(INTEGER  TYPE)
     INTEGERMAPSPEC  CONT(INTEGER  ADR)
     BYTEINTEGERFNSPEC  BYTECONT(INTEGER  ADR)
     ROUTINESPEC  RELEASE USER SEG


     RECORDFORMAT  SEGF(INTEGER  PAR, PDR, PT, X)
     RECORDFORMAT  PSECTF(BYTEINTEGER  X, Y, ID, STATE, BYTEINTEGERARRAY  C 
       NAME(0:3), BYTEINTEGER  PRIO, INTEGER  POFFQ, C 
      INTEGERARRAY  R(0:8),  C 
      INTEGER  TRPV, RECORD  (SEGF) ARRAY  SEG(0:7))
                     ! NB: R(0-8) ARE R0, R1, R2, R3, R4, R5, PC, PS, SP

     RECORD  (PSECTF) NAME  P

     OWNINTEGERARRAY  MAX(0:7)

     RECORDFORMAT  D1F(INTEGER  X)
     RECORDFORMAT  D2F(INTEGERNAME  N)
     RECORDFORMAT  D3F(RECORD  (PSECTF) NAME  P)
     RECORD  (D2F) NAME  D2
     RECORD  (D1F)D1
     RECORD  (D3F) NAME  D3

     INTEGER  I, J, K, TASK, STRM, PST, STACK, N
     INTEGER  PROG, ISTACK, S, IST, S2, TFLAG
      OWNINTEGER  HW REGS = -1
     OWNINTEGERARRAY  BP(1:20) = 0(20)
     OWNINTEGERARRAY  REGC(0:8)
     INTEGERARRAY  CONT BP(1:20)

     OWNINTEGER  LAST SEG =- 1;        ! LAST USER SEG ACCESSED
     OWNINTEGER  HEX FLAG = 0;          ! PRINT IN OCTAL (0) OR HEX (1)

     CONSTINTEGER  COM LIM = 18
     OWNBYTEINTEGERARRAY  COMM(0:COM LIM) = C 
     'E', 'I', 'R', 'P', 'W', 'B', 'C', 'A', 'D', '?', 'N', 'O', 'T', 
     'F', 'L', 'S', '+', '-', 'H'
     SWITCH  SW(0:COM LIM)
     !!
     D2 == D1;  D3 == D2
     TASK = ID
     STRM = 0
     PST = 0;  PROG = 0
      MAP HWR(5)
     MAX(7) = K'17777'
     !!
LOOP2:
     NEWLINES(2) IF  STRM # 0
     TFLAG = 0
     SELECT OUTPUT(0)
     PROMPT('
Debug?')
     SKIPSYMBOL IF  NEXTSYMBOL = NL
     IF  NEXTSYMBOL >= '0' AND  NEXTSYMBOL <= '7' START 
        CORE(0)
        -> LOOP2
     FINISHELSESTART 
        READSYMBOL(S);  READSYMBOL(S2)
        I = 0
        WHILE  I <= COM LIM CYCLE 
           IF  S = COMM(I) START 
              IF  I <= 3 AND  PST = 0 START 
                 PRINTSTRING('T NOT SET
')
                 -> SKP
              FINISH 
               INT = 0
              -> SW(I)
           FINISH 
           I = I+1
        REPEAT 
        PRINTSTRING('
S,A,I,R,P,W,N,O,B OR C PLEASE!
')
SKP:    SKIPSYMBOL WHILE  NEXTSYMBOL # NL AND  S2 # NL
        -> LOOP2
     FINISH 
     !!
SW(12):                                ! T - TASK NUMBER
LOOP:
     PROMPT('
Task ID?')
      ->LOOP2 IF  NEXTSYMBOL='?'
      HW REGS = -1
     TASK = ROCTAL;  SKIPSYMBOL
     SVC(MAP PSECT, TASK, 5)
     PST = ACC
     IF  PST = 0 START 
        PRINTSTRING('ID ?
')
        -> LOOP
     FINISH 
     D1_X = PST
     P == D3_P
      PRINTSYMBOL(P_NAME(I)) FOR  I = 0, 1, 3
      NEWLINE
      RELEASE USER SEG
      LAST SEG = -1
     CYCLE  I = 0, 1, 7
         HW REGS = I IF  P_SEG(I)_PAR = K'007600'; ! H/W REGS
        N = P_SEG(I)_PDR
        IF  N&7 = 0 THEN  N = 0 ELSE  C 
          N = (N+K'400') >> 2&K'177700'
        MAX(I) = N
     REPEAT 
      REGC(I) = P_R(I)  FOR  I = 0, 1, 8
     PROG = K'40000'
     IST = K'140000';                  ! HAVE TO BE BETTER LATER!!
     -> LOOP2
     !!
SW(15):                                ! STOP
     RELEASE USER SEG
     CLEAR('A')
     STOP 
     !!
SW(1):                                 ! IMP STACK
     SELECT OUTPUT(STRM)
     DSTACK;  -> LOOP2
     !!
SW(18):                                 ! HEX TOGGLE
      HEX FLAG = HEX FLAG!!1
      -> LOOP2
      !!
SW(2):                                 ! REGISTERS
     SELECT OUTPUT(STRM)
     DREG;  -> LOOP2
     !!
SW(3):                                 ! PSECT
     SELECT OUTPUT(STRM)
     PSECT;  -> LOOP2
     !!
SW(4):                                 ! WAIT
     WAIT;  -> LOOP2
SW(5):                                 ! BREAK POINT
     BREAK POINT;  -> LOOP2
     !!
SW(6):                                 ! CLEAR BREAK POINT
     CLEAR(0);  -> LOOP2
SW(9):                                 ! ?
     -> LOOP2
     !!
SW(10):                                ! N(EW) PROGRAM CODE
     PRINTSTRING('
NEW PROGRAM CODE?');  PRINTSYMBOL(0)
     PROG = ROCTAL
     -> LOOP2
     !!
SW(11):                                ! O(UTPUT) STREAM
     IF  S2 # ' ' THEN  PROMPT('STREAM?')
     STRM = ROCTAL
     -> LOOP2
     !!
SW(7):                                 ! ALL
     SELECT OUTPUT(STRM)
     PSECT
      TFLAG = 0;                      ! LOOK AT TASK VIRTUAL MEMORY
      CYCLE  I = K'40000', K'20000', K'160000'
         NEWLINES(5)
         DUMP(I, K'20000')
      REPEAT 
     -> LOOP2
     !!
SW(8):                                 ! DUMP CORE
     PROMPT('DUMP FROM?') IF  S2 = NL
     I = ROCTAL
     PROMPT('LENGTH?') IF  NEXTSYMBOL = NL
     SELECT OUTPUT(STRM)
     DUMP(I, ROCTAL)
     -> LOOP2
     !!
SW(16):                                ! '+' IMPLIED COMM
SW(17):                                ! '-' - IMPLIED COMM
     CORE(I)

SW(13):                                ! F - FILE BACK TO DISC
SW(14):                                ! L - LOAD FILE 
SW(0):                                 ! E - EXTERNALS
     -> LOOP2
     !!


     ROUTINE  PSECT
        INTEGER  I
        RECORD  (SEGF) NAME  SEG
        TFLAG = 1
        PRINTSYMBOL(P_NAME(I)) FOR  I = 0, 1, 3
        PRINTSTRING(' STATE = ');  OCTAL(P_STATE)
        PRINTSTRING('     POFFQ: ');  OCTAL(P_POFFQ)
        DREG
        RETURN  IF  INT#0
        PRINTSTRING('SEGMENTS
 NO  ADDR    LEN
')
        CYCLE  I = 0, 1, 7
           RETURN  IF  INT # 0
           IF  MAX(I) > 0 START 
              SEG == P_SEG(I)
              WRITE(I, 1);  SPACE;  OCTAL(SEG_PAR)
              SPACE;  OCTAL(MAX(I))
              SPACES(2)
              IF  SEG_PDR&7 = 2 THEN  PRINTSYMBOL('R') ELSE  C 
                PRINTSYMBOL('W')
              NEWLINE
           FINISH 
        REPEAT 
     END 


     ROUTINE  DREG
        REGISTERS
        RETURN  IF  INT#0
        PRINTSTRING('STACK=');  OCTAL(REGC(8))
        NEWLINE
     END 


     ROUTINE  DSTACK
        NEWLINES(2)
        DUMP(IST, MAX(6)-2)
     END 
     !!


     ROUTINE  REGISTERS
        OWNBYTEINTEGERARRAY  REGS(0:15) = C 
        'R', '0', 'R', '1', 'R', '2', 'R', '3', 
        'R', '4', 'R', '5', 'P', 'C', 'P', 'S'
        INTEGER  I, J
        NEWLINE
       J = 0
        CYCLE  I = 0, 1, 7
           RETURN  IF  INT # 0
           PRINTSYMBOL(REGS(J));  PRINTSYMBOL(REGS(J+1))
           PRINTSTRING(' = ')
           OCTAL(REGC(I))
           SPACES(3)
           IF  I = 3 THEN  NEWLINE
           J = J+2
        REPEAT 
        NEWLINE
     END 
     !!


     INTEGERFN  ROCTAL
        INTEGER  N, I, J, SIGN
        N = 0;  SIGN = 1
        WHILE  NEXTSYMBOL < '0' OR  NEXTSYMBOL > '7' CYCLE 
           STOPIF  NEXTSYMBOL = 'S'
           IF  NEXTSYMBOL = '-' THEN  SIGN =- 1
           SKIPSYMBOL
        REPEAT 
        CYCLE  I = 1, 1, 6
           J = NEXTSYMBOL-'0'
           IF  J < 0 OR  J > 7 THENRESULT  = N*SIGN
           N = N << 3+J
           SKIPSYMBOL
        REPEAT 
        RESULT  = N
     END 


     ROUTINE  DUMP(INTEGER  LOW, QUANT)
        INTEGER  I, J, N, N1, CHAR, NE, ZFLAG, INITF, SEGNO
        ZFLAG = 0;                     ! SET TO PRINT MESSAGE IF ALL
                                       ! ZEROES
        INITF = 0;                     ! TO SUPPRESS N<LOW
        N = LOW&X'FFF0';               ! START ON BDRY
        SEGNO = N >> 13
        IF  SEGNO = HW REGS START 
            PRINTSTRING("
Cannot Dump - Points to Hardware Registers
")
            RETURN 
        FINISH 
        WHILE  QUANT >= 0 CYCLE 
           IF  INT # 0 THEN  RETURN 
           IF  N&K'17777' >= MAX(SEGNO) THENEXIT 
           N1 = N;  NE = 8;  J = 0
           WHILE  NE # 0 CYCLE 
              J = J!CONT(N)
              N = N+2;  NE = NE-1
           REPEAT 
           IF  J = 0 START ;           ! ALL ZEROES
              IF  ZFLAG = 0 START 
                 PRINTSTRING(' ZEROES
')
                 ZFLAG = ZFLAG+1
              FINISH 
           FINISHELSESTART 
              ZFLAG = 0;  N = N1;      ! ENSURE ZFLAG IS OK
              OCTAL(N);  PRINTSYMBOL('>')
              NE = 8
              WHILE  NE # 0 CYCLE 
                 IF  N >= LOW OR  INITF # 0 THEN  OCTAL(CONT(N)) C 
                   ELSE  SPACES(6)
                 SPACE
                 N = N+2;  NE = NE-1
              REPEAT 
              PRINTSTRING('*')
              NE = 16
              WHILE  NE # 0 CYCLE 
                 CHAR = BYTECONT(N1)&127
                 IF  CHAR < 32 OR  CHAR > 126 THEN  CHAR = ' '
                 PRINTSYMBOL(CHAR)
                 N1 = N1+1;  NE = NE-1
              REPEAT 
              NEWLINE
           FINISH 
           QUANT = QUANT-16
           INITF = INITF+1
        REPEAT 
     END 


     ROUTINE  OCTAL(INTEGER  N)
        INTEGER  I
         CONSTBYTEINTEGERARRAY  CHAR(0:15) = '0', '1', '2', '3',
           '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'

        IF  HEX FLAG = 0 START 
           CYCLE  I = 15, -3, 0
              PRINTSYMBOL((N >> I)&7+'0')
           REPEAT 
         ELSE ;                         ! PRINT IN HEX
            CYCLE  I = 12, -4, 0
               PRINTSYMBOL(CHAR((N>>I)&15))
            REPEAT 
         FINISH 
     END 


     ROUTINE  BREAK POINT
        INTEGER  A, I, P
        IF  S2 # ' ' START 
           PROMPT('ADDR?')
        FINISH 
        A = ROCTAL+PROG
        CYCLE  I = 1, 1, 20
           IF  BP(I) = 0 START ;       ! FREE SLOT
              BP(I) = A
              P = CONT(A)
              CONT BP(I) = P
              CONT(A) = K'777'
              PRINTSTRING('BP: ');  OCTAL(I)
              PRINTSTRING(' ADDR=');  OCTAL(A)
              PRINTSTRING(' CONT=');  OCTAL(CONT BP(I));  NEWLINE
              RETURN 
           FINISH 
        REPEAT 
        PRINTSTRING('
BP TABLE FULL!
')
     END 
     !!


     ROUTINE  CLEAR BP(INTEGER  N)
        INTEGERNAME  P
        P == CONT(BP(N))
        P = CONT BP(N)
        BP(N) = 0
     END 
     !!


     ROUTINE  CLEAR(INTEGER  P)
        INTEGER  I, N
        IF  S2 # ' ' AND  P # 'A' START 
           PROMPT('NO?')
        FINISH 
        IF  P = 0 THEN  P = NEXTSYMBOL;  N =- 1
        IF  P # 'A' THEN  N = ROCTAL
        IF  N < 0 START 
           CYCLE  I = 1, 1, 20
              CLEAR BP(N) IF  BP(I) # 0
           REPEAT 
        FINISHELSESTART 
           IF  N <= 0 OR  N > 20 OR  BP(N) = 0 START 
              PRINTSTRING('?
')
           FINISHELSE  CLEAR BP(N)
        FINISH 
     END 
     !!


     ROUTINE  WAIT
        *K'104001';                    ! EMT WAITC
     END 
     !!


     ROUTINE  CORE(INTEGER  TYPE)
        OWNINTEGER  LAST
        INTEGER  I, J, N, S, C, STACK, REPT
        !!
        !! FORMAT :-
        !!          <OCTAL>                     : PRINTS VALUE
        !!          <OCTAL>+C                   : PRINTS VALUE
                                       ! N+CODE BASE
        !!          <OCTAL>+RN                 : PRINTS VALUE
                                       ! N+REGISTER N
        !!             DITTO  =<OCTAL>          : PLANTS OCTAL
        !!
        REPT = 1
        IF  TYPE = 0 START 
           N = ROCTAL
           READSYMBOL(S)
           IF  S = '+' START 
              READSYMBOL(C)
              IF  C = 'C' THEN  N = N+PROG ELSESTART 
                 IF  C = 'G' THEN  N = N+ISTACK+K'20' ELSESTART 
                    IF  C # 'R' START 
REJ:                   PRINTSTRING(' ?
')
                       RETURN 
                    FINISH 
                    READSYMBOL(C)
                    C = C-'0'
                    -> REJ IF  C < 0 OR  C > 5
                    N = N+REGC(C)
                 FINISH ;  FINISH 
              READSYMBOL(S)
           FINISH 
        ELSE 
           IF  TYPE = 16 THEN  N = LAST+2 ELSE  N = LAST-2
           S = S2
        FINISH 
        UNTIL  REPT = 0 CYCLE 
           LAST = N
           OCTAL(N);  PRINTSTRING(' : ')
           IF  N&1 # 0 THEN  PRINTSTRING(' ODD!') ELSESTART 
              IF  N&K'17777' >= MAX(N >> 13) THEN  PRINTSTRING( C 
                ' SEGMENT?') ELSESTART 
                 OCTAL(CONT(N))
                 IF  S = '=' START 
                    C = ROCTAL
                    CONT(N) = C
                    PRINTSTRING(' -> ');  OCTAL(C)
                 FINISH 
                 IF  S = '*' START 
                    REPT = ROCTAL;  S = 0
                 FINISH 
              FINISH 
           FINISH 
           NEWLINE
           REPT = REPT-1
           N = N+2
        REPEAT 
     END 


     INTEGERMAP  CONT(INTEGER  ADR)
        OWNINTEGER  DUMMY = 0
        INTEGER  SEG
         IF  PST = 0 AND  ADR&K'160000'#0 START 
             D1_X = ADR&K'137777'
             -> RES
         FINISH 
        IF  TFLAG = 0 START 
           SEG = ADR >> 13
           IF  ADR&K'17777' >= MAX(SEG) THEN  RESULT  == DUMMY
           IF  SEG = HWREGS THEN  RESULT  == DUMMY
           IF  SEG # LAST SEG START 
              RELEASE USER SEG
              MAP VIRT(TASK, SEG, 4)
              LAST SEG = SEG
           FINISH 
           D1_X = K'100000'+(ADR&K'17777')
        ELSE 
            D1_X = ADR
         FINISH 
RES:
        RESULT  == D2_N
     END 


     BYTEINTEGERFN  BYTECONT(INTEGER  ADR)
        INTEGER  X
        X = CONT(ADR&K'177776')
        IF  ADR&1 # 0 THEN  X = X >> 8 ELSE  X = X&X'FF'
        RESULT  = X
     END 


     ROUTINE  RELEASE USER SEG
        IF  LAST SEG #- 1 THEN  MAP VIRT(0, -1, 4)
     END 
ENDOFPROGRAM