*DECK DB$UNDO 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      PROC DB$UNDO((ARTX),(ERRBLKA)); 
      BEGIN 
 #
* *   DB$UNDO - BACKOUT TRANSACTION              PAGE  1
* *   W P CEAGLIO / P L KENNY                    DATE  03/30/81 
* 
* DC  PURPOSE 
* 
*     BACKOUT ALL UPDATES FOR A TRANSACTION UNIT. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM ARTX    I;        # INPUT - ORDINAL OF ART ENTRY            #
      ITEM ERRBLKA I;        # INPUT - ADDRESS OF ERROR BLOCK          #
# 
* D   ASSUMPTIONS 
* 
*     SALX SET FOR SCHEMA INVOLVED. 
* 
*     SAL 
*       SAARTPTR IS NON-ZERO AND POINTS TO ART IN CORE. 
* 
*     SYSRECOVERY IS TRUE IF IN SYSTEM RECOVERY MODE. 
* 
*     IF NOT IN SYSTEM RECOVERY MODE
*       UNDOBUF POINTS TO THE TRF LOG RECORD WSA AND
*       ALL OF THE AREAS REQUIRING UPDATES ARE OPEN FOR I-O.
*       P<CSFIXED> IS SET.
* 
*     THE TRF FET/I-O BUFFER ASSOCIATED WITH ARTX HAS BEEN ALLOCATED
*     AND FET FIRST AND LIMIT FIELDS HAVE BEEN INITIALIZED. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - ALL UPDATES HAVE BEEN BACKED OUT THROUGH APPLICATION 
*                OF THE BEFORE IMAGES.
*                THE ART ENTRY CORRESPONDING TO ARTX HAS BEEN CLEARED.
*                TQARTX[0] HAS BEEN SET TO ZERO.
* 
*     ABNORMAL - ROLLBACK IS NOT PERFORMED OR IS INCOMPLETE.
* 
*                IF AN ERROR OCCURRED ON THE TRANSACTION RECOVERY 
*                FILE OR IF THERE IS INSUFFICIENT MEMORY FOR ROLLBACK 
*                PROCESSING, THE SCHEMA STATUS IS SET TO *ERRDOWN*, AND 
*                APPROPRIATE FIELDS OF THE ERROR BLOCK HAVE BEEN SET. 
*                THE ART ENTRY AND ASSOCIATED TRF SEGMENT ARE NOT 
*                RELEASED.
*                NOTE - IN SYSTEM RECOVERY MODE, DB$AREH WILL BE CALLED 
*                BY THE CALLER OF DB$UNDO FOR SCHEMA LEVEL ERRORS.
* 
*                IF A REQUIRED AREA IS UNUSABLE, THE AREA IS DOWNED AND 
*                ALL RUN UNITS WHICH HAVE THE AREA OPEN ARE TERMINATED. 
*                IN BOTH SYSTEM RECOVERY AND NON-RECOVERY MODES, DB$AREH
*                HAS BEEN CALLED (VIA DB$DRAR) TO PRINT AN ERROR MESSAGE
*                TO THE CDCS OUTPUT FILE AND DAYFILE, AND THE ERROR BLOCK 
*                HAS BEEN ZEROED OUT.  IF NOT IN SYSTEM RECOVERY, AN
*                ERROR STATUS IS RETURNED TO DB$UNDU. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RUTR      SYSTEM RECOVERY ROLL BACK PROCESSOR
*     DB$UNDU      DB$UNDO INTERFACE
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC CLOSEM;      # CRM I/O INTERFACE                       #
      XREF PROC CMMSDA;      # RESPECIFY THE CMM DYNAMIC AREA          #
      XREF FUNC DB$CBIN;     # CONVERT DISPLAY CODE NUMBER TO BINARY   #
      XREF PROC DB$DRAR;     # DOWN AND RETURN AREA                    #
      XREF PROC DB$FLOP;     # GENERATE A FLOW POINT                   #
      XREF PROC DB$FSIO;     # SELECT AND SET A FIT                    #
      XREF PROC DB$FTEX;     # CRM ERROR ROUTINE                       #
      XREF FUNC DB$LNK;      # LINK (LIFO) MM BLOCK                    #
      XREF PROC DB$LNKD;     # DELINK MM BLOCK                         #
      XREF PROC DB$MFA;      # ALLOCATE CMM BLOCK                      #
      XREF PROC DB$MFF;      # RELEASE CMM BLOCK                       #
      XREF FUNC DB$OCAR B;   # ACTIVATE AREA (VERSION)                 #
      XREF PROC DB$PUNT;     # ABORT CDCS BECAUSE OF AN INTERNAL ERROR #
      XREF FUNC DB$RDLG I;   # READ RECORD FROM TRF SEGMENT            #
      XREF PROC DB$TARE;     # TERMINATE USERS OF A GIVEN AREA         #
      XREF PROC DLTE;        # CRM I/O INTERFACE                       #
      XREF PROC PUT;         # CRM I/O INTERFACE                       #
      XREF PROC REPLC;       # CRM I/O INTERFACE                       #
# 
* DC  EXTERNAL LABELS REFERENCED
# 
      XREF LABEL DB$RBER;    # CONTINUATION ADDRESS FOR TERMINATING    #
                             # USERS OF A GIVEN AREA                   #
      XREF ITEM  UNDOBUF I;  # POINTER TO LOG RECORD WSA               #
# 
* DC  INTERNAL PROCS/FUNCS
* 
*     BACKOUT      RESTORE DATA BASE RECORD 
*     FINDKEY      LOCATE/ADD PRIMARY KEY TO CHAIN
*     FINDRFT      LOCATE/CREATE RESTORED FILE TABLE (RFT) ENTRY
*     MEMOVFL      PROCESS MEMORY OVERFLOW
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     ART ENTRY CORRESPONDING TO ARTX PARAMETER 
* 
*     AUTOMATIC RECOVERY ERROR BLOCK
# 
      XREF ITEM CRMRC   I;   # CRM RECALL COUNT                        #
      XREF ITEM DB$MFPA I;   # CMM OVERFLOW OWNCODE EXIT ADDRESS       #
# 
*     P<OFT> (CDCSCOMMN)
*     OFT 
*       STATUS FIELD
* 
*     SAL 
*       STATUS FIELD
*       TRF FET POINTER 
* 
*     TQT 
*       TQT ART INDEX FIELD 
* 
*     P<UFT> (CDCSCOMMN)
* 
* DC  DESCRIPTION 
* 
*     THE STRATEGY FOR ROLLBACK OF A TRANSACTION IS BASED ON A SINGLE 
*     PASS OF THE RECORDS CONTAINED IN THE APPLICABLE SEGMENT WITHIN
*     THE TRF.  SINCE UPDATES TO MORE THAN ONE AREA MAY BE INVOLVED,
*     ANY REQUIRED ATTACHING AND ACTIVATION OF AN AREA (AND ITS INDEX)
*     IS PERFORMED AS REQUIRED.  TWO INFORMATION STRUCTURES ARE INVOLVED
*     - THE RESTORED FILE TABLE (RFT) AND THE PRIMARY KEY LIST (KEYLIST)
*     ASSOCIATED WITH AN RFT ENTRY.  THE RFT CONSISTS OF AN ENTRY FOR 
*     EACH UNIQUE AREA ID ENCOUNTERED IN THE SCAN OF THE TRF SEGMENT. 
*     THE KEYLIST IS BUILT UP EACH TIME A BEFORE-IMAGE IS APPLIED --- IT
*     IS USED TO BYPASS ALL BUT THE FIRST BEFORE-IMAGE FOR A GIVEN
*     PRIMARY KEY.
* 
*     THE ART INDEX SUPPLIED IN THE CALL IS USED TO POINT TO THE START
*     OF THE SEGMENT TO PROCESS IN THE TRF.  A SEQUENTIAL READ OF THE 
*     RECORDS IN THE SEGMENT IS PERFORMED UNTIL THE END OF THE SEGMENT
*     IS REACHED.  ONLY THE BEFORE-IMAGE RECORDS ARE OF INTEREST.  FOR
*     EACH SUCH RECORD, THE FOLLOWING IS DONE --- 
* 
*        -  EXTRACT THE AREA IDENTIFIER AND VERSION NAME FROM THE LOG 
*           RECORD (PLACED IN CELLS *ARID* AND *ARVERS*, RESPECTIVELY). 
*           NOTE - ONLY ONE VERSION IS ALLOWED IN THE SEGMENT.
* 
*        -  CHECK FOR AN ENTRY FOR THE AREA IN THE RFT. 
*           IF NONE, CREATE A NEW ENTRY AND COMPLETE REQUIRED FIELDS. 
*           ACTIVATE THE FILE IDENTIFIED BY THE AREA IDENTIFIER AND THE 
*           VERSION NAME.  THIS MAY ENTAIL CREATION OF AN OFT AND ATTACH
*           OF DATA AND INDEX FILES (SYSTEM RECOVERY MODE ONLY).  IN ANY
*           CASE, A UFT IS ALLOCATED FOR CDCS USE IN THE BACKOUT
*           PROCESS.
* 
*        -  CHECK IF THE GIVEN PRIMARY KEY HAS ALREADY BEEN PROCESSED.
*           IF NOT, ADD IT TO THE KEY LIST FOR THE RFT ENTRY AND THEN 
*           PERFORM BACKOUT OF THE GIVEN RECORD.
* 
*     AT THE END OF THE SEGMENT, DO THE FOLLOWING FOR EACH RFT ENTRY -- 
* 
*        *  CLOSE THE AREA (IF IT IS OPEN), AND DELINK THE UFT AND THE
*           KEYLIST FOR THE AREA. 
* 
*        *  IF THE RFT ENTRY HAS THE *BAD* FLAG SET, ISSUE A DAYFILE
*           MESSAGE INDICATING THE AREA IS BAD, AND CALL DB$TARE TO 
*           TERMINATE ALL USERS OF THE AREA.
* 
*        *  DELINK THE RFT ENTRY. 
* 
*     RELEASE THE TEMPORARY BUFFER FOR THE LOG RECORD.
* 
*     CLEAR THE ART ENTRY.
* 
*     RESET THE CMM OVERFLOW OWNCODE EXIT ADDRESS.
* 
*     IF AN ERROR OCCURRED ON READING THE TRF OR INSUFFICIENT MEMORY
*     WAS AVAILABLE FOR TRANSACTION ROLLBACK, PLACE THE SCHEMA IN 
*     *ERRDOWN* STATUS.  RETURN WITHOUT CLEARING THE ART ENTRY. 
* 
 #
  
  
#     NON-LOCAL VARIABLES REFERENCED                                   #
  
      XREF ITEM DB$FTSM B;   # SUPPRESS MESSAGES FROM DB$FTEX          #
      XREF ITEM DB$HHAE I;   # CMM HIGHEST HIGH ADDRESS                #
      XREF ITEM DB$NOS B;    # TRUE IF EXECUTING ON NOS                #
      XREF ARRAY DB$RA0;;    # PARAMETER LIST TERMINATOR               #
  
#     LOCAL ITEMS (GLOBAL TO ALL PROCS/FUNCS)                          #
  
      ITEM AREAERR     B;    # TRUE IF SOME AREA IS UNUSABLE           #
      ITEM AREAOFFSET   I;   # OFFSET TO AREA CONTROL BLOCK IN RSB     #
      ITEM ARID         I;   # AREA IDENTIFIER                         #
      ITEM ARVERS   C(07);   # AREA VERSION NAME                       #
      ITEM INDEX        I;   # SCRATCH - FOR LOOPS                     #
      ITEM KL           I;   # PRIMARY KEY LENGTH IN CHARACTERS        #
      ITEM KLW          I;   # PRIMARY KEY LENGTH IN WORDS             #
      ITEM LOGRECL      I;   # TRF LOG RECORD LENGTH                   #
      ITEM MAXLOGSZ     I;   # MAXIMUM LOG RECORD LENGTH IN WORDS      #
      ITEM MEMERR       B;   # TRUE IF MEMORY OVERFLOW                 #
      ITEM MFPASAVE     I;   # OLD CMM OWNCODE EXIT ADDRESS            #
      ITEM OLDVERS   C(7);   # FIRST VERSION NAME ON TRF               #
      ITEM PAD          I;   # PAD IN JOURNAL LOG RECORD               #
      ITEM RECLEN       I;   # RECORD LENGTH OF BEFORE IMAGE (CHARS)   #
      ITEM RFTPTR       I;   # POINTER TO START OF RFT CHAIN           #
      ITEM SAVEJLR      I;   # SAVE THE POINTER JLREC                  #
      ITEM SAVESR       B;   # SAVE SYSRECOVERY STATUS                 #
      ITEM TREOI        B;   # TRUE IF THE END OF TRF SEGMENT REACHED  #
      ITEM TRIOERR      B;   # TRUE IF I/O ERROR READING TRF           #
  
      LABEL ENDUNDO;         # TERMINATE ROLLBACK PROCESSING           #
  
#     LOCAL ARRAYS (GLOBAL TO ALL PROCS/FUNCS)                         #
  
*CALL ARTDCLS 
  
      BASED ARRAY FET;       # FOR TRF I/O                             #
*CALL FETDCLS 
  
      BASED ARRAY FIT;;      # DUMMY FOR CRM I/O                       #
  
      BASED ARRAY RECKEY;;   # DUMMY BASED ARRAY FOR PRIMARY KEY       #
  
*CALL RFTDCLS 
  
*CALL SRERRDCLS 
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   B A C K O U T .        #
#                                                                      #
#**********************************************************************#
  
      PROC BACKOUT; 
      BEGIN 
 #
* *   DB$UNDO                                    PAGE  1
* *   BACKOUT - RESTORE DATA BASE RECORD
* *   W P CEAGLIO                                DATE  03/30/81 
* 
* DC  PURPOSE 
* 
*     RESTORE A SPECIFIED RECORD TO A PRIOR STATE.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     P<OFT> SET FOR AREA.
*     P<UFT> SET FOR AREA.  FIT IN UFT HAS *WSA*, *KA*, *RL* FIELDS 
*     COMPLETED.
*     P<JLREC> SET FOR LOG RECORD CONTAINING RECORD IMAGE TO BE BACKED
*     OUT.
*     P<RFT> SET FOR AREA.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL  - RECORD RESTORED TO STATE AT START OF TRANSACTION. 
* 
*     ABNORMAL- IF I/O ERROR ON AREA, AREA SET TO *ERRDOWN* STATUS AND
*               THE RFT AREA-BAD FLAG IS SET TO *TRUE*. 
*               IF BAD DATA ON TRF, TRIOERR SET TO *TRUE*.
* 
* DC  CALLING ROUTINES
* 
*     DB$UNDO - MAIN PROCEDURE
* 
* DC  CALLED ROUTINES 
* 
*     DB$RA0     PARAMETER LIST TERMINATOR
*     DLTE       CRM I/O INTERFACE (DELETE) 
*     PUT        CRM I/O INTERFACE (PUT)
*     REPLC      CRM I/O INTERFACE (REPLACE)
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     OFT (STATUS FIELD)
*     RFT (AREA BAD FLAG) 
* 
* DC  DESCRIPTION 
* 
*     -  IF AREA NOT IN *UP* STATUS, SKIP BACKOUT AND RETURN. 
* 
*     -  PERFORM BACKOUT OF RECORD IDENTIFIED BY THE FIT PARAMETERS.
*        THE BACKOUT PROCEDURE IS DETERMINED BY THE DIRECTIVE CODE IN 
*        THE LOG RECORD HEADER.  IF THE CODE IS FOR A DELETE, THEN A
*        CRM PUT IS DONE.  IF THE CODE IS FOR A WRITE, A CRM DELETE IS
*        PERFORMED.  IF THE CODE IS FOR REWRITE, A CRM REPLACE IS DONE. 
*        IF THE CODE IS FOR NONE OF THESE DIRECTIVES, THERE IS AN ERROR 
*        ON THE TRANSACTION RECOVERY FILE, SO TRIOERR IS SET *TRUE*.
* 
*     -  IF AN I/O ERROR (EXCLUDING 445 AND 446) OCCURRED ON THE AREA,
*        SET THE AREA TO *ERRDOWN* STATUS AND SET THE RFT AREA-BAD FLAG 
*        TO *TRUE*. 
* 
 #
  
  
  
# S T A R T   O F   B A C K O U T   E X E C U T A B L E  C O D E       #
  
  
#**********************************************************************#
#                                                                      #
#     PERFORM BACKOUT OF RECORD.  THE PROCEDURE FOR APPLYING THE UPDATE#
#     IS AS FOLLOWS--                                                  #
#                                                                      #
#         LOG RECORD TYPE              CRM FUNCTION TO APPLY           #
#         ---------------              ---------------------           #
#                                                                      #
#         WRITE                        DELETE                          #
#         DELETE                       PUT                             #
#         REWRITE                      REPLACE                         #
#                                                                      #
#**********************************************************************#
  
      P<FIT> = LOC(UFFIT[0]); 
      IF JLHDDIRC[0] EQ DFJLDCD      # IF "WRITE" LOG RECORD           #
      THEN
        BEGIN 
        DLTE(FIT,DB$RA0); 
        P<UFT> = RFUFT[0];           # A CRM CALL TO DB$QRF MAY HAVE   #
                                     # CAUSED SCHEDULER TO SET P<UFT>  #
                                     # INCORRECTLY                     #
        IF UFFITES[0] EQ O"445"      # IF KEY NOT FOUND                #
        THEN
          BEGIN 
          UFFITES[0] = 0;            # IGNORE KEY NOT FOUND ERROR      #
          END 
        END 
      ELSE
        BEGIN 
        IF JLHDDIRC[0] EQ DFJLDCF    # IF "DELETE" LOG RECORD          #
        THEN
          BEGIN 
          PUT(FIT,DB$RA0);
          P<UFT> = RFUFT[0];
          IF UFFITES[0] EQ O"446"    # IF "DELETE" LOG RECORD          #
          THEN
            BEGIN 
            UFFITES[0] = 0; 
            REPLC(FIT,DB$RA0);
            P<UFT> = RFUFT[0];
            END 
          END 
        ELSE
          BEGIN 
          IF JLHDDIRC[0] EQ DFJLDCE  # IF "REWRITE" LOG RECORD         #
          THEN
            BEGIN 
            REPLC(FIT,DB$RA0);
            P<UFT> = RFUFT[0];
            IF UFFITES[0] EQ O"445"  # IF KEY NOT FOUND                #
            THEN
              BEGIN 
              UFFITES[0] = 0; 
              PUT(FIT,DB$RA0);
              P<UFT> = RFUFT[0];
              END 
            END 
          ELSE
            BEGIN 
            TRIOERR = TRUE;  # BAD RECORD TYPE ON TRF                  #
            SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF             #
            SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF                #
            RETURN; 
  
            END 
          END 
  
        IF UFFITES[0] NQ 0
        THEN
          BEGIN 
          IF LOC(FPT) GR 0
          THEN
            BEGIN 
            FPFTEX[0] = DFFTEX1;       # DECLARE A NORMAL DB$FTEX CALL #
            END 
          SAVESR = SYSRECOVERY; 
          SYSRECOVERY = TRUE;          # SO DB$FTEX DOESNT RESET P<OFT>#
          DB$FTSM = TRUE;              # SUPPRESS MESSAGES FROM DB$FTEX#
          DB$FTEX;                     # CHECK FOR DOWN CONDITIONS     #
          SYSRECOVERY = SAVESR; 
          END 
        END 
  
#     IF AN I/O ERROR OCCURRED, FILL IN THE APPROPRIATE FIELDS IN THE  #
#     ERROR BLOCK, AND CALL DB$DRAR TO PRINT THE ERROR MESSAGE AND TO  #
#     SET THE AREA STATUS TO *ERRDOWN*.                                #
  
      IF UFFITFNF[0]
        OR OFSTATUS[0] EQ S"ERRDOWN"   # OR AREA HAS BEEN DOWNED       #
      THEN
        BEGIN 
        SRENUMB[0] = DFSRENARB;  # DATABASE AREA ERROR                 #
        SREFUNC[0] = DFSREFNCR;  # CRM FUNCTION                        #
        SREFPAR = 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] = DFNPTR;       # THE UFT HAS BEEN RELEASED           #
        RFARBAD[0]= TRUE; 
        END 
  
      RETURN; 
  
      END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   F I N D K E Y .        #
#                                                                      #
#**********************************************************************#
  
      FUNC FINDKEY(PKEY,(KEYLEN)) B;
      BEGIN 
 #
* *   DB$UNDO                                    PAGE  1
* *   FINDKEY - LOCATE/CREATE KEY IN AREA KEY LIST
* *   W P CEAGLIO                                DATE  03/30/81 
* 
* DC  PURPOSE 
* 
*     LOCATE/ADD PRIMARY KEY IN KEYLIST FOR AN RFT ENTRY. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ARRAY PKEY;            # PRIMARY KEY VALUE                       #
        BEGIN 
        ITEM PKVAL   C(00,00,240);
        END 
      ITEM KEYLEN       I;   # LENGTH (CHARACTERS) OF PRIMARY KEY VALUE#
# 
* D   ASSUMPTIONS 
* 
*     P<RFT> IS SET FOR AREA TO BE PROCESSED. 
* 
* DC  EXIT CONDITIONS 
* 
*     FUNCTION SET *TRUE* IF KEY IN LIST--OTHERWISE, IT IS SET *FALSE*
*     AND KEY ADDED TO LIST.
* 
* DC  CALLING ROUTINES
* 
*     DB$UNDO - MAIN PROCEDURE
* 
* DC  CALLED ROUTINES 
* 
*     DB$LNK                 LINK (LIFO) MANAGED MEMORY BLOCK 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     THE SEARCH RESULT IS ASSUMED *FALSE*.  THE KEYLIST IS SET FROM THE
*     CURRENT RFT ENTRY.  THE CHAIN IS SEARCHED FOR A MATCHING VALUE
*     WITH THE GIVEN PRIMARY KEY.  IF THERE IS A MATCH, THE SEARCH
*     RESULT IS SET TO *TRUE*--OTHERWISE, THE KEY IS ADDED TO THE CHAIN.
*     THE FUNCTION IS SET TO THE VALUE OF THE SEARCH RESULT.
* 
 #
  
#     LOCAL VARIABLES                                                  #
  
      ITEM INDX         I;   # SCRATCH - FOR LOOP                      #
      ITEM KEYFND       B;   # OUTPUT - RESULT OF SEARCH               #
  
  
  
  
# S T A R T   O F   F I N D K E Y   E X E C U T A B L E   C O D E      #
  
  
#     INITIALIZE SEARCH TO START OF KEY LIST.  ASSUME SEARCH RESULT IS #
#     *FALSE*.                                                         #
  
      P<KEYLIST> = LOC(RFKEYLP[0]); 
      KEYFND = FALSE; 
  
#     SEARCH KEYLIST CHAIN FOR MATCHING KEY VALUE.  IF FOUND, SET      #
#     SEARCH RESULT TO *TRUE*.                                         #
  
      FOR INDX=INDX 
        WHILE KEYNEXT[0] NQ 0 
        AND NOT KEYFND
      DO
        BEGIN 
        P<KEYLIST> = KEYNEXT[0];
        IF KEYLEN EQ KEYLENTH[0]
          AND C<0,KEYLEN>PKVAL[0] EQ C<0,KEYLEN>KEYVALUE[0] 
        THEN
          BEGIN 
          KEYFND = TRUE;
          END 
        END 
  
#     IF KEY NOT FOUND, ADD IT TO THE LIST.                            #
  
      IF NOT KEYFND 
      THEN
        BEGIN 
        P<KEYLIST> = DB$LNK(LOC(RFKEYLP[0]),(KEYLEN+9)/10+1); 
        C<0,KEYLEN>KEYVALUE[0] = C<0,KEYLEN>PKVAL[0]; 
        KEYLENTH[0] = KEYLEN; 
        END 
  
#     SET FUNCTION TO VALUE OF SEARCH RESULT.                          #
  
      FINDKEY = KEYFND; 
  
      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$UNDO                                    PAGE  1
* *   FINDRFT - LOCATE/CREATE RFT ENTRY 
* *   W P CEAGLIO / P L KENNY                    DATE  03/30/81 
* 
* DC  PURPOSE 
* 
*     LOCATE/CREATE AN RFT ENTRY IN THE RFT CHAIN.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     ARID CONTAINS AREA IDENTIFIER.
*     ARVERS CONTAINS VERSION NAME. 
*     RFTPTR IS THE START OF RFT CHAIN. 
*     IF NOT IN SYSTEM RECOVERY - 
*         THE FILE IS ALREADY OPEN AND THE RSB POINTER IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     AN EXISTING ENTRY IS FOUND OR A NEW ENTRY IS CREATED.  P<RFT> IS
*     SET TO THE CURRENT ENTRY. 
*     IF IN SYSTEM RECOVERY MODE AND AN AREA CANNOT BE ACTIVATED, THE 
*     BAD-AREA FLAG IN THE RFT ENTRY IS SET TO *TRUE*, THE UFT POINTER
*     IN THE RFT ENTRY IS SET TO DFNPTR, AND THE FUNCTION RESULT IS SET 
*     TO *FALSE*.  (THE AREA WILL BE DOWNED BY DB$OCAR.)
* 
* DC  CALLING ROUTINES
* 
*     DB$UNDO - MAIN PROCEDURE
* 
* 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 START OF RFT CHAIN. 
* 
*     -  INITIALIZE RFT SEARCH RESULT TO *FALSE*. 
* 
*     -  SEARCH THE RFT CHAIN FOR A MATCHING ENTRY FOR THE GIVEN AREA.
* 
*     -  IF A MATCHING RFT ENTRY WAS NOT FOUND, CREATE A NEW ENTRY AND
*        COMPLETE THE AREA ID FIELD.  IF THE AREA CANNOT BE ACTIVATED,
*        SET THE BAD-AREA FLAG TO *TRUE*.  COMPLETE THE REMAINING 
*        FIELDS.
* 
*     -  SET FUNCTION RESULT TO THE OPPOSITE VALUE OF THE RFT BAD-AREA
*        FLAG.
* 
 #
  
  
#     LOCAL VARIABLES                                                  #
  
      ITEM EXIST   B;        # RESULT OF SEARCH OF RFT CHAIN           #
      ITEM IX      I;        # SCRATCH - FOR LOOP                      #
  
  
  
  
# 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      #
  
#     INITIALIZE FOR SEARCH                                            #
  
      P<RFT> = LOC(RFTPTR); 
      EXIST = FALSE;
  
#     SEARCH RFT CHAIN FOR MATCHING ENTRY FOR SPECIFIED AREA ID.       #
#     IF FOUND, SET SEARCH RESULT TO *TRUE*.                           #
  
      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        #
        THEN
          BEGIN 
          EXIST = TRUE; 
          END 
        END 
  
#     IF NOT FOUND, CREATE NEW ENTRY AND COMPLETE AREA ID FIELD.       #
#     IF THE AREA CANNOT BE ACTIVATED (DB$OCAR), SET THE BAD           #
#     FLAG IN THE RFT ENTRY TO *TRUE*.  COMPLETE THE REMAINING RFT     #
#     FIELDS.                                                          #
  
      IF NOT EXIST
      THEN
        BEGIN 
        P<RFT> = DB$LNK(LOC(RFTPTR),DFRFTSIZE); 
        RFARID[0] = ARID; 
        RFEX[0] = 0;
        IF SYSRECOVERY
        THEN
          BEGIN 
          RFARBAD[0] = NOT DB$OCAR(ARID,ARVERS,ERRBLKA);
          END 
        ELSE
#             IF NOT IN SYSTEM RECOVERY, GET THE OFT AND UFT POINTERS  #
#             FROM THE RSB.                                            #
          BEGIN 
          RFARBAD[0] = FALSE; 
  
          FOR AREAOFFSET =
            DFRSBFIX + (CSFARENO[0] - CSFEXTNO[0] -1) * DFARECON
            STEP -DFARECON  UNTIL DFRSBFIX
          DO
            BEGIN 
            P<RSARBLK> = LOC(RSB) + AREAOFFSET; 
            IF ARID EQ RSARID[0]
            THEN
              BEGIN                # FOUND THE STATUS BLOCK FOR THE ID #
              AREAOFFSET = DFRSBFIX; #  TERMINATE THE SCAN             #
              END 
            END 
          P<OFT> = RSAROFIT[0]; 
          RCOFTLOC[0] = LOC(OFT); 
          P<FKL> = RSFFKLLOC[0];
          IF RSARFPT[0] NQ 0
          THEN
            BEGIN 
            P<FPT> = LOC(FKL) + RSARFPT[0]; 
            END 
          DB$FSIO;                 # SELECT AND SET A UFT              #
          IF P<OFT> EQ 0
            OR RSARFPT[0] EQ 0
            OR ARID NQ RSARID[0]
          THEN
            BEGIN 
            DB$PUNT("DB$UNDO"); 
            END 
          RFEX[0] = UFFITEX[0]; 
          END 
        RFKEYLP[0] = 0; 
        RFOFT[0] = LOC(OFT);
        IF RFARBAD[0] 
        THEN
          BEGIN 
          RFUFT[0] = DFNPTR;
          END 
        ELSE
          BEGIN 
          RFUFT[0] = LOC(UFT);
          UFFITEX[0] = 0; 
          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$UNDO                                    PAGE  1
* *   MEMOVFL - MEM OVERFLOW CODE 
* *   P L KENNY                                  DATE  03/31/81 
* 
* DC  PURPOSE 
* 
*     PROCESS A MEMORY OVERFLOW FOR DB$UNDO.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     A MEMORY OVERFLOW SITUATION HAS OCCURRED DURING DB$UNDO 
*     PROCESSING.  MEMOVFL IS CALLED VIA THE CMM OWNCODE EXIT.
* 
* DC  EXIT CONDITIONS 
* 
*     MEMERR IS SET TRUE TO INDICATE A MEMORY OVERFLOW SITUATION HAS
*     OCCURRED.  THE ERROR BLOCK FIELDS HAVE BEEN FILLED IN.
*     EXIT IS TO LABEL ENDUNDO IN THE DB$UNDO 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.
* 
*     THE ERROR BLOCK FIELDS HAVE BEEN SET. 
* 
* DC  DESCRIPTION 
* 
*     -  SET MEMERR TO TRUE.
* 
*     -  SET APPROPRIATE FIELDS IN THE ERROR BLOCK TO INDICATE MEMORY 
*        OVERFLOW OCCURRED. 
* 
*     -  GO TO ENDUNDO TO TERMINATE ROLLBACK 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;
  
      SRENUMB[0] = DFSRENMEM;  # INSUFFICIENT MEMORY                   #
      SREFUNC[0] = DFSREFNRB;  # FUNCTION IS TRANSACTION ROLLBACK      #
      GOTO ENDUNDO;          # TERMINATE DB$UNDO ROLLBACK PROCESSING   #
  
      END                    # END MEMOVFL                             #
  
#**********************************************************************#
#     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 $ U N D O   E X E C U T A B L E   C O D E      #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("UNDO");     # GENERATE A FLOW POINT                   #
      CONTROL ENDIF;
  
#**********************************************************************#
#                                                                      #
#     PERFORM PREPARATION FOR READ OF THE SPECIFIED TRF SEGMENT.  THIS #
#     CONSISTS OF THE FOLLOWING:                                       #
#                                                                      #
#        -  CHECK FOR ANY TRF ERROR STATUS THAT WAS LEFT UNREPORTED    #
#           FROM AN EARIER OPERATION.                                  #
#        -  SWITCH TO THE TRF FET THAT IS ASSOCIATED WITH ARTX.        #
#        -  PRIMING THE FET ASSOCIATED WITH THE SPECIFIED (PARAMETER)  #
#           ART INDEX (ARTX).                                          #
#        -  ALLOCATION OF A WORKING STORAGE AREA FOR READING THE TRF.  #
#                                                                      #
#**********************************************************************#
  
      P<SRERRBLK> = ERRBLKA; # SET POINTER TO ERROR BLOCK              #
      SREWORD[0] = 0;        # INITIALIZE ERROR BLOCK                  #
      SREWORD[1] = 0; 
  
      P<FET> = SATRFPTR[SALX];
  
      IF FETNOSAT[0] NQ 0 
      THEN
        BEGIN 
        SRENUMB[0] = DFSRENFUN;  # FUNCTION ERROR                    #
        SREFUNC[0] = DFSREFNIO;  # FUNCTION IS CIO                   #
        IF DB$NOS 
        THEN
          BEGIN 
          SREFPAR[0] = FETNOSAT[0];  # NOS FET ERROR STATUS FIELD    #
          END 
        ELSE
          BEGIN 
          SREFPAR[0] = FETNBAT[0];   # NOS/BE FET ERROR STATUS FIELD #
          END 
        SREFTYP[0] = DFSREFTTR;   # FILE TYPE =TRF                   #
        RETURN; 
  
        END 
  
  
  
#                                                                      #
#     IF THE SCHEMA STATUS IS NOT UP, IDLING, OR DOWNING, THEN RETURN. #
#                                                                      #
      IF SASCHST[SALX] NQ S"UP" 
        AND SASCHST[SALX] NQ S"IDLING"
        AND SASCHST[SALX] NQ S"DOWNING" 
      THEN
        BEGIN 
        SRENUMB[0] = DFSRENSDN;  # SCHEMA NOT UP                       #
        RETURN; 
  
        END 
  
      P<ART> = SAARTPTR[SALX];
      P<FET> = ARFETPTR[ARTX];  # INITIALIZE FET FOR TRF SEGMENT       #
      IF P<FET> EQ 0
      THEN                   # DB$BEG$ WAS ENDED BEFORE ALLOCATING     #
                             # THE TRF FET/BUFFER AREA                 #
        BEGIN 
        GOTO NOFETPTR;       # THERE IS NO FET POINTER, EXIT           #
  
        END 
      SATRFPTR[SALX] = P<FET>;
      FETIN[0] = FETFIRST[0]; 
      FETOUT[0] = FETFIRST[0];
      FETRR[0]= (DFARTENSIZE*(ARNTUN[0]+1))/64 + ARNPRU[0]*(ARTX-1) +3; 
      FETCODE[0] = DFFIRSTC;  # INDICATE FIRST READ OF THE TRF SEGMENT #
  
      MAXLOGSZ = (SASCMAXLOG[SALX] + 9) / 10;  # MAX LOG REC SIZE (WDS)#
      MEMERR = FALSE; 
      MFPASAVE = DB$MFPA;    # SAVE CURRENT CMM OVERFLOW OWNCODE ADDR  #
      DB$MFPA = LOC(MEMOVFL);  # SET CMM OVERFLOW OWNCODE EXIT         #
      IF SYSRECOVERY
      THEN
        BEGIN 
        DB$MFA(MAXLOGSZ,P<JLREC>);  # ALLOCATE WSA                     #
        END 
      ELSE
        BEGIN                # DB$INIT HAS ALREADY ALLOCATED THE WSA   #
        P<JLREC> = UNDOBUF; 
        CMMSDA(DB$HHAE);     # SET DYNAMIC AREA TO HIGHEST HIGH ADDRESS#
        END 
      SAVEJLR = P<JLREC>; 
  
#**********************************************************************#
#                                                                      #
#     INITIALIZE ALL FLAGS AND TABLE POINTERS.                         #
#                                                                      #
#**********************************************************************#
  
      TREOI = FALSE;
      TRIOERR = FALSE;
      RFTPTR = 0; 
      OLDVERS = "       ";
  
  
#**********************************************************************#
#                                                                      #
#     READ FROM TRF SEGMENT UNTIL THE END OF THE SEGMENT IS REACHED.   #
#     FOR EACH BEFORE-IMAGE, DO THE FOLLOWING ---                      #
#                                                                      #
#        -  EXTRACT THE AREA ID AND VERSION NAME FROM THE BEFORE-IMAGE.#
#        -  IF THE VERSION NAME IS DIFFERENT FROM THE PREVIOUS VERSION #
#           NAME, THERE IS AN ERROR ON THE TRF, SO ROLLBACK PROCESSING #
#           IS STOPPED.                                                #
#        -  SEARCH FOR AN AREA MATCH IN THE RFT.  IF NONE, CREATE NEW  #
#           ENTRY.  ACTIVATE THE AREA (VERSION) IF REQUIRED.           #
#        -  CHECK IF THE GIVEN PRIMARY KEY HAS ALREADY BEEN PROCESSED. #
#           IF NOT, ADD IT TO THE KEY LIST FOR THE RFT ENTRY AND THEN  #
#           PERFORM BACKOUT OF THE GIVEN RECORD.                       #
#                                                                      #
#        -  AN ERROR OR THE END OF THE SEGMENT READING THE TRF OR      #
#           INSUFFICIENT MEMORY WILL TERMINATE READING OF THE TRF.     #
#                                                                      #
#**********************************************************************#
  
      FOR INDEX=INDEX 
        WHILE NOT TREOI 
        AND NOT TRIOERR 
      DO
        BEGIN 
#                                                                      #
#         RESTORE P<JLREC> BECAUSE IT MIGHT HAVE BEEN CHANGED BY       #
#         DB$SCHD IF DB$QRF IS CALLED DURING AAM PROCESSING.           #
#                                                                      #
        P<JLREC> = SAVEJLR; 
        LOGRECL = DB$RDLG(LOC(FET),P<JLREC>); 
  
        IF FETNOSAT[0] NQ 0  # IF I/O ERROR - EXIT LOOP                #
        THEN
          BEGIN 
          TRIOERR = TRUE; 
#                                                                      #
#         FILL IN APPROPRIATE FIELDS OF ERROR BLOCK.                   #
#                                                                      #
          SRENUMB[0] = DFSRENFUN;  # FUNCTION ERROR                    #
          SREFUNC[0] = DFSREFNIO;  # FUNCTION IS CIO                   #
          IF DB$NOS 
          THEN                     # EXECUTING ON NOS                  #
            BEGIN 
            SREFPAR[0] = FETNOSAT[0];  # NOS FET ERROR STATUS FIELD    #
            END 
          ELSE                     # EXECUTING ON NOS/BE               #
            BEGIN 
            SREFPAR[0] = FETNBAT[0];   # NOS/BE FET ERROR STATUS FIELD #
            END 
          SREFTYP[0] = DFSREFTTR;  # FILE TYPE =TRF                    #
  
          TEST;                    # EXIT LOOP                         #
          END 
  
        IF LOGRECL LS 0 
        THEN
          BEGIN 
          TREOI = TRUE;      # END OF SEGMENT - EXIT LOOP              #
          TEST; 
  
          END 
#                                                                      #
#       PROCESS ONLY BEFORE IMAGE RECORDS FROM THE TRF.  THIS CONSISTS #
#       OF TWO TYPES OF RECORDS -                                      #
#       (1) BEFORE IMAGE RECORDS OF TYPE DFJLRQBI ARE WRITTEN TO THE   #
#           TRF FOR USE IN BACKING OUT UNCOMMITTED TRANSACTIONS OR FOR #
#           USE IN RECORDING ON THE JOURNAL LOG FILE FOR A COMMITTED   #
#           TRANSACTION.                                               #
#       (2) BEFORE IMAGES OF TYPE DFJLRQTR CORRESPOND TO AREAS WHICH DO#
#           NOT HAVE BEFORE IMAGE RECORD LOGGING DEFINED AND SO THESE  #
#           RECORDS ARE ONLY USED FOR BACKING OUT UNCOMMITTED          #
#           TRANSACTIONS.                                              #
#                                                                      #
        IF JLHDTYPE[0] EQ DFJLRQBI
          OR JLHDTYPE[0] EQ DFJLRQTR
        THEN
          BEGIN 
          CRMRC = 0;
          ARVERS = JLHDVENM[0];  # VERSION NAME ON LOG RECORD          #
          IF OLDVERS EQ "       " 
          THEN               # FIRST VERSION FOUND ON THIS TRF SEGMENT #
            BEGIN 
            OLDVERS = ARVERS; 
            END 
          ELSE
            BEGIN 
            IF ARVERS NQ OLDVERS
            THEN             # VERSION MISMATCH                        #
              BEGIN 
              TRIOERR = TRUE;  # BAD DATA ON TRF                       #
              SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF           #
              SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF              #
              TEST;          # EXIT LOOP                               #
  
              END 
            END 
  
          ARID = DB$CBIN(JLHDARID[0],4,10); 
          IF ARID LS 0 OR ARID GR SASCNBAR[SALX]
          THEN
            BEGIN 
            TRIOERR = TRUE; 
            SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF             #
            SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF                #
            TEST;            # EXIT LOOP                               #
  
            END 
  
          IF FINDRFT         # ACTIVATE AREA                           #
          THEN
            BEGIN 
            P<OFT> = RFOFT[0];
            P<UFT> = RFUFT[0];
            KL = DB$CBIN(JLHDKEYL[0],3,10); 
            IF KL LS 0
            THEN
              BEGIN 
              TRIOERR =TRUE;
              SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF           #
              SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF              #
              TEST;          # EXIT LOOP                               #
  
              END 
            KLW = (KL + 9)/10;
            P<RECKEY> = LOC(JLBARKEY[0]); 
            IF NOT FINDKEY(RECKEY,KL)  # CHECK IF KEY IN LIST          #
            THEN                       # IF NOT, SETUP FOR BACKOUT     #
              BEGIN 
              UFFITKA[0] = LOC(RECKEY); 
              UFFITWSA[0] = LOC(RECKEY) + KLW;
              RECLEN = DB$CBIN(JLHDTRLS[0],6,10) - 10 * KLW;
              IF RECLEN LS 0
              THEN
                BEGIN 
                TRIOERR = TRUE; 
                SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF         #
                SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF            #
                TEST;        # EXIT LOOP                               #
  
                END 
              PAD = B<0,6>JLHDPAD[0] - O"33"; 
              IF PAD LS 0 OR PAD GR 9 
              THEN
                BEGIN 
                TRIOERR = TRUE; 
                SRENUMB[0] = DFSRENDAT;  # INVALID DATA ON TRF         #
                SREFTYP[0] = DFSREFTTR;  # FILE TYPE IS TRF            #
                TEST;        # EXIT LOOP                               #
  
                END 
              RECLEN = RECLEN - PAD;
              UFFITRL[0] = RECLEN;
              BACKOUT;       # BACKOUT THE GIVEN RECORD                #
              END 
            END 
  
          END 
        END                  # END FOR-LOOP                            #
  
  
  
#     T E R M I N A T E   R O L L B A C K   P R O C E S S I N G        #
  
ENDUNDO:                     # TERMINATE ROLLBACK PROCESSING           #
  
#**********************************************************************#
#                                                                      #
#     ROLL BACK PROCESSING COMPLETED OR ABORTED.  DO THE FOLLOWING     #
#     FOR EACH RFT ENTRY:                                              #
#                                                                      #
#       *  CLOSE THE AREA (IF IT IS OPEN) AND DELINK THE UFT ENTRY AND #
#          THE KEY LIST.                                               #
#       *  ISSUE DAYFILE MESSAGE FOR AREA/VERSION IF *BAD* FLAG SET.   #
#          CALL DB$TARE TO TERMINATE ALL RUN UNITS WHICH HAVE THAT     #
#          AREA/VERSION OPEN.                                          #
#       *  DELINK THE RFT ENTRY.                                       #
#                                                                      #
#**********************************************************************#
  
  
      AREAERR = FALSE;
      P<RFT> = RFTPTR;
      FOR INDEX=INDEX 
        WHILE P<RFT> NQ 0 
      DO
        BEGIN 
        P<UFT> = RFUFT[0];
        IF P<UFT> GR 0
        THEN
          BEGIN 
          UFFITEX[0] = RFEX[0]; 
          IF SYSRECOVERY
          THEN
            BEGIN 
            IF UFFITOC[0] EQ DFFITOCOPEN  # CLOSE FILE ONLY IF OPEN    #
            THEN
              BEGIN 
              P<FIT> = LOC(UFFIT[0]); 
              UFFITFNF[0] = FALSE;
              CLOSEM(FIT,DFFITCFDET,DB$RA0);
              END 
            END 
          P<UFT> = DFNPTR;
  
          P<KEYLIST> = RFKEYLP[0];  # RELEASE KEY LIST                 #
          FOR INDEX=INDEX 
            WHILE P<KEYLIST> NQ 0 
          DO
            BEGIN 
            DB$LNKD(P<KEYLIST>);
            END 
          END 
  
        IF RFARBAD[0]        # IF THIS AREA COULD NOT BE RESTORED      #
        THEN
          BEGIN 
          AREAERR = TRUE;    # INDICATE AT LEAST ONE AREA WAS BAD      #
          IF NOT SYSRECOVERY
          THEN
            BEGIN 
            DB$TARE(RFOFT[0],LOC(DB$RBER));  # TERMINATE ALL USERS OF  #
                                             # THE AREA.  (NOTE -      #
                                             # DB$TARE DOES NOT TERMIN-#
                                             # ATE THE CURRENT USER.)  #
            END 
          END 
  
        DB$LNKD(P<RFT>);     # DELINK RFT ENTRY                        #
        END 
  
  
#**********************************************************************#
#                                                                      #
#     RELEASE THE TEMPORARY BUFFER FOR THE LOG RECORD.                 #
#                                                                      #
#     RESET DB$MFPA TO THE PREVIOUS CMM OVERFLOW OWNCODE EXIT.         #
#                                                                      #
#     IF THERE WAS AN ERROR IN READING THE TRF FILE OR INSUFFICIENT    #
#     MEMORY FOR ROLLBACK PROCESSING, SET THE SCHEMA IN *ERRDOWN*      #
#     STATUS AND RETURN TO THE CALLER TO PROCESS THE ERROR.            #
#     TO ABORT THE CURRENT RUN UNIT.                                   #
#                                                                      #
#     IF AN AREA WAS BAD AND NOT IN SYSTEM RECOVERY MODE, SET A FLAG   #
#     IN THE ERROR BLOCK TO NOTIFY THE CALLER.                         #
#                                                                      #
#**********************************************************************#
  
  
      IF SYSRECOVERY
      THEN
        BEGIN 
        DB$MFF(SAVEJLR);     # RETURN LOG RECORD BUFFER                #
        END 
  
#     RESET DB$MFPA TO PREVIOUS CMM OVERFLOW OWNCODE EXIT ADDRESS.     #
  
      DB$MFPA = MFPASAVE; 
  
#     CLEAR TQARTX.  THIS DISASSOCIATES THE RUN UNIT FROM ART ENTRY.   #
#     IF ANY ERRORS HAVE OCCURED, THE ART ENTRY WILL NOT BE CLEARED.   #
#     THIS WILL ALSO PREVENT AN INFINITE LOOP THROUGH DB$ERR, DB$TQTD. #
  
      TQARTX[0] = 0;
  
#     CHECK IF AN I/O ERROR OCCURRED ON THE TRANSACTION RECOVERY FILE. #
#     CHECK IF A MEMORY OVERFLOW OCCURRED.                             #
  
      IF TRIOERR
        OR MEMERR 
      THEN
        BEGIN 
        SASCHST[SALX] = S"ERRDOWN";  # SET SCHEMA STATUS TO ERRDOWN    #
        RETURN; 
  
        END 
  
#     CHECK IF ANY AREA ERRORS OCCURRED.                               #
  
      IF AREAERR
      THEN                   # SOME AREA WAS UNUSABLE                  #
        BEGIN 
        IF NOT SYSRECOVERY
        THEN
          BEGIN 
          SRENUMB[0] = DFSRENARB;  # RETURN ERROR TO DB$UNDU           #
  
          END 
        RETURN; 
  
        END 
  
#**********************************************************************#
#                                                                      #
#     NO ERRORS IN ROLLBACK PROCESSING.                                #
#                                                                      #
#     RELEASE THE TRF FET/I-O BUFFER ASSOCIATED WITH THE ART ENTRY.    #
#     CLEAR THE ART ENTRY.  SET THE SAL TRF FET POINTER TO THE         #
#     LOCATION OF THE MODEL TRF FET.                                   #
#                                                                      #
#**********************************************************************#
      INDEX = ARFETPTR[ARTX] -1;
      DB$MFF(INDEX);         # RETURN FET/BUFFER FOR TRF I/O           #
  
NOFETPTR: 
      ARBCID[ARTX] = " ";    # CLEAR ART ENTRY                         #
      ARURID[ARTX] = " "; 
      ARCURUP[ARTX] = 0;
  
      RCWART[0] = TRUE;      # ART MUST BE WRITTEN TO TRF BEFORE       #
                             # USER"S LOCKS ARE RELEASED               #
#                                                                      #
#     RESET SAL TRF POINTER TO LOC OF MODEL TRF FET.  (THIS ASSUMES    #
#     THAT DB$UNDO IS NON-INTERRUPTIBLE AFTER STARTING TRF PROCESSING, #
#     ELSE A CHECK MUST FIRST BE MADE THAT THIS WAS THE LAST FET USED  #
#     IN PROCESSING THE TRF (I.E., SATRFPTR[SALX] IS EQUAL TO          #
#     ARFETPTR[ARTX]).)                                                #
  
      SATRFPTR[SALX] = ARMODFET[0];  # TRF MODEL FET                   #
      ARFETPTR[ARTX] = 0; 
  
      RETURN; 
  
      END 
      TERM
