*DECK DBQRFA
USETEXT CDCSCTX 
      PRGM DBQRFA;
*CALL COPYRDCLS 
      BEGIN 
 #
* *   DBQRFA - APPLY QRF TO A DATABASE           PAGE  1
* *   J E ESLER                                  DATE  12/6/76
* *   A W ALLEN - DATABASE VERSIONS              DATE  08/15/80 
* 
* DC  PURPOSE 
* 
*     READ THE BLOCKS SAVED ON THE QUICK RECOVERY FILE AND WRITE THEM 
*     ON THE APPROPRIATE DATABASE FILES, RESTORING THE DATABASE TO THE
*     LAST RECOVERY POINT FOR THE SPECIFIED SCHEMA. 
* 
* DC  ENTRY CONDITIONS
* 
*     THE MASTER DIRECTORY AND QRF ARE PRESENT AT THE CONTROL POINT.
* 
* DC  EXIT CONDITIONS 
* 
*     FILES WITH BLOCK LOGGING HAVE BEEN RESTORED, IF POSSIBLE.  A LIST 
*     OF RESTORED AND UNRESTORED FILES IS PROVIDED. 
* 
* DC  CALLING ROUTINES
* 
*     CALLED BY CONTROL CARD
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ABRT;           #ISSUE ABORT REQUEST#
      XREF PROC DB$ATWR;           #ATTACH A P.F.#
      XREF FUNC DB$CBIN;           #CONVERT DISPLAY CODE TO BINARY# 
      XREF FUNC DB$CDIS C(10);     #CONVERT BINARY TO DISPLAY CODE# 
      XREF FUNC DB$CFIL C(30);     #BLANK FILL AN ITEM# 
      XREF PROC DB$IORD;           #ISSUE CIO READ# 
      XREF PROC DB$IORE;           #READ QRF, POSITION AT NEXT PRU# 
      XREF PROC DB$IORW;           #ISSUE CIO REWIND# 
      XREF PROC DB$IOWR;           #ISSUE CIO (RE)WRITE#
      XREF FUNC DB$LFN;            # CREATE LFN FOR FILE               #
      XREF FUNC DB$LNK;            # LINK CMM BLOCK IN CHAIN           #
      XREF PROC DB$MDER;           #MD ERROR PROCESSOR# 
      XREF PROC DB$MFA;            #ALLOCATE FIXED MM BLOCK#
      XREF PROC DB$MSG;            #ISSUE DAYFILE MESSAGE#
      XREF PROC DB$RCLL;           #REQUEST RECALL# 
      XREF PROC DB$RNRW;           #DO A RANDOM REWRITE#
      XREF PROC DB$RTN;            #RETURN A P.F.#
      XREF FUNC DB$STAT;           #GET STATUS OF LFN#
      XREF PROC DB$VEPF;           # GET PF INFO FOR VERSION OF AN AREA#
      XREF PROC DB$VEPN;           # GET PRIMARY VERSION NAME          #
      XREF PROC DB$VERL;           # VERSION NAME LOOK-UP              #
      XREF PROC DB$WGET;           #READ MASTER DIRECTORY#
      XREF PROC DB$WOPN;           #OPEN MASTER DIRECTORY#
# 
* DC  NON-LOCAL VARIABLES 
# 
      XREF ARRAY DB$RA0;     #ARRAY BASED AT RA+0#
        BEGIN 
        ITEM CCPARAM U(0,0,42);   #CONTROL CARD PARAMETER#
        ITEM CCSEP   U(0,54,6);   #CONTROL CARD SEPARATER#
        ITEM NUMCCPR U(0,42,18);  #NUMBER OF CONTROL CARD PARAMETERS# 
        END 
*CALL FITMDDCLS 
  
      XREF ARRAY DB$IOFT ;
        BEGIN 
        ITEM QFFETLFN C(0,0,7);        #QRF FET LFN                    #
        ITEM QFFETEC  U(0,46,5);   #QRF FET ERROR CODE                 #
          ITEM QFFETECNOS U(0,46,4);   #NOS ERROR CODE                 #
          ITEM QFFETECNB  U(0,46,5);   #NOS/BE ERROR CODE              #
        ITEM QFFETST  U(0,51,9);   #QRF FET CODE/STATUS                #
        ITEM QFFETFIR    (1,42,18);    #QRF FET FIRST POINTER          #
        ITEM QFFETIN    (2,42,18);     #QRF FET IN POINTER             #
        ITEM QFFETOUT    (3,42,18);    #QRF FET OUT POINTER            #
        ITEM QFFETLIM    (4,42,18);    #QRF FET LIMIT POINER           #
        END 
      XREF ITEM DB$NOSU B;         # TRUE = NOS, FALSE = NOS/BE        #
      XREF ARRAY DB$RNFT;          #SKELETON FET FOR RANDOM I/O#
        ITEM RNFTWD U(0,0,60);
# 
* 
* DC  DESCRIPTION 
* 
*     VERIFY CONTROL CARD PARAMETERS (CRACKCC). 
*     READ QRF HEADER BLOCK.
*     STOP IF QRF IS EMPTY. 
*     FIND SCHEMA ENTRY IN MASTER DIRECTORY AND CREATE AN SAL.
*     FOR EACH BLOCK ON THE QRF 
*       BEGIN 
*       IF I/O ERROR OR INVALID AREA ID 
*       THEN
*         ABORT DBQRFA RUN
*       FIND PERMANENT FILE ENTRY FOR THIS QRF BLOCK (FINDFILE).
*       IF FILE NOT ATTACHED
*       THEN
*         ATTACH DATABASE FILE AND INDEX FILE (ATTACHAREA). 
*       IF NO ERRORS ON ATTACH
*       THEN
*         APPLY QRF BLOCK TO DATABASE (APPLYBLOCK). 
*       END 
* 
*     (END OF QRF)
*     RETURN DATABASE AND INDEX FILES.
*     RE-INITIALIZE QRF.
* 
*     INTERNAL PROCEDURES-- 
* 
*     ABORT                        ISSUE ERROR MESSAGE AND ABORT
*     SETFET                       INITIALIZE FET FOR A DATABASE FILE 
*     APPLYBLOCK                   APPLY QRF BLOCK TO SPECIFIED DATABASE
*                                  OR INDEX FILE
*     ATTACHAREA                   ATTACH A DATABASE AND INDEX FILE 
*     FINDFILE                     FIND PERMANENT FILE ENTRY FOR A
*                                  VERSION AND AREA 
*     CRACKCC                      INTERPRET CONTROL CARD PARAMETERS
*     RETURNAREAS                  RETURN DATABASE AND INDEX FILES
* 
 #
# 
*     LOCAL VARIABLES 
# 
      DEF DFEOP #O"31"#;           #END OF PARTITION CODE#
      DEF DFEQUAL #2#;             #CODE FOR = ON CONTROL CARD# 
      DEF DFMAXBKSZ #O"20000"#;    #MAXIMUM CRM BLOCK SIZE# 
      DEF DFRANDFETLN #8#;         #LENGTH OF FET FOR RANDOM FILE#
  
      ITEM AREAID;                 #AREA ID, INTEGER, FOR QRF BLOCK#
      ITEM AREAMSG1  C(52) =
               "  AREA ID = 0000, LAST CLOSED DDDDDDDDDDTTTTTTTTTT: ";
      ITEM AREAMSG2  C(52) =
               "    DATE/TIME FROM QRF FSTT   DDDDDDDDDDTTTTTTTTTT: ";
  
      BASED ARRAY ATTACHINFO;      #TEMPLATE FOR PF ATTACH INFORMATION# 
        BEGIN 
        ITEM PFNAME U(0,0,42);     #PERM FILE NAME# 
        END 
      ITEM BLOCKCHAIN    =0;       # POINTER TO FIRST BLOCKTBL ENTRY   #
  
      BASED ARRAY BLOCKTBL S(3);   # TABLE OF QRF BLOCK CONTROL WORDS  #
                                   # FOR APPLIED BLOCKS.               #
        BEGIN 
        ITEM BLOCKPRIOR I(0,24,18); 
        ITEM BLOCKNEXT  I(0,42,18); 
        ITEM BLOCKCTL0  U(1,0,60); # BLOCK CONTROL WORD ZERO.          #
        ITEM BLOCKCTL1  U(2,0,60); # BLOCK CONTROL WORD ONE.           #
        END 
  
      BASED ARRAY FET;             #DATABASE AREA FET#
        BEGIN 
        ITEM FETWORD U(0,0,60); 
        ITEM FETLFN U(0,0,42);
        ITEM FETNBAT U(0,46,5);    # ERROR CODE FOR NOS/BE             #
        ITEM FETNOSAT U(0,46,4);   # ERROR CODE FOR NOS                #
        END 
      ITEM FETERROR U;             # FET ERROR (NOS OR NOS/BE)         #
      ARRAY FSTTBUF S(128); 
        BEGIN 
        ITEM FSTIME      C(05,00,10);  # TIME LAST CLOSED              #
        ITEM FSDATE      C(06,00,10);  # DATE LAST CLOSED              #
        ITEM FSBLKSIZ    U(15,42,18);  # BLOCK SIZE OF FILE            #
        END 
      ITEM INDEX;                  #LOOP INDEX# 
      ITEM INDEX1;                 #LOOP INDEX# 
      ITEM LFNDB;                  # LFN FOR DATABASE FILE             #
      ITEM LFNINDEX;               # LFN FOR INDEX FILE                #
      ITEM MAXARID;                #MAXIMUM LEGAL AREA ID FOR SCHEMA# 
  
      ARRAY MDAINFO (DFMDAIEN);    #MD AREA INFORMATION#
        BEGIN 
*CALL MDARIDCLS 
        END 
      ITEM MISSINGFILE B = FALSE;  #FLAG FOR REQUIRED FILE NOT PRESENT# 
      ITEM NEWFILE         B;      # TRUE IF FIRST QRF BLOCK FOR FILE  #
      ITEM PFOFF           U;      # WA OFFSET OF PIT ENTRY IN MD      #
      ITEM PFCHAIN         =0;     # POINTER TO FIRST PFTABLE ENTRY    #
  
      BASED ARRAY PFTABLE S(6);    # PERMANENT FILE STATUS ENTRY       #
        BEGIN 
        ITEM PTHDRWD    U(0,0,60);
        ITEM PTPRIOR    I(0,24,18); 
        ITEM PTNEXT     I(0,42,18); 
        ITEM PTBLKSIZ   U(00,06,18);   # BLOCK SIZE OF FILE            #
  
        ITEM PTAREAWD   U(1,0,60); # AREA FILE WORD.                   #
        ITEM PTATTACH   B(1,0,1);  # TRUE IF AREA AND INDEX ATTACHED   #
        ITEM PTAREABAD  B(1,1,1);  # TRUE IF FATAL ERROR               #
        ITEM PTAREAOLD  B(01,03,01);   # TRUE IF AREA OLDER THAN QRF   #
        ITEM PTAREAUCT  U(1,6,18); # COUNT OF BLOCKS WRITTEN TO AREA   #
        ITEM PTAREAFET  I(1,42,18);# FET FOR AREA FILE                 #
  
        ITEM PTINDEXWD  U(2,0,60); # INDEX FILE WORD.                  #
        ITEM PTINDEXUCT U(2,0,18); # COUNT OF BLOCKS WRITTEN TO INDEX  #
        ITEM PTINDEXFET I(2,42,18);# FET FOR INDEX FILE                #
  
        ITEM PTVERSWD   U(3,0,60); # DATABASE VERSION WORD.            #
        ITEM PTPVENAME  C(3,0,7);  # PRIMARY VERSION NAME              #
        ITEM PTAREAID   U(3,48,12);# AREA ID                           #
        ITEM PTTIME     C(04,00,10);   # TIME LAST CLOSED              #
        ITEM PTDATE     C(05,00,10);   # DATE LAST CLOSED              #
        END 
  
*CALL QRCTLDCLS 
  
      ARRAY QH S(65); 
        BEGIN 
*CALL QRHEDDCLS 
        END 
      ITEM PRUNUM ;                # PRU NUMBER                        #
      ITEM QRFDONE;                #LOOP INDEX# 
      ITEM SCID = -1;          #SCHEMA ID#
      ITEM VENAME C(07);           # VERSION NAME                      #
      ITEM VERSUB     U;           # VERSION SUBSCRIPT                 #
      BASED ARRAY WSA;             # WORKING STORAGE FOR QRF BLOCKS    #
        BEGIN 
        ITEM WSAAMLOGO   C(01,00,05);  # AAM FILE LOGO                 #
        ITEM WSTIME      C(05,00,10);  # TIME LAST CLOSED              #
        ITEM WSDATE      C(06,00,10);  # DATE LAST CLOSED              #
        END 
      CONTROL EJECT;
  
#     MESSAGES FOR DBQRFA.                                             #
  
      DEF DFNUMERR #16#;           # NUMBER OF MESSAGES DEFINED.       #
  
      ARRAY ERRTEXTS [DFNUMERR] S(4); 
        BEGIN 
        ITEM TEXT C(0,0,40) = 
        ["ERROR NUMBER XXX IN DBQRFA             :"  # 0 = FATAL       #
        ,"INCORRECT SCHEMA ID ON QRF HEADER      :"  # 1 = FATAL       #
        ,"CANNOT FIND SCHEMA IN MASTER DIRECTORY :"  # 2 = FATAL       #
        ,"QRF BLOCK CONTAINS INVALID AREA ID     :"  # 3 = FATAL       #
        ,"REQUIRED FILES NOT AT CONTROL POINT    :"  # 4 = FATAL       #
        ,"CIO ERROR ON QRF FILE                  :"  # 5 = FATAL       #
        ,"QRF BLOCK READ FOR UNDEFINED INDEX FILE:"  # 6 = FATAL       #
        ,"QRF BLOCK CONTAINS INVALID VERSION NAME:"  # 7 = FATAL       #
        ,"BAD CONTROL CARD PARAMETER = XXXXXXXXXX:"  # 8 = FATAL       #
        ,"FILE XXXXXXX NOT AT CONTROL POINT      :"  # 9 = WILL ABORT  #
        ,"QRF EMPTY                              :"  #10 = STOP        #
        ,"MESSAGE FOR AREA XXXX  VERSION XXXXXXX :"  #11 = INFORMATION #
        ,"  CIO ERROR XXX WHILE RESTORING FILE   :"  #12 = INFORMATION #
        ,"  FILE CANNOT BE RESTORED              :"  #13 = INFORMATION #
        ,"  XXXXX BLOCKS REWRITTEN               :"  #14 = INFORMATION #
        ,"  XXXXX INDEX BLOCKS REWRITTEN         :"  #15 = INFORMATION #
        ,"LAST RECOVERY POINT IS XXXXXXXXXX      :"  #16 = INFORMATION #
        ];
        END 
      CONTROL EJECT;                                                    000100
      PROC ABORT((ERRNUM));                                             000110
 #                                                                      000120
* *   DBQRFA                                     PAGE  1
* *   ABORT - ISSUE ERROR MESSAGE AND ABORT 
* *   J E ESLER                                  DATE  12/06/76 
* *   A W ALLEN                                  DATE  12/08/80 
* 
* DC  DESCRIPTION 
* 
*     PRINT AN ERROR MESSAGE ON THE DAYFILE AND ABORT DBQRFA RUN. 
* 
 #                                                                      000140
      BEGIN                                                             000150
      ITEM ERRNUM;                 #REQUESTED ERROR NUMBER#             000170
                                                                        000260
      IF ERRNUM GR DFNUMERR THEN                                        000270
        BEGIN                                                           000280
        C<14,3>TEXT[0] = DB$CDIS(ERRNUM,3,10," ");                      000290
        ERRNUM = 0;                                                     000300
        END                                                             000310
      DB$MSG(TEXT[ERRNUM]);            #MESSAGE ON DAYFILE#             000320
      DB$MSG("   **PROGRAM ABORTED**:");                                000370
      DB$ABRT;                                                          000380
      END                                                               000390
      CONTROL EJECT;
      FUNC SETFET(LFN); 
      BEGIN 
 #
* *   DBQRFA                                     PAGE  1
* *   SETFET - INITIALIZE FET FOR A DATABASE FILE 
* *   J E ESLER                                  DATE  12/06/76 
* 
* DC  DESCRIPTION 
* 
*     SETFET - FUNCTION TO RESERVE AND INITIALIZE A FET FOR A DATABASE
*     FILE.  RETURNS THE ADDRESS OF THE FET.
 #
      ITEM LFN;                    #FILE NAME FOR FET#
      DB$MFA(DFRANDFETLN,P<FET>); 
      FOR INDEX = DFRANDFETLN-1 STEP -1 UNTIL 0 DO
        FETWORD[INDEX] = RNFTWD[INDEX]; 
      FETLFN = LFN; 
      SETFET = LOC(FET);
      END 
      CONTROL EJECT;                                                    000400
      PROC APPLYBLOCK;                                                  000410
 #                                                                      000420
* *   DBQRFA                                     PAGE  1
* *   APPLYBLOCK--APPLY QRF BLOCK TO SPECIFIED DATABASE OR INDEX FILE 
* *   J E ESLER                                  DATE  12/06/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  08/15/80 
* 
* DC  PURPOSE 
* 
*     APPLY A QRF BLOCK TO THE DATABASE GIVEN THAT THE FILE IS
*     ALREADY ATTACHED.  FIRST, CHECK THAT THE PRU FOR THIS BLOCK HAS 
*     NOT ALREADY BEEN UPDATED. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     P<PFTABLE> IS SET TO THE PERMANENT FILE ENTRY FOR THE DATABASE
*     (OR INDEX) FILE TO BE UPDATED.
* 
*     NEWFILE FLAG IS TRUE IF THIS IS THE FIRST OCCURRENCE OF THIS FILE 
*       ON THE QRF, FALSE OTHERWISE.  WHEN NEWFILE IS TRUE THEN THE 
*       CHAIN OF QRF CONTROL WORDS -BLOCKTBL- DOES NOT NEED TO BE 
*       SEARCHED. 
* 
*     THE FILE CORRESPONDING TO P<PFTABLE> IS ATTACHED AND USEABLE. 
* 
*     THE QRF BLOCK HAS BEEN READ INTO CMM AT ADDRESS -WSA-.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
*       THE CONTROL WORDS FOR THE NEW QRF BLOCK ARE ADDED TO THE QRF
*         BLOCK CHAIN -BLOCKTBL-. 
*       THE QRF BLOCK IS APPLIED TO THE DATABASE, OR AN ERROR MESSAGE 
*         IS ISSUED INDICATING AN I/O ERROR.
* 
*     ABNORMAL EXITS--
*       IF THIS SAME PRU HAS ALREADY BEEN UPDATED (SAME CONTROL WORDS 
*         ARE ALREADY IN BLOCKTBL), THEN CONTROL RETURNS TO THE CALLER. 
* 
*       IF AN INDEX FILE IS NEEDED, BUT IS NOT SPECIFIED IN THE MASTER
*         DIRECTORY, THEN EXIT VIA THE INTERNAL PROCEDURE, -ABORT- AND
*         ABORT THE DBQRFA RUN. 
* 
* DC  CALLING ROUTINES
* 
*     DBQRFA                       MAIN PROGRAM.
* 
* DC  CALLED ROUTINES 
* 
*     ABORT                        INTERNAL PROC TO ABORT DBQRFA. 
*     DB$CDIS                      CONVERT BINARY TO DISPLAY CODE 
*     DB$LNK                       LINK CMM BLOCK IN CHAIN
*     DB$MSG                       ISSUE DAYFILE MESSAGE. 
*     DB$RNRW                      DO A CIO RANDOM REWRITE. 
* 
* DC  DESCRIPTION 
* 
*     IF THE DATABASE FILE FOR THIS QRF RECORD WAS PREVIOUSLY ATTACHED
*     THEN
*       SEARCH QRF BLOCK CHAIN OF CONTROL WORDS.
*       IF SAME PRU IS ALREADY UPDATED
*       THEN
*         RETURN. 
* 
*     ADD CONTROL WORDS TO QRF BLOCK CHAIN (BLOCKTBL).
*     SET FET POINTER TO AREA OR INDEX FILE.
*     REWRITE THE BLOCK.
*     IF ERROR ON REWRITE 
*     THEN
*       ISSUE AN ERROR MESSAGE
*     ELSE
*       INCREMENT FILE UPDATE COUNT.
*     RETURN. 
* 
 #                                                                      000450
      BEGIN                                                             000460
  
#     CHECK BLOCK LIST TO SEE IF BLOCK HAS ALREADY BEEN UPDATED.       #
#     ONLY THE FIRST (EARLIEST) IMAGE IS WRITTEN FOR EACH BLOCK.       #
  
      IF NOT NEWFILE               # IF NOT THE FIRST OCCURRENCE OF    #
      THEN                         # THIS FILE ON THE QRF...           #
        BEGIN 
        P<BLOCKTBL> = LOC(BLOCKCHAIN);
        FOR INDEX = INDEX          # LOOK FOR SAME PRU IN BLOCKTBL     #
          WHILE BLOCKNEXT[0] NQ 0 
        DO
          BEGIN 
          P<BLOCKTBL> = BLOCKNEXT[0]; 
          IF BLOCKCTL0[0] EQ QCWORD0[0] 
            AND BLOCKCTL1[0] EQ QCWORD1[0]
          THEN                     # IF SAME BLOCK CONTROL WORDS...    #
            RETURN;                # RETURN AND READ NEXT QRF BLOCK.   #
  
          END 
        END 
  
#     ADD BLOCK TO BLOCK LIST.                                         #
  
      P<BLOCKTBL> = DB$LNK(LOC(BLOCKCHAIN),3);
      BLOCKCTL0[0] = QCWORD0[0];
      BLOCKCTL1[0] = QCWORD1[0];
  
#     INCREMENT UPDATE COUNT FOR THIS FILE.                            #
#     SET FET POINTER.                                                 #
  
      IF QCINDEXF[0]               # IF UPDATE IS FOR INDEX FILE...    #
      THEN
        BEGIN 
        P<FET> = PTINDEXFET[0]; 
        IF P<FET> EQ 0 THEN 
          ABORT(6);                #INDEX FILE WAS NOT SPECIFIED IN MD# 
        END 
      ELSE
        BEGIN 
        P<FET> = PTAREAFET[0];
        END 
  
      PRUNUM = QCPRUN[0]; 
  
#     IF THE BLOCK THAT IS TO BE WRITTEN IS THE FSTT, VALIDATE TIME    #
  
      IF PRUNUM EQ 1
      THEN
        BEGIN 
        IF PTDATE[0] LS WSDATE[0] 
          OR (PTDATE[0] EQ WSDATE[0] AND PTTIME[0] LS WSTIME[0])
        THEN
          BEGIN 
          C<12,04>AREAMSG1 = DB$CDIS(PTAREAID[0],4,10," "); 
          C<30,10>AREAMSG1 = PTDATE;
          C<40,10>AREAMSG1 = PTTIME;
          C<30,10>AREAMSG2 = WSDATE;
          C<40,10>AREAMSG2 = WSTIME;
          DB$MSG(AREAMSG1); 
          DB$MSG(AREAMSG2); 
          DB$MSG("    RECOVERED FILE DOES NOT MATCH THE QRF FILE:");
          DB$MSG("    BLOCK IMAGES WILL NOT BE APPLIED:");
          PTAREAOLD[0] = TRUE;
          RETURN; 
  
          END 
        END 
  
#     UPDATE THE BLOCK.                                                #
  
      DB$RNRW(LOC(FET),LOC(WSA),QFFETIN[0]-QFFETOUT[0]-2,PRUNUM); 
      IF DB$NOSU                   # SET CIO ERROR FIELD FOR NOS OR    #
      THEN                         # NOS/BE.                           #
        FETERROR = FETNOSAT[0]; 
      ELSE
        FETERROR = FETNBAT[0];
      IF FETERROR NQ 0             # ERROR REWRITING BLOCK             #
      THEN
        BEGIN 
        C<17,4>TEXT[11] = DB$CDIS(PTAREAID[0],4,10,"0");
        C<31,7>TEXT[11] = PTPVENAME[0]; 
        DB$MSG(TEXT[11]); 
        C<12,3>TEXT[12] = DB$CDIS(FETERROR,3,8,"0");
        DB$MSG(TEXT[12]); 
        PTAREABAD[0] = TRUE;
        END 
      ELSE                         #IF NO ERROR, BUMP FILE UPDATE COUNT#
        BEGIN 
        IF QCINDEXF[0]
        THEN
          PTINDEXUCT[0] = PTINDEXUCT[0] + 1;
        ELSE
          PTAREAUCT[0] = PTAREAUCT[0] + 1;
        END 
      RETURN;                                                           000550
      END                                                               000560
      CONTROL EJECT;                                                    000570
      PROC ATTACHAREA;                                                  000575
 #                                                                      000580
* *   DBQRFA                                     PAGE  1
* *   ATTACHAREA--ATTACH A DATABASE AND INDEX FILE
* *   J E ESLER                                  DATE  12/06/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  08/15/80 
* 
* DC  PURPOSE 
* 
*     ATTACH A DATABASE FILE AND INDEX FILE, GIVEN PERMANENT FILE 
*     OFFSET IN MD PIT (PFOFF).  FIRST READ MD ATTACH INFORMATION.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     PFOFF EQUALS OFFSET WORD ADDRESS IN MASTER DIRECTORY. 
*     P<PFTABLE> IS SET FOR A FILE THAT NEEDS TO BE ATTACHED. 
* 
* DC  EXIT CONDITIONS 
* 
*     ATTACH HAS BEEN ISSUED FOR DATABASE FILE AND INDEX FILE.  EITHER
*     THE FILES ARE ATTACHED OR FLAGS ARE SET IN PFTABLE INDICATING AN
*     UNUSEABLE FILE. 
* 
* DC  CALLING ROUTINES
* 
*     DBQRFA                       MAIN PROGRAM 
* 
* DC  CALLED ROUTINES 
* 
*     DB$ATWR                      ATTACH A FILE
*     DB$LFN                       CREATE LFN FOR FILE
*     DB$VEPF                      GET PF INFO FOR VERSION OF AN AREA.
*     SETFET                       INITIALIZE FET FOR AREA OR INDEX FILE
* 
* DC  DESCRIPTION 
* 
*     GET PERMANENT FILE INFORMATION IN MASTER DIRECTORY (DB$VEPF). 
*     ATTACH THE DATABASE FILE (DB$ATWR). 
*     IF INDEX FILE REQUIRED
*     THEN
*       ATTACH INDEX FILE.
*     IF FILES SUCCESSFULLY ATTACHED
*     THEN
*       INITIALIZE FET-S (SETFET).
*     ELSE
*       SET BAD FILE STATUS IN PFTABLE. 
* 
 #                                                                      000610
      BEGIN                                                             000620
      DB$VEPF(PFOFF,MDAINFO); 
      P<ATTACHINFO> = LOC(MDAIARPF);
      LFNDB = DB$LFN("F",LOC(PFTABLE)); 
      DB$ATWR(LFNDB,ATTACHINFO,ATTACHSTATUS); 
      IF ATTACHSTATUS EQ 0 THEN        #NO PFM ERROR# 
        BEGIN                                                           000690
        IF MDAIIXPF NQ 0 THEN                                           000720
          BEGIN                                                         000730
          P<ATTACHINFO> = LOC(MDAIIXPF);                                000740
          LFNINDEX = DB$LFN("X",LOC(PFTABLE));
          DB$ATWR(LFNINDEX,ATTACHINFO,ATTACHSTATUS);
          END 
        END                                                             000800
  
#     IF THE FILE(S) WERE ATTACHED PROPERLY, INITIALIZE THE FET(S).    #
  
      IF ATTACHSTATUS EQ 0 THEN                                         000810
        BEGIN                                                           000820
        PTAREAFET[0] = SETFET(LFNDB); 
        PTATTACH[0] = TRUE; 
        PTAREABAD[0] = FALSE; 
        IF MDAIIXPF NQ 0 THEN 
          BEGIN 
          PTINDEXFET[0] = SETFET(LFNINDEX); 
          END 
        P<FET> = PTAREAFET[0];
        DB$IORW(P<FET>);
        DB$RCLL(P<FET>);
        DB$IORD(P<FET>,LOC(FSTTBUF),127); 
        DB$RCLL(P<FET>);
        IF FETNOSAT[0] NQ 0 
        THEN
          BEGIN 
          PTAREABAD[0] = TRUE;
          RETURN; 
  
          END 
        PTDATE[0] = FSDATE[0];
        PTTIME[0] = FSTIME[0];
        PTBLKSIZ[0] = FSBLKSIZ[0];
  
        END                                                             000840
      ELSE                                                              000850
        BEGIN                                                           000860
        PTAREABAD[0] = TRUE;
        PTATTACH[0] = FALSE;
        END                                                             000880
      END                                                               000890
      CONTROL EJECT;
      PROC FINDFILE;
 #
* *   DBQRFA                                     PAGE  1
* *   FINDFILE--FIND PERMANENT FILE ENTRY FOR A VERSION AND AREA. 
* *   A W ALLEN - DATABASE VERSIONS              DATE  08/15/80 
* 
* DC  PURPOSE 
* 
*     GIVEN AREA ID AND PRIMARY VERSION NAME FROM QRF, FIND PERMANENT 
*     FILE ENTRY IN PFTABLE.  SET UP NEW PFTABLE ENTRY IF NEW 
*     FILE. 
* 
* DC  ENTRY CONDITIONS
* 
*     P<QCCTLWD> POINTS TO CONTROL WORDS FOR A NEW QRF BLOCK. 
*     PFTABLE CHAIN CONTAINS VERSION AND AREA ID FOR FILES THAT HAVE
*       ALREADY BEEN ATTACHED.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT-- 
*       P<PFTABLE> IS SET TO ENTRY FOR THIS AREA ID AND 
*         VERSION NAME. 
*       NEWFILE = TRUE IF NEW FILE ON QRF, ELSE FALSE.
*       IF THIS IS A NEW FILE THEN
*         PFOFF ( = WA OFFSET OF PF INFO IN MD PIT) IS ALSO SET.
* 
*     ABNORMAL EXIT-- 
*       EXIT VIA -ABORT- WHEN VERSION NAME IS NOT ON MD.
* 
* DC  CALLING ROUTINES
* 
*     DBQRFA                       MAIN PROGRAM 
* 
* DC  CALLED ROUTINES 
* 
*     ABORT                        ISSUE ERROR MESSAGE AND ABORT
*     DB$LNK                       LINK CMM BLOCK IN CHAIN
*     DB$VEPN                      GET PRIMARY VERSION NAME.
*     DB$VERL                      VERSION NAME LOOK-UP.
* 
* DC  DESCRIPTION 
* 
*     FOR ALL PFTABLE ENTRIES 
*       BEGIN 
*       IF VERSION AND AREA ID IN PFTABLE ARE THE SAME AS THE 
*         NEW QRF BLOCK 
*       THEN
*         SET P<PFTABLE>. 
*         RETURN. 
*       END 
* 
*     (VERSION AND AREA ID ON QRF ARE NOT IN PFTABLE) 
* 
*     FIND VERSION SUBSCRIPT IN MASTER DIRECTORY (DB$VERL). 
*     IF VERSION NOT FOUND
*     THEN
*       ABORT (INVALID VERSION NAME ON QRF).
*     GET PERMANENT FILE OFFSET FROM MASTER DIRECTORY (DB$VEPN).
*     SET PRIMARY VERSION NAME AND AREA ID IN PFTABLE ENTRY.
* 
 #
      BEGIN 
      NEWFILE = FALSE;
      P<PFTABLE> = LOC(PFCHAIN);
      FOR INDEX = INDEX            # LOOP THROUGH PFTABLE CHAIN.       #
        WHILE PTNEXT[0] NQ 0
      DO
        BEGIN 
        P<PFTABLE> = PTNEXT[0]; 
        IF QCAID[0] EQ PTAREAID[0]
          AND QCVENAME[0] EQ PTPVENAME[0] 
        THEN                       # IF AREA ID AND VERSION ALREADY SET#
          RETURN;                  # FILE ALREADY IN USE.              #
  
        END 
  
#     FILE NOT ALREADY ATTACHED.  LOCATE PF INFO IN MASTER DIRECTORY.  #
  
      NEWFILE = TRUE; 
      DB$VERL(QCVENAME[0],VERSUB); # FIND VERSION IN MASTER DIRECTORY. #
      IF VERSUB EQ 0               # IF VERSION INVALID...             #
      THEN
        ABORT(7);                  # PRINT ERROR MESSAGE AND ABORT.    #
  
      DB$VEPN(VERSUB,QCAID[0],VENAME,PFOFF);
                                   # FIND PF OFFSET INTO MD PIT.       #
      P<PFTABLE> = DB$LNK(LOC(PFCHAIN),6);
      PTAREAWD[0] = 0;
      PTINDEXWD[0] = 0; 
      PTATTACH[0] = FALSE;
      PTPVENAME[0] = QCVENAME[0]; # SET VERSION AND AREA ID IN     #
      PTAREAID[0] = QCAID[0];     # PF TABLE.                      #
      RETURN; 
      END 
      CONTROL EJECT;
      PROC CRACKCC; 
      BEGIN 
 #
* *   DBQRFA                                     PAGE  1
* *   CRACKCC - INTERPRET CONTROL CARD PARAMETERS 
* *   J E ESLER                                  DATE  12/06/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  03/02/81 
* 
* DC  DESCRIPTION 
* 
*     CRACKCC - INTERPRET ALL PARAMETERS ON THE CONTROL CARD. 
*     VERIFY THAT EACH IS LEGAL AND APPEARS ONLY ONCE.
 #
      ITEM INDEX;                  #LOOP INDEX# 
      ITEM LFN C(7);               #TEMPORARY#
      ITEM QRFLFN C(7) = O"21220614170700"; #QRF FILE NAME# 
      ITEM PARAM;            #CONTROL CARD PARAMETER# 
      ITEM PARAMCNT;         #NUMBER OF CONTROL CARD PARAMETERS#
  
# PARAMETER VALUES DEFINED BELOW MUST CORRESPOND TO SWITCH VALUES IN   #
# SWITCH CCPARMSW, SINCE A COMMON INDEX IS USED TO REFERENCE THEM.     #
  
      DEF DFLEGPMCNT #2#;          #NUMBER OF LEGAL CONTROL CARD PARM-1#
      ARRAY CCPARMTBL[DFLEGPMCNT];
        BEGIN 
        ITEM LEGPARAM U(0,0,60); #THE VALUE PARAMETER#
        ITEM P1HALF U(0,0,18) = [O"230300",  #SC# 
                                 O"150400",  #MD# 
                                 O"210600"]; #QF# 
        ITEM P2HALF U(0,18,42) = [0,0,0]; 
        END 
      SWITCH CCPARMSW SCHEMAID,#SAVE SCHEMA ID# 
                     MDLFN,    #SAVE MD LFN#
                     QFLFN;    #SAVE QRF LFN# 
  
      PROC STORLFN(FILENAME);                                           001480
 #                                                                      001490
*     STORLFN - VERIFY THAT THE NEXT CONTROL CARD PARAMETER IS A VALID  001500
*               FILE NAME. STORE THE NAME IN THE LOCATION SPECIFIED.    001510
 #                                                                      001520
      BEGIN                                                             001530
      ITEM FILENAME;         #LOCATION TO SAVE LFN#                     001540
                                                                        001550
      IF CCSEP[INDEX] NQ DFEQUAL THEN                                   001560
        BEGIN 
        C<29,10>TEXT[8] = PARAM;       # PARAMETER MISSING EQUAL SIGN. #
        ABORT(8); 
        END 
  
      INDEX = INDEX + 1;               #BUMP INDEX TO FILE NAME#        001580
      FILENAME = CCPARAM[INDEX] * 2**18;  #LFN, ZERO FILLED#            001590
      IF C<0,1>FILENAME GR O"32" OR C<0,1>FILENAME EQ O"00" THEN
        BEGIN 
        C<29,10>TEXT[8] = FILENAME;    # MOVE BAD LFN INTO MESSAGE.    #
        ABORT(8);                      # PRINT MESSAGE AND ABORT.      #
        END 
  
      RETURN;                                                           001620
      END                                                               001630
  
      PARAMCNT = NUMCCPR[52] + 1;                                       001690
      FOR INDEX = 2 STEP 1 UNTIL PARAMCNT DO                            001700
        BEGIN                                                           001710
        PARAM = CCPARAM[INDEX] * 2**18; #GET PARAMETER AND ZERO FILL#   001720
        FOR INDEX1 = 0 STEP 1 UNTIL DFLEGPMCNT DO                       001730
          BEGIN                                                         001740
          IF PARAM EQ LEGPARAM[INDEX1] THEN                             001750
            BEGIN                                                       001760
            LEGPARAM[INDEX1] = 0; #CLEAR PARAMETER-LEGAL ONLY ONCE#     001770
            GOTO CCPARMSW[INDEX1];#SWITCH ON PARAMETER VALUE#           001780
                                                                        001790
            END                                                         001800
          END                                                           001810
        C<29,10>TEXT[8] = PARAM;       # ILLEGAL PARAMETER.            #
        ABORT(8);                      # PRINT MESSAGE AND ABORT.      #
 #                                                                      001830
*     LABELED CODE IS JUMPED TO AS CONTROL CARD PARAMETERS ARE
*     RECOGNIZED. PARAMETERS ARE VERIFIED AND STORED.                   001850
 #                                                                      001860
SCHEMAID:                                                               001870
        INDEX = INDEX + 1;                                              001880
        SCID = DB$CBIN(CCPARAM[INDEX]*2**18,4,10);                      001890
        TEST INDEX;                    #CHECK NEXT PARAMETER#           001900
                                                                        001910
MDLFN:                                                                  001920
        STORLFN(LFN);              #GET FILE NAME#                      001930
        FTMDLFN[0] = LFN;          #SAVE MD LFN#                        001940
        TEST INDEX;                    #CHECK NEXT PARAMETER#           001950
                                                                        001960
QFLFN:                                                                  001970
        STORLFN(QRFLFN);                                                001980
        END #INDEX#                                                     001990
  
      IF DB$STAT(FTMDLFN) EQ 0         # IF MASTER DIRECTORY NOT       #
      THEN                             # ATTACHED...                   #
        BEGIN 
        C<5,7>TEXT[9] = DB$CFIL(FTMDLFN,7," "); 
        DB$MSG(TEXT[9]);
        MISSINGFILE = TRUE; 
        END 
      IF DB$STAT(QRFLFN) EQ 0          # IF QRF IS NOT ATTACHED...     #
      THEN
        BEGIN 
        C<5,7>TEXT[9] = DB$CFIL(QRFLFN,7," ");
        DB$MSG(TEXT[9]);
        MISSINGFILE = TRUE; 
        END 
      IF MISSINGFILE THEN              #REQ"D FILE MISSING-ABORT#       002030
        ABORT(4); 
                                                                        002080
      QFFETLFN[0] = QRFLFN;                                             002110
      END 
      CONTROL EJECT;                                                    000900
      PROC RETURNAREAS; 
 #                                                                      000910
* *   DBQRFA                                     PAGE  1
* *   RETURNAREAS - RETURN DATABASE AND INDEX FILES 
* *   J E ESLER                                  DATE  12/06/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  03/02/81 
* 
* DC  DESCRIPTION 
* 
*     RETURNAREAS - RETURN ALL ATTACHED DATABASE AREAS AND INDEX FILES. 
*     OUTPUT STATISTICS FOR UPDATES.                                    000930
 #                                                                      000940
      BEGIN                                                             000950
      P<PFTABLE> = LOC(PFCHAIN);
      FOR INDEX = INDEX WHILE PTNEXT[0] NQ 0
      DO                           # FOR ALL FILES ON QRF...           #
        BEGIN 
        P<PFTABLE> = PTNEXT[0]; 
        C<17,4>TEXT[11] = DB$CDIS(PTAREAID[0],4,10,"0");
        C<31,7>TEXT[11] = DB$CFIL(PTPVENAME[0],7," ");
        DB$MSG(TEXT[11]);          # WRITE AREA ID AND VERSION NAME.   #
        IF PTAREABAD[0]            # IF FILE IS DOWN...                #
        THEN
          BEGIN 
          DB$MSG(TEXT[13]);        # WRITE "FILE CANNOT BE RESTORED"   #
          END 
        IF PTATTACH[0]             # IF FILE IS ATTACHED...            #
        THEN
          BEGIN 
          P<FET> = PTAREAFET[0];
          DB$RTN(FETLFN);          # RETURN AREA FILE.                 #
          C<2,5>TEXT[14] = DB$CDIS(PTAREAUCT[0],5,10,"0");
          DB$MSG(TEXT[14]);        # PRINT UPDATE COUNT FOR AREA FILE. #
          IF PTINDEXFET[0] NQ 0    # IF INDEX FILE...                  #
          THEN
            BEGIN 
            P<FET> = PTINDEXFET[0]; 
            DB$RTN(FETLFN);        # RETURN INDEX FILE.                #
            C<2,5>TEXT[15] = DB$CDIS(PTINDEXUCT[0],5,10,"0"); 
            DB$MSG(TEXT[15]);      # PRINT UPDATE COUNT FOR INDEX FILE #
            END 
          END 
        END                        # END PFTABLE LOOP.                 #
      RETURN;                                                           001100
      END                                                               001110
      CONTROL EJECT;                                                    001470
# 
  
  
      S T A R T   O F   D B Q R F A   M A I N   P R O G R A M 
  
  
*     VERIFY PARAMETERS AND INITIALIZE TABLES.
# 
      CRACKCC;                     #CRACK THE CONTROL CARD# 
                                                                        002140
# 
*     READ HEADER RECORD FROM QRF.                                      002160
*     CHECK SCHEMA ID IF SC PARAMETER WAS SPECIFIED.                    002170
*     ABORT IF IT IS INCORRECT.                                         002180
# 
      DB$IORW(LOC(DB$IOFT));                                            002120
      DB$RCLL(LOC(DB$IOFT));                                            002130
      DB$IORD(LOC(DB$IOFT),LOC(QH),DFPRUSIZ+1);                         002200
      DB$RCLL(LOC(DB$IOFT));                                            002210
      IF (DB$NOSU AND QFFETECNOS NQ 0)
        OR (NOT DB$NOSU AND QFFETECNB NQ 0) 
      THEN
        ABORT(5);                  # CIO ERROR ON QRF.                 #
      IF SCID NQ -1 AND SCID NQ QHSCID THEN                             002220
        ABORT(1);                  #QRF IS FOR WRONG SCHEMA            #002230
      SCID = QHSCID;               #SET SCHEMA ID FROM QRF             #002240
      C<23,10>TEXT[16] = DB$CDIS(QHRPNUM,10,10," ");
      DB$MSG(TEXT[16]); 
# 
*     CHECK FOR EMPTY QRF. ISSUE MESSAGE AND TERMINATE IF IT IS.        002260
# 
      IF QFFETIN - QFFETOUT EQ DFPRUSIZ THEN
        BEGIN                                                           002290
        DB$MSG(TEXT[10]); 
        STOP;                                                           002310
        END                                                             002320
# 
*     OPEN MD. READ MD SCHEMA CONTROL WORDS.                            002340
# 
      DB$WOPN(DB$FTMD,DB$MDER);                                         002360
      DB$WGET(DB$FTMD,MDCW,DFMDNUMCW,1,DB$MDER);
  
#     READ SCHEMA DIRECTORY ENTRY GIVEN SCHEMA ID.                     #
  
      IF SCID GR MDSDNO[0]
      THEN
        ABORT(2);                  # INVALID SCHEMA.                   #
      DB$MFA(DFSALENSIZE,P<SAL>); 
      SALL = 0; 
      SALX = 0; 
      DB$WGET(DB$FTMD,SAL,DFMDSCDESIZE
             ,MDSDWA[0] + (SCID - 1)*DFMDSCDESIZE 
             ,DB$MDER); 
      SASCWD09[0] = 0;
      SASCWD10[0] = 0;
      SASCWD11[0] = 0;
      SASCWD12[0] = 0;
      IF SASCHID[0] NQ SCID 
      THEN
        ABORT(2);                  # SCHEMA NOT IN MD.                 #
      MAXARID = SASCNBAR[0];
      DB$MFA(DFMAXBKSZ,P<WSA>);    #RESERVE CIO BUFFER FOR QRF FILE.   #
# 
*     READ THE QRF AND VALIDATE EACH RECORD.                            002710
# 
      DB$IORW(LOC(DB$IOFT));
      DB$RCLL(LOC(DB$IOFT));
      DB$IORE(LOC(DB$IOFT),LOC(WSA),DFPRUSIZ);  #POSITION AT FIRST BLK# 
      DB$RCLL(LOC(DB$IOFT));
      IF (DB$NOSU AND QFFETECNOS NQ 0)
        OR (NOT DB$NOSU AND QFFETECNB NQ 0) 
      THEN
        ABORT(5);                  # CIO ERROR ON QRF.                 #
  
      FOR QRFDONE = 0 WHILE QRFDONE EQ 0 DO 
        BEGIN                                                           002740
        DB$IORD(LOC(DB$IOFT),LOC(WSA),DFMAXBKSZ);                       002750
        DB$RCLL(LOC(DB$IOFT));                                          002760
        P<QCCTLWD> = QFFETIN[0] - 2;  #CONTROL WORDS ARE LAST TWO WORDS#
        IF QFFETST GQ DFEOP OR QCGBID NQ QHGBID THEN
          BEGIN                    #END OF QRF INFORMATION             #002790
          QRFDONE = 1;
          TEST QRFDONE;            #END READING OF QRF# 
  
          END 
        IF (DB$NOSU AND QFFETECNOS NQ 0)
          OR (NOT DB$NOSU AND QFFETECNB NQ 0) 
        THEN                       # CIO ERROR ON QRF.                 #
          ABORT(5); 
        AREAID = QCAID;                                                 002830
        IF AREAID GR MAXARID OR AREAID LQ 0 THEN
          ABORT(3);                #INVALID AREA ID#                    002850
  
        FINDFILE;                  # FIND PERM. FILE FOR THIS QRF BLOCK#
        IF NEWFILE                 # IF THIS IS THE FIRST RECORD FOR   #
        THEN                       # THIS FILE...                      #
          ATTACHAREA;              # ATTACH AREA AND INDEX FILE.       #
        IF NOT PTAREABAD[0]        # IF NO ERRORS HAVE BEEN DETECTED   #
          AND NOT PTAREAOLD[0]         # AND NOT AN OLD AREA THAT HAS  #
                                       #   BEEN RECOVERED.             #
        THEN                       # ON THIS FILE...                   #
          APPLYBLOCK;              # APPLY THE QRF BLOCK TO DATABASE.  #
        END                                                             002960
# 
*     AT END OF QRF, RETURN ALL AREAS. PRINT RECOVERY STATISTICS.       002980
# 
      RETURNAREAS;                                                      003000
# 
*     REINITIALIZE QRF. 
# 
      DB$IORW(LOC(DB$IOFT));
      QHGBID = QHGBID + 1;         #INCREMENT GOOD BLOCK ID#
      DB$RCLL(LOC(DB$IOFT));
      DB$IOWR(LOC(DB$IOFT),LOC(QH),DFPRUSIZ); 
      DB$RCLL(LOC(DB$IOFT));
      IF (DB$NOSU AND QFFETECNOS NQ 0)
        OR (NOT DB$NOSU AND QFFETECNB NQ 0) 
      THEN
        ABORT(5);                  # CIO ERROR ON QRF.                 #
      DB$MSG("  DBQRFA COMPLETE:"); 
      END                                                               003050
      TERM                                                              003060
