%external %routine DUMP BLOCK (%name from, %integer bytes, line width, wants)
   %integer from addr = addr(from)

   !'WANTS' mask values:

   %const %integer hex = 1<<1,
                 octal = 1<<2,
                 ASCII = 1<<3,
               decoded = 1<<4,
                exclam = 1<<5,
                EBCDIC = 1<<6,
               formats = 3

   %external %integer %fn %spec EtoI (%integer sym)
   %external %string(63) %fn %spec ITOS (%integer I,places)
   %external %routine %spec PHEX (%integer n,width)

   %integer %fn STOI (%string(15) s)
      %byte %name b
      %integer j, n = 0
      %for j = 1,1,length(s) %cycle
         b == char no (s,j)
         %continue %if b <= ' '
         %if '0' <= b <= '9' %start
            n = 10*n + (b-'0')
         %finish %else %result = -1
      %repeat
      %result = n
   %end

   %const %integer non zero = 1
   %const %integer infinity = 16_7FFFFFFF
   %const %integer FF = 12;              !ASCII formfeed character
   %record(parm fm) P
   %integer offset;                      !word index in BLOCK

   %integer N words;                     !# of 32-bit words per dump line
   %integer firsttry;                    !!!!!!
   %integer rows;                        !# of dump lines per block
   %integer N fields;                    !# of (hex,oct,..) fields wanted
   %integer unit;                        !physical unit no.
   %integer decoding = 0
   %integer j,k

   %routine report (%string(63) message)
      print string (message);  newline
   %end

   %integer lines = 0

   %routine break;                       !keeps track of lines for formfeeds
      newline;  lines = lines + 1
   %end

   %routine dump ASCII (%integer word, sp); !SP = padding per character
      %routine do (%integer word)
         %integer j,k
         %for j = 1,1,3 %cycle
            k = rem (word,37);  word = word//37
            %if k = 0 %then space %else %start
               %if k <= 26 %start
                  print symbol (k + 'A' - 1)
               %else
                  print symbol (k - 27 + '0')
               %finish
            %finish
         %repeat
      %end
      %integer j, k
      %if decoding = 0 %or wants&1<<exclam # 0 %start;   !straight ASCII
         %for j = 1,1,4 %cycle
            spaces (sp)
            k = (word>>(3*8)) & 255;  word = word<<8
            %if wants&EBCDIC {xlate} # 0 %then k = EtoI(k) %else k = k&127
            %if k < ' ' %or k = 127 %then space %else print symbol (k)
         %repeat
      %else;                             !packed decode
         spaces (4*sp + 4 - 6)
         do (word>>16);  do(word&X'FFFF')
      %finish
   %end

   %routine poct (%integer n)
      %integer j
      print symbol (n>>j & 7 + '0') %for j = 30, -3, 0
   %end

   %routine print decoded (%integer n, offset)
      !dump the ASCII translation of the N words
      !starting at FROM under each of the formats
      %integer j,k,from
      from = from addr + offset
      decoding = non zero
      spaces (4);  print symbol ('|')
      %for j = 1,1,formats %cycle
         %if wants & 1<<j # 0 %start
            spaces (2) %if 1<<j = octal
            %for k = from, 4, from + 4*(n-1) %cycle
               %if 1<<j = hex %start
                  space
                  dump ASCII (integer(k),1)
               %else %if 1<<j = octal
                  dump ASCII (integer(k),2);   !4*(2+1) = 12 = octal field
               %else; !ASCII - dont do it again
                  spaces (4)
               %finish
            %repeat
         %finish
      %repeat
      decoding = 0
   %end

   %integer len, block ht, m, save

   bytes = bytes + 1 %while bytes&3 # 0

   !Calc no. of words per row of dumped block,
   !fitting in all required output formats for
   !each word

   N fields = 0
   %for j = 1,1,formats+4 %cycle
      N fields = N fields+1 %if wants & 1<<j # 0
   %repeat
   len = 0;  len = len + 9 %if wants & hex # 0
             len = len +12 %if wants & octal # 0
             len = len + 4 %if wants & ASCII # 0
   N words = (line width - 5 { nnn|} - N fields) // len

!  %cycle
!     %if N words = 0 %start
!        report ("Won't fit!")
!        %stop
!     %finish
!     %exit %if rem (bytes//4,N words) = 0
!     N words = N words - 1
!  %repeat

   !Now we can find the number of lines the dump
   !of a single block will occupy

   rows = (bytes>>2) // N words
   rows = rows+1 %if rows*N words < bytes>>2
   block ht = rows
   block ht = 2*rows %if wants & decoded # 0;  !ASCII decode under each line
   block ht = 3 {header lines} + block ht
   break

   offset = 0
   %for j = 1,1,rows %cycle
      write (4*offset,3) {byte offset};  print symbol ('|')
      %for k = 1,1,formats %cycle
         space %if 1<<k = ASCII %and wants&(\(ASCII!decoded)) # 0
         !(don't jam ASCII dump up against octal one)
         %if wants & 1<<k # 0 %start
            space
            save = offset
            %for m = 1,1,N words %cycle
               %if 1<<k = hex %start
                  space
                  Phex (integer(from addr+4*offset),8)
               %else %if 1<<k = octal
                  space
                  Poct (integer(from addr+4*offset))
               %else %if 1<<k = ASCII
                  Dump ASCII (integer(from addr+4*offset),0)
               %finish %else %monitor %and %stop
               offset = offset + 1
            %repeat
            offset = save
         %finish
      %repeat
      break
      print decoded (N words,offset) %and break %if wants & decoded # 0
      offset = offset + N words
   %repeat
%end

%end %of %file