!*****************************
!*       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