<< 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 := %40000;  <<tdbuf size for sdiscs       >>          01455000
      TOS := IF TAPE'SDISC'TOG THEN SDISC'BUFFSIZE                      01568000
             ELSE TAPE'RECSIZE;                                         01569000
      (IF SYSDUMPING THEN 100000D ELSE 4000D) #,               <<02206>>01598100
      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
$EDIT VOID=01943000                                                     01943000
$EDIT VOID=01947000                                                     01947000
   ATTIO'2'EOF    = 128,      <<enab/disab dvr detection of>>  <<m8862>>01947100
                              <<two concecutive eofs       >>  <<m8862>>01947200
   COMMAND'TEXT'LEN   = 232,                                   <<02125>>01978000
   COMMAND'TEXT''LEN   = 448,                                           01980000
   DATA'AREA'A    =  0  ,     << For DIRSCAN >>                <<09945>>01996100
   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
   MAX'ERROR'LEVEL   = 20,                                     <<j2246>>02106000
   MVTAB'DST      = 53 ,      << Mounted Volume Table DST >>   <<01231>>02131000
   SIZE'OF'MVTAB'ENTRY = 22,  << MVTAB entry size >>           <<01231>>02131100
   SUBTYPE'7978   = 2  ,      <<  "      "  HP7978  "  >>      <<m7682>>02198500
   SUBTYPE'7974   = 3  ,      <<  "      "  HP7974  "  >>      <<m7682>>02199000
   TYPE'7978      = %1030 ,   <<  "       "   "      "     " >><<m7682>>02214500
   TYPE'7974      = %1430 ,   <<  "       "   "      "     " >><<m7682>>02215000
   DS1            = 1,                                                  02228100
   NS             = 2,                                                  02228200
   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
   FLMODTIME      = FLAB'D (59) #,                             <<01530>>02617000
   FLEND         = FLAB'D (57)  #,                             <<09992>>02696100
   G'EXTSIZE'INX'D= 13,                                        <<01700>>03010000
   G'FILE'SECTORS'INX'D = 12,                                  <<01700>>03016000
   G'LOCKWORD'INX = 20,                                        <<01700>>03027000
   G'LOCKWORD'INX'= 40,                                        <<01700>>03027100
   G'RECSIZE      = 32;                                        <<01700>>03042000
   REMOTE'NODE'NAME (0:87),                                    <<01497>>03190100
   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
   SYSDUMP'REELNUM            := 0,                            <<02125>>03436100
   TIME'0                     = TIME,                          <<m8224>>03451000
   TIME'1                     = TIME + 1,                      <<m8224>>03451100
   DS'ERROR                   := 0,                            <<r9434>>03469000
   S'R'FLAGS7                 := 0,                            <<07699>>03497000
   S'R'FLAGS8                 := 0,                            <<01497>>03497100
$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
      ALREADY'VALID'FILESET = S'R'FLAGS6.(12:01)  #,          <<RESTOR>>03744000
      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
      REMOTE'NODE'FLAG = S'R'FLAGS8.(08:03)     #,             <<01497>>03769955
      POWER'FAIL     = S'R'FLAGS8.(07:01)       #,             <<j2246>>03770988
$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 := 201D; <<File limit for good2>>     <<s9586>>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'RE'STORE'CURRENT'REEL      = 6098,                       <<j2246>>05134000
$EDIT VOID=05136000                                                     05136000
   SR'NEED'AM'OR'SM             = 6111,                        <<01701>>05158000
   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
   SR'PDBAKUP'CALLED'BY'ALIEN   = 6260,                        <<P2099>>05405000
   SR'REMOTE'NODE'EXPECTED      = 6281,                        <<01497>>05405093
   SR'REELNUM'EQUAL             = 6303,                        <<02125>>05405150
   SR'REEL'NO'EXPECTED          = 6304,                        <<02125>>05405160
   RS'CREATE'SM                 = 9011,                        <<01701>>05428000
   RS'CREATE'SM'OR'AM           = 9012,                        <<01701>>05430000
   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,  <<09901>>06210400
   M'CORRUPTED'FILE           = M'AM'OR'SM'REQUIRED      + 1,  <<09901>>06210500
   M'BAD'FILE'SIZE            = M'CORRUPTED'FILE         + 1;  <<09901>>06210600
   FWRITEDIR,                                                           07051000
   LOADPROC,                                                   <<07699>>07059000
PROCEDURE ABORTIO (LDEVICE);                                   <<m7499>>07089010
         VALUE LDEVICE;                                        <<m7499>>07089020
         INTEGER LDEVICE;                                      <<m7499>>07089030
         OPTION EXTERNAL;                                      <<m7499>>07089040
                                                               <<m7499>>07089050
LOGICAL PROCEDURE AS'DSPLABEL (INDEX);                         <<01497>>07106100
         VALUE INDEX;                                          <<01497>>07106300
         INTEGER INDEX;                                        <<01497>>07106400
         OPTION EXTERNAL;                                      <<01497>>07106500
                                                                        07106600
                                                               <<09945>>07281000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, WHICH);                  <<01159>>07281100
         VALUE WHICH;                                          <<09945>>07281200
         ARRAY ENTRYNAME;                                      <<09945>>07281300
         LOGICAL WHICH;                                        <<09945>>07281400
         OPTION EXTERNAL;                                      <<09945>>07281500
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
INTEGER PROCEDURE XRETPMASK (N1, N2, N3, N4, PMASKHI, PMASKLO);<<m9732>>07780000
         BYTE ARRAY N1, N2, N3, N4;                            <<m9732>>07784000
                                                               <<07699>>07788000
$EDIT VOID=08010000                                                     08002000
                                GROUPNAME,ACCTNAME,LOCKWORD);  <<01700>>08144110
         BYTE ARRAY TARGET, FILENAME, GROUPNAME, ACCTNAME,     <<01700>>08144300
                    LOCKWORD;                                  <<01700>>08144310
         OPTION FORWARD, UNCALLABLE, VARIABLE;                 <<01700>>08144400
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
PROCEDURE DEALLOC'IF'AUTOALLOC(LDEV,FADDR,FILECODE,FLAGS);     <<01894>>08769000
         VALUE LDEV,FADDR,FILECODE,FLAGS;                      <<01894>>08769100
         INTEGER LDEV,FILECODE,FLAGS;                          <<01894>>08769200
         DOUBLE FADDR;                                         <<R1623>>08769300
         OPTION EXTERNAL;                                      <<R1623>>08769400
                                                               <<R1623>>08769500
      BUF         (0:224);                                     <<01497>>10930000
      PARTS,                                                   <<s9586>>15122000
      FIRST'CHAR,                                              <<s9586>>15122100
      SECOND'CHAR;                                             <<s9586>>15122200
   BYTE ARRAY DSET'SUFFIX(0:20);                               <<01498>>15122300
                                                               <<s9586>>15122400
  <<---------------------->>                                   <<s9586>>15122500
   SUBROUTINE SUFFIX'TO'INTEGER;                               <<s9586>>15122600
      BEGIN <<SUFFIX'TO'INTEGER>>                              <<s9586>>15122610
      I.(0:8) := PTEXT;                                        <<01498>>15122620
      I.(8:8) := "-";                                          <<01498>>15122630
      SCAN DSET'SUFFIX UNTIL I, 1;                             <<01498>>15122700
      FIRST'CHAR := TOS - @DSET'SUFFIX;                        <<s9586>>15122800
      I.(0:8) := PTEXT(1);                                     <<01498>>15122810
      SCAN DSET'SUFFIX UNTIL I, 1;                             <<01498>>15122900
      SECOND'CHAR := TOS - @DSET'SUFFIX;                       <<s9586>>15123000
      NUMBER := 10 * FIRST'CHAR + SECOND'CHAR;                 <<s9586>>15123100
      END; <<SUFFIX'TO'INTEGER>>                               <<s9586>>15123200
                                                               <<s9586>>15123300
  <<---------------------->>                                   <<s9586>>15123400
         << "-" used as a terminal character >>                <<01498>>15123500
   MOVE DSET'SUFFIX := "0123456789ABCDEFGHIJ-";                <<01498>>15124000
            IF (NOT DBSTORE'TOG) AND (NOT DBRESTOR'TOG) THEN   <<s9586>>15247000
               BEGIN                                           <<s9586>>15247100
               WHILE (LEN:=LEN-1) >= 0 DO                      <<s9586>>15248000
                  IF PTEXT(LEN) <> NUMERIC THEN                <<s9586>>15250000
                     RETURN;              <<not a digit!>>     <<s9586>>15252000
               END;                                            <<s9586>>15252100
               SUFFIX'TO'INTEGER;                              <<s9586>>15262000
                  (NUMBER < DBSTORE'LOW) THEN                  <<s9586>>15266000
$EDIT VOID=15267000                                            <<s9586>>15267000
                                                               <<07699>>15270100
            IF DBRESTOR'TOG AND (LEN=2) THEN                   <<07699>>15271000
               BEGIN                                           <<07699>>15271100
               SUFFIX'TO'INTEGER;                              <<s9586>>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
$EDIT VOID=20044000                                                     20000000
   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
         FILES'REJECTED := FILES'REJECTED + 1D;                <<*1266>>21219000
      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
$EDIT VOID=22018000                                                     22018000
$EDIT VOID=22020000                                                     22020000
$EDIT VOID=22022000                                                     22022000
$EDIT VOID=22024000                                                     22024000
$EDIT VOID=22026000                                                     22026000
$EDIT VOID=22028000                                                     22028000
      IF FLFOPTIONS.(08:02) = 1 THEN                           <<09992>>22032100
         D := FLEND + 1D                                       <<09992>>22032200
      ELSE                                                     <<09992>>22032300
         D := FLEOF;                                           <<09992>>22034000
      IF SECTORS'MIN > SECTORS'MAX THEN                        <<09901>>22094100
         SECTORS'MIN := -1D                                    <<09992>>22094200
      ELSE                                                     <<09992>>22094300
         IF FLFOPTIONS.(08:02) = 1 THEN                        <<09992>>22094400
            SECTORS'MIN := SECTORS'MAX;                        <<09992>>22094500
      IF DUMMY'I = SOFTWARE'ABORT THEN                         <<j2246>>22210010
         OPERATOR'ABORT := TRUE;                               <<j2246>>22210020
      IF DUMMY'I >= DS'COMM'ERROR THEN                         <<j2246>>22210030
         DS'ERROR := TRUE;                                     <<j2246>>22210040
      IF (DUMMY'I = 89) OR (DUMMY'I = 18) THEN                 <<j2246>>22210100
         POWER'FAIL := TRUE                                    <<j2246>>22210200
      ELSE                                                     <<j2246>>22210300
         POWER'FAIL := FALSE;                                  <<j2246>>22210400
      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
      ACTUAL'DEV' (0:14),                                      <<01497>>22870000
      MOVE ACTUAL'DEV' := DEV', (15)                           <<01497>>22928000
      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
           and not in: STORE A,,B;*T  RESTORE *T;A,; >>       <<RESTOR>>23580000
     IF ALLOW'EMPTY'FILESET AND NOT ALREADY'VALID'FILESET     <<RESTOR>>23586000
         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
      ALREADY'VALID'FILESET := TRUE;                          <<RESTOR>>23801000
                           ERROR'CODE, CHAR'INX, DELIMS', -1)  <<S8716>>23824000
   ALREADY'VALID'FILESET := TRUE;                             <<RESTOR>>23875000
                                                                        24082100
   INTEGER                                                     <<01497>>24082200
      LEN,                                                     <<01497>>24082300
      PLABEL'RFA,                                              <<01497>>24082310
      RETURN'ADDRESS,                                          <<01497>>24082320
      DS'NS'TYPE  := 1;                                        <<j1551>>24082400
                                                                        24082410
   EQUATE                                                      <<01497>>24082420
      RFA'RESOLVE'ENVID = 37;                                  <<01497>>24082430
   SUBROUTINE PARSE'NODE'NAME (NODE'NAME, LEN, TYPE);          <<01497>>24344150
            BYTE ARRAY NODE'NAME;                              <<01497>>24344170
            INTEGER    LEN, TYPE;                              <<01497>>24344180
                                                                        24344190
      BEGIN                                                    <<01497>>24344200
      RETURN'ADDRESS := TOS;                                   <<01497>>24344201
      TOS := PLABEL'RFA;                                       <<01497>>24344202
      ASSEMBLE (PCAL 0);                                       <<01497>>24344218
      TOS := RETURN'ADDRESS;                                   <<01497>>24344219
      RETURN 0;                                                <<01497>>24344221
      END;                                                     <<01497>>24344222
                        IF NOT CAP'SM THEN                     <<01701>>24546000
            ERR (SR'FILE'COUNT'EXPECTED)                                25026000
         ELSE                                                  <<01021>>25026100
         IF G'NUM'FSIZE > 11184624D THEN                                25026200
            ERR (SR'DNUMBER'TOO'BIG);                          <<01021>>25026300
               ERR (SR'NEED'AM'OR'SM);                         <<01701>>25084000
         STEPIT;                                               <<s9586>>25123000
         IF (ICLASS IS NUMBERv) OR (ICLASS IS TOKENv) THEN     <<s9586>>25124000
         IF (DBSTORE'HIGH < 0) OR (DBSTORE'HIGH > 199) THEN    <<s9586>>25136000
                                                                        25220010
         STEPIT;                                               <<01497>>25220020
         IF ITEMP =  "," THEN                                  <<01497>>25220100
            BEGIN                                              <<01497>>25220200
            STEPIT;                                            <<01497>>25220300
            IF ITEMP = ";" THEN                                <<01497>>25220410
               ERR (SR'REMOTE'NODE'EXPECTED);                  <<01497>>25220420
                                                                        25220430
            FILL' (REMOTE'NODE'NAME, 88, " ");                 <<01497>>25220440
                                                                        25220450
            TOS := @REMOTE'NODE'NAME;                          <<01497>>25220451
            WHILE ITEMP <> ";" AND ICLASS ISNT ENDLINEv DO     <<01497>>25220460
               BEGIN                                           <<01497>>25220470
               MOVE * := ITEMP, (ILEN), 2;                     <<01497>>25220500
               STEPIT;                                         <<01497>>25220501
               END;                                            <<01497>>25220502
                                                                        25220503
            ASSEMBLE (DEL, NOP);                               <<01497>>25220504
            UNSTEPIT;                                          <<01497>>25220505
            PLABEL'RFA := AS'DSPLABEL (RFA'RESOLVE'ENVID);     <<01497>>25220506
            IF PLABEL'RFA <> 0 THEN                            <<01497>>25220510
               PARSE'NODE'NAME (REMOTE'NODE'NAME, LEN,         <<01497>>25220511
                                          DS'NS'TYPE);         <<01497>>25220512
            IF DS'NS'TYPE = 0 THEN                             <<01497>>25220520
               ERR (SR'REMOTE'NODE'NAME'EXPECTED);             <<01497>>25220530
            IF DS'NS'TYPE = DS1 THEN                           <<01497>>25220540
               REMOTE'NODE'FLAG := DS1                         <<01497>>25220550
            ELSE                                               <<01497>>25220560
            IF DS'NS'TYPE = NS THEN                            <<01497>>25220570
               REMOTE'NODE'FLAG := NS;                         <<01497>>25220580
            END                                                <<01497>>25220600
         ELSE                                                  <<01497>>25220610
            UNSTEPIT;                                          <<01497>>25220620
                                                                        25220700
         STEPIT;                                               <<s9586>>25379000
         IF (ICLASS IS NUMBERv) OR (ICLASS IS TOKENv) THEN     <<s9586>>25380000
         IF (DBSTORE'LOW < 0) OR (DBSTORE'LOW > 199) THEN      <<01498>>25390000
                                                               <<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 NOT SYSDUMPING THEN                                <<01529>>25637051
            IF SEEN'PROGRESS THEN WARN (SR'PROGRESS'REDUNDENT);<<01529>>25637060
         IF TOTAL'SECTOR'COUNT <> -1D THEN                     <<j1663>>25637061
            SEEN'PROGRESS := TRUE;                             <<j1663>>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
         <<---------- REELNUM    parm ------------>>           <<02125>>25638990
                                                               <<02125>>25638991
      ELSE IF ILEN = 7 AND ITEMP = "REELNUM" THEN              <<02125>>25639000
         BEGIN                                                 <<02125>>25639010
         ASSURE'SYSDUMPING;                                    <<02125>>25639020
         STEPIT;                                               <<02125>>25639030
         IF ITEMP <> "=" THEN                                  <<02125>>25639040
            ERR (SR'REELNUM'EQUAL);                            <<02125>>25639050
         STEPIT;                                               <<02125>>25639060
         IF (ICLASS IS NUMBERv) THEN                           <<02125>>25639070
            TAPE'REEL := SUBCLASS                              <<02125>>25639080
         ELSE                                                           25639090
            ERR (SR'REEL'NO'EXPECTED);                         <<02125>>25639100
         END                                                   <<02125>>25639110
                                                                        25639120
                               GBUF' (G'ACCT'INX'),            <<01700>>26252690
                               GBUF' (G'LOCKWORD'INX'));       <<01700>>26252691
                                 %10101);                      <<02126>>26252770
            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
      LEN,                                                     <<s9586>>26938000
      FIRST'CHAR,                                              <<s9586>>26938100
      SECOND'CHAR;                                             <<s9586>>26938200
                                                               <<s9586>>26946100
   BYTE ARRAY DSET'SUFFIX(0:20);                               <<01498>>26946200
      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
$EDIT VOID=27234000                                            <<s9586>>27234000
      IF (DBSTORE'TOG) AND (LEN = 2) THEN                      <<s9586>>27234100
         BEGIN                                                 <<s9586>>27234200
         << "-" used as a terminal character >>                <<01498>>27234210
         MOVE DSET'SUFFIX := "0123456789ABCDEFGHIJ-";          <<01498>>27234300
         I.(0:8) := COPY'ITEMP(0);                             <<01498>>27234310
         I.(8:8) := "-";                                       <<01498>>27234320
         SCAN DSET'SUFFIX UNTIL I, 1;                          <<01498>>27234400
         FIRST'CHAR := TOS - @DSET'SUFFIX;                     <<s9586>>27234500
         I.(0:8) := COPY'ITEMP(1);                             <<01498>>27234510
         SCAN DSET'SUFFIX UNTIL I, 1;                          <<01498>>27234600
         SECOND'CHAR := TOS - @DSET'SUFFIX;                    <<s9586>>27234700
         SUBCLASS := 10 * FIRST'CHAR + SECOND'CHAR;            <<s9586>>27234800
         END                                                   <<s9586>>27234900
      ELSE                                                     <<s9586>>27235000
         SUBCLASS := 0;                                        <<s9586>>27235100
      RETURN'THEM (TOKENv, SUBCLASS, LEN);                     <<s9586>>27235200
                                                               <<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
   IF XRETPMASK (DESIG', DUMMY', DUMMY', DUMMY',               <<m9732>>27654000
      MAX'NUM'FILES := 180000D,                                         30118100
      FORMAL'NAME   (0:5),                                     <<j9342>>30128000
      INDIRECT'NAME (0:FILE'PART'WORDS*3),                     <<s1413>>30130000
      NS'FILE'NAME      (0:49),                                <<01497>>30130100
      INDIRECT'LEN:= 0,       <<length of indiect file name>>  <<m7523>>30151000
      ALREADY'PARSE'FILESET  := FALSE,                         <<j1663>>30176100
      ASCII'NUM     (0:10),                                    <<01497>>30185000
      NS'FILE'NAME' (*) = NS'FILE'NAME (0),                    <<01497>>30190100
      SCRATCH'      (0:14);                                    <<01497>>30192000
      ALREADY'VALID'FILESET := FALSE;                         <<RESTOR>>30525000
                                                               <<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
      SCAN P UNTIL [8/%15,8/%15], 1; <<leave pointer>>         <<s9586>>31300000
      ELSE IF ITEMP = "PDBAKUP" AND ILEN = 7 THEN              <<P2099>>31372010
         BEGIN                                                 <<P2099>>31372020
         IF USING'DRIVER THEN FAIL(SR'PDBAKUP'CALLED'BY'ALIEN);<<P2099>>31372030
         FATHERS'PIN := FATHER;                                <<P2099>>31372040
         IF <> THEN FAIL (SR'PDBAKUP'CALLED'BY'ALIEN);         <<P2099>>31372050
         PROCINFO (PARMS'TEMPI'1, PARMS'TEMPI'2, FATHERS'PIN,  <<P2099>>31372060
                   10, FATHERS'NAME);                          <<P2099>>31372070
         IF <> THEN FAIL (SR'CHECKING'FATHERS'NAME);           <<P2099>>31372080
         IF FATHERS'NAME <> "PDBAKUP.PPC.SYS " THEN            <<P2099>>31372090
            FAIL (SR'PDBAKUP'CALLED'BY'ALIEN);                 <<P2099>>31372100
         IGNORE'PRIV'CHECK'FLAG:=TRUE;                         <<P2099>>31372110
         S'R'STATUS:=STORINGV;                                 <<P2099>>31372120
         END                                                   <<P2099>>31372130
         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
      DBSTORE'HIGH    := 199;                                  <<s9586>>31466000
      IF DBSTORE'TOG OR DBRESTOR'TOG  THEN                     <<07699>>31498000
      FILL' (INDIRECT'NAME', FILE'PART'SIZE*3+2, " ");         <<s1413>>31526000
$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 NUM'RECORDS < MAX'NUM'FILES THEN                   <<01021>>31716100
            NUM'RECORDS := MAX'NUM'FILES;                      <<01021>>31716200
                      (NUM'RECORDS/DOUBLE (D'BLOCKFACTOR))+1D, <<01021>>31736000
                       1)                 <<initial extent>>   <<01021>>31740000
      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:=%104;                                       <<j2246>>32284000
         MOVE SCRATCH' := "               ";                   <<01497>>32326000
         TOS := @SCRATCH';                                     <<01497>>32326010
         IF REMOTE'NODE'FLAG = DS1 THEN                        <<01497>>32326100
            BEGIN                                              <<01497>>32326110
            MOVE * := REMOTE'NODE'NAME WHILE AN, 1;            <<01497>>32326200
            MOVE * := "#", 2;                                  <<01497>>32326300
            END;                                               <<01497>>32326400
                                                                        32326500
         LEN := ASCII (TAPE'LDEV, 10, ASCII'NUM);              <<01497>>32328000
         MOVE * := ASCII'NUM, (LEN);                           <<01497>>32329000
                                                                        32329100
         IF REMOTE'NODE'FLAG = NS THEN                         <<01497>>32329200
            BEGIN                                              <<01497>>32329300
            TOS := @NS'FILE'NAME';                             <<01497>>32329310
            MOVE * := TAPE'NAME' WHILE AN, 1;                  <<01497>>32329320
            MOVE * := ":", 2;                                  <<01497>>32329330
            MOVE *:=REMOTE'NODE'NAME,(SCAN REMOTE'NODE'NAME UNTIL " "); 32329340
            END;                                               <<01497>>32329350
                                                                        32329360
      ELSE IF DBSTORE'TOG OR DBRESTOR'TOG  THEN                <<07699>>32368000
      IF REMOTE'NODE'FLAG = NS THEN                            <<01497>>32376100
        BEGIN                                                  <<01497>>32376110
         IF OPEN'FILE (T'NUM, NS'FILE'NAME, FOPTIONS,          <<01497>>32376200
                       AOPTIONS, TAPE'RECSIZE, SCRATCH')       <<01497>>32376300
               = FAILED THEN                                   <<01497>>32376400
            FAIL (SR'CANT'OPEN'TAPE);                          <<01497>>32376500
        END                                                    <<01497>>32376510
     ELSE                                                      <<01497>>32376520
                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
            I'NUM := 0;                                        <<*2401>>33378010
            IF ALREADY'PARSE'FILESET = FALSE THEN              <<j1663>>33378100
               BEGIN                                           <<j1663>>33378200
               ALREADY'PARSE'FILESET := TRUE;                  <<j1663>>33378300
               FILESET'INX := 0;                               <<j1663>>33378500
               GENERATE'GOOD'FILE;                             <<j1663>>33378600
               END;                                            <<j1663>>33378700
                                                                        33378800
               BEGIN                                           <<j1663>>33482100
               ALREADY'PARSE'FILESET := TRUE;                  <<j1663>>33482200
               END;                                            <<j1663>>33484100
                                                               <<s9101>>33766000
      IF (NOT SYNTAX'TOG) THEN                                 <<01452>>33766001
      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
         << can't find the pattern, set STOREJCW to why'wrong ><<*1266>>33767301
         IF (FILES'TO'HANDLE + FILES'REJECTED = 0D) THEN       <<*1266>>33767302
            WHY := WHY'WRONG;                                  <<*1266>>33767303
         END;                                                  <<09534>>33767310
                                                               <<s9101>>33767400
$EDIT VOID=33862000                                            <<01701>>33862000
$EDIT VOID=33996000                                            <<j2246>>33950000
      IF (NOT SEEN'HIGH) AND (NOT SEEN'LOW) THEN               <<s9586>>34091000
         <<for root file and empty dataset>>                   <<s9586>>34091100
         DBSTORE'HIGH := DBSTORE'LOW                           <<s9586>>34091200
      ELSE IF (NOT SEEN'HIGH) OR (NOT SEEN'LOW) THEN           <<s9586>>34092000
      IF FILES'TO'HANDLE = 0D THEN                             <<*1266>>34244000
         BEGIN                                                 <<*1266>>34244100
            BEGIN                                              <<*1266>>34245600
            IF FILES'REJECTED = 0D THEN                        <<*1266>>34245700
               SENDMESSAGE (M'NO'FILES'TO'STORE);              <<*1266>>34246000
            END;                                               <<*1266>>34246100
         END                                                   <<*1266>>34246200
               DOUBLE (DBSTORE'HIGH - DBSTORE'LOW + 2)         <<s9586>>34256000
               LAND DBSTORE'HIGH <> DBSTORE'LOW ) THEN         <<s9586>>34257000
<< IF JCW'FLAG THEN  >>                                        <<s9101>>34358000
      FILL (CURR'FILE, 4, "??");       <<blank out file entry>>         40976100
   IF FILE'SECTORS = -1D  THEN                                 <<09901>>41351000
      FAIL (0, M'CORRUPTED'FILE);                              <<09901>>41352000
   IF (SEEN'PROGRESS) LOR ((I'NUM <> 0) LAND (STORINGV)) THEN  <<j1663>>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 := -1D;                            <<j1663>>41895600
         SEEN'PROGRESS := FALSE;                               <<m8224>>41895700
         END;                                                  <<m8224>>41895800
      ENABLE'ARITHMETIC'TRAPS;                                 <<m8224>>41895900
                                                               <<m8224>>41895901
      END;                                                     <<m8224>>41895902
                                                               <<m8224>>41895910
   MOVE GBUF'(G'TITLE'INX') := FLAB',(3*FILE'PART'SIZE),2;     <<01700>>41896000
   MOVE * := LOOK'LOCK',(FILE'PART'SIZE);                      <<01700>>41897000
         IF WRITE'TAPE (BLKTD, TDBUF, TRUE, TDBUF, FALSE)      <<j2246>>50342000
            = FAILED THEN                                      <<j2246>>50344000
      IF WRITE'TAPE (LEN, TDBUF, TRUE, TDBUF, FALSE)           <<j2246>>50374000
         = FAILED THEN                                         <<j2246>>50375000
   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
   INTEGER ARRAY                                               <<09902>>50484100
      SAVE'FLAB  (0: FILE'LABEL'SIZE-1);                       <<09902>>50484200
   IF WRITE'TAPE'MARK (PARMS'TEMPI'1) = FAILED THEN            <<j2246>>50614000
      IF PARMS'TEMPI'1 <> EOTCODE THEN                         <<j2246>>50614100
         FAIL (SR'WT'EOF);                                     <<j2246>>50614200
      IF SYSDUMPING OR TAPE'SDISC'TOG THEN                     <<j2246>>50645010
         BEGIN                                                 <<j2246>>50645020
         << For sdisc, we rewind'unload thru FCONTROL >>       <<j2246>>50645030
         << instaed of FCLOSE in order to be able to  >>       <<j2246>>50645040
         << detect any write errors.                  >>       <<j2246>>50645050
         IF FKONTROL (T'NUM, REWIND'UNLOAD) = FAILED THEN      <<j2246>>50645100
            FAIL (SR'TAPE'REWIND'FAIL);                                 50645200
         END                                                   <<j1856>>50645210
      ELSE                                                     <<j1856>>50645220
         BEGIN                                                 <<j1856>>50645230
         FCLOSE (T'NUM, TAPE'CLOSE'DISP, 0);                            50646000
         IF <> AND (TAPE'DEVINFO.SUBTYPEf = SUBTYPE'7978) THEN <<j2246>>50646100
            BEGIN                                              <<j2246>>50646110
            FCHECK (T'NUM, ERROR'CODE);                        <<j2246>>50646120
            IF (ERROR'CODE = 89) OR (ERROR'CODE = 18) THEN     <<j2246>>50646130
               BEGIN                                           <<j2246>>50646140
               POWER'FAIL := TRUE;                             <<j2246>>50646150
               FAIL (SR'TAPE'REWIND'FAIL);                     <<j2246>>50646160
               END;                                            <<j2246>>50646170
            END;                                               <<j2246>>50646180
         T'NUM := 0;                                                    50648000
         END;                                                  <<j1856>>50648100
      BEGIN                                                    <<09902>>50658100
      MOVE SAVE'FLAB := FLAB,  (FILE'LABEL'SIZE);              <<09902>>50658200
      MOVE FLAB := SAVE'FLAB,  (FILE'LABEL'SIZE);              <<09902>>50660100
      END;                                                     <<09902>>50660200
                                                                        50724100
   DOUBLE                                                      <<j2246>>50724200
      IOB;                                                     <<j2246>>50724300
      ATTIO'STATUS = IOB + 0,                                  <<j2246>>50730100
         BEGIN                                                 <<j2246>>50768110
         IF NOT OPERATOR'ABORT THEN                            <<j2246>>50768120
            BEGIN                                              <<j2246>>50768200
            SENDMESSAGE (SR'RESTART'TAPE);                     <<j2246>>50768201
            IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR   <<j2246>>50768202
               (VIRTDEV) THEN                                  <<j2246>>50768203
               MARK'REEL'BAD                                   <<j2246>>50768204
            ELSE                                               <<j2246>>50768205
               BEGIN                                           <<j2246>>50768206
               << If powerfail on sdisc, we will do a re-try >><<j2246>>50768207
               << on the same reel. Simply rewind the current>><<j2246>>50768208
               << reel instead of changing reels. >>           <<j2246>>50768209
               IOB := 0D;                                      <<j2246>>50768210
               WHILE (ATTIO'STATUS.ATTIO'STATUSf <> ATTIO'GOOD)<<j2246>>50768211
                   LAND (NOT OPERATOR'ABORT) LAND              <<j2246>>50768212
                  ((ERROR'LEVEL:=ERROR'LEVEL+1) < MAX'ERROR'LEVEL) DO   50768213
                  BEGIN                                        <<j2246>>50768214
                  IOB := ATTACHIO(TAPE'LDEV,0,0,0,REWIND,0,0,0,1);      50768215
                  IF ATTIO'STATUS.(8:8) = %33 THEN             <<j2246>>50768216
                     OPERATOR'ABORT := TRUE;                   <<j2246>>50768217
                  END;                                         <<j2246>>50768218
               <<reset error count if we're going to retry>>   <<j2246>>50768219
               IF ERROR'LEVEL <= MAX'ERROR'LEVEL THEN          <<j2246>>50768220
                  ERROR'LEVEL := 0;                            <<j2246>>50768221
               END;                                            <<j2246>>50768222
                                                               <<j2246>>50768223
            IF OPERATOR'ABORT THEN                             <<j2246>>50768224
               BEGIN                                           <<j2246>>50768225
               SENDMESSAGE (SR'OPERATOR'ABORT);                <<j2246>>50768226
               DONT'DO'RECOVERY := TRUE;                       <<j2246>>50768227
               START'REEL := FAILED;                           <<j2246>>50768228
               GO END'START'REEL;                              <<j2246>>50768229
               END;                                            <<j2246>>50768230
                                                               <<j2246>>50768231
            IF DS'ERROR THEN                                   <<j2246>>50768232
               BEGIN                                           <<j2246>>50768233
               SENDMESSAGE (SR'DS'COMM'ERROR);                 <<j2246>>50768234
               DONT'DO'RECOVERY := TRUE;                       <<j2246>>50768235
               START'REEL := FAILED;                           <<j2246>>50768236
               GO END'START'REEL;                              <<j2246>>50768237
               END;                                            <<j2246>>50768238
                                                               <<j2246>>50768239
            IF ERROR'LEVEL > MAX'ERROR'LEVEL THEN              <<j2246>>50768240
$EDIT VOID=50768242                                            <<j2246>>50768241
               BEGIN                                           <<j2246>>50768243
               SENDMESSAGE (RS'ERROR'LEVEL'TOO'DEEP);          <<j2246>>50768244
               DONT'DO'RECOVERY := TRUE;                       <<r2246>>50768245
               START'REEL       := FAILED;                     <<r2246>>50768246
               GO END'START'REEL;                              <<r2246>>50768247
               END;                                            <<r2246>>50768248
$EDIT VOID=50768250                                            <<j2246>>50768250
                                                                        50768251
            IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR   <<j2246>>50768252
               (VIRTDEV) THEN                                  <<j2246>>50768253
               SENDMESSAGE (SR'MOUNT'DIFFERENT'TAPE,,TRUE);    <<j2246>>50768260
            END;                                               <<j2246>>50768261
      IF (REEL'NUM = 1) LOR                                    <<02207>>50870000
         ((SYSDUMPING) LAND (REEL'NUM = SYSDUMP'REELNUM)) THEN <<02207>>50871000
      IF (REEL'NUM = 1) LOR                                    <<02207>>51012000
         ((SYSDUMPING) LAND (REEL'NUM = SYSDUMP'REELNUM)) THEN <<02207>>51012100
         IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR      <<j2246>>51043000
            (VIRTDEV) THEN                                     <<j2246>>51043100
            SENDMESSAGE (SR'MOUNT'NEXT'REEL,,TRUE);                     51044000
         IF (REEL'NUM > 1) LAND (NOT ((SYSDUMPING) LAND        <<02207>>51108000
            (SYSDUMP'REELNUM = REEL'NUM))) THEN                <<02207>>51108010
            IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR   <<j2246>>51108100
               (VIRTDEV) THEN                                  <<j2246>>51108200
                << If powerfail to sdisc on non-virtual >>     <<j2246>>51108210
                << device, don't unload the tape because >>    <<j2246>>51108220
                << we want to retry on the same reel;    >>    <<j2246>>51108230
                << a rewind has already been issued.     >>    <<j2246>>51108240
                                                                        51108300
         IF WRITE'TAPE (TAPE'LABEL'SIZE, TAPE'LABEL, TRUE,     <<j2246>>51156000
            TDBUF, FALSE) = FAILED THEN                        <<j2246>>51160000
            FILE'FAIL (T'NUM, SR'TAPE'MOUNT'FAIL, TRUE)        <<j2246>>51216000
      << -------------------------------------------- >>       <<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
                                                                        51667200
      IF (ERROR'CODE =  89) OR (ERROR'CODE = 18) THEN          <<j2246>>51667300
         POWER'FAIL := TRUE                                    <<j2246>>51667400
      ELSE                                                     <<j2246>>51667500
         POWER'FAIL := FALSE;                                  <<j2246>>51667600
   IF ERROR'CODE >= DS'COMM'ERROR THEN                         <<r9434>>51943000
      DS'ERROR := TRUE;                                        <<r9434>>51943100
                                                                        51943200
   IF (ERROR'CODE =  89) OR (ERROR'CODE = 18) THEN             <<j2246>>51943300
      POWER'FAIL := TRUE                                       <<j2246>>51943400
   ELSE                                                        <<j2246>>51943500
      POWER'FAIL := FALSE;                                     <<j2246>>51943600
   IF (TAPE'SDISC'TOG) LAND (NOT VIRTDEV) THEN                 <<j2246>>51970150
   << --------------------------------------------------- >>   <<j2246>>51970151
   << Call ATTACHIO only if the tape ldev is not a remote >>   <<j2246>>51970152
   << device; otherwise an SF #206 will occur.....        >>   <<j2246>>51970153
   << -------------------------------------------------   >>   <<j2246>>51970154
      ATTACHIO (TAPE'LDEV, 0, 0, 0, REWIND, 0, 0, 0, 1)        <<j2246>>51970155
   ELSE                                                        <<j2246>>51970156
      IF FKONTROL (T'NUM, REWIND) = FAILED THEN                <<j2246>>51970157
         IF NOT VIRTDEV THEN                                   <<j2246>>51970158
            ATTACHIO (TAPE'LDEV,0,0,0,REWIND,0,0,0,1);         <<j2246>>51970159
$EDIT VOID=51970170                                            <<r9434>>51970170
         <<don't check them either for errors>>                <<r9434>>51970190
   IF FKONTROL (T'NUM, REWIND'UNLOAD) = FAILED  THEN           <<j2246>>51970280
      IF NOT VIRTDEV THEN                                      <<j2246>>51970285
      << make sure the tape unloads only if local device >>    <<r9434>>51970286
     ATTACHIO ( TAPE'LDEV, 0, 0, 0, REWIND'UNLOAD, 0, 0, 0, 1);<<j2246>>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
      HOLD'DOUBLE'NUM,                                                  52320100
   REAL                                                                 52322100
      HOLD'REAL'NUM;                                                    52322200
                                                                        52322300
      OLD'HOUR    := 0,       <<used to compute progress  >>   <<j9103>>52384100
$EDIT VOID=52385000                                                     52385000
      RET'ADDR'OF'STORE'A'FILE := 0,                           <<j1551>>52388100
$EDIT VOID=52393000                                                     52393000
$EDIT VOID=52394100                                                     52394100
      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
      IF (SYSDUMPING) LAND (NOT TAPE'SDISC'TOG) THEN           <<j2246>>52598100
         FKONTROL (T'NUM, REWIND'UNLOAD);                      <<j2246>>52598300
                                                                        52598400
                                                               <<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
       DISABLE'ARITHMETIC'TRAPS;                               <<j1900>>53146141
                                                                        53146142
       IF TOTAL'SECTOR'COUNT = 0D THEN                         <<j1900>>53146143
          BEGIN                                                <<j1900>>53146144
          SEEN'PROGRESS := FALSE;                              <<j1900>>53146145
          ENABLE'ARITHMETIC'TRAPS;                             <<j1900>>53146146
          RETURN;                                              <<j1900>>53146147
          END;                                                 <<j1900>>53146148
                                                                        53146149
       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
          HOLD'REAL'NUM := REAL(TOTAL'SECTOR'COUNT) -                   53146261
                           REAL(CUMULATIVE'SECTOR'COUNT);               53146262
          HOLD'REAL'NUM := HOLD'REAL'NUM / REAL(TOTAL'SECTOR'COUNT);    53146263
          HOLD'REAL'NUM := HOLD'REAL'NUM * REAL(100);                   53146264
          HOLD'DOUBLE'NUM := FIXT (HOLD'REAL'NUM);                      53146265
          PARMS'TEMPI'1 := 100 - INTEGER(HOLD'DOUBLE'NUM);     <<m1429>>53146270
$EDIT VOID=53146271                                                     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
      ENABLE'ARITHMETIC'TRAPS;                                 <<J1900>>53146331
       END;                                                    <<m8224>>53146340
                                                               <<m7927>>53181000
      DISABLE'ARITHMETIC'TRAPS;                                <<m7927>>53181100
               IF ATTIO'STATUS.(8:8) = %33 THEN                <<09991>>53266100
                  OPERATOR'ABORT := TRUE;                      <<09991>>53266200
               IF ATTIO'STATUS.(8:8) = %33 THEN                <<09991>>53328100
                  OPERATOR'ABORT := TRUE;                      <<09991>>53328200
                                                               <<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 TAPE'REEL = 0 THEN                                    <<02207>>53864000
         TAPE'REEL := 1;                                       <<02207>>53864100
      IF SYSDUMPING THEN                                       <<02207>>53864200
         SYSDUMP'REELNUM := TAPE'REEL;                         <<02207>>53864300
      TL'REELNUM := TAPE'REEL;                                 <<02207>>53892000
      IF DS'ERROR THEN                                         <<r9434>>54125000
         FAIL (SR'DS'COMM'ERROR );                             <<r9434>>54125100
      IF (ON'ERR = ONERR'QUIT) LOR                             <<02125>>54150000
         (SYSDUMPING LAND TAPE'REEL = SYSDUMP'REELNUM) THEN    <<02207>>54151000
<< Abort the pending IO's for the tape drive and wait for the last>>    54154010
<< IO to complete before retry.                                   >>    54154020
                                                                        54154030
      IF USING'ATTIO THEN                                      <<j1551>>54154040
         BEGIN                                                 <<j1551>>54154050
                                                                        54154060
         DISABLE'ARITHMETIC'TRAPS;                             <<j1551>>54154070
                                                                        54154080
         ABORTIO (TAPE'LDEV);                                  <<j1551>>54154090
                                                                        54154100
         CUR'INX := -1;                                        <<j1551>>54154110
         WHILE (CUR'INX := CUR'INX +1) < NUM'XDS DO            <<j1551>>54154120
            BEGIN                                              <<j1551>>54154130
                                                                        54154140
            IO'INX := FIRST'IO'INX(CUR'INX) - 1;               <<j1551>>54154150
            WHILE (IO'INX := IO'INX + 1) <= LAST'IO'INX(CUR'INX) DO     54154160
               BEGIN                                           <<j1551>>54154170
               IF IO'QUEUE'D (IO'INX) <> 0D THEN               <<j1551>>54154180
                  IOB := WAITFORIO (IO'QUEUE(IO'INX*2));       <<j1551>>54154190
               END;                                            <<j1551>>54154200
            END;                                               <<j1551>>54154210
                                                                        54154220
         ENABLE'ARITHMETIC'TRAPS;                              <<j1551>>54154230
         END;                                                  <<j1551>>54154240
      IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR         <<j2246>>54180100
         (VIRTDEV) THEN                                        <<j2246>>54180200
         SENDMESSAGE (SR'WILL'RE'STORE)                        <<j2246>>54182000
      ELSE                                                     <<j2246>>54182100
         SENDMESSAGE (SR'RE'STORE'CURRENT'REEL);               <<j2246>>54182200
      IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR         <<j2246>>54232300
         (VIRTDEV) THEN                                        <<j2246>>54232400
         MARK'REEL'BAD                                                  54234000
      << ----------------------------------------------- >>    <<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
      ELSE                                                     <<j2246>>54234910
         BEGIN                                                 <<j2246>>54234920
         IOB := 0D;                                            <<j2246>>54234930
         WHILE (ATTIO'STATUS.ATTIO'STATUSf <> ATTIO'GOOD)      <<j2246>>54234940
               LAND (NOT OPERATOR'ABORT) LAND                  <<j2246>>54234950
            ((ERROR'LEVEL:=ERROR'LEVEL+1) < MAX'ERROR'LEVEL) DO<<j2246>>54234951
         << For sdisc powerfail, we want to retry the  >>      <<j2246>>54234952
         << current reel; so simply rewind it.         >>      <<j2246>>54234953
            BEGIN                                              <<j2246>>54234961
            IOB := ATTACHIO (TAPE'LDEV,0,0,0,REWIND,0,0,0,1);  <<j2246>>54234962
            IF ATTIO'STATUS.(8:8) = %33 THEN                   <<j2246>>54234963
               OPERATOR'ABORT := TRUE;                         <<j2246>>54234964
            END;                                               <<j2246>>54234965
                                                               <<j2246>>54234966
         << reset error count if we're going to retry >>       <<j2246>>54234967
         IF ERROR'LEVEL <= MAX'ERROR'LEVEL THEN                <<j2246>>54234970
            ERROR'LEVEL := 0;                                  <<j2246>>54234971
         END;                                                  <<j2246>>54234972
                                                               <<j2246>>54234973
      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
         IF (NOT TAPE'SDISC'TOG) LOR (NOT POWER'FAIL) LOR      <<j2246>>54248100
            (VIRTDEV) THEN                                     <<j2246>>54248200
            SENDMESSAGE (SR'MOUNT'NEXT'REEL,,TRUE);            <<j2246>>54250000
$EDIT VOID=54250600                                                     54250100
            BEGIN                                              <<j2246>>54268100
            IF OPERATOR'ABORT THEN                             <<j2246>>54268200
               SENDMESSAGE (SR'OPERATOR'ABORT);                <<j2246>>54268300
            END;                                               <<j2246>>54270100
               BEGIN                                           <<j1551>>54684810
               ASSEMBLE (DDEL, NOP); << don't return to >>     <<j2093>>54684820
                                     << the caller.     >>     <<j2093>>54684830
               END;                                            <<j1551>>54684910
            BEGIN                                              <<j1551>>54685310
            ASSEMBLE (DDEL, NOP);    << don't return to >>     <<j2093>>54685320
                                     << the caller.     >>     <<j2093>>54685330
            END;                                               <<j1551>>54685410
            BEGIN                                              <<j1551>>54685540
            ASSEMBLE (DDEL, NOP);     << don't return to >>    <<j2093>>54685550
                                      << the caller.     >>    <<j2093>>54685560
            END;                                               <<j1551>>54685601
      RET'ADDR'OF'STORE'A'FILE := S0;                          <<j1551>>54724100
         IF START'REEL (TDBUF, TAPE'REEL) = FAILED THEN        <<02125>>54742000
      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
$EDIT                                                                   55210000
            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
         IF USING'ATTIO THEN                                   <<01702>>55438100
            BEGIN                                              <<01702>>55438200
            SAVE'REEL:=TL'REELNUM;                             <<01702>>55438210
                                                                        55438220
            IF WRITE'TAPE'MARK (PARMS'TEMPI'1) = FAILED THEN   <<01702>>55438230
               IF PARMS'TEMPI'1 <> EOTCODE THEN                <<01702>>55438240
                  RECOVER'ERROR (SR'TAPE'WRITE'FAIL)           <<01702>>55438250
               ELSE                                            <<01702>>55438260
                  BEGIN                                        <<01702>>55438270
                  IF FINISH'REEL (TDBUF, TRUE) = FAILED THEN   <<01702>>55438280
                     RECOVER'ERROR (SR'TAPE'WRITE'FAIL);       <<01702>>55438290
                  IF TL'ZFIELD = 0 THEN                        <<01702>>55438300
                     IF START'REEL (TDBUF, TAPE'REEL+1) = FAILED THEN   55438310
                        RECOVER'ERROR (SR'UNABLE'TO'START'REEL);        55438320
                  END;                                         <<01702>>55438330
                                                                        55438340
            IF SAVE'REEL <> TL'REELNUM THEN                    <<01702>>55438350
               SAVE'STATE (STATE'5);                           <<01702>>55438360
            END;                                               <<01702>>55438370
                                                                        55438380
                                                                        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
         BEGIN                                                 <<j1551>>55888100
         << save return address for STORE'A'FILE because >>    <<j1551>>55888110
         << we'll branch from RECOVER'ERROR directly to  >>    <<j1551>>55888120
         << STORE'A'FILE.                                >>    <<j1551>>55888130
         TOS := RET'ADDR'OF'STORE'A'FILE;                      <<j1551>>55888200
         END;                                                  <<j1551>>55890100
   IF FINISH'REEL(TDBUF,TRUE)=FAILED THEN <<end of final reel>><<m9577>>55920000
      BEGIN                                                    <<j2246>>55920100
      << will not return here; instead we'll branch from >>    <<j2246>>55920200
      << RECOVER'ERROR to STORE'A'FILE; Therefore, we    >>    <<j2246>>55920300
      << need return address for STORE'A'FILE.           >>    <<j2246>>55920400
      TOS := RET'ADDR'OF'STORE'A'FILE;                         <<j2246>>55920500
      RECOVER'ERROR (0);                                       <<j2246>>55921000
      END;                                                     <<j2246>>55921100
$EDIT VOID=55928000                                                     55924000
$EDIT VOID=60008300                                            <<m2175>>60008100
                                                               <<m2175>>60009100
   EQUATE                                                      <<m2175>>60009200
      MAX'C'RECS       = 50;                                   <<m2175>>60009300
      C'EOF'REC   := -1D,                                      <<m2175>>60014010
      ALL'CBUFS   (0 : MAX'C'RECS * CANDIDAT'RECSIZE),         <<m2175>>60017100
                                                               <<m2175>>60020100
   LOGICAL ARRAY                                               <<m2175>>60020200
      C'REC'READ (0 : MAX'C'RECS - 1);                         <<m2175>>60020300
$EDIT VOID=60022100                                            <<m2175>>60022100
      WANTED'FILE := FALSE,                                    <<01896>>60030100
      MOVE GBUF(G'TITLE'INX) :=TDBUF(ML),(3*FILE'PART'WORDS),2;<<01896>>60127000
      MOVE * := LOOK'LOCK, (FILE'PART'WORDS);                  <<01896>>60127100
             LOR (LOGON'GROUP'<>LOOK'GROUP',(FILE'PART'SIZE))  <<s9506>>60165100
   SUBROUTINE CHECK'WANTED'FILE (P');                          <<01896>>60183000
$EDIT VOID=60201000                                            <<01896>>60201000
      WANTED'FILE := FALSE;                                    <<m2175>>60232100
                                                               <<m2175>>60241100
         << if we know where the candidate file eof is, then >><<m2175>>60241200
         << see if we are attempting to read past it.        >><<m2175>>60241300
                                                               <<m2175>>60241400
         IF C'EOF'REC <> -1D THEN                              <<m2175>>60241500
            IF C'REC = C'EOF'REC THEN                          <<m2175>>60241600
                RETURN;                                        <<m2175>>60241700
                                                               <<m2175>>60241800
$EDIT VOID=60241900                                            <<m2175>>60241900
         << see if we have already read the c'rec record >>    <<m2175>>60241910
                                                               <<m2175>>60241920
         IF C'REC < DOUBLE (MAX'C'RECS) AND                    <<m2175>>60241930
            C'REC'READ (INTEGER(C'REC)) THEN                   <<m2175>>60242000
               MOVE CANDIDAT'BUF :=                            <<m2175>>60242020
                    ALL'CBUFS(INTEGER(C'REC)*CANDIDAT'RECSIZE),<<m2175>>60242030
                    (CANDIDAT'RECSIZE)                         <<m2175>>60242040
         ELSE                                                  <<m2175>>60242050
            BEGIN                                              <<m2175>>60242060
$EDIT VOID=60242100                                            <<m2175>>60242100
            FREADDIR (CANDIDAT, CANDIDAT'BUF,                  <<m2175>>60243000
                      CANDIDAT'RECSIZE, C'REC);                <<m2175>>60244000
            IF < THEN                                          <<m2175>>60245000
               FILE'FAIL (CANDIDAT, RS'READ'CANDIDAT'FAIL);    <<m2175>>60246000
            IF > THEN                                          <<m2175>>60248000
               BEGIN                                           <<m2175>>60248100
               C'EOF'REC := C'REC; << now know where eof is >> <<m2175>>60248200
               RETURN;              <<failed to find match>>   <<m2175>>60249000
               END;                                            <<m2175>>60249100
                                                               <<m2175>>60249200
            << save the record for future use >>               <<m2175>>60249300
                                                               <<m2175>>60249400
            IF C'REC < DOUBLE (MAX'C'RECS) THEN                <<m2175>>60249500
               BEGIN                                           <<m2175>>60249600
               MOVE ALL'CBUFS(INTEGER(C'REC)*CANDIDAT'RECSIZE) <<m2175>>60249700
                    := CANDIDAT'BUF, (CANDIDAT'RECSIZE);       <<m2175>>60249800
               C'REC'READ (INTEGER(C'REC)) := TRUE;            <<m2175>>60249900
               END;                                            <<m2175>>60249910
            END;                                               <<m2175>>60249920
                  RETURN;                                      <<m2175>>60300100
                  WANTED'FILE:=TRUE;                           <<m2175>>60304000
                     IF C'REC < DOUBLE (MAX'C'RECS) THEN       <<m2175>>60304410
                        MOVE ALL'CBUFS(INTEGER(C'REC) *        <<m2175>>60304420
                        CANDIDAT'RECSIZE) := CANDIDAT'BUF,     <<m2175>>60304430
                        (CANDIDAT'RECSIZE);                    <<m2175>>60304440
$EDIT VOID=60305000                                                     60305000
               WANTED'FILE:=TRUE;                              <<m2175>>60311000
                     FWRITEDIR (CANDIDAT, CANDIDAT'BUF,                 60311400
                        CANDIDAT'RECSIZE, C'REC - 1D);                  60311401
                     IF C'REC < DOUBLE (MAX'C'RECS) THEN       <<m2175>>60311410
                        MOVE ALL'CBUFS (INTEGER(C'REC-1D) *    <<m2283>>60311420
                        CANDIDAT'RECSIZE) := CANDIDAT'BUF,     <<m2175>>60311430
                        (CANDIDAT'RECSIZE);                    <<m2175>>60311440
$EDIT VOID=60312000                                                     60312000
                                                               <<m2175>>60315001
         IF WANTED'FILE THEN                                   <<01896>>60315010
            BEGIN                                              <<01896>>60315020
            IF CHECK'FILE'ACCESS=FAILED THEN                   <<01896>>60315030
               INCREMENT'REJECTED (FILES'REJ'ACCESS)           <<01896>>60315040
            ELSE                                               <<01896>>60315050
               ADD'FILE'TO'GOOD;                               <<01896>>60315060
            RETURN;                                            <<m2175>>60315061
            END;                                               <<m2175>>60315070
$EDIT VOID=60315090                                            <<m2175>>60315080
         CHECK'WANTED'FILE (TDBUF'(ML*2));                     <<01896>>60387000
$EDIT VOID=60404000                                            <<01896>>60388000
                                                               <<m2175>>60461100
      FILL (C'REC'READ, MAX'C'RECS, FALSE);                    <<m2175>>60461200
               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  <<s9586>>60633051
   GO TO END'DB'IRESTORE; <<restore root only>>                <<s9586>>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
      P'GROUP'NAME     = ARQ (PARMS+11)#,                      <<09945>>70230000
      P'PAGE'NUM       = ARQ (PARMS+15)#,                      <<09945>>70230100
      P'XCOUNT         = ARQ (PARMS+16)#,                      <<09945>>70230200
      P'EMISCWD        = ARQ (PARMS+17)#;                      <<09945>>70230300
$EDIT VOID=70241000                                            <<07346>>70239000
      MVTABX,                                                  <<09945>>70244100
      I,                                                       <<09945>>70244200
   LOGICAL                                                     <<09945>>70247100
      PVGROUP        :=  FALSE;                                <<09945>>70247200
                                                               <<09945>>70247300
   INTEGER POINTER                                             <<09945>>70247400
      S0PNTR          =  S - 0;                                <<09945>>70247500
                                                               <<09945>>70247600
      DIR'SIR'INFO    =  DSEG(%212)  #,                        <<07346>>70250100
      PAGE'NUM        =  DSEG(%215)  #,                        <<09945>>70250200
      DBDIRTY         =  DSEG'L(%247).(15:01) #,               <<09945>>70252000
      XCOUNT          =  DSEG(%230)  #,                        <<09945>>70252100
      EMISCWD         =  DSEG(%261)  #;                        <<09945>>70252200
   DOUBLE                                                      <<09945>>70253010
      DIRBASE         =  DSEG + %270;                          <<09945>>70253020
                                                               <<09945>>70253030
   << The system directory base is at SYSGLOB %130 and %131 >> <<09945>>70253040
   DEFINE                                                      <<09945>>70253050
      SGLOBDIRBASE1   =  ABSOLUTE(%1130)#,                     <<09945>>70253060
      SGLOBDIRBASE2   =  ABSOLUTE(%1131)#,                     <<09945>>70253070
      SYSLDEV         =  1#;                                   <<09945>>70253080
                                                               <<09945>>70253090
   DEFINE                                                      <<09945>>70253100
      << switches DIRBASE in DDS to the system's >>            <<09945>>70253110
      GET'SYS'DIRBASE =                                        <<09945>>70253120
         TOS := SGLOBDIRBASE1;                                 <<09945>>70253130
         TOS.(0:8) := SYSLDEV;                                 <<09945>>70253140
         TOS := SGLOBDIRBASE2;                                 <<09945>>70253150
         DIRBASE := TOS#,                                      <<09945>>70253160
                                                               <<09945>>70253170
      << switches DIRBASE in DDS to Private Volume's >>        <<09945>>70253180
      GET'PV'DIRBASE =                                         <<09945>>70253190
         TOS := @DIRBASE;  << Target offset >>                 <<09945>>70253200
         TOS := MVTAB'DST;  << Source DST >>                   <<01231>>70253210
         TOS := (MVTABX * SIZE'OF'MVTAB'ENTRY) + 2; <<offset>> <<01231>>70253220
         TOS := 2;         << count >>                         <<09945>>70253230
         ASSEMBLE (MFDS 4)#;                                   <<09945>>70253240
                                                               <<09945>>70253250
            PVGROUP := TRUE;                                   <<09945>>70281010
            IF LOGICAL (P'LOCK) THEN                           <<09945>>70281020
               BEGIN                                           <<09945>>70281030
               << Save these for DIRREADing the entry again >> <<09945>>70281040
               P'PAGE'NUM := PAGE'NUM;                         <<09945>>70281050
               P'XCOUNT   := XCOUNT;                           <<09945>>70281060
               P'EMISCWD  := EMISCWD;                          <<09945>>70281070
               END                                             <<09945>>70281080
            ELSE                                               <<09945>>70281090
               MVTABX := ELEMENT (GLINKAGE).MVTABXf;           <<09945>>70281100
               DIRWRITE (DATA'AREA'B);                         <<09945>>70283000
                                                               <<09945>>70284000
            RELSIR (SIR'NUMBER, SIR'INFO);                     <<09945>>70285000
$EDIT VOID=70291000                                            <<09945>>70286000
               END;                                            <<09945>>70304000
                                                               <<09945>>70305000
            SIR'INFO := GETSIR (SIR'NUMBER);                   <<09945>>70306000
$EDIT VOID=70309000                                            <<09945>>70307000
            << 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
            IF PVGROUP THEN                                    <<09945>>70316010
            << All these contortions for private volumes are >><<09945>>70316020
            << to make sure that we lock/unlock the file     >><<09945>>70316030
            << index block in the private volume directory,  >><<09945>>70316040
            << not the system.                               >><<09945>>70316050
               BEGIN                                           <<01159>>70316051
               IF LOGICAL (P'LOCK) THEN                        <<09945>>70316060
                  BEGIN                                        <<09945>>70316070
                  << If the group is on a PV, it has just    >><<09945>>70316080
                  << been mounted.  MOUNT has entirely       >><<09945>>70316090
                  << changed the contents of the directory   >><<09945>>70316100
                  << data segment, including DIRBASE.  We    >><<09945>>70316110
                  << must read back in the group entry block >><<09945>>70316120
                  << that we had previous to the MOUNT.  The >><<09945>>70316130
                  << MOUNT has bound the group to the PV, and>><<09945>>70316140
                  << the GFIPNTR will have been changed to   >><<09945>>70316150
                  << that on the PV.  That's the one we want.>><<09945>>70316160
                  GET'SYS'DIRBASE;                             <<09945>>70316170
                  DIRREAD (P'PAGE'NUM, DATA'AREA'A, P'XCOUNT,  <<09945>>70316180
                           P'EMISCWD);                         <<09945>>70316190
                  << move group name into D'SEG'L(0) for     >><<09945>>70316200
                  << DIRSCAN to match                        >><<09945>>70316210
                  I := -1;                                     <<09945>>70316220
                  WHILE (I:=I+1) < NAMESIZE DO                 <<09945>>70316230
                  << DSEG'L(I) := P'GROUP'NAME(I); >>          <<09945>>70316240
                     DSEG'L(I) := ARQ(PARMS+11+I);             <<09945>>70316250
                  TOS := DIRSCAN (DSEG'L, DATA'AREA'A);        <<09945>>70316260
                  IF <= THEN                                   <<09945>>70316270
                     BEGIN                                     <<01159>>70316280
                     P'ERROR := M'DIREC'UNXPECTED'ERROR;       <<01159>>70316281
                     RC'LOCK'DIRECTORY := RC'STOP;             <<01159>>70316282
                     GO EXIT;                                  <<01159>>70316283
                     END;                                      <<01159>>70316284
                  P'FILE'INX'2 := S0PNTR (GFIPNTR);            <<09945>>70316290
                  MVTABX := S0PNTR (GLINKAGE).MVTABXf;         <<09945>>70316300
                  ASSEMBLE (DEL);                              <<09945>>70316310
                  GET'PV'DIRBASE;                              <<09945>>70316320
                  END                                          <<09945>>70316330
               ELSE    << unlocking >>                         <<09945>>70316340
                  << P'FILE'INX'2 is currently the group file>><<09945>>70316350
                  << index pointer for the private volume.   >><<09945>>70316360
                  << Switch DIRBASE to PV before doing a DIR->><<09945>>70316370
                  << READ.  The PV DIRBASE is obtained from  >><<09945>>70316380
                  << the Mounted Volume table.               >><<09945>>70316390
                  BEGIN                                        <<01159>>70316391
                  GET'PV'DIRBASE;                              <<09945>>70316400
                  END;                                         <<01159>>70316401
               END;                                            <<01159>>70316402
                                                               <<09945>>70316410
                                                               <<09945>>70323010
            IF PVGROUP AND NOT LOGICAL (P'LOCK) THEN           <<09945>>70323020
               BEGIN                                           <<09945>>70323030
               << Post contents of DB area to disc before    >><<09945>>70323040
               << DISMOUNT changes it.  Do the DISMOUNT now  >><<09945>>70323050
               << that the file index block has been un-     >><<09945>>70323060
               << locked.  The Directory Sir must be         >><<09945>>70323070
               << released during that time.                 >><<09945>>70323080
               DIRWRITE (DATA'AREA'B);                         <<09945>>70323090
               RELSIR (SIR'NUMBER, SIR'INFO);                  <<09945>>70323100
               EXCHANGEDB (0);                                 <<09945>>70323110
               DISMOUNT'VOLUME'SET (P'GROUP'NAME, P'ACCT'NAME, <<09945>>70323120
                                    PV'INFO);                  <<09945>>70323130
               SIR'INFO := GETSIR (SIR'NUMBER);                <<09945>>70323140
               EXCHANGEDB (DIRDST);                            <<09945>>70323150
               DIR'SIR'INFO := SIR'INFO;                       <<09945>>70323160
               END;                                            <<09945>>70323170
                                                               <<09945>>70323180
$EDIT VOID=70340000                                            <<07346>>70336000
EXIT:                                                          <<01159>>70340000
   RC'LOCK'DIRECTORY.(15:1) := TRUE;  <<still have dir Sir>>   <<07346>>70342000
      P'PAGE'NUM       = ARQ (PARMS+15)#,                      <<09945>>70387100
      P'XCOUNT         = ARQ (PARMS+16)#,                      <<09945>>70387200
      P'EMISCWD        = ARQ (PARMS+17)#,                      <<09945>>70387300
      P'SIZE           = 18 #;                                 <<09945>>70388000
         DISABLE'ARITHMETIC'TRAPS;                                      70539100
         ENABLE'ARITHMETIC'TRAPS;                                       70541100
         DISABLE'ARITHMETIC'TRAPS;                             <<m7927>>70666100
         ENABLE'ARITHMETIC'TRAPS;                              <<m7927>>70667100
         DISABLE'ARITHMETIC'TRAPS;                             <<m7927>>70816100
         ENABLE'ARITHMETIC'TRAPS;                              <<m7927>>70817100
PROCEDURE DISPLAY'3'TO'DISPLAY (TARGET,LEN,FILENAME,GROUPNAME, <<01700>>71457000
                                ACCTNAME,LOCKWORD);            <<01700>>71457100
      ACCTNAME,                         ! ACCOUNT NAME         <<01700>>71463000
      LOCKWORD;                         ! LOCKWORD             <<01700>>71463100
   OPTION VARIABLE;                                            <<01700>>71463200
   ! of target. Blanks are suppressed.  Maximum of LEN is 35.  <<01895>>71468000
   !    filename/lockword.groupname.acctname                   <<01895>>71470000
$EDIT VOID=71474000                                            <<01700>>71473000
LOGICAL                                                        <<01895>>71476100
   PMAP = Q-4;                                                 <<01895>>71476200
DEFINE                                                         <<01895>>71476300
   LOCKWORD'SENT = PMAP.(15:1)#;                               <<01895>>71476400
   FILL' (TARGET, 4*FILE'PART'SIZE+4, " ");                    <<01895>>71478000
   <<if DBSTORE/DBRESTORE, maint'word s to be checked by DB >> <<01895>>71482001
   IF DBSTORE'TOG OR DBRESTOR'TOG THEN                         <<01895>>71482002
   ELSE IF LOCKWORD'SENT AND (LOCKWORD <> " ") THEN            <<01895>>71482010
$EDIT VOID=71482011                                            <<01895>>71482011
      BEGIN                                                    <<01700>>71482020
      SCANSTOP := "/";                                         <<01700>>71482030
      MOVE SCANSTOP(1) := LOCKWORD, (FILE'PART'SIZE);          <<01700>>71482040
      SCAN SCANSTOP UNTIL " ", 1;                              <<01700>>71482050
      @SCANSTOP := TOS;                                        <<01700>>71482060
      END;                                                     <<01700>>71482070
      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
      BEGIN                                                    <<02026>>72013100
          MOVE FLCLASS' := DEVICE',(FILE'PART'SIZE);           <<02026>>72013200
          PICK'A'DEVICE := TRUE;                               <<02026>>72014000
      END                                                      <<02026>>72014100
$EDIT VOID=72102800                                            <<01894>>72102500
$EDIT VOID=72405000                                            <<R1623>>72404000
            RET (M'FILE'EXCL'ACC)                              <<R1623>>72413000
         ELSE IF OLD'LOADED THEN                               <<R1623>>72413010
            RET (M'LOADED);                                    <<01894>>72413020
$EDIT VOID=72413140                                            <<01894>>72413030
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
$EDIT VOID=72456242                                            <<l1778>>72456242
$EDIT VOID=72456245                                            <<l1778>>72456243
   IF NOT ACCCHECK (FILELEVEL, FLACCTNAME', FILE'NTRY'ACCT'SEC,<<s9506>>72456246
      FLGRPNAME', FILE'NTRY'GROUP'SEC, FLUSERID',              <<l1778>>72456247
      FLSECMX).(READf) THEN                                    <<s9506>>72456248
         RET (M'CANT'READ'TAPE'FILE);                          <<s9506>>72456249
      END;                                                     <<l1778>>72456250
$EDIT VOID=72466800                                            <<01894>>72459000
   IF LOCAL'FLAG THEN                                          <<s9506>>72468000
      IF (NOT SM'TOG) THEN                                     <<s9532>>72468050
         ASSERT'ACCT'GROUP'ACCESS;                             <<s9532>>72468100
                                                               <<01894>>72476100
      <<------------------------------------------------->>    <<01894>>72476200
      << FIX FOR THE AUTOALLOCATE FEATURE                >>    <<01894>>72476300
      <<   If a file is trying to be restored and it is  >>    <<01894>>72476400
      <<   loaded it may have been kept loaded by the    >>    <<01894>>72476500
      <<   autoallocate feature and the reference count  >>    <<01894>>72476600
      <<   may be 0.  If this is so the file can be      >>    <<01894>>72476700
      <<   unloaded and allow the restore to continue.   >>    <<01894>>72476800
      <<------------------------------------------------->>    <<01894>>72476900
                                                               <<01894>>72476910
      IF OLD'LOADED THEN                                       <<01894>>72476920
         BEGIN                                                 <<01894>>72476930
         RELEASE'SIRS (TRUE,TRUE);                             <<01894>>72476940
         DEALLOC'IF'AUTOALLOC(OLD'LDEV,OLD'ADDRESS,            <<01894>>72476950
                              OLD'FCODE,0);                    <<01894>>72476960
         GET'SIRS (TRUE,TRUE);                                 <<01894>>72476970
         IF LOCAL'FLAG THEN                                    <<01894>>72476980
            IF (NOT SM'TOG) THEN                               <<01894>>72476990
               ASSERT'ACCT'GROUP'ACCESS;                       <<01894>>72476991
         OLD'COPY'EXISTS := DOES'OLD'COPY'EXIST;               <<01894>>72476992
         IF OLD'COPY'EXISTS                                    <<01894>>72476993
           THEN EVAL'RETURN( LABELIO(OLD'FLAB,OLD'LDEV,        <<01894>>72476994
                            OLD'ADDRESS,ATTIO'READ,RES'TITLE));<<01894>>72476995
         END; <<THEN OLD'LOADED>>                              <<01894>>72476996
                                                               <<01894>>72476997
      IF OLD'COPY'EXISTS THEN                                  <<01894>>72476998
         BEGIN                                                 <<01894>>72476999
         ASSERT'NOT'BUSY;                                      <<01894>>72477000
         LOCK'OLD'FILE;                                        <<01894>>72478000
         RELEASE'SIRS (TRUE, TRUE);                            <<01894>>72479000
         WRITE'ACCESS'CHECK;                                   <<01894>>72480000
         FILE'CODE'CHECK;                                      <<01894>>72481000
         OLD'LOCKWORD'CHECK;                                   <<01894>>72482000
         GET'OLD'FILE'SIZE;                                    <<01894>>72483000
         ADJUST'SECTORS;                                       <<01894>>72484000
         END; <<OLD'COPY'EXISTS>>                              <<01894>>72484100
      END; <<OLD'COPY'EXISTS>>                                 <<01894>>72485000
$EDIT VOID=72488100                                                     72488100
$EDIT VOID=72498000                                            <<01894>>72489000
   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:4 * FILE'PART'SIZE+3);                      <<01895>>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 := 200D;  << if we can not find out, >>    <<s9586>>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:4 * FILE'PART'SIZE+3);  << File name >>  <<01895>>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
         BUF'INX:=0;   << dont forget inner loop cnt >>                 74181100
                                                               <<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
   IF NOT SEEN'ACCT THEN                                       <<01022>>74567100
      MOVE LAST'ACCT' := RES'ACCT', (FILE'PART'SIZE);                   74568000
   MOVE LAST'RES'USER' := "        ";                          <<01133>>74569100
                                                               <<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
      TITLE'           (0:35);                   ! FILE TITLE  <<01895>>74717000
      OLD'FILE'HIDDEN               := FALSE,                  <<p9364>>74749000
      OLD'FILE'PURGED               := FALSE;                  <<p9364>>74749100
         IF <> THEN                                            <<09990>>74777000
            BEGIN                                              <<09990>>74777010
            RELEASE'SIRS (TRUE, TRUE);                         <<09990>>74777020
            SENDMESSAGE (DIRECTORY'ERROR (DR));                <<09990>>74777030
            END;                                               <<09990>>74777040
         IF <> THEN                                            <<09990>>74784000
            BEGIN                                              <<09990>>74784010
            RELEASE'SIRS (TRUE, TRUE);                         <<09990>>74784020
            SENDMESSAGE (DIRECTORY'ERROR (DR));                <<09990>>74784030
            END;                                               <<09990>>74784040
                                                                        74784050
      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
         DR := DIRECPURGEFILE (-FILE'SECTORS, PARMS'TEMPI'1,            74796000
         IF <> THEN                                            <<09990>>74799000
            BEGIN                                              <<09990>>74799010
            RELEASE'SIRS (TRUE, TRUE);                         <<09990>>74799020
            SENDMESSAGE (DIRECTORY'ERROR (DR));                <<09990>>74799030
            END;                                                        74799040
                                                                        74799050
      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 <<m'word to be checked by DBRES>> <<s9586>>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
      LAST'RES'USER' <>  "  "    LAND                          <<01133>>74972100
      LAST'RES'USER' = RES'CREATOR', (FILE'PART'SIZE) THEN     <<01133>>74973000
      RETURN                                                   <<01133>>74974000
$EDIT VOID=74980000                                                     74979000
      IF CHECK'USER (RES'ACCT',RES'CREATOR',SUB'CODE) = FAILED          74981000
   IF FILE'SECTORS = -1D THEN                                  <<09901>>75006100
      FAIL (M'BAD'FILE'SIZE)                                   <<09901>>75006200
   ELSE                                                        <<09901>>75006300
      FILE'MAX'SECTORS := FIND'FILE'SIZE (FILE'SIZE'MAXv,               75007000
                                          EXTENT'SIZES);                75007100
      FLMODTIME := CLOCK;                                      <<01530>>75036100
   MOVE LOOK'LOCK := GBUF(G'LOCKWORD'INX), (FILE'PART'WORDS);  <<01896>>75094100
      DR := DIRECINSERTFILE (FILE'MAX'SECTORS, PARMS'TEMPI'1,  <<07344>>75185000
                             RES'ACCT, RES'GROUP, RES'FILE,    <<07344>>75185100
                             FADDR, PVMVTABX);                 <<07344>>75186000
         BEGIN                                                 <<09990>>75188010
         RELEASE'SIRS (TRUE, TRUE);                            <<09990>>75188020
         END;                                                  <<09990>>75189100
            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
                         RES'GROUP', RES'ACCT', LOOK'LOCK');   <<01896>>75280000
   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
      MSG'CORRUPTED'FILE         = 1142,                       <<09901>>80592210
      MSG'BAD'FILE'SIZE          = 1143,                       <<09901>>80592220
         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
         M'CORRUPTED'FILE,                                     <<09901>>80926090
               2,    P'NSR, MSG'CORRUPTED'FILE,                <<09901>>80926100
         M'BAD'FILE'SIZE,                                      <<09901>>80926200
               2,    P'NSR, MSG'BAD'FILE'SIZE,                 <<09901>>80926300
                                                               <<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
