{+}
{	Program BRUREAD	: read BRU files	}
{						}
{	Written by Adrian Weiler 1986/87	}
{	Non-commercial use is OK.		}
{	Feel free to give this program to	}
{	anybody that can use it, as long as	}
{	you don't do that for profit. Please	}
{	don't remove this heading.		}
{						}
{	Sorry for the bad docs & for the lots	}
{	of hacks in this code. I didn't write	}
{	this program for profit either...	}
{						}
{	BRUREAD consists of:			}
{	BRUREAD.PAS 	( this file )		}
{	BRU.CLD		( Set Command BRU )	}
{	BRUMSG.MSG	( Message/OBJ )		}
{	BRU.TXT		( short doc )		}
{						}
{	Link: Link BRUREAD,BRUMSG		}
{						}
{	If anybody makes improvements, please	}
{	let me know. My address (snail mail):	}
{	Adrian Weiler				}
{	Hennentalweg 12				}
{	7400 Tuebingen				}
{	W-Germany				}
{	Phone (49)(7071) 45054			}
{	Note: Decimal 45054 = Hex AFFE = Monkey	}
{	BITNET: MIWE001@DTUZDV5A (until Mar'89)	}
{	After Apr'89, I probably won't have	}
{	that account anymore, so you could	}
{	contact a friend: ZRKH001 (ZR?HK?)	}
{	or CFKS001 @ the same node.		}
{-----------------------------------------------}

[inherit ('SYS$LIBRARY:STARLET')]
	program bruread (output,brudat,tfile,listfile);
Type
  V5000 = Varying [5000] of char;
  ufile = [unsafe] file of char;
  Fname = packed array [1..256] of char;
  String = varying [80] of char;
  FabPointer = ^Fab$type;
  RabPointer = ^Rab$type;
  XabPointer = ^Xab$type;
  NamPointer = ^Nam$type;
  TPointer   = ^FName;
  byte = [byte] 0..255;
  word = [word] 0..65535;

  item = packed record
	siz, typ : word;
	adr : integer;
  end;

{ Map RSX-11M File Header }
{ ----------------------- }

  RsxHeader = packed record
	idof,
	mpof : byte;
	fnum,
	fseq : word;
	flev,
	fstr : byte;
	uicmember,
	uicgroup : byte;
	prot : word;
	ucha,
	scha : byte;

	{ Settable by ATR$C_RECATTR (7 Words) }
	rtyp,
	ratt : byte;
        rsiz : word;
        hibh,
        hibk : word;
        efbh,
        efbk : word;
	ffby : word;

	ufat : packed array [1..9] of word;
	rest : packed array [1..466] of byte;
  end;

  hda  = packed array [1..512] of char;		{ Type cast for RsxHeader }


{ Internal representation of File Header }
{ -------------------------------------- }

  FileHeaderPointer = ^FileHeader;
  FileHeader = [unsafe] record
	bt : integer;				{ Total Blocks }
	name : packed array [1..5] of word;	{ File name in Rad50 }
	directory : packed array [1..6] of char;
	attributes : record			{ User settable attributes }
		artyp,
		aratt : byte;
	        arsiz : word;
	        ahibh,
	        ahibk : word;
	        aefbh,
	        aefbk : word;
		affby : word;
	end;
	dates : record				{ User settable dates }
		arvno : word;				{ revision number }
		arday : packed array [1..2] of char;	{ Revision date }
		armon : packed array [1..3] of char;
		aryea : packed array [1..2] of char;
		arhou : packed array [1..2] of char;
		armin : packed array [1..2] of char;
		arsec : packed array [1..2] of char;

		acday : packed array [1..2] of char;	{ creation date }
		acmon : packed array [1..3] of char;
		acyea : packed array [1..2] of char;
		achou : packed array [1..2] of char;
		acmin : packed array [1..2] of char;
		acsec : packed array [1..2] of char;
	end;
	aesqn : byte;			{ extension sequence number }
	aefnu : word;			{ next extension file number }
	back  : FileHeaderPointer;	{ Backpointer to file header
			  		  whose extension the current one is }
	ause : byte;			{ number of retrieval pointers in use }
	artrv : packed array [1..102] of packed record
		asize : byte;
		albn : integer;
	end;
  end;

  c3 = varying [3] of char;


  SigArr = Array [0..9] of Integer;	{ Signal Array }
  MchArr = Array [0..4] of Integer;	{ Mechanism Array }


  Lptr = ^ListItem;

  ListItem = Record
    Link : Lptr;
    Name : Varying [30] Of Char;
  End;

var

  BRUREAD$_CREATED	 : [external,value] Integer;
  BRUREAD$_FILEPURGED	 : [external,value] Integer;
  BRUREAD$_UPDATED	 : [external,value] Integer;
  BRUREAD$_WORKING	 : [external,value] Integer;
  BRUREAD$_TOTAL	 : [external,value] Integer;
  BRUREAD$_CREDIR	 : [external,value] Integer;
  BRUREAD$_FNF		 : [external,value] Integer;
  BRUREAD$_IVDEV	 : [external,value] Integer;
  BRUREAD$_NOTMOUNTED	 : [external,value] Integer;
  BRUREAD$_NOTFOREIGN	 : [external,value] Integer;

  HeaderPointer : Array [0..65535] Of FileHeaderPointer;

  listfile : text;
  tfile : [unsafe] text;
  fullname : string;
  TapeChannel,
  Channel : word;

  St1, St2,
  Context : integer := 0;
  Listspec,
  Resultspec,
  Filespec : Varying [80] of char;
  Fab : FabPointer;
  DevInfo : Dev$type;

  FileOpen,
  Tape,
  FlagCopy,
  FlagDebug,
  FlagExclude,
  FlagLog,
  FlagList,
  FlagSelect,
  FlagTotal,
  FlagRewind : Boolean := False;

  Select,
  Exclude : Lptr := Nil;

  openstat,
  stat: Integer;
  iosb: Packed Array [1..4] of word;

  atrlist : record
    att : packed array [1..2] of item;
    fin : integer
  end := zero;

  brudat : file of V5000;
  CurrentFileHeader : FileHeaderPointer := nil;
  buf : [unsafe,aligned(1)] v5000;
  backup_set : varying [12] of char;

  TotalFiles,
  TotalBlocks,
  curr_file,
  b,
  block_size,
  bufpos,
  pos,
  l : integer := 0;

  mode : (undefined,directory,header,data,end_of_file) := undefined;
  dirbuf : [unsafe] packed record
	fnum, fseq, fvol : word;
	fnam : packed array [1..3] of word;
	ftyp, fver : word;
  end;
  dirspec : varying [6] of char;

  fnambuf : [unsafe] packed record
	fnam : packed array [1..3] of word;
	ftyp, fver : word;
	rvno : word;
	rday : packed array [1..2] of char;
	rmon : packed array [1..3] of char;
	ryea : packed array [1..2] of char;
	rhou : packed array [1..2] of char;
	rmin : packed array [1..2] of char;
	rsec : packed array [1..2] of char;

	cday : packed array [1..2] of char;
	cmon : packed array [1..3] of char;
	cyea : packed array [1..2] of char;
	chou : packed array [1..2] of char;
	cmin : packed array [1..2] of char;
	csec : packed array [1..2] of char;

	eday : packed array [1..2] of char;
	emon : packed array [1..3] of char;
	eyea : packed array [1..2] of char;
  end;
  mapbuf : [unsafe] packed record
	esqn,
	ervn : byte;
	efnu,
	efsq : word;
	ctsz,
	lbsz,
	use,
	map : byte;
	rtrv : packed array [1..102] of packed record
		lbnh, Size : byte;
		lbnl : word;
	end;
  end;

  datbuf : [unsafe] packed array [1..8] of record
	fnum : Word;
	lbnh,Size : Byte;
	lbnl : word;
  end;
  Hdrbuf  : RsxHeader;
  hdrflag : boolean := false;
  eofflag : boolean := false;
  rad50 : [readonly] packed array [1..40] of char :=
	 ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$./0123456789';

  line : varying[132] of char;

[External(Lib$Signal)] Function $Signal
      ( %Immed Cond : Integer;
	%Immed Arguments : [List,Unsafe] Integer
      ) : Integer; Extern;

[Asynchronous] Function Handler
      ( Var SigArgs : SigArr;
	Var MchArgs : MchArr
      ) : Integer;

Begin
  If SigArgs[1] Div 65536 <> 0		{ Not a System Signal }
  Then SigArgs[0] := SigArgs[0]-2;	{ Remove PC, PSL }
  if sigargs[1] <> ss$_unwind then $Putmsg ( SigArgs );

  Case SigArgs[1] Mod 8 Of
    0,  { Warning }
    1,  { Success }
    3 : { Information }	Handler := SS$_Continue;
    2 : { Error }	Handler := SS$_Continue;
    Otherwise Begin
	$Unwind ( MchArgs[2]+1 );	{ Fatal: Exit program }
    End;
  End;
End;

Function VDesc ( Var What : Varying[l] of Char ) : Integer;
Var
  VD : [static] Item; { ** Note: cannot be used twice in a single $signal call }
Begin
  With VD Do Begin
    Siz := What.Length;
    Typ := 0;
    Adr := IAddress (What.body);
  End;
  VDesc := IAddress (VD);
End;

procedure collapse ( a : varying [l1] of char; var b : varying [l2] of char );
var i : integer;
begin
  b := '';
  for i := 1 to l1 do if a[i] <> ' ' then b := b+a[i];
  b := pad (b,' ',length(a));
end;

function c5ta ( p : word ) : c3;
var a : c3;
    i : integer;
begin
a := '';
for i := 1 to 3 do begin
  a := rad50 [p mod 40 + 1] + a;
  p := p div 40;
end;
c5ta := a;
end;

Function FindHeader (num:word;FindBase:Boolean := False) : FileHeaderPointer;
Var
  Hd : FileHeaderPointer;
begin
  Hd := HeaderPointer[Num];
  If Hd = Nil Then Begin	{ Not found }
    If FindBase Then Begin	{ Called by open_file }
      Writeln ('*** Fatal, File ID ',oct(num,6,6),' not found');
    End Else Begin
      Hd^.directory := 'EXTEND';	{ Just in case of error }
      New (Hd);
      Hd^ := Zero;
      HeaderPointer[Num] := Hd;
    End;
  End;

{ If File ID refers to an extension file header, search base header }
{ ----------------------------------------------------------------- }

  If FindBase Then While Hd^.back <> nil do Hd := Hd^.Back;
  FindHeader := Hd;
end;

procedure total;
var
  i : integer;
  d,c,s1, s2 : string;
begin
  c := '';
  if FlagCopy then c := 'created ';
  writev (s1,TotalFiles);
  collapse (s1,s1);
  for i := s1.length downto 1 do if s1[i] = ' ' then s1.length := i - 1;
  writev (s2,TotalBlocks);
  collapse (s2,s2);
  for i := s2.length downto 1 do if s2[i] = ' ' then s2.length := i - 1;
  d := s1+' files '+c+'('+s2+' blocks)';
  if FlagList then begin
    writeln (ListFile); writeln (ListFile,'Total of ',d);
  end else begin
    writeln; $Signal (BRUREAD$_TOTAL,3,%Descr d);
  end;
end;

procedure cleanup; { Forget all we have done... }
begin
end;


[external(Lib$Create_Dir)] Function $Create_Dir (
	%DESCR dirspec : string ) : integer; extern;

[external(CLI$GET_VALUE)] function $GetValue
      (	entity_desc : [CLASS_S] packed array [l..u:integer] of char;
	VAR retdesc : [CLASS_S] packed array [l1..u1:integer] of char;
	Var Retlength : word ) : Integer; extern;

[external(CLI$PRESENT)] function $Present
      (	entity_desc : [CLASS_S] packed array [l..u:integer] of char )
      : Boolean; extern;

[external(LIB$FIND_FILE)] function $FindFile
      (	Filespec : [CLASS_S] packed array [l1..u1:integer] of char;
	%descr Resultspec : varying [l2] of char;
	Var Context : integer;
	DefaultSpec : [CLASS_S] packed array [l3..u3:integer] of char := %immed 
0;
	RelatedSpec : [CLASS_S] packed array [l4..u4:integer] of char := %immed 
0;
	Var StatusValue : integer := %immed 0;
	UserFlags   : integer := %immed 0
      ) : Integer; Extern;

[external(STR$MATCH_WILD)] function $MatchWild
      (	%Descr CandidateString : varying [l1] of char;
	%Descr PatternString : varying [l2] of char
      ) : Integer; Extern;


procedure close_file;

begin
  If FileOpen Then Begin
    With CurrentFileHeader^ Do If FlagLog Then Begin
      if (openstat = rms$_created) then begin
        $Signal (BRUREAD$_CREATED,4,Vdesc(fullname),bt);
      end else if (openstat = rms$_filepurged) then begin
        $Signal (BRUREAD$_FILEPURGED,4,VDesc(fullname),bt);
      end else begin
        $Signal (BRUREAD$_UPDATED,4,Vdesc(fullname),bt);
      end;
    End;
    close (tfile); { Dummy, damit pascal OTS zufrieden ist }
    FileOpen := False;
    Stat := $qiow (
	chan := Channel,
	func := IO$_DEACCESS,
	iosb := iosb,
	p5   := IADDRESS (Atrlist)
	);
    if not (odd(stat) and odd(iosb[1])) then
      writeln ('Deaccess:',hex(stat),hex(iosb[1]));

    $dassgn (Channel);
  end{If File was open};
  curr_file := 0;
end;

procedure add_to_file ( fnum, b, lbn : integer );

  var
    filename : string;
  procedure open_file;
  var
    allocation : integer;
    function user_open (
	var fab : fab$type;
	var rab : rab$type;
	var f   : text ) : integer;
    var
      status : integer;
      nam : NamPointer;
      chan : [unsafe] packed array [1..2] of word;
      dir : string;
      retried : integer;
    begin {user_open}
      retried := 0;
      repeat
        with fab do begin
          fab$v_bio := true;
          fab$v_ufo := true;
          fab$v_upi := true;
          fab$l_alq := Allocation;
          Nam := fab$L_NAM :: NamPointer;
        end;
        status := $create (fab);
        if not odd(status) then begin
	  if status = rms$_dnf then begin {Directory not found}
	    retried := retried + 1; { Allow one retry after dir created }
	    Writev (Dir,Nam^.Nam$L_DEV :: TPOINTER^ : Nam^.Nam$B_DEV,
  		Nam^.Nam$L_DIR :: TPOINTER^ : Nam^.Nam$B_DIR);
            if $create_dir (Dir) = ss$_created then if FlagLog then
	      $Signal (BRUREAD$_CREDIR, 3, Vdesc(dir));
          end else retried := 2; { Other error - no retry }
        end;
      until odd(status) or (retried = 2);

      if odd (status) then $connect (rab);
      user_open := status;
      openstat := status;
  
      if odd (status) then Writev
	(fullname,Nam^.Nam$L_RSA :: TPOINTER^:Nam^.Nam$B_RSL)
      else fullname := '';
      Chan := Fab.Fab$L_STV;
      Channel := chan[1];
    end;

    Function InList ( List : Lptr; Empty : Boolean ) : Boolean;
    Var
      Found : Boolean;
      Candidate, Pattern : Varying [35] Of Char;
    Begin
      If List = Nil Then InList := Empty Else Begin
	Found := False;
	Candidate := '['+CurrentFileHeader^.directory+']'+FileName;
	Repeat
	  Pattern := List^.Name;
	  If Index (Pattern,'[') = 0 Then Pattern := '[*]'+Pattern;
	  If Index (Pattern,';') = 0 Then Pattern := Pattern+';*';
	  Found := odd ( $MatchWild (Candidate,Pattern) );
	  If Found And FlagDebug
	  Then Writeln ( 'Matched ',Candidate,' with ',List^.Name );
	  List := List^.Link;
	Until Found Or (List=Nil);
	InList := Found;
      End;
    End;

  begin {open_file}
    if curr_file <> 0 then close_file;
    curr_file := fnum;
    CurrentFileHeader := FindHeader (curr_file,true);
    with CurrentFileHeader^ do begin
      writev (filename,c5ta(name[1]),c5ta(name[2]),c5ta(name[3]),'.',
	c5ta(name[4]),';',name[5]:5);
      collapse (filename,filename);
      with attributes do allocation := ahibh * 65536 + ahibk;
      with attributes do if arsiz = 0 then begin
	Writeln ('*** Illegal recordsize 0 encountered. Set to 512.',chr(7));
	arsiz := 512;
      end;

      While Filename[Filename.Length] = ' ' Do
	Filename.Length := Filename.Length - 1;

      if FlagCopy then Begin
	If InList(Select,True) And Not InList(Exclude,False) Then begin
	  FileOpen := True;
	  TotalFiles := TotalFiles + 1;
	  TotalBlocks := TotalBlocks + Allocation;
	  open ( tfile, filename,unknown,
	    default := '[.'+backup_set+'.'+directory+']',
	    user_action := user_open );
	  with atrlist.att[1] do begin
	    siz := 28;
	    typ := atr$c_ascdates;
	    adr := iaddress (DATES);
	  end;

	  with atrlist.att[2] do begin
	    siz := 14;
	    typ := atr$c_recattr;
	    adr := iaddress (attributes);
	  end;
	End;
      end{if copy} Else Begin{Listing}
	TotalFiles := TotalFiles + 1;
	TotalBlocks := TotalBlocks + Allocation;
      End;
    end;
  end;

{ * The BRU data blocks describe logical blocks.
  * Since we deal with files, we must remap the logical blocks
  * to virtual blocks of the current file. (Fortunately BRU has
  * the kindness to tell us to which file the block belongs }

  Function Vbn : Integer;	{ Lbn To Vbn conversion }
  Var
    I,
    Vb : Integer;
    Hd : FileHeaderPointer;
  Begin
    Hd := CurrentFileHeader;
    I := 1;				{ start mapping at 1st mapping pointer }
    Vb := 1;				{ it maps vbn 1 }
    While ( lbn < Hd^.Artrv[i].albn )
       Or ( lbn > Hd^.Artrv[i].albn+Hd^.Artrv[i].asize ) Do Begin
      Vb := Vb + Hd^.Artrv[i].asize + 1;{ calculate the vbn mapped by next ptr }
      i := i + 1;			{ advance index to mapping pointer }
      If i > Hd^.Ause Then Begin	{ if all mapping pointers done...}
	Hd := HeaderPointer[Hd^.aefnu];	{ step to extension file header }
	i := 1;				{ and restart mapping }
      End;
    End;
    Vbn := Vb + ( lbn - Hd^.Artrv[i].albn );
  End;

begin
  if curr_file <> fnum then open_file;
  if FileOpen then begin
    Stat := $qiow (
	chan := Channel,
	func := IO$_WRITEVBLK,
	iosb := iosb,
	p1   := %immed iaddress (buf.body) + bufpos,
	p2   := b*512,
	p3   := vbn
	);
    if not (odd(stat) and odd(iosb[1])) then
      writeln ('File write error: ',hex(stat),hex(iosb[1]),hex(iosb[2]),
		' vbn=',vbn);
  end;

  with CurrentFileHeader^ do bt := bt+b;
end;


Procedure Process;
Var
  ExtensionHeader : FileHeaderPointer;

  function check_tape (
	var fab : fab$type;
	var rab : rab$type;
	var f   : text ) : integer;
  var
    status : integer;
    chan : [unsafe] packed array [1..2] of word;
  begin {user_open}
    with fab do begin
      fab$v_nfs := tape;
      fab$v_ufo := tape;
      fab$v_nil := fab$v_ufo;
    end;
    status := $open (fab);
    if odd (status) then $connect (rab);
    check_tape := status;
    Chan := Fab.Fab$L_STV;
    TapeChannel := chan[1];
    If tape and FlagRewind then
      $qiow ( chan := TapeChannel, func := IO$_REWIND );
  end;

  procedure ReadTape;
  begin
    if Tape then begin
      Stat := $qiow (
	chan := TapeChannel,
	func := IO$_READVBLK,
	iosb := iosb,
	p1   := %immed iaddress (buf.body),
	p2   := 5000,
	p3   := 0
	);
      if not (odd(stat) and odd(iosb[1])) then
	if iosb[1] <> SS$_ENDOFFILE then
	writeln ('Tape read error: ',hex(stat),hex(iosb[1]),hex(iosb[2]));
      buf.length := iosb[2];
    end else begin
      read (brudat,buf);
      eofflag := eofflag or eof (brudat);
    end;
  end;

begin { process }
  eofflag := false;
  open (brudat, ResultSpec, old, user_action := check_tape );
  if not tape then reset (brudat);
  repeat ReadTape until buf.length = 0;

  ReadTape;
  readv (substr (buf,1,12),backup_set);
  if FlagList then
    Writeln (listfile,'Directory of Backup Set ',Backup_set)
  else
    writeln ('Backup Set Name: ',backup_set);

  ReadTape; { Boot block }
  ReadTape; { Home block }
  while not eofflag do begin
    ReadTape;
    l := buf.length;
    if l = 80 then begin
      if curr_file <> 0 then close_file;
      mode::byte := (index ('UFDHEADATEOF',substr(buf,1,3)) + 2) div 3;
      case mode of
	header : begin
	  hdrflag := true;
	  if FlagDebug then writeln ('Starting File Headers Section.');
	end;

	directory : begin
	  dirbuf := substr (buf,5,16);
	  with dirbuf do dirspec := c5ta(fnam[1])+c5ta(fnam[2]);
	  if hdrflag then begin
	    mode := header; { Subsequent records are headers }
	    with dirbuf do if FlagList then begin
		writeln (listfile);
		writeln (listfile,'[',c5ta(fnam[1]),',',c5ta(fnam[2]),']');
		writeln (listfile);
	    end;
	  end;
	end;

	data : if FlagDebug then writeln ('Starting File Data Section.');
	undefined : writeln ('*** Undefined mode ***');
	end_of_file : begin 
	  if FlagTotal then total;
	  eofflag := true;
	end;
      end{case};

    end else if l <> 0 then begin
      case mode of
	undefined : writeln ('*** Undefined mode ***');
	directory : begin {Directory entry}
		pos := 1;
		repeat
		  dirbuf := substr (buf,pos,16);
		  with dirbuf do
		  if fnum = 0 then pos := l + 1
		  else begin
		    pos := pos+16;
		    New (CurrentFileHeader);		{ Create new entry }
		    CurrentFileHeader^ := Zero;
		    HeaderPointer[fnum] := CurrentFileHeader;
		    with CurrentFileHeader^ do begin
			name[1] := fnam[1];
			name[2] := fnam[2];
			name[3] := fnam[3];
			name[4] := ftyp;
			name[5] := fver;
			directory := dirspec.body;
		    end;
		  end;
		until pos >= l;
		end;
	header : begin { File header }
		pos := 1;
		repeat
		  hdrbuf :: hda := substr (buf,pos,512);
		  b := hdrbuf.idof*2+1;		{ Identification area }
		  fnambuf := substr (hdrbuf::hda,b,45);
		  b := hdrbuf.mpof*2+1;		{ Map area }
		  mapbuf := substr (hdrbuf::hda,b,512+1-b);
		  with hdrbuf, fnambuf, mapbuf do begin
		    CurrentFileHeader := FindHeader (fnum);
		    with CurrentFileHeader^ do begin
		      with attributes do begin
			artyp := rtyp;
			aratt := ratt;
		        arsiz := rsiz;
		        ahibh := hibh;
		        ahibk := hibk;
		        aefbh := efbh;
		        aefbk := efbk;
			affby := ffby;
		      end;
		      with dates do begin
			arvno := rvno;
			arday := rday;
			armon := rmon;
			aryea := ryea;
			arhou := rhou;
			armin := rmin;
			arsec := rsec;

			acday := cday;
			acmon := cmon;
			acyea := cyea;
			achou := chou;
			acmin := cmin;
			acsec := csec;
		      end;
		      aesqn := esqn;	{ Ext. sequence number }
		      aefnu := efnu;	{ Ext. file number }
		      if efnu <> 0 Then Begin
			ExtensionHeader := FindHeader (efnu);
			ExtensionHeader^.Back := CurrentFileHeader;
		      End;
		      ause := use div 2;	{ Number of pointers in use }
		      For b := 1 To Ause Do With Artrv[b],rtrv[b] Do Begin
			asize := Size;
			albn := lbnh*65536+lbnl;
		      End;
		    End;

		    writev (line,c5ta(fnam[1]),c5ta(fnam[2]),c5ta(fnam[3]),'.',
			c5ta(ftyp),';',fver:5);
		    collapse (line,line);
		    If FlagList then write (listfile,line,'  ');
		    block_size := hibh*65536+hibk;
		    writev (line,block_size:7,'. '); 
		    collapse (line,line);
		    if FlagList then writeln (listfile,line,
			cday,'-',cmon,'-',cyea,' ',chou,':',cmin,':',csec);
		  end;
		  pos := pos+512;
		until pos >= l;
		end;
	data : begin
		datbuf := substr (buf,1,48);
		pos := 0;
		bufpos := 48;
		repeat
		  pos := pos + 1;
		  with datbuf[pos] do
		  if fnum = 0 then pos := 8
		  else begin
		    add_to_file (fnum, size+1, lbnh*65536+lbnl);
		    bufpos := bufpos + (size+1)* 512;
		  end;
		until pos = 8;
		end;
      end{case};
    end;
  end;
  repeat
    ReadTape;
    if FlagDebug then writeln (buf:10,buf.length)
  until buf.length = 0;
  close (Brudat);
  If tape then $dassgn (TapeChannel);

  Cleanup; { Remove all 'CurrentFileHeader' entries }

End{Process};

Function GetList ( What : Packed Array [l..u:integer] Of Char; Var List : Lptr )
	: Boolean;
Var
  FileSpec : Varying [30] Of Char;
  Next : LPtr;
Begin
  GetList := False;
  If $Present ( What ) Then Begin
    GetList := True;
    List := Nil;
    While Odd ( $GetValue (What,FileSpec.body, FileSpec.length) ) Do Begin
      If List = Nil Then Begin
	New (List);
	Next := List;
      End Else Begin
	New (Next^.Link);
	Next := Next^.Link;
      End;
      With Next^ Do Begin
	Link := Nil;
	Name := FileSpec;
      End;
    End;
  End;
End;

Begin {Main}
  Establish ( Handler );
  FlagExclude := GetList  ('EXCLUDE',Exclude);
  FlagCopy    := $Present ('COPY');
  FlagDebug   := $Present ('DEBUG');
  FlagLog     := $Present ('LOG');
  FlagList    := $Present ('LIST');
  FlagRewind  := $Present ('REWIND');
  FlagSelect  := GetList  ('SELECT',Select);
  FlagTotal   := $Present ('TOTAL');
  If FlagList then FlagCopy := False; { Remove default }

  If FlagList then begin
    $GetValue ('LIST',Listspec.body, Listspec.length);
    open (listfile,listspec,new,default := '.LIS');
    rewrite (listfile);
  end;

  St1 := 1;
  While odd (st1) do begin
    St1 := $GetValue ('TAPE',Filespec.body, Filespec.length);
    if odd (St1) then begin
      St2 := 1;
      while odd (st2) do begin
	st2 := $FindFile (Filespec, Resultspec, Context, '.DOS', UserFlags := 
2);
	if odd (st2) then begin
	  fab := Context :: FabPointer;
	  DevInfo := fab^.fab$L_DEV :: Dev$Type;
	  with devinfo do begin
	    if not DEV$V_FOD then $Signal (BRUREAD$_IVDEV)
	    else if not DEV$V_MNT then $Signal (BRUREAD$_NOTMOUNTED)
	    else if dev$v_sqd and not dev$v_for then $Signal 
(BRUREAD$_NOTFOREIGN)
	    else begin
	      Tape := dev$v_sqd;
	      $Signal (BRUREAD$_WORKING,1,VDesc(Resultspec));
	      Process;
	    end;
	  end;
	end;
      end{While more files};
      if st2 <> RMS$_NMF then
	$Signal (BRUREAD$_FNF, 1,VDesc(ResultSpec),St2 );
    end;
  end;
end.