*DECK DB$RFOR 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      PROC DB$RFOR( ERRBLKA );
      BEGIN 
 #
* *   DB$RFOR - ROLL FORWARD FOR AUTO-RECOVERY   PAGE  1
* *   D E TRIGLIA/W P CEAGLIO                    DATE  01/15/81 
* *   R L MCALLESTER                             DATE  11/15/84 
* 
* DC  PURPOSE 
* 
*     TO APPLY ALL AFTER IMAGES FROM THE JOURNAL LOG FROM THE LAST
*     RECOVERY POINT TO EOI.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM ERRBLKA   I;            # ADDRESS OF ERROR PARAMETER BLOCK  #
# 
* D   ASSUMPTIONS 
* 
*     THE JOURNAL LOG IS ATTACHED.
*     SALX IS SET.
*     SAJLFPTR POINTS TO THE JOURNAL LOG QUEUE (WHICH INCLUDES THE FET
*       AND BUFFERS FOR THE JOURNAL LOG HEADER AND FOR GENERAL I/O).
*       THE HEADER RECORD HAS ALREADY BEEN READ INTO ITS BUFFER.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - ALL AFTER IMAGES FOLLOWING THE LAST RECOVERY POINT HAVE
*                BEEN APPLIED TO THE DATABASE.
* 
*     ABNORMAL - ROLL FORWARD NOT PERFORMED OR INCOMPLETE.
*                AN I/O ERROR ON THE JOURNAL LOG WILL RESULT IN THE 
*                SCHEMA BEING PLACED IN *ERRDOWN* STATUS. 
*                AN I/O ERROR ON AN AREA WILL RESULT IN THE AREA BEING
*                PLACED IN *ERRDOWN* STATUS.
* 
* DC  CALLING ROUTINES
* 
*     DB$CARS      AUTO-RECOVERY CONTROL ROUTINE
*     DB$RDLG      READ RECORD FROM JOURNAL LOG 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC CLOSEM;            # CRM CLOSE PROCEDURE               #
      XREF FUNC DB$CBIN;           # CONVERT DISPLAY TO BINARY         #
      XREF PROC DB$DRAR;           # DOWN AND RETURN AREA              #
      XREF PROC DB$FLOP;           # RECORD A FLOW POINT               #
      XREF PROC DB$FTEX;           # CRM ERROR ROUTINE                 #
      XREF FUNC DB$LNK;            # LINK CMM BLOCK INTO CHAIN         #
      XREF PROC DB$LNKD;           # DELINK CMM BLOCK FROM CHAIN       #
      XREF PROC DB$MBA;            # ALLOCATE CMM BLOCK                #
      XREF PROC DB$MBF;            # RELEASE CMM BLOCK                 #
      XREF PROC DB$MFF;            # RELEASE CMM BLOCK                 #
      XREF FUNC DB$OCAR B;         # OPEN AND CHECK AREA               #
      XREF PROC DB$PUNT;           # ABORT CDCS                        #
      XREF PROC DB$RA0;            # PARAMETER LIST TERMINATOR         #
      XREF FUNC DB$RDLG;           # READ RECORD FROM JOURNAL LOG      #
      XREF FUNC DB$ROLI B;         # READ FROM THE ROLL OUT FILE       #
      XREF FUNC DB$ROLO B;         # WRITE TO THE ROLL OUT FILE        #
      XREF PROC DLTE;              # CRM DELETE PROCEDURE              #
      XREF PROC PUT;               # CRM PUT PROCEDURE                 #
      XREF PROC REPLC;             # CRM REPLACE PROCEDURE             #
# 
* DC  INTERNAL PROCS/FUNCS
* 
*     FINDLRP      LOCATE RECOVERY POINT RECORD IN JOURNAL LOG
*     FINDRFT      FIND/CREATE ENTRY IN THE RFT CHAIN 
*     MEMOVFL      PROCESS MEMORY OVERFLOW
*     ROLLFWD      APPLY AFTER IMAGE TO DATABASE FILE 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
# 
      XREF ITEM CRMRC;             # CRM RECALL COUNT                  #
      XREF ITEM DB$FWAR;           # FIRST WORD ADDRESS FOR DB$ROLO    #
      XREF ITEM DB$FTSM B;         # SUPPRESS MESSAGES FROM DB$FTEX    #
      XREF ITEM DB$LWAR;           # LAST WORD ADDRESS FOR DB$ROLO     #
      XREF ITEM DB$MFPA;           # CMM OVERFLOW OWNCODE EXIT ADDRESS #
      XREF ITEM DB$TARN;           # TERMINATING AREA ID NUMBER        #
      XREF ITEM DB$TARV C(7);      # TERMINATING AREA VERSION NAME     #
# 
*     P<OFT>
*     OFSTATUS IN OFT 
*     P<UFT>
* 
* DC  DESCRIPTION 
* 
*     THE STRATEGY FOR ROLL-FORWARD PROCESSING IS BASED ON READING
*     (SEQUENTIALLY) THE JOURNAL LOG FILE FROM THE LAST RECOVERY POINT
*     TO END-OF-INFORMATION, SELECTING ONLY AFTER IMAGES FOR RECOVERY.
*     SINCE UPDATES TO MORE THAN ONE AREA MAY BE INVOLVED, ATTACHING
*     AND ACTIVATING AN AREA (AND ITS INDEX) OCCUR AS REQUIRED.  AN 
*     INFORMATION STRUCTURE, THE *RECOVERED FILE TABLE* (RFT), DRIVES 
*     THE AFTER IMAGE APPLICATION PROCESS.  THE RFT CONSISTS OF AN ENTRY
*     FOR EACH UNIQUE AREA/VERSION COMBINATION ENCOUNTERED IN THE SCAN
*     OF THE JOURNAL LOG FILE.  APPLICATION OF THE AFTER IMAGE IS DONE
*     WITHOUT REGARD FOR MULTIPLE UPDATES TO THE SAME RECORD WITHIN AN
*     AREA. 
* 
*     THE FOLLOWING STEPS COMPRISE THE PROCESSING:  
* 
* 
*     -  POSITION THE JOURNAL LOG TO THE LAST RECOVERY POINT. 
* 
*     -  READ THE JOURNAL LOG UNTIL END-OF-INFORMATION IS REACHED.
*        FOR EACH RECORD WHICH IS AN AFTER-IMAGE, DO THE FOLLOWING: 
* 
*          *  EXTRACT THE AREA ID AND VERSION FROM THE RECORD.
* 
*          *  ATTACH AND OPEN THE AREA/VERSION IF NOT ALREADY DONE. 
* 
*          *  PRIME THE FIT ASSIGNED TO THE AREA WITH THE *WSA*,
*             *KA*, AND *RL* PARAMETERS FROM INFORMATION IN THE 
*             JOURNAL LOG RECORD. 
* 
*          *  APPLY THE AFTER-IMAGE TO THE AREA.  IF AN ERROR OTHER 
*             THAN *445* OR *446* OCCURS, DOWN THE AREA.
* 
*     -  AT END-OF-INFORMATION, DO THE FOLLOWING FOR EACH RFT ENTRY:  
* 
*          *  CLOSE THE FILE (IF IN *UP* STATUS) AND DELINK THE UFT.
* 
*          *  IF THE RFT ENTRY HAS THE *BAD* FLAG SET, ISSUE A DAYFILE
*             MESSAGE WITH THE AREA IDENTIFIER AND VERSION NAME.
* 
*          *  DELINK THE RFT ENTRY. 
* 
*     IF AN I/O ERROR OCCURRED ON READING THE JOURNAL LOG, RETURN AN
*     ERROR TO THE CALLER AND PLACE THE SCHEMA IN *ERRDOWN* STATUS. 
*     RELEASE THE TEMPORARY BUFFER FOR THE JOURNAL LOG RECORD.
* 
 #
  
  
  
#     LOCAL VARIABLES (GLOBAL TO ALL PROCS/FUNCS)                      #
  
      ITEM ARID         I;         # AREA IDENTIFIER                   #
      ITEM ARVERS   C(07);         # AREA VERSION NAME                 #
      ITEM INDEX        I;         # SCRATCH - FOR LOOPS               #
      ITEM JLEOI        B;         # TRUE IF EOI ON JOURNAL LOG        #
      ITEM JLIOERR      B;         # TRUE IF I/O ERROR ON JOURNAL LOG  #
      ITEM KL           I;         # PRIMARY KEY LENGTH IN CHARACTERS  #
      ITEM KLW          I;         # PRIMARY KEY LENGTH IN WORDS       #
      ITEM LOGRECL      I;         # JOURNAL LOG RECORD LENGTH,        #
                                   # END-OF-INFORMATION IF NEGATIVE    #
      ITEM MEMERR       B;         # TRUE IF MEMORY OVERFLOW           #
      ITEM MFPASAVE     I;         # OLD CMM OWNCODE EXIT ADDRESS      #
      ITEM PAD          I;         # PAD LENGTH (CHARS) IN JL RECORD   #
      ITEM RECLEN       I;         # REC LENGTH (CHARS) OF AFTER IMAGE #
      ITEM RFTPTR       I;         # POINTER TO START OF RFT CHAIN     #
  
#     LOCAL ARRAYS (GLOBAL TO ALL PROCS/FUNCS)                         #
  
      BASED ARRAY FET;             # FET FOR JOURNAL LOG I/O           #
*CALL FETDCLS 
  
      BASED ARRAY FIT;;            # DUMMY FIT FOR CRM I/O             #
*CALL JFQUEDCLS 
  
*CALL RFTDCLS 
  
*CALL SRERRDCLS 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   F I N D L R P          #
#                                                                      #
#**********************************************************************#
  
      FUNC FINDLRP B; 
      BEGIN 
 #
* *   DB$RFOR                                    PAGE  1
* *   FINDLRP - POSITION JL TO RECOVERY POINT 
* *   D E TRIGLIA/W P CEAGLIO                    DATE  02/09/81 
* 
* DC  PURPOSE 
* 
*     TO POSITION THE JOURNAL LOG FOR A SPECIFIED SCHEMA IMMEDIATELY
*     AFTER THE LAST RECOVERY POINT RECORD. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     P<FET> POINTS TO FET FOR JOURNAL LOG. 
*     P<JLREC> POINTS TO WSA FOR JOURNAL LOG RECORD.
*     LASTRP CONTAINS THE RECOVERY POINT (DECIMAL) TO BE MATCHED. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - THE JOURNAL LOG IS POSITIONED AT THE RECORD CONTAINING 
*                THE LAST RECOVERY POINT.  FUNCTION RESULT IS SET TO
*                *TRUE*.
* 
*     ABNORMAL - THE RECORD CONTAINING THE LAST RECOVERY POINT WAS NOT
*                FOUND.  FUNCTION RESULT IS SET TO *FALSE*. 
*                IF AN I/O ERROR OCCURRED ON THE JOURNAL LOG, JLIOERR IS
*                SET TO *TRUE* AND THE FUNCTION RESULT IS SET TO
*                *FALSE*. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RFOR      MAIN PROCEDURE 
* 
* DC  CALLED ROUTINES 
* 
*     DB$CBIN      CONVERT DISPLAY TO BINARY
*     DB$RDLG      READ RECORD FROM JOURNAL LOG 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     FET 
* 
* DC  DESCRIPTION 
* 
*     INITIALIZE THE FET BY SETTING THE FETCODE, FETFIRST, FETIN, 
*     FETOUT, AND FETLIMIT FIELDS.
* 
*     CONVERT THE LAST RECOVERY POINT LOCATION TO BINARY.  ALLOCATE A 
*     BUFFER FOR READING THE JOURNAL LOG FILE RECORD. 
*     IF THE LAST RECOVERY POINT NUMBER IS ZERO (NONE), SET UP THE FET
*     FOR THE FIRST RECORD AFTER THE JLF HEADER RECORD, SET THE FUNCTION
*     RESULT TO *TRUE*, AND RETURN TO THE CALLING ROUTINE.
* 
*     SET UP THE FET FOR THE RECORD CONTAINING THE LAST RECOVERY POINT. 
* 
*     READ THE JOURNAL LOG FILE RECORD CONTAINING THE LAST RECOVERY 
*     POINT.  IF AN I/O ERROR OCCURS ON READING THE JOURNAL LOG FILE, 
*     JLIOERR IS SET TO *TRUE*, THE FUNCTION RESULT IS SET TO *FALSE*,
*     AND CONTROL RETURNS TO THE CALLING ROUTINE. 
* 
*     IF THE RECORD TYPE IS RECOVERY POINT AND IF THE RECOVERY POINT
*     NUMBER MATCHES THE LAST RECOVERY POINT, THEN SET THE FUNCTION 
*     RESULT TO *TRUE*.  OTHERWISE, SET THE FUNCTION RESULT TO *FALSE*. 
* 
 #
  
  
#     LOCAL VARIABLES                                                  #
  
      ITEM LASTRP   C(10);         # LAST RECOVERY POINT FROM JL HEADER#
      ITEM LOGRL        I;         # JOURNAL LOG RECORD LENGTH         #
      ITEM LRPLOC       I;         # LOCATION OF LAST RECOVERY POINT   #
                                   # ON JOURNAL LOG                    #
  
  
# S T A R T   O F   F I N D L R P   E X E C U T A B L E   C O D E      #
  
  
#     INITIALIZE THE FET.                                              #
  
      FETCODE[0] = DFFIRSTC;
      FETFIRST[0] = LOC(FET) + DFFETLEN + DFJLHDREC;
      FETIN[0] = FETFIRST[0]; 
      FETOUT[0] = FETFIRST[0];
      FETLIMIT[0] = FETFIRST[0] + DFLOGBUF; 
  
#     POINT JLREC TO THE JLF HEADER RECORD.  SAVE THE LAST RECOVERY    #
#     POINT.  IF THERE IS NO LAST RECOVERY POINT NUMBER (ZEROS), SET   #
#     UP THE FET FOR THE FIRST RECORD AFTER THE JLF HEADER RECORD, SET #
#     THE FUNCTION RESULT TO *TRUE*, AND RETURN TO THE CALLING ROUTINE.#
  
      P<JLREC> = LOC(JFQFET[0]) + DFFETLEN; 
      LASTRP = JLFRLRPT[0]; 
      LRPLOC = DB$CBIN(JLFRLRPTL[0],10,10); 
      DB$MBA((SASCMAXLOG[SALX]+9)/10,P<JLREC>); 
      IF LASTRP EQ "0000000000" 
      THEN
        BEGIN 
        FETRR[0] = 2; 
        FETCWA[0] = 2 * DFPRUSIZ; 
        FINDLRP = TRUE; 
        RETURN; 
  
        END 
  
#     SET UP THE FET FOR THE RECORD CONTAINING THE LAST RECOVERY POINT.#
  
      FETRR[0] = LRPLOC;
      FETSA[0] = LRPLOC;
      FETSR[0] = 0; 
  
#     READ THE JOURNAL LOG FILE RECORD CONTAINING THE LAST RECOVERY    #
#     POINT.  IF AN I/O ERROR OCCURS ON READING THE JOURNAL LOG FILE,  #
#     JLIOERR IS SET TO *TRUE*, THE FUNCTION RESULT IS SET TO *FALSE*, #
#     AND CONTROL RETURNS TO THE CALLING ROUTINE.                      #
  
      LOGRL = DB$RDLG(LOC(FET),P<JLREC>); 
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        JLIOERR = TRUE; 
        FINDLRP = FALSE;
        RETURN; 
  
        END 
  
#     IF THE RECORD TYPE IS RECOVERY POINT AND IF THE RECOVERY POINT   #
#     NUMBER MATCHES THE LAST RECOVERY POINT, THEN SET THE FUNCTION    #
#     RESULT TO *TRUE*.  OTHERWISE, SET THE FUNCTION RESULT TO *FALSE*.#
  
      IF JLHDTYPE[0] EQ DFJLRQRP
        AND JLRPNUMB[0] EQ LASTRP 
      THEN
        BEGIN 
        FINDLRP = TRUE; 
        END 
      ELSE
        BEGIN 
        FINDLRP = FALSE;
        END 
  
      RETURN; 
  
      END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   F I N D R F T          #
#                                                                      #
#**********************************************************************#
  
      FUNC FINDRFT B; 
      BEGIN 
 #
* *   DB$RFOR                                    PAGE  1
* *   FINDRFT - LOCATE/CREATE RFT ENTRY 
* *   W P CEAGLIO                                DATE  01/16/81 
* 
* DC  PURPOSE 
* 
*     TO LOCATE/CREATE AN RFT ENTRY IN THE RFT CHAIN. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     ARID CONTAINS AREA IDENTIFIER.
*     ARVERS CONTAINS VERSION NAME. 
*     RFTPTR IS THE START OF RFT CHAIN. 
* 
* DC  EXIT CONDITIONS 
* 
*     AN EXISTING ENTRY IS FOUND OR A NEW ENTRY IS CREATED.  P<RFT> IS
*     SET.  IF AN AREA CANNOT BE ACTIVATED, THE RFT ENTRY IS MARKED 
*     INCOMPLETE BY SETTING THE OFT FIELD TO ZERO AND THE FUNCTION
*     RESULT IS SET TO *FALSE*.  OTHERWISE, IT IS SET TO *TRUE*.
* 
* DC  CALLING ROUTINES
* 
*     DB$RFOR - MAIN PROGRAM
* 
* DC  CALLED ROUTINES 
* 
*     DB$LNK     ALLOCATE AND LINK MM BLOCK 
*     DB$OCAR    ACTIVATE AREA (VERSION)
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<RFT> DIRECTLY.
*     P<OFT> AND P<UFT> INDIRECTLY (DB$OCAR). 
* 
* DC  DESCRIPTION 
* 
*     -  SET RFT POINTER TO THE START OF RFT CHAIN. 
* 
*     -  INITIALIZE FUNCTION RESULT TO *TRUE* AND RFT SEARCH RESULT TO
*        *FALSE*. 
* 
*     -  SEARCH THE RFT CHAIN FOR A MATCHING ENTRY FOR THE GIVEN AREA 
*        AND VERSION.  IF FOUND, SET RFT SEARCH RESULT TO *TRUE*--IF
*        AN INCOMPLETE RFT ENTRY, SET FUNCTION RESULT TO *FALSE*. 
* 
*     -  IF A MATCHING RFT ENTRY WAS NOT FOUND, CREATE A NEW ENTRY AND
*        COMPLETE THE AREA ID AND VERSION FIELDS.  IF THE AREA CANNOT 
*        BE ACTIVATED, MARK THE RFT ENTRY INCOMPLETE BY SETTING THE OFT 
*        FIELD TO ZERO.  OTHERWISE, COMPLETE THE REMAINING FIELDS WITH
*        PROPER VALUES. 
* 
*     -  SET FUNCTION RESULT. 
* 
 #
  
  
#     LOCAL VARIABLES                                                  #
  
      ITEM EXIST   B;        # RESULT OF SEARCH OF RFT CHAIN           #
      ITEM IX      I;        # SCRATCH - FOR LOOP                      #
      ITEM RFTOK   B;        # FALSE IF INCOMPLETE RFT ENTRY           #
  
  
  
# S T A R T   O F   F I N D R F T   E X E C U T A B L E   C O D E      #
  
  
#     IF PROCESSING A SINGLE AREA, AND THIS IS NOT IT, RETURN FALSE.   #
#     THE RECORD WILL NOT BE PROCESSED.                                #
  
      IF DB$TARN NQ 0 
        AND NOT (DB$TARN EQ ARID
             AND DB$TARV EQ ARVERS) 
      THEN
        BEGIN 
        FINDRFT = FALSE;
        RETURN; 
  
        END 
  
#     INITIALIZE FOR SEARCH.                                           #
  
      P<RFT> = LOC(RFTPTR); 
      EXIST = FALSE;
  
#     SEARCH RFT CHAIN FOR MATCHING ENTRY FOR SPECIFIED AREA ID AND    #
#     VERSION.  IF FOUND, SET SEARCH RESULT TO *TRUE*--IF AN INCOMPLETE#
#     ENTRY, SET FUNCTION RESULT TO *FALSE*.                           #
  
      FOR IX=IX 
        WHILE RFNEXT[0] NQ 0
        AND NOT EXIST 
      DO
        BEGIN 
        P<RFT> = RFNEXT[0]; 
        IF ARID EQ RFARID[0]       # CHECK FOR MATCH ON AREA ID/VERSION#
          AND ARVERS EQ RFVERS[0] 
        THEN
          BEGIN 
          EXIST = TRUE; 
          END 
        END 
  
#     IF NOT FOUND, CREATE NEW ENTRY AND COMPLETE AREA ID AND VERSION  #
#     FIELDS--IF THE AREA CANNOT BE ACTIVATED (DB$OCAR), MARK THE RFT  #
#     ENTRY INCOMPLETE BY SETTING THE OFT FIELD TO ZERO AND SET THE    #
#     FUNCTION RESULT TO *FALSE*.  OTHERWISE, COMPLETE THE REMAINING   #
#     RFT FIELDS WITH PROPER VALUES.                                   #
  
      IF NOT EXIST
      THEN
        BEGIN 
        P<RFT> = DB$LNK(LOC(RFTPTR),DFRFTSIZE); 
        RFARID[0] = ARID; 
        RFVERS[0] = ARVERS; 
        RFARBAD[0] = NOT DB$OCAR(ARID,ARVERS,ERRBLKA);
        RFOFT[0] = LOC(OFT);
        IF RFARBAD[0] 
        THEN
          BEGIN 
          RFUFT[0] = 0; 
          END 
        ELSE
          BEGIN 
          RFUFT[0] = LOC(UFT);
          END 
        END 
  
#     SET FUNCTION RESULT.                                             #
  
      FINDRFT = NOT RFARBAD[0]; 
  
      RETURN; 
  
      END 
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   M E M O V F L .        #
#                                                                      #
#**********************************************************************#
  
      PROC MEMOVFL; 
      BEGIN 
 #
* *   DB$RFOR                                    PAGE  1
* *   MEMOVFL - MEMORY OVERFLOW CODE
* *   P A MURRAY                                 DATE  05/07/81 
* 
* DC  PURPOSE 
* 
*     TO PROCESS A MEMORY OVERFLOW FOR DB$RFOR. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     A MEMORY OVERFLOW SITUATION HAS OCCURRED DURING DB$RFOR 
*     PROCESSING.  MEMOVFL IS CALLED VIA THE CMM OWNCODE EXIT.
* 
* DC  EXIT CONDITIONS 
* 
*     MEMERR IS SET TRUE TO INDICATE A MEMORY OVERFLOW SITUATION HAS
*     OCCURRED.  EXIT IS TO LABEL ENDRFOR IN THE DB$RFOR MAIN PROCEDURE.
* 
* DC  CALLING ROUTINES
* 
*     CALLED VIA THE CMM OVERFLOW OWNCODE EXIT. 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     MEMERR IS SET TO TRUE.
* 
* DC  DESCRIPTION 
* 
*     - SET MEMERR TO TRUE. 
* 
*     - GO TO ENDRFOR TO TERMINATE ROLL FORWARD PROCESSING. 
* 
 #
  
  
# S T A R T   O F   M E M O V F L   E X E C U T A B L E   C O D E      #
  
      MEMERR = TRUE;
  
      GOTO ENDRFOR;          # TERMINATE ROLL FORWARD PROCESSING       #
  
      END                    # END MEMOVFL                             #
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   R O L L F W D .        #
#                                                                      #
#**********************************************************************#
  
      PROC ROLLFWD; 
      BEGIN 
 #
* *   DB$RFOR                                    PAGE  1
* *   ROLLFWD - APPLY AFTER IMAGE 
* *   W P CEAGLIO                                DATE  01/16/81 
* 
* DC  PURPOSE 
* 
*     TO APPLY AN AFTER IMAGE FROM THE JOURNAL LOG TO AN AREA.
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     P<OFT> SET FOR AREA.
*     P<UFT> SET.  FIT IN UFT PRIMED WITH *WSA*, *KA*, *RL* OF THE
*       JOURNAL LOG RECORD TO BE APPLIED. 
*     SALX IS SET.
*     THE JOURNAL LOG RECORD IS READ INTO THE JOURNAL LOG WSA.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - RECORD RECOVERED TO STATE AFTER LAST RECOVERY POINT. 
* 
*     ABNORMAL - IF AN INVALID DIRECTIVE CODE ON LOG FILE, JLIOERR IS 
*                SET TO *TRUE*.  IF A CRM FATAL ERROR OCCURS, THE AREA
*                IS PLACED IN *ERRDOWN* STATUS, THE UFT IS RELEASED, AND
*                RFARBAD[0] IS SET TO *TRUE*. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RFOR - MAIN PROGRAM
* 
* DC  CALLED ROUTINES 
* 
*     DB$DRAR    DOWN AND RETURN AN AREA
*     DB$RA0     PARAMETER LIST TERMINATOR
*     DLTE       CRM DELETE PROCEDURE 
*     PUT        CRM PUT PROCEDURE
*     REPLC      CRM REPLACE PROCEDURE
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     OFSTATUS IN OFT ENTRY.
*     SASCHST IN SAL. 
* 
* DC  DESCRIPTION 
* 
*     -  PERFORM RECOVERY (ROLL FORWARD) OF RECORD IDENTIFIED BY THE
*        FIT PARAMETERS.  THE RECOVERY PROCEDURE IS DETERMINED BY THE 
*        DIRECTIVE CODE IN THE LOG RECORD HEADER.  THE CORRESPONDING
*        CRM OPERATION IS PERFORMED FOR THE CODES *PUT*, *REPLACE*, 
*        AND *DELETE*.  IF AN INVALID DIRECTIVE CODE IS DETECTED, 
*        JLIOERR IS SET TO *TRUE*.
* 
*     -  IF A FATAL I/O ERROR OCCURS, DB$DRAR IS CALLED TO PRINT AN 
*        ERROR MESSAGE AND TO SET THE AREA STATUS TO *ERRDOWN*. 
* 
 #
  
  
  
# S T A R T   O F   R O L L F W D   E X E C U T A B L E   C O D E      #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("RFOR-RF"); 
      CONTROL ENDIF;
  
  
#     PERFORM APPLICATION OF AFTER IMAGE ACCORDING TO DIRECTIVE CODE   #
#     IN LOG RECORD HEADER BY CALLING CORRESPONDING CRM UPDATE ROUTINE #
#     (DELETE, REPLACE, PUT).  IF AN INVALID DIRECTIVE CODE IS         #
#     DETECTED, SET JLIOERR TO *TRUE* AND RETURN TO THE CALLING        #
#     ROUTINE.                                                         #
  
      P<FIT> = LOC(UFFIT[0]); 
      IF JLHDDIRC[0] EQ DFJLDCD 
      THEN
        BEGIN 
        PUT(FIT,DB$RA0);
        END 
      ELSE
        BEGIN 
        IF JLHDDIRC[0] EQ DFJLDCE 
        THEN
          BEGIN 
          REPLC(FIT,DB$RA0);
          END 
        ELSE
          BEGIN 
          IF JLHDDIRC[0] EQ DFJLDCF 
          THEN
            BEGIN 
            DLTE(FIT,DB$RA0); 
            END 
          ELSE                     # INVALID DIRECTIVE CODE            #
            BEGIN 
            JLIOERR = TRUE; 
            RETURN; 
  
            END 
          END 
        END 
  
      IF UFFITES[0] NQ 0
      THEN
        BEGIN 
        IF UFFITES[0] EQ O"345" 
        THEN                       # 345 IS EQUIVALENT TO CM OVERFLOW  #
          BEGIN 
          UFFITES[0] = 0; 
          MEMOVFL;
          END 
  
        IF LOC(FPT) GR 0
        THEN
          BEGIN 
          FPFTEX[0] = DFFTEX1;
          END 
        DB$FTSM = TRUE;                # SUPPRESS MESSAGES FROM DB$FTEX#
        DB$FTEX;                       # CHECK FOR DOWN CONDITIONS     #
        END 
  
#     IF A FATAL I/O ERROR OCCURRED, CALL DB$DRAR TO PRINT AN ERROR    #
#     MESSAGE AND TO SET THE AREA STATUS TO *ERRDOWN*.                 #
  
      IF OFSTATUS[0] EQ S"ERRDOWN"     # IF THE AREA HAS BEEN DOWNED   #
      THEN
        BEGIN 
        SRENUMB[0] = DFSRENARB;    # DATABASE AREA ERROR               #
        SREFUNC[0] = DFSREFNCR;    # FUNCTION IS CRM                   #
        SREFPAR[0] = UFFITES[0];   # CRM ERROR CODE                    #
        SREARID[0] = ARID;         # AREA ID                           #
        SREVRNM[0] = ARVERS;       # VERSION NAME                      #
        DB$DRAR(ERRBLKA);          # PRINT ERROR MESSAGE AND SET       #
                                   # AREA STATUS TO *ERRDOWN*          #
        RFUFT[0] = 0;              # UFT HAS BEEN RELEASED             #
        RFARBAD[0] = TRUE;
        END 
  
      RETURN; 
  
      END 
  
#**********************************************************************#
#     E N D   O F   I N T E R N A L   P R O C E D U R E S              #
#**********************************************************************#
  
  
  
  
# S T A R T   O F   D B $ R F O R   E X E C U T A B L E   C O D E      #
  
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("RFOR");
      CONTROL ENDIF;
  
#**********************************************************************#
#                                                                      #
#     INITIALIZE ERROR STATUS WORD AND ALL FLAGS AND TABLE POINTERS.   #
#     RETURN IMMEDIATELY IF THE FILE IS IN DUMP STATUS (FULL).         #
#     IF ONLY ONE AREA IS BEING PROCESS, SAVE THE LOG RECORD BUFFER.   #
#                                                                      #
#**********************************************************************#
  
      P<SRERRBLK> = ERRBLKA;
      SREWORD[0] = 0; 
      SREWORD[1] = 0; 
      JLEOI = FALSE;
      JLIOERR = FALSE;
      RFTPTR = 0; 
      MEMERR = FALSE; 
      P<JFQUEUE> = SAJLFPTR[SALX];
      P<FET> = LOC(JFQFET[0]);
      P<JLREC> = LOC(JFQFET[0]) + DFFETLEN; 
  
      IF JLFRSTAT[0] EQ DFJLOGDMP 
      THEN
        BEGIN 
        DB$MFF(P<JFQUEUE>); 
        SAJLFPTR[SALX] = 0; 
        RETURN; 
  
        END 
      MFPASAVE = DB$MFPA;    # SAVE CURRENT CMM OVERFLOW OWNCODE ADDR  #
      DB$MFPA = LOC(MEMOVFL);      # SET CMM OVERFLOW OWNCODE EXIT     #
  
      IF DB$TARN NQ 0 
      THEN
        BEGIN 
        DB$FWAR = LOC(JFQUEUE); 
        DB$LWAR = FETLIMIT[0] -1; 
        IF DB$ROLO
        THEN
          BEGIN 
          DB$PUNT("DB$RFOR 2");        # ERROR ON THE ROLL FILE        #
                                       # ABORT CDCS                    #
          END 
        END 
  
#**********************************************************************#
#                                                                      #
#     POSITION THE JOURNAL LOG TO THE LAST RECOVERY POINT RECORD.  THIS#
#     ENTAILS THE FOLLOWING:                                           #
#                                                                      #
#       *  EXTRACT THE LAST RECOVERY POINT NUMBER FROM THE HEADER      #
#          (WHICH IS IN THE JL QUEUE).                                 #
#       *  SET UP THE FET AND WSA FOR THE READ OPERATION.              #
#                                                                      #
#     IF AN I/O ERROR OCCURRED ON READING THE JOURNAL LOG OR IF THE    #
#     LAST RECOVERY POINT RECORD WAS NOT FOUND, DIAGNOSE AN ERROR,     #
#     PUT THE SCHEMA IN *ERRDOWN* STATUS, AND RETURN TO THE CALLER.    #
#                                                                      #
#**********************************************************************#
  
  
      IF NOT FINDLRP                   # ERROR IF CANNOT FIND RP RECORD#
      THEN
        BEGIN 
        IF JLIOERR
        THEN
          BEGIN 
          SRENUMB[0] = DFSRENFUN; 
          SREFUNC[0] = DFSREFNIO; 
          SREFPAR[0] = FETNOSAT[0]; 
          SREFTYP[0] = DFSREFTJL; 
          END 
        ELSE
          BEGIN 
          SRENUMB[0] = DFSRENLRP; 
          END 
  
        SASCHST[SALX] = S"ERRDOWN"; 
        DB$MBF(P<JLREC>); 
  
        RETURN; 
  
        END 
  
#**********************************************************************#
#                                                                      #
#     THE LAST RECOVERY POINT RECORD WAS FOUND IN THE JOURNAL LOG.  NOW#
#     READ FROM JOURNAL LOG UNTIL EOI REACHED.  FOR EACH AFTER-IMAGE,  #
#     DO THE FOLLOWING:                                                #
#                                                                      #
#       *  EXTRACT THE AREA ID AND VERSION FROM THE RECORD.            #
#       *  ATTACH AND OPEN THE AREA/VERSION IF NOT ALREADY DONE.       #
#       *  PRIME FIT WITH *WSA*, *KA*, AND *RL* PARAMETERS OBTAINED    #
#          FROM THE LOG RECORD.                                        #
#       *  APPLY THE AFTER IMAGE TO THE AREA.  IF A CRM ERROR OTHER    #
#          THAN *445* OR *446* OCCURRED, DOWN THE AREA AND SET THE     #
#          FUNCTION TO *FALSE*.  OTHERWISE, SET THE FUNCTION *TRUE*.   #
#                                                                      #
#     AN I/O ERROR READING THE JOURNAL LOG WILL TERMINATE ROLL FORWARD #
#     PROCESSING.                                                      #
#                                                                      #
#**********************************************************************#
  
      FOR INDEX=INDEX 
        WHILE NOT JLEOI 
        AND NOT JLIOERR 
      DO
        BEGIN 
        CRMRC = 0;
        LOGRECL = DB$RDLG(LOC(FET),P<JLREC>); 
        IF FETNOSAT[0] NQ 0            # IF I/O ERROR ON JOURNAL LOG...#
        THEN
          BEGIN 
          JLIOERR = TRUE; 
          TEST; 
  
          END 
  
        IF LOGRECL GR 0 
        THEN
          BEGIN 
          IF JLHDTYPE[0] EQ DFJLRQAI   # CONSIDER ONLY AFTER IMAGES    #
          THEN
            BEGIN 
            ARID = DB$CBIN(JLHDARID[0],4,10); 
            ARVERS = JLHDVENM[0]; 
            IF FINDRFT                 # LOCATE/CREATE RFT ENTRY       #
            THEN
              BEGIN 
              P<OFT> = RFOFT[0];
              P<UFT> = RFUFT[0];
              KL = DB$CBIN(JLHDKEYL[0],3,10); 
              KLW = (KL + 9)/10;
              UFFITWSA = LOC(JLBARKEY[0]) + KLW;  # PRIME FIT          #
              UFFITKA[0] = LOC(JLBARKEY[0]);
              RECLEN = DB$CBIN(JLHDTRLS[0],6,10); 
              IF KL LS 0               # A NEGATIVE RETURN FROM DB$CBIN#
                OR RECLEN LS 0         # IMPLIES BAD LOG RECORD        #
              THEN
                BEGIN 
                JLIOERR = TRUE; 
                TEST; 
  
                END 
              PAD = JLHDPAD[0] - O"33"; 
              UFFITRL[0] = RECLEN - (10 * KLW) - PAD; 
              ROLLFWD;                 # APPLY AFTER IMAGE RECORD      #
              END 
  
            END 
          END 
        ELSE                           # EOR OR EOI DETECTED ON JLF    #
          BEGIN 
          IF LOGRECL EQ DFRDLGEOR      # IF EOR DETECTED               #
          THEN
            BEGIN 
            FETCODE[0] = DFFIRSTC;     # IGNORE EOR, READ NEXT LOG REC #
            END 
          ELSE
            BEGIN 
            JLEOI = TRUE;              # SET EOI FLAG                  #
            END 
          END 
        END 
  
ENDRFOR:                               # TERMINATE ROLL FORWARD        #
  
#**********************************************************************#
#                                                                      #
#     ROLL FORWARD PROCESSING COMPLETED OR ABORTED.  DO THE FOLLOWING  #
#     FOR EACH RFT ENTRY:                                              #
#                                                                      #
#       *  CLOSE AREA (IF IT IS OPEN) AND DELINK UFT ENTRY.            #
#       *  DELINK THE RFT ENTRY.                                       #
#                                                                      #
#     IF AN I/O ERROR OCCURRED ON THE JOURNAL LOG, RETURN AN ERROR TO  #
#     THE CALLER AND PLACE THE SCHEMA IN *ERRDOWN* STATUS.             #
#     OTHERWISE, IF A DATABASE (AREA) ERROR OCCURRED, RETURN AN ERROR  #
#     TO THE CALLER.                                                   #
#     RELEASE THE TEMPORARY BUFFER FOR THE JOURNAL LOG RECORD.         #
#                                                                      #
#**********************************************************************#
  
      P<RFT> = RFTPTR;
      FOR INDEX=INDEX 
        WHILE P<RFT> NQ 0 
      DO
        BEGIN 
        P<UFT> = RFUFT[0];
        IF P<UFT> NQ 0
        THEN
          BEGIN 
          IF UFFITOC[0] EQ DFFITOCOPEN  # CLOSE FILE IF IT IS OPEN     #
          THEN
            BEGIN 
            P<FIT> = LOC(UFFIT[0]); 
            UFFITFNF[0] = FALSE;
            CLOSEM(FIT,DFFITCFDET,DB$RA0);
            END 
          IF UFNEXT[0] EQ LOC(UFT)
          THEN
            BEGIN 
            UFWORD[0] = DFNPTR; 
            END 
          END 
  
        P<UFT> = DFNPTR;
        DB$LNKD(P<RFT>);
        END 
  
      IF JLIOERR                       # IF JOURNAL LOG I/O ERROR...   #
      THEN
        BEGIN 
        SRENUMB[0] = DFSRENFUN; 
        SREFUNC[0] = DFSREFNIO; 
        SREFPAR[0] = FETNOSAT[0]; 
        SREFTYP[0] = DFSREFTJL; 
        SASCHST[SALX] = S"ERRDOWN"; 
        END 
  
#     RESET DB$MFPA TO PREVIOUS CMM OVERFLOW OWNCODE EXIT ADDRESS.     #
  
      DB$MFPA = MFPASAVE; 
  
#     CHECK IF MEMORY OVERFLOW OCCURRED.                               #
  
      IF MEMERR 
      THEN
        BEGIN 
        SASCHST[SALX] = S"ERRDOWN"; 
        SRENUMB[0] = DFSRENMEM; 
        SREFUNC[0] = DFSREFNRF;        # FUNCTION IS ROLL FORWARD      #
        END 
  
  
#     IF PROCESSING ALL AREAS, RETURN THE LOG RECORD BUFFER            #
#     ELSE, ROLL ITS CONTENTS BACK IN TO CONTINUE PROCESSING           #
  
      IF DB$TARN EQ 0 
      THEN
        BEGIN 
        DB$MBF(P<JLREC>);              # RETURN LOG RECORD BUFFER      #
        END 
      ELSE
        BEGIN 
        IF DB$ROLI
        THEN
          BEGIN 
          DB$PUNT("DB$RFOR 2");        # ERROR ON THE ROLL FILE        #
                                       # ABORT CDCS                    #
          END 
        END 
  
      END 
      TERM
