*DECK DIAGIV
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TCEXEC
USETEXT   TSYMC5
      PROC  DIAGIV; 
      BEGIN  # DIAGIV #                                                  DIAGIV 
#----------------------------------------------------------------------# DIAGIV 
#                                                                      # DIAGIV 
#     P R O C   D I A G I V                                            # DIAGIV 
#                                                                      # DIAGIV 
#     PURPOSE -  ISSUE SUMMARY SYNTAX DIAGNOSTIC MESSAGES              # DIAGIV 
#                                                                      # DIAGIV 
#     CALLING SEQUENCE  -                                              # DIAGIV 
#               DIAGIV                                                 # DIAGIV 
#                                                                      # DIAGIV 
#     MESSAGE FORMATS -                                                # DIAGIV 
#                ***    NNN   L    ERROR TEXT                          # DIAGIV 
#                WHERE NNN = ERROR NUMBER                              # DIAGIV 
#                      L = LEVEL OF ERROR                              # DIAGIV 
#                                                                      # DIAGIV 
#                ***    NNN MACHDEP ERRORS(SUPPRESSED)                 # DIAGIV 
#                ***    NNN TRIVIAL ERRORS(SUPPRESSED)                 # DIAGIV 
#                ***    NNN WARNING ERRORS(SUPPRESSED)                 # DIAGIV 
#                ***    NNN FATAL   ERRORS(SUPPRESSED)                 # DIAGIV 
#                WHERE NNN IS NUMBER OF ERRORS AND (SUPPRESSED) IS     # DIAGIV 
#                APPENDED IF DIAGNOSTICS WERE SUPPRESSED               # DIAGIV 
#                                                                      # DIAGIV 
#----------------------------------------------------------------------# DIAGIV 
                                                                         DIAGIV 
                                                                         DIAGIV 
*CALL COMEX 
  
#     XREFS                                                            # DIAGIV 
                                                                         DIAGIV 
      XREF ARRAY DIAGNOS[0:4];                                           DIAGIV 
             BEGIN                                                       DIAGIV 
             ITEM DIAGN          I (00,00,60);                           DIAGIV 
             END                                                         DIAGIV 
      XREF ARRAY DMSGA[0:11] S(1);                                       DIAGIV 
             BEGIN                                                       DIAGIV 
             ITEM DMSG           C (00,00,10);                           DIAGIV 
             ITEM DMSGL          C (0,00,120);   # LONG NAME FOR MSG   #
             END                                                         DIAGIV 
      XREF ARRAY ERRCNTS[1:4] S(1);  # CONTAINS ERROR COUNTS FOR THE 4 # DIAGIV 
             BEGIN                   # CATEGORIES OF ERRORS M,T,W,F    # DIAGIV 
             ITEM ERRCNT U;                                              DIAGIV 
             END                                                         DIAGIV 
      XREF PROC BINDEC;                                                  DIAGIV 
      XREF PROC MSG;
      XREF PROC PTLST;                                                   DIAGIV 
      XREF PROC PTLSTV; 
      XREF ARRAY ETABI[1:1];                                             DIAGIV 
             BEGIN                                                       DIAGIV 
             ITEM DIAGLEV        U (00,00,03);  # DIAGNOSTIC LEVEL     # DIAGIV 
             ITEM DIAGLOC        U (00,42,18);  # DIAGNOSTIC LOCATION  # DIAGIV 
             ITEM DIAGWORD       I (00,00,42);  # END OF LIST FLAG     #
             END                                                         DIAGIV 
      XREF ARRAY PAGEBITS [0:NUMDIAGWRDS] S(1);  # BIT VECTOR OF PAGES #
        BEGIN 
        ITEM PAGEBIT             U( 0, 0,60); 
        END 
      XREF ITEM LASTDIAGPAGE;      # LAST PAGE CONTAINING A DIAG       #
      XREF ITEM EL;                # ERROR LEV FROM SYMPL CONTROL CARD # DIAGIV 
      XREF ITEM DCNTUNS;           # NUMBER OF UNSUPPRESSED DIAGNOSTICS#
      XREF ITEM DCNTTOT;           # TOTAL DIAGNOSTIC COUNT            #
      XREF ITEM SHRTLST;
                                                                         DIAGIV 
                                                                         DIAGIV 
#     LOCALS                                                           # DIAGIV 
                                                                         DIAGIV 
#----------------------------------------------------------------------#
#                                                                      #
#         NOTE - THE NAMES AND LETTERS IN THE FOLLOWING LIST MUST BE   #
#         KEPT IN SYNC WITH THE "EL." EQU-S IN SYMTEXT...              #
#                                                                      #
#----------------------------------------------------------------------#
      ARRAY SUMMSG[1:5] S(2); 
        BEGIN                                                            DIAGIV 
        ITEM EMSG1          C (00,00,10) = [" MACHDEP E",                DIAGIV 
                                            " TRIVIAL E",                DIAGIV 
                                            " WARNING E",                DIAGIV 
                                            " FATAL   E", 
                                            "COMPILER E"];
        ITEM  CLEV           C(01,00,01) = [ "D", "T", "W", "F", "C"];
                                   # THE ABOVE ARE THE ERROR LEVELS    #
        END                                                              DIAGIV 
  
      ARRAY NMES[0:2] S(1); 
        BEGIN 
        ITEM M C(0,0,10) = [" **    SYN","TAX DIAGNO","STIC(S)   "];
        END 
  
      ITEM MSG$         C(10) = " *** NNNN "; 
      ITEM BITNO           I;                                            DIAGIV 
      ITEM WDNO            I;                                            DIAGIV 
      ITEM PGNO            I;      # PAGE NUMBER                       #
      ITEM TL              I;                                            DIAGIV 
      ITEM TL2             I;                                            DIAGIV 
      ITEM TL3             I;                                            DIAGIV 
      ITEM TL4             I;                                            DIAGIV 
      ITEM  DIAGEND          I;    # FOR COMPUTING LENGTHS OF DIA TEXT #
      BASED ARRAY DIAGSTRARY; 
        BEGIN                                                            DIAGIV 
        ITEM DIAGSTRING     C (00,00,10);                                DIAGIV 
        END                                                              DIAGIV 
                                                                         DIAGIV 
      CONTROL EJECT;
      PROC PRINTPAGENUM( (NUM) ); 
      BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   P R I N T P A G E N U M                                #
#                                                                      #
#     PURPOSE --  PUT ONE LINE NUMBER IN ARRAY DMSGA, SUITABLE FOR     #
#                 PRINTING.  BOOKEEP POINTERS AND PRINT LINE IF FULL.  #
#                                                                      #
#     INPUT --    NUMBER (BINARY) OF PAGE NUMBER TO BE PRINTED         #
#     OUTPUT --   PAGE NUMBER IN BUFFER (DMSGA)                        #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      DEF NUMSIZE      #6#;        # ALLOW 6 CHARACTERS FOR PAGE NUM   #
      DEF STARTPOS     #4#;        # COLUMN OF FIRST LINE NUMBER       #
      DEF LASTPOS      #110#;      # LAST COLUMN FOR LINE NUMBER       #
  
      ITEM NUM         I;          # NUMBER (BINARY) OF PAGE           #
      ITEM LINEPOS     I=STARTPOS; # POSITION IN CURRENT LINE          #
      ITEM IT          C(10);      # TEMP FOR BCD LINE NUMBER          #
  
  
      IF LINEPOS GR LASTPOS 
      THEN
        BEGIN  #PRINT PREV LINE#
        PTLST( DMSGA );            # PRINT THE PREVIOUS LINE           #
        C<0,120>DMSGL[0] = "    "; # CLEAR THE NEW LINE                #
        LINEPOS = STARTPOS; 
        END    #PRINT PREV LINE#
  
      IF LINEPOS LQ STARTPOS
      THEN
        BEGIN 
        IT = "    ";               # FIRST PAGE NUMBER ON LINE         #
        END 
  
      ELSE
        BEGIN 
        IT = ",   ";               # SUBSEQUENT PAGE NUMBERS           #
        END 
  
      BINDEC( IT, 1, NUM, NUMSIZE-1);  # CONVERT THE LINE NUMBER       #
      C<LINEPOS,NUMSIZE>DMSGL[0] = C<0,NUMSIZE>IT;  # PLACE IT IN LINE #
      LINEPOS = LINEPOS + NUMSIZE;
  
      END  #PRINTPAGENUM# 
                                                                         DIAGIV 
      CONTROL EJECT;
#     ISSUE **NO DIAGNOSTICS** MESSAGE IF THATS THE TRUTH, AND QUIT    #
  
      IF DCNTTOT EQ 0              # IF TOTAL ERROR COUNT = 0          #
      THEN
        BEGIN                      # NO DIAGNOSTICS                    #
        IF B<59-"L">OPTION EQ 0 
          AND SHRTLST NQ 1
        THEN
          BEGIN 
          RETURN;                  # SKIP MESSAGE IF L=0               #
          END 
                                   # ELSE ISSUE MESSAGE TO L=FILE      #
        PTLSTV ("0**NO SYNTAX DIAGNOSTICS**", 3); 
        RETURN; 
        END                        # NO DIAGNOSTICS                    #
  
  
#     ISSUE COUNT OF UNSUPPRESSED DIAGS TO DAYFILE                     #
  
      IF DCNTUNS GR 0 
      THEN
        BEGIN  #DAYFILE MSG#
        BINDEC(MSG$, 5, DCNTUNS, 4);
        MSG( MSG$ );
        END    #DAYFILE MSG#
  
  
#     IF DEBUG OPTION "D" ON THEN LIST ALL DIAGNOSTICS IN NUMERIC ORDER#
  
      P<DIAGSTRARY> = 0;
      $BEGIN
      IF  B<3,1>INTOPS NQ 0            # *=D OPTION ON                 #
      THEN
        BEGIN 
        PTLSTV (BLANKW, 1);        # SPACE 1 BEFORE FULL DIAG LIST     #
        FOR  TL = 1 STEP 1
          WHILE DIAGWORD[TL] NQ -1     # SIGNIFIES END OF LIST         #
        DO
          BEGIN 
          IF  DIAGLOC[TL] EQ 0       # DIAGNOSTIC IS NULL              #
          THEN
            BEGIN 
            TEST TL;
            END 
          FOR  TL3 = 1 STEP 1 
            UNTIL 11
          DO
            BEGIN 
            DMSG[TL3] = BLANKW;  # CLEAR MSG BUFFER                    #
            END 
          BINDEC(DMSGA,7,TL,3);  # CONVERT ERROR NUMBER TO DIS CODE    #
          C<4,1>DMSG[1] = CLEV[DIAGLEV[TL]];
          TL4 = 0;
          IF  DIAGLOC[TL+1] NQ 0
          THEN
            BEGIN 
            DIAGEND = DIAGLOC[TL+1] - 1;   # COMPUTE LWA OF TEXT       #
            END 
          ELSE
            BEGIN 
            CONTROL FASTLOOP; 
            FOR TL3 = TL+1 STEP 1 
              WHILE DIAGLOC[TL3] EQ 0 
            DO
              BEGIN 
              DIAGEND = DIAGLOC[TL3] - 1; 
              END 
            CONTROL SLOWLOOP; 
            END 
          FOR  TL3 = DIAGLOC[TL] STEP 1 
            UNTIL DIAGEND 
          DO
            BEGIN 
            DMSG[2 + TL4] = DIAGSTRING[TL3];   # MOVE STRING           #
            TL4 = TL4 + 1;
            END 
          PTLST(DMSGA); 
          END 
        END 
      $END
  
  
#     ISSUE TEXT OF DIAGS WHICH WERE ISSUED IN THIS MODULE             #
  
      IF DCNTUNS GR 0 
      THEN
        BEGIN  #ISSUE DIAGNOSTICS#
      PTLSTV (BLANKW, 1);          # SPACE 1 BEFORE ISSUED DIAG TEXTS  #
      FOR TL = 0 STEP 1                                                  DIAGIV 
        UNTIL 4                                                          DIAGIV 
      DO                                                                 DIAGIV 
        BEGIN                                                            DIAGIV 
        IF DIAGN[TL] EQ 0                                                DIAGIV 
        THEN TEST TL;                                                    DIAGIV 
        FOR TL2 = 0 STEP 1                                               DIAGIV 
          UNTIL CMPAR3-1                                                 DIAGIV 
        DO                                                               DIAGIV 
          BEGIN                                                          DIAGIV 
          IF B<TL2>DIAGN[TL] EQ 1                                        DIAGIV 
          THEN                                                           DIAGIV 
            BEGIN                                                        DIAGIV 
            TL4 = TL2 + TL * CMPAR3;  # COMPUTE ERROR NUMBER           # DIAGIV 
            FOR TL3 = 1 STEP 1                                           DIAGIV 
              UNTIL 11                                                   DIAGIV 
            DO                                                           DIAGIV 
              BEGIN # BLANK DMSG #                                       DIAGIV 
              DMSG[TL3] = BLANKW;                                        DIAGIV 
              END    # BLANK DMSG #                                      DIAGIV 
            BINDEC(DMSGA,7,TL4,3);  # CONVERT ERROR NUMBER TO DIS. CODE# DIAGIV 
            C<4,1>DMSG[1] = CLEV[DIAGLEV[TL4]];   # PUT IN LEVEL       #
            IF  DIAGLOC[TL4+1] NQ 0       # NO HOLE IN LIST            #
            THEN
              BEGIN 
              DIAGEND = DIAGLOC[TL4+1] - 1;  # COMPUTE TEXT LENGTH     #
              END 
            ELSE
              BEGIN 
              CONTROL FASTLOOP; 
              FOR TL3 = TL4+1  STEP 1       # FIND NEXT DIAG           #
                WHILE DIAGLOC[TL3] EQ 0 
              DO
                BEGIN 
                DIAGEND = DIAGLOC[TL3] - 1; 
                END 
              CONTROL FASTLOOP; 
              END 
            FOR TL3 = DIAGLOC[TL4] STEP 1                                DIAGIV 
              UNTIL DIAGEND 
            DO                                                           DIAGIV 
              BEGIN  # MOVE MSG #                                        DIAGIV 
              DMSG[2 + TL3 - DIAGLOC[TL4]] = DIAGSTRING[TL3];            DIAGIV 
              END    # MOVE MSG #                                        DIAGIV 
            PTLST(DMSGA);          # PRINT DIAGNOSTIC MESSAGE          # DIAGIV 
            END                                                          DIAGIV 
          END                                                            DIAGIV 
        END                                                              DIAGIV 
        END  # ISSUE DIAGNOSTICS #
  
  
#     ISSUE MESSAGE GIVING PAGE NUMBERS WHERE DIAGNOSTICS OCCURRED     #
  
      IF DCNTUNS GR 0              # IF THERE WERE PRINTED DIAGNOSTICS #
        AND B<59 - "L">OPTION NQ 0 # AND L OPTION ON                   #
        AND SHRTLST NQ 1           # AND NOT L=1                       #
      THEN
      BEGIN  #ISSUE PAGE SUMMARY# 
      C<0,120>DMSGL[0] = "0    ONE OR MORE DIAGNOSTICS OCCURRED ON THE F
OLLOWING PAGE(S) "; 
      PTLST( DMSGA ); 
      C<0,120>DMSGL[0] = "   ";    # CLEAR OUT MESSAGE BUFFER          #
      PGNO = 0;                    # INITIALIZE SEQUENTIAL PAGE COUNTER#
  
      FOR WDNO=0 STEP 1 
      WHILE PGNO LQ LASTDIAGPAGE
      DO
        BEGIN  #WDNO# 
        FOR BITNO=0 STEP 1
        WHILE BITNO LS WL-1 
          AND PGNO LQ LASTDIAGPAGE
        DO
          BEGIN  #BITNO#
          IF B<BITNO,1>PAGEBIT[WDNO] EQ 1 
          THEN
            BEGIN 
            PRINTPAGENUM( PGNO ); 
            END 
  
          PGNO = PGNO + 1;         # INCREMENT PAGE NUMBER COUNTER     #
          END    #BITNO#
        END    #WDNO# 
  
      PTLST(DMSGA);                # PRINT LAST LINE OF PAGE NUMBERS   #
      IF LASTDIAGPAGE GQ MAXDIAGPAGE
      THEN
        BEGIN  #OVERFLOW# 
        C<0,120>DMSGL[0] = "0    ERRORS ALSO OCCURRED ON LATER PAGES";
        PTLST( DMSGA ); 
        END    #OVERFLOW# 
      END    #ISSUE PAGE SUMMARY# 
                                                                         DIAGIV 
  
#     ISSUE DIAGNOSTIC SUMMARY MESSAGES                                #
  
      IF  B<59 - "L">OPTION NQ 0   # L OPTION ON                       #
        OR  SHRTLST EQ 1           # L=1 OPTION                        #
        OR  DCNTUNS GR 0           # UNSUPPRESSED DIAGNOSTICS          #
      THEN
        BEGIN 
      PTLSTV (BLANKW, 1);          # SPACE 1 BEFORE DIAG SUMMARY       #
      DMSG[0] = "  **      ";      # CHANGE "***" TO " **" FOR SUMMARY #
      FOR TL = 1 STEP 1                                                  DIAGIV 
        UNTIL 4                                                          DIAGIV 
      DO                                                                 DIAGIV 
        BEGIN  # ISSUE ERROR COUNT DIAG #                                DIAGIV 
        FOR TL2 = 1 STEP 1                                               DIAGIV 
          UNTIL 11                                                       DIAGIV 
        DO                                                               DIAGIV 
          BEGIN  # BLANK DMSG #                                          DIAGIV 
          DMSG[TL2] = BLANKW;                                            DIAGIV 
          END    # BLANK DMSG #                                          DIAGIV 
        BINDEC(DMSGA,7,ERRCNT[TL],3);  # CONVERT ERROR COUNT TO BCD    # DIAGIV 
        DMSG[1] = EMSG1[TL];                                             DIAGIV 
        DMSG[2] = "RRORS     ";                                          DIAGIV 
        IF TL LS EL                                                      DIAGIV 
        THEN                                                             DIAGIV 
          BEGIN  # SUPPRESSED #                                          DIAGIV 
          DMSG[2] = "RRORS(SUPP";                                        DIAGIV 
          DMSG[3] = "RESSED)   ";                                        DIAGIV 
          END    # SUPPRESSED #                                          DIAGIV 
        PTLST(DMSGA);              #PRINT DIAGNOSTIC MESSAGE           # DIAGIV 
        END    # ISSUE ERROR COUNT DIAG #                                DIAGIV 
        END 
      END    # DIAGIV #                                                  DIAGIV 
      TERM                                                               DIAGIV 
