From:	CRDGW2::CRDGW2::MRGATE::"SMTP::IRUCCVAX.UCC.IE::CBSY8001" 29-NOV-1989 14:48
To:	MRGATE::"ARISIA::EVERHART"
Subj:	BRUREAD - 2 of 3

Message-Id:  <8911291933.AA18848@crdgw1.ge.com>
Received: from IRUCCIBM.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 6227; Wed, 29 Nov 89 14:25:01 EDT
Received: from IRUCCVAX.UCC.IE (CBSY8001) by IRUCCIBM.BITNET (Mailer R2.05)
 with BSMTP id 7669; Wed, 29 Nov 89 19:19:18 IST
Date: Wed, 29 Nov 89 19:18 GMT
From: JFM%IRUCCVAX.UCC.IE@CUNYVM.CUNY.EDU
Subject: BRUREAD - 2 of 3
Sender: CBSY8001%IRUCCVAX.UCC.IE@CUNYVM.CUNY.EDU
To: everhart@arisia.DECNET
X-Vms-To: IN%"everhart@arisia.dnet.ge.com"

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
XFunction VDesc ( Var What : Varying`091l`093 of Char ) : Integer;
XVar
X  VD : `091static`093 Item; `123 ** Note: cannot be used twice in a single $
Vsignal call `125
XBegin
X  With VD Do Begin
X    Siz := What.Length;
X    Typ := 0;
X    Adr := IAddress (What.body);
X  End;
X  VDesc := IAddress (VD);
XEnd;
X
Xprocedure collapse ( a : varying `091l1`093 of char; var b : varying `091l2`
V093 of char );
Xvar i : integer;
Xbegin
X  b := '';
X  for i := 1 to l1 do if a`091i`093 <> ' ' then b := b+a`091i`093;
X  b := pad (b,' ',length(a));
Xend;
X
Xfunction c5ta ( p : word ) : c3;
Xvar a : c3;
X    i : integer;
Xbegin
Xa := '';
Xfor i := 1 to 3 do begin
X  a := rad50 `091p mod 40 + 1`093 + a;
X  p := p div 40;
Xend;
Xc5ta := a;
Xend;
X
XFunction FindHeader (num:word;FindBase:Boolean := False) : FileHeaderPointer
V;
XVar
X  Hd : FileHeaderPointer;
Xbegin
X  Hd := HeaderPointer`091Num`093;
X  If Hd = Nil Then Begin`009`123 Not found `125
X    If FindBase Then Begin`009`123 Called by open_file `125
X      Writeln ('*** Fatal, File ID ',oct(num,6,6),' not found');
X    End Else Begin
X      Hd`094.directory := 'EXTEND';`009`123 Just in case of error `125
X      New (Hd);
X      Hd`094 := Zero;
X      HeaderPointer`091Num`093 := Hd;
X    End;
X  End;
X
X`123 If File ID refers to an extension file header, search base header `125
X`123 ----------------------------------------------------------------- `125
X
X  If FindBase Then While Hd`094.back <> nil do Hd := Hd`094.Back;
X  FindHeader := Hd;
Xend;
X
Xprocedure total;
Xvar
X  i : integer;
X  d,c,s1, s2 : string;
Xbegin
X  c := '';
X  if FlagCopy then c := 'created ';
X  writev (s1,TotalFiles);
X  collapse (s1,s1);
X  for i := s1.length downto 1 do if s1`091i`093 = ' ' then s1.length := i -
V 1;
X  writev (s2,TotalBlocks);
X  collapse (s2,s2);
X  for i := s2.length downto 1 do if s2`091i`093 = ' ' then s2.length := i -
V 1;
X  d := s1+' files '+c+'('+s2+' blocks)';
X  if FlagList then begin
X    writeln (ListFile); writeln (ListFile,'Total of ',d);
X  end else begin
X    writeln; $Signal (BRUREAD$_TOTAL,3,%Descr d);
X  end;
Xend;
X
Xprocedure cleanup; `123 Forget all we have done... `125
Xbegin
Xend;
X
X
X`091external(Lib$Create_Dir)`093 Function $Create_Dir (
X`009%DESCR dirspec : string ) : integer; extern;
X
X`091external(CLI$GET_VALUE)`093 function $GetValue
X      (`009entity_desc : `091CLASS_S`093 packed array `091l..u:integer`093 o
Vf char;
X`009VAR retdesc : `091CLASS_S`093 packed array `091l1..u1:integer`093 of cha
Vr;
X`009Var Retlength : word ) : Integer; extern;
X
X`091external(CLI$PRESENT)`093 function $Present
X      (`009entity_desc : `091CLASS_S`093 packed array `091l..u:integer`093 o
Vf char )
X      : Boolean; extern;
X
X`091external(LIB$FIND_FILE)`093 function $FindFile
X      (`009Filespec : `091CLASS_S`093 packed array `091l1..u1:integer`093 of
V char;
X`009%descr Resultspec : varying `091l2`093 of char;
X`009Var Context : integer;
X`009DefaultSpec : `091CLASS_S`093 packed array `091l3..u3:integer`093 of cha
Vr := %immed 0;
X`009RelatedSpec : `091CLASS_S`093 packed array `091l4..u4:integer`093 of cha
Vr := %immed 0;
X`009Var StatusValue : integer := %immed 0;
X`009UserFlags   : integer := %immed 0
X      ) : Integer; Extern;
X
X`091external(STR$MATCH_WILD)`093 function $MatchWild
X      (`009%Descr CandidateString : varying `091l1`093 of char;
X`009%Descr PatternString : varying `091l2`093 of char
X      ) : Integer; Extern;
X
X`012
Xprocedure close_file;
X
Xbegin
X  If FileOpen Then Begin
X    With CurrentFileHeader`094 Do If FlagLog Then Begin
X      if (openstat = rms$_created) then begin
X        $Signal (BRUREAD$_CREATED,4,Vdesc(fullname),bt);
X      end else if (openstat = rms$_filepurged) then begin
X        $Signal (BRUREAD$_FILEPURGED,4,VDesc(fullname),bt);
X      end else begin
X        $Signal (BRUREAD$_UPDATED,4,Vdesc(fullname),bt);
X      end;
X    End;
X    close (tfile); `123 Dummy, damit pascal OTS zufrieden ist `125
X    FileOpen := False;
X    Stat := $qiow (
X`009chan := Channel,
X`009func := IO$_DEACCESS,
X`009iosb := iosb,
X`009p5   := IADDRESS (Atrlist)
X`009);
X    if not (odd(stat) and odd(iosb`0911`093)) then
X      writeln ('Deaccess:',hex(stat),hex(iosb`0911`093));
X
X    $dassgn (Channel);
X  end`123If File was open`125;
X  curr_file := 0;
Xend;
X
Xprocedure add_to_file ( fnum, b, lbn : integer );
X
X  var
X    filename : string;
X  procedure open_file;
X  var
X    allocation : integer;
X    function user_open (
X`009var fab : fab$type;
X`009var rab : rab$type;
X`009var f   : text ) : integer;
X    var
X      status : integer;
X      nam : NamPointer;
X      chan : `091unsafe`093 packed array `0911..2`093 of word;
X      dir : string;
X      retried : integer;
X    begin `123user_open`125
X      retried := 0;
X      repeat
X        with fab do begin
X          fab$v_bio := true;
X          fab$v_ufo := true;
X          fab$v_upi := true;
X          fab$l_alq := Allocation;
X          Nam := fab$L_NAM :: NamPointer;
X        end;
X        status := $create (fab);
X        if not odd(status) then begin
X`009  if status = rms$_dnf then begin `123Directory not found`125
X`009    retried := retried + 1; `123 Allow one retry after dir created `125
X`009    Writev (Dir,Nam`094.Nam$L_DEV :: TPOINTER`094 : Nam`094.Nam$B_DEV,
X  `009`009Nam`094.Nam$L_DIR :: TPOINTER`094 : Nam`094.Nam$B_DIR);
X            if $create_dir (Dir) = ss$_created then if FlagLog then
X`009      $Signal (BRUREAD$_CREDIR, 3, Vdesc(dir));
X          end else retried := 2; `123 Other error - no retry `125
X        end;
X      until odd(status) or (retried = 2);
X
X      if odd (status) then $connect (rab);
X      user_open := status;
X      openstat := status;
X `032
X      if odd (status) then Writev
X`009(fullname,Nam`094.Nam$L_RSA :: TPOINTER`094:Nam`094.Nam$B_RSL)
X      else fullname := '';
X      Chan := Fab.Fab$L_STV;
X      Channel := chan`0911`093;
X    end;
X
X    Function InList ( List : Lptr; Empty : Boolean ) : Boolean;
X    Var
X      Found : Boolean;
X      Candidate, Pattern : Varying `09135`093 Of Char;
X    Begin
X      If List = Nil Then InList := Empty Else Begin
X`009Found := False;
X`009Candidate := '`091'+CurrentFileHeader`094.directory+'`093'+FileName;
X`009Repeat
X`009  Pattern := List`094.Name;
X`009  If Index (Pattern,'`091') = 0 Then Pattern := '`091*`093'+Pattern;
X`009  If Index (Pattern,';') = 0 Then Pattern := Pattern+';*';
X`009  Found := odd ( $MatchWild (Candidate,Pattern) );
X`009  If Found And FlagDebug
X`009  Then Writeln ( 'Matched ',Candidate,' with ',List`094.Name );
X`009  List := List`094.Link;
X`009Until Found Or (List=Nil);
X`009InList := Found;
X      End;
X    End;
X
X  begin `123open_file`125
X    if curr_file <> 0 then close_file;
X    curr_file := fnum;
X    CurrentFileHeader := FindHeader (curr_file,true);
X    with CurrentFileHeader`094 do begin
X      writev (filename,c5ta(name`0911`093),c5ta(name`0912`093),c5ta(name`091
V3`093),'.',
X`009c5ta(name`0914`093),';',name`0915`093:5);
X      collapse (filename,filename);
X      with attributes do allocation := ahibh * 65536 + ahibk;
X      with attributes do if arsiz = 0 then begin
X`009Writeln ('*** Illegal recordsize 0 encountered. Set to 512.',chr(7));
X`009arsiz := 512;
X      end;
X
X      While Filename`091Filename.Length`093 = ' ' Do
X`009Filename.Length := Filename.Length - 1;
X
X      if FlagCopy then Begin
X`009If InList(Select,True) And Not InList(Exclude,False) Then begin
X`009  FileOpen := True;
X`009  TotalFiles := TotalFiles + 1;
X`009  TotalBlocks := TotalBlocks + Allocation;
X`009  open ( tfile, filename,unknown,
X`009    default := '`091.'+backup_set+'.'+directory+'`093',
X`009    user_action := user_open );
X`009  with atrlist.att`0911`093 do begin
X`009    siz := 28;
X`009    typ := atr$c_ascdates;
X`009    adr := iaddress (DATES);
X`009  end;
X
X`009  with atrlist.att`0912`093 do begin
X`009    siz := 14;
X`009    typ := atr$c_recattr;
X`009    adr := iaddress (attributes);
X`009  end;
X`009End;
X      end`123if copy`125 Else Begin`123Listing`125
X`009TotalFiles := TotalFiles + 1;
X`009TotalBlocks := TotalBlocks + Allocation;
X      End;
X    end;
X  end;
X
X`123 * The BRU data blocks describe logical blocks.
X  * Since we deal with files, we must remap the logical blocks
X  * to virtual blocks of the current file. (Fortunately BRU has
X  * the kindness to tell us to which file the block belongs `125
X
X  Function Vbn : Integer;`009`123 Lbn To Vbn conversion `125
X  Var
X    I,
X    Vb : Integer;
X    Hd : FileHeaderPointer;
X  Begin
X    Hd := CurrentFileHeader;
X    I := 1;`009`009`009`009`123 start mapping at 1st mapping pointer `125
X    Vb := 1;`009`009`009`009`123 it maps vbn 1 `125
X    While ( lbn < Hd`094.Artrv`091i`093.albn )
X       Or ( lbn > Hd`094.Artrv`091i`093.albn+Hd`094.Artrv`091i`093.asize ) D
Vo Begin
X      Vb := Vb + Hd`094.Artrv`091i`093.asize + 1;`123 calculate the vbn mapp
Ved by next ptr `125
X      i := i + 1;`009`009`009`123 advance index to mapping pointer `125
X      If i > Hd`094.Ause Then Begin`009`123 if all mapping pointers done...`
V125
X`009Hd := HeaderPointer`091Hd`094.aefnu`093;`009`123 step to extension file
V header `125
X`009i := 1;`009`009`009`009`123 and restart mapping `125
X      End;
X    End;
X    Vbn := Vb + ( lbn - Hd`094.Artrv`091i`093.albn );
X  End;
X
Xbegin
X  if curr_file <> fnum then open_file;
X  if FileOpen then begin
X    Stat := $qiow (
X`009chan := Channel,
X`009func := IO$_WRITEVBLK,
X`009iosb := iosb,
X`009p1   := %immed iaddress (buf.body) + bufpos,
X`009p2   := b*512,
X`009p3   := vbn
X`009);
X    if not (odd(stat) and odd(iosb`0911`093)) then
X      writeln ('File write error: ',hex(stat),hex(iosb`0911`093),hex(iosb`09
V12`093),
X`009`009' vbn=',vbn);
X  end;
X
X  with CurrentFileHeader`094 do bt := bt+b;
Xend;
X
X`012
XProcedure Process;
XVar
X  ExtensionHeader : FileHeaderPointer;
X
X  function check_tape (
X`009var fab : fab$type;
X`009var rab : rab$type;
X`009var f   : text ) : integer;
X  var
X    status : integer;
X    chan : `091unsafe`093 packed array `0911..2`093 of word;
X  begin `123user_open`125
X    with fab do begin
X      fab$v_nfs := tape;
X      fab$v_ufo := tape;
X      fab$v_nil := fab$v_ufo;
X    end;
X    status := $open (fab);
X    if odd (status) then $connect (rab);
X    check_tape := status;
X    Chan := Fab.Fab$L_STV;
X    TapeChannel := chan`0911`093;
X    If tape and FlagRewind then
X      $qiow ( chan := TapeChannel, func := IO$_REWIND );
X  end;
X
X  procedure ReadTape;
X  begin
X    if Tape then begin
X      Stat := $qiow (
X`009chan := TapeChannel,
X`009func := IO$_READVBLK,
X`009iosb := iosb,
X`009p1   := %immed iaddress (buf.body),
X`009p2   := 5000,
X`009p3   := 0
X`009);
X      if not (odd(stat) and odd(iosb`0911`093)) then
X`009if iosb`0911`093 <> SS$_ENDOFFILE then
X`009writeln ('Tape read error: ',hex(stat),hex(iosb`0911`093),hex(iosb`0912`
V093));
X      buf.length := iosb`0912`093;
X    end else begin
X      read (brudat,buf);
X      eofflag := eofflag or eof (brudat);
X    end;
X  end;
X
Xbegin `123 process `125
X  eofflag := false;
X  open (brudat, ResultSpec, old, user_action := check_tape );
X  if not tape then reset (brudat);
X  repeat ReadTape until buf.length = 0;
X
X  ReadTape;
X  readv (substr (buf,1,12),backup_set);
X  if FlagList then
X    Writeln (listfile,'Directory of Backup Set ',Backup_set)
X  else
X    writeln ('Backup Set Name: ',backup_set);
X
X  ReadTape; `123 Boot block `125
X  ReadTape; `123 Home block `125
X  while not eofflag do begin
X    ReadTape;
X    l := buf.length;
X    if l = 80 then begin
X      if curr_file <> 0 then close_file;
X      mode::byte := (index ('UFDHEADATEOF',substr(buf,1,3)) + 2) div 3;
X      case mode of
X`009header : begin
X`009  hdrflag := true;
X`009  if FlagDebug then writeln ('Starting File Headers Section.');
X`009end;
X
X`009directory : begin
X`009  dirbuf := substr (buf,5,16);
X`009  with dirbuf do dirspec := c5ta(fnam`0911`093)+c5ta(fnam`0912`093);
X`009  if hdrflag then begin
X`009    mode := header; `123 Subsequent records are headers `125
X`009    with dirbuf do if FlagList then begin
X`009`009writeln (listfile);
X`009`009writeln (listfile,'`091',c5ta(fnam`0911`093),',',c5ta(fnam`0912`093)
V,'`093');
X`009`009writeln (listfile);
X`009    end;
X`009  end;
X`009end;
X
X`009data : if FlagDebug then writeln ('Starting File Data Section.');
X`009undefined : writeln ('*** Undefined mode ***');
X`009end_of_file : begin`032
X`009  if FlagTotal then total;
X`009  eofflag := true;
X`009end;
X      end`123case`125;
X
X    end else if l <> 0 then begin
X      case mode of
X`009undefined : writeln ('*** Undefined mode ***');
X`009directory : begin `123Directory entry`125
X`009`009pos := 1;
X`009`009repeat
X`009`009  dirbuf := substr (buf,pos,16);
X`009`009  with dirbuf do
X`009`009  if fnum = 0 then pos := l + 1
X`009`009  else begin
X`009`009    pos := pos+16;
X`009`009    New (CurrentFileHeader);`009`009`123 Create new entry `125
X`009`009    CurrentFileHeader`094 := Zero;
X`009`009    HeaderPointer`091fnum`093 := CurrentFileHeader;
X`009`009    with CurrentFileHeader`094 do begin
X`009`009`009name`0911`093 := fnam`0911`093;
X`009`009`009name`0912`093 := fnam`0912`093;
X`009`009`009name`0913`093 := fnam`0913`093;
X`009`009`009name`0914`093 := ftyp;
X`009`009`009name`0915`093 := fver;
X`009`009`009directory := dirspec.body;
X`009`009    end;
X`009`009  end;
X`009`009until pos >= l;
X`009`009end;
X`009header : begin `123 File header `125
X`009`009pos := 1;
X`009`009repeat
X`009`009  hdrbuf :: hda := substr (buf,pos,512);
X`009`009  b := hdrbuf.idof*2+1;`009`009`123 Identification area `125
X`009`009  fnambuf := substr (hdrbuf::hda,b,45);
X`009`009  b := hdrbuf.mpof*2+1;`009`009`123 Map area `125
X`009`009  mapbuf := substr (hdrbuf::hda,b,512+1-b);
X`009`009  with hdrbuf, fnambuf, mapbuf do begin
X`009`009    CurrentFileHeader := FindHeader (fnum);
X`009`009    with CurrentFileHeader`094 do begin
X`009`009      with attributes do begin
X`009`009`009artyp := rtyp;
X`009`009`009aratt := ratt;
X`009`009        arsiz := rsiz;
X`009`009        ahibh := hibh;
X`009`009        ahibk := hibk;
X`009`009        aefbh := efbh;
X`009`009        aefbk := efbk;
X`009`009`009affby := ffby;
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-
