*DECK DB$RUTR 
USETEXT CDCSCTX 
      PROC DB$RUTR( ERRBLKA );
      BEGIN 
 #
* *   DB$RUTR - ROLL BACK UNCOMMITTED TRANSACT   PAGE  1
* *   D E TRIGLIA/W P CEAGLIO                    DATE  01/14/81 
* 
* DC  PURPOSE 
* 
*     TO ROLL BACK ALL UNCOMMITTED TRANSACTIONS IN THE ART. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM ERRBLKA      I;         # ADDRESS OF ERROR STATUS BLOCK     #
# 
* D   ASSUMPTIONS 
* 
*     THE ART IS IN MANAGED MEMORY. 
*     SALX IS SET.
*     THE QRF, TRF, AND RIF ARE ATTACHED.  THE RIF IS OPENED FOR I/O. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   - ALL UNCOMMITTED TRANSACTIONS IN THE ART HAVE BEEN
*                ROLLED BACK.  COMMITTED TRANSACTIONS WHICH CONTAIN 
*                A RESTART IDENTIFIER WILL CAUSE THE ASSOCIATED RECORD
*                IN THE RESTART IDENTIFIER FILE TO BE REWRITTEN WITH
*                THE TRANSACTION IDENTIFIER.  THE ART IS READY FOR USE
*                AGAIN.  THE ERROR STATUS IS SET TO ZERO. 
* 
*     ABNORMAL - ROLL BACK NOT PERFORMED OR INCOMPLETE. 
*                AN I/O ERROR ON THE TRF 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
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK C(10);       # OBTAIN SYSTEM TIME                #
      XREF FUNC DATE C(10);        # OBTAIN SYSTEM DATE                #
      XREF FUNC DB$COCT C(10);     # BINARY TO OCTAL DISPLAY CODE      #
      XREF PROC DB$FLOP;           # RECORD A FLOW POINT               #
      XREF PROC DB$MFA;            # ALLOCATE CMM BLOCK                #
      XREF PROC DB$MSG;            # ISSUE DAYFILE MESSAGE             #
      XREF PROC DB$RA0;            # TERMINATE PARAMETER LIST          #
      XREF PROC DB$UNDO;           # BACKOUT UNCOMMITTED TRANSACTION   #
      XREF PROC DB$WART;           # REWRITE ART TO TRF                #
      XREF PROC GET;               # READ RECORD FROM RIF              #
      XREF PROC REPLC;             # REWRITE RECORD IN RIF             #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     ART 
* 
* DC  DESCRIPTION 
* 
*     FOR EACH ART ENTRY, DO THE FOLLOWING: 
* 
*       -  IF THE TRANSACTION IS COMMITTED AND CONTAINS A RESTART ID, 
*          REWRITE THE TRANSACTION ID TO THE RESTART ID FILE.  CLEAR
*          THE ART ENTRY.  REWRITE THE ART TO THE TRF.
* 
*       -  IF THE TRANSACTION IS NOT COMMITTED, DO THE FOLLOWING: 
* 
*          * ALLOCATE A FET AND I/O BUFFER FOR READING THE TRF. 
*          * INITIALIZE THE FET FROM THE MODEL FET POINTED TO IN THE ART
*            HEADER.
*          * CALL DB$UNDO TO PERFORM THE TRANSACTION BACKOUT. 
* 
*          NOTE --- DB$UNDO CLEARS THE ART ENTRY, RELEASES THE TRF FET
*          AND I/O BUFFER, AND REWRITES THE ART TO THE TRF. 
* 
*     WHEN PROCESSING COMPLETED (OR ABORTED), CHECK FOR THE FOLLOWING 
*     ERRORS: 
* 
*       -  I/O ERROR ON THE RESTART ID FILE.  RETURN AN ERROR IN THE
*           ERROR STATUS BLOCK. 
* 
*       -  ERROR IN DB$UNDO PROCESSING.  IF AN I/O ERROR ON THE RESTART 
*           IDENTIFIER FILE ALSO OCCURRED, ISSUE A DAYFILE MESSAGE FOR
*           IT. 
* 
 #
  
  
  
#     LOCAL VARIABLES                                                  #
  
      ITEM ARTX    I;              # INDEX INTO ART                    #
      ITEM INDEX   I;              # SCRATCH--FOR LOOPS                #
      ITEM MAXTRAN I;              # MAXIMUM NUMBER OF TRANSACTIONS    #
      ITEM RIFERR  U;              # CRM ERROR NUMBER ON RIF           #
      ITEM RIFERRMSG C(49) = "  I/O (CRM) ERROR XXX ON RESTART IDENTIFIE
R FILE:"; 
      ITEM TIMDAT  C(10);          # FOR SYSTEM TIME AND DATE REQUESTS #
      ITEM TRFBUFLEN  I;           # SIZE (WORDS) OF TRF SEGMENT BUFFER#
      ITEM UNDOERR B;              # TRUE IF ROLL BACK FAILURE         #
  
*CALL ARTDCLS 
  
      BASED ARRAY MODFET;          # MODEL TRF FET (FROM ART HEADER)   #
        BEGIN 
        ITEM MODFETWD   U(00,00,60);
        END 
  
      BASED ARRAY RIDFIT;          # FIT FOR RESTART ID FILE           #
*CALL FITDCLS 
  
      ARRAY RIDREC (DFRIFLEN);     # RESTART ID RECORD LAYOUT          #
*CALL RSTIDDCLS 
  
  
*CALL SRERRDCLS 
  
      BASED ARRAY TRFFET;          # FET FOR READING TRF SEGMENT       #
*CALL FETDCLS 
  
  
  
  
  
# S T A R T   O F   D B $ R U T R   E X E C U T A B L E   C O D E      #
  
  
#**********************************************************************#
#                                                                      #
#     INITIALIZE ERROR STATUS WORD AND ALL FLAGS                       #
#                                                                      #
#**********************************************************************#
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("RUTR");
      CONTROL ENDIF;
  
      P<SRERRBLK> = ERRBLKA;
      RIFERR = 0; 
      UNDOERR = FALSE;
  
#**********************************************************************#
#                                                                      #
#     PICK UP POINTER TO ART FROM SAL.  FOR EACH ENTRY IN THE ART, DO  #
#     THE FOLLOWING:                                                   #
#                                                                      #
#       *  IF THE TRANSACTION IS COMMITTED AND CONTAINS A RESTART ID,  #
#          REWRITE THE TRANSACTION ID TO THE RESTART ID FILE.  CLEAR   #
#          THE ART ENTRY.  REWRITE THE ART TO THE TRF.                 #
#                                                                      #
#       *  IF THE TRANSACTION IS NOT COMMITTED, BACK IT OUT OF THE     #
#          DATABASE.  THIS ENTAILS THE FOLLOWING:                      #
#             -  ALLOCATE A FET AND I/O BUFFER FOR READING THE TRF.    #
#             -  INITIALIZE THE FET FROM MODEL FET IN THE ART HEADER.  #
#             -  CALL DB$UNDO TO PERFORM THE TRANSACTION BACKOUT.      #
#                                                                      #
#           NOTE --- DB$UNDO CLEARS THE ART ENTRY, RELEASES THE TRF    #
#           FET AND I/O BUFFER.                                        #
#                                                                      #
#**********************************************************************#
  
      P<ART> = SAARTPTR[SALX];
      MAXTRAN = ARNTUN[0];
      FOR ARTX=1 STEP 1 
        WHILE ARTX LQ MAXTRAN 
        AND NOT UNDOERR 
      DO
        BEGIN 
        IF ARTRCS[ARTX]            # IF COMMITTED TRANSACTION, REWRITE #
        THEN                       # RESTART ID RECORD IF APPLICABLE   #
          BEGIN 
          IF ARURID[ARTX] NQ " "
            AND SARIDFIT[SALX] NQ 0 
            AND RIFERR EQ 0 
          THEN
            BEGIN 
            P<RIDFIT> = SARIDFIT[SALX]; 
            FITKA[0] = LOC(ARURID[ARTX]); 
            FITWSA[0] = LOC(RIDREC);
            GET(RIDFIT,DB$RA0); 
            IF FITES[0] EQ 0
            THEN
              BEGIN 
              RDDATE[0] = DATE(TIMDAT); 
              RDTIME[0] = CLOCK(TIMDAT);
              RDTID[0] = ARBCID[ARTX];
              REPLC(RIDFIT,DB$RA0); 
              END 
            IF FITES[0] NQ 0           # IF CRM ERROR, SET FLAG        #
              AND FITES[0] NQ O"445"   # (IGNORE ERROR 445-NO KEY )    #
            THEN
              BEGIN 
              RIFERR = FITES[0];
              END 
            END 
  
          ARBCID[ARTX] = " ";      # CLEAR ART                         #
          ARURID[ARTX] = " "; 
          ARCURUP[ARTX] = 0;
          ARTRCS[ARTX] = FALSE; 
  
          DB$WART;                 # REWRITE THE ART TO THE TRF        #
          END 
  
        ELSE                       # OTHERWISE, BACKOUT UNCOMMITTED    #
          BEGIN                    # TRANSACTION.                      #
          IF ARBCID[ARTX] NQ " "
          THEN
            BEGIN 
            TRFBUFLEN = (SASCMAXLOG[SALX]+9)/10 + DFTRBUFEX;
            DB$MFA(DFFETLEN+TRFBUFLEN+1,P<TRFFET>); 
            FETLFNWD[0] = 0;
            P<TRFFET> = P<TRFFET> +1; 
            ARFETPTR[ARTX] = LOC(TRFFET); 
            P<MODFET> = ARMODFET[0];
            FOR INDEX=0 STEP 1
              UNTIL DFFETLEN-1
            DO
              BEGIN 
              FETLFNWD[INDEX] = MODFETWD[INDEX];
              END 
            FETFIRST[0] = LOC(TRFFET) + DFFETLEN; 
            FETLIMIT[0] = FETFIRST[0] + TRFBUFLEN;
            DB$UNDO(ARTX,P<SRERRBLK>);  # (DB$UNDO CLEARS ART ENTRY)   #
            DB$WART;               # REWRITE THE ART TO THE TRF        #
            IF SASCHST[SALX] EQ S"ERRDOWN"  # IF ROLL BACK FAILURE,    #
            THEN                            # SET FLAG                 #
              BEGIN 
              UNDOERR = TRUE; 
              END 
            END 
          END 
        END 
  
#**********************************************************************#
#                                                                      #
#     ROLL BACK PROCESSING COMPLETED OR ABORTED.  CHECK FOR FOLLOWING  #
#     ERRORS:                                                          #
#                                                                      #
#       *  DB$UNDO ERROR - THIS CAN BE AN ERROR ON THE TRF OR A MEMORY #
#          OVERFLOW ERROR (DATABASE AREA ERRORS ARE PROCESSED          #
#          COMPLETELY WITHIN DB$UNDO).  IF AN I/O ERROR ON THE RIF     #
#          ALSO OCCURRED, THEN ISSUE A DAYFILE MESSAGE FOR IT.         #
#                                                                      #
#       *  I/O ERROR ON RIF - IF A DB$UNDO ERROR DID NOT ALSO OCCUR,   #
#          THEN AN ERROR IS RETURNED IN THE STATUS BLOCK AND THE       #
#          SCHEMA IS PLACED IN *ERRDOWN* STATUS.                       #
#                                                                      #
#**********************************************************************#
  
      IF SRENUMB[0] NQ 0           # IF DB$UNDO FAILURE...             #
      THEN
        BEGIN 
        IF RIFERR NQ 0
        THEN
          BEGIN 
          C<18,3>RIFERRMSG = DB$COCT(RIFERR,3); 
          DB$MSG(RIFERRMSG);
          END 
        END 
  
      ELSE                         # ELSE IF ONLY RIF ERROR...         #
        BEGIN 
        IF RIFERR NQ 0
        THEN
          BEGIN 
          SRENUMB[0] = DFSRENFUN; 
          SREFUNC[0] = DFSREFNCR; 
          SREFPAR[0] = RIFERR;
          SREFTYP[0] = DFSREFTRD; 
          SASCHST[SALX] = S"ERRDOWN"; 
          END 
        END 
  
      END 
      TERM; 
