*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