*DECK CBRDIAG 
  PROC CBRDIAG(DIAGNBR,PARMBUF,PARMLENG); 
    BEGIN 
      XREF ITEM ABORTFLAG;             # INDICATES A FATAL ERROR AS    #
                                       # BEEN ISSUED AND THE SUB-SCHEMA#
                                       # IS NOT TO BE SAVED.           #
      XREF ITEM BLKLINE;               # ADDRESS OF THE CURRENT INPUT  #
                                       # RECORD.                       #
      XREF ITEM NEXBLKLINE;            # PRINT LINE FOR N E X ITEM.    #000570
      XREF ITEM CURLENG;               # LENGTH IN CHARACTERS OF THE   #
                                       # CURRENT SOURCE WORD.          #
      XREF ITEM ERRCNTR;               # CONTAINS THE NUMBER OF ERROR  #
                                       # MESSAGES ISSUED.              #
      XREF ITEM NEXLENG;               # LENGTH IN CHARACTERS OF THE   #
                                       # NEXT SOURCE WORD.             #
      XREF ITEM NBRLINE;               # DISPLAY CODED SOURCE LINE     #
                                       # NUMBER.                       #
      XREF ITEM NEXNBRLINE;            # DISPLAY LINE NO. FOR NEX ITEM.#000600
      XREF ITEM NOLIST;                # 1 = NO LIST OPITION SPECIFIED.#
                                       # 0 = OUTPUT LISTING PRODUCED.  #
      XREF ARRAY CWORD [3] S;          # CONTAINS THE CURRENT SOURCE   #
        ITEM CURWRD30 C(0,0,30);       # WORD.                         #
      XREF ARRAY RELDPTR [0];          # DIAGNOSTIC INDEX CREATED IN   #
        ITEM MSGINDX U(0,0,60);        # CBRDAGM.                      #
      XREF ARRAY NEXWORD [3] S;        # CONTAINS THE NEXT SOURCE WORD.#
        ITEM NEXWRD30 C(0,0,30);
      XREF PROC DDLPRNT;               # ED BUFFERS TO THE OUTPUT FILE.#
      ITEM DIAGADR;                    # CONTAINS THE WORD ADDRESS     #
                                       # CRELATIVE TO THE FIRST WORD OF#
                                       # THE USERS FIELD LENGTH) OF THE#
                                       # REQUESTED MESSAGE.            #
      ITEM DIAGLENG;                   # LENGTH IN CHARACTERS OF THE   #
                                       # REQUESTED MESSAGE.            #
      ITEM DIAGPTR;                    # SUB-SCRIPT INTO THE DIAGNOSTIC#
                                       # INDEX (RELDPTR).              #
      ITEM DIAGTYPE;                   # 0 = PRINT DIAGNOSTIC, NO      #
                                       #     INSERTIONS.               #
                                       # 1 = PRINT DIAGNOSTIC, INSERT  #
                                       #     THE CONTENTS OF NEXTWORD. #
                                       # 2 = PRINT DIAGNOSTIC, INSERT  #
                                       #     THE CONTENTS OF THE BUFFER#
                                       #     PASSED IN THE PARAMETER   #
                                       #     LIST.                     #
      ITEM DIAGNBR;                    # THE DIAGNOSTIC NUMBER PASSED  #
                                       # IN THE PARAMETER.             #
      ITEM ERRLENG;                    # LENGTH IN CHARACTERS OF THE   #
                                       # SYNTAX WORD IN ERROR. COULD   #
                                       # BE PASSED AS A PARAMETER (ERR #
                                       # TYPE 2).                      #
      ITEM PARMLENG;                   # LENGTH OF THE SOURCE WORD IN  #
                                       # ERROR IS PASSED IN THE        #
                                       # PARAMETER LIST (LENG IN CHAR).#
      ITEM I;                          # SCRATCH ITEM.                 #
      ITEM J;                          # SCRATCH ITEM.                 #
      ITEM K;                          # SCRATCH ITEM.                 #
      ITEM STDCALL B;                  # TRUE IF CALLED BY STD (FTRSYN)#000630
      ARRAY ERRORBUF [3] S(1);         # INTERMEDIATE BUFFER THAT CONT-#
        ITEM ERRWRD30 C(0,0,30);       # AINS THE SOURCE WORD THATS IN #
                                       # ERROR.                        #
      ARRAY MESSAGEBUF [15] S;         # CONTAINS THE MESSAGE IF ANY   #
        ITEM MSGBUF C(0,0,150);        # INSERTIONS WHERE MADE.        #
      ARRAY PARMBUF [3] S;             # SOURCE WORD IN ERROR IS PASSED#
                                       # AS A PARAMETER.               #
        ITEM PARMWRD30 C(0,0,30); 
      BASED ARRAY DIAGNBRSTD [0];      # USED TO GET THE DIAGNOSTIC    #
        ITEM DIAGSTDNBR U(0,0,60);     # NUMBER WHEN CALLED BY CTLSTD. #
      BASED ARRAY PARM [0];;           # ADDRESS OF THE BUFFER TO BE   #
                                       # PRINTED.                      #
      BASED ARRAY RA [0];              # POINTS TO THE FIRST WORD OF   #
        BEGIN                          # CORE. (RA + 0)                #
          ITEM RELADR C(0,0,150); 
          ITEM RELWORD U(0,0,60); 
        END 
      STDCALL = FALSE;                                                  000650
  CONTDIAG: 
      P<RA> = 0;  # POINT BASED ARRAY TO ZERO. ADDRESS OF THE DIAGNOST #
                  # MESSAGE IS FETCHED BY USING A BASED ARRAY POINTING #
                  # TO WORD ZERO AND USING THE WORD ADDRESS OF THE     #
                  # MESSAGE AS A SUB-SCRIPT.                           #
      ABORTFLAG = 1; # SET THE ABORT FLAG. THIS WILL PERVENT THE SUB-  #
                     # SCHEMA FROM BEING SAVED.                        #
      ERRCNTR = ERRCNTR + 1; # INCREMENT THE ERROR COUNTER.            #
      DIAGPTR = (DIAGNBR-400) / 2; # DETERMINE THE WORD POSITION IN THE#
                 # THE POINTER ARRAY OF THE DESIRED MESSAGE.           #
      IF B<59,1>DIAGNBR EQ 1 THEN # DETERMINE IF THE MESSAGE NUMBER IS #
                                  # ODD OR EVEN.                       #
        I = 30; 
       ELSE 
        I = 0;
      DIAGADR = B<I+12,18>MSGINDX[DIAGPTR]; # GET ADDR OF MESSAGE      #
      DIAGLENG = B<I+3,9>MSGINDX[DIAGPTR]; # GET MESSAGE LENG (CHAR).  #
      DIAGTYPE = B<I,3>MSGINDX[DIAGPTR]; # GET MESSAGE TYPE.           #
      IF NOT STDCALL                                                    000670
      THEN RELWORD[DIAGADR+1] = NBRLINE; # STORE DISP. LINE NO. IN DIAG#000680
      ELSE RELWORD[DIAGADR+1] = NEXNBRLINE; # USE NEX NO.ON STD(SYNGEN)#000690
                                   # CALLS, SINCE FTSYN PRINTS DIAG    #000700
                                   # BEFORE +SNS/+SNW MOVE NEX TO CUR. #000710
      IF DIAGTYPE GR 0 THEN # MESSAGE TYPES GREATER THAN ZERO HAVE     #
        BEGIN    # EITHER A NAME OR A SOURCE THAT ARE IN ERROR PRINTED #
                 # IN THE DIAG MESSAGE.                                #
          IF DIAGTYPE EQ 1 THEN # SOURCE WORD IN ERROR IS STORED IN    #
            BEGIN  # NEXWORD.                                          #
              ERRWRD30[0] = CURWRD30[0]; # MOVE SOURCE WORD INTO TEMP  #
                                         # BUFFER.                     #
              IF CURLENG GR 30 THEN # MAXIMIM INSERTION SIZE IS 30 CHAR#
                ERRLENG = 30; 
               ELSE 
                ERRLENG = CURLENG;
            END 
       ELSE 
          IF DIAGTYPE EQ 3 THEN # CHECK IF SOURCE WORD IS ERROR IS IN  #
            BEGIN               # NEXWORD.                             #
              ERRWRD30[0] = NEXWRD30[0]; # MOVE SOURCE WORD INTO TEMP  #
                                         # BUFFER.                     #
              IF NEXLENG GR 30 THEN 
                ERRLENG = 30; 
               ELSE 
                ERRLENG = NEXLENG;
            END 
           ELSE 
        BEGIN 
          ERRWRD30[0] = PARMWRD30[0]; # STORE THE SOURCE WORD THAT IS  #
                                      # IN ERROR.                      #
          ERRLENG = PARMLENG; 
        END 
          FOR I=0 STEP 1 WHILE C<I,1>RELADR[DIAGADR] NQ O"45" DO
            C<I,1>MSGBUF[0] = C<I,1>RELADR[DIAGADR]; # MOVE THE DIAGNOS#
                # TIC CHAR BY CHAR FROM CBRDAGM TO A TEMPORARY BUFFER. #
                 # MOVE UNTIL THE INSERTION FLAG "+" WAS ENCOUNTERED.  #
          K = I + 1; # STORE THE CHAR POS OF REST OF DIAG TO BE MOVED. #
          FOR J=0 STEP 1 UNTIL ERRLENG - 1 DO # MOVE THE SOURCE WORD   #
               # IN ERROR INTO THE MESSAGE BUFFER.                     #
            BEGIN 
              C<I,1>MSGBUF[0] = C<J,1>ERRWRD30[0];
              I = I + 1;
            END 
          FOR I=I STEP 1 UNTIL DIAGLENG +ERRLENG - 1 DO # MOVE THE REST#
            BEGIN  # OF THE DIAGNOSTIC MESSAGE INTO THE MSGBUFFER.     #
              C<I,1>MSGBUF[0] = C<K,1>RELADR[DIAGADR];
              K = K + 1;
            END 
          P<PARM> = LOC(MESSAGEBUF);
          DIAGLENG = I; 
        END 
       ELSE 
        P<PARM> = DIAGADR;
      IF NOLIST EQ 1 THEN  # IF THE NO LIST OPTION IS ON, THEN PRINT   #
                           # THE SOURCE LINE THAT THIS DIAGNOSTIC      #
                           # PERTAINS TO.                              #
        IF NOT STDCALL                                                  000730
        THEN DDLPRNT(BLKLINE,120);                                      000740
        ELSE DDLPRNT(NEXBLKLINE,120); # USE NEX LINE ON STD(FTRSYN)CALL#000750
                                      # SINCE FTRSYN PRINTS DIAG BEFORE#000760
                                      # +SNS/+SNW MOVE NEX LINE TO CUR.#000770
      DDLPRNT(PARM,DIAGLENG); 
      RETURN; 
  ENTRY PROC DIAGSTD(DIAGNBR);
      P<DIAGNBRSTD> = LOC(DIAGNBR); 
      DIAGNBR = DIAGSTDNBR[0];
      STDCALL = TRUE;                                                   000790
      GOTO CONTDIAG;
    END 
  TERM; 
