*DECK DB$AREH 
USETEXT CDCSCTX 
      PROC DB$AREH( ( ARERRBLK ) ); 
      BEGIN 
 #
* *   DB$AREH - AUTO RECOVERY ERROR HANDLER      PAGE  1
* *   ALICE WONG                                 DATE  03/27/81 
* 
* DC  PURPOSE 
* 
*     TO PUT MESSAGES ON THE DAYFILE AND THE CDCS OUTPUT FILE 
*     CONCERNING ERRORS ENCOUNTERED DURING AUTO RECOVERY
*     INITIALIZATION. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     THE ACTUAL PARAMETER MUST BE THE LOCATION OF THE ARRAY, NOT 
*     THE ARRAY ITSELF. 
# 
      ITEM ARERRBLK;              # LOC OF AUTO RECOVERY ERROR BLOCK   #
# 
* D   ASSUMPTIONS 
* 
*     - AN ERROR HAS OCCURED
*     - THE ERROR NUMBER IN THE ERROR BLOCK MUST BE FILLED
*     - SALX SET FOR THE SCHEMA INVOLVED
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT - THE PROPER MESSAGE IS ON THE DAYFILE AND CDCS 
*                   OUTPUT FILE.
* 
*     ABNORMAL EXIT - DB$PUNT IS CALLED AND CDCS ABORTED, IF ILLEGAL
*                     ERROR NUMBER OR ILLEGAL INSERTION TYPE IS FOUND.
* 
* DC  CALLING ROUTINES
* 
*     DB$CARS                     AUTO RECOVERY CONTROLLER. 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK   C(10);    # GET CURRENT TIME                   #
      XREF FUNC DB$CDEC C(10);    # CONVERT BINARY TO DECIMAL DISPLAY  #
      XREF FUNC DB$COCT C(10);    # CONVERT BINARY TO OCTAL DISPLAY    #
      XREF PROC DB$FLOP;          # GENERATE FLOW POINT                #
      XREF PROC DB$LINE;          # WRITE MESSAGE TO CDCS OUTPUT FILE  #
      XREF PROC DB$MSG;           # SEND AN ERROR MESSAGE TO DAYFILE   #
      XREF PROC DB$PUNT;          # INTERNAL ERROR PROCESSOR           #
# 
*     INTERNAL PROCS
*       PROC INSERT               - ADD INSERTION INTO ERROR TEXT - 
*       PROC PRTMSG               - PRINT MESSAGE TO OUTPUT & DAYFILE - 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     - GET THE CORRECT ERROR MESSAGE TEXT BY COMPARING THE ERROR 
*       NUMBER FROM THE ERROR BLOCK WITH THE ERROR NUMBER IN THE
*       ERROR TEXT TABLE. 
* 
*     - SCANNING THE ERROR MESSAGE TEXT, IF THE CHARACTER IS: 
*       ..NOT AN INSERTING TYPE CHARACTER--MOVE IT TO TARGET MESSAGE. 
*       ..INSERTION CHAR "'"--THEN IF THE NEXT CHAR IS: 
*         "A"--INSERT SYSTEM FILE TYPE. 
*         "B"--INSERT FUNCTION TYPE.
*         "C"--INSERT ERROR NUMBER ASSOCIATED WITH ATTACH, CIO, OR CRM. 
*         "D"--INSERT AREA ID.
*         "E"--INSERT VERSION NAME. 
* 
*     - LIST THE TARGET MESSAGE ON CDCS OUTPUT FILE.
* 
*     - SEND THE TARGET MESSAGE (MINUS THE TIME STAMP AND THE TEXT
*       "CDCS") TO THE DAYFILE. 
*     - IF NOT SYSTEM RECOVERY AND PRINT SCHEMA FLAG (ERRSCH) IS ON 
*       THEN PRINT THE SCHEMA NAME TO CDCS OUTPUT FILE AND DAYFILE. 
 #
  
# 
*     NON-LOCAL VARIABLE REFERENCED 
# 
      XREF ARRAY DB$AREM; ;       # AUTO RECOVERY ERROR MESSAGE TEXTS  #
# 
*     COMDECK SRERRDCLS -- COMDECK FOR ERROR PARAMETER BLOCK
# 
*CALL SRERRDCLS 
# 
*     LOCAL DEFS
# 
      DEF DFBEGPOS    #22#;       # BEG POSITION OF TEXT WITHIN ERROR  #
                                  # MESSAGE BUFFER.                    #
      DEF DFINSERTLEN #30#;       # MAX LENGTH OF TEXT IN CHARACTERS   #
                                  # TO BE INSERTED                     #
# 
*     LOCAL VARIABLES 
# 
      ITEM CLOCKP       C(10);    # PARAMETER FOR CLOCK CALL           #
      ITEM FOUNDERROR       B;    # FLAG FOR ERROR NUMBER FOUND        #
      ITEM FROMINDEX        I;    # INDEX IN MSG TEXT                  #
      ITEM FTYP             I;    # FILE TYPE                          #
      ITEM FUNCTN           I;    # FUNCTION TYPE                      #
      ITEM INDEX            I;    # FOR LOOP INDEX                     #
      ITEM INSERTTYPE    C(1);    # TYPE OF INSERT                     #
      ITEM STARTINSERT      B;    # TRUE IF "'" IS FOUND               #
      ITEM TOINDEX          I;    # INDEX INTO FORMED MESSAGE          #
  
  
      BASED ARRAY ERRTXT;         # ERROR TEXT AS DEFINED IN DB$AREM   #
        BEGIN 
        ITEM ERRNO  U(00,00,09);  # ERROR NUMBER                       #
        ITEM ERRSCH B(00,32,01);  # =T IF SCHEMA NAME SHOULD BE PRINT#
        ITEM ERRCL  I(00,33,09);  # LENGTH OF TEXT IN CHARS - 1        #
        ITEM ERRWL  I(00,42,18);  # LENGTH OF TEXT IN WORDS + 1        #
        ITEM ERRMT  C(01,00,60);  # TEXT OF ERROR MESSAGE              #
        END 
  
      ARRAY FUNCT [0:DFSREMXFN] S(4);  # FUNCTION TYPE                 #
        BEGIN 
        ITEM FUNTYPE C(00,00,40) = ["*********:", 
                                    "ATTACH:",
                                    "I/O (CIO):", 
                                    "I/O (CRM):", 
                                    "FDL LOAD:",
                                    "QUICK RECOVERY FILE APPLICATION:", 
                                    "ROLL FORWARD:",
                                    "ROLL BACK:"];
        END 
  
      ARRAY MSGARRAY S(12);       # BUFFER FOR BUILDING ERROR TEXT     #
        BEGIN 
        ITEM MSG C(00,00,120);
        END 
  
      ARRAY SYSFLTYPE [0:DFSREMXFL] S(3);  # SYSTEM FILE TYPE          #
        BEGIN 
        ITEM SYSTYPE C(00,00,30) = ["*******************:", 
                                    "PROCEDURE LIB FILE:",
                                    "JOURNAL LOG FILE:",
                                    "QUICK RECOVERY FILE:", 
                                    "TRANSACTION RECOVERY FILE:", 
                                    "RESTART IDENTIFIER FILE:", 
                                    "DATABASE AREA FILE:"]; 
        END 
      CONTROL EJECT;
      PROC INSERT(INTXT); 
      BEGIN 
 #
* *   DB$AREH                                    PAGE  1
* *   INSERT - ADDS INSERTION MESSAGE INTO THE
* *            ERROR MESSAGE TEXT.
* *   ALICE WONG                                 DATE  03/27/81 
* 
* DC  PURPOSE 
* 
*     TO INSERT THE TEXT PASSED IN THE PARAMETER -INTXT- INTO THE 
*     ERROR MESSAGE TEXT AT THE CHARACTER POSITION POINTED TO 
*     BY -TOINDEX-. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM INTXT C(DFINSERTLEN);  # TEXT TO BE INSERTED INTO ERROR MSG #
# 
* D   ASSUMPTIONS 
* 
*     -MSG- IS THE BUFFER FOR TEXT TO BE INSERTED.
*     -TOINDEX- CONTAINS THE STARTING CHARACTER POSITION WHERE THE
*     TEXT TO BE INSERTED SHOULD START. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE INSERTION TEXT IS INSERTED AND -TOINDEX- POINTS TO THE END
*     OF THE INSERTION TEXT.
* 
* DC  CALLING ROUTINES
* 
*     DB$AREH                     AUTO RECOVERY ERROR HANDLER 
*     PRTMSG                      PRINT MESSAGE TO OUTPUT & DAYFILE 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     MSG                         BUFFER FOR ERROR MESSAGE TEXT.
*     TOINDEX                     CHARACTER POSITION POINTER FOR MSG. 
* 
* DC  DESCRIPTION 
* 
*     - FIND OUT THE LENGTH OF THE TEXT TO BE INSERTED BY 
*       SCANNING THE INSERTION TEXT -INTXT- FOR THE CHARACTER 
*       ":".
* 
*     - IF ":" IS NOT FOUND WHEN THE MAX LENGTH ALLOWED FOR INSERTION 
*       TEXT (DFINSERTLEN) HAS BEEN SCANNED, THE LENGTH IS ASSUMED TO 
*       BE THE MAX LENGTH ALLOWED (I.E. =DFINSERTLEN).
* 
*     - THE INSERTION TEXT IS THEN COPIED TO THE BUFFER OF
*       THE ERROR MESSAGE TEXT (MSG). 
* 
*     - THE CHARACTER POSITION POINTER (TOINDEX) IS THEN UPDATED TO 
*       POINT TO THE POSITION AFTER THE INSERTION TEXT. 
* 
 #
  
# 
*     LOCAL VARIABLES 
# 
        ITEM IDX  I;              # FOR LOOP INDEX                     #
        ITEM INSERTLEN I;         # LENGTH OF INSERTION TEXT           #
  
# 
*     S T A R T   O F   I N S E R T   E X E C U T A B L E   C O D E 
# 
  
        INSERTLEN = 0;
  
# 
*       LOOK FOR CHARACTER = ":" AS INDICATION OF END OF INSERTION. 
# 
        FOR IDX = 0 STEP 1
          WHILE (IDX LS DFINSERTLEN)
          AND (INSERTLEN EQ 0)
        DO
          BEGIN 
  
          IF C<IDX,1>INTXT EQ ":" 
          THEN
            BEGIN 
            INSERTLEN = IDX;
            END 
  
          END 
  
# 
*       ":" NOT FOUND, MAX LENGTH ASSUMED.
# 
        IF INSERTLEN EQ 0 
        THEN
          BEGIN 
          INSERTLEN = DFINSERTLEN;
          END 
  
# 
*       MOVE INSERTION INTO ERROR TEXT. 
# 
        C<TOINDEX,INSERTLEN>MSG = C<0,INSERTLEN>INTXT;
        TOINDEX = TOINDEX + INSERTLEN;
        RETURN; 
  
        END 
      CONTROL EJECT;
      PROC PRTMSG;
        BEGIN 
 #
* *   DB$AREH                                    PAGE  1
* *   PRTMSG - PRINTS MESSAGE TO OUTPUT FILE
* *            AND DAYFILE. 
* *   ALICE WONG                                 DATE  08/20/81 
* 
* DC  PURPOSE 
* 
*     TO PRINT THE ERROR MESSAGE TO OUTPUT FILE AND DAYFILE.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     THE ERROR MESSAGE IS IN ERRTXT AND TOINDEX POINTS TO
*     END OF TEXT.
* 
* DC  EXIT CONDITIONS 
* 
*     THE ERROR MESSAGE IS PRINTED BOTH ON OUTPUT FILE AND DAYFILE. 
* 
* DC  CALLING ROUTINES
* 
*     DB$AREH                     AUTO RECOVERY ERROR HANDLER 
* 
* DC  CALLED ROUTINES 
* 
*     DB$LINE                     WRITE MESSAGE TO CDCS OUTPUT FILE 
*     DB$MSG                      SEND AN ERROR MESSAGE TO DAYFILE
* DC  NON LOCAL VARIABLES MODIFIED
* 
*     INDEX                       FOR LOOP INDEX
*     MSG                         BUFFER FOR ERROR MESSAGE TEXT 
*     TOINDEX                     CHARACTER POSITION POINTER FOR MSG
*     ERRTXT                      ERROR TEXT
* 
* DC  DESCRIPTION 
* 
*     - PRINT MESSAGE TO OUTPUT FILE
*     - PRINT MESSAGE TO DAYFILE
* 
 #
  
# 
*       PRINT MESSAGE TO OUTPUT FILE
# 
        DB$LINE(MSGARRAY,TOINDEX);
  
# 
*       TERMINATE MESSAGE WITH 11 CHARACTERS OF BINARY ZERO.
*       THIS INSURES LOWER 12 BIT BYTES OF CM WORD IS ZERO FILLED.
# 
  
        INDEX = TOINDEX + 11; 
        FOR TOINDEX = TOINDEX STEP 1
          UNTIL INDEX 
        DO
          BEGIN 
          C<TOINDEX,1>MSG = 0;
          END 
  
# 
*       ONLY THE ERROR MESSAGE IS SENT TO THE DAYFILE, THE TIME 
*       STAMP AND THE TEXT "CDCS" ARE SKIPPED.
# 
  
        P<ERRTXT> = LOC(MSGARRAY) + 2;
        DB$MSG(ERRTXT); 
        END 
CONTROL EJECT;
  
# 
*     S T A R T   O F   D B $ A R E H   E X E C U T A B L E   C O D E.
# 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("AREH   "); 
      CONTROL ENDIF;
  
      P<SRERRBLK> = ARERRBLK; 
      P<ERRTXT> = LOC(DB$AREM); 
      FOUNDERROR = FALSE; 
# 
*     FIND ERROR IN ERROR TEXT TABLE, IF NOT FOUND, CDCS INTERNAL ERROR.
# 
      FOR INDEX = INDEX 
        WHILE (ERRNO[0] NQ 0) 
        AND (NOT FOUNDERROR)
      DO
        BEGIN 
  
        IF SRENUMB[0] EQ ERRNO[0] 
        THEN
          BEGIN 
          FOUNDERROR = TRUE;
          END 
        ELSE
          BEGIN 
          P<ERRTXT> = LOC(ERRTXT) + ERRWL[0]; 
          END 
  
        END 
  
  
      IF NOT FOUNDERROR 
      THEN
        BEGIN 
        DB$PUNT("DB$AREH  1");    # CDCS ABORTED, NOT RETURNED         #
  
        END 
  
# 
*     ERROR NUMBER FOUND, BLANK FILL MESSAGE BUFFER.
# 
      MSG[0] = " "; 
      TOINDEX = DFBEGPOS; 
  
# 
*     TRANSFER ERROR TEXT FROM TABLE TO MSG BUFFER WHILE
*     ADDING INSERTS. 
# 
      STARTINSERT = FALSE;        # PRESET -START INSERT- FALSE        #
  
      FOR FROMINDEX = 0 STEP 1
        UNTIL ERRCL[0]
      DO
        BEGIN 
  
        IF NOT STARTINSERT
        THEN                      # LAST CHAR IS NOT "'"               #
          BEGIN 
  
          IF C<FROMINDEX,1>ERRMT[0] NQ "'"
          THEN                    # INSERT CHAR INTO TARGET MESSAGE    #
                                  # IF NOT AN INSERTION TYPE CHAR.     #
            BEGIN 
            C<TOINDEX,1>MSG = C<FROMINDEX,1>ERRMT[0]; 
            TOINDEX = TOINDEX + 1;
            END 
          ELSE
            BEGIN 
            STARTINSERT = TRUE;   # "'" FOUND, NEXT CHAR SPECIFIES     #
            END                   # INSERTION TYPE.                    #
  
          END 
  
        ELSE                      # LAST CHAR IS "'", START INSERTION  #
  
          BEGIN 
  
          STARTINSERT = FALSE;    # CLEAR START INSERTION FLAG         #
          INSERTTYPE = C<FROMINDEX,1>ERRMT[0];
  
# 
*         IF "A" TYPE INSERTION THEN
*           INSERT SYSTEM FILE TYPE FROM ARRAY SYSFLTYPE. 
# 
          IF INSERTTYPE EQ "A"
          THEN
            BEGIN 
            FTYP = SREFTYP[0];
            IF FTYP GR DFSREMXFL
            THEN
              BEGIN 
              FTYP = 0; 
              END 
            INSERT(SYSTYPE[FTYP]);
            TEST FROMINDEX; 
  
            END 
# 
*         IF "B" TYPE INSERTION THEN
*           INSERT FUNCTION TYPE FROM ARRAY FUNCT.
# 
          IF INSERTTYPE EQ "B"
          THEN
            BEGIN 
            FUNCTN = SREFUNC[0];
            IF FUNCTN GR DFSREMXFN
            THEN
              BEGIN 
              FUNCTN = 0; 
              END 
            INSERT(FUNTYPE[FUNCTN]);
            TEST FROMINDEX; 
  
            END 
# 
*         IF "C" TYPE INSERTION THEN
*           INSERT ERROR ASSOCIATED WITH ATTACH/CIO/CRM AS PASSED 
*           IN ERROR BLOCK. 
# 
          IF INSERTTYPE EQ "C"
          THEN
            BEGIN 
            C<TOINDEX,3>MSG = DB$COCT(ABS(SREFPAR[0]),3); 
            TOINDEX = TOINDEX + 3;
            TEST FROMINDEX; 
  
            END 
# 
*         IF "D" TYPE INSERTION THEN
*           INSERT AREA ID PASSED IN ERROR BLOCK. 
# 
          IF INSERTTYPE EQ "D"
          THEN
            BEGIN 
            C<TOINDEX,4>MSG =  DB$CDEC(SREARID[0],4); 
            TOINDEX = TOINDEX + 4;
            TEST FROMINDEX; 
  
            END 
# 
*         IF "E" TYPE INSERTION THEN
*           INSERT VERSION NAME PASSED IN ERROR BLOCK.
# 
          IF INSERTTYPE EQ "E"
          THEN
            BEGIN 
            C<TOINDEX,7>MSG = SREVRNM[0]; 
            TOINDEX = TOINDEX + 6;
            FOR INDEX = INDEX 
              WHILE C<TOINDEX,1>MSG EQ " "
            DO
              BEGIN 
              TOINDEX = TOINDEX - 1;
              END 
            TOINDEX = TOINDEX + 1;
            TEST FROMINDEX; 
  
            END 
# 
*         ILLEGAL INSERTION TYPE         PUNT = 2 
# 
  
          DB$PUNT("DB$AREH  2");  # CDCS ABORTED, NOT RETURNED         #
  
          END 
  
        END                       # FOR FROMINDEX = 0 STEP 1           #
  
# 
*     PRINT ERROR MESSAGE.
# 
      C<15,4>MSG[0] = "CDCS"; 
      C<0,10>MSG[0] = CLOCK(CLOCKP);
      PRTMSG; 
  
# 
*     IF NOT SYSTEM RECOVERY AND PRINT SCHEMA FLAG IS ON, 
*     THEN PRINT SCHEMA NAME. 
# 
  
      IF (NOT SYSRECOVERY)
        AND ERRSCH[0] 
      THEN
        BEGIN 
        C<0,22>MSG = "                      ";
        C<DFBEGPOS,8>MSG = " SCHEMA ";
        TOINDEX = 30; 
        INSERT(SASCNAME[SALX]); 
        PRTMSG; 
        END 
  
  
      END 
  
      TERM
