%begin;      !tapeanal
   %include "sysinc:command.inc"
   %externalintegerfnspec ETOI(%integer s)
   %string(15) Param
   %record(parmfm) p
   %owninteger error, dumping, tm, size, number, flag
   %byteintegerarray b(0:8000)
   %integer j,s
   %routine print out
      %return %if number = 0
      write(number, 4)
      printstring(" block")
      printsymbol('s') %unless number = 1
      printstring(" of")
      write(size, 1)
      printstring(" bytes")
      newline
      number = 0;  size = 0
   %end
   %routine claim tape
      %record(parmfm) p
      p_dact = 1;  svc(105, p)
      error = p_p6
   %end
   %routine release tape
      %record(parmfm) p
      p_dact = 10;  p_p1 = 3;  svc(105, p)
      p_dact = 2;  svc(105, p)
   %end
   %integerfn function(%integer n)
      %record(parmfm) p
      p_dact = 10;  p_p1 = n;  svc(105, p)
      %result = p_p6
   %end
   %routine rewind
      error = function(3)
   %end
   %routine skip forward
      error = function(4)
   %end
   %routine clear
      error = function(1)
   %end
   %routine backspace
      error = function(6)
   %end
   %routine read(%integer n)
      p_p2 = addr(b(0))
      p_p4 = n
      p_dact = 8
      svc(105, p)
   %end
   %routine dump block(%integer size)
      %integer j, s
      %routine hex(%integer p)
         %integer j, s
         %routine xs(%integer s)
            %if s > 9 %then s = s-10+'A' %else s = s+'0'
            printsymbol(s)
         %end
         %for j = p, 1, p+15 %cycle
            space %if p&3 = 0
            s = b(j)
            s = 0 %if j > size
            xs(s>>4&15);  xs(s&15)
         %repeat
      %end
      %routine syms(%integer p)
         %integer j,s
         %for j = p, 1, p+15 %cycle
            s = b(j)
            s = ETOI(s) %if flag < 0
            s = ' ' %unless ' ' <= S <= 126
            printsymbol(s)
         %repeat
      %end
      %for j = 0, 16, 256-16 %cycle
         newline
         spaces(10)
         hex(j)
         printstring(" |")
         syms(j)
      %repeat %until j >= size-15
      newline
      flag = 0 %if command_modifier = 0
   %end
   printstring("Tapeanal V3");  newline
   param = command_parameter
   %for j = 1,1,length(param) %cycle
      s = charno(param, j)
      charno(param, j) = s+32 %if 'A' <= s <= 'Z'
   %repeat
   %if param = "" %start
      dumping = 0
   %else %if param = "ascii"
      dumping = 1
   %else %if param = "ebcdic"
      dumping = -1
   %else
      printstring("Unknown keyword ".param." ASCII assumed")
      newline
      dumping = 1
   %finish
   claim tape
   rewind
   tm = 0
   size = 0;  number = 0;  flag = dumping
   %cycle
      read(8000)
      %if p_p4 # 0 %start;      !tm
         print out
         printstring("Tape mark");  newline
         %exit %if tm # 0
         tm = 1
         flag = dumping
         %continue
      %finish
      tm = 0
      %if p_p6 # 0 %start
         printstring("Error");  write(p_p6, 0);  newline
         %exit
      %finish
      j = p_p3-1
      dump block(j) %if flag # 0
      print out %if j # size
      size = j;  number = number+1
   %repeat
   newline
   release tape
%endofprogram