*DECK D$FORMAT
USETEXT CCTTEXT 
PROC D$FORMATTER; 
  # 
    THIS ROUTINE ASSEMBLES THE ERROR MESSAGE TEXT AND OUTPUTS IT. 
    INPUT IS THE ETEXT AND THE CCT. THE LOCAL MESSAG NUMBER AND PHASE-
   ID IS TAKEN FROM THE ETEXT ATOM.  PHASE-ID * 1000 PLUS THE LOCAL 
   NUMBER FORMS THE EXTERNAL MESSAGE NUMBER.
  
   EACH MESSAGE HAS A 30-BIT POINTER IN THE TABLE "DFTABLE".  THIS
   POINTER CONTAINS 6 BITS OF ERROR LEVEL, 6 BITS OF MESSAGE LENGTH 
   (IN WORDS), AND 18 BITS OF MESSAGE ADDRESS.  SINCE SYMPL DOES NOT
   PROVIDE PARTIAL WORD ARRAY ENTRIES, WE MUST "MASSAGE" THE EXTERNAL 
   MESSAGE NUMBER INTO AN INDEX AND PICK UP THE TOP OR BOTTOM OF THE
   WORD DEPENDING ON WHETHER THE MESSAGE IS ODD OR EVEN.
  
   ONCE WE HAVE THE POINTER, WE CAN EASILY OUTPUT THE MESSAGE.  IT THE
   MESSAGE WILL NOT FIT ON ONE LINE, WE SCAN BACK TO THE BEGINNING OF 
   THE WORD THAT DOESN"T FIT AND PUT THE REST ON ANOTHER LINE.
                              # 
  # THE DEF "DFVIRTUAL" IS USED TO ENSURE THAT THE ETEXT
    ENTRY IS IN MEMORY.  THE TYPICAL REFERENCE PATTERN FOR
    ETEXT IS LOOPING THRU IT. HENCE THE PHYSICAL INDEX FOR THE
    LOGICAL ETEXT ATOM IS TYPICALLY CALCULATED AT THE TOP OF A
    LOOP. LOCAL IDENTFIERS WHICH START WITH "R" (EG.RI,RJ) ARE
    USED FOR THE PHYSICAL (REAL) INDICES, WHERE I, J ETC. ARE THE 
    LOGICAL INDICES ( TYPICALLY THE LOOP COUNTER OR INDEX). # 
  
BEGIN 
*CALL TABLETYP
*CALL WORKTABS
  
*CALL DIAGLVL 
*CALL ASSEMOP 
  
          ARRAY[1:5];        #MUST MATCH NUMBER OF LEVELS IN DIAGLVL# 
              ITEM ELEV C(0,0,6) = [ "T", "W", "F", "C", "N"];
   # CBLIST FUNCTION CODES #
   DEF SINGLE$SP  #1#  ;
   DEF DOUBLE$SP  #2#  ;
   DEF EJECT  #3#  ;
   DEF TITLE$DEF  #4#  ;
   DEF SUBTITLE$DEF  #5#  ; 
   DEF OPENF  #8#  ;
   DEF CLOSEF  #9#  ; 
   DEF SH$TITLE    #10#;
   DEF ON  #1#  ; 
   DEF OFF  #0#  ;
   DEF GROUPED  #1#  ;
   DEF SINGLE  #0#  ; 
          DEF    TITLELEN    #110#;    #LENGTH OF LISTING TITLE#
   DEF  SHTITLELEN #80#;   # LENGTH OF TERMINAL TITLE # 
  ITEM CH C(10); # THIS IS JUST A TEMPORARY # 
  
  ITEM T1 U; # THIS IS JUST A TEMPORARY # 
  ITEM T2 U; # JUST A TEMP #
          ITEM   DLVL        I = 0;    #DIAG LEVEL FOR TABLES#
          ITEM   DN          I = 0;    #DIAG EXT NR#
  
   ITEM  $$$DUMMY$$$$ I;
          ITEM   DIAGS$PRINT I = 0;    #NR DIAGS ACTUALLY PRINTED#
   ITEM  WORK$BASE ;
   ITEM  PL C ( 132); 
   ITEM  SPACES C(10) = "          "; 
   ITEM  FORMAT$FLAG; 
   ITEM  LINE$LENGTH I; 
   ITEM  S$TAB  I;
   ITEM  L$TAB  I;
   ITEM  C$TAB  I;
   ITEM  E$TAB  I;
   ITEM  MTAB   I;
   ITEM  REG1       I;
   ITEM  REG2       I;
   ITEM  REG3       I;
   ITEM  REG4       I;
   ITEM  I I; 
   ITEM  J I; 
   ITEM  K I; 
   ITEM  L I; 
   ITEM  NN I;
   ITEM  N C (10);
   ITEM  LN I;
   ITEM  FCODE I; 
   ITEM  ET$LENGTH  ; 
          ITEM   ICR         I;    #CHAR NUMBER FOR C FUNC# 
*CALL ETEXT 
          XREF PROC FINDIAG;
          XREF  ITEM NOTXT I; 
  
          BASED ARRAY TEXT[0];
              ITEM  TEXT$W   C(0,0,10); 
   ITEM NBRTOPRINT I = 0;   # NUMBER OF ERRORS TO PRINT # 
  ITEM VI I;
  
   SWITCH ERRS  TRIV, WARN, FATL, CATS, NANSI;
  
  $BEGIN
   COMMON PARAMS; 
       ARRAY  [0:7];
           ITEM PARAMC   C(0,0,10); 
   XDEF ITEM DFDEBUG B; 
   XREF PROC OUTPUT;
   XREF FUNC OCT C(40); 
   XREF PROC DISPLAY; 
  $END
          XREF ITEM LISTHED C(90); #FULL LISTING TITLE# 
          XREF ITEM LISTTYP C(20); #TYPE FIELD OF TITLE#
          XREF               #ALL LIVE IN COBOL5# 
              BEGIN 
              ITEM  TOTF$ERR I; 
              ITEM  TOTW$ERR I; 
              ITEM  TOTT$ERR I; 
              ITEM  TOTC$ERR I; 
              ITEM   CC$PW   I; 
              ITEM   ALTFET  C(10);    # FET FOR "E" FILE              #
              END 
  
   XREF PROC CBLIST;
          XREF FUNC DEC C(10);
   XREF PROC QSORT4;
   XREF FUNC VIRTUAL U; 
          DEF VMETEXT  #TABLETYPE"ETEXT$"#; 
   DEF DFVIRTUAL(XX) # VIRTUAL(VMETEXT,XX)# ; 
CONTROL EJECT;
FUNC LENGTH (STRING) U; 
BEGIN 
#   NOTE: STRING MUST BE DECLARED TO BE THE # 
#         SAME LENGTH AS N IN FORMATTER.    # 
   ITEM STRING C(10), 
        I I        ,
        DONE B; 
# NOTE THAT THE MAX. LENGTH RETURNED IS 5 . THAT IS, THE LARGEST
   NUMBER PUT IN THE LISTING IS 99999. LARGER NUMBERS ARE TRUNCATED#
  
  
DONE = FALSE; 
FOR I = 0 STEP 1 WHILE NOT DONE DO
   IF C<I,1> STRING EQ " "
   THEN BEGIN 
        LENGTH = I; 
        DONE = TRUE;
        END 
   ELSE # SEE IF 5 CHARACTERS LONG #
   IF I EQ 4 THEN 
     BEGIN
       LENGTH = 5;
       DONE = TRUE; 
     END
  
   $BEGIN 
     IF DFDEBUG THEN
       BEGIN
         OUTPUT(2," ST. LEN =",DEC(I+1)); 
       END
   $END 
END #LENGTH#
CONTROL EJECT;
$BEGIN
PROC PRINT$ETEXT; 
BEGIN 
  # THIS IS USED FOR DEBUGGING PURPOSES ONLY
                                              # 
    IF DFDEBUG THEN OUTPUT(2," PRINT$ETE","XT CALLED.");
  ITEM I,J; 
  
  FCODE = SINGLE$SP;
  CBLIST(FCODE,"ETEXT",5);
  FOR J = 1 STEP 1  UNTIL ET$LENGTH     DO
    BEGIN 
      I = DFVIRTUAL(J); 
      OUTPUT(2,OCT(ET$INFO[I],0,10),OCT(ET$INFO[I],10,10)); 
    PL = SPACES;
    NN = ET$GLOBAL$NO[I]; N = DEC(NN); LN = LENGTH(N);
    C<15-LN,LN> PL = N; 
    NN = ET$LINE$NO[I]; N = DEC(NN); LN = LENGTH(N);
    C<21-LN,LN> PL = N; 
    NN = ET$COLUMN$NO[I]; N = DEC(NN); LN = LENGTH(N);
    C<27-LN,LN> PL = N; 
    NN = ET$PHASE$NO[I]; N = DEC(NN); LN = LENGTH(N); 
    C<33-LN,LN> PL = N; 
    NN = ET$SEVRTY$NO[I]; N = DEC(NN); LN = LENGTH(N);
    C<39-LN,LN> PL = N; 
    NN = ET$LOCAL$NO[I]; N = DEC(NN); LN = LENGTH(N); 
    C<45-LN,LN> PL = N; 
    CBLIST(FCODE,PL,50);
    END 
  CBLIST(FCODE,"END ETEXT",9);
END   #PRINT$ETEXT# 
$END
CONTROL EJECT;
          PROC   FIND$INDX (RI);
          BEGIN 
# 
          THIS PROC ACCEPTS A GLOBOAL DIAGNOSTIC NUMBER IN RI AND RETURN
                 RETURNS: 
                 DLVL =      DIAG LEVEL NR
                 T1 =        LENGTH OF TEXT IN CHARS
                 T2 =        ADDRESS OF THE TEXT
  
          IF RI IS OUT OF RANGE, WE RETURN: 
                 DLVL = CATASTROPH
                 T1 = 30
                 T2 =XNOTXT 
# 
          ITEM   RI          U; 
          FINDIAG(RI,DLVL,T1,T2); 
  
              $BEGIN
              IF DFDEBUG  THEN
                  OUTPUT(6,"RI,I,ETC=", DEC(RI),DEC(I),DEC(DLVL), 
                  DEC(T1),DEC(T2)); 
              $END
          RETURN; 
  
          END    #FIND$INDX#
CONTROL EJECT;
PROC LCS$FORMAT;
  # PUT LINE COLUMN AND SEVERITY IN THE PRINT LINE
              # 
BEGIN 
  $BEGIN
    IF DFDEBUG THEN OUTPUT(2," LCS$FORMA","T CALLED."); 
  $END
  ITEM RI U;
  RI = VIRTUAL(TABLETYPE"WORK1$",I);
  PL = SPACES;   #CLEAR PRINT LINE# 
  
          CH = ELEV[DLVL];
    C<S$TAB+1,1> PL = CH; #PUT SEVERITY CODE IN PRINT LINE #
    $BEGIN
      IF DFDEBUG THEN OUTPUT(2," S$CODES =",CH);
    $END
      NN=W1$LINE$NO[RI];
      IF NN NQ 0
      THEN BEGIN
           N = DEC(NN); 
           LN = LENGTH(N);
           C<L$TAB+4-LN,LN>PL = N;
           NN = W1$COLUMN$NO[RI]; 
           IF NN NQ 0 
           THEN BEGIN 
                N = DEC(NN);
                LN = LENGTH(N); 
                C<C$TAB+3-LN,LN>PL = N; 
                END 
           ELSE  C<C$TAB,3>PL = " NA";
           END
          CONTROL IFNQ CB5$CDCS,"NO"; 
           NN = W1$COLUMN$NO[RI]; 
           IF NN EQ 253      #SS-RELATED ERROR# 
                THEN C<C$TAB,3>PL = " SS";
          CONTROL FI; 
              $BEGIN
              IF DFDEBUG  THEN
                  OUTPUT(3,"DLVL = ", DEC(DLVL), PL); 
              $END
          RETURN; 
END   #LCS$FORMAT#
CONTROL EJECT;
PROC FORMATTER; 
BEGIN 
  $BEGIN
    IF DFDEBUG THEN OUTPUT(2," FORMATTER"," CALLED.");
  $END
  ITEM RI U;
  
IF FORMAT$FLAG EQ SINGLE
THEN
  BEGIN 
  S$TAB = 0; L$TAB = 4; C$TAB = 9; E$TAB = 13; MTAB = 20; 
  PL = SPACES;
  C<S$TAB,3> PL = "SEV";
  C<L$TAB,4> PL = "LINE"; 
  C<C$TAB,3> PL = "COL";
  C<E$TAB,5> PL = "ERROR";
  CBLIST(SUBTITLE$DEF,PL,E$TAB+5);
  END 
ELSE
  BEGIN 
  E$TAB = 0;
  MTAB = 7; 
  S$TAB = 8;
  L$TAB = 12; 
  C$TAB = 17; 
  END 
CBLIST(EJECT);
  
  # I IS THE INDEX OF THE ETEXT ATOM TO BE PROCESSED. THE ETEXT IS
    LOOPED THRU AND EACH ENTRY IS PROCESSED. #
  
  $BEGIN
    IF DFDEBUG THEN OUTPUT(2," ETLEN = ",DEC(ET$LENGTH)); 
  $END
  
  FOR $$$DUMMY$$$$ = 1 STEP 1 UNTIL NBRTOPRINT DO 
    BEGIN 
    I = $$$DUMMY$$$$; 
    $BEGIN
      IF DFDEBUG THEN 
OUTPUT(4,"OUTER LOOP",", VALUE OF"," I IS  ",DEC(I)); 
    $END
  
    RI = VIRTUAL(TABLETYPE"WORK1$",I);
    FCODE = DOUBLE$SP;
    J = W1$PHASE$NO[RI];
    IF J GR 8 THEN J = 0;  # USE 0 IF ILLEAGAL ID # 
    DN = J * 1000 + W1$LOCAL$NO[RI];
    FIND$INDX(DN);
    LCS$FORMAT; 
          DIAGS$PRINT = DIAGS$PRINT + 1;    #UP NR DIAGS PRINTED# 
          N = DEC(DN);
          LN = LENGTH(N); 
  C<E$TAB+5-LN,LN> PL = N;
          P<TEXT> = T2;      #SET DIAG TEXT ADDR# 
  
          IF  MTAB + T1 LQ  LINE$LENGTH  THEN 
              BEGIN 
              J = MTAB; 
          FOR I = 0 STEP 10  UNTIL T1-1  DO 
                  BEGIN 
                  T2 = I / 10;
                  C<J,10>PL = TEXT$W[T2]; 
                  J = J + 10; 
                  END 
              CBLIST(FCODE,PL,MTAB+T1); 
              PL = SPACES;
              END 
          ELSE
              FOR I = 0 STEP 1 UNTIL T1-1  DO 
#                     * * * * WARNING * * * *              #
#                                                          #
#                            THIS LOOP MUST MODIFY I TO    #
#                            TAKE PROPER SIZED STEPS       #
#                                                          #
                  BEGIN 
                  J= I + (LINE$LENGTH - MTAB ); 
  
                  IF  J GR T1-1  THEN 
                      J = T1 - 1; 
                  L = MTAB; 
          #SCAN BACKWARDS TO THE FIRST BLANK# 
                  IF J NQ T1-1  THEN
                      BEGIN 
                      FOR K = J STEP -1 UNTIL I  DO 
                          BEGIN 
                          T2 = K / 10;           #COMPUTE WORD NUMBER#
                          ICR = K - (T2 * 10);   #COMPUTE CHAR# 
                          IF C<ICR,1>TEXT$W[T2] EQ " "  THEN
                              BEGIN 
                              J = K;
                              K = I;   #STOP LOOPING# 
                              END 
                          END 
                      END 
          #MOVE THE MESSAGE STRING TO PL# 
                  FOR K = I  STEP 1 UNTIL J DO
                      BEGIN 
                      T2 = K / 10;
                      ICR = K - (T2 *10); 
                      C<L,1>PL = C<ICR,1>TEXT$W[T2];
                      L = L + 1;
                      END 
                  CBLIST(FCODE, PL, MTAB+L);
                  PL = SPACES;
                  FCODE = SINGLE$SP;
                  I = J;
                  END 
  END 
END #FORMATTER# 
CONTROL EJECT;
INITIALIZE: 
  
$BEGIN
IF CCTCHKOUT[0] NQ 0
   AND
   (PARAMC[0] EQ "DEBUG" OR PARAMC[1] EQ "DEBUG") 
THEN
    DFDEBUG = TRUE; 
ELSE
    DFDEBUG = FALSE;
  
  
IF CCTCHKOUT[0] NQ 0
   AND
   (PARAMC[0] EQ "ALL" OR PARAMC[1] EQ "ALL") 
THEN
    CCTETEXTLEN = 32000;
  
# PARAMETERS ARE- "ALL" AND "DEBUG" # 
# "DEBUG" SELECTS TRACE INFO AND    # 
# "ALL" SELECTS A DUMP OF ALL       # 
# MESSAGES IN THE SYSTEM.           # 
$END
  
  
  
  
ET$LENGTH = CCTETEXTLEN;
          LINE$LENGTH = CC$PW - 2;     # SET LENGTH OF DIAG LINE #
CONTROL$: 
CBLIST(OPENF,";STDDGN",7);
PL = SPACES;
        LISTTYP = "     DIAGNOSTICS IN "; 
        IF CCTDIAGTT[0] 
        THEN CBLIST(SH$TITLE,LISTHED,SHTITLELEN); 
        ELSE CBLIST(TITLE$DEF,LISTHED,TITLELEN);
  
  
  # CHECK FOR NO DIAGNOSTICS
                              # 
IF CCTETEXTLEN EQ 0 
THEN
  BEGIN 
      $BEGIN
        IF DFDEBUG THEN DISPLAY(2," ETEXTLENGTH = 0",0,15); 
      $END
              RETURN; 
  END 
          IF  CCTDGLISTFIL NQ " "  THEN 
              BEGIN 
              C<0,7>ALTFET = CCTDGLISTFIL;
              CBLIST(13,0, LOC(ALTFET));
              END 
$BEGIN
  # 
    CHECK TO SEE IF ALL MESSAGES TO BE DUMPED.
          # 
IF CCTETEXTLEN EQ 32000 
THEN
  BEGIN 
                  CCTDIAGLEVEL = TRIVIAL; 
                  CCTANSIDIAG = TRIVIAL;
    $BEGIN
      IF DFDEBUG THEN DISPLAY(2," ETEXTLEN = 32000",0,17);
    $END
  # 
    BUILD ETEXT TO GENERATE EVERY MESSAGE 
                     #
                  ITEM  RJ   U; 
              K = 1;
  RJ = VIRTUAL(TABLETYPE"WORK1$",K);
  FOR I = 1 STEP 1 UNTIL 8 DO 
    BEGIN 
      $BEGIN
        IF DFDEBUG THEN 
          BEGIN 
  
OUTPUT(4,"ET GEN: VA","LUE OF I ","IS  ",DEC(I)); 
          END 
        $END
                      FOR  J = 0 STEP 1 UNTIL 999  DO 
      BEGIN 
                      L = J + I * 1000; 
                      FIND$INDX(L); 
                      IF  T2 NQ  LOC(NOTXT) THEN
                          BEGIN 
                          WORK1WORD[RJ] = 0;
                          W1$PHASE$NO[RJ] = I;
                          W1$LOCAL$NO[RJ] = J;
                          K = K + 1;
                          RJ = VIRTUAL(TABLETYPE"WORK1$",K);
                          END 
                      ELSE
                          BEGIN 
                              $BEGIN
                              IF DFDEBUG AND J LS 100  THEN 
                                  OUTPUT(3,"NO DIAG FO", "R INDX",
                                  DEC(L));
                              IF DFDEBUG AND J EQ 100  THEN 
                                  OUTPUT(2, "NUMBERS SU","PRESSED");
                              $END
                          END 
      END 
    END 
  $BEGIN
  IF DFDEBUG THEN 
                      OUTPUT(4, "DUMMY ETEX", "T CREATED,", " K =", 
                      DEC(K));
  $END
  NBRTOPRINT = K - 1; 
  FORMAT$FLAG = SINGLE; 
  MTAB = 20;
  C<MTAB,21> PL = "COMPLETE MESSAGE LIST";
  FORMATTER;
  GOTO CLOSE$UP;
  END 
$END
 #    GO THROUGH DIAGNOSTICS THROWING AWAY ONES WHICH WILL NOT BE # 
 #    PRINTED - ALSO COUNT SUCH ELIMINATED ONES # 
  J = 1;
  FOR I = 1 STEP 1 UNTIL CCTETEXTLEN DO 
    BEGIN 
    VI = VIRTUAL(TABLETYPE"ETEXT$",I);
    DN = ET$PHASE$NO[VI] * 1000 + ET$LOCAL$NO[VI];  # GLOBAL DIAG NBR # 
    FIND$INDX(DN);
    GOTO ERRS[DLVL - 1];
  
 TRIV:  
    TOTT$ERR = TOTT$ERR + 1;
    IF CCTDIAGLEVEL GR TRIVIAL
    THEN
      BEGIN 
      REG1 = REG1 + 1;
      TEST;    # DONT PRINT THIS ONE #
      END 
    GOTO PRINTIT; 
  
 WARN:     # W - WARNING TYPE # 
    TOTW$ERR = TOTW$ERR + 1;
    IF CCTDIAGLEVEL GR WARNING
    THEN
      BEGIN 
      REG2 = REG2 + 1;
      TEST;   # DONT PRINT THIS ONE # 
      END 
    GOTO PRINTIT; 
  
 FATL:    # F - FATAL ERROR # 
    TOTF$ERR = TOTF$ERR + 1;
    IF CCTDIAGLEVEL GR FATAL
    THEN
      BEGIN 
      REG3 = REG3 + 1;
      TEST;   # DONT PRINT THIS ONE # 
      END 
    GOTO PRINTIT; 
  
 CATS:     # C - CATASTROPHIC ERROR # 
    TOTC$ERR = TOTC$ERR + 1;
    GOTO PRINTIT; 
  
 NANSI:      # N - NON-ANSI ERROR # 
    IF CCTANSIDIAG EQ 0 THEN
      TEST;  # IGNORE - ANSI DIAGS NOT SELECTED # 
    IF CCTANSIDIAG EQ TRIVIAL THEN
      BEGIN 
      TOTT$ERR = TOTT$ERR + 1;
      IF CCTDIAGLEVEL GR TRIVIAL THEN 
        BEGIN 
        REG4 = REG4 + 1;
        TEST; 
        END 
      END 
    ELSE
      BEGIN 
      TOTF$ERR = TOTF$ERR + 1;
      IF CCTDIAGLEVEL GR FATAL THEN 
        BEGIN 
        REG4 = REG4 + 1;
        TEST; 
        END 
      END 
  
 PRINTIT: 
    T1 = VIRTUAL(TABLETYPE"WORK1$",J);
  #    CREATE WORK TABLE ENTRY FOR DIAG TO BE PRINTED  #
    WORK1WORD[T1] = 0;
    W1$LINE$NO[T1] = ET$LINE$NO[VI];
    W1$COLUMN$NO[T1] = ET$COLUMN$NO[VI];
    W1$PHASE$NO[T1] = ET$PHASE$NO[VI];
    W1$LOCAL$NO[T1] = ET$LOCAL$NO[VI];
    J = J + 1;
    END 
  NBRTOPRINT = J - 1; 
  # 
    ETEXT IS SORTED BY LINE AND COLUMN NUMBER, OR, MESSAGE NUMBER 
    DEPENDING ON THE COMPILE OPTIONS. 
                # 
  BEGIN 
  $BEGIN
    IF DFDEBUG THEN PRINT$ETEXT;
  $END
  T1 = NBRTOPRINT;
          I = 1;
          QSORT4( I,  T1 ) ;
  $BEGIN
    IF DFDEBUG THEN PRINT$ETEXT;
  $END
  END 
FORMATTER;
CLOSE$UP: 
MTAB = 20;
PL = SPACES;
      # IF ETEXT LENGTH IS ZERO AND SUPPRESSED-MESSAGE COUNTS  #
      # ARE ZERO, PUT - NO ERRORS - IN THE REPORT.             #
      IF CCTETEXTLEN EQ 0  AND  REG1 EQ 0  AND
         REG2 EQ 0  AND  REG3 EQ 0  AND  REG4 EQ 0
      THEN
              RETURN; 
      ELSE BEGIN
           IF DIAGS$PRINT EQ 0 AND  REG3 EQ 0    #CHECK NR DIAGS PRINTD#
           THEN C<MTAB,42>PL= 
                 " **     NO SEVERE ERRORS               ** ";
           ELSE BEGIN 
                IF DIAGS$PRINT EQ 1 
                THEN C<MTAB,42>PL = 
                   " **      1 ERROR LISTED                ** ";
                ELSE BEGIN
                    N = DEC(DIAGS$PRINT); 
                     LN = LENGTH(N);
                     C<MTAB,5>PL = " **  "; 
                     I = 5 - LN;
                     IF I NQ 0
                     THEN C<MTAB+5,I>PL = "     ";
                     C<MTAB+I+5,LN>PL = N;
                     C<MTAB+I+5+LN,32>PL =
                        " ERRORS LISTED               ** "; 
                     END
                 END
            END 
      CBLIST(DOUBLE$SP,PL,MTAB+45); 
      MTAB = 20;
      PL = SPACES;
  
      IF REG1 EQ 0  AND  REG2 EQ 0  AND 
         REG3 EQ 0  AND  REG4 EQ 0
      THEN BEGIN
           C<MTAB,42>PL=" **     NO UNLISTED ERRORS             ** "; 
           CBLIST(DOUBLE$SP,PL,MTAB+45);
           MTAB = 20; 
           PL = SPACES; 
           END
  
      IF REG1 NQ 0
      THEN BEGIN
           IF REG1 EQ 1 
           THEN C<MTAB,42>PL= 
                  " **      1 UNLISTED TRIVIAL ERROR      ** "; 
           ELSE BEGIN 
                N = DEC(REG1);
                LN = LENGTH(N); 
                C<MTAB,5>PL = " **  ";
                I = 5 - LN; 
                IF I NQ 0 
                THEN C<MTAB+5,I>PL = "     "; 
                C<MTAB+I+5,LN>PL = N; 
                C<MTAB+I+5+LN,31>PL=" UNLISTED TRIVIAL ERRORS     **";
                END 
           CBLIST(DOUBLE$SP,PL,MTAB+45);
           MTAB = 20; 
           PL = SPACES; 
           END
  
      IF REG2 NQ 0
      THEN BEGIN
           IF REG2 EQ 1 
           THEN C<MTAB,42>PL =
                  " **      1 UNLISTED WARNING ERROR      ** "; 
           ELSE BEGIN 
                N = DEC(REG2);
                LN = LENGTH(N); 
                C<MTAB,5>PL = " **  ";
                I = 5 - LN; 
                IF I NQ 0 
                THEN C<MTAB+5,I>PL = "     "; 
                C<MTAB+I+5,LN>PL = N; 
                C<MTAB+I+5+LN,31>PL=" UNLISTED WARNING ERRORS     **";
                END 
           CBLIST(DOUBLE$SP,PL,MTAB+45);
           MTAB = 20; 
           PL = SPACES; 
           END
  
      IF REG3 NQ 0
      THEN BEGIN
           IF REG3 EQ 1 
           THEN C<MTAB,42>PL =
                  " **      1 UNLISTED FATAL ERROR        ** "; 
           ELSE BEGIN 
                N = DEC(REG3);
                LN = LENGTH(N); 
                C<MTAB,5>PL = " **  ";
                I = 5 - LN; 
                IF I NQ 0 
                THEN C<MTAB+5,I>PL = "     "; 
                C<MTAB+I+5,LN>PL = N; 
                C<MTAB+I+5+LN,31>PL=" UNLISTED FATAL ERRORS       **";
                END 
  
           CBLIST(DOUBLE$SP,PL,MTAB+45);
           MTAB = 20; 
           PL = SPACES; 
           END
      IF REG4 NQ 0
      THEN BEGIN
           IF REG4 EQ 1 
           THEN C<MTAB,42>PL =
                " **      1 UNLISTED NON-ANSI MESSAGE   ** "; 
           ELSE BEGIN 
                N = DEC(REG4);
                LN = LENGTH(N); 
                C<MTAB,5>PL = " **  ";
                I = 5 - LN; 
                IF I NQ 0 
                THEN C<MTAB+5,I>PL = "     "; 
                C<MTAB+I+5,LN>PL = N; 
                C<MTAB+I+5+LN,31>PL = " UNLISTED NON-ANSI MESSAGES  **";
                END 
           CBLIST(DOUBLE$SP,PL,MTAB+45);
           MTAB = 20; 
           PL = SPACES; 
           END
  
CBLIST(CLOSEF,";STDDGN",7); 
END  #D$FORMATTER#
TERM
