*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 BBITMAP[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 BBITMAP[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 BKWD$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 BKWD$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 BKWD$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 BKWD$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 BKWD$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 BKWD$MAP NQ 1 THEN # IF -NODE- NOT SPECIFIED # NDLEM2(ERR103,STLNUM[0],NODE$PARAM); # FLAG ERROR # IF BKWD$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,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,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,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