*DECK DB$BERR 
USETEXT BRGENTX 
      PROC DB$BERR(ERRNUM); 
      BEGIN 
 #
* *   DB$BERR - DBREC ERROR PROCESSOR            PAGE  1
* *   E. P. JOHNSON                              DATE  01/13/81 
* * 
* 
* DC  PURPOSE 
* 
*     TO CONTROL THE FORMATTING OF THE ERROR MESSAGE TEXT AND TO WRITE
*     THAT TEXT TO ITS DESIGNATED LOCATION. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM ERRNUM I;                   # ERROR NUMBER.                 #
# 
* D   ASSUMPTIONS 
* 
*     COMMON ITEMS: 
*       CDCSFLG              THE CDCS FLAG HAS BEEN SET TO TRUE IF THIS 
*                            IS A CDCS INITIATED JOB. 
* 
*     THE FORMAT OF THE ERROR MESSAGE TABLE, DB$BETX, CORRESPONDS TO THE
*     FORMAT OF THE MSGTABLE BASED ARRAY. 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL - THE ERROR MESSAGE TEXT HAS BEEN FORMATTED AND WRITTEN TO 
*              THE DBREC OUTPUT FILE. IF THE ERROR IS FATAL OR THE CDCS 
*              FLAG IS TRUE, THEN THE ERROR MESSAGE IS WRITTEN TO THE 
*              DBREC DAYFILE AND THE ABORT FLAG IS SET TO TRUE. 
* 
*     ABNORMAL - IF THE ERROR NUMBER IS NOT IN THE ERROR TABLE, THEN
*                DBREC IS ABORTED BECAUSE THIS IS AN INTERNAL ERROR.
* 
* DC  CALLING ROUTINES
* 
*     DB$BALJ                ALLOCATE THE JOURNAL LOG FILE(S).
*     DB$BALQ                ALLOCATE THE QUICK RECOVERY FILE.
*     DB$BALR                ALLOCATE THE RESTART IDENTIFIER FILE.
*     DB$BALT                ALLOCATE THE TRANSACTION RECOVERY FILE(S). 
*     DB$BDLG                DUMP THE JOURNAL LOG FILE TO TAPE. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$BFTX;               # FORMAT THE MESSAGE TEXT.      #
      XREF PROC DB$BUNT;               # DBREC INTERNAL ERROR PROCESSOR#
      XREF FUNC DB$CDIS C(10);         # CONVERT NUMBER TO DISPLAY CODE#
      XREF PROC DB$EPRT;               # WRITE A STRING TO THE OUTPUT  #
                                       # FILE.                         #
      XREF PROC DB$MSG;                # WRITE A STRING TO THE DAYFILE.#
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     COMMON ITEMS: 
*       ABORT                THE ABORT FLAG.
*       ERRCNT               THE ERROR COUNT. 
* 
* DC  DESCRIPTION 
* 
*     - SET THE POINTER OF THE MESSAGE TABLE BASED ARRAY TO THE 
*       LOCATION OF THE ERROR TABLE.
* 
*     - SEARCH THE ERROR TABLE FOR THE DESIGNATED ERROR MESSAGE BY
*       COMPARING THE GIVEN ERROR NUMBER WITH THE NUMBERS IN THE TABLE. 
* 
*     - IF THE ERROR NUMBER IS NOT IN THE TABLE, THEN ABORT DBREC 
*       BECAUSE THIS IS AN INTERNAL ERROR.
* 
*     - INSERT THE ERROR NUMBER INTO THE MESSAGE BUFFER AND SET TOINDEX 
*       TO THE STARTING CHARACTER POSITION OF THE MESSAGE TEXT. 
* 
*     - FORMAT THE MESSAGE TEXT.
* 
*     - IF THE ERROR IS FATAL OR THE CDCS FLAG IS TRUE, THEN WRITE THE
*       MESSAGE TO THE DBREC DAYFILE AND SET THE ABORT FLAG TO TRUE 
*       TO STOP THE EXECUTION OF ANY FURTHER DIRECTIVES.
* 
*     - INSERT THE CARRIAGE CONTROL CHARACTER INTO THE MESSAGE BUFFER 
*       TO DOUBLE SPACE THE MESSAGE ON THE DBREC OUTPUT FILE. 
* 
*     - WRITE THE MESSAGE TO THE DBREC OUTPUT FILE. 
* 
*     - RETURN TO THE CALLER. 
* 
 #
  
# EXTERNALLY REFERENCED ARRAYS.                                        #
  
      XREF ARRAY DB$BETX;;             # ERROR MESSAGE TEXT ARRAY.     #
  
# LOCAL VARIABLES.                                                     #
  
      ITEM FOUND B;                    # ERROR NUMBER FOUND FLAG.      #
      ITEM I I;                        # LOOP VARIABLE.                #
      ITEM TOINDEX I;                  # CHARACTER POSITION IN THE     #
                                       # MESSAGE BUFFER.               #
      ARRAY MESSAGE [0:0] S(DFMSGBUFLENW);
                                       # MESSAGE BUFFER.               #
        BEGIN 
        ITEM MESBUF C(00,00,DFMSGBUFLENC);
        END 
*CALL BMGTBDCLS 
  
  
# S T A R T   O F   D B $ B E R R   E X E C U T A B L E   C O D E      #
  
  
# SET THE POINTER OF THE MESSAGE TABLE BASED ARRAY TO THE LOCATION     #
# OF THE ERROR TABLE.                                                  #
  
      P<MSGTABLE> = LOC(DB$BETX); 
  
# SEARCH THE ERROR TABLE FOR THE DESIGNATED ERROR MESSAGE, BY COMPARING#
# THE GIVEN ERROR NUMBER WITH THE NUMBERS IN THE TABLE.                #
  
      FOUND = FALSE;                   # INITIALIZE FOUND TO FALSE.    #
  
      FOR I=I 
        WHILE MSGNUM[0] NQ 0
         AND NOT FOUND
      DO
        BEGIN 
  
# IF THE ERROR NUMBER EQUALS THE MESSAGE NUMBER, THEN SET FOUND        #
# TO TRUE. ELSE, SET THE POINTER OF THE MESSAGE TABLE BASED ARRAY TO   #
# THE NEXT TABLE ENTRY.                                                #
  
        IF ERRNUM EQ MSGNUM[0]
        THEN
          BEGIN 
          FOUND = TRUE; 
          END 
        ELSE
          BEGIN 
          P<MSGTABLE> = P<MSGTABLE> + MSGELENW[0];
          END 
        END 
  
# IF THE ERROR NUMBER IS NOT IN THE TABLE, THEN ABORT DBREC BECAUSE    #
# THIS IS AN INTERNAL ERROR.                                           #
  
      IF NOT FOUND
      THEN
        BEGIN 
        DB$BUNT(" DB$BERR-1");
  
        END 
  
      ERRCNT = ERRCNT + 1;             # INCREMENT THE ERROR COUNTER.  #
  
# INSERT THE ERROR NUMBER INTO THE MESSAGE BUFFER AND SET TOINDEX TO   #
# THE STARTING CHARACTER POSITION OF THE MESSAGE TEXT.                 #
  
      MESBUF[0] = " ";
  
      C<1,3>MESBUF[0] = DB$CDIS(MSGNUM[0],3,10,"0");
  
      C<5,1>MESBUF[0] = "-";
  
      TOINDEX = 7;
  
# FORMAT THE MESSAGE TEXT.                                             #
  
      DB$BFTX(P<MSGTABLE>,MESSAGE,TOINDEX); 
  
# IF THE ERROR IS FATAL OR THE CDCS FLAG IS TRUE, THEN WRITE THE       #
# MESSAGE TO THE DBREC DAYFILE AND SET THE ABORT FLAG TO TRUE TO STOP  #
# THE EXECUTION OF ANY FURTHER DIRECTIVES.                             #
  
      IF MSGFNFE[0] OR CDCSFLG
      THEN
        BEGIN 
        DB$MSG(MESBUF[0]);
        ABORT = TRUE; 
        END 
  
# INSERT THE CARRIAGE CONTROL CHARACTER INTO THE MESSAGE BUFFER TO     #
# DOUBLE SPACE THE MESSAGE ON THE DBREC OUTPUT FILE.                   #
  
      C<0,1>MESBUF[0] = "0";
  
# WRITE THE MESSAGE TO THE DBREC OUTPUT FILE. THE LENGTH OF THE MESSAGE#
# IS RETURNED IN TOINDEX BY THE TEXT FORMATTER, DB$BFTX.               #
  
      DB$EPRT(MESBUF[0],TOINDEX); 
  
# RETURN TO THE CALLER.                                                #
  
      RETURN; 
  
      END 
      TERM
