%include "SysInc:Command.inc"
%include "TAPE:EBCDIC.inc"
%include "TAPE:IBMprocs.inc"
%include "TAPE:Labels.inc"
%include "TAPE: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 = 20
   %const %string(15) %array key(1:keys) =
      "INITIALISE",  "READ",        "WRITE",
      "APPEND",      "HELP",        "ANALYSE",
      "FIXED",       "VARIABLE",    "TRUNCATE",
      "NOTRUNCATE",  "SYNCH",       "NOSYNCH",
      "RECORD",      "BLOCK",       "BLOCKED",
      "UNBLOCKED",   "SPANNED",     "UNSPANNED",
      "LABEL",       "FILE"
   %switch S(1:6)                        {Initialise..analyse: subcommands}

   %own %integer {control flags} %c
      Fixed = true,                      {Fixed-length records}
      Synch char = -1,                   {Default NOSYNCH}
      Record length = 80,
      Block size = 6*80,
      Blocked = true,
      Spanned = false,                   {No spanned records}
      File no = 1

   %own %integer option = 0              {READ, WRITE, APPEND etc}
   %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 TTY = 0               {IMP command/report stream no.}
   %own %string(6) tape label = ""
   %string(63) junk, hd, tl

   %routine decode parm
      %string(63)%name p == command_parameter
      %string(63) x, val
      %integer j, k
      %switch C(0:keys)
      To upper (p)
      p = x . val %while p -> x . (" ") . val
      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): {Initialise}
         C(2): {Read}
         C(3): {Write}
         C(4): {Append}
         C(5): {Help}
         C(6): {Analyse}
               %if option # 0 %start
                  Print string (key(option)." and ".x."?")
                  Newline
                  %return
               %finish
               option = k
               %continue

         C(7): {Fixed}
               Fixed = true
               Record length = 80
               %continue
         C(8): {Variable}
               Fixed = false
               Record length = 1024
               %continue

         C(9): {Truncate}
         C(10):{NoTruncate}
               Print string (x." not implemented");  newline
               %continue

         C(11):{Synch}
               Synch char = char no(val,1)
               %continue
         C(12):{No Synch}
               Synch char = -1 {none}
               %continue

         C(13):{Record=n}
               Record length = StoI(val)
               %continue

         C(14):{Block=n}
               Block size = StoI(val)
               %continue
   
         C(15):{Blocked}
               Blocked = true
               %continue
         C(16):{Unblocked}
               Blocked = false
               %continue

         C(17):{Spanned}
               Print string ("*Spanned records not allowed")
               Newline
               %stop
         C(18):{Unspanned}
               Spanned = false
               %continue

         C(19):{LABEL=volname}
               %if length(val) > 6 %start
                  Print string ("*Label more than six characters?")
                  Newline
                  %continue
               %finish
               tape label = val
               %continue

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

      %repeat
   %end

   %routine stop
      Rewind
      Release tape
      %stop
   %end

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

   %on stream err %start                 {end of input on console stream}
      Stop
   %finish

   -> S(5) %if command_modifier = '?'
   Decode Parm %if command_parameter # ""
   Prompt ("Parm: ")
   %while option = 0 %cycle
      Read (command_parameter)
      Decode parm
   %repeat
   %while tape label = "" %and
      option # 6 {analyse} %cycle
      Prompt ("Label:")
      Read (junk)
      command_parameter = "LABEL=".junk
      Decode parm
   %repeat
   -> S(option)

S(1): {Initialise tape}
      %begin
         %record(label) V                {Volume label}
         Release tape
         Claim tape
         Rewind
         Tape mark;  backspace           {***** FRIG tape hardware *****}
         Fill (V,' ',80)
         V_vol1 = m'VOL1'
         Move string (tape label, V_serial no(1))
         V_R1(1) = '0'
         To EBCDIC (80,V)
         Write tape (addr(V),80)
         Tape mark
         Tape mark
         Rewind
         Stop
      %end

S(2): {Read tape}
      %begin
         %string(255) line
         %string(17) dataset
         %string(31) file
         %integer failed, sym, j, joins = 0

         %on stream err, MT err %start
            %if EVENT_event = MT err %start
               Select output (tty)
               Print string ("*".event_message)
               Newline
            %finish
            {TTY input ended}
            Unload MT (1)
            Release MT (1)
            %stop
         %else
            Claim MT (1,0)
            Load MT (1,0,tape label)
            Prompt ("File: ")
         %finish

         %cycle
            Select input (TTY)
            Read (file)
            To upper (file)
            %if char no(file,1) = '*' %start
               command_parameter = sub string(file,2,length(file))
               %signal stream err %if command_parameter = ""
               Decode parm
               %continue
            %finish
            %begin
               %on stream err, pack err %start     {Open output failed}
                  Print string ("*".Event_message)
                  Newline
                  Failed = true
                  %return
               %finish
               Open output (3,file)
               Failed = false
            %end
            %continue %if failed = true
            j = 0
            j = variable %unless fixed = true
            j = j + unblocked %unless blocked = true
            Open MT in (1,"",File no,record length,block size,j)
            Select output (3)
            %begin
               %integer j
               %on MT err %start         {Assume eof on tape file}
                  %return                {from BEGIN..END}
               %finish
               %cycle
                  j = record length
                  Read MT (1, j, charno(line,1))
                  length(line) = j
                  %if fixed = true %start
                     {guess where end of line is..}
                     %while line#"" %and charno(line,length(line))=' ' %cycle
                        length(line) = length(line) - 1
                     %repeat
                  %finish
                  %if line # "" %and char no(line,length(line)) = synch char %start
                     length(line) = length(line) - 1
                     Print string (line)
                     joins = joins + 1
                  %else
                     Print string (line)
                     Newline
                  %finish
               %repeat
            %end
            Close MT (1)
            Close output
            Select output (TTY)
            %if joins # 0 %start
               Write (joins,0)
               Print string (" join")
               Print symbol ('s') %if joins # 1
               Newline
            %finish
            file no = file no + 1
         %repeat
      %end

S(3): {Write tape}
S(4): {Append to tape}
      %begin
         %string(17) Dataset             {Filename recorded on tape}
         %string(31) file
         %byte %array line(1:256)
         %integer failed, sym, len, line no, j, pend = -1, splits = 0

         %on stream err %start           {Assume EOF on command stram}
            Unload MT (1)
            Release MT (1)
            %stop
         %finish

         Claim MT (1,0)
         Load MT (1,hazard,tape label)
         Prompt ("File: ")
         %cycle
            Select input (tty)
            Read (file)
            To upper (file)
            %if char no(file,1) = '*' %start     {special command}
               file = sub string(file,2,length(file))
               %signal stream err %if file = ""
               Command_parameter = file
               Decode parm
               %continue
            %finish
            %begin
               %on stream err, pack err %start   {Open input failed}
                  Print string ("*".Event_message)
                  Newline
                  Failed = true
                  %return
               %finish
               Open input (3,file)
               Failed = false
            %end
            %continue %if failed = true
            Dataset <- file              {truncate in required}
            j = 0
            j = variable %unless fixed = true
            j = j + unblocked %unless blocked = true
            file no = 999999 %if option = 4 {append?}
            Open MT out (1,dataset,file no,record length,block size,j)
            Select input (3)
            len = 0                      {Current input record length}
            line no = 0
            %while %not end of input %cycle
               Read symbol (sym)
               %if sym = NL %start
                  line no = line no + 1
                  %if len > record length %start
                     Print string ("*Warning: record")
                     Write (line no,1)
                     Print string (" truncated")
                     Newline
                  %finish
                  write MT (1,len,line(1))
                  len = 0
               %else
                  len = len + 1
                  line(len) = sym
                  %if len = record length - 1 %and synch char >= 0 %start
                     splits = splits + 1
                     len = len + 1
                     line(len) = synch char
                     Write MT (1,len,line(1))
                     len = 0
                  %finish
               %finish
            %repeat
            %if splits # 0 %start
               Write (splits,0)
               %if splits = 1 %start
                  Print string (" line was split")
               %else
                  Print string (" lines were split")
               %finish
               Newline
            %finish
            Close MT (1)
            Close input
            file no = file no + 1
         %repeat
      %end

S(5): {Help information}
      Print string ("*Use LAYOUT TAPE:TAPE.LAY")
      Newline
      %stop

S(6): {Analyse tape}
      %begin
         %byte %array B(0:8191)          {Max 8K blocks}
         %record(label) L
         %integer j, number, last

         %routine show (%integer number, size)
            %return %if number = 0
            Write (number, 3+5+17+1)
            Print string (" block")
            Print symbol ('s') %if number # 1
            Print string (" of")
            Write (size,1)
            Print string (" bytes")
            Newline
         %end

         Release tape
         Claim tape
         Rewind
         Read tape (addr(L),80);  to ISO(80,L)   {Volume label}
         %if L_Vol1 # m'VOL1' %start
            Print string ("*Not an IBM tape")
            Newline
            Stop
         %finish
         Print string ("Volume ")
         Print symbol (L_serial no(j)) %for j = 1,1,6
         Newlines (2)
         %cycle
            Read tape (addr(L),80)    {File header label}
            To ISO (80,L)
            %exit %if tape error # 0
            %if L_label1 # m'HDR1' %start
ERR:           Print string ("*Tape protocol error")
               Newline
               Stop
            %finish
            L_label1 = 17             {Fake string length for _FILE}
            Print string ("   File ".string(addr(L_label1)+3))
            Read tape (addr(L),80)
            To ISO (80,L)
            ->ERR %if tape error#0 %or L_label2#m'HDR2'
            write (StoI(string of(5,L_record len(1))),0)
            Print string (" byte ")
            %if L_format = 'F' %start
               Print string ("fixed")
            %else %if L_format = 'V'
               Print string ("variable")
            %else
               Print string ("undefined")
            %finish
            Print string (" length records, ")
            %if L_attrib = ' ' %start
               Print string (" unblocked")
            %else
               %if L_attrib # 'B' %start
                  Print string ("spanned, ")
               %finish
               %if L_attrib # 'S' %start
                  Write (StoI(string of(5,L_block len(1))),0)
                  Print string (" byte blocks")
               %finish
            %finish
            Newline
            Skip forward              {Past header labels}
            number = 0;  last = 0     {Find end of user data}
            %cycle
               Read tape (addr(B(0)),8192)
               %exit %if tape error # 0
               %if bytes transferred # last %start   {change of blocksize}
                  Show (number,last)
                  last = bytes transferred
                  number = 0
               %finish
               number = number + 1
            %repeat
            Show (number,last)
            Skip forward              {Past trailer labels}
         %repeat
         Print string ("**EOT**")
         Newline
         Stop
      %end

%end %of %program