Retro1.org codex

*DECK NDLNFNT 
USETEXT NDLDATT 
USETEXT NDLER2T 
USETEXT NDLFETT 
USETEXT NDLNCFT 
USETEXT NDLPS2T 
USETEXT NDLTBLT 
      PROC NDLNFNT; 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLNFNT - NCF NETWORK ELEMENTS
* 
*     S.M. ILMBERGER         81/11/2
* 
*     PROCESS NETWORK ELEMENT STATEMENTS
* 
*     PROC NDLNFNT
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     INVALID STMT I.D.-ABORT FROM NCFNET 
* 
*     METHOD
* 
*     FOR EACH "NETWORK" OR "TRUNK" TYPE STATEMENT IN STMT$TABLE
*       READ FULL STATEMENT 
*       IF STATEMENT IS NFILE 
*         CLEAR PRFX$TABLE AND VERIFY$ENTRY 
*         CALL NFILE STATEMENT PROCESSOR
*       IF STATEMENT IS NPU 
*         GET AND CLEAR NEXT ENTRY OF NPU$XREF TABLE
*         CALL NPU STATEMENT PROCESSOR
*       IF STATEMENT IS SUPLINK 
*         GET AND CLEAR NEXT ENTRY OF SUPLINK TABLE 
*         CALL SUPLINNK STATEMENT PROCESSOR 
*       IF STATEMENT IS COUPLER 
*         GET AND CLEAR NEXT ENTRY OF PLINK$XREF TABLE
*         CALL COUPLER STATEMENT PROCESSOR
*       IF STATEMENT IS LOGLINK 
*         GET AND CLEAR NEXT ENTRY OF LOGLINK$XREF
*         CALL LOGLINK STATEMENT PROCESSOR
*       IF STATEMENT IS TRUNK 
*         GET AND CLEAR NEXT ENTRY OF PLINK$XREF TABLE
*         CALL TRUNK STATEMENT PROCESSOR
*       IF STATEMENT HAS NOT MATCHED A STATEMENT ID 
*         SEND ERROR MESSAGE
*       READ NEXT STATEMENT HEADER
*     END 
* 
# 
*ENDIF
# 
****  PROC NDLNFNT - XREF LIST BEGINS 
# 
      XREF
        BEGIN 
        PROC ABORT;          # ABORTS NDLP                             #
        PROC SSTATS;         # ALLOCATE MORE TABLE SPACE               #
        PROC MESSAGE;        # MAKE DAYFILE AND SYSTEM CONSOLE MESSAGE #
        PROC READW;          # READ STATEMENT TABLE                    #
        PROC NDLTRNK;        # PROCESS TRUNK STATEMENT                 #
        PROC NDLWNCF;        # WRITE RECORD TO NCF-FILE                #
        END 
# 
****
# 
 
      DEF FSTCT # 1 #;       # FIRST ENTRY IN COUPLER TABLE            #
      DEF FSTLL # 1 #;       # FIRST ENTRY IN LOGLINK-XREF-TABLE       #
      DEF FSTLLT # 1 #;      # FIRST ENTRY IN LOGLINK TABLE            #
      DEF FSTNT # 1 #;       # FIRST ENTRY IN NPU TABLE                #
      DEF FSTPL # 1 #;       # FIRST ENTRY IN PHYSICAL-LINK-XREF TAB   #
      DEF LEN$FH$TAB # 17 #; # LENGTH OF TABLE TO WRITE TO NCF         #
      DEF SECLL # 2 #;       # SECOND ENTRY IN LOGLINK-XREF TAB        #
 
      ITEM COMM$RD$ER  B;    # INDICATES STMT IS COMMUNICATION TYPE OR #
                             # A READ ERROR OCCURED                    #
      ITEM CPL$CNT I;        # NUMBER OF COUPLERS ON CURRENT NPU       #
      ITEM CRNT$CPL C(7);    # NAME OF CURRENT COUPLER                 #
      ITEM CRNT$CNID;        # NODE I.D. OF CRUENT COUPLER             #
      ITEM CRNT$HNAM C(7);   # NAME OF CURRENT HNAME                   #
      ITEM FWAWSA;           # 1ST WORD ADDRESS OF WORKING STORAGE AREA#
      ITEM I;                # LOOP COUNTER                            #
      ITEM PRI$USED B;       # PRIMARY SPECIFIED FLAG                  #
      ITEM SEC$USED B;       # SECONDARY SPECIFIED FLAG                #
 
      ARRAY STMT$TAB [0:11] S(1); #  ROUTES STMT TO NETWORK OR         #
        BEGIN                     #  COMMUNICATION PROCESSOR           #
        ITEM STMT$TYPE C(0,0,10) = [,"NETWORK   ",    # NFILE    #
                                     "NETWORK   ",    # NPU      #
                                     "NETWORK   ",    # SUPLINK  #
                                     "NETWORK   ",    # COUPLER  #
                                     "NETWORK   ",    # LOGLINK  #
                                     "COMMUNIC  ",    # GROUP    #
                                     "COMMUNIC  ",    # LINE     #
                                     "COMMUNIC  ",    # REPEAT   #
                                     "COMMUNIC  ",    # TERMINAL #
                                     "COMMUNIC  ",    # DEVICE   #
                                     "TRUNK     "     # TRUNK    #
                                   ]; 
        END 
 
      SWITCH NET$ELEM        ERR$NET ,  # UNK     # 
                             NFILE$ST,  # NFILE   # 
                             NPU$ST  ,  # NPU     # 
                             SLINK$ST,  # SUPLINK # 
                             COUP$ST ,  # COUPLER # 
                             LLINK$ST,  # LOGLINK # 
                             ERR$NET ,
                             ERR$NET ,
                             ERR$NET ,
                             ERR$NET ,
                             ERR$NET ,
                             TRNK$ST ;  # TRUNK   # 
 
      CONTROL EJECT;
      PROC CHKNODE(NODE$VAL,MXNO,UNQFLG,INRANGE); 
          #   CHECKS THAT NODE NUMBER IS UNIQUE                        #
      BEGIN # CHKNODE PROC   #
*IF,DEF,IMS 
# 
**    CHKNODE - CHECK NODE VALUE
* 
*     S.M. ILMBERGER         81/10/30 
* 
*     CHECK UNIQUENESS OF NODE NUMBER 
* 
*     PROC CHKNODE(NODE$VAL,MXNO,UNQFLG,INRANGE)
* 
*     ENTRY        NODE$VAL - NODE NUM TO CHECK UNIQUENESS OF 
*                  MXNO - MAXIMUM VALUE NODE CAN HAVE 
* 
*     EXIT         UNQFLG - FLAG INDICATING IF NODE IS UNIQUE 
*                  INRANGE - FLAG INDICATING IF NODE IS IN RANGE
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     CALL RNGNODE TO CK IF NODE IS IN RANGE
*     IF NODE IS INRANGE
*       CK BITMAP FOR UNIQUENESS
*       IF NOT UNIQUE 
*         SEND ERROR MSG
*       ELSE
*         SET BIT IN BITMAP 
*     END 
* 
# 
*ENDIF
 
      ITEM CNODEVAL C(10);   # CHARACTER STORAGE FOR NODE NUMBER       #
      ITEM NODE$VAL I;       # NODE NUMBER TO CHECK UNIQUENESS ON      #
      ITEM MXNO     I;       # MAX NUMBER NODE CAN HAVE                #
      ITEM UNQFLG   B;       # NODE UNIQUENESS FLAG                    #
                             # TRUE IF VALUE IS UNIQUE                 #
      ITEM INRANGE  B;       # RANGE RESTRAINT FLAG                    #
                             # TRUE WHEN NODE NUMBER IS IN RANGE       #
 
      XREF
        BEGIN 
        PROC NDLEM2;         # MAKES ENTRY IN ERROR-FILE-2             #
        FUNC XCDD C(10);     # CONVERTS INTEGER TO DECIMAL DISPLAY CODE#
        END 
 
      ITEM BIT;              # INDICATES BIT NUMBER OF BITMAP          #
      ITEM WORD;             # INDICATES WORD OF BITMAP                #
 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      BIT = 0;
      WORD = 0; 
      UNQFLG = TRUE;         # NODE IS UNIQUE                          #
      RNGNODE(NODE$VAL,MXNO,INRANGE); # CK IF NODE IS RANGE            #
      IF INRANGE
      THEN
        BEGIN 
        WORD = (NODE$VAL-1) / 60; # COMPUTE CORRECT WORD OF BITMAP     #
        BIT = (NODE$VAL-1) - (60 * WORD); # AND BIT TO REFER TO        #
        IF B<BIT,1>BITMAP[WORD] EQ 1 # TEST BIT IN BITMAP              #
        THEN                 # IF ALREADY SET                          #
          BEGIN 
          CNODEVAL = XCDD(NODE$VAL);   # CONVERT INTEGER TO DEC DISPLAY#
          NDLEM2(ERR125,STLNUM[0],CNODEVAL); # SEND ERROR MSG          #
          UNQFLG = FALSE;    # SET FLAG TO INDICATE VALUE NOT UNIQUE   #
          END 
        ELSE                 # OTHERWISE SET FLAG                      #
          BEGIN 
          B<BIT,1>BITMAP[WORD] = 1; 
          END 
        END   # IF INRANGE #
      RETURN; 
 
      END   # CHKNODE PROC #
 
      CONTROL EJECT;
      PROC CPLERPR;          # PROCESS COUPLER STATEMENT               #
      BEGIN 
*IF,DEF,IMS 
# 
**    CPLERPR - COUPLER PROCESSOR 
* 
*     S.M. ILMBERGER         81/10/30 
* 
*     PROCESS COUPLER STATEMENT 
* 
*     PROC CPLERPR
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     INVALID KEYWORD I.D.-ABORT FROM CPLERPR 
* 
*     METHOD
* 
*     IF NO LABEL ERROR 
*       SAVE COUPLER NAME 
*       SET COUPLER FLAG IN PLINK$XREF
*     FOR EACH KEYWORD ON STATEMENT 
*       IF NO VALUE ERROR 
*       SAVE INFO IN APPROPRIATE POSITION OF PLINK$XREF TABLE 
*     IF NO NODE OR HNAME PARAMETER SPECIFIED 
*       FLAG ERROR
*     IF DUPLICATE COUPLER LOC VALUE
*       FLAG ERROR
*     IF MORE THAN TWO COUPLERS 
*       FLAG ERROR
*     SET BIT IN LOC BITMAP FOR LOC VALUE 
*     END 
* 
# 
*ENDIF
 
      XREF
        BEGIN 
        PROC NDLEM2;         # MAKE ENTRY IN ERROR-FILE-2              #
        END 
 
      DEF COUP$PAR # "COUPLER" #; # FOR ERROR MESSAGE                  #
      DEF HNAME$PAR # "HNAME" #; # FOR ERROR MESSAGE                   #
      DEF MX$NODE # 255 #;   # MAX NODE NUMBER ON COUPLER STATEMENT    #
      DEF NODE$PAR # "NODE" #; #FOR ERROR MESSAGE                      #
      DEF PRI1 # 0 #;        # LOC VALUE FOR PRIMARY                   #
      DEF SEC1 # 1 #;        # LOC VALUE FOR SECONDARY                 #
      DEF SEC # "SECOND" #; 
 
      ITEM COUPCNT;          # NUMBER OF COUPLERS TO CURRENT NPU       #
      ITEM I;                # LOOP COUNTER                            #
      ITEM INRFLG B;         # NODE NUMBER IN RANGE                    #
      ITEM KWD$MAP;          # KEYWORD EXISTS BIT MAP                  #
      ITEM LOC$PAR C(10);    # LOC PARAMETER VALUE                     #
      ITEM NODEVAL;          # NODE VALUE                              #
      ITEM UNQFLG B;          # NODE NUMBER UNIQUE FLAG                #
 
      SWITCH CPL$PAR         ERR$CP ,  # UNK     #
                             NODE$ID,  # NODE    #
                             ERR$CP ,  # VARIANT #
                             ERR$CP ,  # OPGO    #
                             ERR$CP ,  # DMP     #
                             ERR$CP ,  # LLNAME  #
                             ERR$CP ,  # UNK     #
                             ERR$CP ,  # UNK     #
                             ERR$CP ,  # UNK     #
                             ERR$CP ,  # UNK     #
                             HNAM$ID,  # HANME   #
                             LOC$ID ;  # LOC     #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      CRNT$CPL = " "; 
      CRNT$CNID = 0;
      CRNT$HNAM = " ";
      KWD$MAP = 0;           # CLEAR BIT MAP                           #
      LOC$PAR = "PRIMARY";   # SET DEFAULT LOC VALUE                   #
      PLWC[0] = PLWC[0] +1; 
      IF NOT STLBERR[1] 
      THEN
        BEGIN 
        PLNAME[PLWC[0]] = STLABEL[1]; 
        PLTYPE[PLWC[0]] = 0; # INDICATES THIS IS A COUPLER STMT        #
        END 
      PLNID1[PLWC[0]] = CRNT$NID; 
      PLHNAME[PLWC[0]] = " "; #BLANK FILL HOST NAME BY DEFAULT# 
      FOR I=FSTKID2 STEP 1 UNTIL STWC[0]
      DO
        BEGIN 
        B<STKWID[I],1>KWD$MAP = 1;     # SET BIT FOR KEYWORD           #
        IF NOT STVLERR[I] 
        THEN
          BEGIN 
          IF STKWID[I] LS KID"NODE" 
            OR STKWID[I] GR KID"LOC"
          THEN
            GOTO ERR$CP;
          ELSE
            GOTO CPL$PAR[STKWID[I]];
 
NODE$ID:                     # PARAMETER IS - NODE                     #
          NODEVAL = STVALNUM[I];
          CHKNODE(NODEVAL,MX$NODE,UNQFLG,INRFLG);   #CK NODE NUMBER  #
          IF UNQFLG AND INRFLG
          THEN
            PLHNID[PLWC[0]] = STVALNUM[I];
          CRNT$CPL = STLABEL[1];
          CRNT$CNID = STVALNUM[I];
          TEST I; 
 
HNAM$ID:                      # NEXT PARAMETER = HNAME                 #
          PLHNAME[PLWC[0]] = STVALNAM[I]; 
          CRNT$HNAM = STVALNAM[I];
          IF PLNAME[PLWC[0]] EQ PLHNAME[PLWC[0]]
          THEN
            NDLEM2(ERR122,STLNUM[0],HNAME$PAR); 
          TEST I; 
 
LOC$ID: 
                             # NEXT PARAMETER = LOC                    #
          LOC$PAR = STVALNAM[I];       # SAVE LOC VALUE                #
          IF STVALNAM[I] EQ SEC 
          THEN
            PLLOC[PLWC[0]] = 1; 
          TEST I; 
 
ERR$CP: 
          EPRC2[0] = "CPLERPR"; 
          MESSAGE(ABRTMSG2,0);
          ABORT;
          END 
        END # I LOOP #
      IF B<KID"NODE",1>KWD$MAP NQ 1 
      THEN                   # IF NODE NOT SPECIFIED, FLAG ERROR       #
        NDLEM2(ERR103,STLNUM[0],NODE$PAR); # FLAG ERROR                #
      IF (PLLOC[PLWC[0]] EQ PRI1
        AND PRI$USED) 
      OR (PLLOC[PLWC[0]] EQ SEC1
        AND SEC$USED) 
      THEN
        NDLEM2(ERR124,STLNUM[0],LOC$PAR);  # FLAG ERROR-DUP LOC VALUE  #
      IF CPL$CNT GQ 2 
      THEN
        NDLEM2(ERR123,STLNUM[0],COUP$PAR); # FLAG ERROR-TOO MANY CPLER #
      CPL$CNT = CPL$CNT + 1; # INCREMENT COUPLER COUNT                 #
      IF PLLOC[PLWC[0]] EQ PRI1 
      THEN
        PRI$USED = TRUE;
      ELSE
        SEC$USED = TRUE;
      RETURN; 
 
      END # CPLERPR PROC #
 
      CONTROL EJECT;
      PROC LLINKPR;          # PROCESS LOGLINK STATEMENT               #
      BEGIN 
*IF,DEF,IMS 
# 
**    LLINKPR - LOGICAL LINK PROCESSOR
* 
*     S.M. ILMBERGER         81/10/30 
* 
*     PROCESS LOGICAL LINK STATEMENTS AND BUILD LOGLINK$XREF TABLE
* 
*     PROC LLINKPR
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     INVALID KEYWORD I.D.-ABORT FRM LLINKPR
* 
*     METHOD
* 
*     IF NO LABEL ERROR 
*       SAVE LOGLINK NAME IN LOGLINK$XREF TABLE 
*     SAVE CURRENT NPU NODE AND CURRENT COUPLER NODE IN LOGLINK$XREF
*     FOR EACH PARAMETER ON THE LOGLINK LINE
*       SET APPROPRIATE BIT IN KEYWORD BITMAP 
*       IF NO VALUE ERROR 
*         IF PARAMETER IS NCNAME
*           SEARCH NPU$TABLE FOR NPU NAME = NCNAME VALUE
*           IF NCNAME VALUE IS A NPU NAME 
*             SAVE CORRESPONDING NODE ID IN LOGLINK$XREF
*           ELSE
*             SEARCH COUP$TABLE FOR COUPLER NAME = NCNAME 
*             IF NAME DEFINED IN COUPLER TABLE
*               SAVE CORRESPONDING NODE ID IN LOGLINK$XREF
*             ELSE
*               FLAG ERROR - INVALID NCNAME 
*           IF DUPLICATE LOGLINK
*             FLAG ERROR - DUP LOGLINK
*         IF PARAMETER IS DI
*           SET FLAG IN LOGLINK$XREF TABLE
*         IF PARAMETER IS NOT DI OR NCNAME
*           SEND DAYFILE ERROR MESSMGE - ABORT
*     IF NCNAME PARAMETER NOT SPECIFIED 
*       FLAG ERROR - PARAMETER MISSING
*     END 
* 
# 
*ENDIF
 
      XREF
        BEGIN 
        PROC NDLEM2;         # MAKE ENTRY IN PASS 2 ERROR FILE         #
        END 
 
      DEF DI$YES # "YES" #;    # VALUE FOR DI PARAMETER                #
      DEF LLNK$PAR # "LOGLINK" #; 
      DEF NCNM$PAR # "NCNAME" #; # FOR ERROR MSG                       #
 
      ITEM CPL$ENT;          # ENTRY OF COUPLER TABLE                  #
      ITEM FOUND B;          # FOUND FLAG                              #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM KWD$MAP;          # KEYWORD EXISTS MAP                      #
      ITEM NPU$ENT;          # ENTRY OF NPU TABLE                      #
 
      SWITCH LLK$PAR         ERR$LL ,  # UNK     #
                             ERR$LL ,  # NODE    #
                             ERR$LL ,  # VARIANT #
                             ERR$LL ,  # OPGO    #
                             ERR$LL ,  # DMP     #
                             ERR$LL ,  # LLNAME  #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  # HNAME   #
                             ERR$LL ,  # LOC     #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             ERR$LL ,  #         #
                             NCNA$ID,  # NCNAME  #
                             DI$ID  ;  # DI      #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      KWD$MAP = 0;           # CLEAR KEYWORD EXISTS MAP                #
      LLWC[0] = LLWC[0] + 1;
      IF NOT STLBERR[1] 
      THEN
        BEGIN                # NO LABEL ERROR                          #
        LLNAME[LLWC[0]] = STLABEL[1]; # SET LLINK NAME                 #
        END 
      LLHNID1[LLWC[0]] = CRNT$CNID; 
      LLNID1[LLWC[0]] = CRNT$NID; 
      LLHNAME[LLWC[0]] = CRNT$HNAM; 
      FOR I=FSTKID2 STEP 1 UNTIL STWC[0]
      DO                     # PROCESS REST OF PARAMETERS              #
        BEGIN 
        B<STKWID[I],1>KWD$MAP = 1;     # SET BIT FOR KEYWORD           #
        IF NOT STVLERR[I] 
        THEN
          BEGIN              # NO VALUE ERRORS                         #
          IF STKWID[I] LS KID"NODE" 
            OR STKWID[I] GR KID"DI" 
          THEN
            GOTO ERR$LL;
          ELSE
            GOTO LLK$PAR[STKWID[I]];
 
NCNA$ID:                     # NEXT PARAMETER IS NCNAME                #
          NPU$ENT = 0;
          FOR J=FSTNT STEP NTENTSZ WHILE NPU$ENT EQ 0 
            AND J LQ NTWC[0]
          DO
            BEGIN 
            IF NTNAME[J] EQ STVALNAM[I] 
            THEN
              NPU$ENT = J;
            END # J LOOP #
          IF NPU$ENT GR 0 
          THEN
            BEGIN 
            LLHNID2[LLWC[0]] = NTNID[NPU$ENT];
            LLNID2[LLWC[0]] = NTNID[NPU$ENT]; 
            END 
          ELSE
            BEGIN 
            CPL$ENT = 0;
            FOR J=FSTCT STEP CTENTSZ WHILE CPL$ENT EQ 0 
              AND J LQ CTENT[0] 
            DO
              BEGIN          # CHK COUPLER TABLE                       #
              IF CTNAME[J] EQ STVALNAM[I] 
              THEN
                CPL$ENT = J;
              END   # J LOOP #
            IF CPL$ENT GR 0 
            THEN             # NAME DEFINED IN COUPLER-TABLE           #
              BEGIN 
              LLTYPE[LLWC[0]] = 1;
              LLHNID2[LLWC[0]] = CTHNID[CPL$ENT]; 
              LLNID2[LLWC[0]] = CTNID[CPL$ENT]; 
              END 
            ELSE
              NDLEM2(ERR121,STLNUM[0],NCNM$PAR);
            END 
          IF LLHNID1[LLWC[0]] NQ 0
            AND LLHNID2[LLWC[0]] NQ 0 
          THEN
            BEGIN 
            FOR J=1 STEP 1 UNTIL LLWC[0] - 1
            DO
              BEGIN 
              IF ( LLHNID1[J] EQ LLHNID1[LLWC[0]] 
                AND LLHNID2[J] EQ LLHNID2[LLWC[0]] )
              OR ( LLHNID1[J] EQ LLHNID2[LLWC[0]] 
                AND LLHNID2[J] EQ LLHNID1[LLWC[0]] )
              THEN
                BEGIN 
                NDLEM2(ERR120,STLNUM[0],LLNK$PAR);
                END 
              END   # J LOOP #
            END 
          TEST I; 
 
DI$ID:                       # NEXT PARAMETER = DI                     #
          IF STVALNAM[I] EQ DI$YES
          THEN
            LLST[LLWC[0]] = TRUE; 
          TEST I; 
 
ERR$LL: 
          EPRC2[0] = "LLINKPR"; 
          MESSAGE(ABRTMSG2,0);
          ABORT;
          END 
        END # I LOOP #
 
      IF B<KID"NCNAME",1>KWD$MAP NQ 1 
      THEN                   # IF NCNAME NOT SPECIFIED, FLAG ERROR     #
        NDLEM2(ERR103,STLNUM[0],NCNM$PAR);
 
      IF LLNID1[LLWC[0]] NQ LLNID2[LLWC[0]] AND 
        (LLNID1[LLWC[0]] NQ 0 AND LLNID2[LLWC[0]] NQ 0) 
      THEN                   # IF THIS IS A LOGLINK TO A REMOTE NODE   #
        BEGIN                #   AND NPU NODE I.D.-S WERE DETERMINED   #
        FOUND = FALSE;                 # CLEAR FOUND FLAG              #
        FOR I=1 STEP TNIENTSZ WHILE NOT FOUND AND 
                                    I LQ TNIWC[0] 
        DO                   # FOR EACH ENTRY IN THE TNI TABLE         #
          BEGIN 
          IF (LLNID1[LLWC[0]] EQ TNIN1[I] AND 
              LLNID2[LLWC[0]] EQ TNIN2[I]) OR 
             (LLNID1[LLWC[0]] EQ TNIN2[I] AND 
              LLNID2[LLWC[0]] EQ TNIN1[I])
          THEN                         # IF TRUNK SUPPORTS LOGLINK     #
            BEGIN 
            FOUND = TRUE;              # SET FOUND FLAG                #
            END 
          END 
        IF NOT FOUND                   # IF NO TRUNK FOUND             #
        THEN
          BEGIN              # FLAG ERROR -- NO TRUNK FOR THIS LOGLINK #
          NDLEM2(ERR154,STLNUM[0]," "); 
          END 
        END 
      RETURN; 
 
      END # LLINKPR PROC #
 
      CONTROL EJECT;
      PROC NFILEPR;          # PROCESS NFILE STATEMENT                 #
 
      BEGIN 
*IF,DEF,IMS 
# 
**    NFILEPR -  NFILE STATEMENT PROCESSOR
* 
*     S.M. ILMBERGER         81/11/2
* 
*     PROCESS NFILE STATEMENT 
* 
*     PROC NFILEPR
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     IF NO LABEL ERROR 
*       INITIALIZE NCFFET 
*       SET UP PRFX$TABLE 
*       SET UP VERIFY$ENTRY TABLE 
*       INITIALIZE NCF$INDEX TABLE
*     IF LABEL ERROR
*       CLEAR FILE NAME IN FET
*     END 
* 
# 
*ENDIF
      XREF
        BEGIN 
        FUNC EDATE C(10);    # UNPACK DATE                             #
        FUNC ETIME C(10);    # UNPACK TIME                             #
        PROC PDATE;          # GET PACKED DATE AND TIME                #
        PROC RECALL;         # RETURNS CONTROL WHEN PROCESS FINISHED   #
        PROC REWIND;         # REWINDS SPECIFIED FILE                  #
        PROC VERSION;        # GET VERSION NUMBER OF OPERATING SYSTEM  #
        PROC NDLZFIL;        # ZERO FILL UNUSED PART OF WORD           #
        END 
 
      DEF BLANK # " " #;
 
*CALL NAMLEV
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # DUMMY VARIBLE                           #
      ITEM TEMP1 U;          # TEMP STORAGE                            #
      ITEM TEMPACDAT U;      # STORAGE FOR PACKED DATE                 #
      ITEM TEMPDAT C(10);    # STORAGE FOR DATE                        #
      ITEM TEMPNAM C(10);    # STORAGE FOR NDLZFIL                     #
      ITEM TEMPT1 C(10);     # STORAGE FOR TIME                        #
      ITEM TEMPTIM U;        # STORAGE FOR TIME                        #
      ITEM TEMPVER C(10);    # STORAGE FOR VERSION NO. OF OP. SYSTEM   #
 
      ARRAY TEMPTAB [0:0] S(1); 
        BEGIN 
        ITEM BC U(0,0,12);   # NUMBER OF 12 BIT BYTES TO RETURN        #
        ITEM SB U(0,12,12);  # STARTING BYTE IN SOURCE FIELD           #
        ITEM BP U(0,24,12);  # STARTING BYTE IN RECEIVING FIELD        #
        ITEM WADDR U(0,42,18); # ADDR OF FIELD RECEIVING VERSION NUMB  #
        END 
 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      IF NOT STLBERR[1] 
      THEN                   # NO LABEL ERROR                          #
        BEGIN 
        PT$ID[0] = O"7700";  # SET TABLE I.D.                          #
        PTWC[0] = 0014;      # SET WORD COUNT                          #
        PT$FNAME[0] = STLABEL[1];  # SET FILE HEADER NAME              #
        TEMPNAM = STLABEL[1]; 
        NDLZFIL(TEMPNAM);    # ZERO FILL FILE NAME                     #
        NCFLFN[0] = TEMPNAM; # INITIALIZE NCFFET                       #
        REWIND(NCFFET);      # REWIND NCF FILE                         #
        RECALL(NCFFET); 
        PDATE(TEMPACDAT);    # GET PACKED DATE AND TIME                #
        VEWORD1[0] = TEMPACDAT; # SET PAKED DATE-CLEARS REST OF WORD   #
        TEMPTIM = 0;
        B<42,18>TEMPTIM = B<42,18>TEMPACDAT;
        TEMPT1 = ETIME(TEMPTIM);  # UNPACK TIME - STORE IN TABLE       #
        PT$TIME[0] = C<1,8>TEMPT1;
        TEMP1 = 0;
        C<7,3>TEMP1 = C<4,3>TEMPACDAT;     # SET UP FOR EDATE          #
        TEMPDAT = EDATE(TEMP1); # UNPACK DATE                          #
        PT$DATE[0] = C<1,8>TEMPDAT; # SET DATE                         #
        BC[0] = 5;           # SET UP FOR VERSION CALL                 #
        SB[0] = 0;
        BP[0] = 0;
        WADDR[0] = LOC(TEMPVER);
        VERSION(TEMPTAB);    # GET VERSION OF OPERATING SYSTEM         #
        PT$OPS[0] = TEMPVER; # PUT VERSION IN TABLE                    #
        PT$PNAME[0] = "NDLP"; 
        PT$PVER[0] = C<9,3>NAMVER[0]; # SET PROGRAM VERSION NUMBER     #
        PT$PLEV[0] = C<2,3>NAMLV[0]; # SET PROGRAM LEVEL               #
        PT$BLNK1[0] = BLANK; # CLEAR FIELD                             #
        PT$BLNK2[0] = BLANK;
        PT$TITLE[0] = TITLE$WORD[0];
 
      # SET VERIFY TABLE ENTRIES                                       #
 
        VE$ID[0] = "VERSION"; # SET TABLE I.D.                         #
 
#     INITIALIZE NCF DIRECTORY HEADER  #
 
        NCFWORD[0] = 0;      # CLEAR FIRST WORD                        #
        NCF$RECID[0] = O"7000";        # SET RECORD I.D.               #
        NCF$NAM[0] = "NCF";  # SET FILE IDENTIFIER                     #
        NCFWORD1[0] = 0;     # CLEAR SECOND WORD                       #
 
        END 
      ELSE
        BEGIN                # LABEL ERROR EXISTS                      #
        NCFWORD0[0] = 0;     # ZERO FILE NAME IN FET                   #
        END 
      RETURN; 
 
      END   # NFILEPR # 
 
      CONTROL EJECT;
      PROC NPUPR; 
 
      BEGIN 
*IF,DEF,IMS 
# 
**    NPUPR - NPU PROCESSOR 
* 
*     S.M. ILMBERGER         81/11/2
* 
*     PROCESS NPU STATEMENT 
* 
*     PROC NPUPR
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     INVALID KEYWORD I.D.-ABORT FROM NPUPR 
* 
*     METHOD
* 
*     IF NO LABEL ERROR 
*       SAVE NPU NAME IN NPU$XREF TABLE 
*     FOR EACH PARAMETER ON NPU STATEMENT 
*       SET APPROPRIATE BIT IN KEYWORD BITMAP 
*       IF NO VALUE ERROR 
*         STORE PARAMETER VALUE IN APPROPRIATE NPU$XREF ITEM
*       ELSE VALUE ERROR EXISTS 
*         SEND DAYFILE MESSAGE - ABORT
*     IF NODE OR VARIANT PARAMETER NOT SPECIFIED
*       FLAG ERROR - MISSING PARAMETER
*     CK IF SUPERVISORY LINK EXISTS FOR CURRENT NPU 
*     IF NO SUPLINK STATEMENT 
*       COUNT NUMBER OF LOGLINKS
*       IF MORE THAN ONE LOGLINK
*         FLAG ERROR - MISSING SUPLINK STATEMENT
*       IF NO LOGLINKS
*         FLAG ERROR - NO LOGLINKS TO NPU 
*       ELSE
*         MAKE DEFAULT SUPLINK TABLE ENTRY
*     END 
* 
# 
*ENDIF
      XREF
        BEGIN 
        PROC NDLEM2;         # NMAKE ENTRY IN ERROR-FILE-2             #
        END 
 
      DEF LLINK$STMT # "LOGLINK" #; 
      DEF MXNODE # 255 #;    # MAX NODE NUMBER ON NPU STATEMENT        #
      DEF NODE$PARAM # "NODE" # ; 
      DEF SLINK$STMT # "SUPLINK" #; 
      DEF VARI$PARAM # "VARIANT" #; 
 
      ITEM FOUND B; 
      ITEM I;                # LOOP COUNTER                            #
      ITEM INDEX; 
      ITEM KWD$MAP;          # KEYWORD EXISTS BIT MAP                  #
      ITEM NODE$INR B;       # TRUE WHEN NODE NUMBER IS IN RANGE       #
      ITEM NODE$UNQ B;       # TRUE WHEN NODE NUMBER IS UNIQUE         #
      ITEM NUMLLINK I;       # NUMBER OF LOGLINKS TO THIS NPU          #
      ITEM SPL$EXST B;       # TRUE WHEN SUPLINK EXISTS FOR THIS NPU   #
      ITEM DMP$USED B;       # DMP SPECIFIED FLAG                      #
 
      SWITCH NPU$PAR         ERR$NPU,  # UNK     #
                             NODE$ID,  # NODE    #
                             VARI$ID,  # VARIANT #
                             OPGO$ID,  # OPGO    #
                             DMP$ID;   # DMP     #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      NPWC[0] = NPWC[0] + 1;
      CRNT$CPL = " "; 
      CRNT$CNID = 0;
      CPL$CNT = 0;           # CLEAR COUPLER COUNT                     #
      KWD$MAP = 0;           # CLEAR BIT MAP                           #
      PRI$USED = FALSE;      # CLEAR LOC=PRIMARY SPECIFIED FLAG        #
      SEC$USED = FALSE;      # CLEAR LOC=SECOND SPECIFIED FLAG         #
      DMP$USED = FALSE;      # CLEAR DMP SPECIFIED FLAG                #
      IF NOT STLBERR[1] 
      THEN                   # NO LABEL ERROR EXISTS                   #
        BEGIN 
        NPNAME[NPWC[0]] = STLABEL[1];   # PUT NPU NAME IN NPU$XREF     #
        END 
      FOR I=FSTKID2 STEP 1 UNTIL STWC[0]
      DO
        BEGIN 
        B<STKWID[I],1>KWD$MAP = 1;     # SET BIT FOR KEYWORD           #
        IF NOT STVLERR[I]    # NO VALUE ERROR                          #
        THEN
          BEGIN 
          IF STKWID[I] LS KID"NODE" 
            OR STKWID[I] GR KID"DMP"
          THEN
            GOTO ERR$NPU; 
          ELSE
            GOTO NPU$PAR[STKWID[I]];
 
NODE$ID:                     # NEXT PARAMETER = NODE                   #
          CRNT$NPU = STLABEL[1];
          CRNT$NID = STVALNUM[I]; 
          CHKNODE(CRNT$NID,MXNODE,NODE$UNQ,NODE$INR);   # CK NODE NUMB #
          IF NODE$UNQ AND NODE$INR
          THEN               # NODE NUMBER UNIQUE AND IN RANGE         #
            NPNID[NPWC[0]] = CRNT$NID;     # SET NODE NUM IN NPU$XREF  #
          TEST I; 
 
VARI$ID:                     # NEXT PARAMETER = VARIANT                #
          NPVARNT[NPWC[0]] = STVALNAM[I];     # SET VARIANT NUMBER IN  #
                                              # NPU-XREF-TABLE         #
          TEST I; 
 
OPGO$ID:                     # NEXT PARAMETER = OPGO                   #
          IF STVALNAM[I] EQ "YES" 
          THEN
            NPOPGO[NPWC[0]] = TRUE;  # SET OPGO FLAG IN NPU$XREF TABLE #
          TEST I; 
DMP$ID:                      # NEXT PARAMETER = DMP                    #
          DMP$USED = TRUE;   # SET DMP SPECIFIED FLAG TO TRUE          #
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            NPDMP[NPWC[0]] = TRUE;     # SET DMP FLAG IN ENTRY         #
            END 
          TEST I; 
 
ERR$NPU:  
          EPRC2[0] = "NPUPR"; 
          MESSAGE(ABRTMSG2,0);
          ABORT;
          END 
        END # I LOOP #
      IF NOT DMP$USED        # IF DMP NOT SPECIFIED                    #
      THEN
        BEGIN 
        NPDMP[NPWC[0]] = TRUE; # SET DMP FLAG IN ENTRY                 #
        END 
      IF B<KID"NODE",1>KWD$MAP NQ 1 
      THEN                   # IF -NODE- NOT SPECIFIED                 #
        NDLEM2(ERR103,STLNUM[0],NODE$PARAM); # FLAG ERROR              #
      IF B<KID"VARIANT",1>KWD$MAP NQ 1
      THEN                   # IF -VARIANT- NOT SPECIFIED              #
        NDLEM2(ERR103,STLNUM[0],VARI$PARAM); # FLAG ERROR              #
      SPL$EXST = FALSE; 
      FOUND = FALSE;
      FOR I=FSTNT STEP NTENTSZ UNTIL NTWC[0]
      DO
        BEGIN                # SEE IF SUPLINK EXISTS                   #
        IF NOT FOUND
        THEN
          BEGIN 
          IF NTNAME[I] EQ NPNAME[NPWC[0]] 
          THEN
            BEGIN 
            FOUND = TRUE; 
            IF NTSPLK[I]
            THEN
              SPL$EXST = TRUE;
            END 
          END 
        END 
      IF NOT SPL$EXST 
      THEN                   # NO SUPLINK EXISTS                       #
        BEGIN                # CHECK FOR MORE THAN 1 LOGLINK           #
        NUMLLINK = 0; 
        FOR I=FSTLLT STEP LLTENTSZ UNTIL LLTENT[0]
        DO                   # COUNT LLINKS                            #
          BEGIN 
          IF LLTNID[I] EQ CRNT$NID
          THEN
            BEGIN 
            NUMLLINK = NUMLLINK + 1;
            INDEX = I;       # INDEX FOR LOGLINK TABLE                 #
            END 
          END  # I LOOP # 
        IF NUMLLINK GR 1
        THEN                 # MORE THAN 1 LOGLINK EXISTS AND NO SLINK #
          NDLEM2(ERR126,STLNUM[0],SLINK$STMT);
        ELSE
          BEGIN 
          IF NUMLLINK EQ 0
          THEN               # NO LOGLINK TO THIS NPU                  #
            NDLEM2(ERR127,STLNUM[0],LLINK$STMT);
          ELSE               # ONLY 1 LOGLINK TO THIS NPU              #
            SLINKXR(INDEX);  # MAKE DEFAULT SUPLINK TABLE ENTRY        #
          END 
        END 
      RETURN; 
 
      END   # NPUPR PROC #
 
      CONTROL EJECT;
      PROC RNGNODE(NODEVAL,MAX,RNGFLG); 
      # CHECK THAT NODE IS WITHIN RANGE                                #
      BEGIN  # RNGNODE PROC # 
*IF,DEF,IMS 
# 
**    PRGNODE - CK RANGE OF NODE
* 
*     S.M. ILMBERGER         81/11/2
* 
*     CHECK THAT NODE VALUE IS WITHIN RANGE 
* 
*     PROC RNGNODE(NODEVAL,MAX,RNGFLG)
* 
*     ENTRY        NODEVAL - NODE NUMBER
*                  MAX - MAXIMUM VALUE FOR NODE VALUE 
* 
*     EXIT         RNGFLG - FLAG INDICATING IF NODE VALUE IS IN RANGE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     IF NODEVAL IS GREATER THAN MAX OR LESS THAN 0 
*       SEND ERROR MESSAGE
*       SET RNGFLG TO FALSE 
*     ELSE
*       SET RNGFLG TO TRUE
*     END 
* 
# 
*ENDIF
 
      ITEM CNODE C(10);      # CHARACTER STORAGE FOR NODE VALUE        #
      ITEM NODEVAL I;        # NODE NUMBER TO CHECK                    #
      ITEM MAX     I;        # MAX NUMBER FOR NODEVAL                  #
      ITEM RNGFLG  B;        # FLAG INDICATING NODE IS IN RANGE        #
                             # TRUE WHEN IN RANGE                      #
 
      XREF
        BEGIN 
        PROC NDLEM2;         # MAKES ENTRY IN ERROR-FILE-2             #
        FUNC XCDD C(10);     # CONVERT INTEGER TO DEC DISPLAY CODE     #
        END 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      IF NODEVAL GR MAX OR NODEVAL LQ 0 
      THEN
        BEGIN                # NODE NUMBER IS NOT IN RANGE             #
        CNODE = XCDD(NODEVAL);     # CONVERT INTEGER NODE TO CHARCATER #
        NDLEM2(ERR100,STLNUM[0],CNODE);   # SEND ERROR MSG             #
        RNGFLG = FALSE;      # SET NODE IN RANGE FLAG TO FALSE         #
        END 
      ELSE
        RNGFLG = TRUE;
      RETURN;                # *** RETURN ***                          #
 
      END   # RNGNODE PROC #
 
      CONTROL EJECT;
      PROC SLINKPR; 
      BEGIN                  # PROCESS SUPLINK STATEMENT               #
*IF,DEF,IMS 
# 
**    SLINKPR - SUPLINK PROCESSOR 
* 
*     S.M. ILMBERGER         81/11/2
* 
*     PROCESS SUPLINK STATEMENT 
* 
*     PROC SLINKPR
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH KEYWORD ON STATEMENT 
*       IF NO VALUE ERROR 
*         IF KEYWORD = LLNAME 
*           SEARCH LOGLINK TABLE FOR LLNAME VALUE 
*           IF LLNAME IN LOGLINK TABLE
*             IF CURRENT NPU NODE MATCHES LOGLINK ENTRY 
*               BUILD SUPLINK TABLE ENTRY 
*             ELSE
*               SEND ERROR MESSAGE - NO LOGLINK TO THIS NPU 
*           ELSE
*             LLNAME NOT VALID LOGLINK
*     IF LLNAME PARAMETER NOT SPECIFIED 
*       SEND ERROR MESSAGE - REQUIRED PARAMETER MISSING 
*     END 
* 
# 
*ENDIF
 
      XREF
        BEGIN 
        PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
        END 
 
      DEF LLNAME$PAR # "LLNAME" #; # USED FOR NDLEM2                   #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM LL$ENT;           # LOGLINK TABLE ENTRY THAT MATCHES LLNAME #
      ITEM LLNAME$FLG B;     # LLNAME PARAMETER IS SPECIFIED IF SET    #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      LLNAME$FLG = FALSE; 
      FOR I=FSTKID1 STEP 1 UNTIL STWC[0]
      DO
        BEGIN 
        LLNAME$FLG = TRUE;   # SET LLNAME SPECIFIED FLAG               #
        IF NOT STVLERR[I] 
        THEN                 # NO VALUE ERROR EXISTS                   #
          BEGIN 
          IF STKWID[I] EQ KID"LLNAME" 
          THEN               # NEXT KEYWORD = LLNAME                   #
            BEGIN 
            LL$ENT = 0; 
            FOR J=FSTLLT STEP LLTENTSZ UNTIL LLTENT[0]
            DO               # SEARCH LOGLINK TABLE FOR SAME LLNAME    #
              BEGIN 
              IF LLTNAME[J] EQ STVALNAM[I]
              THEN
                LL$ENT = J; 
              END 
            IF LL$ENT NQ 0
            THEN             # FOUND LLNAME IN LOGLINK TABLE           #
              BEGIN 
              IF LLTNID[LL$ENT] EQ CRNT$NID 
              THEN           # CURRENT NPU NODE MATCHES LOGLINK ENTRY  #
                SLINKXR(LL$ENT); # BUILD SUPLINK TABLE ENTRY           #
              ELSE
                NDLEM2(ERR128,STLNUM[0],STVALNAM[I]); 
              END 
            ELSE             # LLNAME NOT IN LOGLINK TABLE             #
              NDLEM2(ERR129,STLNUM[0],STVALNAM[I]); 
            END 
          END   # NO VALUE ERROR #
        END  # I LOOP # 
      IF NOT LLNAME$FLG      # LLNAME PARAMETER NOT SPECIFIED ON SUPLNK#
      THEN                   # STATEMENT                               #
        NDLEM2(ERR103,STLNUM[0],LLNAME$PAR);
      RETURN; 
 
      END   # SLINKPR PROC #
 
      CONTROL EJECT;
      PROC SLINKXR(LLENT);   # MAKES ENTRIES IN SUPLINK TABLE          #
      BEGIN 
*IF,DEF,IMS 
# 
**    SLINKXR - SUPLINK CROSS REFERINCE 
* 
*     S.M. ILMBERGER         81/11/2
* 
*     MAKE ENTRIES IN SUPLINK TABLE 
* 
*     PROC SLINKXR(LLENT) 
* 
*     ENTRY        LLENT - NUMBER ASSOCIATED W/LOGLINK TABLE ENTRY
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     SET SUPLINK TABLE NAME AND HOST NODE FROM LOGLINK ENTRY 
*     SEARCH COUPLER TABLE TO SEE IF SUPLINK IS LOCAL OR REMOTE 
*     SET SUPLINK TYPE
*     END 
* 
# 
*ENDIF
 
      ITEM LLENT;            # NUMBER ASSOCIATED W/LLINK TABLE ENTRY   #
 
      DEF REMOTE # 1 #;      # NPU IS REMOTE TO NPU                    #
 
      ITEM K;                # LOOP COUNTER                            #
      ITEM MATCH B;          # INDICATES COUPLER TABLE ENTRY AND       #
                             # SUPLINK TABLE ENTRY MATCH               #
      ITEM NENTSL;           # NEXT ENTRY IN SUPLINK TABLE             #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      NENTSL = SLTWC[0] + 1; #  MAKE ENTRIES IN SUPLINK TABLE          #
      SLTNAME[NENTSL] = LLTNAME[LLENT]; 
      SLTHNID[NENTSL] = LLTHNID[LLENT]; 
      SLTNID[NENTSL] = CRNT$NID;
      MATCH = FALSE;
      FOR K=FSTCT STEP CTENTSZ WHILE K LQ CTENT[0] AND NOT MATCH
      DO                      # SEARCH COUPLER TABLE TO DETERMINE IF   #
        BEGIN                 # SUPLINK IS LOCAL OR REMOTE TO THIS NPU #
        IF CTHNID[K] EQ SLTHNID[NENTSL] 
          AND CTNID[K] EQ CRNT$NID
        THEN
          BEGIN 
          MATCH = TRUE; 
          END 
        END 
      IF NOT MATCH
      THEN
        SLTTYPE[NENTSL] = REMOTE; # SET SUPLINK TYPE TO "REMOTE"       #
      SLTWC[0] = SLTWC[0] + SLTENTSZ; 
      RETURN; 
 
      END   # SLINKXR # 
 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      FOR I=0 WHILE STMT$STAT EQ TRNS$OK #STMT IS NETWORK ELEMENT TYPE #
        AND (STMT$TYPE[STSTID[0]] EQ "NETWORK" # AND NO READ ERRORS    #
          OR STMT$TYPE[STSTID[0]] EQ "TRUNK") 
      DO
        BEGIN 
        READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); # READ FULL STMT #
        IF STMT$STAT NQ TRNS$OK 
        THEN
          GOTO ERR$NET; 
        ELSE
          GOTO NET$ELEM[STSTID[0]]; 
 
NFILE$ST: 
        PTWORD0[0] = 0;      # CLEARS WORD 0 OF PRFX$TABLE TABLE       #
        PTWORD1[0] = 0;      # CLEARS WORD 1 OF PRFX$TABLE TABLE       #
        VEWORD0[0] = 0;      # CLEARS VERIFY$ENTRY TABLE               #
        VEWORD1[0] = 0; 
        NFILEPR;             # CALL NFILE STATEMENT PROCESSOR          #
        FWAWSA = LOC(PTWORD0[0]); #SAVE 1ST WORD ADDRESS OF FH TABLE   #
        NDLWNCF(TABLE"FH",FWAWSA,LEN$FH$TAB); # WRITE FILE HEADER REC  #
        GOTO RDNXT; 
 
NPU$ST: 
        NPWORD[NPWC[0]+1] = 0; #CLEAR NEXT 2 WORDS OF NPU$XREF TABLE   #
        NPWORD1[NPWC[0]+1] = 0; 
        NPUPR;               # CALLS NPU STATEMENT PROCESSOR           #
        GOTO RDNXT; 
 
SLINK$ST: 
        IF ( SLTWC[0]+1+SLTENTSZ ) GR SLT$LENG
        THEN                 # NOT ENOUGH SPACE IN SUPLINK$TAB         #
          BEGIN 
          SSTATS(P<SUPLINK$TABL>,SLTENTSZ); # ALLOCATE 1 MORE WORD FOR #
          END                            # SUPLINK TABLE               #
        SLTWORD[SLTWC[0]+1] = 0; # CLEARS NEW WORD OF TABLE            #
        SLINKPR;             # CALL SUPLINK STMT PROCESSOR             #
        GOTO RDNXT; 
 
COUP$ST:  
        IF ( (PLWC[0]*PLENTSZ)+1+PLENTSZ ) GR PL$LENG 
        THEN                 # NEED MORE SPACE IN PLINK$XREF TABLE     #
          BEGIN 
          SSTATS(P<PLINK$XREF>,PLENTSZ); # ALLOCATE 2 WORDS            #
          END 
        PLWORD[PLWC[0]+1] = 0; # CLEAR NEW TABLE ENTRIES               #
        PLWORD1[PLWC[0]+1] = 0; 
        CPLERPR;             # CALL COUPLER PROCESSOR                  #
        GOTO RDNXT; 
 
LLINK$ST: 
        LLWORD[LLWC[0]+1] = 0; # CLEAR NEW TABLE ENTRIES               #
        LLWORD1[LLWC[0]+1] = 0; 
        LLINKPR;               # CALL LOGLINK STMT PROCESSOR           #
        GOTO RDNXT; 
 
TRNK$ST:  
        IF ( (PLWC[0]*PLENTSZ)+1+PLENTSZ ) GR PL$LENG 
        THEN                   # NEED MORE ROOM IN PLINK$XREF TABLE    #
          BEGIN 
          SSTATS(P<PLINK$XREF>,PLENTSZ); # ALLOCATE 2 MORE WORDS       #
          END 
        PLWORD[PLWC[0]+1] = 0; # CLEAR NEW TABLE ENTRIES               #
        PLWORD1[PLWC[0]+1] = 0; 
        NDLTRNK;             # CALL TRUNK STMT PROCESSOR               #
        GOTO RDNXT; 
 
ERR$NET:  
        EPRC1[0] = "NCFNET";
        MESSAGE(ABRTMSG1,0);
        ABORT;
        TEST I; 
 
RDNXT:  
        READW(STFET,STMT$TABLE,1,STMT$STAT);   # READ NXT STMT HEADER  #
        TEST I; 
        END # I LOOP #
      RETURN; 
 
      END # NDLNFNT # 
      TERM