*DECK DB$DIAG                                                            DIAG 
USETEXT SCANTXT 
USETEXT MDDEFTX 
USETEXT MDBCMTX 
      PROC DB$DIAG (DIAGNUM,DIAGINF);                                    DIAG 
 #                                                                       DIAG 
  *   DB$DIAG - ISSUES DIAGNOSTIC MESSAGE        PAGE  1                 DIAG 
  *   J. JAN JANIK                               DATE  12/03/75          DIAG 
  DC  PURPOSE                                                            DIAG 
                                                                         DIAG 
      TO ISSUE THE DIAGNOSTIC MESSAGE SPECIFIED BY THE INPUT PARAMETER.  DIAG 
                                                                         DIAG 
  DC  ENTRY CONDITIONS                                                   DIAG 
                                                                         DIAG 
      DIAGNUM = DIAGNOSTIC NUMBER                                        DIAG 
      DIAGINF = INFORMATION TO BE INSERTED IN THE MESSAGE                DIAG 
                                                                         DIAG 
  DC  EXIT CONDITIONS                                                    DIAG 
                                                                         DIAG 
      DIAGNOSTIC MESSAGE HAS BEEN ISSUED.                                DIAG 
      ERRCNT = ERRCNT + 1.                                               DIAG 
      IF ERRCNT EXCEEDS DFERRLMT, EXIT TO DB$MABT, ELSE RETURN TO CALLER DIAG 
                                                                         DIAG 
  DC  CALLING ROUTINES                                                   DIAG 
                                                                         DIAG 
      SEMANTIC ROUTINES AND STD.                                         DIAG 
 #                                                                       DIAG 
      BEGIN                                                              DIAG 
                             # SUPPRESS LISTING FOR DECLARATIONS FOR     JJJ0105
                               COMMON DB$MDBC, FOR DB$MABT ABORT CODES   DIAG 
                               AND FOR SCANNER EXTERNALS.              # DIAG 
      CONTROL NOLIST;                                                    JJJ0105
*CALL MDABTDCLS                                                          DIAG 
      CONTROL LIST;                                                      DIAG 
                                                                         DIAG 
      DEF DFNASTYLN #39#;  # LENGTH OF NASTYMSG     #                    DIAG 
                                                                         DIAG 
      XREF                                                               DIAG 
        BEGIN                                                            DIAG 
 #                                                                       DIAG 
                                                                         DIAG 
  DC  CALLED ROUTINES                                                    DIAG 
#                                                                        DIAG 
        PROC DB$MABT;        # ABORT THE RUN                           # DIAG 
        PROC DB$EPRT;        # PRINT THE STRING                        # DIAG 
                                                                         DIAG 
        FUNC DB$CDEB C(10);  # CONVERT INTEGER TO DECIMAL - BLANK FILL #
        FUNC DB$COCB C(10);  # CONVERT INTEGER TO OCTAL - BLANK FILL   #
#                                                                        DIAG 
  DC  NON-LOCAL VARIABLES                                                DIAG 
#                                                                        DIAG 
        ITEM DB$LNBR C(10);  # DISPLAY CODED LINE NUMBER               # JJJ1230
                                                                         DIAG 
        ARRAY DB$DADD S(1);  # CONTAINS MESSAGE POINTER PAIRS          # DIAG 
          BEGIN                                                          DIAG 
#     TYPE, CHARACTER COUNT AND RELATIVE ADDRESS OF EVEN NUMBERED MSG  # DIAG 
          ITEM ERRTYPEV U(0,0,4);                                        DIAG 
          ITEM NUMCHREV U(0,4,8);                                        DIAG 
          ITEM MSGADDEV U(0,12,18);                                      DIAG 
                                                                         DIAG 
#     TYPE, CHARACTER COUNT AND RELATIVE ADDRESS OF ODD NUMBERED MSG   # DIAG 
          ITEM ERRTYPOD U(0,30,4);                                       DIAG 
          ITEM NUMCHROD U(0,34,8);                                       DIAG 
          ITEM MSGADDOD U(0,42,18);                                      DIAG 
          END                                                            DIAG 
        ARRAY DB$RA0 S(1);   # USED TO CONSTRUCT RELATIVE ADDR         # DIAG 
          BEGIN                                                          DIAG 
          ITEM RELADDR0 C(0,0,140);                                      DIAG 
          END                                                            DIAG 
#     IN ADDITION, SCANNER EXTERNALS DB$NLNG, DB$CLNG, NEXWORDC,         DIAG 
      CURWORDC AND ERRCNT WITHIN 0,0 COMMON ARE USED.                    DIAG 
 #                                                                       DIAG 
        END                                                              DIAG 
                                                                         DIAG 
#     FORMAL PARAMETERS #                                                DIAG 
                                                                         DIAG 
      ITEM DIAGNUM I;        # ERROR NUMBER, 100 AND UP                # DIAG 
                                                                         DIAG 
      ARRAY DIAGINF;                                                     DIAG 
        BEGIN                                                            DIAG 
        ITEM DIAGINFC1 C(0,0,10);  # USED IF INFO IS 10 CHAR STRING    # DIAG 
        ITEM DIAGINFC3 C(0,0,30);  # USED IF INFO IS 30 CHAR STRING    # DIAG 
        ITEM DIAGINFU  C(0,0,60);  # USED IF INFO IS INTEGER           # DIAG 
        END                                                              DIAG 
                                                                         DIAG 
#     LOCAL ITEMS   #                                                    DIAG 
                                                                         DIAG 
      ITEM BUFINDX I;        # INDEX INTO MBUF                         # DIAG 
      ITEM ERRINDX;          # INDEX INTO DB$DADD                      # DIAG 
      ITEM ERRTYP U;         # TYPE OF CURRENT MESSAGE                 # DIAG 
      ITEM INDEX I;          # INDEX INTO MESSAGE                      # DIAG 
      ITEM IX I;             # INDEX FOR LOOP                          # DIAG 
      ITEM MBUF C(140);      # BUFFER FOR MESSAGE                      # DIAG 
      ITEM MSGADDR U;        # REL ADDR FOR CURRENT MSG                # DIAG 
      ITEM MVLEN I;          # NUMBER OF CHARACTERS TO MOVE OR MOVED   # DIAG 
      ITEM NUMCHAR I;        # NUMBER OF CHARACTERS IN CURRENT MSG     # DIAG 
                                                                         DIAG 
      ARRAY NASTYMSG S(4);   # USED IF ERRTYP IS WRONG                 # DIAG 
        BEGIN                                                            DIAG 
        ITEM NMSG1 C(0,0,37)=[" ERR MSG WHICH FOLLOWS HAS TYPE CODE="];  DIAG 
        ITEM NASTYTYP C(3,42,2);                                         DIAG 
        END                                                              DIAG 
                                                                         DIAG 
#     THE SWITCH INTEXTYP IS USED TO JUMP TO THE PROPER PROCESSING       DIAG 
      ROUTINE TO INSERT TEXT INTO THE MESSAGE.  THE JUMP IS BASED ON THE DIAG 
      VALUE OF ERRTYP WHOSE SOURCE IS A 4-BIT FIELD.                     DIAG 
#                                                                        DIAG 
      SWITCH INTEXTYP  TYPE0,    # ERRTYP=0 - INSERT NEXT WORD         # DIAG 
                       TYPE1,    # ERRTYP=1 - INSERT CURRENT WORD      # DIAG 
                       TYPE2,    # ERRTYP=2 - INSERT VARIABLE STRING   # DIAG 
                       TYPE3,    # ERRTYP=3 - INSERT DECIMAL NUMBER # 
                       TYPE4,    # ERRTYP=4 - INSERT OCTAL NUMBER # 
                       TYPE5,    # ERRTYP=5 - INSERT 10 CHAR           # DIAG 
                       BADTYPE,  # ERRTYP=6 - ISSUE NASTY MESSAGE      # DIAG 
                       BADTYPE,  # ERRTYP=7 - ISSUE NASTY MESSAGE      # DIAG 
                       BADTYPE,  # ERRTYP=8 - ISSUE NASTY MESSAGE      # DIAG 
                       BADTYPE,  # ERRTYP=9 - ISSUE NASTY MESSAGE      # DIAG 
                       BADTYPE,  # ERRTYP=10 - ISSUE NASTY MESSAGE     # DIAG 
                       BADTYPE,  # ERRTYP=11 - ISSUE NASTY MESSAGE     # DIAG 
                       BADTYPE,  # ERRTYP=12 - ISSUE NASTY MESSAGE     # DIAG 
                       BADTYPE,  # ERRTYP=13 - ISSUE NASTY MESSAGE     # DIAG 
                       BADTYPE,  # ERRTYP=14 - ISSUE NASTY MESSAGE     # DIAG 
                       BADTYPE;  # ERRTYP=15 - ISSUE NASTY MESSAGE     # DIAG 
      CONTROL EJECT;                                                     DIAG 
 #                                                                       DIAG 
                                                                         DIAG 
  DC  DESCRIPTION                                                        DIAG 
                                                                         DIAG 
      START OF EXECUTABLE CODE FOR DB$DIAG.  BUMP ERRCNT, CALCULATE      DIAG 
      INDEX INTO DB$DADD, AND EXTRACT TYPE, CHAR CNT AND REL ADDR OF MSG DIAG 
 #                                                                       DIAG 
      ERRCNT = ERRCNT + 1;                                               DIAG 
      ERRINDX = (DIAGNUM - 100) / 2;                                     DIAG 
 #
      SET FLAG TO INDICATE SCHEMA LEVEL ERROR 
 #
      SCFATAL = 1;
                                                                         DIAG 
      IF B<59,1> DIAGNUM EQ 0  # SEE IF MSG NUM IS ODD OR EVEN         # DIAG 
        THEN                   # EVEN  #                                 DIAG 
        BEGIN                                                            DIAG 
        ERRTYP = ERRTYPEV[ERRINDX];                                      DIAG 
        NUMCHAR = NUMCHREV[ERRINDX];                                     DIAG 
        MSGADDR = MSGADDEV[ERRINDX];                                     DIAG 
        END                                                              DIAG 
                                                                         DIAG 
        ELSE                   # ODD   #                                 DIAG 
        BEGIN                                                            DIAG 
        ERRTYP = ERRTYPOD[ERRINDX];                                      DIAG 
        NUMCHAR = NUMCHROD[ERRINDX];                                     DIAG 
        MSGADDR = MSGADDOD[ERRINDX];                                     DIAG 
        END                                                              DIAG 
 #                                                                       DIAG 
      MOVE MESSAGE NUMBER AND LINE NUMBER TO MESSAGE BUFFER.             DIAG 
 #                                                                       DIAG 
      C<0,10>MBUF = C<0,10>RELADDR0[MSGADDR];                            DIAG 
      C<10,10>MBUF = DB$LNBR;                                            DIAG 
 #                                                                       DIAG 
      MOVE REST OF MESSAGE UNTIL INSERTION CHARACTER IS ENCOUNTERED      DIAG 
 #                                                                       DIAG 
      BUFINDX = 20;                                                      DIAG 
      INDEX = 10;                                                        DIAG 
      FOR IX = 1 WHILE INDEX LS NUMCHAR AND                              DIAG 
                                    C<INDEX> RELADDR0[MSGADDR] NQ "'" DO DIAG 
        BEGIN                                                            DIAG 
        C<BUFINDX>MBUF = C<INDEX>RELADDR0[MSGADDR];                      DIAG 
        BUFINDX = BUFINDX + 1;                                           DIAG 
        INDEX = INDEX + 1;                                               DIAG 
        END                                                              DIAG 
                                                                         DIAG 
 #                                                                       DIAG 
      SEE IF MESSAGE MOVE IS COMPLETE.                                   DIAG 
 #                                                                       DIAG 
      IF INDEX NQ NUMCHAR                                                DIAG 
        THEN                 # MSG HAS INSERTION TEXT                  # DIAG 
        BEGIN                                                            DIAG 
        INDEX = INDEX + 1;   # SKIP OVER INSERTION CHARACTER           # DIAG 
 #                                                                       DIAG 
      BRANCH TO PROPER INSERTION ROUTINE THRU SWITCH INTEXTYP BASED ON   DIAG 
      THE VALUE OF ERRTYP.                                               DIAG 
 #                                                                       DIAG 
        GOTO INTEXTYP [ERRTYP];                                          JJJ1230
                                                                         DIAG 
                                                                         DIAG 
                                                                         DIAG 
 #                                                                       DIAG 
      ERRTYP = 0.  INSERT NEXWORD, DB$NLNG CHAR LONG, INTO MESSAGE.      DIAG 
 #                                                                       DIAG 
TYPE0:                                                                   DIAG 
        MVLEN = DB$NLNG;                                                 DIAG 
        IF MVLEN + BUFINDX GR 137 THEN MVLEN = 137 - BUFINDX;            DIAG 
        C<BUFINDX,MVLEN>MBUF = C<0,MVLEN>NEXWRDC[0];                     JJJ0105
        BUFINDX = BUFINDX + MVLEN;                                       DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      ERRTYP = 1.  INSERT CURWORD, DB$CLNG CHAR LONG, INTO MESSAGE.      DIAG 
 #                                                                       DIAG 
TYPE1:                                                                   DIAG 
        MVLEN = DB$CLNG;                                                 DIAG 
        IF MVLEN + BUFINDX GR 137 THEN MVLEN = 137 - BUFINDX;            DIAG 
        C<BUFINDX,MVLEN>MBUF = C<0,MVLEN>CURWORDC[0];                    DIAG 
        BUFINDX = BUFINDX + MVLEN;                                       DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      ERRTYP = 2.  INSERT TEXT FROM DIAGINF UP TO TERMINATOR ":"         DIAG 
 #                                                                       DIAG 
TYPE2:                                                                   DIAG 
        FOR IX = 0 STEP 1 WHILE IX LS 30 AND C<IX>DIAGINFC3[0] NQ ":" 
        AND C<IX>DIAGINFC3[0] NQ " " DO 
          BEGIN                                                          DIAG 
          C<BUFINDX>MBUF = C<IX>DIAGINFC3[0];                            JJJ0105
          BUFINDX = BUFINDX + 1;                                         DIAG 
          END                                                            DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      ERRTYP = 3.  CONVERT DIAGINF TO DISPLAY CODED DECIMAL AND INSERT   DIAG 
      10 DIGITS, RIGHT JUSTIFIED BLANK FILL.                             DIAG 
 #                                                                       DIAG 
TYPE3:                                                                   DIAG 
        C<BUFINDX,10>MBUF = DB$CDEB(DIAGINFU[0],10);
        BUFINDX = BUFINDX + 10;                                          DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      ERRTYP = 4.  CONVERT DIAGINF TO DISPLAY CODED OCTAL AND INSERT 10  DIAG 
      DIGITS, RIGHT JUSTIFIED BLANK FILL.                                DIAG 
 #                                                                       DIAG 
TYPE4:                                                                   DIAG 
        C<BUFINDX,10>MBUF = DB$COCB(DIAGINFU[0],10);
        BUFINDX = BUFINDX + 10;                                          DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      ERRTYP = 5.  MOVE 10 CHAR TO MBUF FROM DIAGINF.                    DIAG 
 #                                                                       DIAG 
TYPE5:                                                                   DIAG 
        C<BUFINDX,10>MBUF = DIAGINFC1[0];                                DIAG 
        BUFINDX = BUFINDX + 10;                                          DIAG 
        GOTO TYPEXIT;                                                    DIAG 
 #                                                                       DIAG 
      TYPE IS EQUAL TO NON-SUPPORTED TYPE.  PRINT NASTY MESSAGE AND      DIAG 
      INSERT 10 * INTO SPECIFIED MESSAGE.                                DIAG 
 #                                                                       DIAG 
BADTYPE:                                                                 DIAG 
        NASTYTYP[0] = DB$CDEB(ERRTYP,2);
        DB$EPRT (NASTYMSG,DFNASTYLN);                                    DIAG 
        C<BUFINDX,10>MBUF = "**********";                                DIAG 
        BUFINDX = BUFINDX + 10;                                          JJJ0105
        GOTO TYPEXIT;                                                    DIAG 
                                                                         DIAG 
                                                                         DIAG 
TYPEXIT:                                                                 DIAG 
        END                  # END OF VARIABLE PORTION HANDLERS        # DIAG 
 #                                                                       DIAG 
      IF MORE OF MESSAGE TO MOVE, AND ROOM IN MBUF, MOVE IT.             DIAG 
 #                                                                       DIAG 
                                                                         DIAG 
      IF INDEX LS NUMCHAR AND BUFINDX LS 137                             DIAG 
        THEN                                                             DIAG 
        BEGIN                                                            DIAG 
        FOR IX = 1 WHILE INDEX LS NUMCHAR AND BUFINDX LS 137 DO          DIAG 
          BEGIN                                                          DIAG 
          C<BUFINDX>MBUF = C<INDEX>RELADDR0[MSGADDR];                    DIAG 
          BUFINDX = BUFINDX + 1;                                         DIAG 
          INDEX = INDEX + 1;                                             DIAG 
          END                                                            DIAG 
        END                                                              DIAG 
 #                                                                       DIAG 
      PRINT THE MESSAGE                                                  DIAG 
 #                                                                       DIAG 
      DB$EPRT(MBUF,BUFINDX);                                             DIAG 
 #                                                                       DIAG 
      IF TOO MANY ERRORS, ABORT THE RUN.                                 DIAG 
 #                                                                       DIAG 
      IF ERRCNT GR DFERRLMT THEN DB$MABT(DFERLMEX,ERRCNT);               DIAG 
      RETURN;                                                            DIAG 
      END                                                                DIAG 
      TERM                                                               DIAG 
