˙%include "SysInc:Command.inc"
%include "IBM:EBCDIC.inc"
%include "IBM:MTdefs.inc"

%begin
   %external %routine %spec to upper (%string(*)%name s)
   %external %predicate %spec end of input
   %external %integer %fn %spec StoI (%string(31) s)

   %const %integer true = 0,  false = 1

   %const %integer keys = 10
   %const %string(15) %array key(1:keys) =
      "ANALYSE",
      "READ",
      "WRITE",
      "WIDTH",
      "ISO",
      "LIMIT",
      "FILE",
      "BLOCK",
      "EBCDIC",
      "ISO"
   %switch S(1:3)

   %own %integer option = 0              {READ, WRITE, APPEND etc}
   %own %integer ISO tape = false        {Tape assumed EBCDIC by default}
   %own %integer width = 132             {Page width for dump output}
   %own %integer limit = 80              {Default bytes dumped/block by ANALYSE}
   %own %integer file no = 1             {Position within tape}
   %own %integer block size = 2048       {Default}
   %own %integer convert = false         {ISO:EBCDIC conversions?}
   %const %integer Stream err = 9        {IMP stream I/O error event no.}
   %const %integer Pack err = 10         {Invalid filename}
   %const %integer MT err = 13           {Error from IBM tapes package}
   %const %integer new option = 14       {DECODEPARM wants to change options}
   %const %integer TTY = 0               {IMP command/report stream no.}
   %routine %spec stop                   {Wind down tape & quit}

   %routine decode parm
      %string(63)%name p == command_parameter
      %string(63) x, val
      %integer j, k
      %switch C(0:keys)
      %if command_modifier = '?' {PTAPE?} %or p -> ("HELP") %start
         Print string ("*LAYOUT IBM:TAPES.LAY for information")
         Newline
         Stop
      %finish
      p = p . ","
      %while p -> x . (",") . p %cycle   {Peel off options}
         val = ""
         %if x -> x . ("=") . val %start; %finish
         k = 0
         %for j = 1,1,keys %cycle
            k = j %and %exit %if x = key(j)
         %repeat
         -> C(k)
         C(0): { unrecognised keyword }
˙               Print string (x)
               Print string ("=".val) %if val # ""
               Print symbol ('?');  newline
               %return

         C(1): {ANALYSE}
         C(2): {READ}
         C(3): {WRITE}
               %if option # 0 %start
                  Print string (key(option)." and ".x."?")
                  Newline
                  %signal new option
               %finish
               option = k
               %continue

         C(4): {WIDTH=characters}
               width = StoI(val)
               %continue

         C(5): {ISO}
               ISO tape = true
               %continue

         C(6): {LIMIT=n}
               limit = StoI(val)         {max no. of chars in block ANALYSE}
               %continue

         C(7): {FILE=n}
               file no = StoI(val)
               %continue

         C(8): {BLOCK=n}
               block size = StoI(val)
               %if block size < 18 %start
                  block size = 18
                  Print string ("*Block size set to 18 bytes (minimum)")
                  Newline
               %finish
               %continue

         C(9): {EBCDIC}
               convert = true
               %continue

         C(10):{ISO}
               convert = false
               %continue

      %repeat
   %end

   %routine get tape
      %cycle
         Claim tape
         %exit %if tape error = 0
         Release tape
         Print string ("*Warning: tape force-released")
         Newline
      %repeat
      Rewind
   %end

   %routine stop
      Rewind
      Release tape
      %stop
   %end

   %routine find (%integer f)
      {F is a file number.  FILE NO (global) is the file no. we
      {are currently at within the tape (one at beginning of tape).
      {Physical files are separated by tape marks. 
      %byte %array junk(1:20)
      %if f <= 1 %start
         Rewind
         file no = 1
         %return
      %finish
      %while file no < f %cycle
         skip forward
         file no = file no + 1
      %repeat
      %while fil˙e no > f %cycle
         skip reverse                    {back past last TM}
         skip reverse                    {back over prev file}
         read tape (addr(junk(1)),20)    {move over TM at start of file}
         file no = file no - 1
      %repeat
   %end

   {********* Main Program *********}

   %on %event MT err, stream err, new option %start
      %if event_event = stream err %start
         Stop
      %finish
      %if event_event = MT err %start
         Print string ("**Magtape error ")
         Write (tape error,1)
         stop
      %finish
      -> S(option)
   %finish

   Prompt ("Parm: ")
   Decode parm %if command_parameter # ""
   %while option = 0 %cycle
      Read (command_parameter)
      To upper (command_parameter)
      Decode parm
   %repeat
   -> S(option)

S(1): {*********** ANALYSE ***********}

      %begin
         %external %routine %spec TEMP LIBRARY (%string(31) filename)
         %external %routine %spec DUMP BLOCK   %c
            (%name from, %integer bytes, page width, flags)
         %const %integer {FLAGS masks} %c
            Hex = 1<<1, ASCII = 1<<3, EBCDIC = 1<<6
         %const %integer max block = 8000
         %byte %array B(1:max block)
         %integer after TM = true        {Frig to force dump of block #1}
         %integer number, size           {Count up groups of blocks}
         %integer j, flags

         %routine show (%integer number, size)
            %if number # 0 %start
               Write (number,4)
               Print string (" block")
               Print symbol ('s') %unless number = 1
               Print string (" of")
               Write (size,1)
               Print string (" bytes")
               Newline
            %finish
         %end

         Temp library ("IBM:DUMPER")
         Get tape
         number = 0;  size = 0
         %cycle
            Read tape (addr(B(1)),max block)
            %if bytes transferred # size %start   {New group}
               Show (number, size)
               size = bytes transferred
               n˙umber = 0
            %finish
            number = number + 1
            %signal MT err %if tape error&(~128) # 0   {mask out TM flag}
            %if TM # 0 %start
               number = 0                {suppress SHOW for tapemarks}
               Print string ("Tape mark")
               Newline
               %exit %if after TM = true {two consecutive tapemarks?}
               after TM = true
            %else
               %if after TM = true %or command_modifier = '!' %start
                  j = bytes transferred
                  j = limit %if j > limit
                  flags = hex+ASCII
                  flags = flags+EBCDIC %if convert = true
                  Dump block (B(1), j, width, flags)
               %finish
               after TM = false
            %finish
         %repeat
         Show (number,size)
         Stop
      %end

S(2): {************* READ *************}

      %begin
         %const %integer max block = 8000
         %byte %array B(1:max block)
         %integer failed, j
         %string(31) file
         Get tape
         Prompt ("File: ")
         %cycle
            Read (file)
            To upper (file)
            %if char no(file,1) = '*' %start
               file = sub string(file,2,length(file))
               Stop %if file = ""
               command_parameter = file
               Decode parm
               %continue
            %finish
            %begin
               %on * %start
                  Print string ("*".event_message)
                  Newline
                  failed = true
                  %return
               %finish
               Open output (3,file)
               failed = false
            %end
            Find (file no)
            Select output (3)
            %cycle
               Read tape (addr(B(1)), max block)
               To ISO (bytes transferred,B(1)) %if convert = true
               %exit %if TM # 0
               Print symbol (B(j)) %for j = 1,1,bytes transferred
            %repeat
            Close output
            fi˙le no = file no + 1
         %repeat
      %end

S(3): {************** WRITE ***************}

      %begin
         %const %integer max block = 8000
         %byte %array B(1:max block)
         %integer len, j
         %string(31) file
         %integer {Bool} failed = false
         %integer eof
         Get tape
         %cycle
            Prompt ("File: ")
            Select input (tty)
            Read (file)
            To upper (file)
            %if char no(file,1) = '*' %start
               file = sub string(file,2,length(file))
               %exit %if file = ""
               Decode parm
               %continue
            %finish
            Find (file no)
            Tape mark;  backspace        {For grotty tape hardware}
            %begin
               %on * %start
                  Print string ("*".event_message)
                  Newline
                  failed = true
                  %return
               %finish
               Open input (3,file)
               failed = false
            %end
            %continue %if failed = true
            Prompt ("Text: ")
            Select input (3)
            %cycle
               B(j) = 0 %for j = 1,1,18  {Min tape block is 18: padded with 0's}
               eof = false
               %begin                    {Read up to one tape block from file}
                  %integer j
                  %on stream err %start {end of file?}
                     eof = true
                     %return
                  %finish
                  %for j = 1,1,block size %cycle
                     Read symbol (B(j))
                     len = j
                  %repeat
               %end
               len = 18 %if len < 18
               To EBCDIC (len,B(1)) %if convert = true
               Write tape (addr(B(1)),len)
            %repeat %until eof = true
            Tape mark;  tape mark        {**eot**}
            Backspace                    {next file overwrites last mark}
            file no = file no + 1
         %repeat
      %end

%end %of %program