*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,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 CWORD EQ " " THEN # IF CHARACTER IS A BLANK # BEGIN CWORD = 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,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 # BIBRANAME[CRNT$ENT+1] = A$CHAR[CSTVALNAM[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 BIBWORD[CRNT$ENT + 7] = CCTEMP2 - 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,-AT$LENG); # RELEASE TABLE SPACE # SSTATS(P,-UT$LENG); SSTATS(P,-OB$LENG); SSTATS(P,-IB$LENG); SSTATS(P,-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,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 # BDTEA$WORD[0] = CCTEMP2 - 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 # CUDATA$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 # BOBUDATA[NEXT$WORD] = A$CHAR[CUDATA$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 # BOBUDATA[NEXT$WORD]=B<0,4>A$CHAR[CUDATA$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[CUDATA$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[CUDATA$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 BOBUDATA[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 = BSERVICEWD[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 # BOBUDATA[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 # BOBUDATA[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 = BDOMAINWD[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 # BOBUDATA[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 # BOBUDATA[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 BOBUDATA[NEXT$WORD] = BCRNT$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,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,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,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,MXUTAB); SSTATS(P,MXATAB); SSTATS(P,MXOTAB); SSTATS(P,MXITAB); SSTATS(P,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