!*****************************
!*       gen_dbug7          *
!*date:  15.nov.84           *
!* modified for imp77        *
!*****************************
!! stk = 300, str = 1

%INCLUDE "B_DEIMOSSPECS"


%begin

     %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)


     %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 = 19
     %ownbyteintegerarray comm(0:com lim) = %c
     'E', 'I', 'R', 'P', 'W', 'B', 'C', 'A', 'D', '?', 'N', 'O', 'T', 
     'F', 'L', 'S', '+', '-', 'H', 'V'
     %switch sw(0:com lim)
     !!
     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)
         -> loop2 %if s = nl
        readsymbol(s2)
         %if 'a' <= s <= 'z' %then s = s-'a'+'A'
        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
      pst = map psect(task, 5)
     %if pst = 0 %start
        printstring("id ?
")
        -> loop
     %finish
     p == record(pst)
      printsymbol(p_name(i)) %for i = 0, 1, 3
      newline
      release user seg
      last seg = -1
      hw regs = -1
     %for i = 0, 1, 7 %cycle
         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
     %if s2=nl %then prompt("
New Program Base?")
     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
      %for i = k'40000', k'20000', k'160000' %cycle
         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(19):                                 ! v - dump whole seg
      prompt("Seg No?") %if s2 = nl
      i = roctal
      select output(strm)
      dump(i<<13, k'20000')
      -> 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
")
        %for i = 0, 1, 7 %cycle
           %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
        %for i = 0, 1, 7 %cycle
           %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
        %for i = 1, 1, 6 %cycle
           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&7
        %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
           %if n&x'8000' # 0 %then printsymbol('1') %else printsymbol('0')
           %for i = 12, -3, 0 %cycle
              printsymbol((n >> i)&7+'0')
           %repeat
         %else;                         ! print in hex
            %for i = 12, -4, 0 %cycle
               printsymbol(char((n>>i)&15))
            %repeat
         %finish
     %end


     %routine break point
        %integer a, i, p
        %if s2 # ' ' %start
           prompt("addr?")
        %finish
        a = roctal+prog
        %for i = 1, 1, 20 %cycle
           %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
           %for i = 1, 1, 20 %cycle
              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
        %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 %until rept = 0
     %end


     %record (segf) %map map(%integer buff no)
        ! New compiler  - so must get 0
        %result == null %if buff no = 0
        *mov_1,0
        *mov_#8,1;     ! desired vm seg no *2 ie 4*2
        *iot
        %result == record(k'100000')
     %end
     %integermap cont(%integer adr)
        %owninteger dummy = 0
        %integer seg, x, i
         %if pst = 0 %and adr&k'160000'#0 %start
            x = adr&k'137777'
             -> res
         %finish
        %if tflag = 0 %start
           seg = adr >> 13 & 7
           %if adr&k'17777' >= max(seg) %then %result == dummy
           %if seg = hwregs %then %result == dummy
           %if seg # last seg %start
              release user seg
              I = map virt(task, seg, 4)
              %if i = 0 %start
                 %if map(p_seg(seg)_par) == null %start
                    last seg = -1; %result == dummy
                 %finish
              %finish
              last seg = seg
           %finish
           x = k'100000'+(adr&k'17777')
        %else
            x = adr
         %finish
res:
        %result == INTEGER(x)
     %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 I = map virt(0, -1, 4)
     %end
%endofprogram