Retro1.org codex

*DECK NDLEM2
USETEXT NDLDATT 
USETEXT NDLER2T 
USETEXT NDLFETT 
      PROC NDLEM2(CODE,LINE,CLRWORD); 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLEM2 - PASS 2 ERROR MESSAGE PROC. 
* 
*     D.K. ENDO    81/10/22 
* 
*     THIS PROCEDURE MAKES AN ENTRY INTO THE PASS 2 ERROR FILE AND, 
*     IF NEEDED, FLUSHES THE CIO BUFFER.
* 
*     PROC NDLEM2(CODE,LINE,CLRWORD)
* 
*     ENTRY        CODE = ERROR CODE. 
*                  LINE = SOURCE LINE NUMBER ERROR WAS DETECTED ON. 
*                  CLRWORD = CLARIFIER WORD.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF ERROR CODE IS NON-ZERO,
*     THEN, 
*       SET UP ENTRY. 
*       IF FATAL ERROR, 
*       THEN, 
*         INCREMENT ERROR COUNT.
*       OTHERWISE,
*         INCREMENT WARNING COUNT.
*     OTHERWISE,
*       CREATE ZERO ENTRY(FLAGS EOF). 
*     WRITE ENTRY TO FILE.
*     IF ERROR CODE IS ZERO,
*       FLUSH CIO BUFFER. 
* 
# 
*ENDIF
# 
****  PROC NDLEM2 - XREF LIST BEGINS
# 
      XREF
        BEGIN 
        PROC RECALL;
        PROC WRITEF;         # FLUSHES BUFFER AND WRITES EOF           #
        PROC WRITEW;         # WRITES ENTRY TO FILE                    #
        END 
# 
****
# 
      ITEM CODE;             # ERROR CODE                              #
      ITEM LINE;             # LINBE NUMBER THAT ERROR WAS DETECTED    #
      ITEM CLRWORD C(10);    # CLARIFIER WORD                          #
      ARRAY ELT [0:0]  S(2); # ERROR LISTING TABLE                     #
        BEGIN 
        ITEM ELTCODE I(0,0,12);        # ERROR CODE                    #
        ITEM ELTLINE I(0,12,18);       # LINE NUMBER                   #
        ITEM ELTCLRW C(1,0,10);        # CLARIFIER WORD                #
        ITEM ELTWRD1 U(0,0,60); 
        ITEM ELTWRD2 U(1,0,60); 
        END 
CONTROL EJECT;
#                                                                      #
#                            NDLEM2 CODE BEGINS HERE                   #
#                                                                      #
      IF CODE NQ 0           # BUFFER SHOULD NOT BE CLEARED            #
      THEN
        BEGIN 
        ELTWRD1[0] = 0;                # CLEAR FIRST WORD OF ENTRY     #
        ELTCODE[0] = CODE;             # MAKE ENTRY IN ERROR TABLE     #
        ELTLINE[0] = LINE;
        ELTCLRW[0] = CLRWORD; 
        IF EMT2TYPE[CODE] EQ "E"
        THEN                 # SET FLAG IN SOURCE                      #
          BEGIN 
          ERRCNT = ERRCNT + 1;         # INCREMENT FATAL ERROR COUNT   #
          END 
        ELSE
          BEGIN 
          WARNCNT = WARNCNT + 1;       # INCREMENT WARNING ERROR COUNT #
          END 
        END 
      ELSE                   # CLEAR BUFFER                            #
        BEGIN 
        ELTWRD1[0] = 0;                # MAKE ZEROED ENTRY             #
        ELTWRD2[0] = 0;                #   FLAGGING END OF TABLE       #
        END 
      WRITEW(ERR2FET,ELT,2); # WRITE ENTRY TO FILE                     #
      IF CODE EQ 0
      THEN                             # WRITE BUFFER TO FILE          #
        BEGIN 
        WRITEF(ERR2FET);
        RECALL(ERR2FET);
        END 
      RETURN;                # **** RETURN ****                        #
      END # NDLEM2 #
      TERM