<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$PAGE "DBRESTORE ENHANCEMENT"                                  <<07699>>01282010
<<----------------------------------------------------------   <<07699>>01282020
COMMENT:                                                       <<07699>>01282021
                                                               <<07699>>01282030
Notes on the DBRESTOR enhancment:                              <<07699>>01283030
                                                               <<07699>>01283040
The program DBRESTOR.PUB.SYS (whose purpose is to restore a    <<07699>>01283050
database rather than a set of files) has in the past called    <<07699>>01283060
procedures in the RESTORE module (module 52).  With RESTORE    <<07699>>01283070
being supported as a program, the restore module can not be    <<07699>>01283080
supported indefinately.  Hence the DBRESTOR enhancement.       <<07699>>01283090
                                                               <<07699>>01283100
The purpose of the enhancement is to allow restoring logical   <<07699>>01283110
sets of files where the entire set of files is not known       <<07699>>01283120
a'priori.  Here, the set of files is determined by examining   <<07699>>01283130
the root file.                                                 <<07699>>01283140
                                                               <<07699>>01283150
One important point is that the design and implementation of   <<07699>>01283160
DBRESTOR leaves hooks for other future enhancments where       <<07699>>01283170
restoring logically related files is desirable.                <<07699>>01283180
                                                               <<07699>>01283190
The design of the enhancement is as follows:                   <<07699>>01283200
                                                               <<07699>>01283210
  The store/restore program is passed a DBRESTOR token (to     <<07699>>01283220
  tell STORE that it is DBRESTORing) and database sets (as     <<07699>>01283230
  opposed to file sets).  The syntax for database sets is the  <<07699>>01283240
  sames as file sets except no wild cards are accepted:        <<07699>>01283250
                                                               <<07699>>01283260
     database_set :== database [,database[,database...]]       <<07699>>01283270
     database :== {6 character root file name}                 <<07699>>01283280
                                                               <<07699>>01283290
  A file of database names (or rootfile names) may also be     <<07699>>01283300
  passed as an indirect file (the filename is preceeded by an  <<07699>>01283310
  explanation mark ['!']).                                     <<07699>>01283320
                                                               <<07699>>01283330
  STORE will put the list of databases into it's good file the <<07699>>01283340
  same as a set of files.                                      <<07699>>01283350
                                                               <<07699>>01283360
  During FRESTORE (where all files are restored), the the name <<07699>>01283370
  of the next file to be restored may be read from one of two  <<07699>>01283380
  files.  The GOOD file contains all the database names.  First<<07699>>01283390
  time a name is obtained in FRESTORE, it is read from the good<<07699>>01283400
  file.  Then the root file is restored.  From the root file   <<07699>>01283410
  a second good file (GOOD2) is generated by the procedure     <<07699>>01283420
  DB'IRESTORE.  Subsequent reads will come from the GOOD2 file <<07699>>01283430
  until the GOOD2 file is empty.  Then the next read will come <<07699>>01283440
  from the GOOD file until all databases have been restored and<<07699>>01283450
  we are at the end of the GOOD file.                          <<07699>>01283460
                                                               <<07699>>01283470
  The parser was slightly modified to allow lowercase maint    <<07699>>01283480
  words to be passed in (same syntax as lockwords).            <<07699>>01283490
                                                               <<07699>>01283500
  Error handling is special for DBRESTOR in that any component <<07699>>01283510
  file in the database not being restored will force the entire<<07699>>01283520
  database to be purged.  This is done by the procedure DB'PURG<<07699>>01283530
  In the event of an error, DB'PURGE will only purge those file<<07699>>01283540
  restored.  There is one known problem with this method in tha<<07699>>01283550
  if KEEP is specified and the error happens on a file other   <<07699>>01283560
  than the root, it is possible that the program may purge no  <<07699>>01283570
  more than one of the original old database component files.  <<07699>>01283580
  It is the author's opinion that it is a very rare case that  <<07699>>01283590
  any component files will be left laying around without a root<<07699>>01283600
  file.                                                        <<07699>>01283610
                                                               <<07699>>01283620
  Currently it is not possible to restore more than one        <<07699>>01283630
  database with a maintenance word.  To change this, the maint <<07699>>01283640
  word must be taken from the candidat file instead of moving  <<07699>>01283650
  it into the maintword array is it currently does.            <<07699>>01283660
                                                               <<07699>>01283670
  To add any other enhancement where logically related files   <<07699>>01283680
  can be restored without specifying the entire set of files   <<07699>>01283690
  just add another 'TOG variable and call a different procedure<<07699>>01283700
  other than DB'IRESTORE to build the GOOD2 file.              <<07699>>01283710
                                                               <<07699>>01283720
  One more exception, obviously the root file must preceed the <<07699>>01283730
  component files on the tape (otherwise a rewind would be     <<07699>>01283740
  necessary).     ;                                            <<07699>>01283750
                                                               <<07699>>01283760
   NUM'XDS        := 3,      <<number of XDS buffers to use>>   <<2>>   01454000
   SDISC'BUFFSIZE := %50000;  <<tdbuf size for sdiscs       >>          01455000
      TOS := IF TAPE'SDISC'TOG THEN SDISC'BUFFSIZE                      01568000
             ELSE TAPE'RECSIZE;                                         01569000
      VTABINX (FILE'LDEV, PVMVTABX<>0) .(08:08)  #,            <<07349>>01642000
                                                               <<m8011>>01750100
   NUMBANKS = ABSOLUTE ( %1000 + %47)#, << NUMBANKS-1 >>       <<m8011>>01750200
$EDIT VOID=01752090                                                     01752010
                                                               <<m8011>>01892100
   SMALL'MEMORY'SYSTEM = 5#, << implies 6 banks, 384K >>       <<j9050>>01892200
   VERY'SMALL'MEMORY'SYSTEM = 3#, << 4 banks, 256K >>          <<j9050>>01892210
$EDIT                                                          <<07043>>01922000
   ATTIO'2'EOF'ERROR =%53,    <<illegal read past 2 eofs>>     <<m8862>>01939100
   ATTIO'REWIND'ON= 5  ,      <<ATTACHIO rewind on line>>      <<r9434>>01943000
   ATTIO'REWIND   = 9  ,      <<ATTACHIO rewind and unload >>  <<r9434>>01947000
   ATTIO'2'EOF    = 128,      <<enab/disab dvr detection of>>  <<m8862>>01947100
                              <<two concecutive eofs       >>  <<m8862>>01947200
   COMMAND'TEXT'LEN    = 180,                                           01978000
   COMMAND'TEXT''LEN   = 360,                                           01980000
   DS'COMM'ERROR  = 244,      <<1st DS error returned by FCHECK<<r9434>>02003500
   ITEM'MPE4'LDEV =  6    ,   <<Item number for FFILEINFO >>   <<r9434>>02073000
   ITEM'LDEV      = 50    ,   <<Item number for FFILEINFO >>   <<07043>>02078100
   ITEM'VIRT      = 51    ,   <<Item number for FFILEINFO >>   <<07043>>02078200
   SUBTYPE'7978   = 2  ,      <<  "      "  HP7978  "  >>      <<m7682>>02198500
   SUBTYPE'7974   = 3  ,      <<  "      "  HP7974  "  >>      <<m7682>>02199000
   TYPE'7978      = %1030 ,   <<  "       "   "      "     " >><<m7682>>02214500
   TYPE'7974      = %1430 ,   <<  "       "   "      "     " >><<m7682>>02215000
   WHY'WRONG      = 7,                                         <<s9101>>02280100
                  <<STOREJCW returns this value when        >> <<s9101>>02280200
                  <<one of the following conditions exists  >> <<s9101>>02280300
                  << 1. bad'file'count <> 0 when restoring  >> <<s9101>>02280400
                  << 2. files'rejected <> 0 when storing    >> <<s9101>>02280500
                                                               <<s9101>>02280510
   WHY'FAILED     = 8,                                         <<s9101>>02280520
                  <<STOREJCW returns this value when        >> <<s9101>>02280530
                  <<failed'file'count > 0                   >> <<s9101>>02280540
   PROGRESS'INTERVAL          := 60D,                          <<m9104>>03297000
   SUBCLASS'D                 := 0D,                           <<m8224>>03304000
   TIME                       := 0D,                           <<m8224>>03304100
   TOTAL'SECTOR'COUNT         := 0D;                           <<m8224>>03305000
   ERROR'LEVEL                := 0,                            <<r9434>>03345000
   LAST'TAPE'REEL             := 0,                            <<r9434>>03381100
   PROGRESS'NUM               := 0,                            <<m8224>>03417000
   TIME'0                     = TIME,                          <<m8224>>03451000
   TIME'1                     = TIME + 1,                      <<m8224>>03451100
   DS'ERROR                   := 0,                            <<r9434>>03469000
   S'R'FLAGS7                 := 0,                            <<07699>>03497000
$EDIT VOID=03514140                                                     03514010
         <<for use with the progress messages>>                <<m8224>>03565000
      HOUR        = TIME'0.(0:8)                #,             <<j9103>>03565010
      MINUTE      = TIME'0.(8:8)                #,             <<m8224>>03565100
      SECOND      = TIME'1.(0:8)                #,             <<m8224>>03565200
$EDIT VOID=03565300                                            <<m9104>>03565300
                                                               <<m8224>>03565400
      PVMVTABX    =    PV'INFO.(04:04)           #,            <<07349>>03570000
      VIRTDEV        = S'R'FLAGS6.(03:01)       #,             <<07043>>03762000
      DBRESTOR'TOG   = S'R'FLAGS7.(15:01)       #,             <<07699>>03769000
      PROGRESS'TO'CONSOLE = S'R'FLAGS7.(14:01)  #,             <<m8224>>03769100
      SEEN'PROGRESS  = S'R'FLAGS7.(13:01)       #,             <<m8224>>03769200
$PAGE                                                          <<07699>>03873000
<< Globals needed for DB'RESTORE >>                            <<07699>>03874000
                                                               <<07699>>03875000
INTEGER                                                        <<07699>>03876000
   DB'RESTOR'HIGH      := 0,      << High file number >>       <<07699>>03877000
   DB'RESTOR'LOW       := 0;      << lowest db file number >>  <<07699>>03878000
BYTE ARRAY DB'GET'R'NAME(0:13) :=                              <<07699>>03879000
      "GET'ROOT'INFO ";           << Name of getroot proc  >>  <<07699>>03880000
LOGICAL DB'GET'R'PLABEL;          << Plabel of getroot proc>>  <<07699>>03881000
INTEGER G2'NUM;                   << file number of good2  >>  <<07699>>03882000
EQUATE FWRITEOF = 6;              << FCONTROL number       >>  <<07699>>03883000
DOUBLE MAX'DBRESTOR'RECS := 101D; << File limit for good2 >>   <<07699>>03884000
LOGICAL DB'FIRST'TIME := TRUE;    << First time good file  >>  <<07699>>03885000
                                  << is read               >>  <<07699>>03886000
LOGICAL DB'GOT'ROOT'FILE := FALSE;<< Root file is in good  >>  <<07699>>03887000
                                  << file buffer iff true  >>  <<07699>>03888000
BYTE ARRAY MAINT'WORD(0 : FILE'PART'SIZE); << DB maint word >> <<07699>>03889000
LOGICAL UPCASE;                            << Upcase if true>> <<07699>>03890000
   SR'PROGRESS'REDUNDENT        = 6256,                        <<m8224>>05401110
   SR'PROGRESS'INTERVAL'EXPECTED= 6257,                        <<m9104>>05401120
   SR'DS'COMM'ERROR             = 6258,                        <<r9434>>05402020
   LAST'REAL'MSG                = 6259,                        <<r9434>>05404000
   RS'RESTORE'CREATED           = 9076,                        <<m7941>>05510090
   RS'OLD'FILE'PURGED           = 9077,                        <<p9364>>05510091
   DB'FNAME'LONG                = 11000,                       <<07699>>05510100
   DB'MISSING'FILE              = 11001,                       <<07699>>05510200
   DB'DUPLICATE                 = 11002,                       <<07699>>05510300
   DB'NOT'PURGED                = 11003,                       <<07699>>05510400
   SR'DBRESTOR'CALLED'BY'ALIEN  = 11004,                       <<07699>>05510500
   DB'NO'IMAGE                  = 11005,                       <<07699>>05510600
   DB'NOT'GOOD'ROOT             = 11006,                       <<07699>>05510700
   DB'PURGED                    = 11007,                       <<07699>>05510800
$EDIT VOID=05510900                                            <<07699>>05510900
   M'DB'NOT'RESTORED          = M'DATELINE               + 1,  <<07699>>06059000
   M'DIREC'NO'ROOM            = M'DB'NOT'RESTORED        + 1,  <<07699>>06060000
   M'PROGRESS                 = M'PREV'CATASTROPHIC      + 1,  <<m8224>>06151000
   M'PV'DISMOUNT'FAIL         = M'PROGRESS               + 1,  <<m8224>>06152000
   M'NOT'PURGED               = M'WRITE'FILE'LABEL'FAILED+ 1,           06210100
   M'T'BAD'RECSIZE            = M'NOT'PURGED             + 1,  <<s9532>>06210200
   M'SM'REQUIRED              = M'T'BAD'RECSIZE          + 1,  <<s9532>>06210300
   M'AM'OR'SM'REQUIRED        = M'SM'REQUIRED            + 1;  <<s9532>>06210400
   LOADPROC,                                                   <<07699>>07059000
PROCEDURE ABORTIO (LDEVICE);                                   <<m7499>>07089010
         VALUE LDEVICE;                                        <<m7499>>07089020
         INTEGER LDEVICE;                                      <<m7499>>07089030
         OPTION EXTERNAL;                                      <<m7499>>07089040
                                                               <<m7499>>07089050
DOUBLE PROCEDURE P'ATTACHIO (LDEV, QMISC, DX, T, FUNC, CNT,    <<07347>>07450100
                           P1, P2, FLAGS, EXTBASE, EXTSIZE);   <<07347>>07450200
         VALUE   LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLAGS, <<07347>>07450300
                 EXTBASE, EXTSIZE;                             <<07347>>07450350
         INTEGER LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLAGS; <<07347>>07450400
         DOUBLE  EXTBASE;                                      <<07347>>07450450
         LOGICAL EXTSIZE;                                      <<07347>>07450460
         OPTION EXTERNAL,VARIABLE;                             <<07347>>07450500
                                                               <<07347>>07450600
                                                               <<07699>>07788000
LOGICAL PROCEDURE READ'DISK (LDEV, ADDRESS, DST, BUFFER,       <<m7666>>08510000
                             LEN, IOB, ATTIO);                 <<m7666>>08511000
         VALUE   LDEV, ADDRESS, DST, BUFFER, LEN, ATTIO;       <<m7666>>08512000
         LOGICAL ATTIO;                                        <<m7666>>08515000
         OPTION FORWARD,  UNCALLABLE, VARIABLE;                <<m7666>>08518000
$EDIT VOID=08674060                                                     08674010
LOGICAL PROCEDURE DB'PURGE(GOODFNUM);                          <<07699>>08768100
         INTEGER GOODFNUM;                                     <<07699>>08768200
         OPTION FORWARD, UNCALLABLE, PRIVILEGED;               <<07699>>08768300
                                                               <<07699>>08768400
                  (NUMBER < DBSTORE'LOW) THEN                  <<09397>>15266000
$EDIT VOID=15267000                                                     15267000
                                                               <<07699>>15270100
            IF DBRESTOR'TOG AND (LEN=2) THEN                   <<07699>>15271000
               BEGIN                                           <<07699>>15271100
               NUMBER := 10 * (PTEXT-"0") + (PTEXT(1)-"0");    <<07699>>15271200
               IF (NUMBER > DB'RESTOR'HIGH) OR                 <<07699>>15271300
                  (NUMBER < DB'RESTOR'LOW) THEN                <<07699>>15271400
                     RETURN;                                   <<07699>>15271500
               END;                                            <<07699>>15271600
         IF NOT (DBRESTOR'TOG LAND STATE=STATE'LOCK) THEN      <<07699>>16809000
            MOVE DUMMY':=DUMMY' WHILE AS;<<upshift 1 character><<07699>>16810000
   DEFAULT'ALLOWED'ITEMS:=%077777;          <<all bits on>>    <<S8716>>17034000
   IF ALLOWED'ITEMS.ALLOW'IMBEDDED'BLANKS'bit THEN             <<S8716>>17093000
      WHILE PDIS(CHAR'INX) = " " DO                            <<S8716>>17093100
         CHAR'INX:=CHAR'INX + 1;                               <<S8716>>17093200
                                                               <<S8716>>17093300
   IF PROGRESS'NUM <> 0 AND PROGRESS'NUM <> NOSHUT THEN        <<m8224>>20607000
      FCLOSE (PROGRESS'NUM, 0, 0);                             <<m8224>>20607100
                                                               <<m8224>>20607200
      IF GOT'DSIR AND DSIR'INFO = 3 THEN                       <<09470>>21164100
         DSIR'INFO := 0;                                       <<09470>>21164200
      IF GOT'FISIR AND FISIR'INFO = 3 THEN                     <<09470>>21164300
         FISIR'INFO := 0;                                      <<09470>>21164400
      IF GOT'DSIR AND DSIR'INFO = 3 THEN                       <<09470>>21228100
         DSIR'INFO := 0;                                       <<09470>>21228200
      IF GOT'FISIR AND FISIR'INFO = 3 THEN                     <<09470>>21228300
         FISIR'INFO := 0;                                      <<09470>>21228400
      BLKSIZE'D,              << RIO words in a block .     >> <<*7681>>21624000
      RECSIZE'D;              << RIO words in a record.     >> <<*7681>>21626000
               (recsize in words)*(blockfactor) + blockfactor/16        21646000
               (16 * blksize in words) / (16*recsize in words + 1)    >>21650000
         BLKSIZE'D := DOUBLE(FLBLKSIZE);                       <<*7681>>21656000
         IF FLRECSIZE < 0                                      <<*7681>>21658000
            THEN RECSIZE := -FLRECSIZE                         <<*7681>>21660000
            ELSE RECSIZE := FLRECSIZE*2;                       <<*7681>>21662000
         RECSIZE'D := DOUBLE( (RECSIZE+1)/2 );                 <<*7681>>21664000
         BLKF := INTEGER( 16D*BLKSIZE'D / (16D*RECSIZE'D+1D) );<<*7681>>21666000
      BLKSIZE'D:=LOGICAL(FLBLKSIZE)**2;                        <<m7886>>21718000
      BLKF:=LOGICAL(BLKSIZE'D/DOUBLE(RECSIZE));                <<m7886>>21722000
      IF DOUBLE(BLKF * RECSIZE) <> BLKSIZE'D THEN              <<m7886>>21726000
      RELSIR (DSIR, 0);  <<GUARANTEE TO RELEASE DSIR>>         <<j9170>>22288000
   DISJ'EXT'LEN  (0) := IF ORIG'NUM'EXTENTS = 1 THEN           <<m9013>>22514000
                           LAST'EXTSIZE                        <<m9013>>22515000
                        ELSE                                   <<m9013>>22515100
                           EXTSIZE;                            <<m9013>>22515200
      IF PARMMASK.(9:1) THEN   <<recsize specified>>                    22942100
         FILENO:=FOPEN (DESIG', FOPTIONS, AOPTIONS, RECSIZE,            22944000
                        ACTUAL'DEV', <<formmsg>>, <<userlabels>>,       22946000
                        BLOCKFACTOR, NUMBUFFERS, FILESIZE,              22948000
                        NUMEXTENTS, INITIALLOC)                         22950000
                                                                        22950001
      ELSE                     <<recsise not specified>>                22950010
         FILENO:=FOPEN (DESIG', FOPTIONS, AOPTIONS, ,                   22950020
                        ACTUAL'DEV', <<formmsg>>, <<userlabels>>,       22950030
                        BLOCKFACTOR, NUMBUFFERS, FILESIZE,              22950040
                        NUMEXTENTS, INITIALLOC)                         22950050
      IF PARMMASK.(9:1) THEN   <<recsize specified>>                    22954100
         FILENO:=FOPEN (DESIG', FOPTIONS, AOPTIONS, RECSIZE,            22956000
                        ACTUAL'DEV', <<formmsg>>, <<userlabels>>,       22958000
                        <<blockfactor>>, NUMBUFFERS, FILESIZE,          22960000
                        NUMEXTENTS, INITIALLOC)                         22962000
                                                                        22962010
      ELSE         <<recsize not specified>>                            22962100
         FILENO:=FOPEN (DESIG', FOPTIONS, AOPTIONS, ,                   22962200
                        ACTUAL'DEV', <<formmsg>>, <<userlabels>>,       22962300
                        <<blockfactor>>, NUMBUFFERS, FILESIZE,          22962400
                        NUMEXTENTS, INITIALLOC);                        22962500
                                                                        22962600
   MOVE DELIMS':=(%5, "!;,", %15, "-");          <<!INDIRECT>> <<S8716>>23550000
         MOVE DELIMS':=(%6, "!;, ", %15, "-");                 <<S8782>>23591000
                              CHAR'INX, DELIMS', -1)           <<S8716>>23664000
   IF (STD'WILD = 0) OR (DBSTORE'TOG) OR (DBRESTOR'TOG ) THEN  <<07699>>23716000
   IF DBRESTOR'TOG THEN                                        <<07699>>23794100
      MOVE MAINT'WORD := LOOK'LOCK',(FILE'PART'SIZE);          <<07699>>23794200
                           ERROR'CODE, CHAR'INX, DELIMS', -1)  <<S8716>>23824000
                                                               <<m8224>>25637000
         <<--------- PROGRESS parm ---------->>                <<m8224>>25637010
                                                               <<m8224>>25637020
      ELSE IF ILEN = 8 AND ITEMP = "PROGRESS" THEN             <<m8224>>25637030
         BEGIN                                                 <<m8224>>25637040
         ASSURE'STORING;                                       <<m8224>>25637050
         IF SEEN'PROGRESS THEN WARN (SR'PROGRESS'REDUNDENT);   <<m8224>>25637060
         SEEN'PROGRESS := TRUE;                                <<m8224>>25637070
                                                               <<m9104>>25637080
         STEPIT;                                               <<m9104>>25637090
                                                               <<m9104>>25637100
         IF ITEMP = "=" THEN                                   <<m9104>>25637110
            BEGIN                                              <<m9104>>25637120
                                                               <<m9104>>25637130
            IF STEPIT IS NUMBERv THEN                          <<m9104>>25637140
               PROGRESS'INTERVAL := 60D * DOUBLE (SUBCLASS)    <<m9104>>25637150
            ELSE                                               <<m9104>>25637160
               IF ICLASS IS DNUMBERv THEN                      <<m9104>>25637170
                  PROGRESS'INTERVAL := 60D * SUBCLASS'D        <<m9104>>25637180
            ELSE                                               <<m9104>>25637190
               IF ICLASS IS TOKENv THEN                        <<m9104>>25637200
                  IF SUBCLASS IS DNUMBERv THEN                 <<m9104>>25637210
                     ERR (SR'NUMBER'TOO'BIG)                   <<m9104>>25637220
                  ELSE IF SUBCLASS IS DNUMBERv THEN            <<m9104>>25637230
                     ERR (SR'DNUMBER'TOO'BIG)                  <<m9104>>25637240
                  ELSE                                         <<m9104>>25637250
                     ERR(SR'PROGRESS'INTERVAL'EXPECTED)        <<m9104>>25637260
            ELSE                                               <<m9104>>25637270
               ERR (SR'PROGRESS'INTERVAL'EXPECTED)             <<m9104>>25637280
                                                               <<m9104>>25637290
            END                                                <<m9104>>25637300
                                                               <<m9104>>25637301
         ELSE  <<no time interval, use default>>               <<m9104>>25637302
                                                               <<m9104>>25637303
            BEGIN                                              <<m9104>>25637304
            UNSTEPIT;                                          <<m9104>>25637305
            PROGRESS'INTERVAL := 60D;                          <<m9104>>25637306
            END                                                <<m9104>>25637307
                                                               <<m9104>>25637310
         END                                                   <<m9104>>25637320
            BEGIN                                                       26253031
            DISPLAY'3'TO'STANDARD (GBUF'(G'FILE'INX'),                  26253032
                GBUF'(G'GROUP'INX'), GBUF'(G'ACCT'INX'),                26253033
                CURR'TITLE', ERROR'CODE);                               26253034
            END;                                                        26253041
LOGICAL PROCEDURE READ'DISK (LDEV, ADDRESS, DST, BUFFER,       <<m7666>>26260000
                             LEN, IOB, ATTIO);                 <<m7666>>26261000
         VALUE   LDEV, ADDRESS, DST, BUFFER, LEN, ATTIO;       <<m7666>>26262000
         LOGICAL ATTIO;                                        <<m7666>>26265000
         OPTION PRIVILEGED, UNCALLABLE, VARIABLE;              <<m7666>>26268000
           the data segment.  If ATTIO is true, then use                26284000
           ATTACHIO instead of P'ATTACHIO.  This is done to             26284100
           read FLAB's so that we alway go through the disc             26284200
           caching code. >>                                             26284300
   LOGICAL                                                     <<m7666>>26304100
      PMAP = Q-4;                                              <<m7666>>26304200
   DEFINE                                                      <<m7666>>26304300
      ATTIO'SENT = PMAP.(15:1)#;                               <<m7666>>26304400
   IF ATTIO'SENT AND ATTIO THEN                                <<m7666>>26351000
      LOCAL'IOB:=ATTACHIO (                                    <<m7666>>26352000
                  1)     << request=blocked...wait til done>>  <<m7666>>26370000
   ELSE                                                        <<m7666>>26370100
      LOCAL'IOB :=P'ATTACHIO(LDEV,0,DST,BUFFER,ATTIO'READ,LEN, <<m7666>>26370200
                            A1,A2,1);                          <<m7666>>26370300
                          FILE'LABEL'SIZE, IOB,TRUE);          <<m7666>>26488000
   IF REL'DSIR AND GOT'DSIR AND DSIR'INFO <> 3 THEN            <<j9170>>26572000
   IF REL'FISIR AND GOT'FISIR AND FISIR'INFO <> 3 THEN         <<j9170>>26600000
      IF UPCASE THEN                                           <<07699>>27220000
$EDIT VOID=27226000                                            <<07699>>27220001
         BEGIN                                                 <<07699>>27221000
         IF ITEMP = "*" THEN         << a back reference >>    <<07699>>27222000
            MOVE COPY'ITEMP(1):=COPY'ITEMP(1) WHILE ANS, 1     <<07699>>27223000
         ELSE                                                  <<07699>>27224000
            MOVE COPY'ITEMP(0):=COPY'ITEMP(0) WHILE ANS, 1;    <<07699>>27225000
         END                                                   <<07699>>27226000
      ELSE                                                     <<07699>>27227000
         BEGIN                                                 <<07699>>27227100
         IF ITEMP = "*" THEN    << a back reference >>         <<07699>>27227200
            MOVE COPY'ITEMP(1):=COPY'ITEMP(1) WHILE AN, 1      <<07699>>27227300
         ELSE                                                  <<07699>>27227400
            MOVE COPY'ITEMP(0):=COPY'ITEMP(0) WHILE AN, 1;     <<07699>>27227500
         END;                                                  <<07699>>27227600
                                                               <<07699>>27313000
   IF ITEMP = "/" AND DBRESTOR'TOG THEN                        <<07699>>27313100
      UPCASE := FALSE  << We don't want to upcase the maint >> <<07699>>27313200
                       << word for a database as lowercase  >> <<07699>>27313300
                       << is significant.  My apologies for >> <<07699>>27313400
                       << making this a context dependant   >> <<07699>>27313500
                       << scanner.                          >> <<07699>>27313600
   ELSE                                                        <<07699>>27313700
      UPCASE := TRUE;                                          <<07699>>27313800
                                                               <<07699>>27313900
      FORMAL'NAME   (0:5),                                     <<j9342>>30128000
      INDIRECT'LEN:= 0,       <<length of indiect file name>>  <<m7523>>30151000
                                                               <<m7593>>30545000
            IF ITEMP = "." THEN  <<check for group name>>      <<m7593>>30545010
               BEGIN                                           <<m7593>>30545020
                                                               <<m7593>>30545030
               STEPIT;                                         <<m7593>>30545040
               STEPIT;                                         <<m7593>>30545050
                                                               <<m7593>>30545060
               IF ITEMP = "."  THEN <<skip acct. name>>        <<m7593>>30545070
                  BEGIN                                        <<m7593>>30545080
                                                               <<m7593>>30545090
                  STEPIT;                                      <<m7593>>30545100
                  STEPIT;                                      <<m7593>>30545110
                                                               <<m7593>>30545120
                  END;                                         <<m7593>>30545130
               END;                                            <<m7593>>30545140
                                                               <<m7593>>30545150
         S'R'STATUS:=STORINGV;                                 <<07699>>31398000
      ELSE IF ITEMP = "DBRESTOR" AND ILEN = 8 THEN             <<07699>>31400010
         BEGIN                                                 <<07699>>31400020
         IF USING'DRIVER THEN                                  <<07699>>31400030
                FAIL(SR'DBRESTOR'CALLED'BY'ALIEN);             <<07699>>31400040
         FATHERS'PIN := FATHER;                                <<07699>>31400050
         IF <> THEN FAIL(SR'DBRESTOR'CALLED'BY'ALIEN);         <<07699>>31400060
         PROCINFO(PARMS'TEMPI'1,PARMS'TEMPI'2,FATHERS'PIN,     <<07699>>31400070
                  10,FATHERS'NAME);                            <<07699>>31400080
         IF <> THEN FAIL(SR'CHECKING'FATHERS'NAME);            <<07699>>31400090
         IF FATHERS'NAME <> "DBRESTOR.PUB.SYS" THEN            <<07699>>31400100
                FAIL(SR'DBRESTOR'CALLED'BY'ALIEN);             <<07699>>31400110
         LOADPROC(DB'GET'R'NAME, 0, DB'GET'R'PLABEL);          <<07699>>31400111
         IF <> THEN                                            <<07699>>31400112
            FAIL(DB'NO'IMAGE);                                 <<07699>>31400113
         DBRESTOR'TOG  := TRUE;                                <<07699>>31400120
         IGNORE'PRIV'CHECK'FLAG := TRUE;                       <<07699>>31400130
         S'R'STATUS := RESTORINGV;                             <<07699>>31400140
         END                                                   <<07699>>31400150
                                                               <<07699>>31400160
      IF DBSTORE'TOG OR DBRESTOR'TOG  THEN                     <<07699>>31498000
$EDIT VOID=31604300                                            <<07345>>31604100
                                                               <<07345>>31634100
      IF NUM'RECORDS = 0D THEN                                 <<07345>>31634200
         NUM'RECORDS := G'NUM'FSIZE;                           <<07345>>31634300
      << open second good file if doing DBRESTOR >>            <<07699>>31664010
      IF DBRESTOR'TOG  THEN                                    <<07699>>31664020
         BEGIN                                                 <<07699>>31664030
         MOVE FORMAL'NAME := "GOOD2 ";                         <<07699>>31664040
         IF OPEN'FILE (G2'NUM,        << GOOD2 file number>>   <<07699>>31664050
                       FORMAL'NAME,                            <<07699>>31664060
                       %2000,      << same as G'NUM >>         <<07699>>31664070
                       %105,       << same as G'NUM >>         <<07699>>31664080
                       G'RECSIZE,  << %30 >>                   <<07699>>31664090
                       ,                                       <<07699>>31664100
                       16,                                     <<07699>>31664110
                       ,                                       <<07699>>31664120
                       MAX'DBRESTOR'RECS,                      <<07699>>31664130
                       1,          << # of extents  >>         <<07699>>31664140
                       G'NUM'EXTENTS) <<initial allocated>>    <<07699>>31664150
             = FAILED THEN                                     <<07699>>31664160
             FAIL (SR'G'NUM'ERROR);                            <<07699>>31664170
         END;    << end opening second good file >>            <<07699>>31664180
      IF SEEN'PROGRESS THEN                                    <<m8224>>31861010
         BEGIN                                                 <<m8224>>31861020
         IF MODE.INTERACTIVEbit THEN                           <<m8224>>31861030
            BEGIN                                              <<m8224>>31861040
                << open $stdlist in case syslist redirected >> <<m8224>>31861050
            MOVE FORMAL'NAME := "PROGRESS  ";                  <<m9342>>31861060
            IF OPEN'FILE (PROGRESS'NUM,                        <<m8224>>31861070
                          FORMAL'NAME,                         <<m8224>>31861080
                          %2514,                               <<m8224>>31861090
                          %2,                                  <<m8224>>31861100
                          -72)                                 <<m8224>>31861110
                 = FAILED THEN                                 <<m8224>>31861120
                 PROGRESS'NUM := SYSLIST'NUM;                  <<m8224>>31861130
            PROGRESS'TO'CONSOLE := FALSE;                      <<m8224>>31861140
            END                                                <<m8224>>31861150
         ELSE                                                  <<m8224>>31861160
            PROGRESS'TO'CONSOLE := TRUE;<<to console for jobs>><<m8224>>31861170
         END;                                                  <<m8224>>31861180
                                                               <<m8224>>31861190
      INDIRECT'LEN := ILEN;                                    <<m7523>>31932000
      CASE PARSE'NAME (ITEMP, ILEN) OF   << check file name >> <<m7523>>31936000
                                                               <<m7523>>31986010
         STEPIT;                                               <<m7523>>31986020
                                                               <<m7523>>31986030
         IF ITEMP = "." THEN                                   <<m7523>>31986040
            BEGIN                                              <<m7523>>31986050
            STEPIT;                                            <<m7523>>31986060
            INDIRECT'LEN := INDIRECT'LEN + ILEN + 1;           <<m7523>>31986070
                                                               <<m7523>>31986080
            CASE PARSE'NAME (ITEMP, ILEN) OF   << group name >><<m7523>>31986090
$EDIT VOID=31986180                                            <<m7523>>31986091
               BEGIN                                           <<m7523>>31986100
                                                               <<m7523>>31986110
               <<OK: (0) >>                                    <<m7523>>31986120
                  ;                                            <<m7523>>31986130
                                                               <<m7523>>31986140
               <<PN'NAME'TOO'LONG:  (1) >>                     <<m7523>>31986150
                  FAIL2 (SR'IND'NAME'TOO'LONG, ITEMP'OFFSET);  <<m7523>>31986160
                                                               <<m7523>>31986170
               <<PN'EMPTY'NAME:     (2) >>                     <<m7523>>31986180
                  FAIL2 (SR'IND'NAME'EXPECTED, ITEMP'OFFSET);  <<m7523>>31986190
                                                               <<m7523>>31986200
               <<PN'BACK'ILLEGAL:   (3) >> <<shouldnt happen>> <<m7523>>31986210
                  FAIL2 (SR'IND'SPECIAL'CHAR, ITEMP'OFFSET);   <<m7523>>31986220
                                                               <<m7523>>31986230
               <<PN'MUST'START'WITH'ALPHA: (4) >>              <<m7523>>31986240
                  FAIL2 (SR'IND'MUST'START'WITH'ALPHA,         <<m7523>>31986250
                         INTEGER((ITEMP'OFFSET)+1));           <<m7523>>31986260
                                                               <<m7523>>31986270
               <<PN'ILLEGAL'CHARACTER: (5) >>                  <<m7523>>31986280
                  FAIL2 (SR'IND'SPECIAL'CHAR, ITEMP'OFFSET);   <<m7523>>31986290
                                                               <<m7523>>31986300
               <<PN'WILDCARDS'ILLEGAL: (6) >>                  <<m7523>>31986310
                  FAIL2 (SR'IND'WILDCARDS, ITEMP'OFFSET)       <<m7523>>31986320
                                                               <<m7523>>31986330
               END;                                            <<m7523>>31986340
                                                               <<m7523>>31986350
             STEPIT;                                           <<m7523>>31986360
                                                               <<m7523>>31986370
             IF ITEMP = "." THEN                               <<m7523>>31986380
                BEGIN                                          <<m7523>>31986390
                STEPIT;                                        <<m7523>>31986400
                INDIRECT'LEN := INDIRECT'LEN + ILEN + 1;       <<m7523>>31986410
                                                               <<m7523>>31986420
                 CASE PARSE'NAME (ITEMP, ILEN) OF <<acct name>><<m7523>>31986430
                    BEGIN                                      <<m7523>>31986440
                                                               <<m7523>>31986450
                    <<OK: (0) >>                               <<m7523>>31986460
                       ;                                       <<m7523>>31986470
                                                               <<m7523>>31986480
                    <<PN'NAME'TOO'LONG:  (1) >>                <<m7523>>31986490
                      FAIL2(SR'IND'NAME'TOO'LONG,ITEMP'OFFSET);<<m7523>>31986500
                                                               <<m7523>>31986510
                    <<PN'EMPTY'NAME:     (2) >>                <<m7523>>31986520
                      FAIL2(SR'IND'NAME'EXPECTED,ITEMP'OFFSET);<<m7523>>31986530
                                                               <<m7523>>31986540
                    <<PN'BACK'ILLEGAL:   (3) >>                <<m7523>>31986550
                       FAIL2(SR'IND'SPECIAL'CHAR,ITEMP'OFFSET);<<m7523>>31986560
                                                               <<m7523>>31986570
                    <<PN'MUST'START'WITH'ALPHA: (4) >>         <<m7523>>31986580
                       FAIL2 (SR'IND'MUST'START'WITH'ALPHA,    <<m7523>>31986590
                              INTEGER((ITEMP'OFFSET)+1));      <<m7523>>31986600
                                                               <<m7523>>31986610
                    <<PN'ILLEGAL'CHARACTER: (5) >>             <<m7523>>31986620
                       FAIL2(SR'IND'SPECIAL'CHAR,ITEMP'OFFSET);<<m7523>>31986630
                                                               <<m7523>>31986640
                    <<PN'WILDCARDS'ILLEGAL: (6) >>             <<m7523>>31986650
                       FAIL2 (SR'IND'WILDCARDS, ITEMP'OFFSET)  <<m7523>>31986660
                                                               <<m7523>>31986670
                    END;                                       <<m7523>>31986680
                                                               <<m7523>>31986681
                 STEPIT;                                       <<m7523>>31986682
                                                               <<m7523>>31986683
                                                               <<m7523>>31986690
                END;                                           <<m7523>>31986700
                                                               <<m7523>>31986710
            END;                                               <<m7523>>31986720
                                                               <<m7523>>31986730
$EDIT VOID=32000000                                            <<m7523>>32000000
      MOVE INDIRECT'NAME' := PT, (INDIRECT'LEN);               <<m7523>>32004000
      IF ICLASS IS ENDLINEv OR ITEMP = ";" THEN                <<m7523>>32008000
                       %1302) <<WAIT,MULT,SHR,BUF,WRITE(SAVE)>><<m7926>>32152000
$EDIT VOID=32160000                                                     32154000
         AOPTIONS:=%101;                                       << 8584>>32284000
      ELSE IF DBSTORE'TOG OR DBRESTOR'TOG  THEN                <<07699>>32368000
                TAPE'RECSIZE, TAPE'DEVINFO);                   <<07043>>32420000
   << ----------------------------------------------- >>       <<r9434>>32424100
   << This fix was incorporated to support remote     >>       <<r9434>>32424110
   << stores issued from systems running on MPE4 versions >>   <<r9434>>32424120
   << earlier than VP-delta.  NOTE: this fix may be   >>       <<r9434>>32424130
   << obsoleted once Q-mit and VP die out!!.  To be   >>       <<r9434>>32424140
   << safe, get tape file info assuming system may be >>       <<r9434>>32424150
   << remote and running pre-VP-delta...              >>       <<r9434>>32424160
   << ----------------------------------------------- >>       <<r9434>>32424170
                                                               <<r9434>>32424180
  FFILEINFO(T'NUM, ITEM'MPE4'LDEV, TAPE'LDEV);                 <<r9434>>32424200
  IF <> THEN                                                   <<r9434>>32424300
     FAIL (RS'T'FGETINFO'FAIL)                                 <<r9434>>32424400
  ELSE IF TAPE'LDEV <> 0 THEN                                  <<r9434>>32424500
     BEGIN                                                     <<r9434>>32424600
     PARMS'TEMPI'1 := TAPE'LDEV.(0:8);                         <<r9434>>32424700
     TAPE'LDEV     := TAPE'LDEV.(8:8);                         <<r9434>>32424800
     END                                                       <<r9434>>32424900
  ELSE BEGIN                                                   <<r9434>>32425000
       << ------------------------------------- >>             <<r9434>>32425100
       << ldev must be > 255 , therefore must be>>             <<r9434>>32425200
       << VE or later system, in which case     >>             <<r9434>>32425300
       << issue normal call...                  >>             <<r9434>>32425400
       << ------------------------------------- >>             <<r9434>>32425410
       FFILEINFO(T'NUM, ITEM'LDEV, TAPE'LDEV,                  <<r9434>>32425420
                        ITEM'VIRT, PARMS'TEMPI'1);             <<r9434>>32425430
       IF <> THEN                                              <<r9434>>32425500
          FAIL (RS'T'FGETINFO'FAIL);                           <<r9434>>32425600
        END;                                                   <<r9434>>32425700
   VIRTDEV := (PARMS'TEMPI'1 <> 0);                            <<r9434>>32425800
               AND (TAPE'DEVINFO.SUBTYPEf = SUBTYPE'7974 OR    <<m7682>>32494000
                    TAPE'DEVINFO.SUBTYPEf = SUBTYPE'7976 OR    <<m7682>>32494500
                    TAPE'DEVINFO.SUBTYPEf = SUBTYPE'7978) THEN <<m7682>>32495000
               (TAPE'DEVINFO.TAPE'TYPEf = TYPE'7976 OR         <<m7682>>32624000
                TAPE'DEVINFO.TAPE'TYPEf = TYPE'7978 )  AND     <<m7682>>32625000
$EDIT VOID=32808000                                            <<j9107>>32808000
$EDIT VOID=32810000                                            <<j9107>>32810000
   IF SEEN'LOCAL OR SEEN'ACCT THEN                             <<j9107>>32814000
                                                               <<s9101>>33766000
      IF WHY =  0 THEN                                         <<09534>>33766010
         BEGIN                                                 <<09534>>33766020
         IF (FAILED'FILE'COUNT > 0D) THEN                               33766100
            WHY := WHY'FAILED;                                          33766200
         IF ((BAD'FILE'COUNT <> 0D) LAND (RESTORING)) OR                33767000
            ((FILES'REJECTED <> 0D) LAND (STORING)) THEN                33767100
            WHY := WHY'WRONG;                                           33767300
         END;                                                  <<09534>>33767310
                                                               <<s9101>>33767400
      IF (NOT SEEN'HIGH) AND (NOT SEEN'LOW) THEN                        34091000
         <<for root file and empty dataset>>                            34091100
         DBSTORE'HIGH := DBSTORE'LOW                                    34091200
      ELSE IF (NOT SEEN'HIGH) OR (NOT SEEN'LOW) THEN                    34092000
               DOUBLE (DBSTORE'HIGH - DBSTORE'LOW + 2)         <<09397>>34256000
               LAND DBSTORE'HIGH <> DBSTORE'LOW ) THEN         <<09397>>34257000
<< IF JCW'FLAG THEN  >>                                        <<s9101>>34358000
   IF SEEN'PROGRESS THEN                                       <<m8224>>41895000
      BEGIN                                                    <<m8224>>41895100
      DISABLE'ARITHMETIC'TRAPS;                                <<m8224>>41895200
      TOTAL'SECTOR'COUNT :=TOTAL'SECTOR'COUNT+FILE'SECTORS+1D; <<m8224>>41895300
      IF TOTAL'SECTOR'COUNT < 0D THEN  <<overflow>>            <<m8224>>41895400
         BEGIN                                                 <<m8224>>41895500
         TOTAL'SECTOR'COUNT := 0D;                             <<m8224>>41895600
         SEEN'PROGRESS := FALSE;                               <<m8224>>41895700
         END;                                                  <<m8224>>41895800
      ENABLE'ARITHMETIC'TRAPS;                                 <<m8224>>41895900
                                                               <<m8224>>41895901
      END;                                                     <<m8224>>41895902
                                                               <<m8224>>41895910
   IF NOT (LABELED LAND LAST'FILE) THEN                        <<m7492>>50379000
      IF WRITE'TAPE'MARK (PARMS'TEMPI'1) = FAILED THEN         <<m7492>>50380000
         FILE'FAIL  (T'NUM, SR'TAPE'WRITE'FAIL);               <<m7492>>50382000
      IF FKONTROL (T'NUM, REWIND'UNLOAD) = FAILED THEN         <<m9577>>50645100
         FAIL (SR'TAPE'REWIND'FAIL);                           <<m9577>>50645200
         IF OPERATOR'ABORT     OR                              <<r9434>>50768220
            DS'ERROR           OR                              <<r9434>>50768230
            ERROR'LEVEL > MAX'ERROR'LEVEL THEN                 <<r9434>>50768240
            << Note: this must be done because we cannot >>    <<r9434>>50768241
            << declare local labels in subroutines!!!    >>    <<r9434>>50768242
            BEGIN                                              <<r9434>>50768243
            DONT'DO'RECOVERY := TRUE;                          <<r9434>>50768244
            START'REEL       := FAILED;                        <<r9434>>50768245
            GO END'START'REEL;                                 <<r9434>>50768246
            END;                                               <<r9434>>50768247
      << -------------------------------------------- >>       <<r9434>>51330100
      << In case this is a remote store on a system   >>       <<r9434>>51330200
      << running MPE4 or earlier...                   >>       <<r9434>>51330300
      << -------------------------------------------- >>       <<r9434>>51330400
      FFILEINFO (T'NUM, ITEM'MPE4'LDEV, TAPE'LDEV);            <<r9434>>51331000
      IF <> THEN                                               <<r9434>>51331100
         FAIL(SR'TAPE'FGETINFO'FAIL, FALSE)                    <<r9434>>51331200
      ELSE IF TAPE'LDEV <> 0 THEN                              <<r9434>>51331300
              TAPE'LDEV := TAPE'LDEV.(8:8)                     <<r9434>>51331400
      ELSE BEGIN << must be 5E system or greater >>            <<r9434>>51331500
           FFILEINFO (T'NUM, ITEM'LDEV, TAPE'LDEV);            <<r9434>>51332000
           IF <> THEN                                          <<r9434>>51334000
           FAIL (SR'TAPE'FGETINFO'FAIL, FALSE);                <<r9434>>51336000
           END;                                                <<r9434>>51337000
      IF ERROR'CODE >= DS'COMM'ERROR THEN                      <<r9434>>51667000
         DS'ERROR := TRUE;                                     <<r9434>>51667100
   IF ERROR'CODE >= DS'COMM'ERROR THEN                         <<r9434>>51943000
      DS'ERROR := TRUE;                                        <<r9434>>51943100
   << --------------------------------------------------- >>   <<r9434>>51970151
   << If FCONTROL fails then make sure the tape ldev is   >>   <<r9434>>51970152
   << not a remote device before calling ATTACHIO...      >>   <<r9434>>51970153
   << otherwise an SF #206 will occur.                    >>   <<r9434>>51970154
   << -------------------------------------------------   >>   <<r9434>>51970155
   IF <> AND (NOT VIRTDEV) THEN                                <<r9434>>51970156
      << make sure tape rewinds only if local device ...>>     <<r9434>>51970157
      ATTACHIO (TAPE'LDEV, 0, 0, 0, ATTIO'REWIND'ON,0,0,0,1);  <<r9434>>51970158
$EDIT VOID=51970170                                            <<r9434>>51970170
         <<don't check them either for errors>>                <<r9434>>51970190
   IF <> AND (NOT VIRTDEV) THEN                                <<r9434>>51970285
      << make sure the tape unloads only if local device >>    <<r9434>>51970286
     ATTACHIO ( TAPE'LDEV, 0, 0, 0, ATTIO'REWIND, 0, 0, 0, 1); <<r9434>>51970287
   PARMS'TEMPI'1 := TAPE'LDEV;                                 <<r9434>>51970300
   << -------------------------------------------- >>          <<r9434>>51970301
   << WRITE'TAPE'MARK writes an EOF to tape.  If an>>          <<r9434>>51970302
   << error occurs, the error code is returned from>>          <<r9434>>51970303
   << FCHECK.  We report either software operator  >>          <<r9434>>51970304
   << aborts or DS errors in the case of remote    >>          <<r9434>>51970305
   << stores which will be checked by RECOVER'ERROR>>          <<r9434>>51970306
   << Note: if a DSERROR then we do not want to    >>          <<r9434>>51970307
   << print out the following messages...          >>          <<r9434>>51970308
   << -------------------------------------------- >>          <<r9434>>51970309
   IF LAST'TAPE'REEL <> TAPE'REEL                              <<r9434>>51970310
      THEN BEGIN                                               <<r9434>>51970311
           ERROR'LEVEL := 0;                                   <<r9434>>51970312
           LAST'TAPE'REEL := TAPE'REEL;                        <<r9434>>51970313
           END;                                                <<r9434>>51970314
   ERROR'LEVEL := ERROR'LEVEL + 1;                             <<r9434>>51970315
                                                               <<r9434>>51970316
   IF NOT DS'ERROR THEN                                        <<r9434>>51970317
      BEGIN                                                    <<r9434>>51970318
      SENDMESSAGE (SR'BAD'TAPE,,TRUE);                         <<r9434>>51970319
      SENDMESSAGE (SR'TAKE'IT'OFF,,TRUE);                      <<r9434>>51970320
      SENDMESSAGE (SR'NOT'PART'OF'TAPE'SET,,TRUE);             <<r9434>>51970330
      END;                                                     <<r9434>>51970331
      CUMULATIVE'SECTOR'COUNT := 0D,                           <<m8224>>52301000
      OLD'SECONDS := 0D,      <<used to compute progress  >>   <<j9103>>52312100
      SECONDS     := 0D,      <<used to compute progress  >>   <<j9103>>52312200
      TDBUF'SECTORS := 0D,                                              52320000
      OLD'HOUR    := 0,       <<used to compute progress  >>   <<j9103>>52384100
$EDIT VOID=52385000                                                     52385000
$EDIT VOID=52393000                                                     52393000
      TDBUF'OFFSET:= 0,       <<offset into tdbuf>>                     52395000
        unfreezing and unlocking prior to releasing.                    52506000
        We first call ABORTIO to ensure that the buffers                52506100
        are not I/O frozen.                              >>             52506200
$EDIT VOID=52513300                                                     52512100
                                                                        52592010
      << abort the pending I/O for the tape drive and >>                52592020
      << wait for the last I/O to complete prior to   >>                52592030
      << releasing the buffers.                       >>                52592040
                                                                        52592050
      IF USING'ATTIO THEN                                               52592060
         BEGIN                                                          52592070
                                                                        52592080
         DISABLE'ARITHMETIC'TRAPS;                                      52592090
                                                                        52592091
         ABORTIO (TAPE'LDEV);                                           52592100
                                                                        52592101
         CUR'INX := -1;                                                 52592102
         WHILE (CUR'INX := CUR'INX +1) < NUM'XDS DO                     52592110
            BEGIN                                                       52592111
                                                                        52592130
            IO'INX := FIRST'IO'INX(CUR'INX) - 1;                        52592140
            WHILE (IO'INX := IO'INX + 1) <= LAST'IO'INX(CUR'INX) DO     52592150
               BEGIN                                                    52592160
               IF IO'QUEUE'D (IO'INX) <> 0D THEN                        52592170
                  IOB := WAITFORIO (IO'QUEUE(IO'INX*2));                52592180
               END;                                                     52592190
            END;                                                        52592191
                                                                        52592200
         ENABLE'ARITHMETIC'TRAPS;                                       52592210
                                                                        52592220
         RELEASE'BUFFERS;                                               52597000
                                                                        52597100
         END;                                                           52597200
                                                               <<m8011>>52761100
      IF (TAPE'DEVINFO.SUBTYPEf = subtype'7978) AND            <<m8011>>52761200
         (NUMBANKS > SMALL'MEMORY'SYSTEM) AND                  <<m8011>>52761300
         (TAPE'DENSITY = 6250) THEN                            <<m8011>>52761400
          NUM'XDS := 6                                         <<j9050>>52761500
      ELSE                                                     <<j9050>>52761510
      IF  NUMBANKS <= VERY'SMALL'MEMORY'SYSTEM THEN            <<j9050>>52761520
          NUM'XDS := 2;                                        <<j9050>>52761530
$PAGE                                                          <<m8224>>53146010
   <<----------------------->>                                 <<m8224>>53146020
   <<   CHECK'PROGRESS      >>                                 <<m8224>>53146030
   <<----------------------->>                                 <<m8224>>53146040
                                                               <<m8224>>53146050
   SUBROUTINE CHECK'PROGRESS (READ'SIZE);                      <<m8224>>53146060
   DOUBLE READ'SIZE;                                           <<m8224>>53146061
                                                               <<m8224>>53146070
      <<This routine we check whether "time'interval" seconds           53146080
        has elasped since the last progress message was printed         53146090
        If so then compute the % complete and send the message.         53146100
        We also acumulate the total sectors stored so far.    >>        53146110
                                                               <<m8224>>53146120
       BEGIN                                                   <<m8224>>53146130
                                                               <<m8224>>53146140
       CUMULATIVE'SECTOR'COUNT := CUMULATIVE'SECTOR'COUNT +    <<m8224>>53146150
                                  READ'SIZE;                   <<m8224>>53146160
                                                               <<m8224>>53146170
       TIME := CLOCK;                                          <<m8224>>53146180
       IF  HOUR < OLD'HOUR THEN                                <<j9103>>53146181
           HOUR     := HOUR + 24;                              <<j9103>>53146182
       SECONDS := DOUBLE(SECOND);                              <<j9103>>53146183
       SECONDS := SECONDS + DOUBLE(MINUTE) * 60D;              <<j9103>>53146184
       SECONDS := SECONDS + DOUBLE(HOUR) * 3600D;              <<j9103>>53146185
$EDIT VOID=53146190                                                     53146190
$EDIT VOID=53146200                                                     53146200
                                                               <<m8224>>53146210
$EDIT VOID=53146220                                                     53146220
       IF  OLD'SECONDS = 0D THEN OLD'SECONDS := SECONDS;       <<j9103>>53146221
                                                               <<m8224>>53146230
$EDIT VOID=53146240                                                     53146240
       IF SECONDS - OLD'SECONDS > PROGRESS'INTERVAL THEN       <<j9103>>53146241
          BEGIN                                                <<m8224>>53146250
                                                               <<m8224>>53146260
          PARMS'TEMPI'1:=100-INTEGER(100D*(TOTAL'SECTOR'COUNT  <<m8224>>53146270
            - CUMULATIVE'SECTOR'COUNT) / TOTAL'SECTOR'COUNT);  <<m8224>>53146271
          IF PARMS'TEMPI'1 <> 100 THEN                         <<m8224>>53146290
              IF PROGRESS'TO'CONSOLE THEN                      <<m8224>>53146291
                  SENDMESSAGE (M'PROGRESS, FALSE, TRUE)        <<m8224>>53146292
              ELSE                                             <<m8224>>53146293
                  SENDMESSAGE (M'PROGRESS);                    <<m8224>>53146295
                                                                        53146296
          IF  HOUR < 24 THEN                                   <<J9103>>53146297
              BEGIN                                            <<j9103>>53146298
              OLD'HOUR := HOUR;                                <<j9103>>53146299
              OLD'SECONDS := SECONDS;                          <<j9103>>53146300
              END                                              <<j9103>>53146302
          ELSE                                                 <<j9103>>53146303
              BEGIN                                            <<j9103>>53146304
              OLD'HOUR := HOUR - 24;                           <<j9103>>53146305
              OLD'SECONDS := SECONDS - 24D * 3600D;            <<j9103>>53146306
              END;                                             <<j9103>>53146307
                                                               <<m8224>>53146310
          END;                                                 <<m8224>>53146320
                                                               <<m8224>>53146330
       END;                                                    <<m8224>>53146340
                                                               <<m7927>>53181000
      DISABLE'ARITHMETIC'TRAPS;                                <<m7927>>53181100
                                                               <<m7927>>53365000
      ENABLE'ARITHMETIC'TRAPS;                                 <<m7927>>53365100
      IF TAPE'SDISC'TOG THEN                                            53862000
         TDBUF'SECTORS := DOUBLE (SDISC'BUFFSIZE/128)                   53863000
      ELSE                                                              53863100
         TDBUF'SECTORS := DOUBLE (TAPE'RECSIZE/128);                    53863200
                                                                        53863300
      IF DS'ERROR THEN                                         <<r9434>>54125000
         FAIL (SR'DS'COMM'ERROR );                             <<r9434>>54125100
      << ----------------------------------------------- >>    <<r9434>>54234100
      << The procedure MARK'REEL'BAD tries to rewind the >>    <<r9434>>54234200
      << the current reel and "mark" the tape "bad".  In >>    <<r9434>>54234300
      << the case of the GOTO below, we may want to check>>    <<r9434>>54234400
      << for operator abort or a DS failure which may    >>    <<r9434>>54234500
      << occur, else we keep looping forever printing    >>    <<r9434>>54234600
      << out the messages at the end of the procedure... >>    <<r9434>>54234700
      << ----------------------------------------------- >>    <<r9434>>54234800
                                                               <<r9434>>54234900
      IF OPERATOR'ABORT THEN                                   <<r9434>>54235000
         FAIL(SR'OPERATOR'ABORT);                              <<r9434>>54235100
      IF DS'ERROR THEN                                         <<r9434>>54235200
         FAIL(SR'DS'COMM'ERROR );                              <<r9434>>54235300
      IF ERROR'LEVEL > MAX'ERROR'LEVEL THEN                    <<r9434>>54235400
         FAIL(RS'ERROR'LEVEL'TOO'DEEP);                        <<r9434>>54235500
$EDIT VOID=54250600                                                     54250100
      FIRST'REEL:=TAPE'REEL;                                            54762000
               SECTORS'THIS'READ:=TDBUF'SECTORS                         55046000
                  BEGIN                                        <<j9261>>55118100
                  CHECK'IO'STATUS (WAIT'ALL);                  <<j9261>>55118200
                  END;                                         <<j9261>>55120100
                                                               <<m8860>>55125000
               << rember the reel # the file started on >>     <<m8860>>55125100
               FIRST'REEL := TAPE'REEL;                        <<m8860>>55125200
            IF SEEN'PROGRESS THEN CHECK'PROGRESS (             <<m8224>>55153000
                                          SECTORS'THIS'READ ); <<m8224>>55153100
                                                               <<m8224>>55153200
            IF SECTORS'FILLED >= TDBUF'SECTORS                          55310000
               ELSE                                                     55346000
                  BEGIN  <<empty the now full tdbuf>>                   55346010
                  TDBUF'OFFSET := 0;                                    55346020
                  WHILE (SECTORS'FILLED:=SECTORS'FILLED -               55346030
                         DOUBLE (TAPE'RECSIZE/128)) >= 0D DO            55346040
                     BEGIN                                              55346050
                     IF WRITE'TAPE (TAPE'RECSIZE,                       55346060
                                    TDBUF (TDBUF'OFFSET),               55346070
                                    FALSE,                              55346080
                                    TDBUF,                              55346090
                                    (FILE'SECTORS'LEFT = 0D LAND        55346100
                                     EXTENT'SECTORS'LEFT=0D LAND        55346110
                                     SECTORS'FILLED = 0D ))             55346120
                        = FAILED THEN                                   55346130
                          RECOVER'ERROR (SR'TAPE'WRITE'FAIL);           55346140
$EDIT VOID=55346170                                                     55346150
                     TDBUF'OFFSET :=TDBUF'OFFSET+TAPE'RECSIZE;          55348000
$EDIT VOID=55352000                                                     55348001
                     END;                                               55350000
                  END; <<tdbuf is now completely empty>>                55352000
                                                                        55468000
$EDIT VOID=55476000                                                     55472000
                                                                        55472010
         TDBUF'OFFSET := 0;                                             55472020
         LEN := INTEGER (SECTORS'FILLED);                               55472021
         WHILE (LEN := LEN - TAPE'RECSIZE/128) >= 0 DO                  55472030
            BEGIN  <<empty the tdbuf>>                                  55472050
            IF WRITE'TAPE (TAPE'RECSIZE, TDBUF(TDBUF'OFFSET),           55472060
                           FALSE, TDBUF, SECTORS'FILLED=0D)             55472070
                = FAILED THEN                                           55472080
                  RECOVER'ERROR (SR'TAPE'WRITE'FAIL);                   55472090
            TDBUF'OFFSET := TDBUF'OFFSET + TAPE'RECSIZE;                55472100
            SECTORS'FILLED := SECTORS'FILLED -                 <<m9018>>55472101
                              DOUBLE (TAPE'RECSIZE/128);       <<m9018>>55472102
            END;                                                        55472110
         IF SECTORS'FILLED > 0D  THEN <<partial recsize remains>>       55472120
            IF WRITE'TAPE (LOGICAL (SECTORS'FILLED) * 128,              55472130
                           TDBUF (TDBUF'OFFSET), FALSE,                 55472140
                           TDBUF, TRUE)                                 55472150
                = FAILED THEN                                           55472160
                   RECOVER'ERROR (SR'TAPE'WRITE'FAIL);                  55474000
                                                                        55476000
         END                                                   <<m7492>>55569000
         ELSE                                                  <<m7492>>55569100
         BEGIN       << last'file >>                           <<m7492>>55569110
         DISABLE'ARITHMETIC'TRAPS;                             <<m7492>>55569120
         IF LDIRECTF (T'NUM) OR NEED'DIRECTORY THEN            <<m7492>>55569130
            BEGIN       << write directory on reel switch >>   <<m7492>>55569140
            IF NEXTTAPEFILE(T'NUM) <> 0 THEN                   <<m7492>>55569150
               FILE'FAIL (T'NUM, SR'CANT'REOPEN'TAPE);         <<m7492>>55569160
            IF DIREC'TO'TAPE (TDBUF) = FAILED THEN             <<m7492>>55569170
               FILE'FAIL (T'NUM, ERROR'CODE);                  <<m7492>>55569180
            END;                                               <<m7492>>55569190
         ENABLE'ARITHMETIC'TRAPS;                              <<m7492>>55569200
         END;                                                  <<m7492>>55569210
                                                               <<m7492>>55569220
   IF FINISH'REEL(TDBUF,TRUE)=FAILED THEN <<end of final reel>><<m9577>>55920000
      FAIL (0); <<msg already printed >>                       <<m9577>>55921000
      BEGIN                                                    <<m9577>>55925000
      IF FKONTROL (T'NUM, REWIND'UNLOAD) = FAILED THEN         <<m9577>>55925100
         FAIL (SR'TAPE'REWIND'FAIL);                           <<m9577>>55925200
      END;                                                     <<m9577>>55927000
             LOR (LOGON'GROUP'<>LOOK'GROUP',(FILE'PART'SIZE))  <<s9506>>60165100
$EDIT VOID=60305000                                                     60305000
$EDIT VOID=60312000                                                     60312000
               BEGIN                                           <<m7665>>60524000
               NEXTTAPEFILE(T'NUM);                            <<m7665>>60525000
               IF < THEN                                       <<m7665>>60525100
                  FILE'FAIL (T'NUM, RS'T'READ'DIR'FAIL);       <<m7665>>60525200
                                                               <<m7665>>60525300
               << If this is the last reel of the volume set,>><<m7665>>60525400
               << there may be no file after the directory.  >><<m7665>>60525500
               << However, the first reel should have at     >><<m7665>>60525600
               << least one data file following it.          >><<m7665>>60525700
               IF > AND TL'REELNUM = 1 THEN                    <<m7665>>60525800
                  FILE'FAIL (T'NUM, RS'T'READ'DIR'FAIL);       <<m7665>>60525900
               END;                                            <<m7665>>60525910
$TITLE "[RESTORE]  DB'IRESTORE -- list of db files to restore" <<07699>>60632005
$PAGE                                                          <<07699>>60632010
<<**********************************************************>> <<07699>>60632015
$CONTROL SEGMENT=IRESTORE                                      <<07699>>60632020
LOGICAL PROCEDURE DB'IRESTORE( GOOD'FNUM,                      <<07699>>60632025
                               ROOT'FNAME);                    <<07699>>60632030
                                                               <<07699>>60632045
INTEGER GOOD'FNUM;                                             <<07699>>60632055
BYTE ARRAY ROOT'FNAME;                                         <<07699>>60632060
                                                               <<07699>>60632065
<< DB'IRESTORE will build a good file containing only those >> <<07699>>60632070
<< files associated with a root file, this file can then    >> <<07699>>60632075
<< be used to restore all files associated with an IMAGE    >> <<07699>>60632080
<< database.                                                >> <<07699>>60632085
<<                                                          >> <<07699>>60632090
<< RETURNS: GOOD if and only if DB'IRESTORE succeeded       >> <<07699>>60632095
<< PARAMETERS: GOOD'FNUM  (file modified) - File number of  >> <<07699>>60632100
<<                good file to be built                     >> <<07699>>60632105
<<             ROOT'FNAME (unchanged) - File name, group    >> <<07699>>60632110
<<                name, and account name of the root file   >> <<07699>>60632115
<<                of a database in STANDARD format (ie:     >> <<07699>>60632120
<<                FILENAME GROUPNAME ACCOUNTNAME with each  >> <<07699>>60632125
<<                name padded with blanks to make 8 chars   >> <<07699>>60632130
<<                                                          >> <<07699>>60632185
<< GLOBALS: The directory file is accessed globally         >> <<07699>>60632190
<<          DB'RESTOR'LOW (changed) - The low parameter is  >> <<07699>>60632195
<<             stored in this variable for pattern matching >> <<07699>>60632200
<<             purposes                                     >> <<07699>>60632205
<<          DB'RESTOR'HIGH (changed) - The high parameter is>> <<07699>>60632210
<<             stored in this variable for pattern matching >> <<07699>>60632215
<<             purposes                                     >> <<07699>>60632220
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> <<07699>>60632225
                                                               <<07699>>60632230
                                                               <<07699>>60632235
BEGIN  << DB'IRESTORE >>                                       <<07699>>60632240
                                                               <<07699>>60632245
INTEGER DB'FILES;             << number of db files found   >> <<07699>>60632255
LOGICAL NO'MORE'DIREC;        << signals eof on direc file  >> <<07699>>60632260
DOUBLE  NUM'FILES;            << number of files on tape    >> <<07699>>60632265
INTEGER ERROR'CODE;           << error from pattern match   >> <<07699>>60632270
LOGICAL ARRAY PAT'FNAME(0 : 3 * FILE'PART'WORDS);              <<07699>>60632275
BYTE ARRAY PAT'FNAME'(*) = PAT'FNAME;                          <<07699>>60632280
                              << holds pattern for pattern  >> <<07699>>60632285
                              << matching >>                   <<07699>>60632290
BYTE POINTER FIRST'BLANK;     << location of first blank in >> <<07699>>60632295
                              << root file name             >> <<07699>>60632300
INTEGER ROOT'FNAME'LEN;       << length of root file name   >> <<07699>>60632305
                                                               <<07699>>60632310
LOGICAL ARRAY STD'TITLE(0:MAX'STD'LEN);                        <<07699>>60632315
LOGICAL ARRAY F'PAT(0:MAX'PAT'LEN);                            <<07699>>60632316
LOGICAL ARRAY G'PAT(0:MAX'PAT'LEN);                            <<07699>>60632317
LOGICAL ARRAY A'PAT(0:MAX'PAT'LEN);                            <<07699>>60632318
                                                               <<07699>>60632330
DEFINE                                                         <<07699>>60632335
   D'FNAME = D'REC'BUF(0)#,                                    <<07699>>60632340
   D'GNAME = D'REC'BUF(FILE'PART'WORDS)#,                      <<07699>>60632345
   D'ACCTNAME = D'REC'BUF(FILE'PART'WORDS * 2)#;               <<07699>>60632350
                                                               <<07699>>60632355
<< The following variables support deblocking dir file      >> <<07699>>60632360
                                                               <<07699>>60632365
LOGICAL ARRAY DIR'BUF(0:D'BLOCKSIZE - 1);                      <<07699>>60632370
                              << block buffer for d' file   >> <<07699>>60632375
LOGICAL POINTER BLK'PTR;      << points to next record      >> <<07699>>60632380
INTEGER PARTIAL'SIZE;         << len of partial rec in buff >> <<07699>>60632385
LOGICAL ARRAY D'REC'BUF(0:D'RECSIZE - 1);                      <<07699>>60632390
                              << holds current d' record    >> <<07699>>60632395
BYTE ARRAY DIREC'BUF'FNAME(*) = D'REC'BUF;                     <<07699>>60632396
                              << Points to file name in buf >> <<07699>>60632397
                                                               <<07699>>60632400
<< The following variables support good file handline       >> <<07699>>60632405
                                                               <<07699>>60632410
INTEGER ARRAY GOOD'BUF(0:G'RECSIZE);                           <<07699>>60632415
DOUBLE ARRAY  GOOD'BUF'D(*) = GOOD'BUF;                        <<07699>>60632420
INTEGER ARRAY COMPARE'BUF(0:G'RECSIZE);                        <<07699>>60632425
                                                               <<07699>>60632430
<<------------------------->>                                  <<07699>>60632435
<< FAIL                    >>                                  <<07699>>60632440
<<------------------------->>                                  <<07699>>60632445
                                                               <<07699>>60632450
SUBROUTINE FAIL(ERR);                                          <<07699>>60632455
           VALUE ERR;                                          <<07699>>60632460
           INTEGER ERR;                                        <<07699>>60632465
<< Fails the procedure DB'IRESTORE                         >>  <<07699>>60632470
BEGIN                                                          <<07699>>60632475
                                                               <<07699>>60632480
IF ERR <> 0 THEN                                               <<07699>>60632495
   SENDMESSAGE (ERR);                                          <<07699>>60632500
                                                               <<07699>>60632505
DB'IRESTORE := FAILED;                                         <<07699>>60632520
                                                               <<07699>>60632525
GO END'DB'IRESTORE;                                            <<07699>>60632530
                                                               <<07699>>60632535
END << FAIL >>;                                                <<07699>>60632540
                                                               <<07699>>60632545
<<--------------------------->>                                <<07699>>60632550
<<  GET'DIRECTORY'RECORD     >>                                <<07699>>60632555
<<--------------------------->>                                <<07699>>60632560
                                                               <<07699>>60632565
SUBROUTINE GET'DIRECTORY'RECORD;                               <<07699>>60632570
<< Gets the next directory record from the directory file >>   <<07699>>60632575
<< This procedure must unblock the records and set the    >>   <<07699>>60632580
<< pointer DIREC'BUF'FNAME.  It must also increment the   >>   <<07699>>60632585
<< number of directory records read.                      >>   <<07699>>60632590
BEGIN                                                          <<07699>>60632595
IF (@BLK'PTR + D'RECSIZE) > (@DIR'BUF + D'BLOCKSIZE) THEN      <<07699>>60632600
   BEGIN   << the next record is not completely in this blk >> <<07699>>60632605
   PARTIAL'SIZE := D'BLOCKSIZE - (@BLK'PTR - @DIR'BUF);        <<07699>>60632610
   MOVE D'REC'BUF := BLK'PTR,(PARTIAL'SIZE);                   <<07699>>60632615
                        << move what is there, if any       >> <<07699>>60632620
   FREAD(D'NUM, DIR'BUF, D'BLOCKSIZE);                         <<07699>>60632625
   IF < THEN FAIL(RS'D'FILE'ERROR);                            <<07699>>60632630
   IF > THEN NO'MORE'DIREC := TRUE;                            <<07699>>60632635
   MOVE D'REC'BUF(PARTIAL'SIZE) := DIR'BUF,                    <<07699>>60632640
                                    (D'RECSIZE-PARTIAL'SIZE);  <<07699>>60632645
   @BLK'PTR := @DIR'BUF - PARTIAL'SIZE + D'RECSIZE;            <<07699>>60632650
   END                                                         <<07699>>60632655
ELSE                                                           <<07699>>60632660
   BEGIN  << record is in buffer >>                            <<07699>>60632665
   MOVE D'REC'BUF := BLK'PTR,(D'RECSIZE);                      <<07699>>60632670
   @BLK'PTR := @BLK'PTR + D'RECSIZE;                           <<07699>>60632675
   END;                                                        <<07699>>60632680
IF NOT NO'MORE'DIREC THEN                                      <<07699>>60632685
   NUM'FILES := NUM'FILES + 1D;                                <<07699>>60632690
END;  << GET'DIRECTORY'RECORD >>                               <<07699>>60632695
                                                               <<07699>>60632700
$PAGE                                                          <<07699>>60632705
<<------------------------->>                                  <<07699>>60632710
<<  INITIALIZE'DB'IRESTORE >>                                  <<07699>>60632715
<<------------------------->>                                  <<07699>>60632720
                                                               <<07699>>60632725
SUBROUTINE INITIALIZE'DB'IRESTORE;                             <<07699>>60632730
<< Initialize all DB'IRESTORE variables                   >>   <<07699>>60632735
BEGIN                                                          <<07699>>60632740
DB'IRESTORE := TRUE;                                           <<07699>>60632745
NO'MORE'DIREC := FALSE;                                        <<07699>>60632750
FPOINT(D'NUM, 0D); << reset directory file to zero        >>   <<07699>>60632755
@BLK'PTR := @DIR'BUF + D'BLOCKSIZE; << force FREAD of d'  >>   <<07699>>60632765
NUM'FILES := -1D;                                              <<07699>>60632770
<< Now initialize pattern matching by setting up pattern  >>   <<07699>>60632775
MOVE PAT'FNAME' := ROOT'FNAME, (FILE'PART'SIZE * 3);           <<07699>>60632780
SCAN PAT'FNAME' UNTIL "  ",1;                                  <<07699>>60632785
@FIRST'BLANK := TOS;                                           <<07699>>60632790
ROOT'FNAME'LEN := @FIRST'BLANK - @PAT'FNAME';                  <<07699>>60632795
IF ROOT'FNAME'LEN > 6 THEN FAIL(DB'FNAME'LONG);                <<07699>>60632800
PAT'FNAME'(ROOT'FNAME'LEN) := "#";                             <<07699>>60632805
PAT'FNAME'(ROOT'FNAME'LEN + 1) := "#";                         <<07699>>60632810
IF DISPLAY'3'TO'STANDARD(PAT'FNAME',PAT'FNAME'(FILE'PART'SIZE),<<07699>>60632811
                         PAT'FNAME'(FILE'PART'SIZE * 2),       <<07699>>60632812
                         STD'TITLE, ERROR'CODE) = FAILED THEN  <<07699>>60632813
   FAIL(SR'D'2'S'FAILED);                                      <<07699>>60632814
                                                               <<07699>>60632815
IF PATTERN'BUILD'STANDARD(STD'TITLE, F'PAT, G'PAT, A'PAT,      <<07699>>60632816
                          ERROR'CODE) = FAILED THEN            <<07699>>60632817
   FAIL(SR'RESTORE'PATTERN'ERROR);                             <<07699>>60632818
END  << INITIALIZE'DB'IRESTORE >>;                             <<07699>>60632819
$PAGE                                                          <<07699>>60632820
<<------------------------->>                                  <<07699>>60632825
<<  MATCHED                >>                                  <<07699>>60632830
<<------------------------->>                                  <<07699>>60632835
                                                               <<07699>>60632840
LOGICAL SUBROUTINE MATCHED;                                    <<07699>>60632845
<< Checks to see if DIREC'BUF'FNAME matches a database name >> <<07699>>60632850
<< MATCHED is true iff the current d'record is part of the  >> <<07699>>60632855
<< database.                                                >> <<07699>>60632860
BEGIN                                                          <<07699>>60632865
IF PATTERN'3'MATCH(D'FNAME, D'GNAME, D'ACCTNAME, F'PAT,        <<07699>>60632870
                   G'PAT, A'PAT, ERROR'CODE)                   <<07699>>60632875
                             = GOOD THEN                       <<07699>>60632880
   << Matched pattern setup in initialize'dbirestore >>        <<07699>>60632885
   MATCHED := TRUE                                             <<07699>>60632890
ELSE MATCHED := FALSE;                                         <<07699>>60632895
END << MATCHED >>;                                             <<07699>>60632900
                                                               <<07699>>60632905
<<------------------------->>                                  <<07699>>60632910
<<  ADD'TO'GOOD            >>                                  <<07699>>60632915
<<------------------------->>                                  <<07699>>60632920
                                                               <<07699>>60632925
SUBROUTINE ADD'TO'GOOD;                                        <<07699>>60632930
<< Adds the file pointed to by DIREC'BUF'FNAME to good file >> <<07699>>60632935
BEGIN                                                          <<07699>>60632940
FILL(GOOD'BUF, G'RECSIZE, 0);                                  <<07699>>60632945
GOOD'BUF'D(G'FILENUM'INX'D) := NUM'FILES;                      <<07699>>60632950
GOOD'BUF'D(G'ADDRESS'INX'D) := FILE'ADDRESS;                   <<07699>>60632955
GOOD'BUF  (G'LDEV'INX)      := FILE'LDEV;                      <<07699>>60632960
MOVE GOOD'BUF(G'TITLE'INX)  := D'REC'BUF,                      <<07699>>60632965
                                     (FILE'PART'WORDS * 3);    <<07699>>60632970
FWRITE (GOOD'FNUM, GOOD'BUF, G'RECSIZE, 0);                    <<07699>>60632975
                                                               <<07699>>60632980
IF < THEN                                                      <<07699>>60632985
   FAIL(SR'G'NUM'ERROR)                                        <<07699>>60632990
ELSE IF > THEN                                                 <<07699>>60632995
   FAIL(RS'GOOD'FILE'FULL);                                    <<07699>>60633000
                                                               <<07699>>60633005
END << ADD'TO'GOOD >>;                                         <<07699>>60633010
$PAGE                                                          <<07699>>60633015
<<------------------------->>                                  <<07699>>60633020
<< DB'IRESTORE OUTER BLOCK >>                                  <<07699>>60633025
<<------------------------->>                                  <<07699>>60633030
                                                               <<07699>>60633035
INITIALIZE'DB'IRESTORE;                                        <<07699>>60633040
                                                               <<07699>>60633050
IF (DB'RESTOR'HIGH = DB'RESTOR'LOW) AND (DB'RESTOR'HIGH = 0) THEN       60633051
   GO TO END'DB'IRESTORE;  <<root only, no data files to restore>>      60633052
DO      << skip up to root file >>                             <<07699>>60633055
   GET'DIRECTORY'RECORD                                        <<07699>>60633060
UNTIL DIREC'BUF'FNAME = ROOT'FNAME, (FILE'PART'SIZE*3);        <<07699>>60633065
                                                               <<07699>>60633070
DB'FILES := -1; << set number of database files to 0 >>        <<07699>>60633075
DO      << search for all directory components       >>        <<07699>>60633080
   BEGIN                                                       <<07699>>60633081
   GET'DIRECTORY'RECORD;                                       <<07699>>60633085
   IF MATCHED THEN                                             <<07699>>60633090
      BEGIN                                                    <<07699>>60633095
      ADD'TO'GOOD;                                             <<07699>>60633100
      DB'FILES := DB'FILES + 1;                                <<07699>>60633105
      END;                                                     <<07699>>60633110
   END                                                         <<07699>>60633111
UNTIL NO'MORE'DIREC OR                                         <<07699>>60633115
        (DB'FILES = DB'RESTOR'HIGH - DB'RESTOR'LOW);           <<07699>>60633116
                                                               <<07699>>60633120
IF DB'FILES <> DB'RESTOR'HIGH - DB'RESTOR'LOW THEN             <<07699>>60633125
   FAIL(DB'MISSING'FILE);                                      <<07699>>60633130
                                                               <<07699>>60633185
END'DB'IRESTORE:                                               <<07699>>60633190
                                                               <<07699>>60633195
END << proc DB'IRESTORE >>;                                    <<07699>>60633200
$TITLE "[RESTORE] GET'NEXT'VOLUME --- get correct continuation"<<07699>>60633205
$PAGE                                                          <<07699>>60633210
   << ----------------------------------------------- >>       <<r9434>>60696100
   << In case running a remote store on a system      >>       <<r9434>>60696200
   << running MPE4 or earlier ...                     >>       <<r9434>>60696300
   << ----------------------------------------------- >>       <<r9434>>60696400
   FFILEINFO(T'NUM, ITEM'MPE4'LDEV, TAPE'LDEV);                <<r9434>>60696500
   IF <> THEN                                                  <<r9434>>60696600
      FAIL(RS'T'FGETINFO'FAIL)                                 <<r9434>>60696700
   ELSE IF TAPE'LDEV <> 0 THEN                                 <<r9434>>60696800
           TAPE'LDEV := TAPE'LDEV.(8:8)                        <<r9434>>60696900
   ELSE BEGIN  << must be a 5E system or later >>              <<r9434>>60696910
        FFILEINFO (T'NUM, ITEM'LDEV, TAPE'LDEV);               <<r9434>>60697000
        IF <> THEN                                             <<r9434>>60698000
           FAIL (RS'T'FGETINFO'FAIL);                          <<r9434>>60699000
        END;                                                   <<r9434>>60699100
      BEGIN                                                    <<m9012>>60711100
      IF USING'ATTIO THEN                                      <<m9012>>60711200
         BEGIN                                                 <<m9012>>60711300
         << reset drivers consecutive eof detection >>         <<m9012>>60711400
         << for eofs found at the beginining of reels>>        <<m9012>>60711500
         ISSUE'CTRL (ATTIO'2'EOF);                             <<m9012>>60711600
         END;                                                  <<m9012>>60711700
                                                               <<m9012>>60711800
      END;                                                     <<m9012>>60712100
      BEGIN                                                    <<m9012>>60714100
      IF USING'ATTIO THEN                                      <<m9012>>60714200
         BEGIN                                                 <<m9012>>60714300
         << reset drivers consecutive eof detection >>         <<m9012>>60714400
         << for eofs found at the beginining of reels>>        <<m9012>>60714500
         ISSUE'CTRL (ATTIO'2'EOF);                             <<m9012>>60714600
         END;                                                  <<m9012>>60714700
                                                               <<m9012>>60714800
      END;                                                     <<m9012>>60715100
    IF TL'SPANTOG = 0 THEN                                     <<09471>>60757100
       DISTANCE := DISTANCE - 1D;                              <<09471>>60757200
   FGETINFO (T'NUM, , TAPE'FOPTIONS, TAPE'AOPTIONS);           <<07043>>60823000
   << ------------------------------------------------ >>      <<r9434>>60825020
   << In case running a remote store on a system       >>      <<r9434>>60825040
   << running MPE4 or earlier ...                      >>      <<r9434>>60825060
   << ------------------------------------------------ >>      <<r9434>>60825080
   FFILEINFO (T'NUM, ITEM'MPE4'LDEV, TAPE'LDEV);               <<r9434>>60825100
   IF <> THEN                                                  <<07043>>60825200
      FAIL (RS'T'FGETINFO'FAIL)                                <<r9434>>60825300
   ELSE IF TAPE'LDEV <> 0 THEN                                 <<r9434>>60825400
           TAPE'LDEV := TAPE'LDEV.(8:8)                        <<r9434>>60825500
   ELSE BEGIN                                                  <<r9434>>60825600
        << must be a 5E system or later >>                     <<r9434>>60825700
        FFILEINFO(T'NUM, ITEM'LDEV, TAPE'LDEV);                <<r9434>>60825800
        IF <> THEN                                             <<r9434>>60825900
           FAIL (RS'T'FGETINFO'FAIL);                          <<r9434>>60825910
        END;                                                   <<r9434>>60825920
   FGETINFO (T'NUM, , TAPE'FOPTIONS, TAPE'AOPTIONS);           <<07043>>60954000
   << ------------------------------------------------ >>      <<r9434>>60956020
   << In case running a remote store on a system       >>      <<r9434>>60956040
   << running MPE4 or earlier ...                      >>      <<r9434>>60956060
   << ------------------------------------------------ >>      <<r9434>>60956080
   FFILEINFO (T'NUM, ITEM'MPE4'LDEV, TAPE'LDEV);               <<r9434>>60956100
   IF <> THEN                                                  <<07043>>60956200
      FAIL (RS'T'FGETINFO'FAIL)                                <<r9434>>60956300
   ELSE IF TAPE'LDEV <> 0 THEN                                 <<r9434>>60956400
           TAPE'LDEV := TAPE'LDEV.(8:8)                        <<r9434>>60956500
   ELSE BEGIN                                                  <<r9434>>60956600
        FFILEINFO(T'NUM, ITEM'LDEV, TAPE'LDEV);                <<r9434>>60956700
        IF <> THEN                                             <<r9434>>60956800
           FAIL (RS'T'FGETINFO'FAIL);                          <<r9434>>60956900
        END;                                                   <<r9434>>60956910
         IF USING'ATTIO THEN                                   <<m9012>>60979100
            << reset the drivers consecutive eof detection >>  <<m9012>>60979300
            << for eofs at the beginining of reels         >>  <<m9012>>60979400
            ISSUE'CTRL (ATTIO'2'EOF);                          <<m9012>>60979500
$EDIT VOID=70241000                                            <<07346>>70239000
      DIR'SIR'INFO    =  DSEG(%212)  #,                        <<07346>>70250100
$EDIT VOID=70291000                                            <<07346>>70290000
$EDIT VOID=70309000                                            <<07346>>70309000
            << update the sirinfo in the directory data seg >> <<07346>>70312100
            << since the directory must release the SIR we  >> <<07346>>70312200
            << have aquired.                                >> <<07346>>70312300
                                                               <<07346>>70312400
            DIR'SIR'INFO := SIR'INFO;                          <<07346>>70312500
                                                               <<07346>>70312600
$EDIT VOID=70340000                                            <<07346>>70336000
   RC'LOCK'DIRECTORY.(15:1) := TRUE;  <<still have dir Sir>>   <<07346>>70342000
         DISABLE'ARITHMETIC'TRAPS;                             <<m7927>>70666100
         ENABLE'ARITHMETIC'TRAPS;                              <<m7927>>70667100
         DISABLE'ARITHMETIC'TRAPS;                             <<m7927>>70816100
         ENABLE'ARITHMETIC'TRAPS;                              <<m7927>>70817100
      REAL'EXTENT := 0,                 ! NON ZERO EXTENTS     <<07349>>71694100
      LCLFLDEVTYPE,                     ! for use in splt stk  <<m8798>>71699100
      LCLFLDEVSUBTYPE,                  ! for use in splt stk  <<m8798>>71699200
         REAL'EXTENT := REAL'EXTENT + 1;                       <<07349>>71779100
   CHUNK'LDEV := CHUNK'ADDR'1.(0:8);                           <<07349>>71783000
$EDIT VOID=71784000                                            <<07349>>71784000
   LDT'FILE'USE'CNT := LDT'FILE'USE'CNT+LOGICAL(REAL'EXTENT-1);<<07349>>71791000
                                                               <<m8798>>71945100
   << convert some DB relative variables to locals >>          <<m8798>>71945200
   << for use in split stack mode.                 >>          <<m8798>>71945300
                                                               <<m8798>>71945400
   LCLFLDEVTYPE := FLDEVTYPE;                                  <<m8798>>71945500
   LCLFLDEVSUBTYPE := FLDEVSUBTYPE;                            <<m8798>>71945600
      EXCHANGEDB (LDT'DST);                                    <<j9486>>71955100
      IF LDT'AVAIL'TO'SYS AND LDT'DEVICE'TYPE=LCLFLDEVTYPE THEN<<m8798>>71959000
         IF NOT (CHECKSUB) OR LPDT'SUBTYPE=LCLFLDEVSUBTYPE THEN<<m8798>>71960000
            IF LCLFLDEVTYPE = 0 THEN                           <<m8798>>71962000
               BEGIN                                           <<m8798>>71962100
               EXCHANGEDB ( LPDT'DST );                        <<m8798>>71962200
               END;                                            <<m8798>>71979100
END;                                                           <<s9506>>72456100
                                                               <<s9506>>72456200
                                                               <<s9506>>72456201
<<---------------------------------------->>                   <<s9506>>72456202
<<  ASSERT'ACCT'GROUP'ACCESS of HIDE'OF'COPY     >>            <<s9506>>72456203
<<---------------------------------------->>                   <<s9506>>72456204
                                                               <<s9506>>72456205
SUBROUTINE ASSERT'ACCT'GROUP'ACCESS;                           <<s9506>>72456206
                                                               <<s9506>>72456207
                                                               <<s9506>>72456210
BEGIN                                                          <<s9506>>72456211
   DISABLE'ARITHMETIC'TRAPS;                                   <<s9506>>72456212
   DR := DIRECFINDFILE (FILELEVEL, FILE'INDEX'PTR,FLACCTNAME,  <<s9532>>72456213
         FLGRPNAME, FLLOCNAME, FILE'NTRY, PVMVTABX );          <<s9532>>72456214
   IF <> THEN                                                  <<s9532>>72456215
      BEGIN                                                    <<s9532>>72456216
      ENABLE'ARITHMETIC'TRAPS;                                 <<s9532>>72456217
      IF DRA <> 2 THEN RET (RS'DIR'FIND'OLD)                   <<s9532>>72456218
      ELSE IF DRB=ACCTLEVEL AND NOT CREATE'ACCT'FLAG THEN      <<s9532>>72456219
         RET (M'SM'REQUIRED)                                   <<s9532>>72456220
      ELSE IF DRB=GROUPLEVEL AND NOT CREATE'GROUP'FLAG THEN    <<s9532>>72456221
         BEGIN                                                 <<s9532>>72456222
         IF LOGON'ACCT'=FLACCTNAME',(FILE'PART'SIZE) THEN BEGIN<<s9532>>72456223
            IF (NOT CAP'AM) THEN                               <<s9532>>72456224
               RET (M'AM'OR'SM'REQUIRED); END                  <<s9532>>72456225
         ELSE RET (M'SM'REQUIRED);                             <<s9532>>72456226
         END                                                   <<s9532>>72456227
      ELSE IF DRB=FILELEVEL THEN                               <<s9506>>72456228
      ELSE RET (RS'DIR'FIND'OLD);                              <<s9506>>72456229
      END                                                      <<s9506>>72456230
                                                               <<s9506>>72456231
   ELSE                                                        <<s9506>>72456232
      BEGIN                                                    <<s9506>>72456233
      ENABLE'ARITHMETIC'TRAPS;                                 <<s9506>>72456234
      END;                                                     <<s9506>>72456242
                                                               <<s9506>>72456243
                                                               <<s9506>>72456244
                                                               <<s9506>>72456245
   IF NOT ACCCHECK (FILELEVEL, FLACCTNAME', FILE'NTRY'ACCT'SEC,<<s9506>>72456246
      FLGRPNAME', FILE'NTRY'GROUP'SEC, FLLOCNAME',             <<s9506>>72456247
      FLSECMX).(READf) THEN                                    <<s9506>>72456248
         RET (M'CANT'READ'TAPE'FILE);                          <<s9506>>72456249
   IF LOCAL'FLAG THEN                                          <<s9506>>72468000
      IF (NOT SM'TOG) THEN                                     <<s9532>>72468050
         ASSERT'ACCT'GROUP'ACCESS;                             <<s9532>>72468100
   DISABLE'ARITHMETIC'TRAPS;                                   <<m7927>>72532100
                                                               <<m7927>>72532200
   ENABLE'ARITHMETIC'TRAPS;                                    <<m7927>>72591100
                                                               <<m7927>>72591200
$EDIT VOID=72704000                                            <<m7892>>72702000
$EDIT VOID=72727000                                            <<m7892>>72726000
$EDIT VOID=72803000                                            <<m7892>>72803000
$EDIT VOID=72819000                                            <<m7892>>72818000
                                                               <<07699>>72877100
BYTE ARRAY FNAME(0:3 * FILE'PART'SIZE);                        <<07699>>72877200
INTEGER LENGTH;  << Length of fname >>                         <<07699>>72877300
LOGICAL PARAM;  << dummy parameter for FCONTROL call >>        <<07699>>72877400
   IF REQUESTSERVICE THEN <<error may be due to break-abort>>  <<m8219>>72922100
      FILE'FAIL (0, SR'BREAK'SENSED);                          <<m8219>>72922110
                                                               <<m8219>>72922200
$PAGE "READ GOOD FILE SUBROUTINES"                             <<07699>>72950001
<<------------------------->>                                  <<07699>>72950010
<< DB'MAKE'GOOD2           >>                                  <<07699>>72950020
<<------------------------->>                                  <<07699>>72950030
                                                               <<07699>>72950040
SUBROUTINE DB'MAKE'GOOD2;                                      <<07699>>72950050
<< Creates the good2 file                                   >> <<07699>>72950060
BEGIN                                                          <<07699>>72950070
IF SEEN'LOCAL THEN  << possible different group and acct >>    <<07699>>72950072
   BEGIN                                                       <<07699>>72950074
   MOVE FNAME := GBUF'(G'FILE'INX'), (FILE'PART'SIZE);         <<07699>>72950076
   LENGTH := FILE'PART'SIZE;                                   <<07699>>72950078
   WHILE FNAME(LENGTH-1) = " " DO LENGTH := LENGTH - 1;        <<07699>>72950079
   END                                                         <<07699>>72950080
ELSE                                                           <<07699>>72950081
   DISPLAY'3'TO'DISPLAY(FNAME, LENGTH, GBUF'(G'FILE'INX'),     <<07699>>72950082
                     GBUF'(G'GROUP'INX'), GBUF'(G'ACCT'INX')); <<07699>>72950090
FNAME(LENGTH) := ";";  << Terminate file name >>               <<07699>>72950100
<< Call DB'GET'ROOT'INFO to get image specific info    >>      <<07699>>72950110
TOS := 0;                << room for return value>>            <<07699>>72950111
TOS := @FNAME;           << address of file name >>            <<07699>>72950120
TOS := @MAINT'WORD;      << Maintenance word     >>            <<07699>>72950130
TOS := @DB'RESTOR'LOW;   << Low parameter        >>            <<07699>>72950140
TOS := @DB'RESTOR'HIGH;  << high parameter       >>            <<07699>>72950150
TOS := DB'GET'R'PLABEL;  << plabel for db'get'root'info >>     <<07699>>72950160
ASSEMBLE(PCAL 0); << DB'GET'ROOT'INFO(FNAME,MAINT,LOW,HIGH) >> <<07699>>72950170
IF  TOS    THEN << Successful DB'GET'ROOT'INFO >>              <<07699>>72950180
   BEGIN                                                       <<07699>>72950190
   IF DB'IRESTORE(G2'NUM,GBUF'(G'TITLE'INX')) THEN             <<07699>>72950200
      FPOINT(G2'NUM, 1D)  << set to just past root file >>     <<07699>>72950210
   ELSE FILE'FAIL(0,0);                                        <<07699>>72950220
   END                                                         <<07699>>72950230
ELSE FILE'FAIL(0,DB'NOT'GOOD'ROOT);                            <<07699>>72950240
END << DB'MAKE'GOOD2 sub >>;                                   <<07699>>72950250
$PAGE                                                          <<07699>>72950260
<<------------------------->>                                  <<07699>>72950270
<< DB'READ'GOOD            >>                                  <<07699>>72950280
<<------------------------->>                                  <<07699>>72950290
                                                               <<07699>>72950300
LOGICAL SUBROUTINE DB'READ'GOOD;                               <<07699>>72950310
<< Reads from the good1 file, meaning reads a new root file >> <<07699>>72950320
<< RETURNS: FALSE if at end of file, TRUE otherwise         >> <<07699>>72950330
                                                               <<07699>>72950340
BEGIN                                                          <<07699>>72950350
FPOINT(G2'NUM,0D);  << reset pointer on good2 file >>          <<07699>>72950360
FCONTROL(G2'NUM, FWRITEOF, PARAM); << EOF at start of file  >> <<07699>>72950370
IF <> THEN FILE'FAIL(0,SR'G'UPDATE'FAIL);                      <<07699>>72950380
<<*******************************************************>>    <<07699>>72950390
<< Now read the new root file name                       >>    <<07699>>72950400
<<*******************************************************>>    <<07699>>72950410
FREAD(G'NUM, GBUF, G'RECSIZE);                                 <<07699>>72950420
IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                    <<07699>>72950430
IF > THEN DB'READ'GOOD := FALSE                                <<07699>>72950440
ELSE DB'READ'GOOD := TRUE;                                     <<07699>>72950450
<<*******************************************************>>    <<07699>>72950460
<< Put the root file in the good2 file so that if an     >>    <<07699>>72950470
<< error occurs, it will be purged.                      >>    <<07699>>72950480
<<*******************************************************>>    <<07699>>72950490
FWRITE(G2'NUM, GBUF, G'RECSIZE, 0);                            <<07699>>72950500
IF <> THEN                                                     <<07699>>72950510
   FILE'FAIL(G2'NUM, SR'G'UPDATE'FAIL);                        <<07699>>72950520
<<********************************************************>>   <<07699>>72950530
<< To insure that the new root file will be processed, set>>   <<07699>>72950540
<< GOT'ROOT'FILE to true                                  >>   <<07699>>72950550
<<********************************************************>>   <<07699>>72950560
DB'GOT'ROOT'FILE := TRUE;                                      <<07699>>72950570
END  << db'read'good sub >>;                                   <<07699>>72950580
$PAGE                                                          <<07699>>72950590
<<------------------------->>                                  <<07699>>72950600
<<  DB'FETCH'RECORD        >>                                  <<07699>>72950610
<<------------------------->>                                  <<07699>>72950620
                                                               <<07699>>72950630
LOGICAL SUBROUTINE DB'FETCH'RECORD;                            <<07699>>72950640
<< Fetches a record from a good file containing information >> <<07699>>72950650
<< on what file to restore next.                            >> <<07699>>72950660
<< RETURNS: False if no more files to restore, true otherwis>> <<07699>>72950670
                                                               <<07699>>72950680
BEGIN                                                          <<07699>>72950690
DB'FETCH'RECORD := TRUE;                                       <<07699>>72950700
IF DB'FIRST'TIME THEN  << First filename fetched in FRESTORE>> <<07699>>72950710
                       << or a serious error occurred       >> <<07699>>72950720
   BEGIN                                                       <<07699>>72950730
   DB'FETCH'RECORD := DB'READ'GOOD;                            <<07699>>72950740
                       << reads the good1 file and sets     >> <<07699>>72950750
                       << DB'GOT'ROOT to true               >> <<07699>>72950760
   DB'FIRST'TIME := FALSE;  << no longer the first time     >> <<07699>>72950770
   END                                                         <<07699>>72950780
ELSE << been through here before >>                            <<07699>>72950790
   BEGIN                                                       <<07699>>72950800
   IF DB'GOT'ROOT'FILE THEN  << Just restored a root file >>   <<07699>>72950810
      BEGIN                                                    <<07699>>72950820
      DB'MAKE'GOOD2;  << makes a good2 files >>                <<07699>>72950830
      DB'GOT'ROOT'FILE := FALSE; << Already processed root>>   <<07699>>72950840
      END;                                                     <<07699>>72950850
   FREAD(G2'NUM, GBUF, G'RECSIZE);                             <<07699>>72950860
   <<*****************************************************>>   <<07699>>72950870
   << Read in from good 2 file, G'NUM contains only the   >>   <<07699>>72950880
   << names of root files to be restored, G2'NUM contains >>   <<07699>>72950890
   << the file names of all component files of the databas>>   <<07699>>72950900
   << being restored.  Since we got here, the root file   >>   <<07699>>72950910
   << has already been processed and the G2'NUM file is   >>   <<07699>>72950920
   << present.                                            >>   <<07699>>72950930
   <<*****************************************************>>   <<07699>>72950940
   IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                 <<07699>>72950950
   IF > THEN  << No more component files, read another root>>  <<07699>>72950960
      DB'FETCH'RECORD := DB'READ'GOOD;                         <<07699>>72950970
   END;                                                        <<07699>>72950971
END  << DB'FETCH'RECORD sub >>;                                <<07699>>72950980
                                                               <<07699>>72950990
<<------------------------->>                                  <<07699>>72951000
<< FETCH'GOOD'RECORD       >>                                  <<07699>>72951010
<<------------------------->>                                  <<07699>>72951020
                                                               <<07699>>72951030
LOGICAL SUBROUTINE FETCH'GOOD'RECORD;                          <<07699>>72951040
<< Fetch a record from a good file.  If doing a DBRESTORE   >> <<07699>>72951050
<< then the good record may come from one of two good files >> <<07699>>72951060
<< RETURNS: true if successful, false if end of file        >> <<07699>>72951070
BEGIN                                                          <<07699>>72951080
IF DBRESTOR'TOG THEN                                           <<07699>>72951090
   FETCH'GOOD'RECORD := DB'FETCH'RECORD                        <<07699>>72951100
ELSE                                                           <<07699>>72951110
   BEGIN                                                       <<07699>>72951120
   FREAD(G'NUM, GBUF, G'RECSIZE);                              <<07699>>72951130
   IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                 <<07699>>72951140
   IF > THEN FETCH'GOOD'RECORD := FALSE    << EOF >>           <<07699>>72951150
   ELSE FETCH'GOOD'RECORD := TRUE;                             <<07699>>72951160
   END;                                                        <<07699>>72951170
END  << Fetch'good'record sub >>;                              <<07699>>72951180
            IF NUM'SKIPS = 0D THEN                             <<m8861>>73029000
               BEGIN                                           <<m8861>>73029100
               FOUND := TRUE;                                  <<m8861>>73029200
               IF USING'ATTIO THEN                             <<m8861>>73029300
                  START'A'READ (TAPE'RECSIZE);                 <<m8861>>73029400
               ISSUE'READ (TDBUF, TAPE'RECSIZE, FALSE);        <<m8861>>73029500
               END                                             <<m8861>>73029600
               MOVE'TO'TDBUF;                                  <<09471>>73062100
               IF TDBUF' <> GBUF' (G'FILE'INX'),(3*FILE'PART'SIZE) THEN 73064000
                                                               <<07699>>73095100
            IF DBRESTOR'TOG THEN                               <<07699>>73095200
               BEGIN                                           <<07699>>73095300
               DB'PURGE(G2'NUM);  << Purge partial database >> <<07699>>73095400
               DB'FIRST'TIME := TRUE; << Read next database >> <<07699>>73095500
               END;                                            <<07699>>73095600
                                                               <<07699>>73095700
            IF NOT FETCH'GOOD'RECORD THEN  <<EOF on goodfile>> <<07699>>73099000
$EDIT VOID=73104000                                            <<07699>>73099001
               BEGIN                                           <<07699>>73100000
               CURR'FILENO := -1D;                             <<07699>>73101000
               FOUND := TRUE;                                  <<07699>>73102000
               SKIP'AND'READ'TAPE := FAILED;                   <<s8700>>73102100
               << Must fail since no more files are left >>    <<s8700>>73102200
               << to be found during resynchronization   >>    <<s8700>>73102300
               END;                                            <<07699>>73103000
            FILL' (RES'FILE', FILE'PART'SIZE,  " ");           <<s8700>>73104000
            FILL' (RES'GROUP' , FILE'PART'SIZE, " ");          <<s8700>>73104100
            FILL' (RES'ACCT', FILE'PART'SIZE, " ");            <<s8700>>73104200
            << This is necessary for the sendmessage to >>     <<s8700>>73104300
            << send the correct file name with the error>>     <<s8700>>73104400
   IF REQUESTSERVICE THEN <<error may be due to break-abort>>  <<m8219>>73226100
      FAIL;                                                    <<m8219>>73226110
                                                               <<m8219>>73226200
   LOCAL'IOB:=P'ATTACHIO (                                     <<07347>>73675000
      RET (M'T'BAD'RECSIZE);                                   <<j9355>>73741000
$PAGE                                                                   73742010
<<----------------------------------------------->>                     73742020
<<  SUBROUTINE XEQ'READ'SDISC OF WRITE'THE'FILE  >>                     73742030
<<----------------------------------------------->>                     73742040
                                                                        73742050
SUBROUTINE XEQ'READ'SDISC;                                              73742060
                                                                        73742070
   << Interface to read'tape for serial discs. We take >>               73742080
   << advantage of the fact that there may be a larger >>               73742090
   << tdbuf, allowing more efficient disc reads.       >>               73742100
                                                                        73742110
BEGIN                                                                   73742120
                                                                        73742121
   << continue calling READ'TAPE as long as room remains>>              73742122
   << in the TDBUF and the amount of data already in    >>              73742123
   << TDBUF does not satisfy the files requirements.    >>              73742124
                                                               <<m9018>>73742125
   TAPE'BUFF'OFFSET := 0;                                      <<m9018>>73742126
                                                               <<m9018>>73742127
   WHILE ((SDISC'BUFFSIZE-SECTORS'LEFT'IN'BUFFER*128>=TAPE'RECSIZE)     73742130
         LAND (SECTORS'TO'WRITE -                              <<m9018>>73742140
               DOUBLE (SECTORS'LEFT'IN'BUFFER) > 0D))          <<m9018>>73742141
         DO                                                    <<m9018>>73742150
      BEGIN                                                             73742160
      READ'TAPE'RET :=READ'TAPE(TDBUF(SECTORS'LEFT'IN'BUFFER*128),      73742170
                                GBUF);                                  73742180
      SECTORS'LEFT'IN'BUFFER := SECTORS'LEFT'IN'BUFFER +                73742190
                                READ'TAPE'LEN CHANGE'TO'SECTORS;        73742200
$EDIT VOID=73742210                                                     73742210
      IF READ'TAPE'RET = FAILED THEN                                    73742220
         BEGIN                                                          73742230
         KILL'RESTORE := TRUE;                                          73742240
         RET (-1);                                                      73742250
         END                                                            73742260
      ELSE IF READ'TAPE'RET = GOOD'SKIPFILE THEN                        73742270
         BEGIN                                                          73742280
         SENDMESSAGE (M'CONTAINED'TAPE'ERROR);                          73742290
         RET (-1);                                                      73742300
         END;                                                           73742310
                                                                        73742320
      IF LAST'READ'WAS'EOF THEN                                         73742330
         BEGIN                                                          73742340
         EOF'READ := TRUE;                                              73742350
         RET (M'NOT'ALL'SECTORS'WRITTEN);                               73742360
         END;                                                           73742370
                                                                        73742380
      IF READ'TAPE'LEN MOD SECTORSIZE <> 0 THEN                         73742390
         RET (RS'T'BAD'RECSIZE);                                        73742400
                                                                        73742410
      END;                                                              73742420
END;                                                                    73742430
$EDIT VOID=73743400                                                     73743010
         IF TAPE'SDISC'TOG THEN                                <<m9018>>73808000
            XEQ'READ'SDISC                                     <<m9018>>73808100
         ELSE                                                  <<m9018>>73808200
            BEGIN                                              <<m9018>>73808210
            XEQ'READ'TAPE;                                     <<m9018>>73808300
            SECTORS'LEFT'IN'BUF :=                             <<m9018>>73809000
                  READ'TAPE'LEN CHANGE'TO'SECTORS;             <<m9018>>73809010
            END;                                               <<m9018>>73809100
$TITLE "[RESTORE] DB'PURGE --- Purge all files in good2 file"  <<07699>>73921005
$PAGE                                                          <<07699>>73921010
<<**********************************************************>> <<07699>>73921015
$CONTROL SEGMENT=FRESTORE                                      <<07699>>73921020
LOGICAL PROCEDURE DB'PURGE(GOOD'FNUM);                         <<07699>>73921025
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> <<07699>>73921030
<< Purge all files in the good file passed, called in       >> <<07699>>73921035
<< response to an error where only part of a database is    >> <<07699>>73921040
<< restored and must be purged.                             >> <<07699>>73921045
<<                                                          >> <<07699>>73921050
<< RETURNS: Good if successful, failed if not successful    >> <<07699>>73921055
<< PARAMETERS: GOOD'FNUM (input only) - File number of good >> <<07699>>73921060
<<               file                                       >> <<07699>>73921065
<< GLOBALS: None                                            >> <<07699>>73921070
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> <<07699>>73921075
                                                               <<07699>>73921080
INTEGER GOOD'FNUM;                                             <<07699>>73921090
                                                               <<07699>>73921095
BEGIN  << DB'PURGE >>                                          <<07699>>73921100
                                                               <<07699>>73921105
DOUBLE CURRENT'FPOINTER;  << Current file pointer           >> <<07699>>73921110
DOUBLE COUNT;             << Number of file purged so far   >> <<07699>>73921115
INTEGER                                                        <<07699>>73921120
   ERRNUM,                << Error number from file system  >> <<07699>>73921125
   FC,                    << File code for FOPEN            >> <<07699>>73921126
   PURGE'FNUM,            << Purged file file number        >> <<07699>>73921130
   LENGTH;                << Length of purged file filename >> <<07699>>73921135
                                                               <<07699>>73921140
BYTE ARRAY FNAME(0:5*FILE'PART'SIZE);                          <<07699>>73921145
                          << Purged file name               >> <<07699>>73921150
ARRAY GOOD'BUF(0:G'RECSIZE);                                   <<07699>>73921155
                          << Good file buffer               >> <<07699>>73921160
BYTE ARRAY GOOD'BUF'(*) = GOOD'BUF;                            <<07699>>73921165
LOGICAL DONE;   << Done purging files >>                       <<07699>>73921166
                                                               <<07699>>73921170
EQUATE                                                         <<07699>>73921175
   FREC'POINTER  = 09,    << FFILEINFO number for record ptr>> <<07699>>73921180
   FNOT'EXIST    = 52;    << File system error, nonexistant >> <<07699>>73921185
                          << permanent file                 >> <<07699>>73921190
                                                               <<07699>>73921195
$PAGE "DB'PURGE SUBROUTINES"                                   <<07699>>73921200
<<------------------------->>                                  <<07699>>73921205
<<  FAIL                   >>                                  <<07699>>73921210
<<------------------------->>                                  <<07699>>73921215
                                                               <<07699>>73921220
SUBROUTINE FAIL(ERR);                                          <<07699>>73921225
VALUE ERR;                                                     <<07699>>73921230
INTEGER ERR;                                                   <<07699>>73921235
                                                               <<07699>>73921240
<< Fails the DB'PURGE, merely prints out the error, does not>> <<07699>>73921245
<< exit the procedure.                                      >> <<07699>>73921250
BEGIN                                                          <<07699>>73921255
                                                               <<07699>>73921260
DB'PURGE := FAILED;                                            <<07699>>73921265
IF ERR <> 0 THEN                                               <<07699>>73921270
   SENDMESSAGE(ERR);                                           <<07699>>73921275
                                                               <<07699>>73921280
END;                                                           <<07699>>73921285
$PAGE "DB'PURGE OUTER BLOCK"                                   <<07699>>73921290
<<------------------------->>                                  <<07699>>73921295
<< DB'PURGE OUTER BLOCK    >>                                  <<07699>>73921300
<<------------------------->>                                  <<07699>>73921305
                                                               <<07699>>73921310
<<**********************************************>>             <<07699>>73921315
<< Find out where current file pointer is.  All >>             <<07699>>73921320
<< files past the current pointer have not been >>             <<07699>>73921325
<< restored yet so they need not be purged.     >>             <<07699>>73921330
<<**********************************************>>             <<07699>>73921335
                                                               <<07699>>73921340
DB'PURGE := GOOD;                                              <<07699>>73921345
DONE := FALSE;                                                 <<07699>>73921346
FFILEINFO(GOOD'FNUM, FREC'POINTER, CURRENT'FPOINTER);          <<07699>>73921350
IF <> THEN                                                     <<07699>>73921355
   CURRENT'FPOINTER := 100D;  << if we can not find out,    >> <<07699>>73921360
                              << purge all of them.         >> <<07699>>73921365
FPOINT(GOOD'FNUM, 0D);        << reset to first record      >> <<07699>>73921370
IF <> THEN                                                     <<07699>>73921375
   FAIL(DB'NOT'PURGED);                                        <<07699>>73921380
COUNT := 0D;                                                   <<07699>>73921385
FREAD(GOOD'FNUM, GOOD'BUF, G'RECSIZE);                         <<07699>>73921390
IF <> THEN                                                     <<07699>>73921395
   BEGIN                                                       <<07699>>73921396
   DONE := TRUE;                                               <<07699>>73921397
   FAIL(DB'NOT'PURGED);                                        <<07699>>73921398
   END;                                                        <<07699>>73921399
IF DISPLAY'3'TO'STANDARD(GOOD'BUF'(G'FILE'INX'),               <<07699>>73921400
              GOOD'BUF'(G'GROUP'INX'), GOOD'BUF'(G'ACCT'INX'), <<07699>>73921401
              LOOK'TITLE', ERROR'CODE) = FAILED THEN           <<07699>>73921402
   FAIL(SR'D'2'S'FAILED);                                      <<07699>>73921403
SENDMESSAGE(M'DB'NOT'RESTORED); << Send database not purged >> <<07699>>73921404
WHILE NOT DONE AND COUNT < CURRENT'FPOINTER DO                 <<07699>>73921405
   BEGIN                                                       <<07699>>73921406
   PURGE'FNUM := 0;                                            <<07699>>73921407
   DISPLAY'3'TO'DISPLAY(FNAME, LENGTH, GOOD'BUF'(G'FILE'INX'), <<07699>>73921410
                        GOOD'BUF'(G'GROUP'INX'),               <<07699>>73921415
                        GOOD'BUF'(G'ACCT'INX'));               <<07699>>73921420
   FC := FILECODE'LOW - 1;                                     <<07699>>73921421
   DO BEGIN                                                    <<07699>>73921422
      FC := FC + 1;                                            <<07699>>73921423
      PURGE'FNUM := FOPEN(FNAME,1,<<aoptions>>,<<recsize>>,    <<07699>>73921425
                     <<dev>>,<<formsg>>,<<usrl>>,<<blkf>>,     <<07699>>73921426
                     <<buf>>,<<fsze>>,<<exts>>,<<aloc>>,FC);   <<07699>>73921427
      IF <> THEN PURGE'FNUM := 0;                              <<07699>>73921428
      END                                                      <<07699>>73921431
   UNTIL (PURGE'FNUM <> 0) OR (FC = FILECODE'HIGH);            <<07699>>73921432
   IF PURGE'FNUM = 0 THEN                                      <<07699>>73921433
      BEGIN  << check to see what kind of error        >>      <<07699>>73921435
      FCHECK(0,ERRNUM);                                        <<07699>>73921440
      IF ERRNUM <> FNOT'EXIST THEN                             <<07699>>73921445
         FAIL(DB'NOT'PURGED);                                  <<07699>>73921450
      END                                                      <<07699>>73921455
   ELSE                                                        <<07699>>73921460
      BEGIN                                                    <<07699>>73921465
      FCLOSE(PURGE'FNUM,4,0); << close/purge option  >>        <<07699>>73921470
      IF <> THEN FAIL(DB'NOT'PURGED)                           <<07699>>73921475
      ELSE                                                     <<07699>>73921476
         GOOD'FILE'COUNT := GOOD'FILE'COUNT - 1D;              <<07699>>73921477
         << We didn't really restore this file, did we? >>     <<07699>>73921478
      END;                                                     <<07699>>73921480
   COUNT := COUNT + 1D;                                        <<07699>>73921485
   FREAD(GOOD'FNUM, GOOD'BUF, G'RECSIZE);                      <<07699>>73921490
   IF < THEN                                                   <<07699>>73921491
      BEGIN                                                    <<07699>>73921492
      FAIL(DB'NOT'PURGED);                                     <<07699>>73921493
      DONE := TRUE;                                            <<07699>>73921494
      END                                                      <<07699>>73921495
   ELSE IF > THEN DONE := TRUE;                                <<07699>>73921496
   END;  << Purging entire set >>                              <<07699>>73921497
SENDMESSAGE(DB'PURGED);                                        <<07699>>73921498
END << DB'PURGE proc >>;                                       <<07699>>73921505
                                                               <<07699>>73994100
   BYTE ARRAY FNAME(0:3 * FILE'PART'SIZE);    << File name >>  <<07699>>73994200
   INTEGER LENGTH;                  << Length of FNAME     >>  <<07699>>73994300
   LOGICAL PARAM;         << Dummy parameter for FCONTROL  >>  <<07699>>73994400
     unfreezing and unlocking prior to releasing.                       74005000
     We first call ABORTIO to ensure that the buffers                   74005100
     are not I/O frozen.                              >>                74005200
   ABORTIO (TAPE'LDEV);                                        <<m7499>>74008100
                                                               <<m7499>>74008200
                                                               <<j9050>>74104010
   IF  (TAPE'DEVINFO.SUBTYPEf = subtype'7978) AND              <<j9050>>74104100
       (NUMBANKS > SMALL'MEMORY'SYSTEM) AND                    <<j9050>>74104200
       (TAPE'DENSITY = 6250) THEN                              <<j9050>>74104300
       NUM'XDS := 6   <<allow 6 buffers for 7978>>             <<j9050>>74104400
   ELSE                                                        <<j9050>>74104410
   IF  NUMBANKS <= VERY'SMALL'MEMORY'SYSTEM THEN               <<j9050>>74104500
       NUM'XDS := 2;                                           <<j9050>>74104600
                                                               <<j9050>>74104700
                                                               <<07699>>74317100
   IF DBRESTOR'TOG THEN                                        <<07699>>74317200
      DB'PURGE(G2'NUM);     << PURGE the partial database >>   <<07699>>74317300
                                                                        74320100
   << we must blank out the file, grp, and acct fields >>               74320200
   << so that sendmessage will use curr'title'         >>               74320300
                                                                        74320400
   RES'FILE' := " ";                                                    74320500
   RES'GROUP' := " ";                                                   74320600
   RES'ACCT' := " ";                                                    74320700
$PAGE "READ GOOD FILE SUBROUTINES"                             <<07699>>74366001
<<------------------------->>                                  <<07699>>74366010
<< DB'MAKE'GOOD2           >>                                  <<07699>>74366020
<<------------------------->>                                  <<07699>>74366030
                                                               <<07699>>74366040
SUBROUTINE DB'MAKE'GOOD2;                                      <<07699>>74366050
<< Creates the good2 file                                   >> <<07699>>74366060
BEGIN                                                          <<07699>>74366070
IF SEEN'LOCAL THEN                                             <<07699>>74366071
   BEGIN  << Build local filename >>                           <<07699>>74366072
   MOVE FNAME := GBUF'(G'FILE'INX'), (FILE'PART'SIZE);         <<07699>>74366073
   LENGTH := FILE'PART'SIZE;                                   <<07699>>74366074
   WHILE FNAME(LENGTH - 1) = " " DO LENGTH := LENGTH - 1;      <<07699>>74366075
   END                                                         <<07699>>74366076
ELSE                                                           <<07699>>74366077
   DISPLAY'3'TO'DISPLAY(FNAME, LENGTH,  GBUF'(G'FILE'INX'),    <<07699>>74366080
                    GBUF'(G'GROUP'INX'),  GBUF'(G'ACCT'INX')); <<07699>>74366090
FNAME(LENGTH) := ";";  << Terminate file name >>               <<07699>>74366100
<< Call DB'GET'ROOT'INFO to get image specific info    >>      <<07699>>74366110
TOS := 0;                << Room for return value>>            <<07699>>74366111
TOS := @FNAME;           << Address of file name >>            <<07699>>74366120
TOS := @MAINT'WORD;      << Maintenance word     >>            <<07699>>74366130
TOS := @DB'RESTOR'LOW;   << Low parameter        >>            <<07699>>74366140
TOS := @DB'RESTOR'HIGH;  << High parameter       >>            <<07699>>74366141
TOS := DB'GET'R'PLABEL;  << plabel for db'get'root'info >>     <<07699>>74366160
ASSEMBLE(PCAL 0); << DB'GET'ROOT'INFO(FNAME,LOW,HIGH) >>       <<07699>>74366170
IF   TOS   THEN << Successful DB'GET'ROOT'INFO >>              <<07699>>74366180
   BEGIN                                                       <<07699>>74366190
   IF DB'IRESTORE(G2'NUM, GBUF'(G'TITLE'INX')) THEN            <<07699>>74366200
      FPOINT(G2'NUM, 1D)  << set to just past root file >>     <<07699>>74366210
   ELSE FAIL(0);                                               <<07699>>74366220
   END                                                         <<07699>>74366230
ELSE FAIL(DB'NOT'GOOD'ROOT);                                   <<07699>>74366240
END << DB'MAKE'GOOD2 sub >>;                                   <<07699>>74366250
$PAGE                                                          <<07699>>74366260
<<------------------------->>                                  <<07699>>74366270
<< DB'READ'GOOD            >>                                  <<07699>>74366280
<<------------------------->>                                  <<07699>>74366290
                                                               <<07699>>74366300
LOGICAL SUBROUTINE DB'READ'GOOD;                               <<07699>>74366310
<< Reads from the good1 file, meaning reads a new root file >> <<07699>>74366320
<< RETURNS: FALSE if at end of file, TRUE otherwise         >> <<07699>>74366330
                                                               <<07699>>74366340
BEGIN                                                          <<07699>>74366350
FPOINT(G2'NUM,0D);  << reset pointer on good2 file >>          <<07699>>74366360
FCONTROL(G2'NUM, FWRITEOF, PARAM); << EOF at start of file  >> <<07699>>74366370
IF <> THEN FAIL(SR'G'UPDATE'FAIL);                             <<07699>>74366380
<<*******************************************************>>    <<07699>>74366390
<< Now read the new root file name                       >>    <<07699>>74366400
<<*******************************************************>>    <<07699>>74366410
FREAD(G'NUM,  GBUF, G'RECSIZE);                                <<07699>>74366420
IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                    <<07699>>74366430
IF > THEN DB'READ'GOOD := FALSE                                <<07699>>74366440
ELSE DB'READ'GOOD := TRUE;                                     <<07699>>74366450
<<*******************************************************>>    <<07699>>74366460
<< Put the root file in the good2 file so that if an     >>    <<07699>>74366470
<< error occurs, it will be purged.                      >>    <<07699>>74366480
<<*******************************************************>>    <<07699>>74366490
FWRITE(G2'NUM,  GBUF, G'RECSIZE, 0);                           <<07699>>74366500
IF <> THEN                                                     <<07699>>74366510
   FILE'FAIL(G2'NUM, SR'G'UPDATE'FAIL);                        <<07699>>74366520
<<********************************************************>>   <<07699>>74366530
<< To insure that the new root file will be processed, set>>   <<07699>>74366540
<< GOT'ROOT'FILE to true                                  >>   <<07699>>74366550
<<********************************************************>>   <<07699>>74366560
DB'GOT'ROOT'FILE := TRUE;                                      <<07699>>74366570
END  << db'read'good sub >>;                                   <<07699>>74366580
$PAGE                                                          <<07699>>74366590
<<------------------------->>                                  <<07699>>74366600
<<  DB'FETCH'RECORD        >>                                  <<07699>>74366610
<<------------------------->>                                  <<07699>>74366620
                                                               <<07699>>74366630
LOGICAL SUBROUTINE DB'FETCH'RECORD;                            <<07699>>74366640
<< Fetches a record from a good file containing information >> <<07699>>74366650
<< on what file to restore next.                            >> <<07699>>74366660
<< RETURNS: False if no more files to restore, true otherwis>> <<07699>>74366670
                                                               <<07699>>74366680
BEGIN                                                          <<07699>>74366690
DB'FETCH'RECORD := TRUE;                                       <<07699>>74366700
IF DB'FIRST'TIME THEN  << First filename fetched in FRESTORE>> <<07699>>74366710
                       << or a serious error occurred       >> <<07699>>74366720
   BEGIN                                                       <<07699>>74366730
   DB'FETCH'RECORD := DB'READ'GOOD;                            <<07699>>74366740
                       << reads the good1 file and sets     >> <<07699>>74366750
                       << DB'GOT'ROOT to true               >> <<07699>>74366760
   DB'FIRST'TIME := FALSE;  << no longer the first time     >> <<07699>>74366770
   END                                                         <<07699>>74366780
ELSE << been through here before >>                            <<07699>>74366790
   BEGIN                                                       <<07699>>74366800
   IF DB'GOT'ROOT'FILE THEN  << Just restored a root file >>   <<07699>>74366810
      BEGIN                                                    <<07699>>74366820
      DB'MAKE'GOOD2;  << makes a good2 files >>                <<07699>>74366830
      DB'GOT'ROOT'FILE := FALSE; << Already processed root>>   <<07699>>74366840
      END;                                                     <<07699>>74366850
   FREAD(G2'NUM,  GBUF, G'RECSIZE);                            <<07699>>74366860
   <<*****************************************************>>   <<07699>>74366870
   << Read in from good 2 file, G'NUM contains only the   >>   <<07699>>74366880
   << names of root files to be restored, G2'NUM contains >>   <<07699>>74366890
   << the file names of all component files of the databas>>   <<07699>>74366900
   << being restored.  Since we got here, the root file   >>   <<07699>>74366910
   << has already been processed and the G2'NUM file is   >>   <<07699>>74366920
   << present.                                            >>   <<07699>>74366930
   <<*****************************************************>>   <<07699>>74366940
   IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                 <<07699>>74366950
   IF > THEN  << No more component files, read another root>>  <<07699>>74366960
      DB'FETCH'RECORD := DB'READ'GOOD;                         <<07699>>74366970
   END;                                                        <<07699>>74366971
END  << DB'FETCH'RECORD sub >>;                                <<07699>>74366980
                                                               <<07699>>74366990
<<------------------------->>                                  <<07699>>74367000
<< FETCH'GOOD'RECORD       >>                                  <<07699>>74367010
<<------------------------->>                                  <<07699>>74367020
                                                               <<07699>>74367030
LOGICAL SUBROUTINE FETCH'GOOD'RECORD;                          <<07699>>74367040
<< Fetch a record from a good file.  If doing a DBRESTORE   >> <<07699>>74367050
<< then the good record may come from one of two good files >> <<07699>>74367060
<< RETURNS: true if successful, false if end of file        >> <<07699>>74367070
BEGIN                                                          <<07699>>74367080
IF DBRESTOR'TOG THEN                                           <<07699>>74367090
   FETCH'GOOD'RECORD := DB'FETCH'RECORD                        <<07699>>74367100
ELSE                                                           <<07699>>74367110
   BEGIN                                                       <<07699>>74367120
   FREAD(G'NUM,  GBUF, G'RECSIZE);                             <<07699>>74367130
   IF < THEN FILE'FAIL(G'NUM, SR'G'READ'FAIL);                 <<07699>>74367140
   IF > THEN FETCH'GOOD'RECORD := FALSE    << EOF >>           <<07699>>74367150
   ELSE FETCH'GOOD'RECORD := TRUE;                             <<07699>>74367160
   END;                                                        <<07699>>74367170
END  << Fetch'good'record sub >>;                              <<07699>>74367180
   IF NOT FETCH'GOOD'RECORD THEN  << eEOF on goodfile >>       <<07699>>74398000
$EDIT VOID=74399000                                            <<07699>>74398001
   RES'FILE' := " ";                                           <<J9337>>74404010
$EDIT VOID=74418100                                                     74418050
                                                               <<07699>>74442100
      IF DBRESTOR'TOG THEN                                     <<07699>>74442200
         BEGIN                                                 <<07699>>74442300
         DB'PURGE(G2'NUM);   << Purge the partial database >>  <<07699>>74442400
         DB'FIRST'TIME := TRUE; << Force new database      >>  <<07699>>74442500
         END;                                                  <<07699>>74442600
                                                               <<07699>>74442700
      IF NOT FETCH'GOOD'RECORD THEN << EOF on goodfile >>      <<07699>>74446000
$EDIT VOID=74447000                                            <<07699>>74446001
                                                               <<s8700>>74452100
      FILL' (RES'FILE', FILE'PART'SIZE, " ");                  <<s8700>>74452200
$EDIT VOID=74452400                                            <<J9337>>74452210
                                                               <<s8700>>74452500
      << This fill is necessary to correctly print out the >>  <<s8700>>74452600
      << right filename with the synchronization error mess>>  <<s8700>>74452700
                                                               <<s8700>>74452800
                                                               <<07699>>74590100
   IF DBRESTOR'TOG THEN                                        <<07699>>74590200
      DB'FIRST'TIME := TRUE;    << Read first database >>      <<07699>>74590300
   WHILE (GBUF'(G'TITLE'INX') <> TDBUF', (3 * FILE'PART'SIZE)) <<M8797>>74621000
            DO                                                 <<M8797>>74621100
$EDIT VOID=74627100                                                     74627050
      << Tell the driver to abort reads after detecting 2 >>   <<m8862>>74645100
      << cosecutive EOFs, signifying the end of volume.   >>   <<m8862>>74645200
      << This is necessary since the large number of      >>   <<m8862>>74645300
      << pending reads used for RESTORE, could cause the  >>   <<m8862>>74645400
      << tape drive to unspool the tape.                  >>   <<m8862>>74645500
      ISSUE'CTRL (ATTIO'2'EOF);                                <<m8862>>74645600
      OLD'FILE'HIDDEN               := FALSE,                  <<p9364>>74749000
      OLD'FILE'PURGED               := FALSE;                  <<p9364>>74749100
      IF OLD'FILE'PURGED THEN                                  <<p9364>>74789100
         BEGIN                                                 <<p9364>>74789200
         DR := DIRECPURGEFILE (-OLD'SECTORS, PARMS'TEMPI'1,    <<p9364>>74789300
            RES'ACCT, RES'GROUP, RES'FILE, PVMVTABX);          <<p9364>>74789400
                                                               <<p9364>>74789500
         IF <> THEN SENDMESSAGE (DIRECTORY'ERROR (DR));        <<p9364>>74789600
         END;                                                  <<p9364>>74789700
                                                               <<p9364>>74789900
      BEGIN                                                    <<m7497>>74803100
      VTABTOLDEV (FLEXTMAP'D, FLEXTMAP'D, FLNUMEXTS + 1,       <<m7495>>74803200
                  PVMVTABX );                                  <<m7497>>74803300
      END;                                                     <<m7497>>74805100
                                                               <<p9364>>74822100
   IF OLD'FILE'PURGED THEN                                     <<p9364>>74822200
      SENDMESSAGE (RS'OLD'FILE'PURGED);                        <<p9364>>74822300
                                                               <<07699>>74828100
   IF DBRESTOR'TOG THEN  << we must NOT restore this dbs>>     <<07699>>74828200
      BEGIN                                                    <<07699>>74828300
      IF NOT DB'GOT'ROOT'FILE THEN DB'PURGE(G2'NUM);           <<07699>>74828400
        <<Necessary to make sure old copy not purged on keep >><<07699>>74828410
      DB'FIRST'TIME := TRUE;<< Force restoring of the next >>  <<07699>>74828500
                         << database.                   >>     <<07699>>74828600
      END;                                                     <<07699>>74828700
   ELSE IF DBRESTOR'TOG THEN  <<maint'word is checked by DBRESTORE>>    74873100
         IF FLUSERID' = "RESTORE "  THEN                       <<m7941>>74947100
            BEGIN                                              <<m7941>>74947200
            SENDMESSAGE (RS'RESTORE'CREATED);                  <<m7941>>74947300
            MOVE RES'CREATOR := "RESTORE ";                    <<m7941>>74947400
            END                                                <<m7941>>74947500
      ELSE                                                     <<m7941>>74947600
      DR := DIRECINSERTFILE (FILE'MAX'SECTORS, PARMS'TEMPI'1,  <<07344>>75185000
                             RES'ACCT, RES'GROUP, RES'FILE,    <<07344>>75185100
                             FADDR, PVMVTABX);                 <<07344>>75186000
            RELEASE'LDEV := LUN (LOGICAL (RELEASE'ADDR'B1),    <<07349>>75227000
                                 PVMVTABX);                    <<07349>>75227100
$EDIT VOID=75250330                                                     75250010
   VTABTOLDEV (FLEXTMAP'D, FLEXTMAP'D, FLNUMEXTS+1,            <<07349>>75257100
               PVMVTABX);                                      <<07349>>75257200
   LDEVTOVTAB (FLEXTMAP'D, FLEXTMAP'D, FLNUMEXTS+1,            <<07349>>75259100
               PVMVTABX<>0);                                   <<07349>>75259200
$PAGE "PURGE'OLD'COPY of RESTORE'A'FILE"                       <<p9364>>75267010
<<----------------------------------->>                        <<p9364>>75267020
<<  PURGE'OLD'COPY of RESTORE'A'FILE >>                        <<p9364>>75267030
<<----------------------------------->>                        <<p9364>>75267040
                                                               <<p9364>>75267050
SUBROUTINE PURGE'OLD'COPY;                                     <<p9364>>75267060
                                                               <<p9364>>75267061
   ! This routine purges old file to make room for new file.   <<p9364>>75267062
                                                               <<p9364>>75267063
BEGIN                                                          <<p9364>>75267070
   IF NOT OLD'COPY'EXISTS THEN                                 <<p9364>>75267090
      FAIL (M'OUT'OF'DISC'SPACE)                               <<p9364>>75267100
   ELSE                                                        <<p9364>>75267110
      BEGIN                                                    <<p9364>>75267120
      PURGE'OLD'FILE;                                          <<p9364>>75267130
      OLD'FILE'PURGED := TRUE;                                 <<p9364>>75267140
      IF NOT PICK'A'DEVICE (EXTENT'SIZES) THEN                 <<p9364>>75267150
         FAIL (M'OUT'OF'DISC'SPACE);                           <<p9364>>75267151
      END;                                                     <<p9364>>75267170
END <<PURGE'OLD'COPY OF RESTORE'A'FILE>>;                      <<p9364>>75267210
$EDIT VOID=75276000                                            <<p9364>>75269000
   IF NOT PICK'A'DEVICE (EXTENT'SIZES) THEN PURGE'OLD'COPY;    <<p9364>>75296000
   IF NOT OLD'FILE'PURGED THEN PURGE'OLD'FILE;                 <<p9364>>75310000
$EDIT VOID=75315000                                                     75315000
$EDIT VOID=75330000                                            <<p9364>>75316000
      TEXT2       (0:66),                                      <<m8780>>80212000
      TEXT3       (0:66);                                      <<m8780>>80213000
      TEXT2'      (*) = TEXT2 (0),                             <<m8780>>80242000
      TEXT3'      (*) = TEXT3 (0);                             <<m8780>>80243000
      P'DB'NOT'RESTORED = P'DATELINE + 1,                      <<07699>>80275000
      P'DIREC     = P'DB'NOT'RESTORED+1,<<ACCT,CRTR,GROUP parms<<07699>>80276000
      P'PROGRESS  = P'PATTERN   + 1, <<percent complete>>      <<m8224>>80319100
      P'RESTORE'P = P'PROGRESS  + 1, <<preview of RESTORE>>    <<m8224>>80320000
      MSG'DB'RESTOR              = 1133,                       <<07699>>80592120
      MSG'FAILED'DB              = 1134,                       <<07699>>80592130
      MSG'DBASE                  = 1135,                       <<07699>>80592140
      MSG'DBASE2                 = 1136,                       <<07699>>80592150
      MSG'PROGRESS'1             = 1137,                       <<m8224>>80592160
      MSG'PROGRESS'2             = 1138,                       <<m8224>>80592170
      MSG'T'BAD'RECSIZE          = 1139,                       <<j9355>>80592180
      MSG'SM'REQUIRED      = 1140,                             <<s9532>>80592190
      MSG'AM'OR'SM'REQUIRED= 1141,                             <<s9532>>80592200
         M'DB'NOT'RESTORED,                                    <<07699>>80664010
               1,    P'DB'NOT'RESTORED,                        <<07699>>80664020
         M'PROGRESS,                                           <<m8224>>80824100
               1,    P'PROGRESS,                               <<m8224>>80824200
         M'T'BAD'RECSIZE,                                      <<j9355>>80926030
               2,    P'NSR, MSG'T'BAD'RECSIZE,                 <<j9355>>80926040
      M'SM'REQUIRED,                                           <<s9532>>80926050
               2,    P'NSR, MSG'SM'REQUIRED,                   <<s9532>>80926060
      M'AM'OR'SM'REQUIRED,                                     <<s9532>>80926070
               2,    P'NSR, MSG'AM'OR'SM'REQUIRED,             <<s9532>>80926080
                                                               <<m8780>>81184010
      << check for a possibl third line >>                     <<m8780>>81184020
                                                               <<m8780>>81184030
      SCAN TEXT3' UNTIL 0,1;         <<point to null at end>>  <<m8780>>81184040
      LEN:=TOS-LOGICAL(@TEXT3');     <<number of non nulls>>   <<m8780>>81184050
      IF LEN > 0 THEN                                          <<m8780>>81184060
         BEGIN                                                 <<m8780>>81184070
         IF TELL'TO'OP THEN                                    <<m8780>>81184080
            PRINTOP (TEXT3, -LEN, CONTROL'CODE)                <<m8780>>81184090
         ELSE                                                  <<m8780>>81184100
            FWRITE (FNUM, TEXT3, -LEN, CONTROL'CODE);          <<m8780>>81184110
         IF <> THEN SENDMESSAGE:=FAILED;                       <<m8780>>81184120
         END;                                                  <<m8780>>81184130
      FILL (TEXT3, 67, 0);                                     <<m8863>>82051000
            <<P'DB'NOT'RESTORED:>>                             <<07699>>82231000
               BEGIN                                           <<07699>>82231100
               APPEND'MSG(MSG'DBASE);                          <<07699>>82231200
              APPEND " " ENDAPPEND;                            <<07699>>82231250
               APPEND'TITLE(LOOK'TITLE', FIXEDv);              <<07699>>82231300
              APPEND " " ENDAPPEND;                            <<07699>>82231350
               APPEND'MSG(MSG'DBASE2);                         <<07699>>82231400
               END;                                            <<07699>>82231500
                                                               <<07699>>82231600
$EDIT VOID=82889000                                            <<m7525>>82889000
                                                               <<m8224>>82937100
            <<P'PROGRESS>>                                     <<m8224>>82937200
               BEGIN                                           <<m8224>>82937300
                                                               <<m8224>>82937310
               IF PROGRESS'NUM <> 0 THEN                       <<m8224>>82937311
                  FID := PROGRESS'NUM; <<send to progress>>    <<m8224>>82937312
               LOOPS := 0; <<only write this message once>>    <<m8224>>82937313
                                                               <<m8224>>82937314
               APPEND'MSG (MSG'PROGRESS'1);                    <<m8224>>82937320
               SPACE (1);                                      <<m8224>>82937350
               APPEND'NUM  (PARMS'TEMPI'1);                    <<m8224>>82937400
               APPEND'MSG (MSG'PROGRESS'2);                    <<m8224>>82937600
                                                               <<m8224>>82937610
               END;                                            <<m8224>>82937700
                                                               <<m8224>>82937800
               IF DBRESTOR'TOG THEN                            <<07699>>82949000
                  APPEND'MSG (MSG'DB'RESTOR)                   <<07699>>82949100
               ELSE                                            <<07699>>82949200
                  APPEND'MSG (MSG'FILES'ON'TAPE);              <<07699>>82950000
               IF ((BAD'FILE'COUNT <> 0D) LAND (RESTORING)) OR <<m8863>>83046100
                  ((FILES'REJECTED <> 0D) LAND (STORING)) THEN <<m8863>>83046200
                  BEGIN                                        <<m8780>>83046210
                     NEXTLINE (0);                             <<m8780>>83046220
                  IF RESTORING THEN                            <<m8780>>83046300
                     BEGIN                                     <<m8780>>83046400
                     APPEND'MSG (MSG'FILES'NOT'RESTORED);      <<m8780>>83046500
                     APPEND'FMTI (BAD'FILE'COUNT, 8, 10, " "); <<m8780>>83046600
                     END                                       <<m8780>>83046700
                  ELSE                                         <<m8780>>83046800
                     BEGIN                                     <<m8780>>83046900
                     APPEND'MSG (MSG'FILES'NOT'STORED);        <<m8780>>83047000
                     APPEND'FMTI (FILES'REJECTED, 7, 10, " "); <<m8780>>83047100
                     END;                                      <<m8780>>83047200
                  END;                                         <<m8780>>83047210
                                                               <<m8780>>83047300
                  @PTEXT:=@TEXT3';  <<go to the third line>>   <<m8780>>83052000
                  SPACE (0);                                   <<m8780>>83054000
                     BEGIN                                     <<07699>>83057000
                     IF DBRESTOR'TOG THEN                      <<07699>>83057100
                        APPEND'MSG (MSG'FAILED'DB)             <<07699>>83057200
                     ELSE                                      <<07699>>83057300
                        APPEND'MSG (MSG'FAILED'RESTORE'FILES); <<07699>>83058000
                     END                                       <<07699>>83059000
$EDIT VOID=83092000                                            <<m8780>>83070000
IF MSGNO >= 12000 THEN                                         <<07699>>83256000
