(*$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;
     PathString = packed array [0..31] of CHAR;
     Gcmlbuf = packed array [0..79] of CHAR;
     TapeStatus = record Count,DSW:Integer end;
     Entry = record
       Path:Pathstring;
       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;
    Pathname:PathString;
    I,IDX,INDEX:Integer;
    J:Integer;
    Directory:Direct;
    DirCount:Integer;
    CH:Char;
    Address,TSize,Size:Integer;
    Continue:Boolean;
    Found:Boolean;
    Length:Integer;
    GcmlData : GcmlBuf;
  
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 GCML( var Line:GcmlBuf; var Len:Integer);Extern;
  
procedure Initialize;
  
begin
  MTinit( MTlun, 0, 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. *)
    Found := False;
    GCML(GcmlData,Length);
    I := 0;
    J := 0;
    while GcmlData[I] <> ' ' do I :=SUCC(I);
    I := SUCC(I);
    while GcmlData[I] <> '=' do begin
      FileName[J] := GcmlData[I];
      I := SUCC(I);
      J := SUCC(J);
    end;
    I := SUCC(I);
    for J := I to Length do PathName[J-I] := GcmlData[J];
    PathName[Length-I+1] := CHR(0)
  end
end; (* Initialize *)
  
procedure ReadUnixTape;
  
begin
  MTctrf( MTlun, Address-Block, Result );
  Block := Address;
  while Size<0 do begin
    Size := size - 512;
    TSize := TSize + 2
    end;
  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;  (* ReadUnixTape *)
  
function Match( var S1,S2:PathString):Boolean;
var Index:Integer;
begin
  Index := 0;
  while (S1[Index]=S2[Index]) and (Index<32) do Index := SUCC(Index);
  if (Index=32) or (S1[Index]=S2[Index]) then
    Match := True
  else
    Match := False
end;  (* Match *)
 
begin
  Initialize;
  if Result.DSW <> Issuc then Continue := False;
  while Continue do begin
    IDX := 0;
    while Continue and (IDX<8) do
      if Match(Directory[IDX].Path,PathName) then
        begin
          Address := Directory[IDX].Taddr;
          Size := Directory[IDX].LSize;
          TSize := Directory[IDX].HSize;
          Rewrite(Fubar,FileName);
          ReadUnixTape;
          Found := True;
          Continue := False
        end
      else
        IDX := SUCC(IDX);
    (* end while loop *)
    MTrewd( Mtlun, Result );
    if Continue then begin
      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 DirCount = 10 then Continue := False
    end
  end;
  MTrewd( Mtlun, Result );
  if Found then Writeln(TTY, 'Unix TP Input proram exiting...')
           else Writeln(TTY, 'Input file not found...');
  Break
end.