*DECK NDLP2LF
USETEXT NDLDATT
USETEXT NDLFETT
USETEXT NDLTBLT
PROC NDLP2LF;
BEGIN
*IF,DEF,IMS
#
** NDLP2LF - CHECKS LCF STATEMENTS AND CREATES LCF.
*
* D.K. ENDO 81/10/12
*
* THIS PROCEDURE TAKES EACH ENTRY IN THE STMT TABLE AND CALLS THE
* APPROPRIATE PROC TO CHECK THE ENTRY.
*
* PROC NDLP2LF
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* ALLOCATE TABLE SPACE FOR LCF TABLES.
* INITIALIZE THE TABLES.
* REWIND THE STATEMENT TABLE.
* FOR EACH ENTRY IN STATEMENT TABLE:
* CALL APPROPRIATE PROC TO CHECK ENTRY.
* CALL LCF TERMINATION PROC.
*
#
*ENDIF
#
**** PROC NDLP2LF - XREF LIST BEGINS.
#
XREF
BEGIN
PROC SSBSBF; # STORES A BIT FIELD INTO A TABLE #
PROC SSTATS; # ALLOCATES MORE TABLE SPACE #
PROC READ; # FILLS CIO BUFFER #
PROC READW; # READS GIVEN NUMBER OF CP WORDS #
PROC RECALL; # RETURNS CONTROL WHEN RECALL BIT CLEARED #
PROC REWIND; # REWINDS GIVEN FILE #
END
#
****
#
CONTROL PRESET;
CONTROL NOLIST; # ER2CNDL AND PS2CNDL #
*CALL ER2CNDL
*CALL PS2CNDL
CONTROL LIST;
DEF MXAT # 60 #; # SIZE OF ASCII TABLE #
ITEM I; # SCRATCH ITEM #
ITEM STMT$STAT; # STATUS RETURNED BY READ #
ITEM USR$M$FLAG B; # MAXIMUM USER STATEMENTS USED FLAG #
ITEM PP$SNODE; # CURRENT SNODE DEFINED ON OUTCALL STMT #
ITEM PP$DNODE; # CURRENT DNODE DEFINED ON OUTCALL STMT #
ITEM PP$PORT; # CURRENT PORT NUMBER DEFINED ON OUTCALL #
ITEM PP$DTEAL; # CURRENT LENGTH OF DTEA #
ITEM PP$DTEA; # CURRENT VALUE OF DTEA USED BY PATH PID #
# TABLE #
ITEM CRNT$PID C(3); # CURRENT PID NAME USED #
ARRAY ASCII$TABLE [00:MXAT] S(1); # TABLE TO CONVERT DISPLAY CODE#
BEGIN # TO ASCII #
ITEM A$CHAR U(00,52,08) = [O"72", # COLON #
O"101", # A #
O"102", # B #
O"103", # C #
O"104", # D #
O"105", # E #
O"106", # F #
O"107", # G #
O"110", # H #
O"111", # I #
O"112", # J #
O"113", # K #
O"114", # L #
O"115", # M #
O"116", # N #
O"117", # O #
O"120", # P #
O"121", # Q #
O"122", # R #
O"123", # S #
O"124", # T #
O"125", # U #
O"126", # V #
O"127", # W #
O"130", # X #
O"131", # Y #
O"132", # Z #
O"060", # 0 #
O"061", # 1 #
O"062", # 2 #
O"063", # 3 #
O"064", # 4 #
O"065", # 5 #
O"066", # 6 #
O"067", # 7 #
O"070", # 8 #
O"071", # 9 #
O"053", # + #
O"055", # - #
O"052", # * #
O"057", # / #
O"050", # ( #
O"051", # ) #
O"044", # $ #
O"075", # = #
O"040", # BLANK #
O"054", # , #
O"056", # . #
O"043", # POUND #
O"133", # [ #
O"135", # ] #
O"045", # % #
O"042", # " #
O"137", # _ #
O"041", # ! #
O"046", # & #
O"047", # ' #
O"077", # ? #
O"074", # < #
O"076", # > #
O"100" # #
];
END
SWITCH LCFJUMP , # UNKNOWN #
, # NFILE #
, # NPU #
, # SUPLINK #
, # COUPLER #
, # LOGLINK #
, # GROUP #
, # LINE #
, # ** RESERVED ** #
, # TERMINAL #
, # DEVICE #
, # TRUNK #
LFILE$ENTRY, # LFILE #
USER$ENTRY , # USER #
APPL$ENTRY , # APPL #
OUTCALL$ENT, # OUTCALL #
INCALL$ENT , # INCALL #
, # END #
, # TERMDEV #
, # DEFINE #
, # COMMENT #
; # TITLE #
CONTROL EJECT;
PROC APPLPR;
BEGIN
*IF,DEF,IMS
#
** APPLPR - APPLICATION STATEMENT PROC.
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE CHECKS THE APPL STATEMENT AND MAKES ENTRIES INTO
* THE APPL TABLE.
*
* PROC APPLPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INCREMENT APPL TABLE ENTRY SIZE.
* CLEAR NEXT ENTRY IN APPL TABLE.
* IF LABEL IS O.K.
* SEARCH RESERVED NAME TABLE FOR LABEL
* IF FOUND,
* THEN,
* FLAG ERROR.
* OTHERWISE,
* PUT LABEL IN ENTRY.
* FOR EACH VALUE-DECLARATION IN ENTRY,
* IF VALUE IS O.K.
* SELECT CASE THAT APPLIES:
* CASE 1(PRIV):
* IF VALUE IS -YES-,
* SET PRIV FLAG IN ENTRY.
* CASE 2(UID):
* IF VALUE IS -YES-,
* SET UID FLAG IN ENTRY.
* CASE 3(DI):
* IF VALUE IS -YES-,
* SET DI FLAG IN ENTRY.
* CASE 4(KDSP):
* IF VALUE IS -YES-,
* SET KDSP FLAG IN ENTRY.
*
#
*ENDIF
#
**** PROC APPLPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS RANGE #
PROC NDLEM2; # MAKES ENTRY IN PASS2 ERROR FILE #
END
#
****
#
ITEM FOUND B; # FOUND FLAG #
ITEM I; # SCRATCH ITEM #
DEF MXRA # 9 #;
DEF MXCOPY$DEF # 1 #; # DEFAULT VALUE FOR MXCOPYS #
DEF MXBLK # " " #; # CHECK FOR APPL NAME LENGTH IF MXCOPYS #
# GREATER THAN 1 #
ITEM MXCOPY$USED B; # MXCOPY SPECIFIED FLAG #
ITEM AT$STAT B; # STATUS FLAG FOR RANGE CHECKING #
ARRAY RSRV$APPLS [1:MXRA] S(1); # RESERVED APPLICATION TABLE #
BEGIN
ITEM RA$NAME C(0,0,10) = ["NS",
"CS",
"NVF",
"ALL",
"NULL",
"BYE",
"LOGIN",
"LOGOUT",
"HELLO",
];
END
SWITCH APPLJMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, DI$ , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
, , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, , # AUTO , SL ,#
, , # LSPEED , DFL ,#
, , # FRAME , RTIME ,#
, , # RCOUNT , NSVC ,#
, , # PSN , DCE ,#
, , # DTEA , ,#
, , # , ,#
, , # , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, , # NEN , ,#
, , # , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PRI ,#
, , # P80 , P81 ,#
, , # P82 , P83 ,#
, , # P84 , P85 ,#
, , # P86 , P87 ,#
, , # P88 , P89 ,#
, , # AL , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, , # PW , SE ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # MFAM , MUSER ,#
, , # MAPPL , DFAM ,#
, , # DUSER , ,#
, , # , ,#
, RS$ , # PAPPL ,RS ,#
MXCOPY$ , NETXFR$ , # MXCOPYS ,NETXFR ,#
UID$ , PRIV$ , # UID ,PRIV ,#
KDSP$ , PRU$ , # KDSP , PRU ,#
, , # NAME1 , NAME2 ,#
, , # SNODE , DNODE ,#
, , # ACCLEV , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, ; # FAM , UNAME #
CONTROL EJECT;
# #
# APPLPR CODE BEGINS HERE #
# #
MXCOPY$USED = FALSE; # MXCOPYS SPECFIED FLAG RESET #
ATWC[1] = ATWC[1] + 1; # INCREMENT TABLE SIZE #
IF ATWC[1] GQ AT$LENG-1
THEN # IF NEED MORE TABLE SPACE #
BEGIN # ALLOCATE MORE SPACE #
SSTATS
(P<APPL
$TABLE>
,10); END
ATWORD[ATWC[1]] = 0; # CLEAR ENTRY #
IF NOT STLBERR[1] # IF LABEL IS O.K. #
THEN
BEGIN
FOUND = FALSE; # CLEAR FOUND FLAG #
FOR I=1 STEP 1 UNTIL MXRA
DO
BEGIN
IF RA$NAME[I] EQ STLABEL[1]
THEN
BEGIN
FOUND = TRUE; # FLAG ERROR -- NAME CANNOT BE RESRVD WORD#
ATNAME2[ATWC[1]] = MXBLK; # BLANK FILL LAST TWO CHARS #
NDLEM2(ERR149,STLNUM[0],STLABEL[1]);
END
END
IF NOT FOUND # IF LABEL NOT RESERVED NAME #
THEN
BEGIN # PUT NAME IN ENTRY #
ATNAME[ATWC[1]] = STLABEL[1];
END
END
FOR I=2 STEP 1 UNTIL STWC[0] # FOR EACH VALUE DECLARATION #
DO
BEGIN
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
GOTO APPLJMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
PRIV$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATPRIV[ATWC[1]] = TRUE; # SET PRIV FLAG IN ENTRY #
END
TEST I;
UID$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATUID[ATWC[1]] = TRUE; # SET UID FLAG IN ENTRY #
END
TEST I;
RS$: IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATRS[ATWC[1]] = TRUE; # SET ATRS FLAG IN ENTRY #
END
TEST I;
MXCOPY$: MXCOPY$USED = TRUE; # SET MXCOPY USED FLAG #
NDLCKRG(STKWID[I],STVALNUM[I],AT$STAT); # CHECK RANGE #
IF AT$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
ATMAXC[ATWC[1]] = STVALNUM[I]; # ASSIGN VALUE TO ATMAXC #
# ENTRY #
END
TEST I;
DI$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATSTAT[ATWC[1]] = TRUE; # SET DI FLAG IN ENTRY #
END
TEST I;
NETXFR$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATXFR[ATWC[1]] = TRUE; # SET XFR FLAG IN ENTRY #
END
TEST I;
PRU$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATPRU[ATWC[1]] = TRUE; # SET PRU FLAG IN ENTRY #
END
TEST I;
KDSP$:
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
ATKDSP[ATWC[1]] = TRUE; # SET KDSP FLAG IN ENTRY #
END
TEST I;
END
END
IF NOT MXCOPY$USED # IF MXCOPY NOT SPECIFIED #
THEN
BEGIN
ATMAXC[ATWC[1]] = MXCOPY$DEF; # ASSIGN DEFAULT VALUE TO ENTRY #
END
IF ATMAXC[ATWC[1]] GR 1 # CHECK APPL NAME IF MXCOPYS GR 1 #
THEN
BEGIN
IF ATNAME2[ATWC[1]] NQ MXBLK # NAME GREATER THAN 5 CHARS #
THEN
BEGIN
NDLEM2(ERR166,STLNUM[0],STLABEL[1]);
END
END
RETURN; # **** RETURN **** #
END # APPLPR #
CONTROL EJECT;
PROC DC$ZFILL(WORD);
BEGIN # REPLACES BLANKS WITH DISPLAY CODE ZEROS #
ITEM WORD C(10); # WORD TO BE ZERO FILLED #
DEF ZERO # O"33" #; # DISPLAY CODE ZERO #
ITEM K; # LOOP COUNTER #
# #
# DC$ZFILL CODE BEGINS HERE #
# #
FOR K=0 STEP 1 UNTIL 9
DO # FOR EACH CHARACTER IN WORD #
BEGIN
IF C<K,1>WORD EQ " "
THEN # IF CHARACTER IS A BLANK #
BEGIN
C<K,1>WORD = ZERO; # REPLACE IT WITH DISPLAY CODE ZERO #
END
END
RETURN; # **** RETURN **** #
END # DC$ZFILL #
CONTROL EJECT;
PROC INCALPR;
BEGIN
*IF,DEF,IMS
#
** INCALPR - INCALL STATEMENT PROC
*
* D.K. ENDO 81/10/29
*
* THIS PROCEDURE CHECKS THE INCALL STMTS AND MAKES ENTRIES IN THE
* INCALL TABLE.
*
* PROC INCALPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INCREMENT INCALL TABLE WORD COUNT.
* CLEAR NEXT ENTRY.
* SET ENTRY WORD COUNT FIELD.
* FOR EACH VALUE DECLARATION IN ENTRY,
* SELECT THE CASE THAT APPLIES,
* CASE 1(FAM):
* IF VALUE IS O.K.,
* IF VALUE IS NOT ZERO,
* PUT VALUE IN ENTRY.
* CASE 2(UNAME):
* IF VALUE IS O.K.
* PUT VALUE IN ENTRY.
* CASE 3(SNODE,DNODE,DBL,ABL,DBZ):
* IF VALUE IS O.K.
* CHECK IF VALUE IS WITHIN RANGE.
* IF VALUE IS WITHIN RANGE,
* PUT VALUE IN ENTRY
* CASE 4(PRI):
* IF VALUE IS O.K.,
* IF VALUE IS -YES-,
* SET PRI FLAG IN ENTRY.
* IF FAM,UNAME,SNODE, OR DNODE WAS NOT SPECIFIED,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF ABL,DBL,OR DBZ WAS NOT SPECIFIED
* PUT DEFAULT VALUE IN ENTRY.
*
#
*ENDIF
#
**** PROC INCALPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS VALUE TO BE WITHIN RANGE #
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
PROC NDLZFIL; # ZERO FILL NAMES #
FUNC XCDD C(10); # CONVERTS DEC BINARY TO DISPLAY CODE #
FUNC XCHD C(10); # CONVERTS HEX BINARY TO DISPLAY CODE #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF MXANAME # 7 #; # MAXIMUM LENGTH OF ANAME : 7 HEX DIGIT #
DEF DNODE$DEF # 0 #; # DEFAULT DNODE VALUE #
DEF SNO$MAX #255#; #MAXIMUM VALUE OF INCALL SNODE#
DEF DBL$DEF # 2 #; # DEFAULT DBL VALUE #
DEF DBZ$DEF # 225 #; # DEFAULT DBZ VALUE #
DEF DPL$DEF # 7 #; # DEFAULT DPLR/DPLS VALUE #
DEF FIX$ENT # 8 #; # SIZE OF FIXED PORTION OF ENTRY #
DEF MINFAC # 4 #; # MINIMUM CHAR COUNT FOR FACILITY CODE #
DEF MXFAC # 12 #; # MAXIMUM CHAR COUNT OF FACILITY CODE #
DEF MXFACL # 126 #; # MAXIMUM OF TOTAL OF FACL-S ALLOWED #
DEF MXIB$ENT # 40 #; # MAXIMUM INCALL BLOCK ENTRY SIZE #
DEF UBL$DEF # 2 #; # DEFAULT UBL VALUE #
DEF UBZ$DEF # 2 #; # DEFAULT UBZ VALUE #
DEF UBZMUL # 100 #; # MULTIPLE THAT UBZ IS ENCODED WITH #
DEF W$DEF # 2 #; # DEFAULT WR/WS VALUE #
DEF SHOST$DEF # X"303030" #; # DEFAULT SHOST VALUE #
DEF MXDTEA # 15 #; # MAXIMUM LENGTH OF DTEA #
DEF ZERO # O"33" #; # DISPLAY CODE ZERO #
ITEM ABL$USED B; # ABL SPECIFIED FLAG #
ITEM AN$TEMP C(24); # CHAR TEMP FOR ANAME #
ITEM DNODE$USED B; # DNODE SPECIFIED FLAG #
ITEM ANAM$USED B; # ANAME SPECIFIED FLAG #
ITEM CRNT$ENT; # POINTER TO CURRENT ENTRY #
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM CTEMP2 C(20); # CHARACTER TEMPORARY FOR DTEA #
ITEM DBL$USED B; # DBL SPECIFIED FLAG #
ITEM DBZ$USED B; # DBZ SPECIFIED FLAG #
ITEM DPLS$USED B; # DPLS SPECIFIED FLAG #
ITEM DPLR$USED B; # DPLR SPECIFIED FLAG #
ITEM FAC$LENG; # CURRENT TOTAL LENGTH OF FACILITY CODES #
ITEM FAM$USED B; # FAM SPECIFIED FLAG #
ITEM I; # SCRATCH ITEM #
ITEM IB$STAT B; # STATUS RETURNED BY RANGE CHECK PROC #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # INTEGER TEMPORARY #
ITEM K; # INTEGER TEMPORARY #
ITEM NEXT$WORD; # POINTER TO NEXT WORD IN ENTRY #
ITEM SHST$USED B; # SHOST SPECIFIED FLAG #
ITEM UBL$USED B; # UBL SPECIFIED FLAG #
ITEM UBZ$USED B; # UBZ SPECIFIED FLAG #
ITEM UNAM$USED B; # UNAME SPECIFIED FLAG #
ITEM WS$USED B; # WS SPECIFIED FLAG #
ITEM WR$USED B; # WR SPECIFIED FLAG #
ITEM CHARVAL C(10); #FOR CLARIFIER WORD#
ARRAY ERROR$WORD [0:0] S(1); # BUFFER WORD FOR ERROR MESSAGE #
BEGIN
ITEM PARAM C(0,0,4) = [" "]; # PARAMETER #
ITEM SLASH C(0,24,1) = ["/"];
ITEM PVALUE C(0,30,5) = [" "]; # VALUE #
END
SWITCH INCLJMP NEXT$PRM, , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
, PORT$ , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, , # AUTO , SL ,#
, , # LSPEED , DFL ,#
, , # FRAME , RTIME ,#
, , # RCOUNT , NSVC ,#
, , # PSN , DCE ,#
DTEA$ , , # DTEA , ,#
, , # , ,#
, , # , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, COLLECT$ , # NEN , COLLECT ,#
, , # XAUTO , DT ,#
, , # SDT , TA ,#
ABL$ , DBZ$ , # ABL , DBZ ,#
UBZ$ , DBL$ , # UBZ , DBL ,#
UBL$ , , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, PRI$ , # AUTOCON , PRI ,#
, , # P80 , P81 ,#
, , # P82 , P83 ,#
, , # P84 , P85 ,#
, , # P86 , P87 ,#
, , # P88 , P89 ,#
, , # AL , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, , # PW , SE ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # MFAM , MUSER ,#
, , # MAPPL , DFAM ,#
, , # DUSER , ,#
, , # , ,#
, , # PAPPL , ,#
, , # , ,#
, , # UID ,PRIV ,#
, , # KDSP , ,#
, , # NAME1 , NAME2 ,#
SNODE$ , DNODE$ , # SNODE , DNODE ,#
, , # ACCLEV , DHOST ,#
DPLR$ , DPLS$ , # DPLR , DPLS ,#
, , # PRID , UDATA ,#
WR$ , WS$ , # WR , WS ,#
, , # , ,#
FAM$ , UNAME$ , # FAM , UNAME ,#
FAC$ , FAC$ , # FAC1 , FAC2 ,#
FAC$ , FAC$ , # FAC3 , FAC4 ,#
FAC$ , FAC$ , # FAC5 , FAC6 ,#
FAC$ , FAC$ , # FAC7 , FAC8 ,#
FAC$ , FAC$ , # FAC9 , FAC10 ,#
FAC$ , FAC$ , # FAC11 , FAC12 ,#
FAC$ , FAC$ , # FAC13 , FAC14 ,#
FAC$ , FAC$ , # FAC15 , FAC16 ,#
FAC$ , FAC$ , # FAC17 , FAC18 ,#
FAC$ , FAC$ , # FAC19 , FAC20 ,#
FAC$ , FAC$ , # FAC21 , FAC22 ,#
FAC$ , FAC$ , # FAC23 , FAC24 ,#
FAC$ , FAC$ , # FAC25 , FAC26 ,#
FAC$ , FAC$ , # FAC27 , FAC28 ,#
FAC$ , FAC$ , # FAC29 , FAC30 ,#
FAC$ , ANAME$ , # FAC31 , ANAME ,#
SHOST$ , FASTSEL$ ; # SHOST , FASTSEL #
CONTROL EJECT;
# #
# INCALPR CODE BEGINS HERE #
# #
ABL$USED = FALSE; # CLEAR PARAM SPECIFIED FLAG #
ANAM$USED = FALSE;
DBL$USED = FALSE;
DBZ$USED = FALSE;
DPLS$USED = FALSE;
DPLR$USED = FALSE;
DNODE$USED = FALSE;
FAM$USED = FALSE;
SHST$USED = FALSE;
UBL$USED = FALSE;
UBZ$USED = FALSE;
UNAM$USED = FALSE;
WS$USED = FALSE;
WR$USED = FALSE;
FAC$LENG = 0;
CRNT$ENT = IBRWC[1] + 1; # POINT TO NEXT ENTRY #
IF IBRWC[1]+MXIB$ENT GQ IB$LENG-1
THEN # IF NEED MORE TABLE SPACE #
BEGIN # ALLOCATE MORE SPACE #
SSTATS(P<INCALL$TABLE>,MXIB$ENT);
END
NEXT$WORD = CRNT$ENT + FIX$ENT; # CALCULATE NEXT AVAILABLE WORD #
FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1
DO
BEGIN
IBWORD[I] = 0; # CLEAR NEXT ENTRY #
END
IBWC[CRNT$ENT] = FIX$ENT; # ENTER ENTRY SIZE #
FOR I=1 STEP 1 UNTIL STWC[0] # FOR EACH VALUE DECLARATION #
DO
BEGIN
GOTO INCLJMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
ANAME$:
ANAM$USED = TRUE; # SET ANAME SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE OK #
BEGIN
IF STVALLEN[I] LQ MXANAME # IF LENGTH IS LEGAL #
THEN
BEGIN
FOR J=0 STEP 1 UNTIL MXANAME-1
DO
BEGIN # PACK HEX DIGITS #
B<J*8,8>IBRANAME[CRNT$ENT+1] = A$CHAR[C<J,1>STVALNAM[I]];
END
END
ELSE
BEGIN
CTEMP = " ";
NDLEM2(ERR100,STLNUM[0],CTEMP); # VALUE OUT OF RANGE #
END
END
TEST I;
PRI$:
IF NOT STVLERR[I] # IF PRI VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # SET PRI FLAG IN ENTRY #
IBPRI[CRNT$ENT + 2] = TRUE;
END
END
TEST I;
DBL$:
DBL$USED = TRUE; # SET DBL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DBL VALUE IN ENTRY #
IBDBL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
DBZ$:
DBZ$USED = TRUE; # SET DBZ SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DBZ VALUE IN ENTRY #
IBDBZ[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
UBL$:
UBL$USED = TRUE; # SET UBL SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT UBL VALUE IN ENTRY #
IBUBL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
UBZ$:
UBZ$USED = TRUE; # SET UBZ SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IF O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT UBZ VALUE IN ENTRY #
IBUBZ[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
ABL$:
ABL$USED = TRUE; # SET ABL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT ABL VALUE IN ENTRY #
IBABL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
SNODE$:
IF NOT STVLERR[I]
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
IB$STAT = TRUE; # PRESET IB$STAT #
IF STVALNUM[I] LS 0 OR STVALNUM[I] GR SNO$MAX
THEN
BEGIN
CHARVAL=XCDD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CHARVAL);
IB$STAT=FALSE;
END
IF IB$STAT
THEN
BEGIN # PUT SNODE VALUE IN ENTRY #
IBSNODE[CRNT$ENT + 3] = STVALNUM[I];
END
END
TEST I;
DNODE$:
DNODE$USED = TRUE ;
IF NOT STVLERR[I] # IF DNODE VALUE IS OK #
THEN
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); # CHECK RANGE #
IF IB$STAT # IF NOT OUT OF RANGE #
THEN
BEGIN
IBDNODE[CRNT$ENT+3] = STVALNUM[I]; # INSERT VALUE #
END
END
TEST I;
PORT$:
IF NOT STVLERR[I]
THEN # IF PORT VALUE IS O.K. #
BEGIN
IF (STVALNUM[I] LQ X"FE") AND (STVALNUM[I] GR X"00")
THEN # IF VALUE IS WITHIN RANGE #
BEGIN
IBPORT[CRNT$ENT + 2] = STVALNUM[I]; # STORE VALUE IN ENTRY#
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CTEMP);
END
END
TEST I;
WR$:
WR$USED = TRUE; # SET WS SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT WS VALUE IN ENTRY #
IBWR[CRNT$ENT + 3] = STVALNUM[I];
END
END
TEST I;
WS$:
WS$USED = TRUE; # SET WS SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT WS VALUE IN ENTRY #
IBWS[CRNT$ENT + 3] = STVALNUM[I];
END
END
TEST I;
DPLR$:
DPLR$USED = TRUE; # SET DPLR SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DPLR VALUE IN ENTRY #
ITEMP = 16; # SET TO MINIMUM DPLR VALUE #
FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I]
DO # DETERMINE VALUE (POWER OF TWO) #
BEGIN
ITEMP = ITEMP * 2; # SET TO NEXT POWER OF TWO #
END
IBDPLR[CRNT$ENT + 3] = J; # PUT VALUE IN ENTRY #
IF STVALNUM[I] NQ ITEMP
THEN # VALUE IS NOT POWER OF 2 #
BEGIN # FLAG WARNING #
PARAM[0] = "DPLR"; # PARAMETER NAME #
CTEMP = XCDD(ITEMP);
PVALUE[0] = C<5,5>CTEMP; # VALUE #
NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
END
END
END
TEST I;
DPLS$:
DPLS$USED = TRUE; # SET DPLS SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);
IF IB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DPLS VALUE IN ENTRY #
ITEMP = 16; # SET TO MINIMUM DPLS VALUE #
FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I]
DO # DETERMINE VALUE (POWER OF TWO) #
BEGIN
ITEMP = ITEMP * 2; # SET TO NEXT POWER OF TWO #
END
IBDPLS[CRNT$ENT + 3] = J; # PUT VALUE IN ENTRY #
IF STVALNUM[I] NQ ITEMP
THEN # VALUE IS NOT POWER OF 2 #
BEGIN # FLAG WARNING #
PARAM[0] = "DPLS"; # PARAMETER NAME #
CTEMP = XCDD(ITEMP);
PVALUE[0] = C<5,5>CTEMP; # VALUE #
NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
END
END
END
TEST I;
SHOST$:
SHST$USED = TRUE; # SET SHOST SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);# CHECK RANGE #
IF IB$STAT
THEN
BEGIN
IBSHOST[CRNT$ENT + 4] = STVALNUM[I];
END
END
TEST I;
FAM$:
FAM$USED = TRUE; # SET FAM SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] NQ "0" # IF VALUE IS NOT ZERO #
THEN
BEGIN # PUT FAM NAME IN ENTRY #
CTEMP = STVALNAM[I];
NDLZFIL(CTEMP); # ZERO FILL CTEMP #
IBFAM[CRNT$ENT + 5] = CTEMP; # ASSIGN ZERO FILED NAME #
END
ELSE # VALUE IS ZERO #
BEGIN # PUT ZEROS IN FAM FIELD #
IBFAMU[CRNT$ENT + 5] = 0;
END
END
TEST I;
UNAME$:
UNAM$USED = TRUE; # SET UNAME SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # PUT USER NAME IN ENTRY #
CTEMP = STVALNAM[I];
NDLZFIL(CTEMP); # ZERO FILL NAME #
IBUSER[CRNT$ENT + 6] = CTEMP;
END
TEST I;
DTEA$: IF NOT STVLERR[I] # IF VALUE IS VALID #
THEN
BEGIN
CTEMP2 = STVALNAM[I]; # GET FIRST 7 CHARACTER #
C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER #
C<14,1>CTEMP2 = STVALNAM[I+2];# GET NEXT 1 CHARACTER #
IF STVALLEN[I] LQ MXDTEA # IF VALUE LENGTH O.K. #
THEN
BEGIN
IBDTEL[CRNT$ENT+3] = STVALLEN[I];
IBWORD[CRNT$ENT+7] = 0; # CLEAR DTEA WORD #
FOR J = 0 STEP 1 UNTIL STVALLEN[I] - 1 # ASSIGN DTEA VALUE #
DO
BEGIN
B<J*4,4>IBWORD[CRNT$ENT + 7] = C<J,1>CTEMP2 - ZERO;
END
END
ELSE
BEGIN
NDLEM2(ERR100,STLNUM[0],CTEMP2); # VALUE OUT OF RANGE #
END
END
I = I + 2;
TEST I;
FAC$:
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC
THEN # IF VALUE IS WITHIN RANGE #
BEGIN # INCREMENT FAC COUNT #
IBFACNUM[CRNT$ENT + 6] = IBFACNUM[CRNT$ENT + 6] + 1;
IBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
IBFACL[NEXT$WORD] = STVALLEN[I]; # SAVE LENGTH #
ITEMP = STVALLEN[I] * 4; # CALCULATE MASK #
B<0,ITEMP>IBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ];
IBWC[CRNT$ENT] = IBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
FAC$LENG = FAC$LENG + STVALLEN[I]; # INCREMENT FAC LENGTH#
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
IBWORD[NEXT$WORD] = 0;
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(STWORD[I+1]);
NDLEM2(ERR100,STLNUM[0],CTEMP);
END
END
I = I + 1;
TEST I;
COLLECT$:
IF NOT STVLERR[I] # IF COLLECT VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # SET COLLECT FLAG IN ENTRY #
IBCOLCT[CRNT$ENT + 3] = TRUE;
END
END
TEST I;
FASTSEL$:
IF NOT STVLERR[I] # IF FASTSEL VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # SET FASTSEL FLAG IN ENTRY #
IBFSTSL[CRNT$ENT + 3] = TRUE;
END
END
TEST I;
NEXT$PRM: END
IF NOT FAM$USED # IF FAM NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"FAM");
END
IF NOT UNAM$USED # IF UNAME NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"UNAME");
END
IF NOT ANAM$USED
THEN # IF ANAME WAS NOT SPECIFIED #
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"ANAME");
END
IF NOT SHST$USED
THEN # IF SHOST WAS NOT SPECIFIED #
BEGIN
IBSHOST[CRNT$ENT + 4] = SHOST$DEF; # DEFAULT SHOST VALUE #
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT DBL VALUE IN ENTRY#
IBDBL[CRNT$ENT + 2] = DBL$DEF;
END
IF NOT ABL$USED # IF ABL NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT ABL VALUE IN ENTRY#
IBABL[CRNT$ENT + 2] = ABL$DEF;
END
IF NOT DBZ$USED # IF DBZ NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT DBZ VALUE IN ENTRY#
IBDBZ[CRNT$ENT + 2] = DBZ$DEF;
END
IF NOT UBL$USED # IF UBL WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBUBL[CRNT$ENT + 2] = UBL$DEF;
END
IF NOT UBZ$USED # IF UBZ WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBUBZ[CRNT$ENT + 2] = UBZ$DEF;
END
IF NOT DNODE$USED # IF DNODE WAS NOT SPECIFIED #
THEN
BEGIN
IBDNODE[CRNT$ENT+3] = DNODE$DEF; # PUT DEFAULT VALUE IN ENTRY #
END
IF NOT DPLR$USED # IF DPLR WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBDPLR[CRNT$ENT + 3] = DPL$DEF;
END
IF NOT DPLS$USED # IF DPLS WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBDPLS[CRNT$ENT + 3] = DPL$DEF;
END
IF NOT WS$USED # IF WS WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBWS[CRNT$ENT + 3] = W$DEF;
END
IF NOT WR$USED # IF WR WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
IBWR[CRNT$ENT + 3] = W$DEF;
END
IF FAC$LENG GR MXFACL
THEN # IF TOTAL FAC LENGTH IS TOO BIG #
BEGIN # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT #
NDLEM2(ERR153,STLNUM[0]," ");
END
IBRWC[1] = IBRWC[1] + IBWC[CRNT$ENT];
RETURN; # **** RETURN **** #
END # INCALPR #
CONTROL EJECT;
PROC LCFTERM;
BEGIN
*IF,DEF,IMS
#
** LCFTERM - LCF TERMINATION ROUTINE.
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE DOES FINAL PROCESSING FOR LCF CREATION.
*
* PROC LCFTERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* WRITE PREFIX,APPL,USER,OUTCALL, AND INCALL TABLE TO LCF.
* IF NO FATAL ERRORS WERE DETECTED,
* THEN,
* PUT VALID LCF INDICATOR IN THE VALIDATION RECORD.
* OTHERWISE,
* PUT INVALID LCF INDICATOR IN VALIDATION RECORD.
* WRITE VALIDATION RECORD TO LCF.
* DE-ALLOCATE TABLE SPACE.
*
#
*ENDIF
#
**** PROC LCFTERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC SSTATS; # USED TO RELEASE TABLE SPACE #
PROC NDLEM2; # MAKES ENTERIES IN PASS2 ERROR FILE #
END
#
****
#
DEF BAD$MSG # "ERRORS DETECTED IN CREATION OF THIS LCF." #;
DEF HDR$SZ # 17 #; # HEADER RECORD SIZE #
STATUS LF$TBL HDR, # HEADER RECORD #
APPL, # APPL TABLE #
USER, # USER TABLE #
OB, # OUTCALL BLOCK TABLE #
IB, # INCALL BLOCK TABLE #
PATHPID, # PATHPID TABLE #
VR; # VALIDATION RECORD #
ITEM WSA; # ADDRESS OF TABLE TO BE WRITTEN #
CONTROL EJECT;
# #
# LCFTERM CODE BEGINS HERE #
# #
WSA = LOC(PRFX$TABLE); # WRITE FILE HEADER TO LCF #
WR$LCF(LF$TBL"HDR",WSA,HDR$SZ);
WSA = LOC(APPL$TABLE); # WRITE APPL TABLE TO LCF #
WR$LCF(LF$TBL"APPL",WSA,ATWC[1]+1);
WSA = LOC(USER$TABLE); # WRITE USER TABLE TO LCF #
WR$LCF(LF$TBL"USER",WSA,UTWC[1]+1);
WSA = LOC(OUTCALL$TABL); # WRITE OUTCALL TABLE TO LCF #
WR$LCF(LF$TBL"OB",WSA,OBRWC[1] + 1);
WSA = LOC(INCALL$TABLE); # WRITE INCALL TABLE TO LCF #
WR$LCF(LF$TBL"IB",WSA,IBRWC[1]+1);
WSA = LOC(PATHPID$TAB); # WRITE FILE HEADER TO LCF #
WR$LCF(LF$TBL"PATHPID",WSA,PIRWC[1]+1);
# CREATE VALIDATION RECORD #
IF ERRCNT EQ 0
THEN # IF NO FATAL ERRORS DETECTED #
BEGIN
VE$ID[0] = "VALIDLF"; # INSERT RECORD NAME #
VEWORD1[0] = 1; # SET FLAG TO GOOD LCF #
END
ELSE # FATAL ERROR(S) DETECTED #
BEGIN
VE$ID[0] = "INVLDLF"; # INSERT RECORD NAME #
VEWORD1[0] = 0; # CLEAR LCF GOOD FLAG #
PT$TITLE[0] = BAD$MSG; # INSERT BAD LCF MSG IN PRFX TBL#
END
PT$FNAME[0] = "ENDLCF"; # PUT END FILE INDICATOR INTO #
# PREFIX TABLE #
WSA = LOC(PRFX$TABLE); # WRITE VALIDATION RECORD TO LCF#
WR$LCF(LF$TBL"VR",WSA,HDR$SZ);
# #
NDLEM2(0,0,0); # CLEAR PASS2 ERROR BUFFER #
# #
SSTATS
(P<APPL
$TABLE>
,-AT
$LENG
); # RELEASE TABLE SPACE # SSTATS(P<USER$TABLE>,-UT$LENG);
SSTATS(P<OUTCALL$TABL>,-OB$LENG);
SSTATS(P<INCALL$TABLE>,-IB$LENG);
SSTATS
(P<PATHPID
$TAB>
,-PP
$LENG
);# #
RETURN; # **** RETURN **** #
END # LCFTERM #
CONTROL EJECT;
PROC LFILEPR;
BEGIN
*IF,DEF,IMS
#
** LFILEPR - LFILE STATEMENT PROC.
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE USES THE LFILE STATEMENT TO DEFINE THE FILE NAME
* FOR THE LCF AND CREATES THE PREFIX TABLE FOR THE HEADER AND
* VALIDATION RECORDS.
*
* PROC LFILEPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* IF LABEL IS O.K.
* CREATE PREFIX TABLE.
* CREATE VERSION ENTRY.
* INITIALIZE LCF FET.
* REWIND LCF FILE.
*
#
*ENDIF
#
**** PROC LFILEPR - XREF LIST BEGINS
#
XREF
BEGIN
FUNC EDATE C(10); # UNPACKS DATE #
FUNC ETIME C(10); # UNPACKS TIME #
PROC PDATE; # RETURNS PACKED DATE AND TIME #
PROC RECALL; # RETURNS CONTROL WHEN RECALL BIT IS SET #
PROC REWIND; # REWINDS A GIVEN FILE #
PROC VERSION; # RETURNS OPERATING SYSTEM VERSION #
PROC NDLZFIL; # ZERO FILLS A CHARACTER NAME #
END
#
****
#
*CALL NAMLEV
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ARRAY PACK$DATE [0:0] S(1); # TEMPORARY FOR PACKED DATE/TIME#
BEGIN
ITEM PD$DATE U(0,24,18); # PACKED DATE #
ITEM PD$TIME U(0,42,18); # PACKED TIME #
ITEM PD$WORD U(0,24,36); # #
END
ARRAY VRSN$PARAMS [0:0] S(1); # WORD USED TO CONTAIN PARAMS #
BEGIN # FOR CALL TO VERSION #
ITEM VP$BC U(0,0,12) = [5]; # BYTE COUNT #
ITEM VP$SB U(0,12,12) = [0]; # STARTING BYTE IN SOURCE FIELD #
ITEM VP$BP U(0,24,12) = [0]; # BYTE POSITION IN REC FIELD #
ITEM VP$WSA U(0,42,18); # ADDR OF RECEIVING FIELD #
END
CONTROL EJECT;
# #
# LFILEPR CODE BEGINS HERE #
# #
IF NOT STLBERR[1] # IF NO LABEL ERROR #
THEN
BEGIN # CREATE PREFIX TABLE #
PTWORD0[0] = 0; # CLEAR FIRST WORD #
PT$ID[0] = O"7700"; # SET TABLE I.D. #
PTWC[0] = O"0016"; # SET WORD COUNT #
PTWORD1[0] = 0; # CLEAR SECOND WORD #
PT$FNAME[0] = STLABEL[1]; # SET FILE NAME #
PDATE(PACK$DATE); # GET PACKED DATE AND TIME #
CTEMP = ETIME(PD$TIME[0]); # UNPACK THE TIME #
PT$TIME[0] = C<1,8>CTEMP; # PUT TIME IN TABLE #
CTEMP = EDATE(PD$DATE[0]); # UNPACK THE DATE #
PT$DATE[0] = C<1,8>CTEMP; # PUT DATE IN TABLE #
VP$WSA[0] = LOC(PT$OPS[0]); # SET LOCATION FOR OS VERSION #
VERSION(VRSN$PARAMS); # GET OS VERSION #
PT$PNAME[0] = "NDLP"; # SET PROGRAM NAME #
PT$PVER[0] = C<9,3>NAMVER[0]; # SET PROGRAM VERSION #
PT$PLEV[0] = NAMLV[0]; # SET PROGRAM BUILD LEVEL #
PT$BLNK1[0] = " "; # CLEAR FIELDS #
PT$BLNK2[0] = " ";
PT$TITLE[0] = TITLE$WORD[0]; # SET TITLE IN TABLE #
# CREATE VERSION ENTRY #
VEWORD0[0] = 0; # CLEAR 1ST WORD #
VE$ID[0] = "VERSION"; # ENTER ENTRY I.D. #
VEWORD1[0] = 0; # CLEAR 2ND WORD #
VE$PDATE[0] = PD$WORD[0]; # ENTER THE PACKED DATE AND TIME#
# INITIALIZE LCF FET AND LCF #
CTEMP = STLABEL[1]; # PUT FILE NAME IN TEMPORARY #
NDLZFIL(CTEMP); # ZERO FILL NAME #
LCFLFN[0] = CTEMP; # PUT FILE NAME IN FET #
REWIND(LCFFET); # REWIND THE LCF FILE #
RECALL(LCFFET);
END
ELSE # LABEL ERRORS DETECTED #
BEGIN
LCFWORD0[0] = 0; # CLEAR LCF FET #
END
RETURN; # **** RETURN **** #
END # LFILEPR #
CONTROL EJECT;
PROC OUTCLPR;
BEGIN
*IF,DEF,IMS
#
** OUTCLPR - OUTCALL STATEMENT PROC.
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE CHECKS THE OUTCALL STMTS AND MAKES ENTRIES INTO
* THE OUTCALL TABLE
*
* PROC OUTCLPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INCREMENT OUTCALL TABLE WORD COUNT.
* CLEAR NEXT ENTRY.
* SET ENTRY WORD COUNT.
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(NAME1,NAME2):
* IF VALUE IS O.K.,
* PUT VALUE IN ENTRY
* CASE 2(SNODE,DNODE,ACCLEV,DBL,ABL,DBZ):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS WITHIN RANGE.
* IF VALUE IS WITHIN RANGE,
* ENTER VALUE IN ENTRY
* CASE 3(PRI):
* IF VALUE IS O.K.,
* IF VALUE IS -YES-,
* SET PRI FLAG IN ENTRY.
* IF NAME1, NAME2,SNODE, OR DNODE WAS NOT SPECIFIED,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF ACCLEV ABL,DBL, OR DBZ WAS NOT SPECIFIED,
* PUT DEFAULT VALUE IN ENTRY.
*
#
*ENDIF
#
**** PROC OUTCLPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS IF VALUE IS WITHIN RANGE #
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS DEC BINARY TO DISPLAY CODE #
FUNC XCHD C(10); # CONVERTS HEX BINARY TO DISPLAY CODE #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF ACCL$DEF # 0 #; # DEFAULT ACCLEV VALUE #
DEF DNODE$MAX # 255 #; # MAXIMUM VALUE OF DENODE FOR OUTCALL #
DEF DBL$DEF # 2 #; # DEFAULT DBL VALUE #
DEF DBZ$DEF # 225 #; # DEFAULT DBZ VALUE #
DEF DPL$DEF # 7 #; # DEFAULT DPL VALUE #
DEF FIX$ENT # 6 #; # SIZE OF FIXED LENGTH PORTION OF ENTRY #
DEF MINFAC # 4 #; # MINIMUM LENGTH FOR EACH FACILITY CODE #
DEF MXFAC # 12 #; # MAX LENGTH FOR EACH FACILITY CODE #
DEF MXUDATA # 248 #; # MAX LENGTH OF UDATA #
DEF MXFACL # 126 #; # TOTAL MAX LENGTH FOR ALL FACILITIES #
DEF MXDTEA # 15 #; # MAX LENGTH OF DTEA VALUE #
DEF MXOB$ENT # 50 #; # MAXIMUM OUTCALL BLOCK ENTRY SIZE #
DEF MXPRID # 6 #; # MAX LENGTH OF PRID VALUE #
DEF PRID$AOS # X"C0000000" #; # DEFAULT PRID FOR DOS = AOS/VS #
DEF PRID$DEF # X"C1000000" #; # DEFAULT PRID VALUE #
DEF PRID$NVE # X"C2000000" #; # DEFAULT PRID FOR DOS = NOS/VE #
DEF UDL$DEF # 10 #; # DEFAULT UDATA LENGTH VALUE #
DEF UBL$DEF # 2 #; # DEFAULT UBL VALUE #
DEF UBZ$DEF # 2 #; # DEFAULT UBZ VALUE #
DEF UBZMUL # 100 #; # MULTIPLE WITH WHICH UBZ IS ENCODED #
DEF W$DEF # 2 #; # DEFAULT -W- VALUE #
DEF ZERO # O"33" #; # DISPLAY CODE ZERO #
DEF SHST$LEN # 24 #; # LENGTH OF THE SHOST IN BITS #
DEF UDL$BIT # 32 #; # START BIT OF UDL DATA FOR TRANSLATION #
DEF WORDSIZE # 60 #; # WORD SIZE OF 60 BITS #
DEF MXSTRINGW # 14 #; # MAXIMUM NUMBER OF WORDS FOR DOMAIN/SERV #
DEF MXOSTYPE # 10 #; # MAXIMUM NUMBER OF OS TYPES #
DEF UNITSEP # X"1F" #; # UPPER CASE UNIT SEPARATOR #
ITEM TOTLEN; # TOTAL LENGTH OF DOMAIN + SERVICE #
ITEM ABL$USED B; # ABL SPECIFIED FLAG #
ITEM ACCL$USED B; # ACCLEV SPECIFIED FLAG #
ITEM PORT$USED B; # PORT NUMBER SPECIFIED FLAG #
ITEM PRID$USED B; # PRID SPECIFIED FLAG #
ITEM SERVICE$USED B; # SERVICE SPECIFIED FLAG #
ITEM DOMAIN$USED B; # DOMAIN SPECIFIED FLAG #
ITEM CRNT$OSDID; # CURRENT OS ORDINAL #
ITEM CRNT$ORNET; # CURRENT ORIGINATING NETWORK #
ITEM CRNT$DENET; # CURRENT DESTINATION NETWORK #
ITEM CRNT$DOSS; # CURRENT DESTINATION OPERATING SYSTEMS #
ITEM CRNT$DHST C(10); # CURRENT DHOST VALUE #
ITEM CRNT$ENT; # POINTER TO BEGINNING OF CURRENT ENTRY #
ITEM CRNT$PRID; # CURRENT PRID VALUE #
ITEM UDATA$DEF C(24); # DEFAULT UDATA SIZE #
ITEM UDATAW ; # WORD COUNT OF UDATA SPECIFIED #
ITEM CRNT$SHST; # CURRENT VALUE OF SHOST #
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM CTEMP2 C(20); # CHARACTER TEMPORARY #
ITEM DBL$USED B; # DBL SPECIFIED FLAG #
ITEM DBZ$USED B; # DBZ SPECIFIED FLAG #
ITEM DHST$LEN; # DHOST VALUE LENGTH #
ITEM NAME1LEN; # NAME1 VALUE LENGTH #
ITEM DHST$USED B; # DHOST SPECIFIED FLAG #
ITEM SHST$USED B; # SHOST SPECIFIED FLAG #
ITEM DPLS$USED B; # DPLS SPECIFIED FLAG #
ITEM FAC$LENG; # CURRENT TOTAL FACILITY CODE LENGTH #
ITEM NOMATCH B; # NO MATCH FLAG #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # INTEGER TEMPORARY #
ITEM K; # INTEGER TEMPORARY #
ITEM WDC; # WORD COUNT FOR SERVICE/DOMAIN #
ITEM NAM1$USED B; # NAME1 SPECIFIED FLAG #
ITEM NAM2$USED B; # NAME2 SPECIFIED FLAG #
ITEM NEXT$WORD; # POINTER TO NEXT AVAILABLE WORD #
ITEM SAVE$WORD; # COPY OF THE ORIGINAL POINTER TO NEXT #
# AVAILABLE WORD #
ITEM OB$STAT B; # STATUS RETURNED BY RANGE CHECK PROC #
ITEM UBL$USED B; # UBL SPECIFIED FLAG #
ITEM UBZ$USED B; # UBZ SPECIFIED FLAG #
ITEM UDATA$USED B; # UDATA SPECIFIED FLAG #
ITEM WS$USED B; # -WS- SPECIFIED FLAG #
ITEM SETCHAR B; # FLAG FOR PASSING CHARACTER #
ITEM PID$USED B; # -PID- SPECIFIED FLAG #
ITEM CRUBIT; # BIT POINTER FOR CRNT$UDATA #
ARRAY CRNT$UDATA [0:17] S(1);
BEGIN
ITEM CRNT$UWRD U(00,00,60); # UDATA VALUE #
END
ARRAY SERVICE$WD[ 0 : 14] S(1);
BEGIN
ITEM SERVICELEN U(00,00,42); # LENGTH OF SERVICE IN SEMIOCTET#
ITEM SERVICELEN1 U(00,42,18); # EXTENDED LENGTH OF SERVICE #
ITEM SERVICEWD U(00,00,60); # CONTENT OF SERVICE #
END
ARRAY ASCIICHAR [0:0] S(1);
BEGIN
ITEM ASCII$CHAR U(00,00,08);
ITEM ASCII$CHAR1 U(00,00,04);
ITEM ASCII$CHAR2 U(00,04,04);
END
ARRAY DOMAIN$WD[ 0 : 14] S(1);
BEGIN
ITEM DOMAINLEN U(00,00,60); # LENGTH OF DOMAIN IN SEMIOCTET#
ITEM DOMAINWD U(00,00,60); # CONTENT OF DOMAIN #
END
ARRAY DTEA$VAL [0:0] S(1);
BEGIN # DTEA VALUE #
ITEM DTEA1 U(00,00,52); # 1ST 13 NUMBERS OF DTEA VALUE #
ITEM DTEA2 U(00,52,08); # 14TH NUMBER OF DTEA VALUE #
ITEM DTEA$WORD I(00,00,60);
END
ARRAY ERROR$WORD [0:0] S(1); # BUFFER WORD FOR ERROR MESSAGE #
BEGIN
ITEM PARAM C(0,0,4) = [" "]; # PARAMETER #
ITEM SLASH C(0,24,1) = ["/"];
ITEM PVALUE C(0,30,5) = [" "]; # VALUE #
END
STATUS ORNETWORK OUNKNOWN,OCCP,OCDCNET; # ORIGINAL NETWORK TYPE #
STATUS DESNETWORK DUNKNOWN, DCCP,DCDCNET,DAOSVS,DFOREIGN;
# DESTINATION NETWORK TYPE #
STATUS DOSS DOSUNKNOWN,DONOS,DONOSVE,DOAOSVS,DOFOREIGN;
# DESTINATION OPERATING SYSTEM#
ARRAY OSDARRAY [ 0 : MXOSTYPE] S(1);
BEGIN
ITEM OSDMN C(00,00,03) = [ "PPO",
"PDO",
"DPO",
"DDO",
"PDV",
"DDV",
"PAA",
"DAA",
"PFF",
"DFF",
];
ITEM OSDMN1 C(00,00,01);
ITEM OSDMN2 C(00,06,01);
ITEM OSDMN3 C(00,12,01);
END
ARRAY DNTYPE [ 00:03] S(1);
BEGIN
ITEM DNNCHAR C(00,00,01) = ["P","D","A","F"];
ITEM DNNETV U(00,42,18) = [ DESNETWORK"DCCP",
DESNETWORK"DCDCNET",
DESNETWORK"DAOSVS",
DESNETWORK"DFOREIGN"
];
END
ARRAY DNOSTYPE [ 00:03 ] S(1);
BEGIN
ITEM DNOCHAR C(00,00,01) = [ "O","V","A","F"];
ITEM DNOOSV U(00,42,18) = [ DOSS"DONOS",
DOSS"DONOSVE",
DOSS"DOAOSVS",
DOSS"DOFOREIGN"
];
END
SWITCH OUTCJMP NEXT$PRM , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
, PORT$ , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, , # AUTO , SL ,#
, , # LSPEED , DFL ,#
, , # FRAME , RTIME ,#
, , # RCOUNT , NSVC ,#
, , # PSN , DCE ,#
DTEA$ , , # DTEA , ,#
, , # , ,#
, , # , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, , # NEN , ,#
, , # , DT ,#
, , # SDT , TA ,#
ABL$ , DBZ$ , # ABL , DBZ ,#
UBZ$ , DBL$ , # UBZ , DBL ,#
UBL$ , , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, PRI$ , # AUTOCON , PRI ,#
, , # P80 , P81 ,#
, , # P82 , P83 ,#
, , # P84 , P85 ,#
, , # P86 , P87 ,#
, , # P88 , P89 ,#
, , # AL , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, , # PW , SE ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
NETOSD$ , DOMAIN$ , # NETOSD , DOMAIN ,#
SERVICE$ , , # , ,#
, , # MFAM , MUSER ,#
, , # MAPPL , DFAM ,#
, , # DUSER , ,#
, , # , ,#
, , # PAPPL , ,#
, , # , ,#
, , # UID ,PRIV ,#
, , # KDSP , ,#
NAME1$ , NAME2$ , # NAME1 , NAME2 ,#
SNODE$ , DNODE$ , # SNODE , DNODE ,#
ACCLEV$ , DHOST$ , # ACCLEV , DHOST ,#
, DPLS$ , # , DPLS ,#
PRID$ , UDATA$ , # PRID , UDATA ,#
, WS$ , # , WS ,#
PID$ , , # PID , ,#
, , # FAM , UNAME ,#
FAC$ , FAC$ , # FAC1 , FAC2 ,#
FAC$ , FAC$ , # FAC3 , FAC4 ,#
FAC$ , FAC$ , # FAC5 , FAC6 ,#
FAC$ , FAC$ , # FAC7 , FAC8 ,#
FAC$ , FAC$ , # FAC9 , FAC10 ,#
FAC$ , FAC$ , # FAC11 , FAC12 ,#
FAC$ , FAC$ , # FAC13 , FAC14 ,#
FAC$ , FAC$ , # FAC15 , FAC16 ,#
FAC$ , FAC$ , # FAC17 , FAC18 ,#
FAC$ , FAC$ , # FAC19 , FAC20 ,#
FAC$ , FAC$ , # FAC21 , FAC22 ,#
FAC$ , FAC$ , # FAC23 , FAC24 ,#
FAC$ , FAC$ , # FAC25 , FAC26 ,#
FAC$ , FAC$ , # FAC27 , FAC28 ,#
FAC$ , FAC$ , # FAC29 , FAC30 ,#
FAC$ , , # FAC31 , ANAME ,#
SHOST$ ; # SHOST #
CONTROL EJECT;
# #
# OUTCLPR CODE BEGINS HERE #
# #
ABL$USED = FALSE; # CLEAR PARAM SPECIFIED FLAGS #
PRID$USED = FALSE;
ACCL$USED = FALSE;
DBL$USED = FALSE;
DBZ$USED = FALSE;
DHST$USED = FALSE;
DPLS$USED = FALSE;
NAM1$USED = FALSE;
NAM2$USED = FALSE;
UBL$USED = FALSE;
UBZ$USED = FALSE;
UDATA$USED = FALSE;
WS$USED = FALSE;
PID$USED = FALSE;
SHST$USED = FALSE;
PORT$USED = FALSE;
SERVICE$USED = FALSE;
DOMAIN$USED = FALSE;
TOTLEN = 0;
SERVICEWD[0] = 0;
DOMAINLEN[0] = 0;
CRNT$ORNET = ORNETWORK"OCCP";
CRNT$DENET = DESNETWORK"DCCP";
CRNT$DOSS = DOSS"DONOS";
PP$SNODE = 0;
PP$DNODE = 0;
PP$PORT = 0;
PP$DTEAL = 0;
PP$DTEA = 0;
CRNT$PID = " "; # BLANK FILL CURRENT PID VALUE #
UDATA$DEF = " ";
CRNT$PRID = PRID$DEF; # SET CURRENT PRID VALUE TO DEFAULT #
DHST$LEN = 0; # CLEAR DHOST LENGTH VALUE #
FAC$LENG = 0; # CLEAR CURRENT FAC LENGTH #
CRNT$ENT = OBRWC[1] + 1; # POINT TO NEXT ENTRY #
IF OBRWC[1]+MXOB$ENT GQ OB$LENG-1
THEN # IF NEED MORE TABLE SPACE #
BEGIN # ALLOCATE MORE SPACE #
SSTATS(P<OUTCALL$TABL>,MXOB$ENT);
END
NEXT$WORD = CRNT$ENT + FIX$ENT; # POINT TO NEXT WORD #
FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1
DO
BEGIN
OBWORD[I] = 0; # CLEAR NEXT ENTRY #
END
OBWC[CRNT$ENT] = FIX$ENT; # SET ENTRY WORD COUNT #
FOR I=1 STEP 1 UNTIL STWC[0] # FOR EACH VALUE DECLARATION #
DO
BEGIN
GOTO OUTCJMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
NAME1$:
NAM1$USED = TRUE; # SET NAME1 SPECIFIED FLAG #
NAME1LEN = STVALLEN[I]; # SAVE LENGTH OF APPLICATIONS #
IF NOT STVLERR[I] # IF THE VALUE IS O.K. #
THEN
BEGIN # ENTER NAME1 VALUE IN ENTRY #
OBNAME1[CRNT$ENT + 1] = STVALNAM[I];
END
TEST I;
NAME2$:
NAM2$USED = TRUE; # SET NAME2 SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # ENTER NAME2 VALUE IN ENTRY #
OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
END
TEST I;
PRI$:
IF NOT STVLERR[I] # IF PRI VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # SET PRI FLAG IN ENTRY #
OBPRI[CRNT$ENT + 2] = TRUE;
END
END
TEST I;
DBL$:
DBL$USED = TRUE; # SET DBL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DBL VALUE IN ENTRY #
OBDBL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
DBZ$:
DBZ$USED = TRUE; # SET DBZ SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DBZ VALUE IN ENTRY #
OBDBZ[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
UBL$:
UBL$USED = TRUE; # SET UBL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT VALUE IN ENTRY #
OBUBL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
UBZ$:
UBZ$USED = TRUE; # SET UBZ SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT VALUE IN ENTRY #
OBUBZ[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
ABL$:
ABL$USED = TRUE; # SET ABL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT ABL VALUE IN ENTRY #
OBABL[CRNT$ENT + 2] = STVALNUM[I];
END
END
TEST I;
SNODE$:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT SNODE VALUE IN ENTRY #
OBSNODE[CRNT$ENT + 3] = STVALNUM[I];
PP$SNODE = STVALNUM[I]; # SAVE SNODE IN PP$SNODE #
END
END # FOR PATH PID TABLE #
TEST I;
PORT$:
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
IF STVALNUM[I] LQ X"FE"
THEN # IF VALUE IS WITHIN RANGE #
BEGIN
OBPORT[CRNT$ENT + 2] = STVALNUM[I]; # ENTRY PORT NUM #
PP$PORT = STVALNUM[I]; # PORT NUMBER USED BY PATH PID TABLE#
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CTEMP);
END
END
TEST I;
WS$:
WS$USED = TRUE; # SET -WS- SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT
THEN # IF VALUE IS WITHIN RANGE #
BEGIN
OBWS[CRNT$ENT + 3] = STVALNUM[I]; # ENTER -WS- VALUE #
END
END
TEST I;
DPLS$:
DPLS$USED = TRUE; # SET DPLS SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT
THEN # IF VALUE IS WITHIN RANGE #
BEGIN # CALCULATE VALUE (POWER OF TWO) #
ITEMP = 16; # SET TO SMALLEST DPL VALUE #
FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I]
DO # FOR INCREMENT OF EXPONENT #
BEGIN
ITEMP = ITEMP * 2; # SET TO NEXT POWER OF TWO #
END
OBDPLS[CRNT$ENT + 3] = J; # PUT VALUE IN ENTRY #
IF STVALNUM[I] NQ ITEMP
THEN # VALUE IS NOT POWER OF 2 #
BEGIN # FLAG WARNING #
PARAM[0] = "DPLS"; # PARAMETER NAME #
CTEMP = XCDD(ITEMP);
PVALUE[0] = C<5,5>CTEMP; # VALUE #
NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
END
END
END
TEST I;
DNODE$:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
OB$STAT = TRUE;
IF (STVALNUM[I] LS 0) OR (STVALNUM[I] GR DNODE$MAX)
THEN
BEGIN
OB$STAT = FALSE;
NDLEM2(ERR100,STLNUM[0],XCDD(STVALNUM[I]));
END # GENERATE ERROR MESSAGE #
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT DNODE VALUE IN ENTRY #
OBDNODE[CRNT$ENT + 3] = STVALNUM[I];
PP$DNODE = STVALNUM[I]; # SAVE DNODE IN PP$DNODE FOR #
END # PATH PID TABLE #
END
TEST I;
PID$:
PID$USED = TRUE; # SET NAME2 SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # ENTER NAME2 VALUE IN ENTRY #
CRNT$PID = STVALNAM[I]; # SAVE VALUE OF CURRENT PID #
OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
OBPID[CRNT$ENT + 2] = TRUE; # SET PID USED FLAG #
END
TEST I;
ACCLEV$:
ACCL$USED = TRUE; # SET ACCLEV SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE WITHIN RANGE #
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);
IF OB$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT ACCLEV VALUE IN ENTRY #
OBACC[CRNT$ENT + 3] = STVALNUM[I];
END
END
TEST I;
SHOST$:
SHST$USED = TRUE; # SET SHOST SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); # CHECK RANGE #
IF OB$STAT # IF RANGE IS O.K. #
THEN
BEGIN
CRNT$SHST = STVALNUM[I]; # ASSIGN STVALNUM IS CURRENT #
# SHOST #
END
END
TEST I;
DHOST$:
DHST$USED = TRUE; # SET DHOST SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); # CHECKS RANGE #
IF OB$STAT # IF RANGE IS OK #
THEN
BEGIN
CTEMP = XCHD(STVALNUM[I]); #CONVERTS TO HEX#
DC$ZFILL(CTEMP); #ZERO FILL CTEMP#
CRNT$DHST = C<8,2>CTEMP; #MOVE CTEMP TO DHST#
DHST$LEN = 2; #MUST BE 2 CHAR LONG#
END
ELSE
BEGIN # STICKS IN VALUES OF DHST$LEN #
DHST$LEN = 2; # DHST$LEN LEFT EAULT TO 2 #
CRNT$DHST = " "; # BLANK FILLED CRNT$DHST #
END
END
TEST I;
DTEA$:
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
CTEMP2 = STVALNAM[I]; # CONCATINATE NEXT TWO VALUES #
C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER #
C<14,1>CTEMP2 = STVALNAM[I + 2]; # GET NEXT ONE CHAR #
IF STVALLEN[I] LQ MXDTEA
THEN # IF VALUE IS WITHIN RANGE #
BEGIN
OBAL1[CRNT$ENT + 4] = STVALLEN[I];
PP$DTEAL = OBAL1[CRNT$ENT + 4]; # SAVE DTEA LENGTH #
ITEMP = CRNT$ENT + 4; # POINT TO DTEA WORD #
DTEA$WORD[0] = 0; # CLEAR DTEA VALUE TEMPORARY #
FOR J=0 STEP 1 UNTIL STVALLEN[I] - 1
DO # FOR EACH CHARACTER IN VALUE #
BEGIN # CONVERT CHARACTER TO 4-BIT BCD #
B<J*4,4>DTEA$WORD[0] = C<J,1>CTEMP2 - ZERO;
END
PP$DTEA = DTEA$WORD[0]; # SAVE DTEA FOR PATH PID ENTRY #
OBDTEA1[ITEMP] = DTEA1[0]; # PUT VALUE IN ENTRY #
OBDTEA2[ITEMP + 1] = DTEA2[0];
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
NDLEM2(ERR100,STLNUM[0],CTEMP2);
END
END
I = I + 2;
TEST I;
FAC$:
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC
THEN # IF VALUE IS WITHIN RANGE #
BEGIN # INCREMENT FAC COUNT #
OBFACNUM[CRNT$ENT + 3] = OBFACNUM[CRNT$ENT + 3] + 1;
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBFACL[NEXT$WORD] = STVALLEN[I]; # SAVE LENGTH #
ITEMP = STVALLEN[I] * 4; # CALCULATE MASK #
B<0,ITEMP>OBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ];
OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
FAC$LENG = FAC$LENG + STVALLEN[I]; # INCREMENT FAC LENGTH#
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0;
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(STWORD[I + 1]);
NDLEM2(ERR100,STLNUM[0],CTEMP);
END
END
I = I + 1;
TEST I;
NETOSD$:
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
NOMATCH = TRUE; # SET NOMATCH FLAG #
OSDMN[MXOSTYPE] = C<0,3>STVALNAM[I]; # PRELOAD PARAMETER WORD#
FOR K = 0 STEP 1 WHILE NOMATCH
DO
BEGIN
IF OSDMN[K] EQ C<0,3>STVALNAM[I]
THEN
BEGIN
NOMATCH = FALSE; # EXIT LOOP MATCH FOUND #
CRNT$OSDID = K;
END
END
IF CRNT$OSDID EQ MXOSTYPE
THEN
BEGIN
NDLEM2(ERR168,STLNUM[0],STVALNAM[I]);
END
IF OSDMN1[CRNT$OSDID] EQ "P"
THEN
BEGIN
CRNT$ORNET = ORNETWORK"OCCP"; # CCP IS THE ORGINAL NETWORK#
END
ELSE
BEGIN
CRNT$ORNET = ORNETWORK"OCDCNET"; # MUST BE CDCNET #
END
FOR K = 0 STEP 1 UNTIL 3
DO
BEGIN
IF OSDMN2[CRNT$OSDID] EQ DNNCHAR[K]
THEN
BEGIN
CRNT$DENET = DNNETV[K];
END
END
FOR K = 0 STEP 1 UNTIL 3
DO
BEGIN
IF OSDMN3[CRNT$OSDID] EQ DNOCHAR[K]
THEN
BEGIN
CRNT$DOSS = DNOOSV[K];
END
END
END
TEST I;
SERVICE$:
SERVICE$USED = TRUE; # SET SERVICE USED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF TOTLEN + STVALNUM[I] LQ MXUDATA # VALUE LENGTH O.K. #
THEN
BEGIN
WDC = STVALNUM[I]/10 + 1; # CALCULATE WORD COUNT #
TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
SERVICELEN[0] = STVALNUM[I]; # SAVE LENGTH OF SERVICE #
FOR K = 1 STEP 1 UNTIL WDC
DO
BEGIN
SERVICEWD[K] = STWORD[I + K]; # SAVE WORDS #
END
END
ELSE
BEGIN
NDLEM2(ERR100,STLNUM[0],"SERVICE");
END
END
I = I + MXSTRINGW;
TEST I;
DOMAIN$:
DOMAIN$USED = TRUE; # SET DOMAIN USED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF TOTLEN + STVALNUM[I] LQ MXUDATA # VALUE LENGTH O.K. #
THEN
BEGIN
WDC = STVALNUM[I]/10 + 1; # CALCULATE WORD COUNT #
TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
DOMAINLEN[0] = STVALNUM[I]; # SAVE LENGTH OF SERVICE #
FOR K = 1 STEP 1 UNTIL WDC
DO
BEGIN
DOMAINWD[K] = STWORD[I + K]; # SAVE WORDS #
END
END
ELSE
BEGIN
NDLEM2(ERR100,STLNUM[0],"DOMAIN");
END
END
I = I + MXSTRINGW;
TEST I;
PRID$:
PRID$USED = TRUE; # SET PRID SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN # CHECK IF VALUE IS WITHIN RANGE #
IF STVALLEN[I] LQ MXPRID
THEN # IF VALUE IS IN RANGE #
BEGIN # SAVE VALUE LEFT-JUSTIFIED ZERO FILLED #
CRNT$PRID = STVALNUM[I] * (16**(MXPRID + 2 - STVALLEN[I]));
END
ELSE # VALUE TOO LARGE #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CTEMP);
END
END
TEST I;
UDATA$:
UDATA$USED = TRUE; # SET UDATA SPECFIED FLAG #
IF NOT STVLERR[I]
THEN
BEGIN
IF TOTLEN + STVALNUM[I] LQ MXUDATA
THEN
BEGIN # STORE LENGTH #
OBUDL[CRNT$ENT + 3] = STVALNUM[I];
# STORE 10-CHAR ENTRIES #
IF OBUDL[CRNT$ENT + 3] GR 0 # IF NOT NONE SPECIFIED #
THEN
BEGIN
UDATAW = (OBUDL[CRNT$ENT + 3]*4 + 56)/60; # WORD COUNT #
FOR J = 0 STEP 1 WHILE J LQ UDATAW - 1
DO
BEGIN
CRNT$UWRD[J] = STWORD[I + J + 1]; #AVAIL SPACE POINTER#
END
END
END
ELSE
BEGIN
CTEMP = " ";
NDLEM2(ERR100,STLNUM[0],CTEMP); # VALUE OUT OF RANGE #
END
END
I = I + MAXUDATW;
TEST I;
NEXT$PRM:
END
IF NOT NAM1$USED # IF NAME1 NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"NAME1");
END
IF NOT NAM2$USED # IF NAME2 NOT SPECIFIED #
THEN
BEGIN
IF NOT PID$USED # IF PID NOT SPECIFIED TOO #
THEN
BEGIN
NDLEM2(ERR165,STLNUM[0]," "); # EITHER NAME2 OR PID REQUIRED#
END
ELSE
BEGIN
PIDPR; # CALL THE ROUTINE TO PROCESS #
END # PID #
END
ELSE # NAME2 USED #
BEGIN
IF PID$USED # IF PID SPECIFIED TOO #
THEN
BEGIN
NDLEM2(ERR164,STLNUM[0]," "); # GENERATE ERROR MESSAGE #
END
END
IF NOT ACCL$USED # IF ACCLEV NOT SPECIFIED #
THEN
BEGIN # PUT ACCLEV DEFAULT IN ENTRY #
OBACC[CRNT$ENT + 3] = ACCL$DEF;
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN # PUT DBL DEFAULT IN ENTRY #
OBDBL[CRNT$ENT + 2] = DBL$DEF;
END
IF NOT ABL$USED # IF ABL NOT SPECIFIED #
THEN
BEGIN # PUT ABL DEFAULT IN ENTRY #
OBABL[CRNT$ENT + 2] = ABL$DEF;
END
IF NOT DBZ$USED # IF DBZ NOT SPECIFIED #
THEN
BEGIN # PUT DBZ DEFAULT IN ENTRY #
OBDBZ[CRNT$ENT + 2] = DBZ$DEF;
END
IF NOT UBL$USED # IF UBL WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
OBUBL[CRNT$ENT + 2] = UBL$DEF;
END
IF NOT UBZ$USED # IF UBZ WAS NOT SPECIFIED #
THEN
BEGIN # PUT DEFAULT VALUE IN ENTRY #
OBUBZ[CRNT$ENT + 2] = UBZ$DEF;
END
IF NOT WS$USED
THEN # IF -WS- WAS NOT SPECIFIED #
BEGIN
OBWS[CRNT$ENT + 3] = W$DEF; # PUT DEFAULT VALUE IN ENTRY #
END
IF CRNT$DOSS NQ DOSS"DONOSVE" # IF DESTINATION OS ISNOT NOSVE #
AND
CRNT$DOSS NQ DOSS"DOFOREIGN"
THEN
BEGIN
SERVICE$USED = FALSE; # IGNORE SERVICE AND DOMAIN #
DOMAIN$USED = FALSE;
END
IF NOT DPLS$USED
THEN # IF DPLS WAS NOT SPECIFIED #
BEGIN
OBDPLS[CRNT$ENT + 3] = DPL$DEF; # PUT DEFAULT VALUE IN ENTRY #
END
IF NOT SERVICE$USED AND DOMAIN$USED
THEN # IF DOMAIN SPECIFIED THEN SERVICE #
BEGIN # MUST BE SPECIFIED #
NDLEM2(ERR170,STLNUM[0]," ");
END
IF SERVICE$USED # IF SERVICE USED #
THEN
BEGIN
IF DHST$USED # IF DHOST USED #
THEN
BEGIN
NDLEM2(ERR171,STLNUM[0]," "); # DHOST IS INVALID #
END
END
IF NOT DHST$USED # IF DHOST NOT USED #
THEN
BEGIN
IF NOT UDATA$USED # IF UDATA NOT PRESENT #
THEN
BEGIN
IF CRNT$DOSS EQ DOSS"DONOS" # ORIGINATING OS IS NOS #
THEN
BEGIN
IF CRNT$ORNET EQ ORNETWORK"OCDCNET" OR
CRNT$DENET EQ DESNETWORK"DCDCNET"
THEN
BEGIN
NDLEM2(ERR169,STLNUM[0]," ");
END
END
END
END
IF NOT PRID$USED
THEN
BEGIN
IF CRNT$DOSS EQ DOSS"DONOSVE"
THEN
BEGIN
CRNT$PRID = PRID$NVE;
END
ELSE
BEGIN
IF CRNT$DOSS EQ DOSS"DOAOSVS"
THEN
BEGIN
CRNT$PRID = PRID$AOS;
END
END
END
IF NOT DHST$USED
THEN # IF DHOST WAS NOT SPECIFIED #
BEGIN # CONVERT DNODE TO DISPLAY CODE #
CTEMP = XCHD(OBDNODE[CRNT$ENT + 3]);
DC$ZFILL(CTEMP); # DISPLAY CODE ZERO FILL VALUE #
CRNT$DHST = C<8,2>CTEMP; # SAVE DEFAULT DHOST VALUE #
DHST$LEN = 2; # SAVE LENGTH OF VALUE #
END
IF FAC$LENG GR MXFACL
THEN # IF TOTAL FAC LENGTH IS TOO BIG #
BEGIN # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT #
NDLEM2(ERR153,STLNUM[0]," ");
END
# INSERT PRID AND UDATA VALUE INTO ENTRY #
OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBPRID[NEXT$WORD] = CRNT$PRID; # INSERT PRID VALUE #
IF NOT UDATA$USED AND NOT SERVICE$USED AND NOT DOMAIN$USED
THEN # NO UDATA AND NO SERVICE SPECIFIED #
BEGIN
IF CRNT$DENET EQ DESNETWORK"DAOSVS"
THEN # CYBER 120 DEFAULTS #
BEGIN
OBUDL[CRNT$ENT + 3] = NAME1LEN; # LENGTH OF NAME1 #
UDATA$DEF = OBNAME1[CRNT$ENT + 1];
END # END OF CYBER 120 DEFAULTS #
ELSE
BEGIN # REGULAR DEFAULTS #
OBUDL[CRNT$ENT+3] = (UDL$DEF + DHST$LEN)*2;
# STORE DEFUALT UDL LENGTH #
CTEMP = XCDD(OBSNODE[CRNT$ENT+3]); # CONVERT SNODE VALUE #
DC$ZFILL(CTEMP); # ZERO FILL VALUE #
UDATA$DEF = C<7,3>CTEMP; # PUT SNODE VALUE IN UDATA #
C<3,DHST$LEN>UDATA$DEF = CRNT$DHST; # PUT DHOST VALUE IN UDA#
I = 3 + DHST$LEN; # CALCULATE CURRENT CHARACTER COUNT #
C<I,7>UDATA$DEF = OBNAME1[CRNT$ENT + 1]; # PUT NAME1 IN UDAT#
END # END OF REGULAR DEFAULTS #
ITEMP = 32; # POINT TO BEGINNING OF UDATA FIELD #
SAVE$WORD = NEXT$WORD; # SAVE NEXT$WORD TO POINT TO THE #
# START OF UDATA #
FOR I=0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
DO # FOR EACH CHARACTER IN UDATA VALUE #
BEGIN
IF ITEMP LS 56
THEN # IF STILL ROOM TO PUT A CHARACTER #
BEGIN # CONVERT TO ASCII AND PUT IN ENTRY #
B<ITEMP,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF];
ITEMP = ITEMP + 8; # POINT TO NEXT POSITION #
END
ELSE # WHOLE CHARATER CAN NOT FIT #
BEGIN
IF ITEMP EQ 56
THEN # IF HALF A CHARACTER CAN FIT #
BEGIN # PUT FIRST HALF IN CURRENT WORD #
B<ITEMP,4>OBUDATA[NEXT$WORD]=B<0,4>A$CHAR[C<I,1>UDATA$DEF];
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
ITEMP = 4; # POINT TO NEXT POSITION #
B<0,4>OBUDATA[NEXT$WORD] = B<4,4>A$CHAR[C<I,1>UDATA$DEF];
END
ELSE # NO MORE ROOM IN CURRENT WORD #
BEGIN
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD COUNT#
ITEMP = 8; # POINT TO NEXT POSITION #
B<0,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF];
END
END
END # END OF FOR LOOP #
IF CRNT$DENET EQ DESNETWORK"DAOSVS"
THEN
BEGIN
OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3]*2;
END
IF SHST$USED # IF SHOST SPECIFIED #
THEN
BEGIN
IF CRNT$DENET NQ DESNETWORK"DAOSVS"
THEN # FOR NON-CYVBER 120 MACHINES #
BEGIN
B<UDL$BIT,SHST$LEN>OBUDATA[SAVE$WORD] = CRNT$SHST;
END
# OVERWRITE THE EARLIER ASCII TRANS #
END
END # END OF NOT UDATA$USED #
ELSE
BEGIN # UDATA OR SERVICE OR DOMAIN SPECIFI#
ITEMP = 32;
CRUBIT = 0; # SET START BIT FOR UDATA #
IF SERVICELEN[0] GR 0 # SERVICE SPECIFIED #
THEN
BEGIN
I = 1;
IF NOT DOMAIN$USED
THEN
BEGIN
IF UDATA$USED
THEN
BEGIN # ADD 2 *US* #
SERVICELEN1[0] = 1;
END
END
FOR J = 0 STEP 1 UNTIL SERVICELEN[0] + SERVICELEN1[0]
DO
BEGIN
IF J GQ SERVICELEN[0] # CHECK IF *US* NEEDED #
THEN
BEGIN
IF DOMAIN$USED OR UDATA$USED # IF FOLLOWED BY DOMAIN #
THEN
BEGIN
ASCII$CHAR[0] = UNITSEP; # ADD 1 *US* FOR DOMAIN #
# AND UDATA BOTH USED #
# ADD 2 *US* FOR DOMAIN NOT USED #
# AND UDATA USED #
TOTLEN = TOTLEN + 1; # BUMP TOKLEN #
SETCHAR = TRUE; # SET SETCHAR FLAG #
END
ELSE
BEGIN
SETCHAR = FALSE; # NOT TO STORE CHAR IN OBUDATA #
END
END
ELSE
BEGIN
SETCHAR = TRUE;
WDC = B<CRUBIT,6>SERVICEWD[I]; # PACK IT IN ASCII #
ASCII$CHAR[0] = A$CHAR[WDC];
END
IF SETCHAR # O.K. TO STORE CHAR IN OBUDATA #
THEN
BEGIN
IF ITEMP LS 56
THEN # IF STILL ROOM TO PUT A CHARACTER #
BEGIN # CONVERT TO ASCII AND PUT IN ENTRY #
B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0];
ITEMP = ITEMP + 8; # POINT TO NEXT POSITION #
END
ELSE # WHOLE CHARATER CAN NOT FIT #
BEGIN
IF ITEMP EQ 56
THEN # IF HALF A CHARACTER CAN FIT #
BEGIN # PUT FIRST HALF IN CURRENT WORD #
B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
ITEMP = 4; # POINT TO NEXT POSITION #
B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
END
ELSE # NO MORE ROOM IN CURRENT WORD #
BEGIN
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
ITEMP = 8; # POINT TO NEXT POSITION #
B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0];
END
END
END # END OF SETCHAR #
CRUBIT = CRUBIT + 6; # BUMP BIT INDEX #
IF CRUBIT EQ WORDSIZE # WORD BOUNDARY REACHED #
THEN
BEGIN
CRUBIT = 0; # CLEAR BIT INDEX #
I = I + 1; # BUMP WORD INDEX FOR SERVICEWD #
END
END # END OF FOR #
END # END OF SERCIELEN GR 0 #
IF DOMAINLEN[0] GR 0 # DOMAIN SPECIFIED #
THEN
BEGIN
I = 1;
CRUBIT = 0;
FOR J = 0 STEP 1 UNTIL DOMAINLEN[0] # INCLUDES *US* #
DO
BEGIN
IF J EQ DOMAINLEN[0] # US NEEDED? #
THEN
BEGIN
IF UDATA$USED # IF FOLLOWED BY UDATA #
THEN
BEGIN
ASCII$CHAR[0] = UNITSEP;
TOTLEN = TOTLEN + 1; # BUMP TOKLEN #
SETCHAR = TRUE; # SET SETCHAR FLAG #
END
ELSE
BEGIN
SETCHAR = FALSE;
END
END
ELSE
BEGIN
WDC = B<CRUBIT,6>DOMAINWD[I]; # PACK IT IN ASCII #
ASCII$CHAR[0] = A$CHAR[WDC];
SETCHAR = TRUE; # GO AND STORE CHAR IN OBUDATA #
END
IF SETCHAR # O.K. TO STORE CHAR IN OBUDATA #
THEN
BEGIN
IF ITEMP LS 56
THEN # IF STILL ROOM TO PUT A CHARACTER #
BEGIN # CONVERT TO ASCII AND PUT IN ENTRY #
B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0];
ITEMP = ITEMP + 8; # POINT TO NEXT POSITION #
END
ELSE # WHOLE CHARATER CAN NOT FIT #
BEGIN
IF ITEMP EQ 56
THEN # IF HALF A CHARACTER CAN FIT #
BEGIN # PUT FIRST HALF IN CURRENT WORD #
B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
ITEMP = 4; # POINT TO NEXT POSITION #
B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
END
ELSE # NO MORE ROOM IN CURRENT WORD #
BEGIN
NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD #
OBWORD[NEXT$WORD] = 0; # CLEAR NEXT WORD #
OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
ITEMP = 8; # POINT TO NEXT POSITION #
B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0];
END
END
END # END OF SETCHAR #
CRUBIT = CRUBIT + 6; # BUMP BIT INDEX #
IF CRUBIT EQ WORDSIZE # WORD BOUNDARY REACHED #
THEN
BEGIN
CRUBIT = 0; # CLEAR BIT INDEX #
I = I + 1; # BUMP WORD INDEX FOR SERVICEWD #
END
END # END OF FOR #
END # END OF DOMAIN GR 0 #
IF OBUDL[CRNT$ENT + 3] GR 0 # UDATA SPECIFIED #
THEN
BEGIN
IF ITEMP EQ WORDSIZE # WORD BOUNDARY REACHED #
THEN
BEGIN
ITEMP = 0;
NEXT$WORD = NEXT$WORD + 1;
OBWORD[NEXT$WORD] = 0;
OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
END
I = 0;
CRUBIT = 0;
FOR J = 0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
DO
BEGIN
B<ITEMP,4>OBUDATA[NEXT$WORD] = B<CRUBIT,4>CRNT$UWRD[I];
ITEMP = ITEMP + 4; # BUNP ITEMP #
IF ITEMP EQ WORDSIZE # WORD BOUNDARY REACHED #
THEN
BEGIN
IF J NQ OBUDL[CRNT$ENT + 3] # NOT DONE YET #
THEN
BEGIN
ITEMP = 0;
NEXT$WORD = NEXT$WORD + 1;
OBWORD[NEXT$WORD] = 0;
OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
END
END
CRUBIT = CRUBIT + 4; # BUMP BIT INDEX #
IF CRUBIT EQ WORDSIZE # WORD BOUNDARY REACHED #
THEN
BEGIN
CRUBIT = 0; # CLEAR BIT INDEX #
I = I + 1; # BUMP WORD INDEX FOR SERVICEWD #
END
END # END OF FOR #
END # END OF UDL GR 0 #
OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3] + TOTLEN*2;
# FINALLY UPDATES OBUDL #
END # END OF UDATA/DOMAIN/SERCVICE USED #
OBRWC[1] = OBRWC[1] + OBWC[CRNT$ENT]; # INCR TABLE WORD COUNT #
RETURN; # **** RETURN **** #
END # OUTCLPR #
CONTROL EJECT;
PROC PIDPR;
BEGIN
*IF,DEF,IMS
#
**
* 1. PROC NAME AUTHOR DATE
* PIDPR Y. C. YIP 06/24/1983
*
* 2. FUNCTIONAL DESCRIPTION.
*
* THIS PROCEDURE PERFORMS ENTERING PATH INFORMATION INTO
* THE PATH PID TABLE IN THE FORM OF PID NAME, DNODE, SNODE,
* PORT NUMBER, DTEA LENGTH AND DTE ADDRESS.
*
*
* 3. METHOD USED.
*
* TABLE MANAGER ROUTINE SSTESTS IS CALLED TO EXPAND TABLE
* SPACE WHEN NEEDED.
*
* FIRST, EMPTY TABLE IS CHECKED BY CHECKING THE WORD COUNT.
* IF NOT EMPTY TABLE
* THEN
* SEARCH FOR IDENTICAL PID BY CHECKING PIDNAME IN TABLE
* AGAINST CRNT$PID.
* IF IDENTICAL PID FOUND
* THEN
* CHECK FOR IDENTICAL SET OF SNODE,DNODE, PORT, AND
* AND DTEA.
*
* IF IDENTICL SET FOUND
* THEN
* EXIT
* ELSE
* MAKE ENTRY OF SNODE,DNODE,PORT, DTEAL AND DTEA.
* ELSE
* MAKE ENTRY WITH NEW PID AND A SET OF SNODE,DNODE,PORT
* DTEAL, AND DTEA INFORMATION.
* ELSE
* MAKE THE FIRST PATH PID ENTRY TO THE EMPTY TABLE.
*
*
*
*
* 3. ENTRY - NONE.
*
* 4. EXIT - NONE.
*
* 5. ROUTINE CALLED - SSTETS.
*
#
*ENDIF
#
**** PROC PIDPR - XREF LIST BEGINS
#
XREF
BEGIN
PROC NDLEM2; # PASS2 ERROR MESSAGE GENERATOR #
PROC SSTETS; # TABLE MANAGER ROUTINE TO EXTEND #
# TABLE ENTRY. #
END
DEF ENTY1 # 1 #; # ONE WORD ENTRY #
DEF ENTY2 # 2 #; # TWO WORD ENTRY #
DEF ENTY3 # 3 #; # THREE WORD ENTRY #
ITEM INDEX1; # LOOP INDEX ONE #
ITEM INDEX2; # LOOP INDEX TWO #
ITEM FOUND B; # FLAG FOR FINDING A MATCHING PID #
ITEM CRNT$PID$ENT; # POINTER TO THE CURRENT PID ENTRY #
ITEM LOOPC; # COUNTER FOR NUMBER OF PIDS #
ITEM NEW$ENT; # POINTER TO NERW TABLE ENTRY #
CONTROL EJECT;
# #
# CODE OF PIDPR BEGINS HERE #
# #
LOOPC = 1; # COUNT OF PIDS SET TO 1 #
FOUND = FALSE; # INITIALIZE PID EXIST FLAG TO FALSE#
IF PICNT[1] EQ 0 # EMPTY TABLE #
THEN # NEW ENTRY NEEDED #
BEGIN
NEW$ENT = ENTY2; # POINTER TO TABLE ENTRY #
END
ELSE
BEGIN
CRNT$PID$ENT = ENTY2; # POINTER TO CURRENT TABLE ENTRY #
FOR INDEX1 = 1 STEP 1 WHILE ( NOT FOUND AND PICNT[1] GQ
LOOPC)
DO # SCAN UNTIL MATCHING PID FOUND OR #
BEGIN # TABLE IS EXHAUSTED #
IF PINAME[CRNT$PID$ENT] EQ CRNT$PID
THEN
BEGIN
FOR INDEX2 = 1 STEP 2 UNTIL (PILLCT[CRNT$PID$ENT]*2)
DO # SCAN LOGICAL LINK RECORD #
BEGIN
IF PIDN[CRNT$PID$ENT + INDEX2] EQ PP$DNODE
AND PISN[CRNT$PID$ENT + INDEX2] EQ PP$SNODE
AND PIPORT[CRNT$PID$ENT + INDEX2] EQ PP$PORT
AND PIDTEA[CRNT$PID$ENT + INDEX2 + 1] EQ PP$DTEA
THEN # DUPLIACTE LOGICAL LINK DEFINITION #
BEGIN
FOUND = TRUE; # SET FOUND FLAG #
END
END # END OF FOR #
IF NOT FOUND # NO DUPLICATE LINK FOUND #
THEN
BEGIN
FOUND = TRUE; # CLEAR FLAG #
NEW$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1;
# NEW ENTRY MADE #
SSTETS
(P<PATHPID
$TAB>
,NEW
$ENT
,2); # MAKE EXTRA # # ENTRY #
PILLCT[CRNT$PID$ENT] = PILLCT[CRNT$PID$ENT] + 1;
# BUMP LOGICAL LINK COUNT #
PIRWC[ENTY1] = PIRWC[ENTY1] + 2; # BUMP WORD COUNT #
PIDN[NEW$ENT] = PP$DNODE; # UPDATE DNODE FIELD #
PISN[NEW$ENT] = PP$SNODE; # UPDATE SNDOE FIELD #
PIPORT[NEW$ENT] = PP$PORT; # UPDATE PORT FIELD #
PIDTEAL[NEW$ENT] = PP$DTEAL; # UPDATE DTEA LENGTH #
NEW$ENT = NEW$ENT + 1;
PIDTEA[NEW$ENT] = PP$DTEA; # UPDATE DTEA FIELD #
END
END
CRNT$PID$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1;
LOOPC = LOOPC + 1; # CHECK THE NEXT PID RECORD #
END
NEW$ENT = CRNT$PID$ENT; # MAKE NEW PID RECORD #
END
IF NOT FOUND # IF NO MATCHING PIDNAME FOUND #
THEN
BEGIN # NEW PID RECORD NEEDED #
SSTETS
(P<PATHPID
$TAB>
,NEW
$ENT
,ENTY3
); # EXPAND ENTRY # PICNT[ENTY1] = PICNT[ENTY1] + 1; # BUMP PID COUNT #
PIRWC[ENTY1] = PIRWC[ENTY1] + ENTY3; # BUMP WORD COUNT #
PINAME[NEW$ENT] = CRNT$PID; # UPDATE PID NAME #
PILLCT[NEW$ENT] = 1; # UPDATE LINK COUNT FIELD #
NEW$ENT = NEW$ENT + 1;
PIDN[NEW$ENT] = PP$DNODE; # UPDATE PIDN FIELD #
PISN[NEW$ENT] = PP$SNODE; # UPDATE PISN FIELD #
PIPORT[NEW$ENT] = PP$PORT; # UPDATE PIPORT FIELD #
PIDTEAL[NEW$ENT] = PP$DTEAL; # UPDATE DTEA LENGTH #
NEW$ENT = NEW$ENT + 1;
PIDTEA[NEW$ENT] = PP$DTEA; # UPDATE DTEA FIELD #
END
RETURN; # RETURN TO CALLER #
END # END OF PROC PIDPR #
CONTROL EJECT;
PROC USERPR;
BEGIN
*IF,DEF,IMS
#
** USERPR - USER STATEMENT PROC
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE CHECKS THE USER STATEMENTS AND MAKES ENTRIES IN
* THE USER TABLE.
*
* PROC USERPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INCREMENT USER TABLE WORD COUNT.
* CLEAR NEXT ENTRY IN USER TABLE.
* IF LABEL IS O.K.,
* PUT LABEL IN ENTRY.
* FOR EACH VALUE DECLARATION
* SELECT CASE THAT APPLIES,
* CASE 1(MFAM,DFAM,PFAM):
* IF VALUE IS NOT -NONE-,
* IF A FAMILY HAS NOT BEEN SPECIFIED YET,
* THEN,
* IF VALUE IS O.K.,
* IF VALUE IS NOT ZERO,
* ZERO FILL VALUE.
* PUT FAMILY NAME IN ENTRY.
* SET CODE FOR FAMILY.
* OTHERWISE,
* FLAG ERROR -- CAN NOT SPECIFY BOTH DFAM,MFAM OR PFAM.
* CASE 2(MUSER,DUSER,PUSER):
* IF VALUE IS NOT -NONE-,
* IF A USER NUMBER HAS NOT BEEN SPECIFIED YET,
* THEN,
* IF VALUE IS O.K.,
* IF VALUE IS NOT ZERO,
* THEN,
* ZERO FILL NAME.
* PUT USER NUMBER IN ENTRY.
* SET CODE FOR USER NUMBER.
* OTHERWISE,
* FLAG ERROR -- USER CAN NOT BE ZERO.
* OTHERWISE,
* FLAG ERROR -- CAN NOT SPECIFY BOTH MUSER, DUSER OR PUSER
* CASE 3(MAPPL,PAPPL):
* IF VALUE IS NOT -NONE-,
* IF AN APPLICATION HAS NOT BEEN SPECIFIED YET,
* THEN
* IF VALUE IS O.K.,
* SEARCH TABLE FOR ILLEGAL APPLICATION.
* IF NOT FOUND,
* THEN,
* PUT APPLICATION NAME IN ENTRY
* SET CODE FOR APPLICATION.
* OTHERWISE,
* FLAG ERROR -- NAME IS A RESERVE WORD
* OTHERWISE,
* FLAG ERROR -- CAN NOT SPECIFY BOTH MAPPL AND PAPPL
*
#
*ENDIF
#
**** PROC USERPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC SSTATS; # ALLOCATES MORE TABLE SPACE ON REQUEST #
FUNC XCDD C(10); # CONVERTS INTEGER TO CHARACTER #
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
PROC NDLZFIL; # ZERO FILLS A BLANK FILLED NAME #
END
#
****
#
DEF MFAM$ID # 136 #; # MFAM KEYWORD I.D. #
DEF USR$M$ST # 262143 #; # MAX NUM OF USER STMTS USED #
DEF PAPPL$ID # 144 #; # PAPPL KEYWORD I.D. #
STATUS CODE UNK, # NOT SPECIFIED #
MAND, # MANDITORY #
DEF, # DEFAULT #
PRIM; # PRIMARY #
ITEM APL$FLG B; # INITIAL APPLICATION SPECIFIED FLAG #
ITEM CRNT$ENT; # POINTS AT CURRENT ENTRY IN USER TABLE #
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM FAM$FLG B; # FAMILY SPECIFIED FLAG #
ITEM FOUND B; # FOUND FLAG #
ITEM I; # SCRATCH ITEM #
ITEM J; # SCRATCH ITEM #
ITEM USR$FLG B; # USER NUMBER SPECIFIED FLAG #
ARRAY CODE$TABLE [MFAM$ID:PAPPL$ID] S(1);
BEGIN
ITEM VAL$CODE (0,0,60) = [CODE"MAND",
CODE"MAND",
CODE"MAND",
CODE"DEF",
CODE"DEF",
CODE"PRIM",
CODE"PRIM",
,
CODE"PRIM"
];
END
DEF MXRWT # 10 #;
ARRAY RES$WORD$TAB [1:MXRWT] S(1);
BEGIN
ITEM VALNAM C(0,0,10) = ["NS",
"NVF",
"ALL",
"NULL",
"BYE",
"LOGIN",
"LOGOUT",
"HELLO",
"NOP",
"DOP"
];
END
SWITCH USERJMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
, , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, , # AUTO , SL ,#
, , # LSPEED , DFL ,#
, , # FRAME , RTIME ,#
, , # RCOUNT , NSVC ,#
, , # PSN , DCE ,#
, , # DTEA , ,#
, , # , ,#
, , # , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, , # NEN , ,#
, , # , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PRI ,#
, , # P80 , P81 ,#
, , # P82 , P83 ,#
, , # P84 , P85 ,#
, , # P86 , P87 ,#
, , # P88 , P89 ,#
, , # AL , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, , # PW , SE ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
FAMILY , USER$NUM , # MFAM , MUSER ,#
APPLICATION , FAMILY , # MAPPL , DFAM ,#
USER$NUM , FAMILY , # DUSER , PFAM ,#
USER$NUM , , # PUSER , ,#
APPLICATION , , # PAPPL , ,#
, , # , ,#
, , # UID ,PRIV ,#
, , # KDSP , ,#
, , # NAME1 , NAME2 ,#
, , # SNODE , DNODE ,#
, , # ACCLEV , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # , ,#
, ; # FAM , UNAME #
CONTROL EJECT;
# #
# USERPR CODE BEGINS HERE #
# #
IF USR$M$FLAG # IF MAXIMUM USR FLAG REACHED #
THEN
BEGIN
RETURN; # SKIP THE ENTRY #
END
FAM$FLG = FALSE; # CLEAR FAMILY SPECIFIED FLAG #
USR$FLG = FALSE; # CLEAR USER NUMBER SPECIFIED FLAG #
APL$FLG = FALSE; # CLEAR INITIAL APPL SPECIFIED FLAG #
IF UTWC[1] GQ USR$M$ST
THEN
BEGIN # IF MAXIMUM ENTRY ALREADY REACHED #
USR$M$FLAG = TRUE; # SET WARNING FLAG TO TRUE #
NDLEM2(ERR159,STLNUM[0],XCDD(USR$M$ST)); # GENERATE WARNING #
RETURN; # SKIP ENTRY #
END
CRNT$ENT = UTWC[1] + 1; # POINT TO NEXT ENTRY POSITION #
UTWC[1] = UTWC[1] + UTENTSZ; # INCREMENT TABLE WORD COUNT #
IF UTWC[1] GQ UT$LENG-1 # IF MORE SPACE IS NEED #
THEN
BEGIN
SSTATS(P<USER$TABLE>,UTENTSZ); # ALLOC ROOM FOR ONE MORE ENTRY#
END
FOR I=CRNT$ENT STEP 1 UNTIL (CRNT$ENT + UTENTSZ) - 1
DO
BEGIN
UTWORD[I] = 0; # CLEAR THE CURRENT ENTRY #
END
IF NOT STLBERR[1] # IF NO LABEL ERRORS #
THEN
BEGIN
UTNAME[CRNT$ENT] = STLABEL[1]; # PUT USER NAME IN ENTRY #
END
FOR I=2 STEP 1 UNTIL STWC[0] # FOR EACH VALUE DECLARATION #
DO
BEGIN
GOTO USERJMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
FAMILY:
IF STVALNAM[I] NQ "NONE" # IF VALUE IS NOT -NONE- #
THEN
BEGIN
IF NOT FAM$FLG # IF FAMILY NOT SPECIFIED #
THEN
BEGIN
FAM$FLG = TRUE; # SET FAMILY SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] NQ "0" # IF VALUE IS NOT ZERO #
THEN
BEGIN # ENTER FAMILY VALUE #
CTEMP = STVALNAM[I];
NDLZFIL(CTEMP); # ZERO FILL NAME #
UTFAM[CRNT$ENT + 1] = CTEMP;
END # ENTER CODE FOR FAMILY #
UTCODE[CRNT$ENT + 1] = VAL$CODE[STKWID[I]];
END
END
ELSE # FAMILY PREVIOUSLY SPECIFIED #
BEGIN # FLAG ERROR -- BOTH MFAM AND DFAM SPEC #
NDLEM2(ERR144,STLNUM[0]," ");
END
END
TEST I; # GET NEXT ENTRY #
USER$NUM:
IF STVALNAM[I] NQ "NONE" # IF VALUE IS NOT -NONE- #
THEN
BEGIN
IF NOT USR$FLG # IF USER NUM NOT SPECIFIED #
THEN
BEGIN
USR$FLG = TRUE; # SET USER NUM SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] NQ "0" # IF VALUE IS NOT ZERO #
THEN
BEGIN # PUT UN AND CODE IN ENTRY #
CTEMP = STVALNAM[I];
NDLZFIL(CTEMP); # ZERO FILL NAME #
UTUSER[CRNT$ENT + 2] = CTEMP;
UTCODE[CRNT$ENT + 2] = VAL$CODE[STKWID[I]];
END
ELSE # VALUE IS ZERO #
BEGIN # FLAG ERROR -- VALUE CAN NOT BE ZERO #
NDLEM2(ERR145,STLNUM[0]," ");
END
END
END
ELSE # USER NUM ALREADY SPECIFIED #
BEGIN # FLAG ERROR -- CANNOT USE BOTH MUSER AND #
NDLEM2(ERR146,STLNUM[0]," "); # DUSER #
END
END
TEST I; # GOTO NEXT ENTRY #
APPLICATION:
IF STVALNAM[I] NQ "NONE" # IF VALUE IS NOT -NONE- #
THEN
BEGIN
IF NOT APL$FLG # IF APPL NOT SPECIFIED #
THEN
BEGIN
APL$FLG = TRUE; # SET APPL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
FOUND = FALSE; # CLEAR FOUND FLAG #
FOR J=1 STEP 1 UNTIL MXRWT
DO # SEARCH RESERVE WORD TABLE FOR #
BEGIN # VALUE #
IF STVALNAM[I] EQ VALNAM[J]
THEN # IF VALUE FOUND IN TABLE #
BEGIN
FOUND = TRUE; # SET FOUND FLAG #
END
END
IF NOT FOUND # IF VALUE IS NOT RESERVED WORD #
THEN
BEGIN # PUT NAME AND CODE IN ENTRY #
UTAPPL[CRNT$ENT + 3] = STVALNAM[I];
UTCODE[CRNT$ENT + 3] = VAL$CODE[STKWID[I]];
END
ELSE # NAME IS A RESERVE WORD #
BEGIN # FLAG ERROR -- CANNOT BE RESERVED APPL #
NDLEM2(ERR147,STLNUM[0],STVALNAM[I]);
END
END
END
ELSE # APPL ALREADY SPECIFIED #
BEGIN # FLAG ERROR -- CANNOT SPEC BOTH MAPPL AND#
NDLEM2(ERR148,STLNUM[0]," "); # PAPPL #
END
END
TEST I; # GOTO NEXT ENTRY #
END
RETURN; # **** RETURN **** #
END # USERPR #
CONTROL EJECT;
PROC WR$LCF(TABLE,WSA,LENGTH);
BEGIN
*IF,DEF,IMS
#
** WR$LCF - WRITE TABLE TO LCF.
*
* D.K. ENDO 81/10/30
*
* THIS PROCEDURE WRITES A GIVEN TABLE TO THE LCF.
*
* PROC WR$LCF(TABLE,WSA,LENGTH)
*
* ENTRY TABLE = SWITCH I.D. FOR TABLE.
* WSA = FIRST WORD ADDRESS OF TABLE.
* LENGTH = LENGTH OF TABLE.
*
* EXIT NONE.
*
* METHOD
*
* POINT FET TO TABLE
* SELECT CASE THAT APPLIES:
* CASE 1(HEADER RECORD,APPL,USER,OUTCALL,INCALL TABLES):
* WRITE TABLE TO LCF.
* WRITE EOR TO LCF
* CASE 2(VERIFICATION RECORD):
* WRITE RECORD TO LCF.
* WRITE EOR TO LCF.
* WRITE EOF TO LCF.
*
#
*ENDIF
ITEM TABLE; # SWITCH I.D. FOR TABLE #
ITEM WSA; # FIRST WORD ADDRESS OF TABLE #
ITEM LENGTH; # LENGTH OF TABLE #
#
**** PROC WR$LCF - XREF LIST BEGINS.
#
XREF
BEGIN
PROC RECALL; # RETURNS CONTROL WHEN RECALL BIT CLEARED #
PROC WRITEF; # FLUSH CIO BUFFER AND PUT EOF #
PROC WRITER; # FLUSH CIO BUFFER AND PUT EOR #
END
#
****
#
SWITCH WLCFJMP W$EOR, # FILE HEADER #
W$EOR, # APPL TABLE #
W$EOR, # USER TABLE #
W$EOR, # OUTCALL TABLE #
W$EOR, # INCALL TABLE #
W$EOR, # PATH PID TABLEORD #
W$EOF; # VALIDATION RECORD #
# #
# WR$LCF CODE BEGINS HERE #
# #
LCFFIRST[0] = WSA; # POINT FET TO TABLE #
LCFOUT[0] = WSA;
LCFIN[0] = WSA + LENGTH;
LCFLIMIT[0] = LCFIN[0] + 1;
# #
GOTO WLCFJMP[TABLE];
W$EOR:
WRITER(LCFFET); # WRITE TABLE WITH EOR #
RECALL(LCFFET);
GOTO LCF$NEXT;
W$EOF:
WRITEF(LCFFET); # WRITE TABLE WITH EOF #
RECALL(LCFFET);
GOTO LCF$NEXT;
LCF$NEXT:
RETURN; # **** RETURN **** #
END # WR$LCF #
CONTROL EJECT;
# #
# NDLP2LF CODE BEGINS HERE #
# #
# ALLOCATE SPACE FOR LCF CREATION #
SSTATS(P<USER$TABLE>,MXUTAB);
SSTATS
(P<APPL
$TABLE>
,MXATAB
); SSTATS(P<OUTCALL$TABL>,MXOTAB);
SSTATS(P<INCALL$TABLE>,MXITAB);
SSTATS
(P<PATHPID
$TAB>
,MXPPTAB
); UTWORD[0] = 0; # INITIALIZE USER TABLE #
UT$IDENT[0] = "USER";
USR$M$FLAG = FALSE; # MAXIMUM USER STATEMENTS FLAG #
UTWORD[1] = 0;
UTWC[1] = 1;
ATWORD[0] = 0; # INITIALIZE APPL TABLE #
AT$IDENT[0] = "APPL";
ATWORD[1] = 0;
ATWC[1] = 1;
OBWORD[0] = 0; # INITIALIZE OUTCALL TABLE #
OB$IDENT[0] = "OUTCALL";
OBWORD[1] = 0;
OBWC[1] = 1;
IBWORD[0] = 0; # INITIALIZE INCALL TABLE #
IB$IDENT[0] = "INCALL";
IBWORD[1] = 0;
IBWC[1] = 1;
PPWORD[0] = 0; # INITIALIZE PATHPID TABLE #
PP$IDENT[0] = "PATHPID";
PPWORD[1] = 0;
PIRWC[1] = 1;
# #
REWIND(ERR2FET); # REWIND PASS 2 ERROR FILE #
RECALL(ERR2FET);
REWIND(STFET); # REWIND STATEMENT TABLE FILE #
RECALL(STFET);
READ(STFET); # READ STATEMENT TABLE INTO CIO BUFFER #
RECALL(STFET);
READW(STFET,STMT$TABLE,1,STMT$STAT); # READ HEADER OF 1ST ENTRY#
# #
FOR I=0 WHILE STMT$STAT EQ TRNS$OK
DO
BEGIN
READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT);
GOTO LCFJUMP[STSTID[0]];
LFILE$ENTRY:
LFILEPR; # CHECK LFILE ENTRY #
GOTO NEXT$STMT;
USER$ENTRY:
USERPR; # CHECK USER ENTRY #
GOTO NEXT$STMT;
APPL$ENTRY:
APPLPR; # CHECK APPL ENTRY #
GOTO NEXT$STMT;
OUTCALL$ENT:
OUTCLPR; # CHECK OUTCALL ENTRY #
GOTO NEXT$STMT;
INCALL$ENT:
INCALPR; # CHECK INCALL ENTRY #
GOTO NEXT$STMT;
NEXT$STMT: # READ NEXT STATEMENT ENTRY HEADER #
READW(STFET,STMT$TABLE,1,STMT$STAT);
END
LCFTERM; # EXECUTE TERMINATION PROCESSING #
RETURN; # **** RETURN **** #
END # NDLP2LF #
TERM