*DECK DIAGSCN 
USETEXT CCTTEXT 
          PROC   DIAGSCN; 
# 
          DIAGSCN - DIAGNOSTIC PRESCANNER 
  
                 DETERMINES IF ANY DIAGNOSTICS ARE OF SUFFICIENT
                 SEVERITY TO SUPRESS CODE GENERATION.  SINCE CALLING
                 D$FORMATTER AT THIS TIME WOULD CLOBBER PROCTAB-S 
                 OUTPUT, WE MUST DO THIS PRESCAN. 
  
# 
          BEGIN 
  
*CALL ETEXT 
*CALL DIAGLVL 
*CALL TABLETYP
  
          DEF    DIAGBASE    #1000#;
          XREF
              BEGIN 
              ITEM  DIAGCNT  I; 
              ARRAY DIAGTBL  [0:249] S(1);
                  ITEM  DIAGTBLWD  I; 
              FUNC  VIRTUAL  U; 
              PROC  PUTSQ;
              PROC  RETRN;
              ITEM  DUMFET   I;    # DUMMY FET FOR BAD BINARY          #
              ITEM  ZZZZZ48;    #OTEXT FILE FET#
              PROC  TMFIXSZ;
              PROC  TMSETRO;
              END 
  
          ITEM   I           U;    # POINTER TO CURRENT ETEXT          #
          ITEM   ETXTLN      I;    # ETEXT LENGTH                      #
          ITEM   MINERR      I;    # MINIMUM ERROR LEVEL TO STOP CGEN  #
          ITEM   ANSIERR     I;    # ANSI EQUIVALENT LEVEL             #
          ITEM   INDX        I;    # DUMMY                             #
          ITEM   DIAGNR      I;    # CURENT DIAG NUMBER                #
          ITEM   LVL         I;    # CURRENT DIAGNOSTIC LEVEL          #
          ITEM   ERCNT       I = 0;# COUNT OF ERRORS BELOW TRIGGER LVL #
          ITEM   FATAL$MSG   C(17) = "ERRORS IN XXXXXXX"; 
  
              $BEGIN
              COMMON PARAMS;
                  ARRAY [0:7];
                      ITEM   PARAMC C(0, 0, 10);
              XREF    PROC   OUTPUT;
              ITEM    DBUGFL I;    # DEBUG ON FLAG                     #
              XREF    FUNC   DEC   C(10); 
              $END
  
          CONTROL EJECT;
          PROC   FINDLVL(NR, ERLVL);
# 
          FINDS THE ERROR LEVEL FOR A SPECIFIC DIAGNOSTIC              #
  
          BEGIN 
          ITEM   NR          I; 
          ITEM   ERLVL       I; 
          ITEM   I           I; 
          ITEM   J           I; 
  
  
          I = NR - DIAGBASE;
          IF  NR LS DIAGBASE OR I GR DIAGCNT  THEN
              BEGIN 
              ERLVL = CATASTROPH;  # ERROR NUMBER DOESN"T EXIST        #
              RETURN;              # D$FORMATTER WILL HANDLE           #
              END 
          J = I / 20; 
          I = I - (J * 20); 
          I = I * 3;
          ERLVL = B<I,3>DIAGTBLWD[J]; 
          RETURN; 
          END 
          CONTROL EJECT;
#         MAIN CODE STARTS HERE                                        #
  
 #    FIX SIZE AND SET READ ONLY FOR ETEXT - NEVER MODIFIED AGAIN # 
          TMFIXSZ(TABLETYPE"ETEXT$"); 
          TMSETRO(TABLETYPE"ETEXT$"); 
  
          ETXTLN = CCTETEXTLEN; 
  
              $BEGIN
              IF  CCTCHKOUT NQ 0  AND 
                  (PARAMC[0] EQ "DIAGS" OR PARAMC[1] EQ "DIAGS")  THEN
                  DBUGFL = 1; 
              ELSE
                  DBUGFL = 0; 
              $END
  
          IF  ETXTLN EQ 0  THEN 
              BEGIN 
                  $BEGIN
                  IF  DBUGFL NQ 0  THEN 
                      OUTPUT(1, "NO ETEXT");
                  $END
              RETURN; 
              END 
              $BEGIN
              IF  DBUGFL NQ 0  THEN 
                  OUTPUT(2, "ETEXTLEN=", DEC(ETXTLN));
              $END
  
          IF  CCTFORCEDOBJ  THEN
              MINERR = NON$ANSI + 1;   #CANT HAVE#
          ELSE
              MINERR = FATAL;          #THE USUAL#
          ANSIERR = CCTANSIDIAG;
  
          FOR  INDX = 1 STEP 1 UNTIL ETXTLN  DO 
              BEGIN 
              I = VIRTUAL(TABLETYPE"ETEXT$",INDX);
              DIAGNR = (ET$PHASE$NO[I] * 1000) + ET$LOCAL$NO[I];
              FINDLVL( DIAGNR, LVL);
                  $BEGIN
                  IF  DBUGFL NQ 0  THEN 
                      OUTPUT(3, "NXT DIAG= ", DEC(DIAGNR), DEC(LVL)); 
                  $END
  
              IF  LVL EQ NON$ANSI  THEN 
                  IF  ANSIERR EQ 0  THEN
                      TEST; 
                  ELSE
                      LVL = ANSIERR;
  
              IF  LVL GQ MINERR  THEN 
                  BEGIN 
                  CCTABORT = TRUE;
                  IF B<0,60>CCTOBJFILE NQ 0 
                  THEN
                      BEGIN 
                  C<10,7>FATAL$MSG = CCTPROGRAMID;    #PUT ID IN MSG   #
                  C<0,7>DUMFET = CCTOBJFILE;     #PUT LFN IN FET       #
                  PUTSQ(LOC(DUMFET), LOC(FATAL$MSG), 17); 
                  PUTSQ(LOC(DUMFET), 0, 0);      #FLUSH THE BUFFER     #
                  RETRN(LOC(DUMFET));       # PUT OUT BAD BINARY MSG   #
                      END 
                      $BEGIN
                      OUTPUT( 2, "CGEN SUPPR", "ESSED");
                      $END
                  RETURN; 
                  END 
              ELSE
                  IF  LVL GQ CCTDIAGLEVEL  THEN  #DIAG WILL BE PRINTED# 
                      ERCNT = ERCNT + 1;         #SO COUNT IT          #
              END 
  
          IF  ERCNT EQ 0  THEN
              CCTETEXTLEN = 0;     # THERE WERE ONLY UNLISTED ERRORS   #
              $BEGIN
              IF  DBUGFL NQ 0  THEN 
                  OUTPUT(2, "PRINTING", DEC(ERCNT));
              $END
          RETURN; 
          END 
          TERM
