*DECK DB$QRF
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      PROC DB$QRF(CRMPACKET); 
      BEGIN 
 #
* *   DB$QRF--QUICK RECOVER FILE PROCESSOR       PAGE  1
* *   C O GIMBER                                 9/2/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* *   BOB MCALLESTER - BLOCK BUFFER ALLOCATION   DATE  10/19/81 
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE IS CALLED FROM CRM TO LOG A CRM BLOCK
*     TO THE QUICK RECOVERY FILE. 
* 
* DC  ENTRY CONDITIONS
# 
      ARRAY CRMPACKET;;      #CRM ARRAY PASSED FOR QRF LOGGING# 
                             #SEE QRP ARRAY DESCRIPTION#
# 
*     LAST FLAG IN CALL NOT SET 
*       THE BLOCK SPECIFIED IN CALL IS WRITTEN TO QRF FILE. 
*     LAST FLAG IN CALL SET.
*       BLOCK SPECIFIED IN CALL MUST BE WRITTEN TO QRF BEFORE RETURN. 
* 
* DC  CALLING ROUTINES
* 
*     CRM VIA LGX (LOGGING EXIT) ADDRESS IN FIT.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$CRMR;     #ACCEPT NEW REQUESTS WITHOUT CALLING CMM  #
      XREF PROC DB$FLOP;     #GENERATE A FLOW POINT#
      XREF PROC DB$FLSH;     #FLUSH DATA FILE PROCESSOR#
      XREF PROC DB$IOBS;     #BACKSPACE QRF#
      XREF PROC DB$IOER;     #I-O ERROR HANDLER#
      XREF PROC DB$IORW;     #REWIND GIVEN FET# 
      XREF PROC DB$IOWR;     #WRITE RECORD GIVEN FET# 
      XREF FUNC DB$ITC;      #INTERNAL TASK CREATOR#
      XREF PROC DB$JRPT;     #JOURNAL LOG RECOVERY POINT PROCESSOR# 
      XREF PROC DB$MBA;      #ALLOCATE TEMPORARY ARRAY# 
      XREF PROC DB$MBF;      #FREE TEMPORARY ARRAY# 
      XREF PROC DB$POP;      #POP FROM STACK# 
      XREF PROC DB$POP2;     #POP 2 FROM STACK# 
      XREF PROC DB$PSH2;     #PUSH 2 INTO STACK#
      XREF PROC DB$PUSH;     #PUSH INTO STACK#
      XREF PROC DB$RCLL;     #CDCS RECALL PROCESSOR#
      XREF PROC DB$SCHD;     #SCHEDULER#
      XREF PROC DB$WRP;      #TASK WRAP-UP PROCESSOR# 
# 
* DC  NON-LOCAL VARIABLES 
*     CDCS COMMON 
* 
*     JOURNAL LOG COMMON
# 
      XREF ITEM CRMRC   I;              # DB$CRMR COUNT                #
      XREF ITEM DB$MFPA I;              # MEMORY OVERFLOW PROC ADDRESS #
 #
*     DEFINITION OF CONSTANTS 
# 
      DEF DFPREFIXL  #01#;   # LENGTH OF BLOCK PREFIX                  #
      DEF DFSUFFIXL  #02#;   # LENGTH OF BLOCK SUFFIX                  #
# 
*     LOCAL VARIABLES 
# 
      ITEM SCRATCH I;        # A PLACE TO TRASH UNWANTED DATA          #
  
      BASED ARRAY BLOCK;
        ITEM BLOCKWORD; 
  
      ITEM BLKFLEN;          # LENGTH OF QFT BLOCK                     #
      ITEM BLKRLEN;          # LENGTH OF QRF BLOCK                     #
      ITEM LFN I;            # WORK WORD FOR COMPUTING LFN LOC         #
      ITEM OFTX;             # ADDRESS OF OFT ENTRY                    #
      ITEM P1 I;             # PARAMETER POINTER                       #
      ITEM RPTEXT C(30) = " QUICK RECOVERY FILE OVERFLOW "; 
      ITEM SAVEMFPA;         # SAVE THE MEMORY OVERFLOW PROC ADDRESS   #
      ITEM SAVEACL;          # SAVE THE ACL POINTER                    #
      ITEM SAVEAPL;          # SAVE THE APL POINTER                    #
      ITEM SAVEASL;          # SAVE THE ASL POINTER                    #
      ITEM SAVECSF;          # SAVE THE CSFIXED POINTER                #
      ITEM SAVEFKL;          # SAVE THE FKL POINTER                    #
      ITEM SAVEFPT;          # SAVE THE FPT POINTER                    #
      ITEM SAVERCB;          # SAVE THE RCB POINTER                    #
      ITEM SAVERSA;          # SAVE THE RSARBLK POINTER                #
      ITEM SAVERSB;          # SAVE THE RSB POINTER                    #
      ITEM SAVESAL;          # SAVE SALX                               #
      ITEM SAVETQT;          # SAVE THE TQT POINTER                    #
      ITEM SAVEUFT;          # SAVE THE UFT POINTER                    #
      ITEM SVCONSTRA;        # SAVE RCCONSTRA (CONSTRAINING ADDRESS)   #
      ITEM SVCONTA;          # SAVE RCCONTA   (CONTINUATION ADDRESS)   #
      ITEM SVCT;             # SAVE RCCT      (CONSTRAINT TYPE)        #
      ITEM SAVE1;            # SAVE A WORD                             #
      ITEM SAVE2;            # SAVE A WORD                             #
      ITEM WAIT B;           # SET WHILE WAITING FOR QUEUE SPACE       #
      ITEM WRITTEN B;        # THE BLOCK IS WRITTEN TO THE QRF         #
      ITEM XA;               # INDUCTION VARIABLE                      #
      ITEM XB;               # INDUCTION VARIABLE                      #
  
  
      BASED ARRAY FSTT;              # FSTT                            #
        BEGIN 
        ITEM FSNXTPRU  U(18,03,24);  # NEXT PRU NUMBER                 #
        ITEM FSMIPFSTT U(58,42,18);  # LOCATION OF MIP FSTT            #
        END 
  
      BASED ARRAY QRP;       #INPUT REQUEST ARRAY#
      BEGIN 
*CALL QRREQDCLS 
        END 
  
      BASED ARRAY QH;        #HEADER RECORD ON QRF FILE#
        BEGIN 
*CALL QRHEDDCLS 
        ITEM QHWORD  I(00,00,60); 
        END 
  
      BASED ARRAY QBC;       #CHAIN OF BLOCKS TO BE WRITTEN TO QRF# 
        BEGIN 
        ITEM QBFWA (0,0,18);           #FWA OF BLOCK FROM XRM CALL# 
        ITEM QBLEN   (00,24,18);       # LENGTH OF THE QFT BLOCK       #
        ITEM QBNEXT (0,42,18);         #NEXT ENTRY IN CHAIN#
        ITEM QBBLOCK (01,00,60);       # CRM BLOCK                     #
        END 
  
      BASED ARRAY QST;       # BLOCK QUEUE SUFFIX TABLE                #
        BEGIN 
        ITEM QSAID    U(00,00,12);     # AREA ID                       #
        ITEM QSPRUN   U(00,12,24);     # PRU NUMBER OF BLOCK           #
        ITEM QSINDEXF B(00,36,01);     # TRUE IF BLOCK FOR INDEX FILE  #
        ITEM QSGBID   U(00,37,23);     # GOOD BLOCK ID                 #
        ITEM QSWORD1  I(00,00,60);     # FIRST WORD OF THE SUFFIX TABLE#
        ITEM QSVENAM  C(01,00,07);     # PRIMARY VERSION NAME          #
        ITEM QSWORD2  I(01,00,60);     # 2ND WORD OF THE SUFFIX TABLE  #
        END 
  
*CALL QRTABDCLS 
      CONTROL NOLIST;        # JFQUEDCLS                               #
*CALL JFQUEDCLS 
      CONTROL LIST; 
  
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM ABSREF   I(00,00,60);     # REFERENCE AN ABSOLUTE ADDRESS #
        END 
  
  
#     B E G I N   D B $ Q R F   E X E C U T A B L E   C O D E .        #
  
  
 #
* 
* DC  DESCRIPTION  DB$QRF 
* 
*     ** NOTE **
*       IF THE SECOND PARAMETER OF A DB$SCHD CALL IS DFWAITTASK 
*       AND SCHDFLAG CONTAINS THE LOCATION OF AN INTERNAL TASK RCB, 
*         THEN THE SPECIFIED INTERNAL TASK IS THE ONLY OTHER TASK 
*         THAT WILL BE EXECUTED BEFORE RETURNING CONTROL. 
*       CONSEQUENTLY, THE DB$SCHD CALL IS NOT A FULL INTERRUPTION.
*       RECURSIVE CALLS TO DB$QRF ARE NOT PERMITTED.
*       IT IS NOT NECESSARY TO SAVE LOCAL VARIABLES.
* 
*       CDCSCOMMN BASED ARRAY POINTERS DO GET RESET BY DB$SCHD. 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF    ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
 #
*     SET QRP BASED ARRAY TO CRM PACKET.
*     CONVERT LAST 6 CHARACTERS IN LFN TO OCTAL GIVING OFT ADDRESS. 
 #
      P<QRP> = LOC(CRMPACKET);
      OFTX = 0; 
      LFN = B<6,36>QRLFN[0];
  
      CONTROL FASTLOOP; 
      FOR XA = 24 STEP 6 UNTIL 54 
      DO
        BEGIN 
        OFTX = 8*OFTX + B<XA,6> LFN - O"33";
        END 
      CONTROL SLOWLOOP; 
 #
*     GET QRF FET TABLE ADDRESS FROM OFT. 
 #
      P<OFT> == OFTX; 
      P<QFT> = OFQFT[0];
      P<FET> = LOC(QFFET);
  
      CONTROL IFGR DFFLOP,0;
        XREF FUNC DB$CDEC C(10);
        XREF FUNC DB$COCB C(10);
        XREF PROC DB$FLUI;
        ITEM QRFFLOP C(7);
        ITEM QRFFLO2 C(7);
  
        QRFFLOP = "Q/L000 ";
        C<3,3>QRFFLOP = DB$CDEC(OFARID[0],3); 
        IF QRINDEXF[0]
        THEN
          BEGIN 
          C<6,1>QRFFLOP = "X";
          END 
        QRFFLO2 = DB$COCB(B<3,21>QRPRUN[0],7);
        IF QRPRUN[0] EQ 1 
        THEN
          BEGIN 
          P<BLOCK> = QRFWA[0];
          B<0,6>QRFFLO2 = O"33" + B<0,3>BLOCKWORD[13];
          END 
      CONTROL ENDIF;
  
 #
* 
*     ** LAST CALL  **
* 
*     IF IT IS THE "LAST CALL" FOR THIS BLOCK THEN
*       IF QRF PROCESSOR TASK NOT ACTIVE THEN RETURN. 
 #
      IF QRLASTF[0] THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLUI(QRFFLOP);        # RECORD AREA ID                    #
          DB$FLUI(QRFFLO2);        # AND PRU NUMBER                    #
        CONTROL ENDIF;
  
        IF QFRCB[0] EQ 0 THEN 
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("QRF-R1 ");        # GENERATE FLOW POINT - RETURN 1#
          CONTROL ENDIF;
  
          P<OFT> = OFTX;               # RESTORE OFT POINTER           #
          P<QFT> = DFNPTR;
          P<FET> = DFNPTR;
          RETURN; 
  
          END 
 #
*       IF BLOCK FOR WHICH CALL IS MADE IS NOT IN QRF BLOCK CHAIN THEN
*         RETURN. 
*       WHEN IT IS IN THE CHAIN, MAKE REPEATED CALLS TO THE QRFTASK 
*       (THROUGH DB$SCHD) UNTIL THE BLOCK DISAPPEARS FROM THE CHAIN.
* 
*       THE "LAST CALL" CAN BE MADE UNEXPECTEDLY DURING A CMM CALL. 
*       BE SURE ALL OF CDCSCOMMN POINTERS THAT ARE RESET BY DB$SCHD 
*       ARE RESTORED TO THEIR INITIAL VALUES. 
*       SOME ROUTINES HAVE SUBSTITUTED OTHER VALUES IN THESE POINTERS 
*       WHILE THEY REQUEST A NEW MEMORY BLOCK.
*       SOME, LIKE DB$IREC, HAVE TEMPORARILY MODIFIED THE RCB POINTER.
*       THE RCB POINTER IS RESTORED BY DB$SCHD BUT THE FIELDS RCCONTA,
*       RCCONSTRA AND RCCT MUST BE SAVED BECAUSE THEY ARE MODIFIED. 
 #
        P<QBC> = QFBEG[0];
        FOR XA = XA WHILE LOC(QBC) NQ 0 
        DO
          BEGIN 
          IF QRFWA[0] EQ QBFWA[0] THEN
            BEGIN 
            SAVEMFPA  = DB$MFPA;
            SAVEACL   = P<ACL>; 
            SAVEAPL   = P<APL>; 
            SAVEASL   = P<ASL>; 
            SAVECSF   = P<CSFIXED>; 
            SAVEFKL   = P<FKL>; 
            SAVEFPT   = P<FPT>; 
            SAVERSA   = P<RSARBLK>; 
            SAVERSB   = P<RSB>; 
            SAVESAL   = SALX; 
            SAVETQT   = P<TQT>; 
            SAVEUFT   = P<UFT>; 
            SVCONSTRA = RCCONSTRA[0]; 
            SVCONTA   = RCCONTA[0]; 
            SVCT      = RCCT[0];
            SCHDFLAG = QFRCB[0];
            DB$PSH2(P<OFT>,OFTX); 
            P<OFT> = DFNPTR;
            P<QFT> = DFNPTR;
            P<FET> = DFNPTR;
            DB$SCHD(LOC(STATCOMP),DFWAITTASK);
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("QRF-S1 ");      # GENERATE FLOW POINT - SCHED 1 #
            CONTROL ENDIF;
  
            DB$POP2(OFTX,  P<OFT>); 
            P<QFT> = OFQFT[0];
            P<FET> = LOC(QFFET);
            DB$MFPA      = SAVEMFPA;
            P<ACL>       = SAVEACL; 
            P<APL>       = SAVEAPL; 
            P<ASL>       = SAVEASL; 
            P<CSFIXED>   = SAVECSF; 
            P<FKL>       = SAVEFKL; 
            P<FPT>       = SAVEFPT; 
            P<RSARBLK>   = SAVERSA; 
            P<RSB>       = SAVERSB; 
            SALX         = SAVESAL; 
            P<TQT>       = SAVETQT; 
            P<UFT>       = SAVEUFT; 
            RCCONSTRA[0] = SVCONSTRA; 
            RCCONTA[0]   = SVCONTA; 
            RCCT[0]      = SVCT;
            P<QBC> = QFBEG[0];  # REINITIALIZE THE SCAN                #
            END 
          ELSE
            BEGIN 
            P<QBC> = QBNEXT[0];  # CONTINUE THE SCAN                   #
            END 
          END 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QRF-R2 ");          # GENERATE FLOW POINT - RETURN 2#
        CONTROL ENDIF;
  
        P<OFT> = OFTX;       # RESTORE THE OFT POINTER                 #
        P<QFT> = DFNPTR;
        P<FET> = DFNPTR;
        P<QBC> = DFNPTR;
        RETURN; 
  
        END 
  
  
 #
* 
*     ** FIRST CALL **
* 
*     THIS IS THE FIRST CALL FOR LOGGING OF THIS BLOCK. 
*     OBTAIN A BUFFER SPACE FOR IT IN THE BLOCK LOGGING CHAIN BUFFER. 
*     IF SPACE IS NOT AVAILABLE, CALL THE INTERNAL TASK 'QRFTASK' TO
*     EMPTY SOME SPACE FOR IT.
*     REPEAT THIS UNTIL SPACE IS AVAILABLE. 
*     IF THE CHAIN BUFFER IS EMPTY AND THERE IS STILL NOT ENOUGH SPACE, 
*     WRITE IT DIRECTLY TO THE QRF FROM ITS CRM BUFFER.  THAT WRITE 
*     MUST BE COMPLETED BEFORE RETURNING TO CRM.
* 
 #
  
      CONTROL IFGR DFFLOP,0;
        C<2,1>QRFFLOP = "F";       # MARK THE FIRST CALL               #
        DB$FLUI(QRFFLOP);          # RECORD AREA ID                    #
        DB$FLUI(QRFFLO2);          # AND PRU NUMBER                    #
      CONTROL ENDIF;
  
      IF QRPRUN[0] EQ 1 
      THEN                         # IT IS AN FSTT                     #
        BEGIN 
        P<BLOCK> = QRFWA[0];
        IF BLOCKWORD[13] LS 0 
        THEN                       # THE OPEN FLAG IS SET, SKIP IT.    #
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("QRF-R3A"); 
          CONTROL ENDIF;
  
          P<OFT> = OFTX;           # RESTORE OFT POINTER               #
          P<QFT> = DFNPTR;
          P<FET> = DFNPTR;
          P<QBC> = DFNPTR;
          RETURN; 
  
          END 
        END 
      P<FSTT> = OFFITFSTT[0]; 
      IF QRINDEXF[0]
      THEN
        BEGIN 
        P<FSTT> = FSMIPFSTT[0];    # USE THE MIP FSTT                  #
        END 
      IF QRPRUN[0] GQ FSNXTPRU[0] 
      THEN                         # SKIP BLOCKS THAT ARE NOT WRITTEN  #
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QRF-R3B"); 
        CONTROL ENDIF;
  
        P<OFT> = OFTX;             # RESTORE OFT POINTER               #
        P<QFT> = DFNPTR;
        P<FET> = DFNPTR;
        P<QBC> = DFNPTR;
        RETURN; 
  
        END 
      WAIT = TRUE;
      WRITTEN = FALSE;
      BLKRLEN = QRLEN[0] + DFSUFFIXL; 
      BLKFLEN = BLKRLEN + DFPREFIXL;
  
      FOR XA = XA WHILE WAIT
      DO
        BEGIN 
        CRMRC = 0;
        WAIT = FALSE; 
        IF QFBEG[0] EQ 0
        THEN                 # THE CHAIN BUFFER IS EMPTY               #
          BEGIN 
          IF BLKFLEN GR QFBUFL[0] 
          THEN
            BEGIN 
# 
*           THE BLOCK DOESNT FIT IN THE CHAIN BUFFER EVEN THOUGH THE
*           CHAIN BUFFER IS EMPTY.
*           THIS BLOCK IS WRITTEN DIRECTLY FROM ITS CRM BUFFER. 
# 
            P<QST> = QRFWA[0] + QRLEN[0]; 
            SAVE1 = QSWORD1[0];  # SAVE THE WORDS FOLLOWING THE BLOCK  #
            SAVE2 = QSWORD1[1]; 
# 
*           CONSTRUCT THE SUFFIX FOLLOWING THE CRM BLOCK. 
# 
            QSAID[0] = OFARID[0]; 
            QSPRUN[0] = QRPRUN[0];
            QSINDEXF[0] = QRINDEXF[0];
            QSGBID[0] = QFGBID[0];
            QSWORD2[0] = 0; 
            QSVENAM[0] =OFVENAME[0];
# 
*           WRITE THE BLOCK DIRECTLY TO THE QRF.
*           WAIT FOR COMPLETION OF THE WRITE. 
* 
*           NOTE. 
*             DB$RCLL CAN NOT BE USED TO WAIT FOR COMPLETION BECAUSE
*             IT CALLS DB$IREC TO ACCEPT NEW REQUESTS WHILE WAITING.
*             DB$IREC MAY IN TURN CALL CMM TO LINK IN A NEW RCB.
*             THE CMM BLOCK CHAIN HAS BEEN TEMPORARILY DESTROYED, SO
*             CMM REQUESTS ARE NOT ALLOWED. 
# 
            DB$IOWR(P<FET>,QRFWA[0],BLKRLEN); 
            FOR XB = XB WHILE NOT FETCOMP[0]
            DO
              BEGIN 
              CRMRC = 0;
              DB$CRMR;
              END 
            QSWORD1[0] = SAVE1; 
            QSWORD1[1] = SAVE2; 
            WRITTEN = TRUE; 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("QRF-LB");   # LARGE BLOCK                       #
            CONTROL ENDIF;
  
            END 
          END 
        ELSE
          BEGIN 
# 
*         THERE IS AN EXISTING BLOCK CHAIN. 
# 
          IF QFBEG[0] LS QFEND[0] 
          THEN
            BEGIN 
# 
*           THE CHAIN IS NOT WRAPPED AROUND THE END OF THE BUFFER.
*           LOOK FOR SPACE BETWEEN THE END OF THE CHAIN AND THE END 
*           OF THE BUFFER.
# 
            IF BLKFLEN GR LOC(QFBUFW1[0]) + QFBUFL[0] - QFEND[0]
            THEN
              BEGIN 
# 
*             THERE IS NOT ENOUGH SPACE, WRAP AROUND AND LOOP AGAIN.
# 
              QFEND[0] = LOC(QFBUFW1[0]); 
              WAIT = TRUE;
              TEST XA;
  
              END 
# 
*           THERE IS SPACE.  FALL OUT OF LOOP AND USE IT. 
# 
            END 
          ELSE
            BEGIN 
# 
*           ANY AVAILABLE SPACE IS BETWEEN QFEND AND QFBEG. 
# 
            IF BLKFLEN GR QFBEG[0] - QFEND[0] 
            THEN
              BEGIN 
              WAIT = TRUE;   # WAIT FOR SPACE                          #
              END 
            END 
          END 
  
        IF WAIT 
        THEN
          BEGIN 
          SCHDFLAG = QFRCB[0];
          DB$PUSH(P<UFT>);
          DB$PSH2(P<OFT>,OFTX); 
          P<OFT> = DFNPTR;
          P<QFT> = DFNPTR;
          P<FET> = DFNPTR;
          DB$SCHD(LOC(STATCOMP),DFWAITTASK);  # WAIT FOR 'QRFTASK'     #
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("QRF-S2");
          CONTROL ENDIF;
  
          DB$POP2(OFTX, P<OFT>);
          DB$POP(P<UFT>); 
          P<QFT> = OFQFT[0];
          P<FET> = LOC(QFFET);
          END 
        END                  # END OF BUFFER ALLOCATION LOOP           #
  
  
      IF NOT WRITTEN
      THEN
        BEGIN 
        P<QBC> = QFLAST[0]; 
        QBNEXT[0] = QFEND[0]; 
        P<QBC> = QFEND[0];
        QBFWA[0] = QRFWA[0];  # BUILD THE BLOCK PREFIX                 #
        QBLEN[0] = QRLEN[0];
        QBNEXT[0] = 0;
        P<BLOCK> = QRFWA[0];
  
        CONTROL FASTLOOP; 
        FOR XA = QRLEN[0] -1 STEP -1 UNTIL 0
        DO
          BEGIN              # MOVE THE BLOCK INTO THE CHAIN BUFFER    #
          QBBLOCK[XA] = BLOCKWORD[XA];
          END 
        CONTROL SLOWLOOP; 
  
        P<QST> = LOC(QBBLOCK[0]) + QBLEN[0];
                             # BUILD THE BLOCK SUFFIX                  #
        QSAID[0] = OFARID[0]; 
        QSPRUN[0] = QRPRUN[0];
        QSINDEXF[0] = QRINDEXF[0];
        QSGBID[0] = QFGBID[0];
        QSWORD2[0] = 0; 
        QSVENAM[0] = OFVENAME[0]; 
        QFLAST[0] = LOC(QBC); 
        QFEND[0] = LOC(QST) + DFSUFFIXL;
        END 
  
      P<OFT> = OFTX;
 #
*     START FLUSH TASK IF ALLOCATED SPACE USED UP.
 #
      IF QFFREE[0] LQ QRLEN[0] + DFPRUSIZ + DFSUFFIXL 
        AND NOT QFFLUSHF[0] 
        THEN
          BEGIN 
                             # SET UP THE IDLERCB POINTER SO THAT      #
                             # DB$RCBC WILL FIND THE QFT RCB.          #
                             # THE RCB IS PROVIDED AS A PART OF THE    #
                             # QFT MEMORY BLOCK.                       #
                             # THIS IS DONE TO AVOID CMM CALLS DURING  #
                             # DB$QRF PROCESSING.                      #
                             # A RECURSIVE CALL TO DB$QRF DURING CRM   #
                             # MEMORY OVERFLOW HANDLING CAN NOT BE     #
                             # TOLERATED.                              #
          SAVERCB = LOC(RCB); 
          XA = LOC(QFBUFW1[0]) + QFBUFL[0] + DFRCIR5; 
          ABSREF[XA] = IDLERCBP;
          IDLERCBP = XA;
          RCBIC = RCBIC +1; 
          QFFLUSHF[0] = TRUE; 
          P<RCB> = DB$ITC(FLUSHTASK,P<QFT>);
          RCFUNC[0] = DFQRF;
          P<RCB> = SAVERCB; 
          END 
 #
*     REDUCE THE FREE SPACE TALLY.
*       ** NOTE **
*         CRM ASSIGNS A BLOCK LENGTH THAT IS TWO LESS THAN AN EVEN PRU. 
*         DB$QRF APPENDS TWO WORDS, CAUSING AN ADDITIONAL PRU TO BE 
*         USED FOR THE END-OF-RECORD. 
 #
      QFFREE[0] = QFFREE[0] - (QRLEN[0] + DFPRUSIZ + DFSUFFIXL);
 #
*     IF ACTIVE RCB FOR QRF THEN RETURN.
 #
      IF QFRCB[0] NQ 0
        OR WRITTEN
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QRF-R3 ");          # GENERATE FLOW POINT - RETURN 3#
        CONTROL ENDIF;
  
        P<QFT> = DFNPTR;
        P<FET> = DFNPTR;
        P<QBC> = DFNPTR;
        RETURN; 
        END 
 #
*     CREATE QRF INTERNAL TASK. 
*     START ITS EXECUTION.
*     RETURN. 
 #
                             # SEE NOTE ON FIRST DB$ITC CALL           #
      SAVERCB = LOC(RCB); 
      XA = LOC(QFBUFW1[0]) + QFBUFL[0]; 
      ABSREF[XA] = IDLERCBP;
      IDLERCBP = XA;
      RCBIC = RCBIC +1; 
      P<RCB> = DB$ITC(QRFTASK,P<QFT>);
      QFRCB[0] = LOC(RCB);
      RCFUNC[0] = DFQRF;
      P<RCB> = SAVERCB; 
      DB$PSH2(OFTX,P<UFT>); 
      SCHDFLAG = QFRCB[0];
      P<QFT> = DFNPTR;
      P<FET> = DFNPTR;
      P<QBC> = DFNPTR;
      DB$SCHD(LOC(STATCOMP),0); 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF-S3");             # GENERATE FLOW POINT - SCHED 3 #
      CONTROL ENDIF;
  
      DB$POP2(P<UFT>,P<OFT>); 
      RETURN; 
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   D B $ Q R P            #
  
  
      XDEF PROC DB$QRP; 
      PROC DB$QRP(RPTN);
      BEGIN 
 #
* *   DB$QRP--QRF RECOVERY POINT PROCESSOR       PAGE  1
* *   C O GIMBER                                 9/2/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     FLUSH THE QRF AND SET IT TO THE RECOVERY POINT CONDITION. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM RPTN I;           # RECOVERY POINT NUMBER                   #
# 
*     ASSUMPTIONS 
* 
*     SALX INDEX IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     QRF HAS BEEN FLUSHED, REWOUND, AND HEADER BLOCK REWRITTEN.
* 
* DC  CALLING ROUTINES
* 
*     DB$CMT$                      COMMIT SYMBIONT
*     DB$JRPT                      JOURNAL LOG RECOVERY POINT 
*     DB$QFIN                      QRF INITIALIZER
*     DB$QRFA                      APPLY THE CONTENTS OF THE QRF
*     DB$QRF                       QRF PROCESSOR VIA CRM LOG EXIT 
*     DB$RPT$                      RECOVERY POINT CONTROL SYMBIONT
*     DB$TQTD                      TQT DELETER
*     DB$WRAR                      WRAP-UP AUTOMATIC SYSTEM RECOVERY
* 
* DC  CALLED ROUTINES 
* 
*     DB$FLOP                      GENERATE A FLOW POINT
*     DB$IOBS                      CIO BACKSPACE
*     DB$IOER                      I-O ERROR HANDLER
*     DB$IORW                      CIO REWIND 
*     DB$IOWR                      CIO WRITE
*     DB$MBA                       ALLOCATE TEMPORARY BUFFER
*     DB$MBF                       FREE TEMPORARY BUFFER
*     DB$RCLL                      CDCS RECALL PROCESSOR
*     DB$SCHD                      CDCS SCHEDULER 
* 
 #
  
  
  
#     B E G I N   D B $ Q R P   E X E C U T A B L E   C O D E .        #
  
 #
* 
* DC  DESCRIPTION  DB$QRP 
* 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRP    ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
 #
*     IF OUTSTANDING QRF INTERNAL TASK THEN FORCE IT TO COMPLETE. 
 #
      P<QFT> = SAQRFPTR[SALX];
      FOR XA = XA WHILE QFRCB[0] NQ 0 
      DO
        BEGIN 
        SCHDFLAG = QFRCB[0];
        P<QFT> = DFNPTR;
        P<FET> = DFNPTR;
        DB$SCHD(LOC(STATCOMP),DFWAITTASK);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QRP-S1 ");          # GENERATE FLOW POINT - SCHED 1 #
        CONTROL ENDIF;
  
        P<QFT> = SAQRFPTR[SALX];
        END 
 #
*     REWIND QRF. 
*     RECALL CDCS UNTIL IO COMPLETE.
 #
      P<FET> = LOC(QFFET[0]); 
      DB$IORW(P<FET>);
      DB$RCLL(P<FET>);
 #
*     REWRITE QRF HEAD RECORD.
*     RECALL CDCS UNTIL IO COMPLETE.
 #
      DB$MBA(DFPRUSIZ,P<QH>); 
      P<QFT> = SAQRFPTR[SALX];     # IN CASE DB$CMOH WAS CALLED.       #
                                   # ANOTHER DB$QRF CALL COULD HAVE    #
                                   # INTERVENED.                       #
  
                             # CLEAR THE MEMORY BLOCK                  #
                             # FOR A CLEANER LOOKING QRF FILE HEADER   #
                             # AND FOR BETTER DATA SECURITY            #
      CONTROL FASTLOOP; 
      FOR XA = (DFPRUSIZ-8)/8*8 STEP -8 UNTIL 0 
      DO
        BEGIN 
        QHWORD[XA+0] = 0; 
        QHWORD[XA+1] = 0; 
        QHWORD[XA+2] = 0; 
        QHWORD[XA+3] = 0; 
        QHWORD[XA+4] = 0; 
        QHWORD[XA+5] = 0; 
        QHWORD[XA+6] = 0; 
        QHWORD[XA+7] = 0; 
        END 
      CONTROL SLOWLOOP; 
  
      P<FET> = LOC(QFFET[0]); 
      QFGBID[0] = QFGBID[0]+1;
      QFFREE[0] = QFSIZE[0];
      QHSCID[0] = SASCHID[SALX];
      QHGBID[0] = QFGBID[0];
      QHSIZE[0] = QFSIZE[0];
      QHRPNUM[0] = RPTN;
      DB$IOWR(P<FET>,P<QH>,DFPRUSIZ); 
      DB$RCLL(P<FET>);
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$IOER(P<FET>);
        END 
 #
*     BACKSPACE QRF OVER EOR.  NOW WHEN QRF LOGGING IS DONE THE FIRST 
*       RECORD WILL BE LONGER THAN ONE PRU. 
 #
      DB$IOBS(P<FET>);
      DB$RCLL(P<FET>);
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$IOER(P<FET>);
        END 
      DB$MBF(P<QH>);
      P<QFT> = DFNPTR;
      P<QH> = DFNPTR; 
      END  #DB$QRP# 
  
  
  
#     B E G I N   I N T E R N A L   T A S K  -  Q R F T A S K .        #
  
 #
* 
* DC  QRF TASKS 
* 
*     *********************** 
* 
*     QRFTASK--MAIN QRF INTERNAL TASK WHICH WRITES BLOCKS TO QRF. 
* 
*     IF QRF FET BUSY RECALL THROUGH SCHEDULER. 
 #
QRFTASK:  
      BEGIN 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF-Q  ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
      DB$POP(P<QFT>); 
  
NEXTBLK:                     # LOOP HERE FOR EACH SUCCESSIVE BLOCK     #
      P<FET> = LOC(QFFET[0]); 
                             # WAIT FOR A PRIOR WRITE TO COMPLETE      #
      FOR XA=XA WHILE NOT FETCOMP[0]
      DO
        BEGIN 
        DB$PUSH(P<QFT>);
        P1 = LOC(FET);
        P<QFT> = DFNPTR;
        P<FET> = DFNPTR;
        DB$SCHD(P1,DFWAITIO); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("QRF-QS1");          # GENERATE FLOW POINT - SCHED 1 #
        CONTROL ENDIF;
  
        DB$POP(P<QFT>); 
        P<FET> = LOC(QFFET[0]); 
        END 
      P<QBC> = QFBEG[0];
 #
*     WRITE QRF BLOCK.
 #
      DB$IOWR(P<FET>,LOC(QBBLOCK[0]),QBLEN[0] + DFSUFFIXL); 
      DB$PUSH(P<QFT>);
      P1 = LOC(FET);
      P<QFT> = DFNPTR;
      P<FET> = DFNPTR;
      DB$SCHD(P1,DFWAITRTN);      # RETURN TO THE WAITING TASK         #
                                  # IF THERE IS ONE.                   #
                                  # ELSE, THIS IS A SIMPLE INTERRUPT.  #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF-QS2");            # GENERATE FLOW POINT - SCHED 2 #
      CONTROL ENDIF;
  
      DB$POP(P<QFT>); 
      P<FET> = LOC(QFFET[0]); 
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        DB$IOER(P<FET>);
        END 
 #
*     DELINK THE BLOCK FROM THE CHAIN.
 #
      P<QBC> = QFBEG[0];
      QFBEG[0] = QBNEXT[0]; 
 #
*     IF THERE ARE MORE BLOCKS TO BE LOGGED 
*       GO LOG THE NEXT BLOCK.
 #
      IF QFBEG[0] NQ 0
      THEN
        BEGIN 
        GOTO NEXTBLK; 
  
        END 
 #
*     THERE ARE NO MORE BLOCKS IN THE CHAIN.
*     SET THE POINTERS TO THE VALUES USED FOR AN EMPTY BUFFER.
 #
      QFLAST[0] = LOC(QFBEG[0]);
      QFEND[0] = LOC(QFBUFW1[0]); 
 #
*     TERMINATE QRF INTERNAL TASK.
 #
      QFRCB[0] = 0; 
      P<QFT> = DFNPTR;
      P<FET> = DFNPTR;
      DB$WRP; 
      END  #QRFTASK#
  
  
  
#     B E G I N   I N T E R N A L   T A S K  -  F L U S H T A S K .    #
  
 #
* 
*     *********************** 
* 
*     FLUSHTASK--INTERNAL TASK CALLED WHEN QRF OVERFLOWS. 
*                ISSUES FLUSH ON SCHEMA.
 #
FLUSHTASK:  
      BEGIN 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF-F  ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
 #
*     FLUSH CRM BUFFERS FOR AREAS OF THE SCHEMA.
*     RESET THE QRF BEFORE DOING THE JOURNAL LOGGING RECOVERY POINT.
*         THIS WILL INSURE THAT IT IS DONE AND WONT BE DELAYED
*         BY WAITS WITHIN DB$JRPT.
*         THE EXTRA DB$QRP CALL FROM DB$JRPT ADDS TO THE OVERHEAD 
*         BUT WILL DO NO OTHER HARM.
* 
*     IF JOURNAL LOGGING IS ACTIVE AND NOT RECENTLY CALLED
*       CALL DB$JRPT TO DO THE RECOVERY POINT PROCESSING. 
* 
*     WRAP UP THE REQUESTED INTERNAL TASK.
 #
      DB$POP(P<QFT>); 
      DB$PUSH(P<QFT>);
      DB$FLSH;
      DB$QRP(0);
      IF SAJLFPTR[SALX] NQ 0
        AND NOT SYSRECOVERY 
      THEN
        BEGIN 
        P<JFQUEUE> = SAJLFPTR[SALX];
        IF   B<42,12>TIMESTAMP LS JFQTIME[0]
          OR B<42,12>TIMESTAMP GR JFQTIME[0] + 6
        THEN
          BEGIN 
                             # USE ANOTHER LEVEL OF INTERNAL TASKING.  #
                             # IT WILL LEAVE THIS RCB IN THE QRF TABLE #
                             # AVAILABLE TO RESET THE QRF AGAIN WHILE  #
                             # DB$JRPT IS RUNNING.                     #
          SCRATCH = DB$ITC(JRPTTASK,SCRATCH); 
          END 
        END 
      DB$POP(P<QFT>); 
      QFFLUSHF[0] = FALSE;
  
      P<QFT> = DFNPTR;
      P<JFQUEUE> = DFNPTR;
      DB$WRP; 
      END  #FLUSHTASK#
  
  
  
#     B E G I N   I N T E R N A L   T A S K  -  J R P T T A S K .    #
  
 #
* 
*     *********************** 
* 
*     JRPTTASK - INTERNAL TASK TO CALL DB$JRPT. 
 #
JRPTTASK:   
      BEGIN 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QRF-JRP");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
      DB$JRPT(LOC(RPTEXT)); 
  
      DB$WRP; 
      END  #JRPTTASK# 
      END  #DB$QRF# 
      TERM; 
