*DECK             DIAG
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TSYMC5Q 
USETEXT   TCEXECQ 
USETEXT   TCEXEC
USETEXT   TSYMC5
#----------------------------------------------------------------------# DIAG 
#                                                                      # DIAG 
#     P R O C   D I A G                                                # DIAG 
#                                                                      # DIAG 
#     PURPOSE - ISSUE SYNTAX ANALYSIS DIAGNOSTIC MESSAGES.             # DIAG 
#                                                                      # DIAG 
#     CALLING SEQUENCE -                                               # DIAG 
#               DIAG(N,NP)                                             # DIAG 
#               WHERE N  = ERROR NUMBER                                # DIAG 
#                     NP = SYMBOL TABLE INDEX OF ASSOCIATED ENTITY     # DIAG 
#                                                                      # DIAG 
#     MESSAGE FORMAT -                                                 # DIAG 
#               ***         NNN     SYMBOL                             # DIAG 
#                                                                      # DIAG 
#     ALTERNATE ENTRY -                                                #
#               DIAG0                                                  #
#                                                                      # DIAG 
#----------------------------------------------------------------------# DIAG 
      PROC DIAG((N),(NP));                                               DIAG 
      BEGIN  # DIAG #                                                    DIAG 
      XREF PROC FIND;                                                    DIAG 
      XREF PROC PTLST;                                                   DIAG 
      XREF PROC PTLSTV;                                                  DIAG 
      XREF PROC BINDEC;                                                  DIAG 
      XREF ARRAY DIAGNOS[0:4];                                           DIAG 
             BEGIN                                                       DIAG 
             ITEM DIAGN         I (00,00,60);                            DIAG 
             END                                                         DIAG 
      XREF ARRAY DMSGA[0:11] S(1);                                       DIAG 
              BEGIN                                                      DIAG 
             ITEM DMSG          C (00,00,10);                            DIAG 
             END                                                         DIAG 
      XREF ARRAY ERRCNTS[1:4] S(1);  # CONTAINS ERROR COUNTS FOR THE 4 # DIAG 
             BEGIN                   # CATEGORIES OF ERRORS M,T,W,F    # DIAG 
             ITEM ERRCNT U;                                              DIAG 
             END                                                         DIAG 
      XREF ITEM ERRLST;                                                  DIAG 
      XREF ITEM MEL;               # MAXIMUM ERROR LEVEL ENCOUNTERED   # DIAG 
      XREF ITEM EL;                # ERROR LEVEL(SYMPL CONTROL CARD)   # DIAG 
      XREF ITEM DCNTUNS;           # COUNT OF UNSUPP. DIAG PER MODULE  # DIAG 
      XREF ITEM DCNTTOT;           # COUNT OF UNS+SUPP DIAG PER MODULE # DIAG 
      XREF ITEM BINPAGE;           # PAGE NUMBER (IN BINARY)           #
  
  
#     XDEFS                                                            #
  
      XDEF ARRAY PAGEBITS [0:NUMDIAGWRDS] S(1);  # BIT VECTOR OF PAGES #
        BEGIN 
        ITEM PAGEBIT     U( 0, 0,WL) = [0,NUMDIAGWRDS(0)];
        END 
      XDEF ITEM LASTDIAGPAGE I = 0;  # LAST PAGE CONTAINING A DIAG     #
  
#     COMDECKS                                                         # DIAG 
  
*CALL COMEX 
*CALL ERLEVS                                                             DIAG 
                                                                         DIAG 
                                                                         DIAG 
      ITEM NP             I;                                             DIAG 
      ITEM N              I;                                             DIAG 
      ITEM TL             I;                                             DIAG 
      ITEM LEV            I;       # ERROR LEVEL                       # DIAG 
      ITEM FIRST          I;       # FIRST BIT LOCATION                # DIAG 
      ITEM INDEX          I;       # WORD LOCATION                     # DIAG 
      ITEM WDNO           I;       # WORD NUMBER                       # DIAG 
      ITEM BITNO          I;       # BIT NUMBER                        # DIAG 
                                                                         DIAG 
DIAG1:                                                                   DIAG 
      INDEX = (N-1)/20;                                                  DIAG 
      FIRST = 3*(N-20*INDEX-1);                                          DIAG 
      LEV = B<FIRST,3>ELEV[INDEX];  # EXTRACT ERROR LEVEL              # DIAG 
      ERRCNT[LEV] = ERRCNT[LEV]+1; # INCREMENT ERROR COUNT             # DIAG 
      IF LEV GR MEL                # IF LEVEL OF THIS ERROR GREATER    # DIAG 
      THEN                         # THAN MAXIMUM LEVEL OF PREVIOUS    # DIAG 
        BEGIN                      # ERRORS(IF ANY) THAN SET MAXIMUM   # DIAG 
        MEL = LEV;                 # ERROR LEVEL TO NEW VALUE          # DIAG 
        END                                                              DIAG 
      IF LEV EQ QERLEV "FATAL"                                           DIAG 
      THEN                                                               DIAG 
        BEGIN                                                            DIAG 
        DCXFLG = 0;                # CLEAR DESCRIPTIVE CONTEXT FLAGS   # DIAG 
        DESFLG = 0;                # .                                 # DIAG 
        STERF = 1;                 # SET ERROR FLAG                    # DIAG 
        END                                                              DIAG 
                                                                         DIAG 
      IF LEV GQ EL                                                       DIAG 
      THEN                                                               DIAG 
        BEGIN  # ISSUE MESSAGE #                                         DIAG 
        IF BINPAGE GQ MAXDIAGPAGE  # DETECT OVERFLOW OF THE VECTOR     #
        THEN
          BEGIN  #OVERFLOW# 
          LASTDIAGPAGE = MAXDIAGPAGE;  # SHOW OVERFLOW                 #
          END    #OVERFLOW# 
  
        ELSE
          BEGIN  #NORMAL# 
          LASTDIAGPAGE = BINPAGE;  # UPDATE LAST PAGE CONTAINING DIAG  #
          WDNO = BINPAGE/WL;       # SET BIT SHOWING PAGE NUM OF ERROR #
          BITNO = BINPAGE - WDNO*WL;  # GET WORD AND BIT OFFSET IN VECT#
          B<BITNO,1>PAGEBIT[WDNO] = 1;
          END    #NORMAL# 
  
        ERRLST = 1;                                                      DIAG 
        DMSG[1] = BLANKW;          # BLANK DIAGNOSTIC MESSAGE          # DIAG 
        DMSG[2] = BLANKW;          # .                                 # DIAG 
        DMSG[3] = BLANKW;          # .                                 # DIAG 
        IF NP NQ 0                                                       DIAG 
        AND NOT NNAM[NP]                                                 DIAG 
        THEN                       # FIND NAME IN SYMBOL TABLE         # DIAG 
          BEGIN  # PUT NAME IN MSG #                                     DIAG 
          FIND(NP,TL);                                                   DIAG 
          IF C<2>NAME[TL] NQ "?"                                         DIAG 
          THEN                                                           DIAG 
            BEGIN  # NOT A DEF #                                         DIAG 
            DMSG[2] = NAME[TL];                                          DIAG 
            IF NCHR[TL] GR 10                                            DIAG 
            THEN                   # MORE THAN 10 CHAR IN NAME         # DIAG 
              BEGIN  # > 10 CHAR #                                       DIAG 
              DMSG[3] = NAME[TL+1];  # SECOND PART OF NAME             # DIAG 
              END  # > 10 CHAR #                                         DIAG 
            END  # NOT A DEF #                                           DIAG 
          ELSE                                                           DIAG 
            BEGIN  # DEF #                                               DIAG 
            DMSG[2] = "*DEF-PARAM";                                      DIAG 
            END  # DEF #                                                 DIAG 
          END  # PUT NAME IN MSG #                                       DIAG 
                                                                         DIAG 
        BINDEC(DMSGA,10,N,5);      # CONVERT ERROR NUMBER TO DIS. CODE # DIAG 
        PTLSTV(DMSGA,4);           # ISSUE ERROR MESSAGE               # DIAG 
        WDNO = N/CMPAR3;           # SET BIT CORRESPONDING TO ERROR    # DIAG 
        BITNO = N-CMPAR3*WDNO;     # NUMBER IN DIAGNOSTIC ARRAY        # DIAG 
        B<BITNO>DIAGN[WDNO] = 1;   # .                                 # DIAG 
        DCNTUNS = DCNTUNS + 1;     # INCREMENT UNSUPP. DIAG COUNT      # DIAG 
        END    # ISSUE MESSAGE #                                         DIAG 
      DCNTTOT = DCNTTOT + 1;       # INCREMENT TOTAL DIAG COUNT        # DIAG 
      RETURN;                                                            DIAG 
                                                                         DIAG 
#----------------------------------------------------------------------# DIAG 
#                                                                      # DIAG 
#     ALTERNATE ENTRY DIAG0                                            # DIAG 
#                                                                      # DIAG 
#     PURPOSE - SAME AS DIAG                                           # DIAG 
#                                                                      # DIAG 
#     CALLING SEQUENCE -                                               # DIAG 
#               DIAG0(N)                                               # DIAG 
#               WHERE N = ERROR NUMBER                                 # DIAG 
#                                                                      # DIAG 
#     MESSAGE FORMAT -                                                 # DIAG 
#               ***         NNN                                        # DIAG 
#                                                                      # DIAG 
#----------------------------------------------------------------------# DIAG 
      ENTRY PROC DIAG0((N));                                             DIAG 
      NP = 0;                                                            DIAG 
      GOTO DIAG1;                                                        DIAG 
      END    # DIAG #                                                    DIAG 
      TERM                                                               DIAG 
