!MOUSES file dumper utility.
%own %string(31) version = "(pre-release) vsn 2.1"
!%OPTION "NOopen,NOspaces,NOstack,Upper"
!Alan Culloch,    August 1980.

%include "Sysinc:Command.inc"
%externalroutinespec Open Da(%integer Chan, Mode, %string(31) File)
%externalroutinespec Read Da(%integer Chan, Block, %name To)
%externalroutinespec Close Da(%integer N)
%externalroutinespec Phex(%integer N, P)
!system calls
%const %integer disc read = 101
%const %integer to director = 20
%const %integer pack filename = 17
%const %integer find unit = 45

%begin
   %external %string(63) %fn %spec ITOS (%integer I,places)
   %integer %fn STOI (%string(15) s)
      %byte %name b
      %integer j, n = 0, Base = 10
      %for j = 1,1,length(s) %cycle
         b == char no (s,j)
         %continue %if b <= ' '
         %if '0' <= b <= '9' %start
            b = b-'0'
         %else %if 'A' <= B&95 <= 'Z'
            b = b&95-'A'+10
         %else
            %result = -1 %unless b  = '_'
            Base = n;  N = 0
            %continue
         %finish
         %result = -1 %if B >= Base
         n = Base*n + b
      %repeat
      %result = n
   %end
   %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

   %string(63) parm = Command_parameter
   %integer exclam = Command_modifier

   !Events
   %const %integer DA trap = 9;          !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 exclam # 0
      parm = parm . ","
      %while parm -> s . (",") . parm %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_sact)) = 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 exclam # '?' %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 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
   %owninteger opened = 0

   !Main program

   %on DA trap %start
      %if opened = 0 %start
         printstring("*Dump ".command_In1. " fails -- ".event_message)
         newline
      %else
         close DA (1)
      %finish
      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
   opened = 1
   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
         Phex(4*offset, 4);  printsymbol('|')
         %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), 8)
                  %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