*DECK CBDIAG                                                            016130
  PROC CBDIAG;                                                          016140
    BEGIN                                                               016150
      XREF                                                              016160
        BEGIN                                                           016170
          ITEM NBRLINE;   # DISPLAY CODED SOURCE LINE NUMBER.          #016180
            ITEM BLKLINE;    # ADDRESS TO PICK UP SOURCE INFO FOR PRNT #
          ITEM NEXNBRLINE;   # DISPLAY SOURCE LINE NO. FOR N E X ITEM. #000320
          ITEM NEXBLKLINE;   # START OF PRINT LINE FOR N E X ITEM.     #000330
          PROC DDLPRNT;   # PRINTS FIXED LENGTH DIAGNOSTICS.           #016190
          PROC DDLERR;   # PROCESS VARIABLE DIAGNOSTICS.               #016200
          ITEM ERRCNTR;                                                 016210
            ITEM NOLIST;     # LIST OPTION---1 = NO LIST, 0 = LIST.    #
          ITEM NEXLENG; 
          ITEM NEXLENW; 
          ITEM ABORTFLAG;              # SET WHEN A SUB-SCHEMA IS NOT  #
                                       # TO BE CREATED.                #
          ITEM TRVERR;             # SET IN THE EVENT OF TRIVIAL ERRORS#
          ARRAY NEXWORD [3] S(1); 
            ITEM NEXWRD U(0,0,60);
          PROC SNATCHO;                                                 016220
          PROC SNATCHF;                                                 016230
        END                                                             016240
  ENTRY PROC DIAGDL(DIAGNBR);                                           016250
      ITEM I; 
      ITEM J; 
      ITEM K; 
      ITEM DIAGNBR;                                                     016260
      ITEM DPTR;    # SUBSCRIPT IN THE DIAG MSGS.                      #016270
      ITEM ERRORTYPE;                                                   016280
      ITEM P1;     # FIRST PARAMETER PASSED TO THE PRINT ROUTINE.      #016290
      ITEM P2;     # SECOND PARAMETER PASSED TO THE PRINT ROUTINE.     #016300
      ITEM STDCALL B;   # TRUE IF CALLED FROM STD (SYNGEN CODE)        #000370
      ARRAY ERRORCNTR [7];   # ERROR TYPE COUNTER.                     #016310
        ITEM ERRCNT I(0,0,60);                                          016320
      XREF ARRAY D100 [0];  # POINTS TO THE DIAGNOSTIC MSGS.          # 
        ITEM DMSGPTR U(0,0,60);                                         016340
      XREF ARRAY DIAGPTR [0];  # DIAGNOSTICS MSGS.                     #016350
        ITEM MSGPTR U(0,0,60);                                          016360
      BASED ARRAY RA [0];                                               016370
        ITEM RELADR U(0,0,60);                                          016380
      BASED ARRAY DIAGNBRSTD [0];                                       016390
        ITEM DIAGSTDNBR U(0,0,60);                                      016400
      BASED ARRAY PARM [0];;                                            016410
      STDCALL = FALSE;                                                  000390
  CONTDIAG:                                                             016420
      P<RA> = 0;                                                        016430
      IF DIAGNBR NQ 200 THEN
        ABORTFLAG = 1;
      ERRCNTR = ERRCNTR + 1;                                            016440
      DPTR = (DIAGNBR-100) / 2;                                         016500
      IF B<59,1>DIAGNBR EQ 1 THEN   # CHECK IF EVEN OR ODD DIAG NUMBER.#016510
        BEGIN      # GET THE WORD ADDRESS OF THE DIAG MSG FROM THE 2ND #016520
          P1 = B<42,18>MSGPTR[DPTR]; # HALF OF THE MSG PTR WRD.      #  016530
          P2 = B<34,8>MSGPTR[DPTR]; # GET THE LENGTH OF THE DIAG.    #  016540
          ERRORTYPE = B<30,4>MSGPTR[DPTR]; # GET THE ERROR TYPE.       #
        END                                                             016560
      ELSE                                                              016570
        BEGIN      # GET THE WRD ADDR OF THE DIAG MSG FROM THE FIRST   #016580
          P1 = B<12,18>MSGPTR[DPTR]; #HALF OF THE MSG PTR WORD.#        016590
          P2 = B<4,8>MSGPTR[DPTR];   # GET THE LENGTH OF THE DIAG.     #
          ERRORTYPE = B<0,4>MSGPTR[DPTR];  # GET THE ERROR TYPE.       #
        END                                                             016620
      ERRCNT[ERRORTYPE] = ERRCNT[ERRORTYPE] + 1; # INCREMENT ERR CNTR. #016630
      IF ERRORTYPE EQ 7 THEN       # IF TRIVIAL ERROR                  #
        TRVERR = 1;                # SET TRIVIAL ERROR FLAG            #
      IF NOT STDCALL                                                    000410
      THEN RELADR[P1+1] = NBRLINE; # STORE DISPLAY LINE NUMBER IN DIAG.#000420
      ELSE RELADR[P1+1] = NEXNBRLINE; # USE NEX LINE NO. ON STD(SYNGEN)#000430
                                   # CALLS, SINCE FTSYN PRINTS DIAG    #000440
                                   # BEFORE +SNS/+SNW MOVE NEX TO CUR. #000450
          P<PARM> = P1;                                                 016650
      IF DIAGNBR EQ 145 THEN
        BEGIN 
          K = NEXLENG;
          J = NEXLENW;
          FOR I=0 STEP 1 UNTIL 2 DO 
            BEGIN 
              IF J GR 0 THEN
                RELADR[P1 + 3 + I] = NEXWRD[I]; 
               ELSE 
                RELADR[P1 + 3 + I] = O"55555555555555555555"; 
              J = J - 1;
              K = K - 10; 
              IF J GR 0 AND K LS 0 THEN 
                BEGIN 
                  K = 6 * (-K); 
                  B<60-K,K>RELADR[P1 + 3 + I] = O"55555555555555555555";
                END 
            END 
        END 
      IF NOLIST EQ 1 THEN     # IF THE NO LIST OPTION IS ON, THEN      #
        IF NOT STDCALL                                                  000470
        THEN DDLPRNT(BLKLINE,120); # PRINT SOURCE LINE THIS DIAGNOSTIC #000480
                                   # PERTAINS TO.                      #
        ELSE DDLPRNT(NEXBLKLINE,120);# USE NEX LINE ON STD(SYNGEN CODE)#000500
                                     # CALLS, SINCE FTSYN PRINTS DIAG  #000510
                                     # BEFORE +SNS/+SNW MOVE NEX TO CUR#000520
      DDLPRNT(PARM,P2);                                                 016660
      RETURN;                                                           016670
  ENTRY PROC DIAGSTD(DIAGNBR);                                          016680
      P<DIAGNBRSTD> = LOC(DIAGNBR);                                     016690
      DIAGNBR = DIAGSTDNBR[0];                                          016700
      STDCALL = TRUE;                                                   000540
      GOTO CONTDIAG;                                                    016710
    END                                                                 016720
  TERM;                                                                 016730
