*DECK DB$QFIN 
USETEXT CDCSCTX 
      PROC DB$QFIN( (PFTBLKA),(ERRBLKA) );
      BEGIN 
 #
* *   DB$QFIN - INITIALIZE QUICK RECOVERY FILE   PAGE  1
* *   W P CEAGLIO                                DATE  01/21/81 
* 
* DC  PURPOSE 
* 
*     ATTACH THE QUICK RECOVERY FILE. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM PFTBLKA   I;            # ADDRESS OF ATTACH INFO IN MD      #
      ITEM ERRBLKA   I;            # ADDRESS OF ERROR BLOCK            #
# 
* D   ASSUMPTIONS 
* 
*     THE TQT POINTER IS SET. 
*     SALX IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - THE QRF IS ATTACHED, VERIFIED, AND POSITIONED PAST THE QRF 
*                HEADER.  THE QRF TABLE IS INITIALIZED. 
* 
*     ABNORMAL - POINTER IN SAL REMAINS SET TO ZERO.  INFORMATION IN THE
*                ERROR BLOCK IS COMPLETED AS FOLLOWS: 
*                    1) ERROR NUMBER = DFSRENFUN IF ATTACH OR CIO ERROR,
*                       DFSRENSCH IF SCHEMA MISMATCH, OR DFSRENALO IF 
*                       FILE NOT ALLOCATED. 
*                    2) FUNCTION = ATTACH IF ATTACH ERROR.
*                       FUNCTION = CIO IF CIO ERROR.
*                    3) PARAMETER = CONTENTS OF ATTACHSTATUS IF ATTACH
*                       ERROR.  PARAMETER = CONTENTS OF QFFETNOSAT IF 
*                       CIO ERROR.
*                    4) FILE TYPE = QUICK RECOVERY FILE.
* 
* DC  CALLING ROUTINES
* 
*     DB$SFIN      CONTROL ROUTINE FOR SYSTEM FILE INITIALIZATION 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ATCH;           # ATTACH SYSTEM FILE                #
      XREF ITEM DB$BTF  B;         # TRUE IF EXECUTING CDCSBTF         #
      XREF FUNC DB$COCT C(10);     # CONVERT BINARY TO OCTAL, W/ZEROES #
      XREF PROC DB$ERR;            # ERROR PROCESSOR                   #
      XREF PROC DB$FLOP;           # GENERATE A FLOW POINT ENTRY       #
      XREF PROC DB$FLSH;           # FLUSH CRM OUTPUT BUFFERS          #
      XREF PROC DB$IORD;           # CIO READ ROUTINE                  #
      XREF PROC DB$IORW;           # CIO REWIND ROUTINE                #
      XREF FUNC DB$LFN;            # ASSIGN LOGICAL FILE NAME          #
      XREF PROC DB$MBA;            # ALLOCATE TEMPORARY CMM BLOCK      #
      XREF PROC DB$MBF;            # RELEASE TEMPORARY CMM BLOCK       #
      XREF PROC DB$MSG;            # ISSUE DAYFILE MESSAGE             #
      XREF PROC DB$MFA;            # ALLOCATE CMM BLOCK                #
      XREF PROC DB$MFF;            # RELEASE CMM BLOCK                 #
      XREF PROC DB$POP;            # POP VARIABLE FROM STACK           #
      XREF PROC DB$POP2;           # POP TWO VARIABLES FROM THE STACK  #
      XREF PROC DB$POP3;           # POP THREE VARIABLES FROM THE STACK#
      XREF PROC DB$PSH2;           # PUSH TWO VARIABLES ONTO THE STACK #
      XREF PROC DB$PSH3;           # PUSH THREE VARIABLES TO THE STACK #
      XREF PROC DB$PUSH;           # PUSH VARIABLE ONTO STACK          #
      XREF PROC DB$QRP;            # REWIND AND REINITIALIZE THE QRF   #
      XREF PROC DB$RTN;            # RETURN ATTACHED FILE              #
      XREF PROC DB$SCHD;           # CDCS SCHEDULER                    #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     SAL 
*       SAQRFPTR   POINTER TO QRF TABLE 
*       SASCHST    SCHEMA STATUS
* 
* DC  DESCRIPTION 
* 
*     -  ALLOCATE BUFFER FOR QRF TABLE (INCLUDING FET) AND RECORD THE 
*        POINTER IN THE SAL.
* 
*     -  INITIALIZE THE QRF FET FROM THE MODEL FET. 
* 
*     -  ASSIGN THE LFN USING COMBINATION OF LETTER "Q" AND THE SCHEMA
*        ID FROM THE SAL ENTRY. 
* 
*     -  ISSUE AN INITIAL ATTACH REQUEST WITHOUT QUEUEING.  IF
*        UNSUCCESSFUL FOR ANY REASON OTHER THAN BUSY, OR IT IS SYSTEM 
*        RECOVERY TIME, OR IMMEDIATE RETURN IS SET, SET ERROR FIELDS, 
*        RETURN THE BUFFER FOR THE QRF TABLE, RESET THE SAL POINTER TO
*        ZERO, AND RETURN FROM DB$QFIN.  IF UNSUCCESSFUL DUE TO A 
*        BUSY FILE, KEEP REISSUING THE ATTACH.
* 
*     -  IF THE ATTACH IS SUCCESSFUL, READ THE QRF HEADER AND VALIDATE
*        THAT IT HAS BEEN ALLOCATED.
* 
*     -  INITIALIZE THE QRF TABLE (QFT).
* 
*     -  IF ANY ERRORS OCCURRED WHILE READING AND VALIDATING THE QRF, 
*        RETURN THE QRF, RELEASE THE QRF TABLE, AND RESET THE SAL 
*        POINTER TO ZERO. 
* 
 #
  
#     LOCAL VARIABLES                                                  #
  
      ITEM ATCHMSG   C(60) =
        "  ATTACH ERROR 000 ON CDCS QUICK RECOVERY FILE XXXXXXX:";
      ITEM QRFBUFL   I;            # QRF BUFFER LENGTH                 #
      ITEM QFTSIZE   I;            # QFT SIZE                          #
      ITEM XA        I;            # INDUCTION VARIABLE                #
      ITEM XB        I;            # INDUCTION VARIABLE                #
  
*CALL SRERRDCLS 
*CALL QRTABDCLS 
  
      BASED ARRAY MDPFT;            # POINTER TO ATTACH INFO IN MD     #
        BEGIN 
        ITEM MDPFN    U(00,00,42);  # PERMANENT FILE NAME              #
        END 
  
      BASED ARRAY QH;              # FOR READING QRF HEADER            #
        BEGIN 
*CALL QRHEDDCLS 
        END 
  
      XREF ARRAY DB$IOFT;          # MODEL FET                         #
        BEGIN 
        ITEM QFETWD  U(00,00,60); 
        END 
  
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM ABSREF   I(00,00,60);     # REFERENCE AN ABSOLUTE ADDRESS #
        END 
  
  
  
# S T A R T   O F   D B $ Q F I N   E X E C U T A B L E   C O D E      #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QFIN");
      CONTROL ENDIF;
  
#     ESTABLISH THE SIZE OF THE QRF DATA BUFFER                        #
  
      QRFBUFL = DFQRFBUFL;
      IF DB$BTF 
      THEN
        BEGIN 
        QRFBUFL = 0;
        END 
  
#     CLEAR ERROR STATUS WORD.                                         #
  
      P<SRERRBLK> = ERRBLKA;
      SREWORD[0] = 0; 
  
#     ALLOCATE BUFFER FOR QRF TABLE AND RECORD POINTER IN SAL.         #
  
                             # QFT INCLUDES FET AND BLOCK CHAIN BUFFER #
                             # AND TWO SHORT RCB'S FOR QRF TASKS       #
      QFTSIZE = DFQFTLEN + DFFETLEN + QRFBUFL + 2*DFRCIR5;
      DB$MFA(QFTSIZE,P<QFT>); 
  
      QFBUFL[0] = QRFBUFL;
      P<FET> = LOC(QFFET[0]); 
      SAQRFPTR[SALX] = LOC(QFT);
  
      XB = LOC(QFT) + QFTSIZE -1; 
  
#     CLEAR THE MEMORY OF THE TWO RCB'S FOR QFT INTERNAL TASKS         #
  
      FOR XA = XB - 2*DFRCIR5 +1 STEP 1 UNTIL XB
      DO
        BEGIN 
        ABSREF[XA] = 0; 
        END 
  
#     INITIALIZE THE QRF FET FROM THE MODEL FET.                       #
  
      FOR XA = DFFETLEN -1 STEP -1 UNTIL 0
      DO
        BEGIN 
        FETLFNWD[XA] = QFETWD[XA];
        END 
  
#     ASSIGN LFN USING "Q" AND SCHEMA ID FROM SAL ENTRY.               #
  
      FETLFNU[0] = DB$LFN("Q",SASCHID[SALX]); 
  
#     ISSUE INITIAL ATTACH REQUEST WITHOUT QUEUEING.                   #
  
      P<MDPFT> = PFTBLKA; 
      DB$PSH2(P<SRERRBLK>,P<MDPFT>);
      DB$ATCH(FETLFNU[0],MDPFT,FALSE);
      DB$POP2(P<MDPFT>,P<SRERRBLK>);
  
      P<QFT> = SAQRFPTR[SALX];
      P<FET> = LOC(QFFET[0]); 
  
#     IF THE INITIAL ATTACH REQUEST WAS UNSUCCESSFUL FOR ANY           #
#     REASON OTHER THAN BUSY, OR IT IS SYSTEM RECOVERY TIME, OR        #
#     IMMEDIATE RETURN IS SET, SET ERROR FIELDS, RETURN THE BUFFER     #
#     FOR THE QRF TABLE, RESET THE SAL POINTER TO ZERO, AND RETURN     #
#     FROM DB$QFIN.  IF UNSUCCESSFUL DUE TO A BUSY FILE, KEEP          #
#     REISSUING THE ATTACH.                                            #
  
        IF ATTACHSTATUS NQ 0           # IF FIRST ATTACH UNSUCCESSFUL  #
        THEN
          BEGIN 
          IF ATTACHSTATUS GR 0 OR      # ERROR OTHER THAN BUSY OR      #
             SYSRECOVERY OR            # SYSTEM RECOVERY TIME OR       #
             TQIMRTN[0]                # IMMEDIATE RETURN SET          #
          THEN
            BEGIN 
            C<47,7>ATCHMSG = C<0,7>MDPFN[0];
            C<15,3>ATCHMSG = DB$COCT(ABS(ATTACHSTATUS),3);
            DB$MSG(ATCHMSG);           # ISSUE ERROR TO CDCS DAYFILE   #
            SRENUMB[0] = DFSRENUNA; 
            SREFPAR[0] = ATTACHSTATUS;
            SREFTYP[0] = DFSREFTQR; 
            DB$MFF(P<QFT>); 
            SAQRFPTR[SALX] = 0; 
            RETURN; 
  
            END 
          ELSE                         # FILE BUSY AT INVOKE           #
            BEGIN 
            DB$PSH3(P<SRERRBLK>,P<MDPFT>,ATTACHSTATUS); 
  
            DB$ERR(95);                # ISSUE ERROR TO UCP            #
  
            DB$POP3(ATTACHSTATUS,P<MDPFT>,P<SRERRBLK>); 
  
            FOR XA = XA 
              WHILE ATTACHSTATUS LS 0  # WHILE FILE REMAINS BUSY       #
            DO
              BEGIN 
              C<47,7>ATCHMSG = C<0,7>MDPFN[0];
              C<15,3>ATCHMSG = DB$COCT(ABS(ATTACHSTATUS),3);
              DB$MSG(ATCHMSG);         # ISSUE ERROR TO CDCS DAYFILE   #
              DB$PSH2(P<SRERRBLK>,P<MDPFT>);
              DB$PUSH(DFATCHDELAY);    # DELAY COUNT IS PUT IN STACK   #
                                       # DB$SCHD WILL POP IT AND USE IT#
              DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
              CONTROL IFGR DFFLOP,0;
                DB$FLOP("QFIN-S1"); 
              CONTROL ENDIF;
  
              DB$POP2(P<MDPFT>,P<SRERRBLK>);
              P<QFT> = SAQRFPTR[SALX];
              P<FET> = LOC(QFFET[0]); 
              DB$PSH2(P<SRERRBLK>,P<MDPFT>);
              DB$ATCH(FETLFNU[0],MDPFT,FALSE);        # REISSUE ATTACH #
              DB$POP2(P<MDPFT>,P<SRERRBLK>);
              P<QFT> = SAQRFPTR[SALX];
              P<FET> = LOC(QFFET[0]); 
              END 
            IF ATTACHSTATUS GR 0       # IF FILE BECAME UNAVAILABLE    #
                                       # FOR ANY REASON OTHER THAN BUSY#
            THEN
              BEGIN 
              C<47,7>ATCHMSG = C<0,7>MDPFN[0];
              C<15,3>ATCHMSG = DB$COCT(ABS(ATTACHSTATUS),3);
              DB$MSG(ATCHMSG);         # ISSUE ERROR TO CDCS DAYFILE   #
              SRENUMB[0] = DFSRENUNA; 
              SREFPAR[0] = ATTACHSTATUS;
              SREFTYP[0] = DFSREFTQR; 
              DB$MFF(P<QFT>); 
              SAQRFPTR[SALX] = 0; 
              RETURN; 
  
              END 
            END 
          END 
  
#     OTHERWISE, THE ATTACH WAS SUCCESSFUL.  VERIFY THE QRF AND        #
#     INITIALIZE THE QRF TABLE (QFT).                                  #
  
#       REWIND THE QUICK RECOVERY FILE.                                #
  
        DB$IORW(P<FET>);       # REWIND                                #
        DB$PUSH(P<SRERRBLK>); 
        DB$SCHD(P<FET>,DFWAITIO); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QFIN-S2"); 
        CONTROL ENDIF;
  
        DB$POP(P<SRERRBLK>);
        P<QFT> = SAQRFPTR[SALX];
        P<FET> = LOC(QFFET[0]); 
  
#       READ THE FIRST RECORD FROM THE QRF.                            #
  
        DB$MBA(DFPRUSIZ+1,P<QH>); 
        DB$IORD(P<FET>,P<QH>,DFPRUSIZ +1);  # READ QRF HEADER          #
        DB$PUSH(P<SRERRBLK>); 
        DB$PUSH(P<QH>); 
        DB$SCHD(P<FET>,DFWAITIO); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QFIN-S3"); 
        CONTROL ENDIF;
  
        DB$POP(P<QH>);
        DB$POP(P<SRERRBLK>);
        P<QFT> = SAQRFPTR[SALX];
        P<FET> = LOC(QFFET[0]); 
  
#       IF NO ERRORS OCCURRED WHILE READING THE QRF, VALIDATE THAT THE #
#       QRF HAS BEEN ALLOCATED.  IF THE QRF IS EMPTY OR IF THE SCHEMA  #
#       ID IN THE QRF DOES NOT MATCH THE SCHEMA ID IN THE SAL, SET     #
#       THE APPROPRIATE FIELDS IN THE ERROR BLOCK.                     #
  
        IF FETNOSAT[0] EQ 0 
        THEN
          BEGIN 
          IF FETIN[0] EQ FETOUT[0]
          THEN
            BEGIN 
            SRENUMB[0] = DFSRENALO;     # QRF EMPTY, MUST BE ALLOCATED #
            SREFTYP[0] = DFSREFTQR; 
            END 
          ELSE
            BEGIN 
            IF QHSCID[0] NQ SASCHID[SALX] 
            THEN
              BEGIN 
              SRENUMB[0] = DFSRENSCH;   # QRF NOT FOR CORRECT SCHEMA   #
              SREFTYP[0] = DFSREFTQR; 
              END 
            END 
  
#         OTHERWISE, INITIALIZE THE QRF TABLE.                         #
  
          IF SRENUMB[0] EQ 0
          THEN
            BEGIN 
            QFFLUSHF[0] = FALSE;
            QFFREE[0] = QHSIZE[0];
            QFSIZE[0] = QHSIZE[0];
            QFGBID[0] = QHGBID[0];
            QFRCB[0] = 0; 
            QFBEG[0] = 0; 
            QFLAST[0] = LOC(QFBEG[0]);
            QFEND[0] = LOC(QFBUFW1[0]); 
            IF NOT SYSRECOVERY     # IF NOT IN SYSTEM RECOVERY MODE    #
            THEN
              BEGIN 
              DB$FLSH;
              DB$QRP(0);           # POSITION THE QRF FOR WRITING      #
              END 
            END 
          END 
  
#       IF AN ERROR OCCURRED WHILE READING THE QRF, SET THE            #
#       APPROPRIATE FIELDS IN THE ERROR BLOCK.                         #
  
        IF FETNOSAT[0] NQ 0 
        THEN
          BEGIN 
          SRENUMB[0] = DFSRENFUN; 
          SREFUNC[0] = DFSREFNIO; 
          SREFPAR[0] = FETNOSAT[0]; 
          SREFTYP[0] = DFSREFTQR; 
          END 
  
#       RELEASE THE SPACE FOR THE QRF HEADER.                          #
  
        DB$MBF(P<QH>);
  
#       IF ANY ERRORS OCCURRED WHILE READING AND VALIDATING THE QRF,   #
#       RETURN THE QRF, RELEASE THE QRF TABLE, AND RESET THE SAL       #
#       POINTER TO ZERO.                                               #
  
        IF SRENUMB[0] NQ 0
        THEN
          BEGIN 
          DB$RTN(FETLFNU[0]); 
          DB$MFF(P<QFT>); 
          SAQRFPTR[SALX] = 0; 
          END 
  
      END 
      TERM; 
