(*$R-*)
program UnixTPInput ( TTY );
  
const Issuc = 1;
      Ieeof = 246;
      Ieeov = 245;
      BuffMax = 1024;
      MTlun = 7;
  
type Buffer = packed array [0..1023] of CHAR;
     FileString = packed array [0..12] of CHAR;
     TapeStatus = record Count,DSW:Integer end;
     Entry = record
       Path:packed array [0..31] of Char;
       Mode:Integer;
       UG  :Integer;
       HSize:Integer;
       LSize:Integer;
       Time:packed array [0..3] of Char;
       Taddr:Integer;
       Unused:packed array [0..17] of Char
     end;
     Direct = array [0..7] of Entry;
  
var Buff:Buffer;  Result:TapeStatus;
    Fubar:file of char;
    Block:Integer;
    FileName:FileString;
    I,IDX,INDEX:Integer;
    Directory:Direct;
    DirCount:Integer;
    CH:Char;
    Address,TSize,Size:Integer;
    Continue:Boolean;
  
procedure MTinit( Lun,MTlun,Charac:Integer; var Statis:TapeStatus );Extern;
procedure MTrewd( Lun:Integer; var Statis:TapeStatus );Extern;
procedure MTunld( Lun:Integer; var Statis:TapeStatus );Extern;
procedure MTctrf( Lun,MaxRec:Integer; var Statis:TapeStatus );Extern;
procedure MTread( Lun:Integer; var Buf:Buffer; MaxBC:Integer;
                  var Statis:TapeStatus );Extern;
procedure MTrdir( Lun:Integer; var Dir:Direct; MaxBC:Integer;
                  var Statis:TapeStatus );Extern;
  
procedure Initialize;
  
begin
  MTinit( MTlun, 1, 0, Result );
  if Result.DSW <> Issuc then begin
    Writeln( TTY, 'Error accessing tape unit.'); Break;
    Continue := False
    end
  else Continue := True;
  if Continue then begin
    MTrewd( MTlun, Result );
    MTctrf( MTlun, 1, Result ); (* First TP block is boot image. *)
    MTrdir( MTlun, Directory, BuffMax, Result ); (* Read first directory *)
    Block := 2;  (* Current block number. *)
    DirCount := 2  (* Next directory number. *)
  end
end; (* Initialize *)
  
procedure ReadUnixTape;
  
begin
  MTctrf( MTlun, Address-Block, Result );
  Block := Address;
  while Size>0 do begin
    MTread( MTlun, Buff, BuffMax, Result );
    INDEX:=Result.Count-1
    if INDEX>Size then INDEX:=Size-1;
    for I:=0 to INDEX do if Buff[I]=chr(10) then Writeln(Fubar)
                                            else Write(Fubar,Buff[I]);
    Block := SUCC(Block);
    if TSize>0 then TSize := TSize-2
               else Size := Size - 512
  end;
  Writeln(Fubar)
end;
  
begin
  Initialize;
  if Result.DSW <> Issuc then Continue := False;
  while Continue do begin
    IDX := 0;
    while Continue and (IDX<8) do begin
      Write( TTY, Directory[IDX].Path , ' process?' ); Break;
      Readln(TTY);
      Read(TTY,CH);
      if (CH='Y') or (CH='y') then begin
        Address := Directory[IDX].Taddr;
        Size := Directory[IDX].LSize;
        TSize := Directory[IDX].HSize;
        Write(TTY, 'Enter RSX file name>' ); Break;
        Readln(TTY);
        for I:=0 to 12 do if EOLN(TTY) then FileName[I]:=' '
                                       else Read(TTY, FileName[I]);
        Rewrite(Fubar,FileName);
        ReadUnixTape
      end;
      Write(TTY, 'Continue processing?'); Break;
      Readln(TTY);
      Read(TTY,CH);
      if (CH='Y') or (CH='y') then Continue := True
                              else Continue := False;
      IDX := SUCC(IDX)
    end;
    MTrewd( Mtlun, Result );
    MTctrf( Mtlun, DirCount, Result );
    MTrdir( MTlun, Directory, BuffMax, Result );
    DirCount := SUCC(DirCount);
    Block := DirCount;
    if Result.DSW=Issuc then Continue := True
                        else Continue := False;
    if Continue then begin
      Write(TTY, 'Continue to next directory?'); Break;
      Readln(TTY); Read(TTY,CH);
      if (CH='Y') or (CH='y') then Continue := True
                              else Continue := False
    end
  end;
  MTunld( MTlun, Result );
  Writeln(TTY, 'Unix TP Input program exiting..');
  Break
end.