*DECK DB$FTEX 
USETEXT CDCSCTX 
      PROC DB$FTEX; 
      BEGIN 
 #
* *   DB$FTEX                                    PAGE  1
* *   CRM ERROR MANAGER 
* *   W P CEAGLIO                                DATE  5/20/76
* *   BOB MCALLESTER                             DATE  11/15/84 
* 
* DC  PURPOSE 
* 
*     PERFORM ALL ACTIONS IN CONNECTION WITH CRM ERRORS 
* 
* DC  ENTRY CONDITIONS
* 
*     DB$FTEX IS ENTERED FROM CRM VIA THE "EX" ADDRESS IN THE FIT.
*     THE "ES" FIT FIELD CONTAINS THE CRM ERROR AND THE "BFF" FIT 
*     FIELD MAY BE FLAGGED TO INDICATE THE AREA IS BAD STRUCTURALLY.
* 
* DC  ASSUMPTIONS 
* 
*     CDCS COMMON 
*           UFT          POINTER TO CURRENT UFT 
*           TQT          POINTER TO CURRENT ENTRY 
*           RCB          POINTER SET
*           RSARBLK      POINTER TO CURRENT AREA CONTROL BLOCK
* 
* DC  EXIT CONDITIONS 
* 
*     IF CDCS HAS BEEN REPRIEVED, RETURN. 
*     IF THE CRM ERROR IS A CDCS-RESERVED NUMBER, OR CRM 507, CDCS IS 
*     ABORTED WITH A CALL TO DB$PUNT. 
* 
*     IF A BAD-FILE CONDITION IS FOUND, OR IF THE CRM ERROR IS ERROR
*     52, THEN THE FILE STATUS IS SET TO "ERRDOWN" AND DB$TARE IS 
*     CALLED TO TERMINATE ALL USERS OF THE AREA.
*     UNLESS CDCS IS ABORTED, DB$ERR IS CALLED TO PROCESS THE ERROR.
* 
*     AN ERROR MESSAGE HAS BEEN WRITTEN TO THE ERROR BUFFER IN THE RUN- 
*     UNIT FIELD LENGTH.  ANY "ON ERROR" DATA BASE PROCEDURES HAVE BEEN 
*     EXECUTED.  FINALLY, THE RUN-UNIT REQUEST IS TERMINATED. 
* 
* DC  CALLING ROUTINES
* 
*     CRM (VIA "EX" FIELD IN THE FIT
*     DB$IFEX - CRM ERROR MANAGER FOR IFT (INTERNAL FIT). 
* 
* DC  CALLED ROUTINES 
* 
*     DB$COCT    CONVERT AN INTEGER VARIABLE TO OCTAL DISPLAY CODE
*     DB$ERR     ERROR MESSAGE GENERATOR
*     DB$ERRE    ERROR MESSAGE EDITOR 
*     DB$FLOP    GENERATE FLOW POINT
*     DB$MSG     SEND A MESSAGE TO THE CDCS DAYFILE 
*     DB$POP     RESTORE A VARIABLE FROM THE RCB PUSH-DOWN STACK. 
*     DB$PUNT    ABORT CDCS 
*     DB$PUSH    SAVE A VARIABLE IN THE RCB PUSH-DOWN STACK.
*     DB$TARE    TERMINATE AREA USERS 
* 
* DC  EXTERNAL LABELS REFERENCED
# 
      XREF LABEL DB$CRER;               # CONTINUATION ADDRESS FOR     #
                                        # TERMINATING USERS OF BAD AREA#
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<OFT>      POINTER TO OFT
*     OFSTATUS    AREA STATUS OFT FIELD 
* 
 #
  
# EXTERNAL REFERENCES                                                  #
  
      XREF PROC DB$CALL;                # MAKE CALL TO SPECIFIED ADDR  #
      XREF FUNC DB$COCT C(10);          # CONVERT INTEGER TO OCTAL     #
      XREF PROC DB$ERR;                 # USER ERROR MESSAGE GENERATOR #
      XREF PROC DB$ERRE;                # ERROR MESSAGE EDITOR         #
      XREF ITEM DB$ERSO I;              # ERROR MSG SEVERITY OVERRIDE  #
      XREF PROC DB$FLOP;                # GENERATE FLOW POINT          #
      XREF PROC DB$FSAV;                # SAVE CURRENT KEY VALUES      #
      XREF PROC DB$LOKD;                # DELETE LOCKS                 #
      XREF PROC DB$MSG;                 # SEND MESSAGE TO DAYFILE      #
      XREF PROC DB$POP;                 # SAVE A VARIABLE              #
      XREF PROC DB$PUNT;                # ABORT CDCS                   #
      XREF PROC DB$PUSH;                # RESTORE A VARIABLE           #
  
      XREF ITEM DB$RCVD;                # FIRST CDCS REPRIEVE ENTRY PT.#
                                        # THIS PROCEDURE ENTRY POINT   #
                                        # IS REFERENCED AS AN INTEGER. #
  
      XREF PROC DB$TARE;                # TERMINATE AREA USERS         #
  
      XREF ARRAY DB$SYMB;               # FUNCTION FLAGS ARRAY         #
        BEGIN 
        ITEM FCPOS B(00,00,01);         # TRUE IF FUNCTION             #
                                        # MODIFIES FILE POSITION       #
        END 
  
#     LOCAL VARIABLES                                                  #
  
      ITEM BUFLEN  I;                   # A PARAMETER FOR DB$ERRE      #
      ITEM CRMERR C(10) = "CRM - 000 "; # PUNT ON CRM INTERNAL ERROR   #
      ITEM MSGBUF  C(20);               # BUFFER FOR DB$ERRE/DB$MSG    #
      ITEM MSGBUF2 C(120);              # CONTINUATION OF MSGBUF       #
      ITEM SUPPRESS B;                  # SUPPRESS DB$ERR CALLS        #
  
#     EXTERNALLY DEFINED VARIABLES                                     #
  
      XDEF ITEM DB$FTSM B=FALSE;        # SUPPRESS DB$ERR CALLS        #
  
  
*CALL ERSORDCLS 
  
  
  
# S T A R T   O F   D B $ F T E X   E X E C U T A B L E   C O D E      #
  
  
      CONTROL IFGR DFFLOP,0;
        ITEM FTEXFLOP C(10) = "FTEX000   "; 
        C<4,3>FTEXFLOP = DB$COCT(UFFITES[0],3); 
        DB$FLOP(FTEXFLOP);   # FLOW POINT CONTAINS CRM ERROR NUMBER    #
      CONTROL ENDIF;
  
      IF LOC(FPT) GR 0
      THEN
        BEGIN 
        FPFITES[0] = UFFITES[0];
        FPFITFNF[0] = UFFITFNF[0];
        IF FPFTEX[0] NQ DFFTEX1    # IF NOT INTENDED FOR DB$FTEX       #
        THEN
          BEGIN 
          IF FPFTEX[0] EQ DFFTEX2  # IF IT IS A DB$MFP ERROR PROCESSOR #
          THEN                     #  FOR ROOT RANK                    #
            BEGIN 
            DB$CALL(FTEX2); 
            END 
          IF FPFTEX[0] EQ DFFTEX3  # IF IT IS A DB$MFP ERROR PROCESSOR #
          THEN                     #  FOR OTHER RANKS                  #
            BEGIN 
            DB$CALL(FTEX3); 
            END 
          RETURN; 
  
          END 
        END 
      SUPPRESS = DB$FTSM OR SYSRECOVERY;
      DB$FTSM = FALSE;
  
#     SYMPL INITIALIZES PROCEDURE ENTRY POINTS WITH ZERO VALUES.       #
#     ANY RETURN JUMP TO IT WILL LEAVE IT NON-ZERO.                    #
  
      IF DB$RCVD NQ 0        # IF THE REPRIEVE DUMP ROUTINE HAS BEEN   #
      THEN                   # ENTERED, RETURN.                        #
        BEGIN 
        RETURN; 
  
        END 
  
      IF (UFFITES[0] GQ O"600" AND UFFITES[0] LQ O"677")
        OR (UFFITES[0] GQ O"730" AND UFFITES[0] LQ O"777")
                                   # CRM USED CDCS-RESERVED NUMBER     #
        OR UFFITES[0] EQ O"507"    # CRM INTERNAL ERROR ON IS FILE     #
      THEN
        BEGIN 
        C<6,3>CRMERR = DB$COCT(UFFITES[0],3); 
        DB$PUNT(CRMERR);
        END 
  
      IF UFFITES[0] EQ O"135"       # READ PARITY ERROR                #
        AND NOT SUPPRESS
      THEN
        BEGIN 
        DB$ERRE(92,MSGBUF,BUFLEN);  # EDIT THE AREA NAME INTO MESSAGE  #
        DB$MSG(MSGBUF2);            # SEND THE MESSAGE TO THE DAYFILE  #
        END 
  
#     IF IT IS A FUNCTION THAT MODIFIES POSITION, SAVE NEW POSITION    #
  
      IF FCPOS[RCIRFUNC[0]] 
        AND RCIRFUNC[0] NQ DFOPN
        AND RCIRFUNC[0] NQ DFCLS
      THEN
        BEGIN 
        DB$FSAV;
        END 
  
#     IDENTIFY AND DOWN A BAD FILE                                     #
  
      IF UFFITBFF[0]               # IF BAD FILE FLAG IS SET OR ...    #
        OR UFFITES[0] EQ O"052"    # FILE WAS NOT FLUSHED BY THE       #
                                   # PREVIOUS USER                     #
        OR UFFITES[0] EQ O"135"    # READ PARITY ERROR OR WRONG LENGTH #
                                   # BLOCK                             #
        OR UFFITES[0] EQ O"546"    # PRIMARY KEY NOT FOUND             #
        OR UFFITES[0] EQ O"547"    # BAD STRUCTURE FOUND IN FILE       #
      THEN
        BEGIN 
        IF SYSRECOVERY
        THEN
          BEGIN 
          OFSTATUS[0] = S"ERRDOWN";  # SET AREA STATUS TO "ERROR DOWN" #
          RETURN; 
  
          END 
        DB$ERRE(51,MSGBUF,BUFLEN); # EDIT A DAYFILE MESSAGE (CRM ERROR)#
        DB$MSG(MSGBUF2);           # AND SEND IT.                      #
        IF NOT SUPPRESS 
        THEN
          BEGIN 
          DB$ERSO = DFERSOI;       # SEVERITY LEVEL IS INFORMATIONAL   #
          DB$ERR(12);              # INFORM THE CURRENT AREA USER      #
          END 
        P<OFT> = RSAROFIT[0];      # SET OFT POINTER                   #
        DB$TARE(P<OFT>,LOC(DB$CRER));  # TERMINATE AREA USERS          #
        GOTO DB$CRER;              # AND THE CURRENT USER              #
  
        END 
      IF SUPPRESS 
      THEN
        BEGIN 
        RETURN; 
  
        END 
      DB$PUSH(DB$FTEX); 
      IF   RCIRFUNC[0] EQ DFRD1 
        OR RCIRFUNC[0] EQ DFRD2 
      THEN
        BEGIN 
        DB$LOKD(FALSE); 
        END 
      IF UFFITFNF[0]
      THEN
        BEGIN 
        DB$ERR(12);                # NORMAL SEVERITY IS NON-FATAL      #
        END 
      ELSE
        BEGIN 
        DB$ERSO = DFERSOT;         # SEVERITY LEVEL IS TRIVIAL         #
        DB$ERR(12); 
        END 
      DB$POP(DB$FTEX);
      END 
      TERM
