!MOUSES file dumper utility.
%own %string(31) version = "vsn 2"
%OPTION "NOOPEN,NOSPACES,NOSTACK,UPPER"
!Alan Culloch,    August 1980.

!system calls
%const %integer disc read = 101
%const %integer to director = 20
%const %integer pack filename = 17
%const %integer find unit = 45

%begin
   %externalintegerfnspec StoI(%string(63) S)
   %externalstring(63)%fnspec ItoS(%integer N, P)
   %externalroutinespec Open Da(%integer Chan, RW, %string(63) File)
   %externalroutinespec Read Da(%integer Chan, Block, %name Buff)
   %externalroutinespec Close Da(%integer Chan)
   %const %integer non zero = 1
   %const %integer infinity = 16_7FFFFFFF
   %const %integer FF = 12;              !ASCII formfeed character
   %record %format block fm (%integer %array word(0:512//4 - 1))
   %record(block fm) block
   %record(parm fm) P
   %integer offset;                      !word index in BLOCK

   %include "Sysinc:command.Inc"

   !Events
   %const %integer DA trap = 12;         !signalled on READ DA bad block#
                                         !(used as E-O-F trap on seq. read).
   !Output display characteristics
   %integer page ht = 60,line width = 80;!defaults
   %integer j
   %for j = 1,1,length(Command_Out1) %cycle
      line width = 132 %if char no (Command_Out1,j) = ':';   !assume LP:
   %repeat
   %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 first = 0, last = infinity;  !default range of blocks to dump
   %integer physical = 0;                !0:from file; #0:direct disc reads
   %integer unit;                        !physical unit no.
   %integer squeeze = non zero;          !to suppress formfeeds
   %integer decoding = 0

   !Dump format is any comb. of hex, octal and straight ASCII
   !side-by-side on the page, with each dump line optionally
   !follwed by an ASCII decode of the words.

   %const %integer hex = 1<<1,
                 octal = 1<<2,
                 ASCII = 1<<3,
               decoded = 1<<4,
               formats = 3
   %integer wants = 0;                   !gets undecoded hex dump by default

   %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 decode parm;                 !interprets program parameter
      %string(63) s, t
      %integer j
      wants = wants ! decoded %if Command_Modifier # 0
      Command_Parameter = Command_Parameter . ","
      %while Command_Parameter -> s . (",") . Command_Parameter %cycle
         %continue %if s = ""
         %if s = "HEX" %start
            wants = wants ! hex
         %else %if s = "OCTAL"
            wants = wants ! octal
         %else %if s = "ASCII"
            wants = wants ! ASCII
         %else %if s = "PAGED"
            squeeze = 0
         %else %if s -> s . ("..") . t
            t = itos(infinity, 0) %if t = ""
            first = stoi (s);  last = stoi (t)
            %if first < 0 %or last < 0 %start
               report (s . ".." . t . "?")
               %stop
            %finish
         %else %if stoi(s) >= 0
            first = stoi(s);  last = first; !single block
         %else %if s -> s . ("=") . t
            %if s = "PAGE" %start
               page ht = stoi (t)
            %else %if s = "WIDTH"
               line width = stoi (t)
            %else %if s = "DISC"
               physical = non zero
               %if t -> ("#") . t %start;   !unit #n
                  unit = stoi (t)
               %else
                  String(addr(P_Dact)) = t . "_:";  SVC (pack filename,P)
                  P_dact = find unit;  SVC (to director,P)
                  %if P_p6 # 0 %start
                     print string (P_text)
                     newline
                     %stop
                  %finish
                  unit = P_p1
               %finish
               print string ("Dumping unit #");  write(unit,0);  newline
            %else
               report (s . "=?")
               %stop
            %finish
            report (t."?") %and %stop %if line width < 0 %or
                                             page ht < 0;   !STOI faults?
         %else
            report (s . "?")
            %stop
         %finish
      %repeat
      wants = wants ! hex %if wants & (hex!octal!ASCII) = 0;   !hex default
      N fields = 0
      %for j = 1,1,formats+4 %cycle
         N fields = N fields + 1 %if wants & 1<<j # 0
      %repeat
   %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 Command_Modifier # '?' %start;   !straight ASCII
         %for j = 1,1,4 %cycle
            spaces (sp)
            k = (word>>(3*8)) & 127;  word = word<<8
            %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 phex (%integer n)
      %integer j,k
      %for j = 7*4, -4, 0 %cycle
         k = n>>j & x'F'
         %if k >= 10 %then print symbol (k - 10 + 'A') %c
                     %else print symbol (k + '0')
      %repeat
   %end

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

   %routine print decoded (%integer n, from)
      !dump the ASCII translation of the N words
      !starting at FROM under each of the format
      !part of the last dump line
      %integer j,k
      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, 1, from + n - 1 %cycle
               %if 1<<j = hex %start
                  space
                  dump ASCII (block_word(k),1)
               %else %if 1<<j = octal
                  dump ASCII (block_word(k),2);   !4*(2+1) = 12 = octal field
               %else; !ASCII - dont do it again
                  spaces (4)
               %finish
            %repeat
         %finish
      %repeat
      decoding = 0
   %end

   %routine read block (%integer block no)
      %record(Parm fm) P
      read DA (1,block no,block) %and %return %if physical = 0
      P_p1 = block no;  P_p2 = addr(block);  P_p3 = unit;  P_p4 = 0
      SVC (disc read,P)
      %if P_p1 # 0 %start
         print string ("*cannot read block")
         write (block no,1);  print string (" from unit")
         write (unit,1);  print string (", status:")
         write (P_p1,1);  newline
         %stop
      %finish
   %end

   !Main program

   %on DA trap %start
      close DA (1)
      close output
      %stop
   %finish

   %integer len, block ht, block no
   %integer k, m, save

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

   decode parm
   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

   !Turn NWORDS down till a block will be printed
   !as an integral number of full rows

   first try = N words;                  !!!!
   %cycle
      %if N words = 0 %start
         report ("Won't fit!")
         %stop
      %finish
      %exit %if rem (512//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 = (512//4) // N words
   block ht = rows
   block ht = 2*rows %if wants & decoded # 0;  !ASCII decode under each line
   block ht = 3 {header lines} + block ht
   squeeze = non zero {ignore PAGED option} %if block ht >= page ht

   open DA (1, 0, Command_In1) %if physical = 0
   open output (1,Command_Out1)
   select output (1)
   print symbol (FF)
   break

   block no = first - 1
   %cycle
      block no = block no + 1
      %exit %if block no > last
      read block (block no); !%SIGNAL when it falls off
      %if lines + block ht >= page ht %start
         print symbol (FF) %and newline %if squeeze = 0
         lines = 0
      %finish
      break;  print string ("Block #");  write (block no,0)
      break
      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 (block_word(offset))
                  %else %if 1<<k = octal
                     space
                     poct (block_word(offset))
                  %else %if 1<<k = ASCII
                     dump ASCII (block_word(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
   %repeat

%end %of %program
