*DECK NDLNFCM
USETEXT NDLDATT
USETEXT NDLER2T
USETEXT NDLFETT
USETEXT NDLNCFT
USETEXT NDLPS2T
USETEXT NDLTBLT
PROC NDLNFCM;
BEGIN
*IF,DEF,IMS
#
** NDL$COM - CHECKS COMMUNICATION ELEMENT STATEMENTS
*
* D.K. ENDO 81/10/12
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROCEDURE TO CHECK A
* PARTICULAR COMMUNICATION ELEMENT STATEMENT.
*
* PROC NDL$COM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH STATEMENT TABLE
* SELECT THE CASE THAT APPLIES,
* CASE 1 (LINE STMT):
* IF A LINE RECORD EXISTS,
* WRITE LINE RECORD TO NCF.
* IF A LINE CONFIG ENTRY EXISTS,
* IF THE LINE IS AN X.25 LINE,
* PUT PVC COUNT IN LINE CONFIG ENTRY.
* WRITE ENTRY TO LINE CONFIG FILE.
* CALL PROC THAT CHECK LINE AND GROUP STATEMENTS.
* CASE 2 (TERMINAL STMT):
* CALL PROCEDURE THAT CHECKS TERMINAL STMTS.
* CASE 3 (DEVICE STMT):
* CALL PROCEDURE THAT CHECKS DEVICE STMTS.
* CASE 4 (TRUNK STMT):
* CALL PROCEDURE THAT CHECKS TRUNK STMTS.
* CASE 5 (NETWORK ELEMENT STMT OR EOF):
* IF A LINE RECORD EXISTS,
* WRITE LINE RECORD TO NCF.
* IF A LINE CONFIG ENTRY EXISTS,
* IF LINE IS AN X.25 LINE,
* PUT PVC COUNT IN LINE ENTRY.
* WRITE ENTRY TO LINE CONFIG FILE.
* EXIT NDL$COM.
*
#
*ENDIF
#
**** PROC NDLNFCM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC LFGCKSM; # CALCULATES CHECK SUM OF GIVEN TABLE #
PROC SSTATS; # ALLOCATES MORE TABLE SPACE ON REQUEST #
PROC READW; # READS GIVEN NUM OF WORD FROM FILE #
PROC NDLTRNK; # PROCESSES TRUNK STATEMENT ENTRY #
PROC NDLEM2; # PASS 2 ERROR MESSAGE. #
PROC NDLWLCR; # WRITES LINE CONFIGURE INFO TO FILE #
PROC NDLWNCF; # WRITES TABLES/RECORDS TO NCF #
END
#
****
#
DEF CON$MX$M4A # 1 #; # MAX NUMBER OC CONSOLES FOR M4A DEV #
DEF CR$MAX$M4A # 1 #; # MAXIMUM NUMBER OF CR-S FOR M4A DEVICES #
DEF DEV$MX$M4A # 3 #; # MAXIMUM NUMBER OF M4A DEVICES ALLOWED #
DEF DT7$MX$M4A # 3 #; # MAXIMUM NUMBER OF USER DT-S FOR M4A #
DEF LP$MAX$M4A # 1 #; # MAXIMUM NUMBER OF LP-S FOR M4A DEVICES #
DEF SYNAUTO # 6 #; # NUMERIC VALUE FOR SYNAUTO TIPTYPE #
DEF USR$WID1 # 255 #; # UPPER LIMIT OF FVAL ALLOWD BY A BYTE #
DEF USR$WID2 # 65535 #; # UPPER LIMIT OF FVAL ALLOWE BY TWO #
DEF MPW$2780$LP # 50 #; # MINIMUM PAGE WIDTH FOR LP OF 2780 #
DEF MXPW$2780$LP # 150 #; # MAXIMUM PAGE WIDTH FOR LP OF 2780 #
STATUS NUM ERR, # ERROR MODE FOR NUMBER #
DEC, # DECIMAL #
HEX; # HEXIDECIMAL #
# BYTES #
STATUS CSET UNKNOWN, # STATUS LIST FOR CODE SET #
BCD,
ASCII,
APLTP,
APLBP,
EBCD,
EBCDAPL,
CORRES,
CORAPL,
EBCDIC,
,,,,,
USER;
STATUS CTYP SVC, # STATUS LIST FOR CIRCUIT TYPE #
PVC,
UNKNOWN;
STATUS DT UNKNOWN, # STATUS LIST FOR DEVICE TYPE #
CON,
CR,
LP,
CP,
PL,
AP,
USER;
STATUS FN UNKNOWN , AL , # 0 #
LSPEED , RCOUNT ,
FRAME , ,
PVC , DCE ,
PSN , ,
SVC , LCN , # 10 #
RTIME , ,
DFL , PL$W ,
DTEA , IMD ,
RC , ,
HN , , # 20 #
AUTOCON , PRI ,
UBL , UBZ ,
ABL , DBL ,
DBZ$MSB , DBZ$LSB ,
XBZ$MSB , XBZ$LSB , # 30 #
LK , ,
TC , PW ,
PL , PG ,
CN , BS ,
CT , AB , # 40 #
B1 , B2 ,
CI , LI ,
, ,
SE , EP ,
PA , BR , # 50 #
CSET , IN ,
OP , FA ,
, DLC$MSB ,
DLC$LSB , DLX ,
DLTO , ELX , # 60 #
ELO , ELR ,
EBX , EBO ,
EBR , IC ,
OC , XLY ,
, CP , # 70 #
W , CTYP ,
NCIR , NEN ,
SDT , RIC ,
BCF , MREC ,
DO$ , , # 80 #
, ,
, ,
, ,
COLLECT , ,
P90 , P91 , # 90 #
P92 , P93 ,
P94 , P95 ,
P96 , P97 ,
P98 , P99 ,
, , # 100 #
MC , ,
, ,
, ,
, ,
, EOF , # 110 #
PAD , ,
, ,
, ,
, ,
, , # 120 #
, ,
, ,
, ,
, ,
, , # 130 #
, ,
, ,
, ,
, ,
, , # 140 #
, ,
, RTS ,
, MCI ,
MLI ;
STATUS LSPD UNKNOWN, # STATUS LIST FOR LINE SPEED #
$110,
$134,
$150,
$300,
$600,
$1200,
$2400,
$4800,
$9600,
$19200,
$38400;
STATUS STIP UNKNOWN, # STATUS LIST FOR SUB-TIP #
M4A,
M4C,
$2741,
N2741,
POST,
PRE,
PAD,
USER,
XAA,
$2780,
$3780;
STATUS TC UNKNOWN, # STATUS LIST FOR TERMINAL CLASS #
M33,
$713,
$721,
$2741,
M40,
H2000,
$751,
T4014,
HASP,
$200UT,
$714X,
$711,
$714,
HPRE,
$734,
$2780,
$3780,
$752,
X364,
$3270,
USER;
STATUS TIP UNKNOWN, # UNKNOWN #
ASYNC ,
MODE4 ,
HASP ,
X25 ,
BSC ,
$3270 ,
USER ;
ITEM AUTO$REC B; # FLAG SET IF AUTO OR XAUTO REC LINE #
ITEM XAUTO$REC B; # FLAG SET IF XAUTO REC LINE #
ITEM BCF$FLAG B; # BCF INDICATOR #
ITEM CA$MAP; # BIT MAP USED TO CHECK UNIQUENESS OF CA #
ITEM CKSUM; # TEMPORARY FOR CHECK SUM VALUE #
ITEM COLLECT$FLAG B;
ITEM COLLECT$USED B;
ITEM COM$ELMT B; # INDICATES STAT ENTRY IS A COMMUNIC ELEMT#
ITEM CP$PL$MAP; # USED TO CHECK FOR DUPLICATE STREAM #
ITEM CRNT$CSET; # CURRENT CODE SET #
ITEM CRNT$CTYP; # CURRENT CIRCUIT TYPE #
ITEM CTYP$USED B; # BOOLEAN TO SEE IF CTYP IS USED #
ITEM W$USED B; # BOOLEAN TO SEE IF W IS USED #
ITEM NCIR$USED B; # BOOLEAN TO SEE IF NCIR USED #
ITEM NEN$USED B; # BOOLEAN TO SEE IF NEN IS USED #
ITEM CRNT$DEV; # POINTER TO CURRENT DEVICE ENTRY #
ITEM CRNT$LSPD; # CURRENT LINE SPEED #
ITEM CRNT$MREC; # CURRENT MREC VALUE #
ITEM CRNT$NCIR; # CURRENT NUMBER OF CIRCUITS #
ITEM CRNT$EOF B; # CURRENT EOF FLAG ON TERMINAL STATEMENT #
ITEM EOF$USED B; # FLAG TO SHOW IF EOF IS SPECIFIED #
ITEM CRNT$NEN; # CURRENT NUMBER OF CIRCUITS ENABLED #
ITEM CRNT$STIP; # CURRENT SUB-TIP #
ITEM CRNT$TC; # CURRENT TERMINAL CLASS #
ITEM CRNT$TERM; # POINTER TO CURRENT TERMINAL IN LINE REC #
ITEM CRNT$TIP; # CURRENT TIPTYPE #
ITEM CRNT$TSPD; # CURRENT TSPEED VALUE #
ITEM CRNT$W; # CURRENT -W- VALUE #
ITEM CRNT$DEPAD; # NUMBER OF 8-BIT PAD ENTRIES FOR DEVICE #
ITEM CRNT$DEPADW; # NUMBER OF WORDS NEEDED FOR PAD ENTRIES #
ITEM DEVCNT; # CRNT NUMBER OF DEVICES DEFINED ON TERM #
ITEM I; # SCRATCH ITEM #
ITEM LCR$EXIST B; # INDICATES LINE CONFIGURE RECORD EXISTS #
ITEM LENGTH; # LENGTH OF RECORD/TABLE TO BE WRITTEN #
ITEM LR$EXIST B; # INDICATES A LINE RECORD EXISTS #
ITEM LTYPE C(10); # CURRENT LINE TYPE CATEGORY #
ITEM MAXDEV; # MAXIMUM NUMBER DEV STMTS FOR THIS TERM #
ITEM MAXTERM; # MAXIMUM NUMBER OF TERM STMTS FOR LINE #
ITEM NSVCERR B; # FLAG SET IF NSVC VALUE IS IN ERROR #
ITEM NWDS16; # NUMBER OF 16 BIT WORDS #
ITEM PVC$CNT; # PVC COUNT #
ITEM RIC$FLAG B; # RESTRICTED INTERACTIVE CAPABILITY FLAG #
ITEM SVC$CNT; # NSVC PARAMETER VALUE #
ITEM XTERMASK; # MASK FOR TERMINALS PER X.25 STIP #
ITEM SVC$SPEC B; # SVC SPECIFIED FLAG #
ITEM TA$MAP; # BIT MAP USED TO CHECK UNIQUENESS OF TA #
ITEM TERMCNT; # CRNT NUMBER OF TERMINALS DEFINED ON LINE#
ITEM TT$USED B; # TIPTYPE SPECIFIED FLAG #
ITEM VALUE; # INTEGER TEMPORARY #
ARRAY CRNT$PADVAL [1:MAXPADW] S(1);
BEGIN # PAD VALUE ARRAY FOR TERMINAL #
ITEM CRNT$PAD (0,0,60);
END
DEF MXDT # 7 #; # MAXIMUM DEVICE TYPE #
ARRAY DO$USED$MAP [1:MXDT] S(1);
BEGIN
ITEM DO$MAP (0,0,60);
END
ARRAY DT$COUNT$TAB [1:MXDT] S(2); # DEVICE TYPE COUNT TABLE #
BEGIN
ITEM DT$CNT (0,0,60);# DEVICE TYPE COUNT #
ITEM DT$MAX (1,0,60);# MAXIMUM NUMBER OF DT ALLOWED #
END
ARRAY FIRST$DT$TAB [1:MXDT] S(1);
BEGIN
ITEM FIRST$DT B(0,0,60); # INDICATES IF 1ST DT IS SENSED #
END
DEF MXTIP # 8 #; # MAXIMUM NUMBER OF TIPTYPE-S #
ARRAY TERMDEV$CNT [0:MXTIP] S(9);
BEGIN
ITEM TRM$MAX (0,0,60) = [255, # UNKNOWN #
1, # ASYNC #
16, # MODE4 #
1, # HASP #
255, # X25 #
1, # BSC #
32, # 3270 #
255 # USER #
];
ITEM DEV$MAX (1,0,60) = [255, # UNKNOWN #
1, # ASYNC #
15, # MODE4 (M4C) #
22, # HASP #
1, # X25 #
4, # BSC #
32, # 3270 #
255 # USER #
];
ITEM LP$MAX (2,0,60) = [255, # UNKNOWN #
0, # ASYNC #
15, # MODE4 (M4C) #
7, # HASP #
0, # X25 #
1, # BSC #
31, # 3270 #
255, # USER #
];
ITEM CR$MAX (3,0,60) = [255, # UNKNOWN #
0, # ASYNC #
1, # MODE4 (M4C) #
7, # HASP #
0, # X25 #
1, # BSC #
0, # 3270 #
255 # USER #
];
ITEM CP$MAX (4,0,60) = [255, # UNKNOWN #
0, # ASYNC #
0, # MODE4 #
7, # HASP #
0, # X25 #
1, # BSC #
0, # 3270 #
255 # USER #
];
ITEM PL$MAX (5,0,60) = [255, # UNKNOWN #
0, # ASYNC #
0, # MODE4 #
7, # HASP #
0, # X25 #
0, # BSC #
0, # 3270 #
255 # USER #
];
ITEM DT7$MAX (6,0,60) = [255, # UNKNOWN #
1, # ASYNC #
15, # MODE4 (M4C) #
22, # HASP #
1, # X25 #
4, # BSC #
32, # 3270 #
255 # USER #
];
ITEM CON$MAX (7,0,60) = [255, # UNKNOWN #
1, # ASYNC #
15, # MODE4 (M4C) #
1, # HASP #
1, # X25 #
1, # BSC #
32, # 3270 #
255 # USER #
];
ITEM AP$MAX (8,0,60) = [255, # UNKNOWN #
0, # ASYNC #
0, # MODE 4 (M4C) #
0, # HASP #
255, # X25 #
0, # BSC #
0, # 3270 #
255 # USER #
];
END
ARRAY STRM$USED$MP [1:MXDT] S(1);
BEGIN
ITEM STRM$MAP (0,0,60);
END
SWITCH COMJUMP , # UNKNOWN #
, # NFILE #
NET$ELMT , # NPU #
, # SUPLINK #
, # COUPLER #
, # LOGLINK #
LINE , # GROUP #
LINE , # LINE #
, # #
TERMINAL$, # TERMINAL #
DEVICE , # DEVICE #
TRUNK ; # TRUNK #
CONTROL EJECT;
PROC C$USR$PRM1(PARAM$USED,CLR$WRD);
*IF,DEF,IMS
#
**
*
* C$USR$PRM1 - CHECKS IF A USER DEFINED TIPTYPE PARAMETER IS
* MISSING.
*
* Y. C. YIP 82/10/19
*
* THIS PROCEDURE CHECKS IF A PARAMETER IS NOT SPECIFIED AND
* IF SO, A WARNING MESSAGE IS GENERATED. APPLIES ONLY FOR
* USER DEFINED TIPTYPE PARAMETERS.
*
* ENTRY PARAM$USED - FLAG TRUE IF PARAMETER IS USED
* FALSE OTHERWISE.
* CLR$WRD - ARRAY OF 10 CHARACTERS WHICH IS THE
* NAME OF THE KEYWORD REQUIRED.
*
* EXIT ALL PARAMETERS ARE UNCHANGED.
*
* METHOD
*
* THE FIRST PARAMETER, PARAM$USED IS CHECKED AND IF IT IS TRUE
* THEN A WARNING IS GENERATED BY CALLING NDLEM2 USING THE SECOND
* PARAMETER WHICH IS THE NAME OF THE KEYWORD AS THE CLARIFIER.
*
*E
#
*ENDIF
BEGIN
ITEM PARAM$USED B; # PARAMETER USED OR NOT #
ITEM CLR$WRD C(10); # CLARIFIER WORD #
IF NOT PARAM$USED # IF PASRAMETER NOT USED #
THEN
BEGIN
NDLEM2(ERR161,STLNUM[0],CLR$WRD); # GENERATE WARNING 161 #
END
END # END OF PROC C$USR$PRM1 #
CONTROL EJECT;
PROC C$USR$PRM2(PARAM$VAL,CLR$WRD);
*IF,DEF,IMS
#
**
*
* C$USR$PRM2 - CHECKS A USER DEFINED TIPTYPE PARAMETER IS MISSING
*
* Y. C. YIP 82/10/20
*
* THIS PROCEDURE CHECKS IF A PARAMETER IS SPECIFIED BY
* THE VALUE OF THE FIRST PARAMETER. IF IT IS NOT SPECIFIED
* A WARNING IS GENERATED TO THE USER. IT APPLIES ONLY FOR
* USER DEFINED TIPTYPE PARAMETERS.
*
* ENTRY PARAM$VAL - VALUE OF THE PARAMETER BEING CHECKED.
* CLR$WRD - ARRAY OF 10 CHARACTERS WHICH IS THE
* NAME OF THE KEYWORD CHECKED.
*
* EXIT ALL PARAMETERS REMAIN UNCHANGED.
*
* METHOD
*
* THE VALUE OF PARAM$VAL IS CHECKED AND IF IT IS ZERO
* A WARNING IS GENERATED WITH THE SECOND PARAMETER WHICH IS
* THE NAME OF THE PARAMETER BEING CHECKED AS THE CLARIFIER.
*
*E
#
*ENDIF
BEGIN
ITEM PARAM$VAL ; # VALUE OF PARAMETER #
ITEM CLR$WRD C(10); # CLARIFIER WORD #
IF PARAM$VAL EQ 0 # IF PARAMETER IS STILL ZERO #
THEN
BEGIN
NDLEM2(ERR161,STLNUM[0],CLR$WRD); # GENERATE ERROR MESSAGE #
END
END # END OF PROC C$USR$PRM2 #
CONTROL EJECT;
PROC DEVPR;
BEGIN
*IF,DEF,IMS
#
** DEVPR - DEVICE STATEMENT PROC.
*
* D.K. ENDO 81/11/02
*
* THIS PROCEDURE CHECKS THE -DT- PARAMETER, DEVICE STMT COUNT, AND
* CALLS A PROC, BASED ON TIPTYPE, TO CHECK THE REMAINING PARAMETERS.
*
* PROC DEVPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INITIALIZE FLAGS AND VALUES.
* POINT TO NEXT DEVICE ENTRY.
* CLEAR FIXED PORTION OF ENTRY.
* INCREMENT DEVICE COUNT.
* IF LABEL IS O.K.,
* PUT LABEL FROM STATEMENT TABLE INTO DEVICE ENTRY.
* IF GROUP COUNT IS GREATER THAN ZERO,
* THEN,
* FOR EACH ITERATION UNTIL GROUP COUNT,
* PUT LABEL INTO DEVICE XREF TABLE FROM LABEL TABLE.
* OTHERWISE,
* PUT LABEL FROM STATEMENT TABLE INTO DEVICE XREF TABLE.
* IF CTYP IS SVC
* SET SVC IN DEVICE XREF ENTRY.
* IF DT WAS NOT SPECIFIED,
* THEN,
* IF TIPTYPE IS X25 AND SUBTIPTYPE IS XAA
* DEFAULT DT TO APPLICATION (AP)
* ELSE
* DEFAULT DT TO CONSOLE
* PUT DT VALUE INTO DEVICE ENTRY.
* OTHERWISE,
* IF VALUE IS O.K.,
* MAP NUMERIC VALUE FOR DT.
* IF TIPTYPE AND DT ARE NOT USER,
* IF TC IS NOT USER OR UNKNOWN,
* THEN,
* IF TC AND DT ARE NOT COMPATIBLE,
* FLAG ERROR -- DT INVALID WITH TC SPECIFIED.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* THEN,
* IF STIP AND DT ARE NOT COMPATIBLE,
* FLAG ERROR -- DT INVALID WITH STIP SPECIFIED.
* OTHERWISE,
* IF TIPTYPE IS NOT UNKNOWN,
* IF TIPTYPE AND DT ARE NOT COMPATIBLE,
* FLAG ERROR -- DT INVALID WITH TIPTYPE SPECIFIED.
* IF DEVICE STATEMENT COUNT IS GREATER THAN MAXIMUM,
* FLAG ERROR -- MAXIMUM DEVICE STATEMENTS EXCEEDED.
* IF TIPTYPE IS NOT USER OR UNKNOWN AND
* DT IS USER OR UNKNOWN,
* THEN,
* SELECT CASE THAT APPLIES,
* CASE 1(ASYNC):
* CHECK ASYNC DEVICE STATEMENT.
* CASE 2(MODE4):
* CHECK MODE4 DEVICE STATEMENT.
* CASE 3(HASP):
* CHECK HASP DEVICE STATEMENT.
* CASE 4(X25):
* CHECK X25 DEVICE STATEMENT.
* CASE 5(BSC):
* CHECK BSC DEVICE STATEMENT.
* OTHERWISE,
* CHECK USER DEVICE STATEMENT.
* IF TIPTYPE IS NOT USER AND DT IS CONSOLE,
* IF HN WAS NOT SPECIFIED,
* AND THE HOST NAMES OF ALL LOGICAL LINKS TERMINATING
* AT THE SAME NPU ARE THE SAME
* THEN,
* DEFAULT HN VALUE TO HOST I.D. OF LOGLINK OF THE LAST ENTRY
* OF THE LOGICAL NAME TABLE
* IF AUTOCON WAS NOT SPECIFIED,
* DEFAULT AUTOCON TO YES
* OTHERWISE,
* IF AUTOCON IS -YES-,
* FLAG ERROR -- REQUIRED PARAMETER MISSING(HN).
* PUT RIC VALUE INTO DEVICE ENTRY.
* PUT WORD COUNT FOR DEVICE ENTRY.
* INCREMENT WORD COUNT FOR TERMINAL ENTRY.
*
#
*ENDIF
#
**** PROC DEVPR - XREF LIST BEGINS
#
XREF
BEGIN
PROC NDLEM2; # MAKE ENTRY IN PASS 2 ERROR FILE #
FUNC XCHD C(10); # CONVERTS HEX VALUE TO DISPLAY CODE #
END
#
****
#
DEF MXDVENT # 14 #; # MAXIMUM WORD SIZE FOR DEVICE ENTRY #
DEF SDT$12 # 12 #; # STARTING USER VALUE FOR SDT #
DEF SDT$13 # 13 #; # INTERNAL VALUE FOR SDT13 #
DEF SDT$14 # 14 #; # INTERNAL VALUE FOR SDT14 #
DEF SDT$15 # 15 #; # ENDING USER VALUE FOR SDT #
DEF FIRST$POS # 24 #; # FIRST POSITION FOR FNFV PAIR #
DEF NO$MATCH # -1 #; # VALUE FOR SAVE$ENTRY IF NO MATCH FOUND #
STATUS CC UNKNOWN, # STATUS LIST OF CONTROL CHARACTERISTICS #
AB,
CN,
B1,
B2,
CT,
BS,
ELX,
EBX;
ITEM ABL$USED B;
ITEM AUTOCON$FLAG B;
ITEM AUTOCON$NO B;
ITEM BIT$POS;
ITEM CRNT$DT;
ITEM DBL$USED B;
ITEM DBZ$USED B;
ITEM DO$USED B;
ITEM HN$USED B;
ITEM PL$USED B;
ITEM I;
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM LL$CNT;
ITEM LLT$PNTR;
ITEM PWI, PDI; # PAD WORD INDX., PAD WORD DISPL. INDX. #
ITEM STREAM$USED B;
ITEM TA$USED B;
ITEM UBL$USED B;
ITEM UBZ$USED B;
ITEM XBZ$USED B;
STATUS X$D$GROUP NO,XG,DG; # STATUS VARIABLE FOR XL'S AND DL'S #
ITEM GR$SET S: X$D$GROUP; # STATUS ITEM OF TYPE X$D$GROUP #
ITEM SAVE$ENTRY; # USED FOR COMPARING HOST NAMES IN #
# LLT$TABLE #
# SET TO 0 IF NO MATCH FOUND
TO INDEX OF LLT$TABLE ENTRY AT LAST
COMPARISON.
OR TO -1 IF A MISMATCH IS FOUND #
DEF MAXCC # 8 #;
ARRAY CRNT$CC$TAB[1:MAXCC] S(1);
BEGIN
ITEM CRNT$CC (0,0,60);
END
DEF MXDT # 7 #; # MAXIMUM NUMBER OF DEVICE TYPES #
ARRAY DT$TABLE [1:MXDT] S(1);
BEGIN
ITEM DTNAME C(0,0,7) = ["CON", # DT CHARACTER VALUES #
"CR",
"LP",
"CP",
"PL",
"AP",
"DT12"
];
ITEM DT$NUMV I(0,42,09) = [0, # CONSOLE -- INTEGER VALUE #
1, # CARD READER #
2, # LINE PRINTER #
3, # CARD PUNCH #
4, # PLOTTER #
6, # A-A DEVICE #
12 # USER DT12 #
];
ITEM DT$STAT (0,51,09) = [DT"CON", # CONSOLE -- STATUS VALUE #
DT"CR", # CARD READER #
DT"LP", # LINE PRINTER #
DT"CP", # CARD PUNCH #
DT"PL", # PLOTTER #
DT"AP", # A TO A DEVICE TYPE #
DT"USER" # USER #
];
END
ARRAY TC$ALLOWED [1:MXDT] S(1); # BIT MAP FOR TC SUPPORTING DT #
BEGIN
ITEM DT$TC$MAP U(0,0,30) = [O"3777777000", # CONSOLE #
O"0006170000", # CARD READER #
O"0007371000", # LINE PRINTER #
O"0004130000", # CARD PUNCH #
O"0004100000", # PLOTTER #
0, # A-A (NA) #
];
END
ARRAY STIP$ALLOWED [1:MXDT] S(1);# MAP FOR STIP SUPPORTING DT #
BEGIN
ITEM DT$STIP$MAP U(0,0,30) = [O"3777000000", # CONSOLE #
O"2143000000", # CARD READER #
O"3143000000", # LINE PRINTER #
O"0143000000", # CARD PUNCH #
O"0140000000", # PLOTTER #
O"0004000000", # A-A DEVICE #
];
END
ARRAY TIP$ALLOWED [1:MXDT] S(1); # MAP FOR TIP SUPPORTING DT #
BEGIN
ITEM DT$TIP$MAP U(0,0,30) = [O"3740000000", # CONSOLE #
O"1500000000", # CARD READER #
O"1540000000", # LINE PRINTER #
O"0500000000", # CARD PUNCH #
O"0400000000", # PLOTTER #
O"0200000000", # A-A DEVICE #
];
END
DEF MNKWID # 65 #;
DEF MXKWID # 131 #;
ARRAY KWD$TABLE [MNKWID:MXKWID] S(1);
BEGIN
ITEM KWDNAME C(0,0,10) = ["DT",
"SDT",
"TA",
"ABL",
"DBZ",
"UBZ",
"DBL",
"UBL",
"XBZ",
"DO",
"STREAM",
"HN",
,
"AUTOCON",
"PRI",
"P90",
"P91",
"P92",
"P93",
"P94",
"P95",
"P96",
"P97",
"P98",
"P99",
"AB",
"BR",
"BS",
"B1",
"B2",
"CI",
"CN",
"CT",
"DLC",
"DLTO",
"DLX",
"EP",
"IN",
"LI",
"OP",
"PA",
"PG",
"PL",
"PW",
"SE",
"FA",
"XLC",
"XLX",
"XLTO",
"ELO",
"ELX",
"ELR",
"EBO",
"EBR",
"CP",
"IC",
"OC",
"LK",
"EBX",
,
"MC",
"XLY",
"EOF",
"PAD",
"RTS",
"MCI",
"MLI"
];
END
SWITCH DEVPJUMP NEXT, # UNKNOWN -- SWITCH BY TIPTYPE #
ASYNC, # ASYNC #
MODE4, # MODE4 #
HASP, # HASP #
X25, # X25 #
BSC, # BSC #
$3270, # 3270 #
NEXT; # USER #
CONTROL EJECT;
PROC CHCONTRL(CHKWID,CHLNUM,STAT,VALUE);
BEGIN
*IF,DEF,IMS
#
** CHCONTRL
* Y. C. YIP
* THIS PROCEDURE CHECKS FOR CONTROL CHARACTERS AND ENSURE THAT
* THE PARAMETER OF A DEVICE STATEMENT DOES NOT USE ANY SPECIAL
* CHARACTER NOT ALLOWED BY THE TERMINAL ERS.
*
* ENTRY CONDITION:
* CHKWID=KEYWORD I.D.KEYWORD .
* CHLNUM=LINE NUMBER OF INPUT SOURCE
* STAT = INPUT VALUE OF STATUS .
* VALUE = VALUE OF KEYWORD.
* EXIT CONDITION:
* CHKWID=UNCHANGED.
* CHLNUM=LINE MUNBER OF SOURCE INPUT.
* STAT= FALSE IF VALUE OVERLAPS WITH SOME
* VALUE DISALLOWED BY THE NDLP ERS.
* VALUE = UNCHANGED.
*
#
*ENDIF
DEF MAXBAD # 5 # ; # LENGTH OF ARRAY FOR CHECKING #
DEF ILLE00 # X"0" # ; # ILLEGAL CHARACTER 0 #
DEF ILLE01 # X"01" #; # ILLEGAL CHARACTER CHAR 01 #
DEF ILLE02 # X"02" #; # ILLEGAL CHARACTER 02 #
DEF ILLE20 # X"20" #; # ILLEGAL CHARACTER 20 #
DEF ILLE30 # X"30" #; # ILLEGAL CHARACTER 30 #
DEF ILLE39 # X"39" #; # ILLEGAL CHARACTER 39 #
DEF ILLE3D # X"3D" #; # ILLEGAL CHARACTER 3D #
DEF ILLE41 # X"41" #; # ILLEGAL CHARACTER 41 #
DEF ILLE5A # X"5A" #; # ILLEGAL CHARACTER 5A #
DEF ILLE61 # X"61" #; # ILLEGAL CHARACTER 61 #
DEF ILLE7A # X"7A" #; # ILLEGAL CHARACTER 7A #
DEF ILLE7F # X"7F" #; # ILLEGAL CHARACTER 7F #
ITEM CHKWID; # I. D. NUMBER OF THE KEYWORD #
ITEM CHLNUM; # LINE NUMBER OF CURRENT LINE #
ITEM STAT B ; # STATUS VARIABLE #
ITEM VALUE ; # VALUE OF KEYWORD #
ARRAY BAD$CHAR [0:MAXBAD] S(1); # BAD CHAR LIST #
BEGIN
ITEM BAD$LIST = [ILLE00,ILLE01,ILLE02,
ILLE20,ILLE3D,ILLE7F];
END
ITEM INDEX1 ; # LOOP INDEX #
IF NOT STAT # IF OUT OF RANGE ALREADY #
THEN
BEGIN
RETURN;
END # RETURN TO CALLING ROUTINE CONDEV #
FOR INDEX1=0 STEP 1 UNTIL MAXBAD
DO
BEGIN
IF VALUE EQ BAD$LIST[INDEX1]
THEN # BAD CHAR MET #
BEGIN
STAT = FALSE; # SET STAT TO FALSE#
END
END
IF ( VALUE GQ ILLE30 AND VALUE LQ ILLE39 )
OR ( VALUE GQ ILLE41 AND VALUE LQ ILLE5A )
OR ( VALUE GQ ILLE61 AND VALUE LQ ILLE7A )
THEN # FALL INTO BAD RANGE ? #
BEGIN
STAT = FALSE; # STAT SET TO FALSE #
END
IF NOT STAT # IF STATUS IS BAD #
THEN
BEGIN
NDLEM2(ERR158,CHLNUM,KWDNAME[CHKWID]); # GENERATE
ERROR MESSAGE #
END
RETURN ; # RETURN TO CALLING ROUTINE #
END # END OF PROC CHCONTRL #
CONTROL EJECT;
PROC ASYDEV;
BEGIN
*IF,DEF,IMS
#
** ASYDEV - CHECK ASYNC DEVICE PARAMRTERS.
*
* D.K. ENDO 81/11/02
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE APPLICABLE TO ASYNC
* DEVICES.
*
* PROC ASYDEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* PUT DEFAULT CONTROL CHARACTER IN CC TABLE BASED ON STIP AND/OR TC.
* FOR EACH VALUE DECLARATION IN ENTRY.
* SELECT CASE THAT APPLIES:
* CASE 1(DI,P90 THRU P99, PRI,PW):
* CALL GENDEV TO CHECK GENERAL PARAMETER.
* CASE 2(HN,AUTOLOG,AUTOCON,AB,BR,BS,B1,B2,CI,CN,CT,
* DLX,IN,LI,OP,PA,PL,SE,FA,XLC,XLX,LK,XLY):
* CALL CONDEV TO CHECK CONSOLE PARAMETER.
* CASE 3(ABL,DBZ,DBL,UBL,XBZ,UBZ):
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETER.
* CASE 4(DLC,DLTO,EP,PG,XLTO,ELO,ELX,ELR,EBO,EBR,CP,IC,OC):
* IF STIP OR TC IS 2741,
* THEN,
* CALL CONDEV TO CHECK PARAMETER.
* OTHERWISE,
* FLAW ERROR -- PARAM INVALID FOR 2741 DEVICES.
* CASE 5(TA,DO,STREAM):
* FLAG ERROR -- PARAM INVALID FOR ASYNC DEVICES.
* CASE 6 (SDT) :
* CHECK FOR SDT12-SDT15 AS VALID SDT NAMES ONLY AND
* CALL BTCHDEV PROCESSOR
* IF ABL OR DBZ NOT SPECIFIED
* DEFAULT VALUE BY LSPEED.
* IF DBL,UBL,OR XBZ WAS NOT SPECIFIED
* DEFAULT VALUE.
* CHECK AL,CN,BS,B1,B2,CT FOR UNIQUENESS
* IF NOT UNIQUE
* FLAG ERROR.
*
#
*ENDIF
#
**** PROC ASYDEV - XREF LIST BEGINS
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRIES IN PASS 2 ERROR FILE #
END
#
****
#
DEF UBL$DEF # 7 #; # DEFAULT UBL VALUE #
DEF UBZ$DEF # 1 #; # DEFAULT UBZ VALUE FOR ASYCH TIPTYPE #
DEF DBL$DEF # 1 #; # DEFAULT DBL VALUE FOR ASYCH TIPTYPE #
DEF PL$DEF # 64 #; # DEFAULT PAGE LENGTH TO 64 #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # VALUE TEMPORARY #
ARRAY CC$TABLE [0:1] S(2); # CONTROL CHARACTERISTICS #
BEGIN
ITEM AB$DEF (00,00,09) = [X"18", # N2741 -- DEFAULT AB #
X"28" # 2741 #
];
ITEM CN$DEF (00,09,09) = [X"18", # N2741 -- DEFAULT CN #
X"28" # 2741 #
];
ITEM BS$DEF (00,18,09) = [X"08", # N2741 -- DEFAULT BS #
X"08" # 2741 #
];
ITEM B1$DEF (00,27,09) = [X"10", # N2741 -- DEFAULT B1 #
X"3A" # 2741 #
];
ITEM B2$DEF (00,36,09) = [X"14", # N2741 -- DEFAULT B2 #
X"29" # 2741 #
];
ITEM CT$DEF (00,45,09) = [X"1B", # N2741 -- DEFAULT CT #
X"25" # 2741 #
];
ITEM ELX$DEF (01,00,09) = [X"0D", # N2741 -- DEFAULT EL #
-1 # 2741(N/A) #
];
ITEM EBX$DEF (01,00,09) = [X"04", # N2741 -- DEFAULT EB #
-1 # 2741(N/A) #
];
END
DEF MXLSPD # 11 #; # MAXIMUM NUMBER OF LINE SPEEDS #
ARRAY FLOW$TABLE [0:MXLSPD] S(2);
BEGIN
ITEM ABL$DEF (0,0,60) = [,1, # 110 -- DEFAULT ABL #
1, # 134 #
1, # 150 #
1, # 300 #
2, # 600 #
2, # 1200 #
2, # 2400 #
2, # 4800 #
2, # 9600 #
3, # 19200 #
3 # 38400 #
];
ITEM DBZ$DEF (1,0,60) = [,230, # 110 -- DEFAULT DBZ #
230, # 134 #
230, # 150 #
230, # 300 #
230, # 600 #
230, # 1200 #
230, # 2400 #
460, # 4800 #
940, # 9600 #
885, # 19200 #
885 # 38400 #
];
END
SWITCH ASYDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$ASY , # , DT ,#
SDT , ILLEGAL , # SDT , TA ,#
FLOW$PARAM , FLOW$PARAM , # ABL , DBZ ,#
FLOW$PARAM , FLOW$PARAM , # UBZ , DBL ,#
FLOW$PARAM , FLOW$PARAM , # UBL , XBZ ,#
ILLEGAL , ILLEGAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
CON$PARAM , CON$PARAM , # AB , BR ,#
CON$PARAM , CON$PARAM , # BS , B1 ,#
CON$PARAM , CON$PARAM , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
CON$PARAM , N2741$PRM , # DLC , DLTO ,#
CON$PARAM , N2741$PRM , # DLX , EP ,#
CON$PARAM , CON$PARAM , # IN , LI ,#
CON$PARAM , CON$PARAM , # OP , PA ,#
N2741$PRM , CON$PARAM , # PG , PL ,#
GEN$PARAM , CON$PARAM , # PW , SE ,#
CON$PARAM , CON$PARAM , # FA , XLC ,#
CON$PARAM , N2741$PRM , # XLX , XLTO ,#
N2741$PRM , N2741$PRM , # ELO , ELX ,#
N2741$PRM , N2741$PRM , # ELR , EBO ,#
N2741$PRM , N2741$PRM , # EBR , CP ,#
N2741$PRM , N2741$PRM , # IC , OC ,#
CON$PARAM , N2741$PRM , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
CON$PARAM , , # XLY , EOF ,#
, N2741$PRM , # PAD , RTS ,#
GEN$PARAM , GEN$PARAM ; # MCI , MLI #
CONTROL EJECT;
# #
# ASYDEV CODE BEGINS HERE #
# #
IF CRNT$STIP EQ STIP"$2741" OR # IF STIP OR TC IS 2741 #
CRNT$TC EQ TC"$2741"
THEN
BEGIN # SET DEFAULT VALUES FOR 2741 #
CRNT$CC[CC"AB"] = AB$DEF[1];
CRNT$CC[CC"CN"] = CN$DEF[1];
CRNT$CC[CC"BS"] = BS$DEF[1];
CRNT$CC[CC"B1"] = B1$DEF[1];
CRNT$CC[CC"B2"] = B2$DEF[1];
CRNT$CC[CC"CT"] = CT$DEF[1];
CRNT$CC[CC"ELX"] = ELX$DEF[1];
CRNT$CC[CC"EBX"] = EBX$DEF[1];
END
ELSE # STIP AND TC NOT 2741 #
BEGIN # IF STIP OR TC NOT UNKNOWN #
IF CRNT$STIP NQ STIP"UNKNOWN" OR
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN #SET DEFAULT VALUES FOR NON-2741#
CRNT$CC[CC"AB"] = AB$DEF[0];
CRNT$CC[CC"CN"] = CN$DEF[0];
CRNT$CC[CC"BS"] = BS$DEF[0];
CRNT$CC[CC"B1"] = B1$DEF[0];
CRNT$CC[CC"B2"] = B2$DEF[0];
CRNT$CC[CC"CT"] = CT$DEF[0];
CRNT$CC[CC"ELX"] = ELX$DEF[0];
CRNT$CC[CC"EBX"] = EBX$DEF[0];
END
END
FOR I=3 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DECLARATION ENTRY #
BEGIN
GOTO ASYDJUMP[STKWID[I]]; # GOTO APPROPRIATE PROC #
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETERS #
TEST I;
SDT: IF STVALNAM[I] EQ "SDT12" OR # IF SDT12 - SDT15 USED #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
THEN
BEGIN
BTCHDEV(STWORD[I],STLNUM[0]); # CALL BATCH DEVICE PROCESSOR #
END
ELSE
BEGIN
GOTO ILLEGAL;
END
TEST I;
CON$PARAM:
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETERS #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETERS #
TEST I;
N2741$PRM: # CHECK NON-2741 PARAMETERS #
IF CRNT$TC NQ TC"$2741" AND # IF TC AND STIP NOT 2741 #
CRNT$STIP NQ STIP"$2741"
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # TERMINAL IS 2741 #
BEGIN # FLAG ERROR -- INVALID FOR 2741 TERMINALS#
NDLEM2(ERR131,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ILLEGAL: # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
NEXT$ASY:
END
IF NOT ABL$USED # IF ABL NOT SPECIFIED #
THEN # DEFAULT BY LINE SPEED #
BEGIN
IF CRNT$LSPD NQ LSPD"UNKNOWN" # CURRENT LSPEED IS SET #
THEN
BEGIN
VALUE = ABL$DEF[CRNT$LSPD]; # DEFAULT ABL IN VALUE #
END
ELSE # CURRENT LSPEED IS UNKNOWN #
BEGIN
IF XAUTO$REC # IF XAUTO WAS SPECIFIED #
THEN
BEGIN
VALUE = ABL$DEF[LSPD"$600"]; # DEFAULT ABL (FOR 600 BAUD) #
END
ELSE
BEGIN
VALUE = ABL$DEF[LSPD"$300"]; # DEFAULT ABL (FOR 300 BAUD) #
END
END
DEVFNFV(FN"ABL",VALUE);
END
IF NOT DBZ$USED # IF DBZ NOT SPECIFIED #
THEN # DEFAULT DBZ BY LINE SPEED #
BEGIN
IF CRNT$LSPD NQ LSPD"UNKNOWN" # CURRENT LSPEED IS KNOWN #
THEN
BEGIN
VALUE = DBZ$DEF[CRNT$LSPD]; # DEFAULT DBZ IN VALUE #
END
ELSE # CURRENT LSPEED IS UNKNOWN #
BEGIN
IF CRNT$TSPD NQ LSPD"UNKNOWN"
THEN # IF TSPEED WAS SPECIFIED #
BEGIN
VALUE = DBZ$DEF[CRNT$TSPD];# DEFAULT DBZ IN VALUE #
END
ELSE # TSPEED WAS NOT SPECIFIED #
BEGIN
VALUE = DBZ$DEF[LSPD"$300"]; # DEFAULT DBZ (FOR 300 BAUD) #
END
END
J = B<44,8>VALUE; # MSB OF DBZ VALUE #
DEVFNFV(FN"DBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF DBZ VALUE #
DEVFNFV(FN"DBZ$LSB",J);
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN # DEFAULT DBL #
BEGIN
DEVFNFV(FN"DBL",DBL$DEF);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN # DEFAULT UBL #
BEGIN
DEVFNFV(FN"UBL",UBL$DEF);
END
IF NOT UBZ$USED # IF UBZ NOT SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"UBZ",UBZ$DEF); # DEFAULT UBZ #
END
IF NOT XBZ$USED # IF XBZ WAS NOT SPECIFIED #
THEN # DEFAULT XBZ BY LINE SPEED #
BEGIN
IF CRNT$LSPD NQ LSPD"UNKNOWN" # CURRENT LSPEED IS SET #
THEN
BEGIN
VALUE = DBZ$DEF[CRNT$LSPD]; # DEFAULT XBZ IN VALUE #
END
ELSE # LSPEED WAS NOT SPECIFIED #
BEGIN
IF CRNT$TSPD NQ LSPD"UNKNOWN"
THEN # IF TSPEED WAS SPECIFIED #
BEGIN
VALUE = DBZ$DEF[CRNT$TSPD]; # DEFAULT XBZ IN VALUE #
END
ELSE # TPSEED WAS NOT SPECIFIED #
BEGIN
VALUE = DBZ$DEF[LSPD"$300"];# DEFAULT XBZ (FOR 300 BAUD) #
END
END
J = B<44,8>VALUE; # MSB OF XBZ VALUE #
DEVFNFV(FN"XBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF XBZ VALUE #
DEVFNFV(FN"XBZ$LSB",J);
END
IF NOT PL$USED AND # IF PL NOT SPECIFIED #
CRNT$DT EQ DT"LP" # AND DEVICE TYPE IS LINEPRINTER #
THEN
BEGIN
DEVFNFV(FN"PL",PL$DEF);
END
IF CRNT$STIP NQ STIP"UNKNOWN" OR
CRNT$TC NQ TC"UNKNOWN"
THEN # IF STIP OR TC NOT UNKNOWN #
BEGIN # CHECK FOR UNIQUENESS #
FOR I=CC"B1" STEP 1 UNTIL CC"EBX"
DO
BEGIN
IF CRNT$CC[CC"AB"] EQ CRNT$CC[I]
THEN
BEGIN # FLAG ERROR -- VALUES NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
FOR I=CC"CN" STEP 1 UNTIL CC"BS"
DO
BEGIN
FOR J=I+1 STEP 1 UNTIL CC"EBX"
DO
BEGIN
IF CRNT$CC[I] EQ CRNT$CC[J]
THEN
BEGIN # FLAG ERROR -- VALUES NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
END
END
RETURN; # **** RETURN **** #
END # ASYDEV #
CONTROL EJECT;
PROC BSCDEV;
BEGIN
*IF,DEF,IMS
#
** BSCDEV - CHECK BISYNC DEVICE PARAMETER.
*
* D.K. ENDO 81/11/02
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE APPLICABLE TO BISYNC
* DEVICES.
*
* PROC BSCDEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION IN ENTRY,
* SELECT CASE THAT APPLIES,
* CASE 1(DI,PRI,P90 THRU P99,PW):
* CALL GENDEV TO CHECK GENERAL PARAMETER.
* CASE 2(DBL):
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETER.
* CASE 3 (UBL):
* IF DT IS CONSOLE AND RANGE OF UBL WITHIN 1 TO 7
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETER.
* CASE 4(HN,AUTOLOG,AUTOCON,CT):
* IF DT IS CONSOLE
* THEN
* CALL CONDEV TO CHECK CONSOLE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAM NOT ALLOWED WITH DT SPECIFIED.
* CASE 5(TA):
* IF DT IS CARD PUNCH,
* THEN,
* IF STIP IS 3780 OR UNKNOWN,
* THEN,
* CALL MBDEV TO CHECK MODE4/BSC PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID FOR 2780 DEVICES.
* OTHERWISE,
* FLAG ERROR -- VALID FOR CARD PUNCH ONLY.
* CASE 6(SDT):
* IF DT IS LINE PRINTER OR CARD READER,
* THEN,
* CALL BTCHDEV TO CHECK PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 7(DO,STREAM,AB,BR,BS,B1,B2,CI,CN,DLC,DLTO,DLX,EP,IN,LI,
* OP,PA,PG,PL,SE,FA,XLC,XLX,XLTO,ELO,ELX,ELR,EBO,EBR,CP,
* IC,OC,LK,EBX,HD,XLY):
* FLAG ERROR -- INVALID FOR BISYNC DEVICES.
* CASE 8(ABL):
* IF DT IS CONSOLE,
* THEN,
* CALL FLOWDEV TO CHECK PARAMETER.
* OTHERWISE,
* FLAG ERROR -- VALID FOR CONSOLES ONLY.
* CASE 9(DBZ):
* IF DT IS NOT CARD READER,
* THEN,
* CALL FLOWDEV TO CHECK PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID FOR CARD READERS.
* CASE 10(UBZ):
* IF DT IS CONSOLE OR CARD READER
* OR LINEPRINTER OR CARD PUNCH,
* THEN,
* CALL FLOWDEV TO CHECK PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* IF ABL WAS NOT SPECIFIED AND DT IS CONSOLE,
* DEFAULT ABL VALUE.
* IF DBL OR UBL NOT SPECIFIED,
* DEFAULT VALUE BY DEVICE TYPE.
* IF DBZ NOT SPECIFIED AND DT IS NOT CARD READER.
* IF TC IS NOT -USER- OR UNKNOWN,
* THEN,
* DEFAULT DBZ BY TC.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* DEFAULT DBZ BY STIP.
* IF UBZ NOT SPECIFIED AND DT IS -CON- OR -CR-,
* DEFAULT UBZ VALUE.
* IF XBZ NOT SPECIFIED,
* IF TC IS NOT -USER- OR UNKNOWN,
* THEN,
* DEFAULT XBZ VALUE BY TC.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN
* DEFAULT XBZ VALUE BY STIP.
* IF TA NOT SPECIFIED AND DT IS CARD PUNCH AND
* STIP IS -3780- AND LINE IS AUTO-REC,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF MREC WAS SPECIFIED,
* PUT MREC VALUE IN DEVICE ENTRY.
* IF STIP OR TC IS -2780-
* PUT BCF VALUE IN DEVICE ENTRY.
* IF DT IS NOT CONSOLE OR USER,
* PUT DO VALUE IN DEVICE ENTRY.
*
#
*ENDIF
#
**** PROC BSCDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRIES IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO CHARACTER #
END
#
****
#
DEF ABL$DEF # 2 #;
DEF DO$DEF # 1 #; # DEFAULT -DO- VALUE #
DEF UBL$DEF # 7 #; # DEFAULT ABL VALUE #
ITEM CHARVAL C(10); # SCRATCH CHARACTER VARIABLE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM VALUE; # INTEGER VALUE TEMPORARY #
ITEM VALUE2; # INTEGER VALUE TEMPORARY #
DEF MXDT # 4 #;
ARRAY DBL$TABLE [1:MXDT] S(1);
BEGIN
ITEM DBL$DEF (0,0,60) = [2, # CONSOLE -- DEFAULT DBL #
2, # CARD READER #
1, # LINE PRINTER #
1 # CARD PUNCH #
];
END
DEF MXTC # 17 #;
ARRAY DBZ$TC$TBL [16:MXTC,1:MXDT] S(1);
BEGIN
ITEM DBZ$DEF (0,0,60) = [[400, # 2780 -- CON DEFAULT DBZ #
512 # 3780 #
]
[ 0, # 2780 -- CR DEFAULT DBZ (N/A) #
0 # 3780 #
]
[ 1, # 2780 -- LP DEFAULT DBZ #
1 # 3780 #
]
[ 1, # 2780 -- CP DEFAULT DBZ #
1 # 3780 #
]];
END
DEF MXSTIP # 11 #;
ARRAY DBZ$STIP$TBL [10:MXSTIP,1:MXDT] S(1);
BEGIN
ITEM DBZ$STIP$DEF (0,0,60) = [[400, # 2780 -- CON DEFAULT #
512 # 3780 #
]
[ 0, # 2780 -- CR DEFAULT (N/A) #
0 # 3780 #
]
[ 1, # 2780 -- LP DEFAULT #
1 # 3780 #
]
[ 1, # 2780 -- CP DEFAULT #
1 # 3780 #
]];
END
ARRAY UBZ$TBL [1:MXDT] S(1);
BEGIN
ITEM UBZ$DEF (0,0,60) = [1, # CONSOLE -- DEFAULT UBZ #
1, # CARD READER #
0, # LINE PRINTER (N/A) #
0, # CARD PUNCH (N/A) #
];
END
ARRAY XBZ$TC$TBL [16:MXTC] S(1);
BEGIN
ITEM XBZ$DEF (0,0,60) = [400, # 2780 -- CON DEFAULT XBZ #
512 # 3780 #
];
END
ARRAY XBZ$STIP$TBL [10:MXSTIP] S(1);
BEGIN
ITEM XBZ$STIP$DEF (0,0,60) = [400, # 2780 -- CON DEFAULT XBZ #
512 # 3780 #
];
END
SWITCH BSCDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$BSC , # , DT ,#
SDT , MB$PARAM , # SDT , TA ,#
ABL , DBZ , # ABL , DBZ ,#
UBZ$UBL , FLOW$PARAM , # UBZ , DBL ,#
UBZ$UBL , FLOW$PARAM , # UBL , XBZ ,#
ILLEGAL , ILLEGAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
ILLEGAL , ILLEGAL , # AB , BR ,#
ILLEGAL , ILLEGAL , # BS , B1 ,#
ILLEGAL , ILLEGAL , # B2 , CI ,#
ILLEGAL , CON$PARAM , # CN , CT ,#
ILLEGAL , ILLEGAL , # DLC , DLTO ,#
ILLEGAL , ILLEGAL , # DLX , EP ,#
ILLEGAL , ILLEGAL , # IN , LI ,#
ILLEGAL , ILLEGAL , # OP , PA ,#
ILLEGAL , ILLEGAL , # PG , PL ,#
GEN$PARAM , ILLEGAL , # PW , SE ,#
ILLEGAL , ILLEGAL , # FA , XLC ,#
ILLEGAL , ILLEGAL , # XLX , XLTO ,#
ILLEGAL , ILLEGAL , # ELO , ELX ,#
ILLEGAL , ILLEGAL , # ELR , EBO ,#
ILLEGAL , ILLEGAL , # EBR , CP ,#
ILLEGAL , ILLEGAL , # IC , OC ,#
ILLEGAL , ILLEGAL , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
ILLEGAL , , # XLY , EOF ,#
, ILLEGAL , # PAD , RTS #
ILLEGAL , ILLEGAL ; # MCI , MLI #
CONTROL EJECT;
# #
# BSCDEV CODE BEGINS HERE #
# #
FOR I=3 STEP 1 UNTIL STWC[0] # CHECK EACH VALUE-DEC ENTRY #
DO
BEGIN
GOTO BSCDJUMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
CON$PARAM:
IF CRNT$DT EQ DT"CON" # IF CURRENT DT IS CONSOLE #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
MB$PARAM:
IF CRNT$DT EQ DT"CP" # IF DT IS CARD PUNCH #
THEN
BEGIN # IF STIP IS 3780 OR UNKNOWN #
IF CRNT$STIP EQ STIP"$3780" OR
CRNT$STIP EQ STIP"UNKNOWN"
THEN
BEGIN # CHECK MODE4/BSC PARAMETER #
MBDEV(STWORD[I],STLNUM[0]);
END
ELSE # STIP MUST BE 2780 #
BEGIN # FLAG ERROR -- INVALID WITH STIP SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END
END
ELSE # DT IS NOT CARD PUNCH #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
SDT:
IF CRNT$DT EQ DT"LP" OR # IF DT IS LINE PRINTER OR #
CRNT$DT EQ DT"CR" OR # CARD READER #
STVALNAM[I] EQ "SDT12" OR # IF USER SDT12 THROUGH SDT15 #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
THEN
BEGIN # CHECK PASSIVE DEVICE PARAMETER#
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS NOT LP OR CR #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ILLEGAL: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS IS AN AUTO-SYNC LINE #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ABL:
IF CRNT$DT EQ DT"CON" # IF CURRNT DT IS CONSOLE #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
DBZ:
IF CRNT$DT NQ DT"CR" # IF DT IS NOT CARD READER #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CARD READER #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
UBZ$UBL: # IF DT IS CONSOLE, CARD READER, LINE #
# PRINTER, OR CARD PUNCH #
IF CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR" OR
CRNT$DT EQ DT"LP" OR CRNT$DT EQ DT"CP"
THEN
BEGIN
IF STKWID[I] EQ KID"UBZ" # IF UBZ PARAMETER #
THEN
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # ELSE, UBL PARAMETER #
IF (CRNT$DT NQ "CON") AND
(STVALNUM[I] GQ 1 AND STVALNUM[I] LQ 7)
THEN
BEGIN # PASSIVE DEVICES: 1 <= UBL <= 7#
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # PARAMETER VALUE OUT OF RANGE #
CHARVAL=XCDD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CHARVAL);
END
END
END
ELSE
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
NEXT$BSC:
END
IF NOT ABL$USED AND # IF ABL NOT SPECIFIED AND #
CRNT$DT EQ DT"CON" # CURRENT DT IS CONSOLE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"ABL",ABL$DEF);
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"DBL",DBL$DEF[CRNT$DT]);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"UBL",UBL$DEF);
END
IF NOT DBZ$USED AND # IF DBZ NOT SPECIFIED AND #
CRNT$DT NQ DT"CR" # CRNT DT IS NOT CARD READER #
THEN
BEGIN
VALUE = 0; # CLEAR VALUE TEMPORARY #
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR UNKNOWN #
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN # DEFAULT DBZ BY TC AND DT #
VALUE = DBZ$DEF[CRNT$TC,CRNT$DT];
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN # IF STIP IS NOT UNKNOWN #
BEGIN # DEFAULT DBZ BY STIP AND DT #
VALUE = DBZ$STIP$DEF[CRNT$STIP,CRNT$DT];
END
END
IF VALUE NQ 0 # IF DEFAULT DBZ WAS DETERMINED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR #
VALUE2 = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FN"DBZ$MSB",VALUE2);
VALUE2 = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FN"DBZ$LSB",VALUE2);
END
END
IF NOT UBZ$USED AND # IF UBZ WAS NOT SPECIFIED #
(CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR")
THEN
BEGIN
DEVFNFV(FN"UBZ",UBZ$DEF[CRNT$DT]); # ENTER DEFAULT UBZ #
END
IF NOT XBZ$USED # IF XBZ NOT SPECIFIED #
THEN
BEGIN
VALUE = 0; # CLEAR VALUE TEMPORARY #
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR UNKNOWN #
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN # DEFAULT XBZ BY TC AND DT #
VALUE = XBZ$DEF[CRNT$TC];
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN # IF STIP IS NOT UNKNOWN #
BEGIN # DEFAULT XBZ BY STIP AND DT #
VALUE = XBZ$STIP$DEF[CRNT$STIP];
END
END
IF VALUE NQ 0 # DEFAULT XBZ VALUE DETERMINED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR #
VALUE2 = B<44,8>VALUE; # MSB OF DEFAULT VALUE #
DEVFNFV(FN"XBZ$MSB",VALUE2);
VALUE2 = B<52,8>VALUE; # LSB OF DEFAULT VALUE #
DEVFNFV(FN"XBZ$LSB",VALUE2);
END
END
IF NOT TA$USED AND # IF TA NOT SPECIFIED AND #
CRNT$DT EQ DT"CP" # DT IS CARD PUNCH #
THEN
BEGIN
IF NOT AUTO$REC AND # IF AUTO-REC LINE AND #
CRNT$STIP EQ STIP"$3780" # STIP IS 3780 #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"TA");
END
END
IF CRNT$MREC NQ 0 # IF MREC VALUE SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR VALUE #
DEVFNFV(FN"MREC",CRNT$MREC);
END
IF CRNT$STIP EQ STIP"$2780" OR # IF STIP OR TC IS 2780 #
CRNT$TC EQ TC"$2780"
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR BCF #
DEVFNFV(FN"BCF",BCF$FLAG);
END
IF CRNT$DT NQ DT"CON" AND
CRNT$DT NQ DT"USER"
THEN # IF CURRENT DEVICE IS A PASSIVE DEVICE #
BEGIN
DEVFNFV(FN"DO$",DO$DEF); # ENTER DEFAULT -DO- INTO ENTRY #
END
RETURN; # **** RETURN **** #
END # BSCDEV #
CONTROL EJECT;
PROC BTCHDEV(BDWORD,BDLNUM);
BEGIN
*IF,DEF,IMS
#
** BTCHDEV - CHECK BATCH DEVICE PARAMETERS.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS THE PARAMETERS THAT ARE USED FOR BATCH OR
* PASSIVE DEVICES.
*
* PROC BTCHDEV(BDWORD,BDLNUM)
*
* ENTRY BDWORD = VALUE DECLARATION ENTRY.
* BDLNUM = CURRENT LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES:
* CASE 1(SDT):
* IF VALUE IS O.K.,
* IF VALUE IS NOT -CCP-,
* MAP NUMERIC VALUE FOR CHARACTER VALUE.
* PUT NUMERIC VALUE INTO DEVICE ENTRY
* IF TIPTYPE IS NOT USER OR UNKNOWN AND
* DT IS NOT USER OR UNKNOWN AND
* SDT VALUE NOT EQUAL SDT12, SDT13, SDT14, OR SDT15
* THEN,
* IF DT AND SDT ARE NOT COMPATIBLE,
* FLAG ERROR -- VALUE INVALID WITH DT SPECIFIED.
* CASE 2(DO):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE IN DEVICE ENTRY.
* IF TIPTYPE IS NOT USER OR UNKNOWN AND
* DT IS NOT USER OR UNKNOWN,
* THEN,
* IF DO VALUE IS NOT UNIQUE FOR DEVICE TYPE,
* FLAG ERROR -- DUPLICATE DO VALUE.
* CASE 3(STREAM):
* IF VALUE IS O.K.,
* IF VALUE IS -AUTOREC-,
* THEN,
* IF LINE IS NOT AUTO-REC,
* FLAG ERROR -- VALUE INVALID FOR FIXED LINES.
* OTHERWISE,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE IN DEVICE ENTRY.
* IF TIPTYPE IS NOT USER OR UNKNOWN AND
* DT IS NOT USER OR UNKNOWN,
* THEN,
* IF VALUE IS NOT UNIQUE FOR DEVICE TYPE,
* THEN,
* FLAG ERROR -- DUPLICATE STREAM VALUE.
* OTHERWISE,
* IF DT IS CARD PUNCH OR PLOTTER,
* IF VALUE IS NOT UNIQUE,
* FLAG ERROR -- DUPLICATE STREAM VALUE.
*
#
*ENDIF
ARRAY BDWORD [0:0] S(1); # VALUE-DECLARATION ENTRY #
BEGIN
ITEM BDKWID U(0,0,9); # KEYWORD I.D. #
ITEM BDVLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM BDNAME C(0,18,7); # CHARACTER STRING VALUE #
ITEM BDVAL (0,18,42); # INTEGER VALUE #
END
ITEM BDLNUM; # STATEMENT SOURCE LINE NUMBER #
#
**** PROC BTCHDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS IF VALUE IS WITH RANGE FOR PARAM #
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
DEF SDT$UNKNOWN # 999 #; # CONSTANT USED IF SDT IS UNK #
ITEM BDSTAT B; # STATUS RETURNED BY NDLCKRG #
ITEM CRNT$SDT; # POINTER TO SDT TABLE OF CRNT VALUE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY FOR STORING WORD COUNT#
ITEM VALUE; # INTEGER VALUE TEMPORARY #
DEF MXSDT # 11 #; # MAXIMUM NUMBER OF SDT-S #
ARRAY SDT$TABLE [1:MXSDT] S(1);
BEGIN
ITEM SDT$NAME C(0,0,7) = ["A6", # SDT VALUES #
"B6",
"A9",
"29",
"26",
"6BIT",
"8BIT",
"SDT12",
"SDT13",
"SDT14",
"SDT15"
];
ITEM SDT$NUMV U(0,42,9) = [0, # A6 - SDT NUMERIC VAL#
1, # B6 #
2, # A9 #
0, # 29 #
1, # 26 #
0, # 6BIT #
1, # 8BIT #
12, # SDT12 #
13, # SDT13 #
14, # SDT14 #
15 # SDT15 #
];
ITEM DT$ALLW U(0,51,9) = [DT"LP", # A6 - DT ALLOWED #
DT"LP", # B6 #
DT"LP", # A9 #
DT"CR", # 29 #
DT"CR", # 26 #
DT"PL", # 6BIT #
DT"PL", # 8BIT #
0, # SDT12 - NOT CHECKED #
0, # SDT13 - NOT CHECKED #
0, # SDT14 - NOT CHECKED #
0 # SDT15 - NOT CHECKED #
];
END
SWITCH BTCHJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , 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 , COLLECT ,#
, , # , DT ,#
SDT$ , , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
DO$ , STREAM , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PRI ,#
, , # P90 , P91 ,#
, , # P92 , P93 ,#
, , # P94 , P95 ,#
, , # P96 , P97 ,#
, , # P98 , P99 ,#
, , # AB , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, ; # PW , SE #
CONTROL EJECT;
# #
# BTCHDEV CODE BEGINS HERE #
# #
GOTO BTCHJUMP[BDKWID[0]]; # GOTO APPROPRIATE PARAGRAPH #
SDT$:
IF NOT BDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF BDNAME[0] NQ "CCP" # IF VALUE IS NOT -CCP- #
THEN
BEGIN
VALUE = SDT$UNKNOWN; # SET VALUE TO UNKNOWN #
FOR I=1 STEP 1 UNTIL MXSDT # SEARCH SDT TABLE FOR VALUE #
DO
BEGIN # IF VALUE FOUND #
IF BDNAME[0] EQ SDT$NAME[I]
THEN
BEGIN
VALUE = SDT$NUMV[I]; # SAVE NUMERICAL VALUE #
CRNT$SDT = I; # SAVE POINTER TO ENTRY #
END
END
IF VALUE NQ SDT$UNKNOWN # IF SDT VALUE WAS FOUND #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR SDT #
DEVFNFV(FN"SDT",VALUE);
IF (CRNT$TIP NQ TIP"USER" AND CRNT$TIP NQ TIP"UNKNOWN") AND
(CRNT$DT NQ DT"USER" AND CRNT$DT NQ DT"UNKNOWN") AND
(VALUE NQ SDT$12 AND VALUE NQ SDT$13 AND
VALUE NQ SDT$14 AND VALUE NQ SDT$15)
THEN # IF TIP IS NOT USER OR UNKNOWN #
BEGIN # AND DT NOT USER OR UNKNOWN #
IF CRNT$DT NQ DT$ALLW[CRNT$SDT]
THEN # IF VALUE NOT ALLOW WITH DT #
BEGIN # FLAG ERROR -- VALUE INVALID WITH DT SPEC#
NDLEM2(ERR138,BDLNUM,BDNAME[0]);
END
END
END
END
END
GOTO NEXT$BTCH;
DO$:
DO$USED = TRUE; # SET -DO- SPECIFIED FLAG #
IF NOT BDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK RANGE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(BDVAL[0],USR$WID1,NUM"DEC",BDSTAT); # CHECK RANGE #
END
ELSE
BEGIN
NDLCKRG(BDKWID[0],BDVAL[0],BDSTAT); # OTHERWISE CHECK NORMAL#
END
# RANGE #
IF BDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"DO$",BDVAL[0]);
IF (CRNT$TIP NQ TIP"USER" AND CRNT$TIP NQ TIP"UNKNOWN") AND
(CRNT$DT NQ DT"USER" AND CRNT$DT NQ DT"UNKNOWN")
THEN # IF TIP IS NOT USER OR UNKNOWN #
BEGIN # AND DT NOT USER OR UNKNOWN #
IF B<BDVAL[0],1>DO$MAP[CRNT$DT] NQ 1
THEN # IF BIT FOR VALUE NOT SET #
BEGIN # SET IT #
B<BDVAL[0],1>DO$MAP[CRNT$DT] = 1;
END
ELSE # -DO- VALUE ALREADY USED #
BEGIN # FLAG ERROR -- DO VALUE NOT UNIQUE FOR DT#
NDLEM2(ERR139,BDLNUM," ");
END
END
END
END
GOTO NEXT$BTCH;
STREAM:
STREAM$USED = TRUE; # SET STREAM SPECIFIED FLAG #
IF NOT BDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF BDNAME[0] NQ "AUTOREC" # IF VALUE IS NOT -AUTOREC- #
THEN
BEGIN # CHECK RANGE #
IF CRNT$TIP EQ TIP"USER" # IF USER DEFINED TIPTYPES #
THEN
BEGIN
USR$RANGE(BDVAL[0],USR$WID1,NUM"DEC",BDSTAT);
END
ELSE
BEGIN
NDLCKRG(BDKWID[0],BDVAL[0],BDSTAT); # CHECK NORMAL RANGE #
END
IF BDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # PUT VALUE IN DEVICE ENTRY #
DEA2[CRNT$DEV + 2] = BDVAL[0];
IF (CRNT$TIP NQ TIP"USER" AND CRNT$TIP NQ TIP"UNKNOWN") AND
(CRNT$DT NQ DT"USER" AND CRNT$DT NQ DT"UNKNOWN")
THEN # IF TIP AND DT IS NOT USER OR #
BEGIN # UNKNOWN #
IF B<BDVAL[0],1>STRM$MAP[CRNT$DT] NQ 1
THEN # IF BIT FOR VALUE NOT SET #
BEGIN # SET IT #
B<BDVAL[0],1>STRM$MAP[CRNT$DT] = 1;
IF CRNT$DT EQ DT"CP" OR # DT IS CP OR PL #
CRNT$DT EQ DT"PL"
THEN
BEGIN # IF BIT FOR VALUE IS NOT SET #
IF B<BDVAL[0],1>CP$PL$MAP NQ 1
THEN
BEGIN # SET IT #
B<BDVAL[0],1>CP$PL$MAP = 1;
END
ELSE # VALUE ALREADY USED FOR CR AND PL #
BEGIN # FLAG ERROR -- PL AND CR STREAM VALUE NOT#
NDLEM2(ERR140,BDLNUM," "); # UNIQUE #
END
END
END
ELSE # STREAM VALUE ALREADY USED #
BEGIN # FLAG ERROR -- STREAM VALUE NOT UNIQUE #
NDLEM2(ERR141,BDLNUM," ");
END
END
END
END
ELSE
BEGIN # VALUE IS -AUTOREC- #
IF NOT AUTO$REC # IF NOT ON AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID ON FIXED#
NDLEM2(ERR113,BDLNUM," "); # CONFIGURATION LINES #
END
END
END
GOTO NEXT$BTCH;
NEXT$BTCH:
RETURN; # **** RETURN **** #
END # BTCHDEV #
CONTROL EJECT;
PROC CONDEV(CDWORD,CDLNUM);
BEGIN
*IF,DEF,IMS
#
** CONDEV - CHECK DEVICE STATEMENT CONSOLE PARAMETERS.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE ONLY ALLOWED FOR CONSOLE
* DEVICES.
*
* PROC CONDEV(CDWORD,CDLNUM)
*
* ENTRY CDWORD = VALUE DECLARATION ENTRY.
* CDLNUM = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS O.K. AND NOT -CCP-,
* SELECT CASE THAT APPLIES,
* CASE 1(AL,BS,B1,B2,CN,CT):
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE IN DEVICE ENTRY.
* SAVE VALUE FOR UNIQUENESS TESTING.
* CASE 2(DLC,CI,DLX,PL,LI,XLY):
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE
* PUT VALUE IN DEVICE ENTRY.
* CASE 3(HN):
* IF VALUE IS NOT -NONE-,
* CHECK IF VALUE IN RANGE.
* IF IN RANGE,
* CHECK IF VALUE IS A LEGAL HOST NODE.
* IF LEGAL HOST I.D.,
* THEN,
* PUT VALUE IN DEVICE ENTRY.
* OTHERWISE,
* FLAG ERROR -- INVALID HN VALUE.
* CASE 4(AUTOCON,AUTOLOG,BR,DLTO,EP,PG,SE):
* IF VALUE IS -YES-
* PUT VALUE IN DEVICE ENTRY.
* CASE 5(PA,OP,IN)
* MAP NUMERIC VALUE FOR CHARACTER VALUE.
* PUT NUMERIC VALUE IN DEVICE ENTRY.
*
#
*ENDIF
ARRAY CDWORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM CDKWID U(0,0,9); # KEYWORD I.D. #
ITEM CDVLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM CDNAME C(0,18,7); # VALUE NAME #
ITEM CDVAL (0,18,42); # VALUE NUMBER #
END
ITEM CDLNUM; # STATEMENT SOURCE LINE NUMBER #
#
**** PROC CONDEV - 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); # CONVERT INTEGER TO DISPLAY CODE #
END
#
****
#
ITEM CDSTAT B; # RETURNED STATUS FROM NDLCKRG #
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM FOUND B; # FLAG INDICATING ENTRY WAS FOUND #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM MAX$ENT; # MAXIMUM ENTRY IN TABLE #
ITEM VALUE1; # INTEGER TEMPORARY #
ITEM VALUE2; # INTEGER TEMPORARY #
DEF MNKWD # 76 #; # MINIMUM KEYWORD I.D. IN TABLE #
DEF MXKWD # 129 #; # MAXIMUM KEYWORD I.D. IN TABLE #
ARRAY FN$TABLE [MNKWD:MXKWD] S(1); # FN VALUE FOR KEYWORDS #
BEGIN
ITEM CD$FN (0,0,60) = [FN"HN", # HN #
, # AUTOLOG #
FN"AUTOCON", # AUTOCON #
FN"PRI", # PRI #
,,,,,,,,,, # P90 THRU P99 #
FN"AB", # AB #
FN"BR", # BR #
FN"BS", # BS #
FN"B1", # B1 #
FN"B2", # B2 #
FN"CI", # CI #
FN"CN", # CN #
FN"CT", # CT #
FN"DLC$MSB", # DLC #
FN"DLTO", # DLTO #
FN"DLX", # DLX #
FN"EP", # EP #
FN"IN", # IN #
FN"LI", # LI #
FN"OP", # OP #
FN"PA", # PA #
FN"PG", # PG #
FN"PL", # PL #
FN"PW", # PW #
FN"SE", # SE #
FN"FA", # FA #
FN"DLC$MSB", # XLC #
FN"DLX", # XLX #
FN"DLTO", # XLTO #
FN"ELO", # ELO #
FN"ELX", # ELX #
FN"ELR", # ELR #
FN"EBO", # EBO #
FN"EBR", # EBR #
FN"CP", # CP #
FN"IC", # IC #
FN"OC", # OC #
FN"LK", # LK #
FN"EBX", # EBX #
,
FN"MC", # MC #
FN"XLY", # XLY #
, # EOF #
, # PAD #
FN"RTS" # RTS #
];
END
DEF MXEBR # 4 #; # MAXIMUM NUMBER OF EBR VALUES #
ARRAY EBR$TABLE [1:MXEBR] S(1);
BEGIN
ITEM EBR$VAL C(0,0,7) = ["NO", # NONE #
"CR", # CARRIAGE RETURN -- EBR VALUES #
"LF", # LINE FEED #
"CL" # CARRIAGE RETURN AND LINE FEED #
];
ITEM EBR$NUMV (0,42,18) = [0, # NONE - NUMERIC VAL #
1, # CARRIAGE RETURN - NUMERIC VAL #
2, # LINE FEED #
3 # CARRIAGE RETURN AND LINE FEED #
];
END
DEF MXELO # 2 #; # MAXIMUM NUMBER OF ELO/EBO VALUES #
ARRAY ELO$TABLE [1:MXELO] S(1);
BEGIN
ITEM ELO$VAL C(0,0,7) = ["EL", # DEFAULT MODE CHAR - ELO VALUES#
"EB" # SAME AS EB #
];
ITEM ELO$NUMV (0,42,18) = [1, # DEFAULT MODE CHAR - NUMERIC #
2, # SAME AS EB #
];
END
DEF MXIN # 3 #; # MAXIMUM NUMBER OF IN VALUES #
ARRAY IN$TABLE [1:MXIN] S(1);
BEGIN
ITEM IN$VAL C(0,0,7) = ["KB", # KEY BOARD -- IN VALUES #
"PT", # PAPER TAPE #
"BK" # BLOCK MODE #
];
ITEM IN$NUMV (0,42,18) = [0, # KEY BOARD -- NUMERICAL VALUE #
1, # PAPER TAPE #
2, # BLOCK MODE #
];
END
DEF MXOP # 3 #; # MAXIMUM NUMBER OF OP VALUES #
ARRAY OP$TABLE [1:MXOP] S(1);
BEGIN
ITEM OP$VAL C(0,0,7) = ["DI", # DISPLAY -- OP VALUES #
"PR", # PRINTER #
"PT" # PAPER TAPE #
];
ITEM OP$NUMV (0,42,18) = [1, # DISPLAY -- NUMERICAL VALUE #
0, # PRINTER #
2 # PAPER TAPE #
];
END
DEF MXPA # 5 #; # MAXIMUM NUMBER OF PA VALUES #
ARRAY PA$TABLE [1:MXPA] S(1);
BEGIN
ITEM PA$VAL C(0,0,7) = ["Z", # ZERO PARITY -- PA VALUES #
"O", # ODD PARITY #
"E", # EVEN PARITY #
"N" # NO PARITY #
,"I" # IGNORE PARITY (ON XPT DELIM) #
];
ITEM PA$NUMV (0,42,18) = [0, # ZERO PARITY -- NUMERICAL VALUE#
1, # ODD PARITY #
2, # EVEN PARITY #
3 # NO PARITY #
,4 # IGNORE PARITY (ON XPT DELIM) #
];
END
BASED ARRAY TABLE [1:1] S(1); # TEMPLATE FOR TABLES(PA,OP,IN) #
BEGIN
ITEM VALUE C(0,0,7); # VALUE CHARACTER STRING #
ITEM NUMV (0,42,18); # NUMERICAL VALUE #
END
SWITCH CONDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , 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 , COLLECT ,#
, , # , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
HN$ , , # HN , AUTOLOG ,#
AUTOCON , , # AUTOCON , PRI ,#
, , # P90 , P91 ,#
, , # P92 , P93 ,#
, , # P94 , P95 ,#
, , # P96 , P97 ,#
, , # P98 , P99 ,#
AB$ , YES$NO , # AB , BR ,#
BS$ , B1$ , # BS , B1 ,#
B2$ , NUMERIC , # B2 , CI ,#
CN$ , CT$ , # CN , CT ,#
DLC$ , DLTO$ , # DLC , DLTO ,#
DLX$ , YES$NO , # DLX , EP ,#
IN$ , NUMERIC , # IN , LI ,#
OP$ , PA$ , # OP , PA ,#
YES$NO , NUMERIC , # PG , PL ,#
, YES$NO , # PW , SE ,#
YES$NO , DLC$ , # FA , XLC ,#
DLX$ , DLTO$ , # XLX , XLTO ,#
ELO$ , ELX$ , # ELO , ELX ,#
EBR$ , ELO$ , # ELR , EBO ,#
EBR$ , YES$NO , # EBR , CP ,#
YES$NO , YES$NO , # IC , OC ,#
YES$NO , EBX$ , # LK , EBX ,#
, , # , MC ,#
DLX$ , , # XLY , EOF ,#
, YES$NO ; # PAD , RTS #
CONTROL EJECT;
PROC T$GROUP(TKWID);
BEGIN
*IF,DEF,IMS
#
**
*
*
* PROCEDURE T$GROUP
*
* THIS PROCEDURE CHECKS IF XL'S AND DL'S ON A DEVICE STATEMENT
* ARE MUTUALLY EXCLUSIVE.
*
* Y.C. YIP 82/10/09
*
*
* ENTRY:
*
* TKWID = KEYWORD ID.
*
* EXIT:
* TKWID REMAIN UNCHANGED.
*
#
*ENDIF
ITEM IS$XL B; # BOOLEAN VARIABLE FOR XL'S #
ITEM TKWID; # KEYWORD ID. #
IF TKWID GR KID"DLX" # IF KEYWORD ID ABOVE DL'S #
THEN
BEGIN
IS$XL = TRUE; # KEYWORD MUST BE XL'S #
END
ELSE
BEGIN
IS$XL = FALSE; # KEYWORD MUST BE DL'S #
END
IF GR$SET EQ X$D$GROUP"NO" # IF NO XL'S OR DL'S ARE MET YET #
THEN
BEGIN
IF IS$XL
THEN
BEGIN # IF KEYWORD IS XL'S #
GR$SET = S"XG"; # SET TO XL'S GROUP #
END
ELSE
BEGIN
GR$SET = S"DG"; # SET TO DL'S GROUP #
END
END
ELSE
BEGIN # IF XL'S OR DL'S WERE USED #
IF (IS$XL AND (GR$SET EQ X$D$GROUP"DG")) OR
( NOT IS$XL AND (GR$SET EQ X$D$GROUP"XG"))
# IF XL'S USED AND THE PARAMETER IS
DL'S OR IF DL'S USED AND THE
PARAMETER IS XL'S. #
THEN
BEGIN
NDLEM2(ERR152,CDLNUM,KWDNAME[TKWID]);
END
END
END # END OF PROC T$GROUP #
CONTROL EJECT;
# #
# CONDEV CODE BEGINS HERE #
# #
IF NOT CDVLERR[0] AND # IF VALUE IS O.K. AND NOT -CCP-#
CDNAME[0] NQ "CCP"
THEN
BEGIN
GOTO CONDJUMP[CDKWID[0]]; # GOTO APPROPRIATE PARAGRAPH #
AB$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -AB- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"AB"] = CDVAL[0]; # SAVE -AB- VALUE #
DEVFNFV(FN"AB",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
BS$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -BS- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"BS"] = CDVAL[0]; # SAVE -BS- VALUE #
DEVFNFV(FN"BS",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
B1$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -B1- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"B1"] = CDVAL[0]; # SAVE -B1- VALUE #
DEVFNFV(FN"B1",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
B2$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -B2- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"B2"] = CDVAL[0]; # SAVE -B2- VALUE #
DEVFNFV(FN"B2",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
CN$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -CN- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"CN"] = CDVAL[0]; # SAVE -CN- VALUE #
DEVFNFV(FN"CN",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
CT$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF -CT- VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"CT"] = CDVAL[0]; # SAVE -CT- VALUE #
DEVFNFV(FN"CT",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
ELX$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"ELX"] = CDVAL[0]; # SAVE -ELX- VALUE #
DEVFNFV(FN"ELX",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
EBX$:
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CEHCK NORMAL RANGE #
END
CHCONTRL(CDKWID[0],CDLNUM,CDSTAT,CDVAL[0]);
# CHECK RANGE OF CONTROL CHARACTER #
IF CDSTAT # IF VALUE IS IN RANGE #
THEN
BEGIN
CRNT$CC[CC"EBX"] = CDVAL[0]; # SAVE -EBX- VALUE #
DEVFNFV(FN"EBX",CDVAL[0]); # MAKE FNFV PAIR ENTRY #
END
GOTO NEXT$CON;
DLC$:
IF CRNT$TIP NQ TIP"USER"
THEN
BEGIN
T$GROUP(CDKWID[0]); # CHECK IF ANY MUTUALLY
EXCLUSIVE KEYWORD WERE USED #
END
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID2,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CHECK NORMAL RANGE #
END
IF CDSTAT # IF -DLC- VALUE IS IN RANGE #
THEN
BEGIN
VALUE1 = CDVAL[0]; # MAKE FNFV PAIR ENTRY FOR #
VALUE2 = B<44,8>VALUE1; # MSB OF -DLC- VALUE #
DEVFNFV(FN"DLC$MSB",VALUE2);
VALUE2 = B<52,8>VALUE1; # LSB OF -DLC- VALUE #
DEVFNFV(FN"DLC$LSB",VALUE2);
END
GOTO NEXT$CON;
DLTO$:
IF CRNT$TIP NQ TIP"USER"
THEN
BEGIN
T$GROUP(CDKWID[0]); # CHECK IF MUTUALLY EXCLUSIVE KEYWORDS #
END
# WERE USED #
GOTO YES$NO;
DLX$:
IF CRNT$TIP NQ TIP"USER"
THEN
BEGIN
T$GROUP(CDKWID[0]); # CHECK IF MUTUALLY EXCLUSIVE KEYWORD ARE
USED #
END
NUMERIC:
IF CDKWID[0] EQ KID"PL" # IF PAGE LENGTH SPECIFIED #
THEN
BEGIN
PL$USED = TRUE; # SET PL USED FLAG #
END
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
IF CDKWID[0] EQ KID"DLX" OR
CDKWID[0] EQ KID"XLX" OR
CDKWID[0] EQ KID"XLY"
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"HEX",CDSTAT);
END
ELSE
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"DEC",CDSTAT);
END
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CHECK NORMAL RANGE #
END
IF CDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(CD$FN[CDKWID[0]],CDVAL[0]);
END
GOTO NEXT$CON;
HN$:
IF CDNAME[0] NQ "NONE" # IF VALUE IS NOT -NONE- #
THEN
BEGIN
HN$USED = TRUE; # SET HN SPECIFIED FLAG #
IF CRNT$TIP EQ TIP"USER" # TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(CDVAL[0],USR$WID1,NUM"DEC",CDSTAT);
END
ELSE
BEGIN
NDLCKRG(CDKWID[0],CDVAL[0],CDSTAT); # CHECK NORMAL RANGE #
END
IF CDSTAT # IF VALUE IS WITHIN RANGE #
THEN # CHECK LLT FOR ENTRY #
BEGIN
FOUND = FALSE; # SEARCH LLT UNTIL FOUND #
FOR I=1 STEP LLTENTSZ WHILE NOT FOUND AND
I LQ LLTENT[0]
DO
BEGIN # IF LOGICAL LINK EXISTS BETWEEN#
IF CDVAL[0] EQ LLTHNID[I] AND # NPU AND HN NODE #
CRNT$NID EQ LLTNID[I]
THEN
BEGIN
FOUND = TRUE; # SET FLAG INDICATING SO #
END
END
IF FOUND # IF ENTRY FOUND #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR HN #
DEVFNFV(FN"HN",CDVAL[0]);
END
ELSE # ENTRY NOT FOUND #
BEGIN # FLAG ERROR -- INVALID HN VALUE #
CTEMP = XCDD(CDVAL[0]);
NDLEM2(ERR136,CDLNUM,CTEMP);
END
END
END
GOTO NEXT$CON;
AUTOCON:
IF CDNAME[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
AUTOCON$FLAG = TRUE; # SET AUTO-CONNECT FLAG #
DEVFNFV(FN"AUTOCON",TRUE); # MAKE FNFV PAIR ENTRY #
END
ELSE # AUTOCON VALUE MUST BE -NO- #
BEGIN
AUTOCON$NO = TRUE; # SET AUTOCON = NO FLAG #
END
GOTO NEXT$CON;
YES: # FOR STAND-ALONE KEYWORDS #
IF CDNAME[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(CD$FN[CDKWID[0]],TRUE);
END
GOTO NEXT$CON;
YES$NO: # FOR KEYWORDS REQUIRING YES/NO VALUE #
IF CDNAME[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # MAKE FNFV PAIR ENTRY WITH VALUE -YES- #
DEVFNFV(CD$FN[CDKWID[0]],TRUE);
END
ELSE # VALUE MUST BE -NO- #
BEGIN # MAKE FNFV PAIR ENTRY WITH VALUE -NO- #
DEVFNFV(CD$FN[CDKWID[0]],FALSE);
END
GOTO NEXT$CON;
PA$:
P<TABLE> =
LOC(PA
$TABLE
); # POINT TO TABLE OF PA VALUES # MAX$ENT = MXPA; # SAVE MAXIMUM ENTRY COUNT #
GOTO MAP$NUM;
OP$:
P<TABLE> =
LOC(OP
$TABLE
); # POINT TO TABLE OF OP VALUES # MAX$ENT = MXOP; # SAVE MAXIMUM ENTRY COUNT #
GOTO MAP$NUM;
IN$:
P<TABLE> =
LOC(IN
$TABLE
); # POINT TO TABLE OF IN VALUES # MAX$ENT = MXIN; # SAVE MAXIMUM ENTRY COUNT #
GOTO MAP$NUM;
ELO$:
P<TABLE> =
LOC(ELO
$TABLE
); # POINT TABLE TO ELO/EBO VALUES # MAX$ENT = MXELO; # SAVE MAXIMUM ENTRY VALUES #
GOTO MAP$NUM;
EBR$:
P<TABLE> =
LOC(EBR
$TABLE
); # POINT TABLE TO EBR VALUES # MAX$ENT = MXEBR; # SAVE MAXIMUM ENTRY VALUES #
MAP$NUM:
FOR I=1 STEP 1 UNTIL MAX$ENT # SEARCH TABLE FOR VALUE #
DO
BEGIN
IF CDNAME[0] EQ VALUE[I] # IF VALUE FOUND #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(CD$FN[CDKWID[0]],NUMV[I]);
END
END
NEXT$CON:
END
RETURN; # **** RETURN **** #
END # CONDEV #
CONTROL EJECT;
PROC COUNT$LK;
BEGIN
*IF,DEF,IMS
#
**
*
*
* COUNT$LK - COUNTS NUMBER OF LOGICAL LINKS TERMINATING AT A NPU.
*
* Y.C. YIP 11/22/1982
*
* THIS PROCEDURE COUNTS NUMBER OF LOGICAL LINKS TERMINATING AT
* THE SAME NPU, AND CHECK IF THE HOST NAMES ARE THE SAME.
*
* PROC COUNT$LK
*
* ENTRY NONE
*
* EXIT NONE
*
* METHOD
*
* THE LOGICAL LINK TABLE IS SEARCHED, THE NUMBER OF LOGICAL
* LINKS TERMINATING AT THE CRNT$NPU IS CHECKED.
* SAVE$ENTRY IS SET TO THE LAST ENTRY OF THE SET OF LOGICAL
* LINKS WITH THE SAME HOST NAME DEFINED ON A PARTICULAR NPU.
* IF ONE OR MORE THAN ONE HOST NAMES ARE DIFFERENT THEN
* SAVE$ENTRY IS SET TO -1. INITIALLY,SAVE$ENTRY IS SET TO
* 0.
*
#
*ENDIF
ITEM I; # LOOP INDIX #
CONTROL EJECT;
# COUNT$LK CODE BEGINS HERE #
LL$CNT = 0; # SETTING LINK COUNT TO 0 #
SAVE$ENTRY = 0; # SETTING SAVE$ENTRY TO 0 #
FOR I=1 STEP 1 UNTIL LLTENT[0]
DO
BEGIN # COUNT NUMBER OF LOGICAL LINKS #
IF LLTNID[I] EQ CRNT$NID # TO THIS NPU #
THEN
BEGIN
IF SAVE$ENTRY EQ 0 # IF FIRST ENTRY #
THEN
BEGIN
SAVE$ENTRY = I; # SAVE ENTRY NUMBER #
END
ELSE # NOT FIRST ENTRY #
BEGIN
IF SAVE$ENTRY NQ NO$MATCH # NO MATCH FLAG IS SET #
THEN
BEGIN
IF LLTHNAME[SAVE$ENTRY] NQ LLTHNAME[I] # IF HOS NAMES DIF#
THEN
BEGIN
SAVE$ENTRY = NO$MATCH;# SET SAVE$ENTRY TO -1 #
END
ELSE
BEGIN
SAVE$ENTRY = I; # SAVE LAST ENTRY #
END
END
END
LL$CNT = LL$CNT + 1; # BUMP LINK COUNT #
LLT$PNTR = I; # SAVE ENTRY #
END
END
END # END OF PROC COUNT$LK #
CONTROL EJECT;
PROC DEVFNFV(FN$VAL,FV$VAL);
BEGIN
*IF,DEF,IMS
#
** DEVFNFV - STORE FNFV PAIR IN DEVICE ENTRY.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE PACKS A GIVEN FNFV PAIR INTO THE CURRENT DEVICE
* ENTRY A INCREMENTS THE FNFV PAIR COUNT.
*
* PROC DEVFNFV(FN$VAL,FV$VAL)
*
* ENTRY FN$VAL = FIELD NUMBER VALUE.
* FV$VAL = VALUE FOR FIELD SPECIFIED BY FN$VAL.
*
* EXIT NONE.
*
* METHOD:
*
* INCREMENT FNFV COUNT IN CURRENT DEVICE ENTRY.
* SET CURRENT STATE TO ZERO.
* ENTER STATE TABLE:
*E
* ***STATE I 0 I 1 I 2 I
* *** I I I I
* STIM ***I STORE FN I STORE FV I EXIT I
* ---------+-----------------+-----------------+-----------------+
* I I I I
* I I I I
* I PUT VAL IN WORD I PUT VAL IN WORD I I
* BIT @ 52 I STATE=STATE+1 I STATE=STATE+1 I EXIT STATE TABLEI
* I BIT=BIT+8 I BIT=BIT+8 I I
* I I I I
* I I I I
* ---------+-----------------+-----------------+-----------------+
* I I I I
* I INCR WORD COUNT I INCR WORD COUNT I I
* I BIT = 0 I BIT = 0 I I
* BIT \ 60 I PUT VAL IN WORD I PUT VAL IN WORD I EXIT STATE TABLEI
* I STATE=STATE+1 I STATE=STATE+1 I I
* I BIT=BIT+8 I BIT=BIT+8 I I
* I I I I
* ---------+-----------------+-----------------+-----------------+
* I PUT FIRST 4 BITSI PUT FIRST 4 BITSI I
* I IN WORD I IN WORD I I
* I INCR WORD COUNT I INCR WORD COUNT I I
* BIT = 56 I BIT = 0 I BIT = 0 I EXIT STATE TABLEI
* I PUT LAST 4 BITS I PUT LAST 4 BITS I I
* I STATE=STATE+1 I STATE=STATE+1 I I
* I BIT=BIT+4 I BIT=BIT+4 I I
* ---------+-----------------+-----------------+-----------------+
*
#
*ENDIF
ITEM FN$VAL; # FIELD NUMBER TO BE STORED #
ITEM FV$VAL; # FIELD VALUE TO BE STORED #
DEF STATE0 # 0 #; # INITIAL STATE -- STORE FN VALUE #
DEF STIM1 # 1 #; # REPRESENTS BIT POSITION @ 52 #
DEF STIM2 # 2 #; # REPRESENTS BIT POSITION \ 60 #
DEF STIM3 # 3 #; # REPRESENTS BIT POSITION = 56 #
STATUS JUMP NEXT$WORD, # INCREMENT TO NEXT WORD BEFORE STORING #
STORE$VAL, # STORE VALUE AND MOVE CRNT BIT POSITION #
STOR$HALF, # STORE HALF VALUE IN CRNT AND NEXT WORD #
EXIT$PROC; # EXIT PROCEDURE -- FNFV PAIR STORED #
ITEM CRNT$STIM; # CURRENT STIMULUS #
ITEM STATE; # CURRENT STATE #
ARRAY FNFV$VALUE [0:0] S(1);
BEGIN # TEMPORARY FOR FN/FV VALUE #
ITEM VALUE (0,0,60);
ITEM FRST$HALF U(0,52,4); # FIRST HALF OF VALUE #
ITEM SCND$HALF U(0,56,4); # SECOND HALF OF VALUE #
END
DEF MXSTATE # 2 #; # MAXIMUM STATE #
DEF MXSTIM # 3 #; # MAXIMUM NUMBER OF STIMULUS #
ARRAY STATE$TABLE [0:MXSTATE,1:MXSTIM] S(1);
BEGIN
ITEM STATE$TBL (0,0,60) =
# STATE * STORE FN * STORE FV * EXIT #
# STIMULUS * * * #
# #
# BIT$POS @ 52 #[[JUMP"STORE$VAL",JUMP"STORE$VAL",JUMP"EXIT$PROC"]
# #
# BIT$POS \ 60 # [JUMP"NEXT$WORD",JUMP"NEXT$WORD",JUMP"EXIT$PROC"]
# #
# BIT$POS = 56 # [JUMP"STOR$HALF",JUMP"STOR$HALF",JUMP"EXIT$PROC"]
];
END
SWITCH FNFVJUMP NEW$WORD, # 0 -- NEXT$WORD #
PUT$VALUE, # 1 -- STORE$VAL #
PUT$HALF, # 2 -- STOR$HALF #
EXIT; # 3 -- EXIT$PROC #
CONTROL EJECT;
# #
# DEVFNFV CODE BEGINS HERE #
# #
STATE = STATE0; # INITIALIZE CURRENT STATE #
VALUE[0] = FN$VAL; # PUT FN VALUE IN TEMPORARY #
# INCREMENT FNFV PAIR COUNT #
DEFNFV[CRNT$DEV + 1] = DEFNFV[CRNT$DEV + 1] + 1;
START$STATE:
IF BIT$POS LQ 52 # IF NET POSITION LESS THAN OR EQUAL TO 56#
THEN
BEGIN
CRNT$STIM = STIM1; # SET CURRENT STIMULUS TO TYPE 1 #
END
ELSE # BIT POS NOT LESS THAN OR EQUAL TO 56 #
BEGIN
IF BIT$POS GQ 60 # IF BIT POS GREATER THAN OR EQUAL TO 60 #
THEN
BEGIN
CRNT$STIM = STIM2; # SET CURRENT STIMULUS TO TYPE 2 #
END
ELSE # BIT POSITION MUST BE 56 #
BEGIN
CRNT$STIM = STIM3; # SET CURRENT STIMULUS TO TYPE 3 #
END
END
# JUMP ACCORDING TO STATE TABLE #
GOTO FNFVJUMP[STATE$TBL[STATE,CRNT$STIM]];
# #
NEW$WORD:
LRWC[1] = LRWC[1] + 1; # INCREMENT WORD COUNT #
LRWORD[LRWC[1]] = 0; # CLEAR THE NEXT WORD #
BIT$POS = 0; # INITIALIZE BIT POSITION #
PUT$VALUE:
B<BIT$POS,8>LRWORD[LRWC[1]] = VALUE[0]; # STORE VALUE #
STATE = STATE + 1; # SET TO NEXT STATE #
VALUE[0] = FV$VAL; # PUT FV VALUE IN TEMPORARY #
BIT$POS = BIT$POS + 8; # RESET CURRENT BIT POSITION #
GOTO START$STATE;
PUT$HALF: # STORE 1ST HALF OF VALUE #
B<BIT$POS,4>LRWORD[LRWC[1]] = FRST$HALF[0];
LRWC[1] = LRWC[1] + 1; # INCREMENT WORD COUNT #
LRWORD[LRWC[1]] = 0; # CLEAR THE NEXT WORD #
BIT$POS = 0; # INITIALIZE BIT POSITION #
B<BIT$POS,4>LRWORD[LRWC[1]] = SCND$HALF[0]; # STORE 2ND HALF #
BIT$POS = 4; # MOVE BIT POSITION #
VALUE[0] = FV$VAL; # PUT FV VALUE IN TEMPORARY #
STATE = STATE + 1; # SET TO NEXT STATE #
GOTO START$STATE;
EXIT:
RETURN; # **** RETURN **** #
END # DEVFNFV #
CONTROL EJECT;
PROC FLOWDEV(FDWORD,FDLNUM);
BEGIN
*IF,DEF,IMS
#
** FLOWDEV - CHECK FLOW CONTROL PARAMETERS ON DEVICE STMT.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS THE PARAMETERS WHICH ARE USED FOR FLOW
* CONTROL.
*
* PROC FLOWDEV(FDWORD,FDLNUM)
*
* ENTRY FDWORD = VALUE DECLARATION ENTRY.
* FDLNUM = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES,
* CASE 1(ABL,DBL,UBL,XBZ):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE INTO DEVICE ENTRY.
* CASE 2(DBZ):
* IF VALUE IS O.K.
* IF DT IS BATCH DEVICE,
* THEN,
* DIVIDE VALUE BY PRU SIZE.
* PUT CONVERTED VALUE INTO DEVICE ENTRY.
* OTHERWISE,
* PUT VALUE INTO DEVICE ENTRY.
* CASE 3(UBZ):
* IF VALUE IS O.K.,
* IF DT IS CONSOLE,
* THEN,
* IF VALUE IS WITHIN 0 AND 2000,
* THEN,
* DIVIDE VALUE BY 200.
* PUT CONVERTED VALUE INTO DEVICE ENTRY.
* OTHERWISE,
* FLAG ERROR -- VALUE OUT OF RANGE.
* OTHERWISE,
* IF DT IS NOT USER OR UNKNOWN,
* THEN,
* IF VALUE IS WITHIN 1 AND 2043,
* THEN,
* DIVIDE VALUE BY PRU SIZE.
* PUT CONVERTED VALUE INTO DEVICE ENTRY.
* OTHERWISE,
* FLAG ERROR -- VALUE OUT OF RANGE.
* OTHERWISE,
* IF VALUE IS LESS THAN 256,
* PUT VALUE INTO DEVICE ENTRY.
*
#
*ENDIF
ARRAY FDWORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM FDKWID U(0,0,9); # KEYWORD I.D. #
ITEM FDVLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM FDNAME C(0,18,7); # CHARACTER STRING VALUE #
ITEM FDVAL U(0,18,42); # INTEGER VALUE #
END
ITEM FDLNUM; # STATEMENT SOURCE LINE NUMBER #
#
**** PROC FLOWDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECK IF VALUE IS WITHIN RANGE #
PROC NDLEM2; # MAKE ENTRY IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO DECIMAL DISPLAY CODE#
FUNC XCHD C(10); # CONERTS INTEGER TO HEX DISPLAY CODE #
END
#
****
#
DEF CONVERT1 # 3 #; # SWITCH VALUE -- CONVERT AND ENTER 1 FNFV#
DEF CONVERT2 # 4 #; # SWITCH VALUE -- CONVERT AND ENTER 2 FNFV#
DEF DIRECT1 # 1 #; # SWITCH VALUE -- DIRECT ENTRY WITH 1 FNFV#
DEF DIRECT2 # 2 #; # SWITCH VALUE -- DIRECT ENTRY WITH 2 FNFV#
DEF $NEXT # 0 #; # SWITCH VALUE -- GOTO NEXT VALUE-DEC #
DEF MAX$PRU # 1920 #; # NUMBER OF CHARACTERS IN THREE PRU-S #
DEF MAX$UBZ$CON # 1950 #; # MAX CHAR COUNT FOR UBZ CONSOLE#
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM FDSTAT B; # STATUS RETURNED BY NDLCKRG #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY -- FOR STORING WC #
ITEM JMP$INDX; # JUMP INDEX FOR SWITCH #
ITEM MAX$SZ; # MAXIMUM SIZE FOR VALUE #
ITEM MULTIPLE; # MULTIPLE BY WHICH TO CALCULATE NEW VALUE#
ITEM VALUE; # INTEGER VALUE TEMPORARY #
ITEM VALUE2; # INTEGER VALUE TEMPORARY #
ARRAY ERROR$WORD [0:0] S(1); # BUFFER WORD FOR ERROR MSG #
BEGIN
ITEM PARAM C(0,0,4) = [" "]; # PARAMETER #
ITEM SLASH C(0,24,1) = ["/"];
ITEM PVALUE C(0,30,5) = [" "]; # VALUE #
END
DEF MNFLW # 68 #;
DEF MXFLW # 73 #;
ARRAY FN$TABLE [MNFLW:MXFLW] S(1);
BEGIN
ITEM FD$FN (0,0,60) = [FN"ABL", # ABL -- FIELD NUMBER #
FN"DBZ$MSB", # DBZ(MSB) #
FN"UBZ", # UBZ #
FN"DBL", # DBL #
FN"UBL", # UBL #
FN"XBZ$MSB", # XBZ(MSB) #
];
END
SWITCH CHKJUMP NEXT, # GO TO NEXT PARAMETER(EXIT) #
D$ENTRY1, # MAKE DIRECT ENTRY W/O CONVERT #
D$ENTRY2, # MAKE DIRECT ENTRY WITH 2 FNFV #
C$ENTRY1, # CONVERT VALUE -- ENTRY 1 FNFV #
C$ENTRY2; # CONVERT VALUE -- ENTRY 2 FNFV #
SWITCH FLOWJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , 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 , COLLECT ,#
, , # , DT ,#
, , # SDT , TA ,#
$ABL , $DBZ , # ABL , DBZ ,#
$UBZ , $DBL , # UBZ , DBL ,#
$UBL , $XBZ , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PRI ,#
, , # P90 , P91 ,#
, , # P92 , P93 ,#
, , # P94 , P95 ,#
, , # P96 , P97 ,#
, , # P98 , P99 ,#
, , # AB , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
, ; # PW , SE #
CONTROL EJECT;
# #
# FLOWDEV CODE BEGINS HERE #
# #
JMP$INDX = $NEXT; # SET JUMP FOR SWITCH TO -NEXT- #
GOTO FLOWJUMP[FDKWID[0]]; # GOTO APPROPRIATE PARAGRAPH #
$ABL:
ABL$USED = TRUE; # SET ABL SPECIFIED FLAG #
IF NOT FDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
JMP$INDX = DIRECT1; # SET JUMP FOR DIRECT ENTRY #
END
GOTO CHECK;
$DBL:
DBL$USED = TRUE; # SET DBL SPECIFIED FLAG #
IF NOT FDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
JMP$INDX = DIRECT1; # SET JUMP FOR DIRECT ENTRY #
END
GOTO CHECK;
$DBZ:
DBZ$USED = TRUE; # SET DBZ SPECIFIED FLAG #
IF NOT FDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$DT EQ DT"CON" OR # IF DT IS CONSOLE, USER, OR #
CRNT$DT EQ DT"USER" OR # UNKNOWN #
CRNT$DT EQ DT"UNKNOWN"
OR CRNT$TIP EQ TIP"USER" # USER DEFINED TIPTYPES #
THEN
BEGIN # SET JUMP TO MAKE DIRECT ENTRY #
JMP$INDX = DIRECT2;
END
ELSE # DT MUST BE A PASSIVE DEVICE #
BEGIN
MULTIPLE = PRU$SZ; # SET MULTIPLE TO PRU SIZE #
MAX$SZ = MAX$PRU; # SET MAXIMUM SIZE FOR VALUE #
JMP$INDX = CONVERT2; # SET JUMP TO CONVERT DBZ VALUE #
END
END
GOTO CHECK;
$UBL:
UBL$USED = TRUE; # SET UBL SPECIFIED FLAG #
IF NOT FDVLERR[0] # VALUE IS O.K. #
THEN
BEGIN
JMP$INDX = DIRECT1; # SET JUMP TO MAKE DIRECT ENTRY #
END
GOTO CHECK;
$UBZ:
UBZ$USED = TRUE; # SET UBZ SPECIFIED FLAG #
IF NOT FDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$DT EQ DT"CON" # IF DT IS A CONSOLE #
AND CRNT$TIP NQ TIP"USER" # AND TIPTYPE NOT USER DEFINED #
THEN
BEGIN
IF FDVAL[0] LS 0 OR
FDVAL[0] GR 2000 # IF VALUE IS OUT OF RANGE #
THEN
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCDD(FDVAL[0]);
NDLEM2(ERR100,FDLNUM,CTEMP);
FDSTAT = FALSE; # SET STATUS TO NO GOOD #
END
ELSE # VALUE IS WITHIN RANGE #
BEGIN
FDSTAT = TRUE; # SET STATUS TO O.K. #
END
MULTIPLE = UBZ$CON; # SET MULTIPLE TO UBZ CONSOLE #
MAX$SZ = MAX$UBZ$CON; # SET MAXIMUM SIZE TO UBZ CON #
JMP$INDX = CONVERT1; # SET JUMP TO CONVERT UBZ VALUE #
END
ELSE # DT IS NOT A CONSOLE #
BEGIN
IF CRNT$DT NQ DT"USER" AND # IF DT IS PASSIVE #
CRNT$DT NQ DT"UNKNOWN"
AND CRNT$TIP NQ TIP"USER" # AND NOT USER DEFINED TIPTYPE #
THEN
BEGIN
IF FDVAL[0] LS 1 OR
FDVAL[0] GR 2043 # IF VALUE IS OUT OF RANGE #
THEN
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCDD(FDVAL[0]);
NDLEM2(ERR100,FDLNUM,CTEMP);
FDSTAT = FALSE; # SET STATUS TO NO GOOD #
END
ELSE # VALUE IS WITHIN RANGE #
BEGIN
FDSTAT = TRUE; # SET STATUS TO O.K. #
END
MULTIPLE = PRU$SZ; # SET MULTIPLE TO PRU SIZE #
MAX$SZ = MAX$PRU; # SET MAXIMUM SIZE IS CHARACTERS#
JMP$INDX = CONVERT1; # SET JUMP TO CONVERT UBZ VALUE #
END
ELSE # DT MUST BE USER OR UNKNOWN #
BEGIN
IF FDVAL[0] LS 256 # VALUE MUST BE LESS THAN 256 #
THEN
BEGIN
JMP$INDX = DIRECT1; # SET JUMP TO MAKE DIRECT ENTRY #
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCDD(FDVAL[0]);
NDLEM2(ERR100,FDLNUM,CTEMP);
END
END
END
END
GOTO CHECK;
$XBZ:
XBZ$USED = TRUE; # SET XBZ SPECIFIED FLAG #
IF NOT FDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
JMP$INDX = DIRECT2; # SET JUMP TO MAKE DIRECT ENTRY #
END
GOTO CHECK;
# #
CHECK:
GOTO CHKJUMP[JMP$INDX]; # JUMP TO TYPE OF ENTRY #
D$ENTRY1: # SPECIFIED ABOVE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(FDVAL[0],USR$WID1,NUM"DEC",FDSTAT);
END
ELSE
BEGIN
NDLCKRG(FDKWID[0],FDVAL[0],FDSTAT); # CHECK FOR NORMAL RANGE #
END
IF FDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FD$FN[FDKWID[0]],FDVAL[0]);
END
GOTO NEXT$FLW;
D$ENTRY2:
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(FDVAL[0],USR$WID2,NUM"DEC",FDSTAT);
END
ELSE
BEGIN
NDLCKRG(FDKWID[0],FDVAL[0],FDSTAT); # CHECK FOR NORMAL RANGE #
END
IF FDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR #
VALUE = FDVAL[0];
VALUE2 = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FD$FN[FDKWID[0]],VALUE2);
VALUE2 = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FD$FN[FDKWID[0]]+1,VALUE2);
END
GOTO NEXT$FLW;
C$ENTRY1:
IF FDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
IF FDVAL[0] LQ MAX$SZ # IF VALUE IS NOT GREATER THAN #
THEN # MAXIMUM SIZE #
BEGIN
VALUE = FDVAL[0]; # SET VALUE TO BE CONVERTED TO #
END # VALUE SPECIFIED #
ELSE # VALUE IS GREATER THAN MAXIMUM #
BEGIN
VALUE = MAX$SZ; # SET VALUE TO BE CONVERTED TO #
END # MAXIMUM SIZE #
VALUE2 = 0;
FOR I=VALUE STEP -MULTIPLE WHILE I GR 0
DO # CONVERT VALUE #
BEGIN
VALUE2 = VALUE2 + 1;
END # MAKE FNFV PAIR ENTRY #
DEVFNFV(FD$FN[FDKWID[0]],VALUE2);
GOTO CHK$WARN;
END
ELSE # VALUE NOT IN RANGE #
BEGIN
GOTO NEXT$FLW;
END
C$ENTRY2:
NDLCKRG(FDKWID[0],FDVAL[0],FDSTAT);
IF FDSTAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
IF FDVAL[0] LQ MAX$SZ # IF VALUE IS NOT GREATER THAN #
THEN # MAXIMUM SIZE #
BEGIN
VALUE = FDVAL[0]; # SET VALUE TO BE CONVERTED TO #
END # VALUE SPECIFIED #
ELSE # VALUE IS GREATER THAN MAXIMUM #
BEGIN
VALUE = MAX$SZ; # SET VALUE TO BE CONVERTED TO #
END # MAXIMUM SIZE #
VALUE2 = 0;
FOR I=VALUE STEP -MULTIPLE WHILE I GR 0
DO # CONVERT VALUE #
BEGIN
VALUE2 = VALUE2 + 1;
END # MAKE FNFV PAIR ENTRIES FOR #
VALUE = B<44,8>VALUE2; # MSB OF CONVERTED VALUE #
DEVFNFV(FD$FN[FDKWID[0]],VALUE);
VALUE = B<52,8>VALUE2; # LSB OF CONVERTED VALUE #
DEVFNFV(FD$FN[FDKWID[0]]+1,VALUE);
GOTO CHK$WARN;
END
ELSE # VALUE NOT IN RANGE #
BEGIN
GOTO NEXT$FLW;
END
CHK$WARN:
IF FDVAL[0] NQ (MULTIPLE * VALUE2)
THEN # IF VALUE IS NOT A MULTIPLE #
BEGIN # FLAG WARNING -- VALUE WAS ROUNDED #
PARAM[0] = KWDNAME[FDKWID[0]]; # PUT PARAMETER NAME AND #
CTEMP = XCDD(MULTIPLE * VALUE2);
PVALUE[0] = C<5,5>CTEMP; # VALUE IN ERROR FILE #
NDLEM2(ERR137,FDLNUM,ERROR$WORD);
END
NEXT$FLW:
RETURN; # **** RETURN **** #
END # FLOWDEV #
CONTROL EJECT;
PROC GENDEV(GDWORD,GDLNUM);
BEGIN
*IF,DEF,IMS
#
** GENDEV - CHECKS GENERAL PARAMETERS ON THE DEVICE STMT.
*
* D.K. ENDO 81/11/20
*
* THE PROCEDURE DOES CHECKING OF PARAMETER THAT ARE COMMON TO ALL
* TIPTYPES.
*
* PROC GENDEV(GDWORD,GDLNUM)
*
* ENTRY GDWORD = VALUE DECLARATION ENTRY.
* GDLNUM = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS O.K.,
* SELECT CASE THAT APPLIES,
* CASE 1(P90,P91,...,P99):
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE INTO DEVICE ENTRY.
* CASE 2(PRI,DI):
* IF VALUE IS -YES-,
* PUT VALUE INTO DEVICE ENTRY.
* CASE 3(PW):
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE
* PUT VALUE INTO DEVICE ENTRY.
* CASE 4(MC):
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE INTO DEVICE ENTRY.
*
#
*ENDIF
DEF HEX$00 # X"00" #; # VALUE HEX 00 #
DEF HEX$03 # X"03" #; # VALUE HEX 03 #
DEF HEX$1F # X"1F" #; # VALUE HEX 1F #
DEF HEX$21 # X"21" #; # VALUE HEX 21 #
DEF HEX$2F # X"2F" #; # VALUE HEX 2F #
DEF HEX$3A # X"3A" #; # VALUE HEX 3A #
DEF HEX$3C # X"3C" #; # VALUE HEX 3C #
DEF HEX$3E # X"3E" #; # VALUE HEX 3E #
DEF HEX$40 # X"40" #; # VALUE HEX 40 #
DEF HEX$5B # X"5B" #; # VALUE HEX 5B #
DEF HEX$60 # X"60" #; # VALUE HEX 60 #
DEF HEX$7B # X"7B" #; # VALUE HEX 7B #
DEF HEX$7E # X"7E" #; # VALUE HEX 7E #
ARRAY GDWORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM GDKWID U(0,0,9); # KEYWORD I.D. #
ITEM GDVLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM GDVAL (0,18,42); # INTEGER VALUE #
ITEM GDNAME C(0,18,7); # CHARACTER VALUE #
END
ITEM GDLNUM; # STATEMENT LINE NUMBER #
#
**** PROC GENDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS IF VALUE IS WITHIN RANGE #
FUNC XCDD C(10); # FUNCTION TO CONVERT BINARY TO DISPLAY #
END
#
****
#
ITEM GDSTAT B; # RETURNED STATUS FROM NDLCKRG #
ITEM ITEMP; # INTEGER TEMPORARY #
SWITCH GENDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , 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 , COLLECT ,#
, , # , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, PRI , # AUTOCON , PRI ,#
USR$PARAM , USR$PARAM , # P90 , P91 ,#
USR$PARAM , USR$PARAM , # P92 , P93 ,#
USR$PARAM , USR$PARAM , # P94 , P95 ,#
USR$PARAM , USR$PARAM , # P96 , P97 ,#
USR$PARAM , USR$PARAM , # P98 , P99 ,#
, , # AB , BR ,#
, , # BS , B1 ,#
, , # B2 , CI ,#
, , # CN , CT ,#
, , # DLC , DLTO ,#
, , # DLX , EP ,#
, , # IN , LI ,#
, , # OP , PA ,#
, , # PG , PL ,#
PW , , # PW , SE #
, , # FA , XLC ,#
, , # XLX , XLTO ,#
, , # ELO , ELX ,#
, , # ELR , EBO ,#
, , # EBR , CP ,#
, , # IC , OC ,#
, , # LK , EBX ,#
, MC , # , MC #
, , # XLY , EOF ,#
, , # PAD , RTS ,#
MCI , MLI ; # MCI , MLI #
CONTROL EJECT;
# #
# GENDEV CODE BEGINS HERE #
# #
IF NOT GDVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
GOTO GENDJUMP[GDKWID[0]];
USR$PARAM: # CHECK RANGE OF USER PRARMETER #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(GDVAL[0],USR$WID1,NUM"HEX",GDSTAT);
END
ELSE
BEGIN
NDLCKRG(GDKWID[0],GDVAL[0],GDSTAT); # CHECK FOR NORMAL RANGE#
END
IF GDSTAT # IF WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(GDKWID[0]+10,GDVAL[0]);
END
GOTO NEXT$GEN;
PRI:
IF GDNAME[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"PRI",TRUE);
END
GOTO NEXT$GEN;
$DI:
IF GDNAME[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
DEST[CRNT$DEV + 2] = TRUE; # SET STATUS FLAG IN ENTRY #
END
GOTO NEXT$GEN;
PW:
IF GDNAME[0] NQ "CCP" # IF VALUE IS NOT -CCP- #
THEN
BEGIN # CHECK RAMGE FOR PW VALUE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(GDVAL[0],USR$WID1,NUM"DEC",GDSTAT);
END
ELSE
BEGIN
NDLCKRG(GDKWID[0],GDVAL[0],GDSTAT); # CHECK FOR NORMAL #
# RANGE #
IF GDSTAT # IF CHECK STATUS IS O.K. #
THEN
BEGIN
IF CRNT$TC EQ TC"$3780" OR # FURTHER CHECK FOR 3780 #
CRNT$TC EQ TC"$2780" # OR 2780 #
THEN
BEGIN
IF CRNT$DT EQ DT"LP" # IF LINEPRINTER #
THEN
BEGIN
IF GDVAL[0] LS MPW$2780$LP OR
GDVAL[0] GR MXPW$2780$LP
THEN
BEGIN
NDLEM2(ERR100,STLNUM[0], XCDD(GDVAL[0]));
GDSTAT = FALSE;
END
END
END
END
END
IF GDSTAT # IF WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"PW",GDVAL[0]);
END
END
GOTO NEXT$GEN;
MCI:
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(GDVAL[0],USR$WID1,NUM"DEC",GDSTAT);
END
ELSE
BEGIN
NDLCKRG(GDKWID[0],GDVAL[0],GDSTAT); # CHECK FOR NORMAL RANGE#
END
IF GDSTAT # IF WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"MCI",GDVAL[0]);
END
GOTO NEXT$GEN;
MLI:
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(GDVAL[0],USR$WID1,NUM"DEC",GDSTAT);
END
ELSE
BEGIN
NDLCKRG(GDKWID[0],GDVAL[0],GDSTAT); # CHECK FOR NORMAL RANGE#
END
IF GDSTAT # IF WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"MLI",GDVAL[0]);
END
GOTO NEXT$GEN;
MC:
IF CRNT$TIP EQ TIP"USER" # IF TIPTYE IS USER #
THEN
BEGIN
USR$RANGE(GDVAL[0],USR$WID1,NUM"HEX",GDSTAT);
END
ELSE # IF OTHER TIPTYPE #
BEGIN
GDSTAT = TRUE; # PRSET GDSATT TO TRUE #
IF NOT ((GDVAL[0] EQ HEX$00) OR
(GDVAL[0] GQ HEX$03 AND GDVAL[0] LQ HEX$1F) OR
(GDVAL[0] GQ HEX$21 AND GDVAL[0] LQ HEX$2F) OR
(GDVAL[0] GQ HEX$3A AND GDVAL[0] LQ HEX$3C) OR
(GDVAL[0] GQ HEX$3E AND GDVAL[0] LQ HEX$40) OR
(GDVAL[0] GQ HEX$5B AND GDVAL[0] LQ HEX$60) OR
(GDVAL[0] GQ HEX$7B AND GDVAL[0] LQ HEX$7E)
)
THEN
BEGIN
GDSTAT = FALSE; # SET GDSTAT FLAG TO FALSE #
NDLEM2(ERR100,STLNUM[0],XCHD(GDVAL[0])); # PASS ERROR #
END
END
IF GDSTAT # IF STATUS IS O.K. #
THEN
BEGIN # PUT VALUE IN DEVICE ENTRY #
DEVFNFV(FN"MC",GDVAL[0]);
END
GOTO NEXT$GEN;
NEXT$GEN:
END
RETURN; # **** RETURN **** #
END # GENDEV #
CONTROL EJECT;
PROC HSPDEV;
BEGIN
*IF,DEF,IMS
#
** HSPDEV - CHECK DEVICE STATEMENT FOR PARAMETERS LEGAL FOR HASP TIP.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETER TO BE VALID FOR HASP DEVICES.
*
* PROC HSPDEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(DI,PRI,PW,P90,P91,...,P99):
* CHECK GENERAL DEVICE PARAMETER.
* CASE 2(UBZ,DBL,XBZ):
* CHECK FLOW CONTROL PARAMETER.
* CASE 3(HN,AUTOLOG,AUTOCON,B1,B2,CN,CT,PG,PL):
* IF DT IS CONSOLE,
* THEN,
* CHECK CONSOLE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER INVALID WITH DT SPECIFIED.
* CASE 4(SDT):
* IF DT IS NOT CONSOLE OR CARD PUNCH
* OR SDT VALUE IS SDT12, SDT13, SDT14 OR SDT15,
* THEN,
* CHECK BATCH DEVICE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER INVALID WITH DT SPECIFIED.
* CASE 5(DO,STREAM):
* IF DT IS NOT CONSOLE,
* THEN,
* CHECK BATCH DEVICE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH DT SPECIFIED.
* CASE 6(TA,AL,BR,BS,CI,DLC,DLTO,DLX,EP,IN,LI,OP,PA,SE,XLY):
* FLAG ERROR -- PARAMETER NOT ALLOWED.
* CASE 7(ABL):
* IF DT IS CONSOLE,
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH DT SPECIFIED.
* CASE 8(DBZ):
* IF DT IS NOT CARD READER,
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH DT SPECIFIED.
* CASE 9(UBL):
* IF DT IS NOT CONSOLE AND WITHIN RANGE 1-7
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH DT SPECIFIED.
* IF DT IS CONSOLE,
* THEN,
* IF ABL WAS NOT SPECIFIED,
* DEFAULT ABL VALUE INTO DEVICE ENTRY.
* OTHERWISE,
* IF DO WAS NOT SPECIFIED,
* IF THIS IS FIRST DEVICE FOR THIS DT
* THEN,
* DEFAULT DO VALUE BY ONE.
* SET BIT IN BIT MAP FOR DO VALUE.
* OTHERWISE,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF STREAM WAS NOT SPECIFIED AND LINE IS NOT AUTO-REC,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF DBL,UBZ WAS NOT SPECIFIED,
* DEFAULT VALUE BY DT.
* IF UBL WAS NOT SPECIFIED AND DT IS CONSOLE OR CARD READER,
* DEFAULT UBL VALUE BY DT.
* IF DBZ WAS NOT SPECIFIED AND DT IS NOT CARD READER,
* DEFAULT DBZ VALUE BY DT.
* IF XBZ WAS NOT SPECIFIED,
* DEFAULT XBZ VALUE INTO DEVICE ENTRY.
* CHECK IS B1,B2,CN,CT ARE UNIQUE,
* IF NOT UNIQUE,
* FLAG ERROR -- B1,B2,CN,CT MUST BE UNIQUE.
*
#
*ENDIF
#
**** PROC HSPDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO CHARACTER #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF B1$DEF # X"3A" #; # DEFAULT B1 VALUE #
DEF B2$DEF # X"29" #; # DEFAULT B2 VALUE #
DEF CN$DEF # X"28" #; # DEFAULT CN VALUE #
DEF CT$DEF # X"25" #; # DEFAULT CT VALUE #
DEF DO$DEF # 1 #; # DEFAULT -DO- VALUE #
DEF STRM$DEF # 1 #; # DEFAULT STREAM VALUE #
DEF UBL$DEF # 7 #; # DEFAULT UBL VALUE #
DEF XBZ$DEF # 400 #; # DEFAULT XBZ VALUE #
DEF PL$DEF # 64 #; # DEFAULT PAGE LENGTH VALUE #
ITEM CHARVAL C(10); # SCRATCH CHARACTER VARIABLE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # INTEGER VALUE TEMPORARY #
DEF MXDT # 5 #;
ARRAY FC$DEF$TABLE [1:MXDT] S(2);
BEGIN
ITEM DBL$DEF (0,0,30) = [2, # CONSOLE -- DBL DEFAULT #
2, # CARD READER #
1, # LINE PRINTER #
1, # CARD PUNCH #
1, # PLOTTER #
];
ITEM DBZ$DEF (0,30,30) = [400, # CONSOLE -- DEFAULT DBZ #
0, # CARD READER (N/A) #
1, # LINE PRINTER #
1, # CARD PUNCH #
1, # PLOTTER #
];
ITEM UBZ$DEF (1,30,30) = [1, # CONSOLE -- UBZ DEFAULT #
1, # CARD READER #
2, # LINE PRINTER #
2, # CARD PUNCH #
2 # PLOTTER #
];
END
SWITCH HSPDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$HSP , # , DT ,#
SDT , ILLEGAL , # SDT , TA ,#
ABL , DBZ , # ABL , DBZ ,#
UBZ$UBL , FLOW$PARAM , # UBZ , DBL ,#
UBZ$UBL , FLOW$PARAM , # UBL , XBZ ,#
ORDINAL , ORDINAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
ILLEGAL , ILLEGAL , # AB , BR ,#
ILLEGAL , CON$PARAM , # BS , B1 ,#
CON$PARAM , ILLEGAL , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
ILLEGAL , ILLEGAL , # DLC , DLTO ,#
ILLEGAL , ILLEGAL , # DLX , EP ,#
ILLEGAL , ILLEGAL , # IN , LI ,#
ILLEGAL , ILLEGAL , # OP , PA ,#
CON$PARAM , PL$PARAM , # PG , PL ,#
GEN$PARAM , ILLEGAL , # PW , SE ,#
ILLEGAL , ILLEGAL , # FA , XLC ,#
ILLEGAL , ILLEGAL , # XLX , XLTO ,#
ILLEGAL , ILLEGAL , # ELO , ELX ,#
ILLEGAL , ILLEGAL , # ELR , EBO ,#
ILLEGAL , ILLEGAL , # EBR , CP ,#
ILLEGAL , ILLEGAL , # IC , OC ,#
CON$PARAM , ILLEGAL , # LK , EBX ,#
CON$PARAM , GEN$PARAM , # HD , MC ,#
ILLEGAL , , # XLY , EOF ,#
, ILLEGAL , # PAD , RTS #
ILLEGAL , ILLEGAL ; # MCI , MLI ,#
CONTROL EJECT;
# #
# HSPDEV CODE BEGINS HERE #
# #
CRNT$CC[CC"CN"] = CN$DEF; # CN -- DEFAULT CONTROL CHAR #
CRNT$CC[CC"B1"] = B1$DEF; # B1 #
CRNT$CC[CC"B2"] = B2$DEF; # B2 #
CRNT$CC[CC"CT"] = CT$DEF; # CT #
FOR I=3 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE-DECLARATION ENTRY #
BEGIN
GOTO HSPDJUMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
CON$PARAM:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
PL$PARAM:
IF CRNT$DT EQ DT"CON" OR # IF DT IS CONSOLE #
CRNT$DT EQ DT"LP" # OF DT IS LINEPRINTER #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
SDT:
IF(CRNT$DT NQ DT"CON" AND # IF DT IS NOT CON OR CP #
CRNT$DT NQ DT"CP" ) OR
( STVALNAM[I] EQ "SDT12" OR # IF SDT12 - SDT15 USED #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
)
THEN
BEGIN # CHECK BATCH DEVICE #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CONSOLE OR CARD PUNCH #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ORDINAL:
IF CRNT$DT NQ DT"CON" # IF DT IS NOT CONSOLE #
THEN
BEGIN # CHECK BATCH PARAMETER #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CONSOLE #
BEGIN
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ILLEGAL: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ABL:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
DBZ:
IF CRNT$DT NQ DT"CR" # IF DT IS NOT CARD READER #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CARD READER #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
UBZ$UBL: # IF DT IS CONSOLE, CARD READER, LINE #
# PRINTER, CARD PUNCH, OR PLOTTER #
IF CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR" OR
CRNT$DT EQ DT"LP" OR CRNT$DT EQ DT"CP" OR
CRNT$DT EQ DT"PL"
THEN
BEGIN
IF STKWID[I] EQ KID"UBZ" # IF UBZ PARAMETER #
THEN
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # ELSE, UBL PARAMETER #
IF CRNT$DT EQ DT"CON"
THEN
BEGIN # CONSOLE DEVICES 1 <= UBL <=31#
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # PASSIVE DEVICE UBL #
IF (STVALNUM[I] GQ 1 AND STVALNUM[I] LQ 7)
THEN # 1<= UBL <= 7 #
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN
CHARVAL=XCDD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CHARVAL);
END
END
END
END
ELSE
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
NEXT$HSP:
END
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN
IF NOT AUTO$REC
THEN # IF THIS IS NOT ON AN AUTO-REC LINE #
BEGIN
DEA2[CRNT$DEV + 2] = STRM$DEF; # DEFAULT STREAM VALUE FOR CON#
END
IF NOT ABL$USED # IF ABL NOT SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"ABL",ABL$DEF);
END
END
ELSE # DT IS PASSIVE DEVICE #
BEGIN
IF NOT DO$USED # IF -DO- NOT SPECIFIED #
THEN
BEGIN
IF FIRST$DT[CRNT$DT] # IF FIRST DEVICE FOR THIS DT #
THEN
BEGIN
DEVFNFV(FN"DO$",DO$DEF); # PUT DEFAULT DO VALUE FOR DEV #
FIRST$DT[CRNT$DT] = FALSE; # CLEAR FLAG FOR DT #
END
ELSE # NOT FIRST DEVICE FOR THIS DT #
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"DO");
END
END
IF NOT STREAM$USED AND # IF STREAM NOT SPECIFIED #
NOT AUTO$REC # AND NOT AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"STREAM");
END
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"DBL",DBL$DEF[CRNT$DT]);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"UBL",UBL$DEF);
END
IF NOT DBZ$USED AND # IF DBZ NOT SPECIFIED AND #
CRNT$DT NQ DT"CR" # DT IS NOT A CARD READER #
THEN
BEGIN
VALUE = DBZ$DEF[CRNT$DT];
J = B<44,8>VALUE; # MSB OF DEFAULT DBZ #
DEVFNFV(FN"DBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF DEFAULT DBZ #
DEVFNFV(FN"DBZ$LSB",J);
END
IF NOT UBZ$USED AND # IF UBZ NOT SPECIFIED #
(CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR")
THEN
BEGIN
DEVFNFV(FN"UBZ",UBZ$DEF[CRNT$DT]);
END
IF NOT XBZ$USED # IF XBZ NOT SPECIFIED #
THEN
BEGIN
VALUE = XBZ$DEF;
J = B<44,8>VALUE; # MSB OF DEFAULT XBZ #
DEVFNFV(FN"XBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF DEFAULT XBZ #
DEVFNFV(FN"XBZ$LSB",J);
END
IF NOT PL$USED AND # IF PL NOT SPECIFIED #
CRNT$DT EQ DT"LP" # DEVICE IS LINEPRINTER #
THEN
BEGIN
DEVFNFV(FN"PL",PL$DEF);
END
FOR I=CC"CN" STEP 1 UNTIL CC"CT" - 1
DO # CHECK UNIQUENESS OF CHARS #
BEGIN
FOR J=I+1 STEP 1 UNTIL CC"CT"
DO
BEGIN
IF CRNT$CC[I] EQ CRNT$CC[J]
THEN
BEGIN # FLAG ERROR -- VALUE IS NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
END
RETURN; # **** RETURN **** #
END # HSPDEV #
CONTROL EJECT;
PROC MBDEV(MBWORD,MBLNUM);
BEGIN
*IF,DEF,IMS
#
** MBDEV - CHECK MODE4/BSC PARAMETER FOR DEVICE STATEMENT.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE COMMON TO MODE4 AND HASP
* DEVICES.
*
* PROC MBDEV(MBWORD,MBLNUM)
*
* ENTRY MBWORD = VALUE DECLARATION ENTRY.
* MBLNUM = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS O.K.
* IF VALUE IS -AUTOREC-
* THEN,
* IF LINE IS NOT AUTO-REC,
* FLAG ERROR -- VALUE INVALID ON FIXED LINES.
* OTHERWISE,
* IF DT IS USER OR UNKNOWN,
* THEN,
* PUT VALUE IS DEVICE ENTRY.
* OTHERWISE,
* IF TIPTYPE IS BSC,
* THEN,
* IF VALUE IS WITHIN RANGE,
* THEN,
* PUT VALUE IS DEVICE ENTRY.
* OTHERWISE,
* FLAG ERROR -- VALUE OUT OF RANGE.
* OTHERWISE,
* IF TIPTYPE IS MODE4,
* THEN,
* IF STIP IS M4A,
* THEN,
* IF VALUE IS 60 HEX,
* THEN,
* PUT VALUE IN DEVICE ENTRY.
* OTHERWISE,
* FLAG ERROR -- VALUE OUT OF RANGE.
* OTHERWISE,
* IF STIP IS M4C,
* THEN,
* IF VALUE IS IN RANGE,
* THEN,
* PUT VALUE IN DEVICE ENTRY.
* IF LINE IS NOT AUTO-REC
* CHECK IF VALUE IS UNIQUE.
* IF NOT UNIQUE,
* FLAG ERROR -- DUPLICATE TA VALUE.
* OTHERWISE,
* FLAG ERROR -- VALUE OUT OF RANGE.
* OTHERWISE,
* PUT VALUE IN DEVICE ENTRY.
* OTHERWISE,
* IF TIPTYPE IS 3270,
* THEN
* IF VALUE IS WITHIN RANGE,
* THEN
* PUT VALUE IN DEVICE ENTRY.
* OTHERWISE,
* PUT VALUE IN DEVICE ENTRY.
*
#
*ENDIF
ARRAY MBWORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM MBKWID U(0,0,9); # KEYWORD I.D. #
ITEM MBVLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM MBNAME C(0,18,7); # CHARACTER VALUE #
ITEM MBVAL (0,18,42); # INTEGER VALUE #
END
ITEM MBLNUM; # STATEMENT SOURCE LINE NUMBER #
#
**** PROC MBDEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
FUNC XCHD C(10); # CONVERTS INTEGER TO HEX DISPLAY CODE #
END
#
****
#
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM ITEMP; # INTEGER TEMPORARY #
CONTROL EJECT;
# #
# MBDEV CODE BEGINS HERE #
# #
TA$USED = TRUE; # SET TA SPECIFIED FLAG #
IF NOT MBVLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF MBNAME[0] NQ "AUTOREC" # IF VALUE IS NOT -AUTOREC- #
THEN
BEGIN
IF CRNT$DT NQ DT"USER" AND # IF DT IS NOT USER OR UNKNOWN #
CRNT$DT NQ DT"UNKNOWN"
THEN
BEGIN
IF CRNT$TIP EQ TIP"BSC" # IF TIPTYPE IS -BSC- #
THEN
BEGIN
IF MBVAL[0] GQ 2 AND # IF TA VALUE IS WITHIN RANGE #
MBVAL[0] LQ 3
THEN
BEGIN # MAKE ENTRY IN LINE RECORD #
DEA2[CRNT$DEV + 2] = MBVAL[0];
END
ELSE # TA VALUE NOT IN RANGE FOR BSC #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(MBVAL[0]);
NDLEM2(ERR100,MBLNUM,CTEMP);
END
END
ELSE IF CRNT$TIP EQ TIP"MODE4"
THEN
BEGIN # IF STIP IS -M4A- #
IF CRNT$STIP EQ STIP"M4A"
THEN
BEGIN # IF TA IS CORRECT VALUE #
IF MBVAL[0] EQ X"60"
THEN
BEGIN # PUT VALUE IN LINE RECORD #
DEA2[CRNT$DEV + 2] = MBVAL[0];
END
ELSE # TA VALUE NOT VALID #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(MBVAL[0]);
NDLEM2(ERR100,MBLNUM,CTEMP);
END
END
ELSE # STIP IS NOT -M4A- #
BEGIN # IF STIP IS -M4C- #
IF CRNT$STIP EQ STIP"M4C"
THEN
BEGIN # IF VALUE IS WITHIN RANGE #
IF MBVAL[0] GQ X"61" AND
MBVAL[0] LQ X"6F"
THEN
BEGIN # PUT VALUE IN LINE RECORD #
DEA2[CRNT$DEV + 2] = MBVAL[0];
IF NOT AUTO$REC # IF NOT AUTO-REC LINE #
THEN # CHECK FOR UNIQUE TA #
BEGIN
ITEMP = MBVAL[0] - X"61";
IF B<ITEMP,1>TA$MAP NQ 1
THEN
BEGIN
B<ITEMP,1>TA$MAP = 1;
END
ELSE # TA VALUE NOT UNIQUE #
BEGIN # FLAG ERROR -- TA NOT UNIQUE #
NDLEM2(ERR143,MBLNUM," ");
END
END
END
ELSE # VALUE IS NOT WITHIN RANGE #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
CTEMP = XCHD(MBVAL[0]);
NDLEM2(ERR100,MBLNUM,CTEMP);
END
END
ELSE # STIP MUST BE UNKNOWN #
BEGIN # PUT VALUE IN LINE RECORD #
DEA2[CRNT$DEV + 2] = MBVAL[0];
END
END
END
ELSE IF CRNT$TIP EQ TIP"$3270"
THEN # TIPTYPE IS 3270 #
BEGIN
IF MBVAL[0] GQ 0 AND MBVAL[0] LQ X"1F"
THEN # IF VALUE IS WITHIN RANGE #
BEGIN
DEA2[CRNT$DEV+2] = MBVAL[0]; # STORE THE VALUE #
END
ELSE # VALUE IS OUT OF RANGE #
BEGIN
NDLEM2(ERR100,MBLNUM,XCHD(MBVAL[0]));
END
END
ELSE # TIPTYPE IS USER OR UNKNOWN #
BEGIN
DEA2[CRNT$DEV + 2] = MBVAL[0];
END
END
ELSE # DT IS USER OR UNKNOWN #
BEGIN
DEA2[CRNT$DEV + 2] = MBVAL[0];
END
END
ELSE # VALUE IS -AUTOREC- #
BEGIN
IF NOT AUTO$REC # IF NOT AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- VAL INVALID ON FIXED LINES#
NDLEM2(ERR113,MBLNUM," ");
END
END
END
RETURN; # **** RETURN **** #
END # MBDEV #
CONTROL EJECT;
PROC MD4DEV;
BEGIN
*IF,DEF,IMS
#
** MD4DEV - CHECK DEVICE STATEMENT PARAMETERS LEGAL FOR MODE4.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECK PARAMETER TO BE ALLOW FOR MODE4 DEVICES.
*
* PROC MD4DEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(PRI,DI,PW,P90,P91,...,P99):
* CHECK GENERAL PARAMETER.
* CASE 2(TA):
* CHECK MODE4/BSC PARAMETER.
* CASE 3(DBL,XBZ):
* CHECK FLOW CONTROL PARAMETER.
* CASE 4(B1,B2,CN,CT,PG,PL,HN,AUTOLOG,AUTOCON):
* IF DT IS CONSOLE,
* THEN,
* CHECK CONSOLE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAM NOT ALLOWED WITH DT SPECIFIED.
* CASE 5(SDT):
* IF DT IS LINEPRINTER OR SDT VALUE SPECIFIED
* IS SDT12, SDT13, SDT14, SDT15,
* THEN,
* CHECK BATCH DEVICE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAM NOT ALLOWED WITH DT SPECIFIED.
* CASE 6(DO):
* IF DT IS LINE PRINTER,
* THEN,
* IF STIP IS M4C OR UNKNOWN,
* THEN,
* CHECK BATCH DEVICE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAM INVALID WITH STIP SPECIFIED.
* OTHERWISE,
* IF DT IS CARD READER,
* THEN,
* FLAG ERROR -- PARAM INVALID WITH M4A DEVICES.
* OTHERWISE,
* FLAG ERROR -- PARAM INVALID WITH CONSOLE DEVICES.
* CASE 7(ABL):
* IF DT IS CONSOLE,
* THEN,
* CHECK FLOW CONTROL PARAMETER
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 8(DBZ):
* IF DT IS NOT CARD READER,
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 9(UBZ):
* IF DT IS CONSOLE OR CARD READER OR LINEPRINTER,
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 10(UBL):
* IF DT IS NOT CONSOLE AND UBL WITHIN RANGE 1-7,
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETERS.
* IF DBL NOT SPECIFIED,
* DEFAULT VALUE BY DEVICE TYPE.
* IF UBL NOT SPECIFIED,
* DEFAULT UBL VALUE.
* IF DT IS CON AND ABL WAS NOT SPECIFIED,
* DEFAULT ABL VALUE.
* IF DT IS NOT CARD READER AND DBZ WAS NOT SPECIFIED,
* IF TC IS NOT USER OR UNKNOWN,
* THEN,
* DEFAULT VALUE BY DT AND TC.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* DEFAULT VALUE BY DT AND STIP.
* IF DT IS NOT LINE PRINTER AND UBZ WAS NOT SPECIFIED,
* IF TC IS NOT USER OR UNKNOWN,
* THEN,
* DEFAULT VALUE BY DT AND TC.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* DEFAULT VALUE BY DT AND STIP.
* IF XBZ WAS NOT SPECIFIED,
* IF TC IS NOT USER OR UNKNOWN,
* THEN
* DEFAULT VALUE BY DT AND TC.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* DEFAULT VALUE BY DT AND STIP.
* IF DO WAS NOT SPECIFIED AND DT IS NOT CONSOLE,
* IF STIP IS M4A OR UNKNOWN,
* THEN,
* DEFAULT DO VALUE TO ONE.
* OTHERWISE,
* IF THIS DEVICE IS FIRST LINE PRINTER,
* THEN,
* DEFAULT DO VALUE TO ONE.
* OTHERWISE,
* FLAG ERROR -- REQUIRED PARAMETER MISSING
* IF TA WAS NOT SPECIFIED AND LINE IS NOT AUTO-REC,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* CHECK CN,B1,B2,CT TO BE UNIQUE.
* IF NOT UNIQUE,
* FLAG ERROR -- CN,B1,B2,CT MUST BE UNIQUE.
*
#
*ENDIF
#
**** PROC MD4DEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO CHARACTER #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF B1$DEF # X"3A" #; # DEFAULT B1 VALUE #
DEF B2$DEF # X"29" #; # DEFAULT B2 VALUE #
DEF CN$DEF # X"28" #; # DEFAULT CN VALUE #
DEF CT$DEF # X"25" #; # DEFAULT CT VALUE #
DEF DO$DEF # 1 #; # DEFAULT DO VALUE #
DEF UBL$DEF # 7 #; # DEFAULT UBL VALUE #
DEF PL$DEF # 64 #; # DEFAULT PL VALUE #
ITEM CHARVAL C(10); # SCRATCH CHARACTER VARIABLE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # INTEGER VALUE TEMPORARY #
DEF MXDT # 3 #;
ARRAY DBL$TABLE [1:MXDT] S(1);
BEGIN
ITEM DBL$DEF (0,0,60) = [2, # CONSOLE -- DEFAULT DBL #
2, # CARD READER #
1 # LINE PRINTER #
];
END
DEF MXTC # 15 #;
ARRAY DBZ$TC$TBL [10:MXTC,1:MXDT] S(1);
BEGIN
ITEM DBZ$TC$DEF (0,0,60) = [[1040, # 200UT -- CONSOLE #
1280, # 714X #
1280, # 711 #
1280, # 714 #
0, # HPRE(N/A) #
1040 # 734 #
]
[ 0, # 200UT -- CARD READER(N/A)#
0, # 714X(N/A) #
0, # 711(N/A) #
0, # 714(N/A) #
0, # HPRE(N/A) #
0 # 734(N/A) #
]
[ 1, # 200UT -- LINE PRINTER #
1, # 714X #
0, # 711(N/A) #
1, # 714 #
0, # HPRE(N/A) #
1 # 734 #
]];
END
ARRAY UBZ$TC$TBL [10:MXTC,1:MXDT] S(1);
BEGIN
ITEM UBZ$TC$DEF (0,0,60) = [[1, # 200UT -- CONSOLE #
1, # 714X #
1, # 711 #
1, # 714 #
0, # HPRE(N/A) #
1 # 734 #
]
[1, # 200UT -- CARD READER #
0, # 714X(N/A) #
0, # 711(N/A) #
0, # 714(N/A) #
0, # HPRE(N/A) #
1 # 734 #
]
[0, # 200UT(N/A) -- LINE PRINTER #
0, # 714X(N/A) #
0, # 711(N/A) #
0, # 714(N/A) #
0, # HPRE(N/A) #
0 # 734(N/A) #
]];
END
ARRAY XBZ$TC$TBL [10:MXTC,1:MXDT] S(1);
BEGIN
ITEM XBZ$TC$DEF (0,0,60) = [[1040, # 200UT -- CONSOLE #
1280, # 714X #
1280, # 711 #
1280, # 714 #
0, # HPRE(N/A) #
1040 # 734 #
]
[1040, # 200UT -- CARD READER #
0, # 714X(N/A) #
0, # 711(N/A) #
0, # 714(N/A) #
0, # HPRE(N/A) #
1040 # 734 #
]
[1000, # 200UT -- LINE PRINTER #
1280, # 714X #
0, # 711(N/A) #
240, # 714 #
0, # HPRE(N/A) #
1000 # 734 #
]];
END
DEF MXSTIP # 2 #;
ARRAY DBZ$STIP$TBL [1:MXSTIP,1:MXDT] S(1);
BEGIN
ITEM DBZ$STIP$DEF (0,0,60) = [[1040,# M4A -- CONSOLE #
1280 # M4C #
]
[ 0, # M4A -- CARD READER(N/A) #
0 # M4C(N/A) #
]
[ 1,# M4A -- LINE PRINTER #
1 # M4C #
]];
END
ARRAY UBZ$STIP$TBL [1:MXSTIP,1:MXDT] S(1);
BEGIN
ITEM UBZ$STIP$DEF (0,0,60) = [[1, # M4C -- CONSOLE #
1 # M4C #
]
[1, # M4A -- CARD READER #
0 # M4C(N/A) #
]
[0, # M4A(N/A) -- LINE PRINTER #
0 # M4C(N/A) #
]];
END
ARRAY XBZ$STIP$TBL [1:MXSTIP,1:MXDT] S(1);
BEGIN
ITEM XBZ$STIP$DEF (0,0,60) = [[1040,# M4A -- CONSOLE #
1280 # M4C #
]
[1040,# M4A -- CARD READER #
0 # M4C(N/A) #
]
[1000,# M4A -- LINE PRINTER #
240 # M4C #
]];
END
SWITCH MD4DJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$MD4 , # , DT ,#
SDT , MB$PARAM , # SDT , TA ,#
ABL , DBZ , # ABL , DBZ ,#
UBZ$UBL , FLOW$PARAM , # UBZ , DBL ,#
UBZ$UBL , FLOW$PARAM , # UBL , XBZ ,#
$DO , ILLEGAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
ILLEGAL , ILLEGAL , # AB , BR ,#
ILLEGAL , CON$PARAM , # BS , B1 ,#
CON$PARAM , ILLEGAL , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
CON$PARAM , ILLEGAL , # DLC , DLTO ,#
CON$PARAM , ILLEGAL , # DLX , EP ,#
ILLEGAL , ILLEGAL , # IN , LI ,#
ILLEGAL , ILLEGAL , # OP , PA ,#
CON$PARAM , PL$PARAM , # PG , PL ,#
GEN$PARAM , ILLEGAL , # PW , SE ,#
CON$PARAM , CON$PARAM , # FA , XLC ,#
ILLEGAL , ILLEGAL , # XLX , XLTO ,#
CON$PARAM , ILLEGAL , # ELO , ELX ,#
CON$PARAM , ILLEGAL , # ELR , EBO ,#
ILLEGAL , ILLEGAL , # EBR , CP ,#
ILLEGAL , ILLEGAL , # IC , OC ,#
CON$PARAM , ILLEGAL , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
ILLEGAL , , # XLY , EOF ,#
, ILLEGAL , # PAD , RTS ,#
ILLEGAL , ILLEGAL ; # MCI , MLI #
CONTROL EJECT;
# #
# MD4DEV CODE BEGINS HERE #
# #
CRNT$CC[CC"CN"] = CN$DEF; # DEFAULT CN AS CURRENT VALUE #
CRNT$CC[CC"B1"] = B1$DEF; # DEFAULT B1 AS CURRENT VALUE #
CRNT$CC[CC"B2"] = B2$DEF; # DEFAULT B2 AS CURRENT VALUE #
CRNT$CC[CC"CT"] = CT$DEF; # DEFAULT CT AS CURRENT VALUE #
CRNT$CC[CC"BS"] = -1; # SET BS TO -NOT APPLICABLE- #
FOR I=3 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DEC ENTRY #
BEGIN
GOTO MD4DJUMP[STKWID[I]]; # GO TO APPROPRIATE PROC #
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
TEST I;
MB$PARAM:
MBDEV(STWORD[I],STLNUM[0]); # CHECK MODE4/BSC PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
ILLEGAL: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
CON$PARAM:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
PL$PARAM:
IF CRNT$DT EQ DT"CON" OR # IF DT IS CONSOLE #
CRNT$DT EQ DT"LP" # OR DT IS LINEPRINTER #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
SDT:
IF CRNT$DT EQ DT"LP" OR # IF DT IS LINE PRINTER #
STVALNAM[I] EQ "SDT12" OR # IF SDT12 - SDT15 USED #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
THEN
BEGIN # CHECK BATCH PARAMETER #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CONSOLE OR CARD READER #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
$DO:
IF CRNT$DT EQ DT"LP" # IF DT IS LINE PRINTER #
THEN
BEGIN # AND STIP IS M4C OR UNKNOWN #
IF CRNT$STIP EQ STIP"M4C" OR
CRNT$STIP EQ STIP"UNKNOWN"
THEN
BEGIN # CHECK BATCH PARAMETER #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # STIP IS M4A #
BEGIN # FLAG ERROR -- INVALID FOR M4A DEVICES #
NDLEM2(ERR134,STLNUM[0],KWDNAME[STKWID[I]]);
END
END
ELSE # DT IS CARD READER OR CONSOLE #
BEGIN
IF CRNT$DT EQ DT"CR" # IF CURRENT DT IS CR #
THEN
BEGIN # FLAG ERROR -- INVALID FOR M4A DEVICES #
NDLEM2(ERR134,STLNUM[0],KWDNAME[STKWID[I]]);
END
ELSE # DT MUST BE CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
END
TEST I;
ABL:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS LP OR CR #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
DBZ:
IF CRNT$DT NQ DT"CR" # IF DT IS NOT A CARD READER #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CARD READER #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
UBZ$UBL: # IF DT IS CONSOLE, CARD READER, OR #
# LINE PRINTER #
IF CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR" OR
CRNT$DT EQ DT"LP"
THEN
BEGIN
IF STKWID[I] EQ KID"UBZ" # IF UBZ PARAMETER #
THEN
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # ELSE, UBL PARAMETER #
IF (CRNT$DT NQ "CON") AND
(STVALNUM[I] GQ 1 AND STVALNUM[I] LQ 7)
THEN
BEGIN # PASSIVE DEVICES: 1 <= UBL <= 7#
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # PARAMETER VALUE OUT OF RANGE #
CHARVAL=XCDD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CHARVAL);
END
END
END
ELSE
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
NEXT$MD4:
END
IF NOT ABL$USED AND # IF ABL NOT SPECIFIED AND DT IS CONSOLE #
CRNT$DT EQ DT"CON"
THEN
BEGIN
DEVFNFV(FN"ABL",ABL$DEF);
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN
VALUE = DBL$DEF[CRNT$DT]; # DEFAULT DBL IN VALUE #
DEVFNFV(FN"DBL",VALUE);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN
BEGIN
VALUE = UBL$DEF; # DEFAULT UBL IN VALUE #
DEVFNFV(FN"UBL",VALUE);
END
IF NOT DBZ$USED AND # IF DBZ NOT SPECIFIED #
CRNT$DT NQ DT"CR"
THEN
BEGIN
VALUE = 0; # CLEAR VALUE TEMPORARY #
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR UNKNOWN #
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN # DEFAULT DBZ BY TC AND DT #
VALUE = DBZ$TC$DEF[CRNT$TC,CRNT$DT];
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN # IF STIP IS NOT UNKNOWN #
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN
BEGIN # DEFAULT DBZ BY STIP AND DT #
VALUE = DBZ$STIP$DEF[CRNT$STIP,CRNT$DT];
END
END
IF VALUE NQ 0 # IF DEFAULT VALUE IS DETERMINED#
THEN
BEGIN
J = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FN"DBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FN"DBZ$LSB",J);
END
END
IF NOT UBZ$USED AND # IF UBZ NOT SPECIFIED #
(CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"CR")
THEN
BEGIN
VALUE = 0; # CLEAR VALUE TEMPORARY #
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR UNKNOWN #
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN # DEFAULT UBZ BY TC AND DT #
VALUE = UBZ$TC$DEF[CRNT$TC,CRNT$DT];
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN # IF STIP IS NOT UNKNOWN #
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN
BEGIN # DEFAULT UBZ BY STIP AND DT #
VALUE = UBZ$STIP$DEF[CRNT$STIP,CRNT$DT];
END
END
IF VALUE NQ 0 # IF DEFAULT VALUE IS DETERMINED#
THEN
BEGIN
DEVFNFV(FN"UBZ",VALUE);
END
END
IF NOT XBZ$USED # IF XBZ NOT SPECIFIED #
THEN
BEGIN
VALUE = 0; # CLEAR VALUE TEMPORARY #
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR UNKNOWN #
CRNT$TC NQ TC"UNKNOWN"
THEN
BEGIN # DEFAULT XBZ BY TC AND DT #
VALUE = XBZ$TC$DEF[CRNT$TC,CRNT$DT];
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN # IF STIP IS NOT UNKNOWN #
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN
BEGIN # DEFAULT XBZ BY STIP AND DT #
VALUE = XBZ$STIP$DEF[CRNT$STIP,CRNT$DT];
END
END
IF VALUE NQ 0 # IF DEFAULT VALUE IS DETERMINED#
THEN
BEGIN
J = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FN"XBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FN"XBZ$LSB",J);
END
END
IF NOT DO$USED AND # IF DO IS NOT SPECIFIED #
CRNT$DT NQ DT"CON" # AND DT IS NOT CONSOLE #
THEN
BEGIN
IF CRNT$STIP EQ STIP"M4A" OR # IF STIP IS M4A OR UNKNOWN #
CRNT$STIP EQ STIP"UNKNOWN"
THEN
BEGIN
DEVFNFV(FN"DO$",DO$DEF); # PUT DO VALUE IN FOR RBF #
END
ELSE # STIP MUST BE M4C #
BEGIN
IF FIRST$DT[DT"LP"] # IF THIS IS FIRST LP #
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
DEVFNFV(FN"DO$",DO$DEF);
B<DO$DEF,1>DO$MAP[DT"LP"] = 1; # SET BIT FOR DEFAULT #
FIRST$DT[DT"LP"] = FALSE; # CLEAR FLAG FOR DT #
END
ELSE # NOT FIRST LINE PRINTER #
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"DO");
END
END
END
IF NOT TA$USED AND # IF TA NOT SPECIFIED AND NOT AUTO-REC #
NOT AUTO$REC
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"TA");
END
DEVFNFV(FN"EOF",CRNT$EOF); # PUT EOF ENTRY IN NCB #
IF NOT PL$USED AND # IF PL NOT SPECIFIED #
CRNT$DT EQ DT"LP" # AND DEVICE IS LINEPRINTER #
THEN
BEGIN
DEVFNFV(FN"PL",PL$DEF);
END
FOR I=CC"CN" STEP 1 UNTIL CC"CT"
DO # CHECK CONTROL CHAR FOR UNIQUENESS #
BEGIN
FOR J=I+1 STEP 1 UNTIL CC"ELX"
DO
BEGIN
IF CRNT$CC[I] EQ CRNT$CC[J]
THEN
BEGIN # FLAG ERROR -- VALUE NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
END
RETURN; # **** RETURN **** #
END # MD4DEV #
CONTROL EJECT;
PROC USRDEV;
*IF,DEF,IMS
#
** USERDEV - CHECK DEVICE STATEMENT PARAMETERS FOR USER TIP.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC USERDEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(DI,PRI,PW,P90,P91,...,P99):
* CHECK GENERAL PARAMETER.
* CASE 2(HN,AUTOCON,AUTOLOG,AB,BR,BS,B1,B2,CI,CN,CT,DLC,DLTO,
* DLX,EP,IN,LI,OP,PA,PG,PL,SE,XLY):
* CHECK CONSOLE PARAMETER.
* CASE 3(SDT,DO,STREAM):
* CHECK BATCH DEVICE PARAMETER.
* CASE 4(TA):
* CHECK MODE4/BSC PARAMETER.
* CASE 5(ABL,DBL,DBZ,UBL,UBZ,XBZ):
* CHECK FLOW CONTROL PARAMETER.
* IF W SPECIFIED,
* ENTER FNFV ENTRY FOR CURRENT VALUE OF W.
* IF NCIR SPECIFIED,
* ENTER FNFV ENTRY FOR NCIR
* ENTER FNFV ENTRY FOR NEN.
* PUT NCIR VALUE IN DEVICE CROSS-REFERENCE TABLE
* IF EOF SPECIFIED,
* ENTER FNFV VALUE FOR EOF.
* IF BCF,CTYP,MREC,NCIR,NEN,W,RIC WAS SPECIFIED
* PUT VALUE IN DEVICE ENTRY.
*
#
*ENDIF
BEGIN
ITEM I; # SCRATCH ITEM #
ITEM CTEMP C(10); # CHARACTER TEMP #
SWITCH USRDJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$USR , # , DT ,#
BTCH$PARAM , MB$PARAM , # SDT , TA ,#
FLOW$PARAM , FLOW$PARAM , # ABL , DBZ ,#
FLOW$PARAM , FLOW$PARAM , # UBZ , DBL ,#
FLOW$PARAM , FLOW$PARAM , # UBL , XBZ ,#
BTCH$PARAM , BTCH$PARAM , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
CON$PARAM , CON$PARAM , # AB , BR ,#
CON$PARAM , CON$PARAM , # BS , B1 ,#
CON$PARAM , CON$PARAM , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
CON$PARAM , CON$PARAM , # DLC , DLTO ,#
CON$PARAM , CON$PARAM , # DLX , EP ,#
CON$PARAM , CON$PARAM , # IN , LI ,#
CON$PARAM , CON$PARAM , # OP , PA ,#
CON$PARAM , CON$PARAM , # PG , PL ,#
GEN$PARAM , CON$PARAM , # PW , SE ,#
CON$PARAM , CON$PARAM , # FA , XLC ,#
CON$PARAM , CON$PARAM , # XLX , XLTO ,#
CON$PARAM , CON$PARAM , # ELO , ELX ,#
CON$PARAM , CON$PARAM , # ELR , EBO ,#
CON$PARAM , CON$PARAM , # EBR , CP ,#
CON$PARAM , CON$PARAM , # IC , OC ,#
CON$PARAM , CON$PARAM , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
CON$PARAM , , # XLY , EOF ,#
, CON$PARAM , # PAD , RTS ,#
GEN$PARAM , GEN$PARAM ; # MCI , MLI #
CONTROL EJECT;
# #
# USRDEV CODE BEGINS HERE #
# #
FOR I=3 STEP 1 UNTIL STWC[0] # CHECK EACH VALUE-DEC ENTRY #
DO
BEGIN
GOTO USRDJUMP[STKWID[I]];
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
TEST I;
CON$PARAM:
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
TEST I;
BTCH$PARAM:
BTCHDEV(STWORD[I],STLNUM[0]); # CHECK BATCH/PASSIVE DEV PARAM #
TEST I;
MB$PARAM:
MBDEV(STWORD[I],STLNUM[0]); # CHECK MODE4/BSC PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
NEXT$USR:
END
CTEMP = "ABL";
C$USR$PRM1(ABL$USED,CTEMP); # CHECK IF ABL IS USED #
CTEMP = "DT";
C$USR$PRM2(CRNT$DT,CTEMP); # CHECK CURRENT DEVICE TYPE USED #
CTEMP ="DBZ";
C$USR$PRM1(DBZ$USED,CTEMP); # CHECK IF DBZ USED #
CTEMP = "DBL";
C$USR$PRM1(DBL$USED,CTEMP); # CHECK IF DBL USED #
CTEMP = "UBZ";
C$USR$PRM1(UBZ$USED,CTEMP); # CHECK IF UBZ USED #
CTEMP = "UBL";
C$USR$PRM1(UBL$USED,CTEMP); # CHECK IF UBL USED #
CTEMP = "XBZ";
C$USR$PRM1(XBZ$USED,CTEMP); # CHECK IF XBZ USED #
IF (CRNT$DT EQ DT"CR") OR (CRNT$DT EQ DT"CP") OR
(CRNT$DT EQ DT"LP") OR (CRNT$DT EQ DT"PL")
THEN # VALID ONLY FOR PASSIVE DEVICES #
BEGIN
CTEMP = "DO";
C$USR$PRM1(DO$USED,CTEMP);# CHECK IF DO IS SPECIFIED #
END
CTEMP = "AUTOCON";
C$USR$PRM1((AUTOCON$FLAG OR AUTOCON$NO),CTEMP); # CHECK AUTOCON #
CTEMP = "HN";
C$USR$PRM1(HN$USED,CTEMP); # CHECK HN #
IF CTYP$USED # IF CTYPE SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"CTYP",CRNT$CTYP); # MAKE FNFV ENTRY #
END
IF W$USED # IF W SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"W",CRNT$W); # MAKE FNFV ENTRY #
END
IF NCIR$USED # IF NCIR IS SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"NCIR",CRNT$NCIR); # MAKE FNFV ENTRY FOR NCIR #
DCNCIR[DCWC[1]] = CRNT$NCIR; # PUT NCIR VALUE IN DEVICE XREF #
DEVFNFV(FN"NEN",CRNT$NEN); # MAKE FNFV ENTRY FOR NEN #
END
IF EOF$USED # IF EOF SPECIFIED #
THEN
BEGIN
DEVFNFV(FN"EOF",CRNT$EOF); # MAKE FNFV ENTRY FOR EOF #
END
RETURN; # **** RETURN **** #
END # USRDEV #
CONTROL EJECT;
PROC X25DEV;
BEGIN
*IF,DEF,IMS
#
** X25DEV - CHECK DEVICE STATEMENT PARAMETERS LEGAL FOR X.25
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETER TO BE LEGAL FOR X.25 CIRCUITS.
*
* PROC X25DEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(PW,P90,P91,...,P99,PRI):
* CHECK GENERAL DEVICE PARAMETER.
* CASE 2(HN,AUTOLOG,AUTOCON,BS,B1,B2,CI,CN,CT,DLX,LI,
* PA,PG,PL,XLY,IN):
* CHECK CONSOLE DEVICE PARAMETER.
* CASE 3(ABL,DBZ,DBL,UBL):
* CHECK FLOW CONTROL PARAMETER.
* CASE 4(DI,TA,DO,STREAM,AB,BR,DLC,DLTO,EP,OP,SE):
* FLAG ERROR -- PARAMETER NOT ALLOW.
* CASE 5(SDT):
* IF SDT VALUE IS SDT12, SDT13, SDT14, OR SDT15,
* CALL BATCH DEVICE PROCESSOR.
* IF ABL,DBL,UBL NOT SPECIFIED,
* PUT DEFAULT VALUE INTO DEVICE ENTRY.
* IF DBZ OR UBZ NOT SPECIFIED
* PERFORM FNFV ENTRY DEPENDING ON DEVICE TYPE.
* PUT CTYP VALUE INTO DEVICE ENTRY.
* IF CTYP IS SVC,
* PUT NCIR AND NEN VALUES INTO DEVICE ENTRY.
* CHECK BS,CN,B1,B2,CT FOR UNIQUENESS.
* IF NOT UNIQUE,
* FLAG ERROR -- VALUE NOT UNIQUE.
#
*ENDIF
#
**** PROC X25DEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF BS$DEF # X"08" #; # DEFAULT BS VALUE #
DEF B1$DEF # X"10" #; # DEFAULT B1 VALUE #
DEF B2$DEF # X"14" #; # DEFAULT B2 VALUE #
DEF CN$DEF # X"18" #; # DEFAULT CN VALUE #
DEF CT$DEF # X"1B" #; # DEFAULT CT VALUE #
DEF EBX$DEF # X"04" #; # DEFAULT EBX VALUE #
DEF ELX$DEF # X"0D" #; # DEFAULT ELX VALUE #
DEF DBL$DEF # 2 #; # DEFAULT DBL VALUE #
DEF DBZ$DEF # 225 #; # DEFAULT DBZ VALUE #
DEF DBZ$AP$DEF # 128 #; # DEFAULT DBZ VALUE FOR DT=AP #
DEF UBZ$AP$DEF # 2 #; # DEFAULT UBZ VALUE FOR DT=AP #
DEF UBL$DEF # 7 #; # DEFAULT UBL VALUE #
DEF UBZ$DEF # 1 #; # DEFAULT UBZ VALUE #
DEF PL$DEF # 64 #; # DEFAULT PL VALUE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # INTEGER VALUE TEMPORARY #
SWITCH X25DJUMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, ILLEGAL , # 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 , COLLECT ,#
, NEXT$X25 , # , DT ,#
SDT , ILLEGAL , # SDT , TA ,#
FLOW$PARAM , FLOW$PARAM , # ABL , DBZ ,#
FLOW$PARAM , FLOW$PARAM , # UBZ , DBL ,#
FLOW$PARAM , ILLEGAL , # UBL , XBZ ,#
ILLEGAL , ILLEGAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
CON$PARAM , CON$PARAM , # AB , BR ,#
CON$PARAM , CON$PARAM , # BS , B1 ,#
CON$PARAM , CON$PARAM , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
CON$PARAM , CON$PARAM , # DLC , DLTO ,#
CON$PARAM , CON$PARAM , # DLX , EP ,#
IN , CON$PARAM , # IN , LI ,#
CON$PARAM , CON$PARAM , # OP , PA ,#
CON$PARAM , CON$PARAM , # PG , PL ,#
GEN$PARAM , ILLEGAL , # PW , SE ,#
CON$PARAM , CON$PARAM , # FA , XLC ,#
CON$PARAM , CON$PARAM , # XLX , XLTO ,#
CON$PARAM , CON$PARAM , # ELO , ELX ,#
CON$PARAM , CON$PARAM , # ELR , EBO ,#
CON$PARAM , CON$PARAM , # EBR , CP ,#
CON$PARAM , CON$PARAM , # IC , OC ,#
CON$PARAM , CON$PARAM , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
CON$PARAM , , # XLY , EOF ,#
, ILLEGAL , # PAD , RTS ,#
GEN$PARAM , GEN$PARAM ; # MCI , MLI #
CONTROL EJECT;
# #
# X25DEV CODE BEGINS HERE #
# #
CRNT$CC[CC"CN"] = CN$DEF; # CN -- DEFAULT CONTROL CHAR #
CRNT$CC[CC"B1"] = B1$DEF; # B1 #
CRNT$CC[CC"B2"] = B2$DEF; # B2 #
CRNT$CC[CC"CT"] = CT$DEF; # CT #
CRNT$CC[CC"BS"] = BS$DEF; # BS #
CRNT$CC[CC"ELX"] = ELX$DEF; # ELX #
CRNT$CC[CC"EBX"] = EBX$DEF; # EBX #
FOR I=3 STEP 1 UNTIL STWC[0] # CHECK EACH VALUE-DEC ENTRY #
DO
BEGIN
GOTO X25DJUMP[STKWID[I]]; # GOTO APPROPRIATE PARAGRAPH #
GEN$PARAM:
IF STKWID[I] EQ KID"MCI" OR # IF -MCI- OR -MLI- USED #
STKWID[I] EQ KID"MLI"
THEN
BEGIN
IF CRNT$STIP EQ STIP"PAD" # IF STIP IS PAD #
THEN
BEGIN
GENDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # XAA STIP #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END # PARAMETER NOT ALLOWED FOR XAA #
END
ELSE
BEGIN
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
END
TEST I;
SDT:
IF STVALNAM[I] EQ "SDT12" OR # IF SDT12 - SDT15 USED #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
THEN
BEGIN
BTCHDEV(STWORD[I],STLNUM[0]); # CALL BATCH DEVICE PROCESSOR #
END
ELSE
BEGIN
GOTO ILLEGAL;
END
TEST I;
IN:
IF CRNT$TIP EQ TIP"X25" AND
STVALNAM[I] EQ "PT"
THEN # IN=PT NOT ALLOWED FOR X.25 #
BEGIN # FLAG ERROR -- VALUE INVALID WITH TIPTYPE#
NDLEM2(ERR112,STLNUM[0],STVALNAM[I]);
TEST I; # GET NEXT VALUE DECLARATION #
END
CON$PARAM:
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
ILLEGAL: # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
IF STKWID[I] EQ KID"DI"
THEN # IF PARAMETER IS -DI- #
BEGIN
NDLEM2(ERR106,STLNUM[0],"DI"); # PUT -DI- IN MESSAGE #
END
ELSE # PARAMETER IS NOT -DI- #
BEGIN
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
END
NEXT$X25:
END
IF NOT ABL$USED # IF ABL NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR DEFAULT ABL #
DEVFNFV(FN"ABL",ABL$DEF);
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY FOR DEFAULT DBL #
DEVFNFV(FN"DBL",DBL$DEF);
END
IF NOT DBZ$USED # IF DBZ NOT SPECIFIED #
THEN
BEGIN
IF CRNT$DT EQ DT"AP" # IF A-A DEVICE TYPE #
THEN
BEGIN
VALUE = DBZ$AP$DEF; # MAKE FNFV PAIR ENTRY FOR #
END
ELSE
BEGIN # ALL OTHER DEVICE TYPE #
VALUE = DBZ$DEF;
END
J = B<44,8>VALUE; # MSB OF DEFAULT DBZ #
DEVFNFV(FN"DBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF DEFAULT DBZ #
DEVFNFV(FN"DBZ$LSB",J);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV ENTRY WITH DEFAULT UBL #
DEVFNFV(FN"UBL",UBL$DEF);
END
IF NOT UBZ$USED # IF UBZ NOT SPECIFIED #
THEN
BEGIN
IF CRNT$DT EQ DT"AP" # IF DEVICE TYPE IS AP #
THEN
BEGIN
DEVFNFV(FN"UBZ",UBZ$AP$DEF);
END
ELSE
BEGIN
DEVFNFV(FN"UBZ",UBZ$DEF); # ELSE PASS REGULAR DEFAULT #
END
END
IF COLLECT$USED # IF COLLECT WAS SPECIFIED #
THEN
BEGIN # PUT VALUE IN ENTRY #
DEVFNFV(FN"COLLECT",COLLECT$FLAG);
END
IF NOT PL$USED AND # IF PL NOT SPECIFIED #
CRNT$DT EQ DT"LP" # AND DEVICE IS LINEPRINTER #
THEN
BEGIN
DEVFNFV(FN"PL",PL$DEF);
END
# MAKE FNFV PAIR ENTRIES FOR CTYP,NEN,NCIR,W#
DEVFNFV(FN"CTYP",CRNT$CTYP);
DEVFNFV(FN"W",CRNT$W);
IF CRNT$CTYP EQ CTYP"SVC" # IF CURRENT CTYP IS -SVC- #
THEN
BEGIN
DEVFNFV(FN"NCIR",CRNT$NCIR); # PUT FNFV PAIR FOR NCIR #
DEVFNFV(FN"NEN",CRNT$NEN); # PUT FNFV PAIR FOR NEN #
DCNCIR[DCWC[1]] = CRNT$NCIR; # PUT NCIR VALUE IN DEVICE XREF #
END
# CHECK UNIQUENESS OF CONTROL CHARS #
FOR I=CC"CN" STEP 1 UNTIL CC"BS"
DO
BEGIN
FOR J=I+1 STEP 1 UNTIL CC"EBX"
DO
BEGIN
IF CRNT$CC[I] EQ CRNT$CC[J]
THEN
BEGIN # FLAG ERROR -- CONTROL CHAR NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
END
RETURN; # **** RETURN **** #
END # X25DEV #
CONTROL EJECT;
PROC $3270DEV;
BEGIN
*IF,DEF,IMS
#
** $3270DEV - CHECK DEVICE STATEMENT PARAMETERS LEGAL FOR 3270.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECK PARAMETER TO BE ALLOW FOR MODE4 DEVICES.
*
* PROC $3270DEV
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(PRI,DI,PW,P90,P91,...,P99):
* CHECK GENERAL PARAMETER.
* CASE 2(TA):
* CHECK MODE4/BSC PARAMETER.
* CASE 3(DBL,DBZ,XBZ):
* CHECK FLOW CONTROL PARAMETER.
* CASE 4(B1,B2,CN,CT,PG,PL,HN,AUTOLOG,AUTOCON):
* IF DT IS CONSOLE,
* THEN,
* CHECK CONSOLE PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAM NOT ALLOWED WITH DT SPECIFIED.
* CASE 5(ABL):
* IF DT IS CONSOLE,
* THEN,
* CHECK FLOW CONTROL PARAMETER
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 6(UBZ):
* IF DT IS CONSOLE OR CARD READER OR LINEPRINTER,
* THEN,
* CHECK FLOW CONTROL PARAMETER.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* CASE 7(UBL):
* IF DT IS NOT CONSOLE AND UBL WITHIN RANGE 1-7,
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETERS.
* CASE 8(XBZ):
* IF DT IS LP OR USER,
* CALL FLOWDEV TO CHECK FLOW CONTROL PARAMETERS.
* OTHERWISE,
* FLAG ERROR -- INVALID WITH DT SPECIFIED.
* IF DBL NOT SPECIFIED,
* DEFAULT VALUE BY DEVICE TYPE.
* IF UBL NOT SPECIFIED,
* DEFAULT UBL VALUE.
* IF DT IS CON AND ABL WAS NOT SPECIFIED,
* DEFAULT ABL VALUE.
* IF DBZ WAS NOT SPECIFIED,
* DEFAULT VALUE BY DEVICE TYPE.
* IF DT IS A CONSOLE AND UBZ WAS NOT SPECIFIED,
* DEFAULT UBZ VALUE.
* IF DT IS LP AND XBZ WAS NOT SPECIFIED,
* DEFAULT XBZ VALUE.
* CHECK CN,B1,B2,CT TO BE UNIQUE.
* IF NOT UNIQUE,
* FLAG ERROR -- CN,B1,B2,CT MUST BE UNIQUE.
*
#
*ENDIF
#
**** PROC $3270DEV - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO CHARACTER #
END
#
****
#
DEF ABL$DEF # 2 #; # DEFAULT ABL VALUE #
DEF B1$DEF # X"3A" #; # DEFAULT B1 VALUE #
DEF B2$DEF # X"29" #; # DEFAULT B2 VALUE #
DEF CN$DEF # X"28" #; # DEFAULT CN VALUE #
DEF CT$DEF # X"25" #; # DEFAULT CT VALUE #
DEF DBL$DEF$CON # 2 #; # DEFAULT DBL VALUE FOR CONSOLES #
DEF DBL$DEF$LP # 1 #; # DEFAULT DBL VALUE FOR LINE PRINTERS #
DEF DBZ$DEF$CON # 1280 #; # DEFAULT DBZ VALUE FOR CONSOLES#
DEF DBZ$DEF$LP # 1 #; # DEFAULT DBZ VALUE FOR LINE PRINTERS #
DEF DO$DEF # 1 #; # DEFAULT DO VALUE #
DEF UBL$DEF # 7 #; # DEFAULT UBL VALUE #
DEF UBZ$DEF # 1 #; # DEFAULT UBZ VALUE #
DEF XBZ$DEF # 400 #; # DEFAULT XBZ VALUE #
DEF PL$DEF # 64 #; # DEFAULT PL VALUE #
ITEM CHARVAL C(10); # SCRATCH CHARACTER VARIABLE #
ITEM I; # SCRATCH ITEM #
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # INTEGER VALUE TEMPORARY #
SWITCH $3270JMP , , # UNK , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # 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 , COLLECT ,#
, NEXT$3270 , # , DT ,#
SDT , MB$PARAM , # SDT , TA ,#
ABL , FLOW$PARAM , # ABL , DBZ ,#
UBZ$UBL , FLOW$PARAM , # UBZ , DBL ,#
UBZ$UBL , XBZ , # UBL , XBZ ,#
$DO , ILLEGAL , # DO , STREAM ,#
CON$PARAM , , # HN , AUTOLOG ,#
CON$PARAM , GEN$PARAM , # AUTOCON , PRI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM , # P98 , P99 ,#
ILLEGAL , ILLEGAL , # AB , BR ,#
ILLEGAL , CON$PARAM , # BS , B1 ,#
CON$PARAM , ILLEGAL , # B2 , CI ,#
CON$PARAM , CON$PARAM , # CN , CT ,#
CON$PARAM , ILLEGAL , # DLC , DLTO ,#
CON$PARAM , ILLEGAL , # DLX , EP ,#
ILLEGAL , ILLEGAL , # IN , LI ,#
ILLEGAL , ILLEGAL , # OP , PA ,#
CON$PARAM , PL$PARAM , # PG , PL ,#
GEN$PARAM , ILLEGAL , # PW , SE ,#
CON$PARAM , CON$PARAM , # FA , XLC ,#
ILLEGAL , ILLEGAL , # XLX , XLTO ,#
CON$PARAM , ILLEGAL , # ELO , ELX ,#
CON$PARAM , ILLEGAL , # ELR , EBO ,#
ILLEGAL , ILLEGAL , # EBR , CP ,#
ILLEGAL , ILLEGAL , # IC , OC ,#
CON$PARAM , ILLEGAL , # LK , EBX ,#
, GEN$PARAM , # , MC ,#
ILLEGAL , , # XLY , EOF ,#
, ILLEGAL , # PAD , RTS ,#
ILLEGAL , ILLEGAL ; # MCI , MLI #
CONTROL EJECT;
# #
# $3270DEV CODE BEGINS HERE #
# #
CRNT$CC[CC"CN"] = CN$DEF; # DEFAULT CN AS CURRENT VALUE #
CRNT$CC[CC"B1"] = B1$DEF; # DEFAULT B1 AS CURRENT VALUE #
CRNT$CC[CC"B2"] = B2$DEF; # DEFAULT B2 AS CURRENT VALUE #
CRNT$CC[CC"CT"] = CT$DEF; # DEFAULT CT AS CURRENT VALUE #
CRNT$CC[CC"BS"] = -1; # SET BS TO -NOT APPLICABLE- #
FOR I=3 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DEC ENTRY #
BEGIN
GOTO $3270JMP[STKWID[I]]; # GO TO APPROPRIATE PROC #
GEN$PARAM:
GENDEV(STWORD[I],STLNUM[0]); # CHECK GENERAL PARAMETER #
TEST I;
MB$PARAM:
MBDEV(STWORD[I],STLNUM[0]); # CHECK MODE4/BSC PARAMETER #
TEST I;
FLOW$PARAM:
FLOWDEV(STWORD[I],STLNUM[0]); # CHECK FLOW CONTROL PARAMETER #
TEST I;
ILLEGAL: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[STKWID[I]]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
CON$PARAM:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
PL$PARAM:
IF CRNT$DT EQ DT"CON" OR # IF DT IS CONSOLE #
CRNT$DT EQ DT"LP" # DT IS LINEPRINTER #
THEN
BEGIN
CONDEV(STWORD[I],STLNUM[0]); # CHECK CONSOLE PARAMETER #
END
ELSE # DT IS NOT CONSOLE #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
SDT:
IF CRNT$DT EQ DT"LP" OR # IF DT IS LINE PRINTER #
STVALNAM[I] EQ "SDT12" OR # IF SDT12 - SDT15 USED #
STVALNAM[I] EQ "SDT13" OR
STVALNAM[I] EQ "SDT14" OR
STVALNAM[I] EQ "SDT15"
THEN
BEGIN # CHECK BATCH PARAMETER #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS CONSOLE OR CARD READER #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
$DO:
IF CRNT$DT EQ DT"LP" # IF DT IS LINE PRINTER #
THEN
BEGIN # CHECK BATCH PARAMETER #
BTCHDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS NOT LP OR CON #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
ABL:
IF CRNT$DT EQ DT"CON" # IF DT IS CONSOLE #
THEN
BEGIN # CHECK FLOW CONTROL PARAMETER #
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE # DT IS LP OR CR #
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
UBZ$UBL: # IF DT IS CONSOLE, USER, OR LINE PRINTER #
IF CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"LP" OR
CRNT$DT EQ DT"USER"
THEN
BEGIN
IF STKWID[I] EQ KID"UBZ" # IF UBZ PARAMETER #
THEN
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # ELSE, UBL PARAMETER #
IF (CRNT$DT EQ DT"CON") OR (CRNT$DT EQ DT"USER") OR
(STVALNUM[I] GQ 1 AND STVALNUM[I] LQ 7)
THEN
BEGIN # PASSIVE DEVICES: 1 <= UBL <= 7#
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # PARAMETER VALUE OUT OF RANGE #
CHARVAL=XCDD(STVALNUM[I]);
NDLEM2(ERR100,STLNUM[0],CHARVAL);
END
END
END
ELSE
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
XBZ:
IF CRNT$DT EQ DT"LP" OR
CRNT$DT EQ DT"USER"
THEN
BEGIN
FLOWDEV(STWORD[I],STLNUM[0]);
END
ELSE
BEGIN # FLAG ERROR -- INVALID WITH DT SPECIFIED #
NDLEM2(ERR133,STLNUM[0],KWDNAME[STKWID[I]]);
END
TEST I;
NEXT$3270:
END
IF NOT ABL$USED AND # IF ABL NOT SPECIFIED AND DT IS CONSOLE #
CRNT$DT EQ DT"CON"
THEN
BEGIN
DEVFNFV(FN"ABL",ABL$DEF);
END
IF NOT DBL$USED # IF DBL NOT SPECIFIED #
THEN
BEGIN
IF CRNT$DT EQ DT"LP"
THEN
VALUE = DBL$DEF$LP; # DEFAULT DBL VALUE FOR LP #
ELSE
VALUE = DBL$DEF$CON; # DEFAULT DBL VALUE FOR CON/USER#
DEVFNFV(FN"DBL",VALUE);
END
IF NOT UBL$USED # IF UBL NOT SPECIFIED #
THEN
BEGIN
VALUE = UBL$DEF; # DEFAULT UBL IN VALUE #
DEVFNFV(FN"UBL",VALUE);
END
IF NOT DBZ$USED # IF DBZ NOT SPECIFIED #
THEN
BEGIN
IF CRNT$DT EQ DT"LP"
THEN
VALUE = DBZ$DEF$LP; # DEFAULT DBZ VALUE FOR LP #
ELSE
VALUE = DBZ$DEF$CON; # DEFAULT DBZ VALUE FOR CON/USER#
J = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FN"DBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FN"DBZ$LSB",J);
END
IF NOT UBZ$USED AND # IF UBZ NOT SPECIFIED #
(CRNT$DT EQ DT"CON" OR CRNT$DT EQ DT"USER")
THEN
BEGIN
VALUE = UBZ$DEF;
DEVFNFV(FN"UBZ",VALUE);
END
IF NOT XBZ$USED AND # IF XBZ NOT SPECIFIED #
CRNT$DT EQ DT"LP"
THEN
BEGIN
VALUE = XBZ$DEF;
J = B<44,8>VALUE; # MSB OF VALUE #
DEVFNFV(FN"XBZ$MSB",J);
J = B<52,8>VALUE; # LSB OF VALUE #
DEVFNFV(FN"XBZ$LSB",J);
END
IF NOT DO$USED AND # IF DO IS NOT SPECIFIED #
CRNT$DT EQ DT"LP" # AND DT IS LINE PRINTER #
THEN
BEGIN
DEVFNFV(FN"DO$",DO$DEF); # PUT DO VALUE IN FOR RBF #
END
IF NOT PL$USED AND # IF PL NOT SPECIFIED #
CRNT$DT EQ DT"LP" # AND DT IS LINE PRINTER #
THEN
BEGIN
DEVFNFV(FN"PL",PL$DEF);
END
FOR I=CC"CN" STEP 1 UNTIL CC"CT"
DO # CHECK CONTROL CHAR FOR UNIQUENESS #
BEGIN
FOR J=I+1 STEP 1 UNTIL CC"ELX"
DO
BEGIN
IF CRNT$CC[I] EQ CRNT$CC[J]
THEN
BEGIN # FLAG ERROR -- VALUE NOT UNIQUE #
NDLEM2(ERR132,STLNUM[0]," ");
END
END
END
RETURN; # **** RETURN **** #
END # $3270DEV #
CONTROL EJECT;
# #
# DEVPR CODE BEGINS HERE #
# #
ABL$USED = FALSE; # INITIALIZE FLAGS AND VALUES #
AUTOCON$FLAG = FALSE;
AUTOCON$NO = FALSE;
BIT$POS = FIRST$POS;
CRNT$DT = DT"UNKNOWN";
DBL$USED = FALSE;
DBZ$USED = FALSE;
DO$USED = FALSE;
HN$USED = FALSE;
STREAM$USED = FALSE;
TA$USED = FALSE;
UBL$USED = FALSE;
UBZ$USED = FALSE;
XBZ$USED = FALSE;
PL$USED = FALSE;
GR$SET = S"NO"; # GR$SET INITIALISED TO NO #
# #
IF LRWC[1]+MXDVENT GQ LR$LENG
THEN # IF THERE IS NOT ENOUGH ROOM FOR ENTRY #
BEGIN
SSTATS(P<LINE$RECORD>,MXDVENT); # ALLOC MORE SPACE #
END
CRNT$DEV = LRWC[1] + 1; # SET POINTER TO CURRENT DEVICE #
LRWORD[CRNT$DEV] = 0; # CLEAR 1ST WORD OF ENTRY #
DE$IDENT[CRNT$DEV] = "DEV"; # SET DEVICE ENTRY IDENTIFIER #
DEWC[CRNT$DEV] = 3; # INITIALIZE ENTRY WORD COUNT #
LRWC[1] = LRWC[1] + 3; # INCREMENT LINE RECORD WORD CNT#
LRWORD[CRNT$DEV + 1] = 0; # CLEAR 2ND WORD IN ENTRY #
LRWORD[CRNT$DEV + 2] = 0; # CLEAR 3RD WORD IN ENTRY #
DEVCNT = DEVCNT + 1; # INCREMENT DEVICE COUNT #
IF NOT STLBERR[1] # IF LABEL IS O.K. #
THEN
BEGIN
DENAME[CRNT$DEV + 1] = STLABEL[1]; # PUT LABEL IN DEVICE ENTRY#
IF LCNI[0] GR 0 # IF GROUP COUNT GREATER THAN ZERO #
THEN
BEGIN # FOR EACH GENERATED NAME PUT IN DEV XREF #
IF DCWC[1]+LCNI[0] GQ DC$LENG
THEN # IF NEED MORE TABLE SPACE FOR ENTRIES #
BEGIN
SSTATS(P<DEVICE$XREF>,LCNI[0]+1); # ALLOCATE MORE SPACE #
END
FOR I=STLBPNTR[1] STEP 1 UNTIL (STLBPNTR[1] + LCNI[0]) - 1
DO
BEGIN
DCWC[1] = DCWC[1] + 1; # INCREMENT WORD COUNT #
DCWORD[DCWC[1]] = 0; # CLEAR ENTRY WORD #
DCNAME[DCWC[1]] = LABLNAM[I]; # PUT NAME IN ENTRY #
DCPORT[DCWC[1]] = LABLPORT[I]; # PUT PORT NUMBER #
DCNID[DCWC[1]] = CRNT$NID; # PUT NPU NODE I.D. #
END
IF LCNI[0] EQ 1
THEN
BEGIN
DENAME[CRNT$DEV + 1] = LABLNAM[STLBPNTR[1]];
END
END
ELSE # NO GENERATED NAME FOR DEVICE #
BEGIN
DCWC[1] = DCWC[1] + 1; # INCREMENT WORD COUNT #
IF DCWC[1] GQ DC$LENG
THEN # IF NEED MORE SPACE FOR ENTRY #
BEGIN
SSTATS(P<DEVICE$XREF>,100); # ALLOCATE MORE TABLE SPACE #
END
DCWORD[DCWC[1]] = 0; # CLEAR ENTRY WORD #
DCNAME[DCWC[1]] = STLABEL[1]; # PUT NAME IN ENTRY #
DCPORT[DCWC[1]] = LCPORT[1]; # PUT PORT NUMBER #
DCNID[DCWC[1]] = CRNT$NID; # PUT NPU NODE I.D. #
IF LTYPE EQ "X25" # IF LINE IS X25 #
THEN
BEGIN
IF CRNT$CTYP EQ CTYP"SVC" # IF CURRENT CTYP IS -SVC- #
THEN
BEGIN
DCSVC[DCWC[1]] = TRUE; # SET SVC FLAG IN DEVICE XREF #
END
END
END
END
IF STORD1[2] NQ 0 # IF DT IS SPECIFIED #
THEN
BEGIN
IF NOT STVLERR[STORD1[2]] # IF VALUE IS O.K. #
THEN
BEGIN
FOR I=1 STEP 1 UNTIL MXDT # MAP DT TO NUMERICAL VALUE #
DO
BEGIN # IF VALUE FOUND IN TABLE #
IF STVALNAM[STORD1[2]] EQ DTNAME[I]
THEN
BEGIN
CRNT$DT = DT$STAT[I]; # SET CURRENT DEVICE TYPE #
DEDT[CRNT$DEV + 2] = DT$NUMV[I]; # PUT NUM VALUE IN ENTRY#
END
END
IF CRNT$TIP NQ TIP"USER" AND
CRNT$DT NQ DT"USER" # IF TIPTYPE AND DT NOT USER #
THEN
BEGIN
IF CRNT$TC NQ TC"USER" AND
CRNT$TC NQ TC"UNKNOWN"
THEN # IF TC IS NOT USER OR UNKNOWN #
BEGIN
IF B<CRNT$TC,1>DT$TC$MAP[CRNT$DT] NQ 1
THEN # IF TC AND DT NOT COMPATIBLE #
BEGIN # FLAG ERROR -- INVALID WITH TC SPECIFIED #
NDLEM2(ERR110,STLNUM[0],DTNAME[CRNT$DT]);
CRNT$DT = DT"UNKNOWN"; # CLEAR CURRENT DEVICE TYPE #
END
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN # IF STIP IS NOT UNKNOWN #
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN
BEGIN # IF STIP AND DT NOT COMPATIBLE #
IF B<CRNT$STIP,1>DT$STIP$MAP[CRNT$DT] NQ 1
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP SPEC #
NDLEM2(ERR111,STLNUM[0],DTNAME[CRNT$DT]);
CRNT$DT = DT"UNKNOWN"; # CLEAR CURRENT DT #
END
END
ELSE # STIP IS UNKNOWN #
BEGIN # IF TIPTYPE IS NOT UNKNOWN #
IF CRNT$TIP NQ TIP"UNKNOWN"
THEN
BEGIN # IF TIPTYPE AND DT NOT COMPAT #
IF B<CRNT$TIP,1>DT$TIP$MAP[CRNT$DT] NQ 1
THEN
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR112,STLNUM[0],DTNAME[CRNT$DT]);
CRNT$DT = DT"UNKNOWN"; # CLEAR CURRENT DT #
END
END
END
END
END
END
END
ELSE # DT WAS NOT SPECIFIED #
BEGIN
IF CRNT$TIP NQ TIP"USER" # IF TIP IS NOT USER #
THEN
BEGIN
IF CRNT$TIP EQ TIP"X25" AND CRNT$STIP EQ STIP"XAA"
THEN # IF X25 TIP AND XAA STIP #
BEGIN
CRNT$DT = DT"AP"; # DEFAULT TO AP #
DEDT[CRNT$DEV + 2] = DT$NUMV[DT"AP"];
END
ELSE
BEGIN
CRNT$DT = DT"CON"; # ELSE CONSOLE IS THE DEFAULT #
END
END
END
IF DEVCNT GR MAXDEV # MAXIMUM NUMBER OF DEVICE STMTS EXCEEDED #
THEN
BEGIN # FLAG ERROR -- MAX DEVICE STMTS EXCEEDED #
NDLEM2(ERR116,STLNUM[0]," ");
END
IF CRNT$TIP NQ TIP"USER" AND
CRNT$TIP NQ TIP"UNKNOWN" AND
CRNT$DT NQ DT"UNKNOWN" AND
NOT AUTO$REC # IF TIP IS NOT USER OR UNKNOWN #
THEN # AND DT IS NOT UNKNOWN #
BEGIN # AND NOT AN AUTO-REC LINE #
DT$CNT[CRNT$DT] = DT$CNT[CRNT$DT] + 1; # INCR COUNT FOR DT #
IF DT$CNT[CRNT$DT] GR DT$MAX[CRNT$DT]
THEN # IF COUNT EXCEEDS MAX FOR DT #
BEGIN # FLAG ERROR -- MAX DT EXCEEDED #
NDLEM2(ERR142,STLNUM[0],DTNAME[CRNT$DT]);
END
IF CRNT$TIP EQ TIP"HASP" AND # IF CURRENT TIPTYPE IS HASP #
(CRNT$DT EQ DT"CP" OR CRNT$DT EQ DT"PL")
THEN
BEGIN # -CP- PLUS -PL- MUST NOT EXCEED MAXIMUM #
ITEMP = DT$CNT[DT"CP"] + DT$CNT[DT"PL"];
IF ITEMP GR DT$MAX[DT"CP"] # IF SUM EXCEEDS MAXIMUM #
THEN
BEGIN # FLAG ERROR - MAX NUM OF DEV EXCEEDED #
NDLEM2(ERR142,STLNUM[0],DTNAME[CRNT$DT]);
END
END
END
IF (CRNT$TIP NQ TIP"USER" AND CRNT$TIP NQ TIP"UNKNOWN") AND
(CRNT$DT NQ DT"USER" AND CRNT$DT NQ DT"UNKNOWN")
THEN
BEGIN # IF TIP AND DT NOT USER OR UNKNOWN #
GOTO DEVPJUMP[CRNT$TIP]; # JUMP TO APPROPRIATE PARAGRAPH #
ASYNC:
ASYDEV; # CHECK FOR ASYNC DEVICES #
GOTO NEXT;
MODE4:
MD4DEV; # CHECK FOR MODE4 DEVICES #
GOTO NEXT;
HASP:
HSPDEV; # CHECK FOR HASP DEVICES #
GOTO NEXT;
X25:
X25DEV; # CHECK FOR X25 DEVICES #
GOTO NEXT;
BSC:
BSCDEV; # CHECK FOR BSC DEVICES #
GOTO NEXT;
$3270:
$3270DEV; # CHECK FOR 3270 DEVICES #
GOTO NEXT;
NEXT:
END
ELSE # TIP OR DT IS USER OR UNKNOWN #
BEGIN
USRDEV; # CHECK USER DEVICES #
END
COUNT$LK; # CALL LOGLINK COUNTER #
IF CRNT$TIP NQ TIP"USER" AND # IF TIP IS NOT USER #
CRNT$DT EQ DT"CON" # AND DT IS CONSOLE #
THEN
BEGIN
IF NOT HN$USED # IF HN WAS NOT SPECIFIED #
THEN
BEGIN
IF LL$CNT EQ 1 # IF ONLY ONE LOGLINK TO THIS NPU #
THEN
BEGIN # DEFAULT HN VALUE #
DEVFNFV(FN"HN",LLTHNID[LLT$PNTR]);
IF NOT AUTOCON$FLAG AND # IF NOT ALREADY SPEC AS -YES- #
NOT AUTOCON$NO # AND NOT SPECIFIEC AS -NO- #
THEN
BEGIN
DEVFNFV(FN"AUTOCON",TRUE);# DEFAULT AUTO CONNECT #
END
END
ELSE # NONE OR MORE THAN ONE LOGLINK #
BEGIN
IF AUTOCON$FLAG
# IF AUTO CONNECT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"HN");
END
ELSE
BEGIN
IF SAVE$ENTRY GR 0
# IF MORE THAN ONE LOGLINK IS FOUND
AND HOST NAMES ARE THE SAME #
THEN
BEGIN
DEVFNFV(FN"HN",LLTHNID[SAVE$ENTRY]);
# DEFAULT TO THE LAST MATCH FOUND #
IF NOT AUTOCON$FLAG AND NOT AUTOCON$NO
THEN # IF AUTOCON NOT SPECIFIED AS YES OR NO #
BEGIN
DEVFNFV(FN"AUTOCON",TRUE); # DEFAULT TO AUTOCON YES #
END
END
END
END
END
END
DEVFNFV(FN"RIC",RIC$FLAG);
# NUMBER OF 8-BIT PAD ENTRIES #
DEPAD[CRNT$DEV + 1] = CRNT$DEPAD;
FOR I = 0 STEP 1 UNTIL CRNT$DEPAD-1
DO
BEGIN # ASSIGN PAD VALUES FOR THIS DEVICE #
PWI = I*8/60 + 1; # PAD WORD INDEX (1-RELATIVE)#
PDI=I*8 -(PWI-1)*60; # PAD WORD DISPLACEMENT INDEX (0-RELATIVE)#
IF PDI LS 56
THEN
BEGIN # 8-BIT ENTRIES DO NOT CROSS WORD BOUNDARY#
ITEMP =
B<PDI
,8>CRNT
$PAD
[PWI
]; END
ELSE
BEGIN # NEW WORD BOUNDARY #
B<
52,4>ITEMP =
B<PDI
,4>CRNT
$PAD
[PWI
]; # FIRST 4-BIT NIBBLE # B<56,4>ITEMP = B<0,4>CRNT$PAD[PWI+1]; # SECOND " " #
END
# PAD FNS ASSIGNED IN CONSEC. SEQ., STARTING FROM PAD$FN$FIRST #
DEVFNFV(PAD$FN$FIRST+I,ITEMP);
# I=10/I DIVIDE BY 0 ERROR: TRAP #
END
DEWC[CRNT$DEV] = (LRWC[1] - CRNT$DEV)+ 1;
TEWC[CRNT$TERM] = TEWC[CRNT$TERM] + DEWC[CRNT$DEV];
# SET TERM ENTRY WC #
RETURN; # **** RETURN **** #
END # DEVPR #
CONTROL EJECT;
PROC LINFNFV(FN,FV);
BEGIN
*IF,DEF,IMS
#
** LINFNFV - MAKE FNFV ENTRY FOR LINE.
*
* D.K. ENDO 81/11/20
*
* THIS PROC PUTS AN FNFV PAIR INTO THE CURRENT LINE CONFIGURE ENTRY.
*
* PROC LINFNFV(FN,FV)
*
* ENTRY FN = FIELD NUMBER.
* FV = FIELD VALUE.
*
* EXIT NONE.
*
* METHOD
*
* INCREMENT FNFV PAIR COUNT IN CURRENT LINE CONFIGURE ENTRY.
* INCREMENT ENTRY WORD COUNT.
* PUT FNFV PAIR IN ENTRY.
*
#
*ENDIF
ITEM FN; # FIELD NUMBER #
ITEM FV; # FIELD VALUE #
# #
# LINFNFV CODE BEGINS HERE #
# #
LCFNFV[3] = LCFNFV[3] + 1; # INCREMENT FNFV COUNT #
LCWC[0] = LCWC[0] + 1; # INCREMENT WORD COUNT OF TABLE #
LCFN[LCWC[0]] = FN; # PUT FIELD NUMBER IN ENTRY ONE #
LCFV[LCWC[0]] = FV; # PUT FIELD VALUE IN ENTRY ONE #
RETURN; # **** RETURN **** #
END # LINFNFV #
CONTROL EJECT;
PROC LINGRPR;
BEGIN
*IF,DEF,IMS
#
** LINGRPR - LINE/GROUP STATEMENT PROC
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETERS ON LINE AND GROUP STATEMENTS.
*
* PROC LINGRPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* CLEAR AND INITIALIZE FLAG AND VALUES.
* CLEAR LINE CONFIG ENTRY BUFFER.
* IF LABEL IS O.K.,
* PUT LABEL FROM STMT ENTRY INTO LINE XREF TABLE.
* PUT LABEL IN LINE RECORD.
* IF CURRENT STMT IS -GROUP-,
* DEFAULT GROUP COUNT IN LINE RECORD.
* DEFAULT NI VALUE IN LINE CONFIG ENTRY.
* PUT LABEL FROM LABEL TABLE INTO LINE XREF TABLE.
* PUT PORT VALUE FROM LABEL TABLE INTO LINE XREF TABLE.
* PUT CURRENT NODE I.D. INTO LINE XREF TABLE.
* PUT CURRENT NODE I.D. INTO LINE RECORD.
* IF LTYPE WAS SPECIFIED,
* THEN,
* IF VALUE IS O.K.
* MAP NUMERIC VALUE FOR LTYPE
* PUT NUMERIC VALUE FOR LTYPE INTO LINE CONFIG ENTRY.
* OTHERWISE,
* FLAG ERROR REQUIRED PARAMETER MISSING.
* SET CURRENT LTYPE TO UNKNOWN.
* IF TIPTYPE WAS SPECIFIED,
* THEN,
* IF VALUE IS O.K.
* MAP NUMERIC VALUE FOR TIPTYPE
* IF TIPTYPE IS USER,
* THEN,
* SET CURRENT TIPTYPE TO USER
* PUT NUMERIC VALUE INTO LINE CONFIG ENTRY.
* OTHERWISE,
* SET CURRENT TIPTYPE
* PUT NUMERIC VALUE INTO LINE CONFIG ENTRY.
* IF LTYPE IS NOT UNKNOWN,
* IF LTYPE IS NOT COMPATIBLE WITH TIPTYPE,
* FLAG ERROR -- LTYPE AND TIPTYPE NOT COMPATIBLE.
* OTHERWISE,
* SET CURRENT TIPTYPE TO UNKNOWN.
* IF AUTO OR XAUTO WAS SPECIFIED,
* IF CURRENT TIPTYPE IS -X25-,
* THEN
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH TIPTYPE SPECIFIED.
* OTHERWISE,
* IF VALUE IS -YES-
* SET AUTO-REC FLAG IN LINE CONFIG ENTRY.
* SET AUTO-REC FLAG IN LINE RECORD.
* IF XAUTO IS SPECIFIED
* SET HIGH SPEED FLAG IN LINE CONFIG ENTRY.
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(AL,PORT,NI,DI,SL,P90,P91,...,P99):
* CHECK GENERAL LINE PARAMETER.
* CASE 2(DFL,FRAME,RTIME,RCOUNT,NSVC,PSN,DCE,DTEA):
* IF TIPTYPE IS X25 OR LTYPE IS X.25 AND TIPTYPE IS USER,
* THEN,
* CHECK X.25 PARAMETER.
* OTHERWISE,
* FLAG ERROR -- PARAMETER NOT ALLOWED WITH TIPTYPE SPECIFIED
* CASE 3(LSPEED):
* IF TIPTYPE NOT ASYNC OR USER,
* THEN,
* FLAG ERROR -- LSPEED ALLOWED ON ASYNC NON-AUTO REC LINES.
* OTHERWISE,
* IF TIPTYPE IS ASYNC AND LINE IS AUTO-REC,
* THEN,
* FLAG ERROR -- ALLOWED ON ASYNC NON-AUTO REC LINES ONLY.
* OTHERWISE,
* MAP NUMERIC VALUE FOR LSPEED.
* PUT VALUE IS LINE CONFIG ENTRY.
* CASE 4(ARSPEED):
* CHECK ASYNC PARAMETERS.
* IF PORT WAS NOT SPECIFIED,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF AL WAS NOT SPECIFIED,
* MAKE FNFV ENTRY FOR DEFAULT AL.
* IF AESPEED NOT SPECIFIED,
* IF TIPTYPE IS ASYNC AND EITHER AUTO OR XAUTO IS SET TO YES,
* SET ARSPEED FLAG TO TRUE IN LINE CONFIGURATION RECORD.
* IF TIPTYPE IS ASYNC,
* IF LSPEED WAS NOT SPECIFIED AND LINE IS NON-AUTO REC.
* DEFAULT LSPEED IN LINE CONFIG ENTRY.
* IF TIPTYPE IS X.25,
* IF DFL,FRAME,RTIME,PSN NOT SPECIFIED,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF RCOUNT,DCE,ACCTYPE NOT SPECIFIED,
* PUT DEFAULT VALUE IN LINE CONFIG ENTRY.
* IF TIPTYPE IS X.25 OR LTYPE IS X.25 AND TIPTYPE IS USER,
* IF NSVC WAS NOT SPECIFIED
* DEFAULT NSVC VALUE INTO LINE CONFIG ENTRY.
* IF LINE NOT AUTO-REC,
* DEFAULT MAXIMUM TERMINAL STATEMENTS BY TIPTYPE.
*
#
*ENDIF
#
**** PROC LINGRPR - XREF LIST BEGIN.
#
XREF
BEGIN
PROC NDLEM2; # MAKE ENTRIES IN ERROR-2-FILE #
END
#
****
#
DEF DEF$DCE # 0 #; # DEFAULT VALUE FOR DCE #
DEF DEF$LSPD # 4 #; # DEFAULT VALUE FOR LSPEED #
DEF DEF$RCNT # 15 #; # DEFAULT VALUE FOR RCOUNT #
DEF LC$FIX$ENT # 3 #; # LENGTH OF FIXED PORTION OF LC ENTRY #
DEF MXDTEA # 2 #; # MAXIMUM LENGTH OF DTEA VALUE ALLOWED #
DEF ZERO # O"33" #; # DISPLAY CODE VALUE FOR ZERO #
ITEM DCEUSED B; # DCE DECLARED FLAG #
ITEM DCE$FLG B; # SET IF DCE WAS SPECIFIED -YES- #
ITEM DFLUSED B; # DFL DECLARED FLAG #
ITEM DTEAUSED B; # DTEA SPECIFIED FLAG #
ITEM FRMUSED B; # FRAME DECLARED FLAG #
ITEM I; # SCRATCH ITEM #
ITEM J; # SCRATCH ITEM #
ITEM LSPDUSED B; # LSPEED DECLARED FLAG #
ITEM ARSUSED B; # ARSPEED DECLARED FLAG #
ITEM NSVCUSED B; # NSVC DECLARED FLAG #
ITEM PORTUSED B; # PORT DECLARED FLAG #
ITEM PSNUSED B; # PSN DECLARED FLAG #
ITEM RCNTUSED B; # RCOUNT DECLARED FLAG #
ITEM RTMUSED B; # RTIME DECLARED FLAG #
ITEM AL$USED B; # AL DECLARED FLAG #
ARRAY DTEA$VALUE [0:0] S(1);
BEGIN
ITEM DTEA$VL1 U(00,00,04); # 1ST DIGIT OF DTEA VALUE #
ITEM DTEA$VL2 U(00,04,04); # 2ND DIGIT OF DTEA VALUE #
ITEM DTEA$VAL U(00,00,08); # DTEA VALUE #
END
DEF MXLTYPE # 9 #; # MAXIMUM NUMBER OF LINE TYPES #
ARRAY LTYPE$TABLE [1:MXLTYPE] S(2); # LINE TYPE TABLE #
BEGIN
ITEM LT$VAL C(0,0,7) = ["S1", # LTYPE VALUES #
"S2",
"S3",
"S4",
"A1",
"A2",
"A6",
"H1",
"H2"
];
ITEM LT$NUMV (0,42,18) = [1, # S1 LTYPE NUMERICAL VALUES#
2, # S2 #
3, # S3 #
11, # S4 #
6, # A1 #
7, # A2 #
9, # A6 #
10, # H1 #
12 # H2 #
];
ITEM LT$CAT C(1,0,10) = ["SYNC", # S1 LINE TYPE CATEGORY #
"SYNC", # S2 #
"SYNC", # S3 #
"SYNC", # S4 #
"ASYNC", # A1 #
"ASYNC", # A2 #
"ASYNC", # A6 #
"X25", # H1 #
"X25" # H2 #
];
END
DEF MXTTYPE # 9 #; # MAXIMUM NUMBER OF TIP-TYPES #
ARRAY TIPTYPE$TABL [1:MXTTYPE] S(1); # TIPTYPE TABLE #
BEGIN
ITEM TT$VAL C(0,0,7) = ["ASYNC", # TIPTYPE VALUES #
"MODE4",
"HASP",
"X25",
"BSC",
"TT12",
"TT13",
"TT14",
"3270"
];
ITEM TT$NUMV (0,42,18) = [1, # ASYNC TIPTYPE NUMERICAL VALUE#
2, # MODE4 #
3, # HASP #
4, # X25 #
5, # BSC #
12, # USER -- TT12 #
13, # USER -- TT13 #
14, # USER -- TT13 #
15 # 3270 #
];
END
DEF MXLSPD # 11 #; # MAXIMUM NUMBER OF LINE SPEEDS #
ARRAY LSPD$TABLE [1:MXLSPD] S(1); # LINE SPEED TABLE #
BEGIN
ITEM LST$VAL C(0,0,7) = ["110",# LINE SPEED VALUES #
"134",
"150",
"300",
"600",
"1200",
"2400",
"4800",
"9600",
"19200",
"38400"
];
ITEM LST$NUMV (0,42,18) = [1, # 110 LSPEED NUMERICAL VALUES #
2, # 134 #
3, # 150 #
4, # 300 #
5, # 600 #
6, # 1200 #
7, # 2400 #
8, # 4800 #
9, # 9600 #
10, # 19200 #
11 # 38400 #
];
END
ARRAY X25$PARAMS [KID"DFL":KID"W"] S(1);
BEGIN
ITEM X25$PNAM C(00,00,10) = ["DFL", # X25 PARAM NAMES #
"FRAME",
"RTIME",
"RCOUNT",
"NSVC",
"PSN",
"DCE",
"DTEA",
,
"LCN",
,,,,,,,,,,,,
"W",
];
END
SWITCH LINJUMP NEXT , , # UNKNOWN , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, GEN$PARAM , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
GEN$PARAM , GEN$PARAM , # NI , PORT ,#
NEXT , NEXT , # LTYPE , TIPTYPE ,#
NEXT , GEN$PARAM , # AUTO , AL ,#
ASY$PARAM , X25$PARAM , # LSPEED , DFL ,#
X25$PARAM , X25$PARAM , # FRAME , RTIME ,#
X25$PARAM , X25$PARAM , # RCOUNT , NSVC ,#
X25$PARAM , X25$PARAM , # PSN , DCE ,#
X25$PARAM , ASY$PARAM , # DTEA , ARSPEED ,#
X25$PARAM , GEN$PARAM , # LCN , IMDISC ,#
GEN$PARAM , , # RC , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, , # NEN , COLLECT ,#
NEXT , , # XAUTO , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # UBZ , DBL ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PI ,#
GEN$PARAM , GEN$PARAM , # P90 , P91 ,#
GEN$PARAM , GEN$PARAM , # P92 , P93 ,#
GEN$PARAM , GEN$PARAM , # P94 , P95 ,#
GEN$PARAM , GEN$PARAM , # P96 , P97 ,#
GEN$PARAM , GEN$PARAM ; # P98 , P99 #
CONTROL EJECT;
PROC GENLINE;
BEGIN
*IF,DEF,IMS
#
** GENLINE - CHECK GENERAL LINE PARAMETERS.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETERS WHICH ARE COMMON TO ALL TIPTYPES.
*
* PROC GENLINE
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* SELECT THE CASE THAT APPLIES,
* CASE 1(PORT):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE IN LINE RECORD.
* PUT VALUE IN LINE XREF ENTRY.
* IF STATEMENT IS NOT -GROUP-,
* PUT VALUE IN LINE RECORD INDEX.
* CHECK IF PORT VALUE IS UNIQUE FOR CURRENT NPU.
* CASE 2(DI):
* IF VALUE IS O.K.
* IF VALUE IS -YES-,
* SET STATUS FLAG IN LINE CONFIG ENTRY.
* CASE 3(NI):
* IF VALUE IS O.K.
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT THE VALUE MINUS ONE IN THE LINE RECORD
* PUT VALUE IN LINE CONFIG ENTRY.
* IF LABEL IS O.K. AND NI VALUE IS GREATER THAN ONE,
* FOR EACH ITERATION OF PORT
* INCREMENT LINE XREF TABLE ENTRY COUNT.
* CLEAR NEXT ENTRY.
* PUT CURRENT NODE I.D. IN ENTRY.
* PUT GENERATED NAME FROM LABEL TABLE IN ENTRY.
* CHECK IF PORT IS IN RANGE.
* IF IN RANGE,
* PUT PORT VALUE IN ENTRY.
* CHECK IF PORT IS UNIQUE FOR CURRENT NPU.
* CASE 4(AL):
* IF VALUE IS WITHIN RANGE,
* MAKE FNFV ENTRY FOR AL SPECIFIED.
* CASE 5(SL,P90,P91,P92,...,P99):
* IF VALUE IS O.K.
* IF VALUE IS NOT -NONE-,
* CHECK IF VALUE IS IN RANGE,
* IF IN RANGE,
* PUT VALUE IN LINE CONFIG ENTRY.
*
#
*ENDIF
#
**** PROC GENLINE - XREF LIST BEGIN.
#
XREF
BEGIN
PROC NDLCKPT; # CHECK UNIQUENESS OF PORT NUMBER #
PROC NDLCKRG; # CHECK IF VALUE IS IN RANGE #
END
#
****
#
DEF DI$VAL # 1 #; # VALUE FOR DISABLED #
ITEM GENL$STAT B; # RETURNED STATUS FROM CHECK ROUTINES #
ITEM J; # SCRATCH ITEM #
# #
SWITCH GENLJUMP NEXT$PARAM , , # UNKNOWN , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, DI , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
NI , PORT , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, AL , # AUTO , AL ,#
, , # LSPEED , DFL ,#
, , # FRAME , RTIME ,#
, , # RCOUNT , NSVC ,#
, , # PSN , DCE ,#
, , # DTEA , ,#
, IMDISC , # , IMDISC ,#
RC , , # RC , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, , # MREC , W ,#
, , # CTYP , NCIR ,#
, , # NEN , COLLECT ,#
, , # , DT ,#
, , # SDT , TA ,#
, , # ABL , DBZ ,#
, , # DBL , UBZ ,#
, , # UBL , XBZ ,#
, , # DO , STREAM ,#
, , # HN , AUTOLOG ,#
, , # AUTOCON , PRI ,#
USER$PARAM , USER$PARAM , # P90 , P91 ,#
USER$PARAM , USER$PARAM , # P92 , P93 ,#
USER$PARAM , USER$PARAM , # P94 , P95 ,#
USER$PARAM , USER$PARAM , # P96 , P97 ,#
USER$PARAM , USER$PARAM ; # P98 , P99 #
CONTROL EJECT;
# #
# GENLINE CODE BEGINS HERE #
# #
GOTO GENLJUMP[STKWID[I]]; # JUMP BY KEYWORD I.D. #
PORT:
PORTUSED = TRUE; # SET PORT SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"DEC",GENL$STAT);
# MAX USER VALUE #
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],GENL$STAT); # CHECK FOR MAX #
# NORMAL VALUE #
END
IF GENL$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
LRPORT[2] = STVALNUM[I]; # PUT PORT IN LINE-RECORD #
LCPORT[1] = STVALNUM[I]; # PUT PORT IN LINE-CONFIG-RECORD#
IF STSTID[0] NQ STID"GROUP" # IF THIS STMT IS GROUP #
THEN
BEGIN
LCTPORT[LCTWC[1]] = STVALNUM[I]; # PUT PORT IN LINE XREF #
END
NDLCKPT(STVALNUM[I],CRNT$NID,GENL$STAT); # CHECK PORT #
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
DI:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
LCST[3] = DI$VAL; # SET STATUS FLAG IN LINE-CONFIG#
END # RECORD #
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
IMDISC:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF YES IS SPECIFIED #
THEN
BEGIN
LINFNFV(FN"IMD",TRUE); # STORE LINE FNFV #
END
ELSE
BEGIN
LINFNFV(FN"IMD",FALSE); # STORE LINE FNFV #
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
NI:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"DEC",GENL$STAT);
# USER VALUE #
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],GENL$STAT); # CHECK FOR MAX #
# NORMAL VALUE #
END
IF GENL$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
LRGC[1] = STVALNUM[I] - 1; # PUT -NI- IN LINE-RECORD #
LCNI[0] = STVALNUM[I]; # PUT -NI- IN LINE-CONFIG-RECORD#
IF LCTWC[1]+LCNI[0] GQ LCT$LENG
THEN # IF NEED MORE SPACE FOR ENTRIES #
BEGIN
SSTATS(P<LINE$XREF>,LCNI[0]+1); # ALLOCATE MORE TABLE SPACE#
END
IF NOT STLBERR[1] AND STVALNUM[I] GR 1
THEN # IF LABEL IS O.K. AND -NI- GREATER THAN 1#
BEGIN # MAKE ENTRY IN LINE-XREF FOR EACH LABEL#
FOR J=STLBPNTR[1]+1 STEP 1 UNTIL (STLBPNTR[1] + LCNI[0]) - 1
DO # BEGINNING WITH THE SECOND LABEL #
BEGIN
LCTWC[1] = LCTWC[1] + 1; # INCREMENT ENTRY COUNT #
LCTWORD[LCTWC[1]] = 0; # CLEAR ENTRY #
LCTNAME[LCTWC[1]] = LABLNAM[J]; # ENTER LABEL #
LCTNID[LCTWC[1]] = CRNT$NID; # ENTER NPU NODE I.D. #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER #
THEN
BEGIN
USR$RANGE(LABLPORT[J],USR$WID1,NUM"DEC",GENL$STAT);
# VALUE CHECK#
END
ELSE
BEGIN
NDLCKRG(KID"PORT",LABLPORT[J],GENL$STAT); # CHECK NORMAL#
# RANGE #
END
IF GENL$STAT # IF PORT IS WITHIN RANGE #
THEN
BEGIN
LCTPORT[LCTWC[1]] = LABLPORT[J]; # PUT -PORT- IN XREF #
NDLCKPT(LABLPORT[J],CRNT$NID,GENL$STAT); # CHECK PORT #
END
END
END
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
AL:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"DEC",GENL$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],GENL$STAT); # CHECK RANGE #
END
IF GENL$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # ENTER FNFV PAIR IN RECORD #
AL$USED = TRUE; # SET AL USED FLAG #
B<38,1>STVALNUM[I] = 1; # SET VALID FLAG #
LINFNFV(FN"AL",STVALNUM[I]);
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
RC:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF YES IS SPECIFIED #
THEN
BEGIN
LINFNFV(FN"RC",TRUE); # STORE LINE FNFV #
END
ELSE
BEGIN
LINFNFV(FN"RC",FALSE); # STORE LINE FNFV #
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
USER$PARAM:
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"HEX",GENL$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],GENL$STAT); # CHECK FOR MAX #
# VALUE RANGE #
END
IF GENL$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # MAKE FNFV PAIR ENTRY IN RECORD#
LINFNFV(STKWID[I]+10,STVALNUM[I]);
END
END
GOTO NEXT$PARAM; # CHECK NEXT PARAMETER #
NEXT$PARAM:
RETURN; # **** RETURN **** #
END # GENLINE #
CONTROL EJECT;
PROC X25LINE;
BEGIN
*IF,DEF,IMS
#
** X25LINE - CHECK X.25 LINE PARAMETERS
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS PARAMETERS LEGAL FOR X.25 LINES.
*
* PROC X25LINE
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES
* CASE 1(DFL,FRAME,RCOUNT,NSVC):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* PUT VALUE IN LINE CONFIG ENTRY.
* CASE 2(RTIME):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* DIVIDE VALUE BY 100.
* PUT RESULT IN LINE CONFIG ENTRY.
* CASE 3(PSN):
* IF VALUE IS O.K.,
* MAP PSN TO NUMERIC VALUE.
* PUT VALUE IN LINE CONFIG ENTRY.
* CASE 4(DCE):
* IF VALUE IS O.K.,
* IF VALUE IS -YES-,
* THEN,
* PUT VALUE OF TRUE IN LINE CONFIG ENTRY.
* OTHERWISE,
* PUT VALUE OF FALSE IN LINE CONFIG ENTRY.
* CASE 5(DTEA):
* IF VALUE IS WITH RANGE,
* PERFORM FNFV ENTRY FOR DTEA SPECIFIED.
*
#
*ENDIF
#
**** PROC X25LINE - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS IF VALUE IS WITHIN RANGE #
FUNC XCDD U; # CONVERT INTEGER TO DECIMAL DISPLAY CODE #
END
#
****
#
ITEM ITEMP; # INTEGER TEMPORARY #
ITEM J; # SCRATCH ITEM #
ITEM VALUE; # INTEGER TEMPORARY FOR VALUE #
ITEM X25$STAT B; # RETURNED STATUS FROM RANGE CHECK PROC #
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 U(0,30,30); # VALUE #
END
DEF MXPSN # 10 #; # MAXIMUM NUMBER OF PSN VALUES #
ARRAY PSN$TABLE [1:MXPSN] S(1);
BEGIN
ITEM PSN$VAL C(0,0,7) = [ "DATAPAC", # PSN VALUES #
"TELENET",
"TRNSPAC",
"TYMNET ",
"CDSN ",
"UNINET",
"C120 ",
"PSN253 ",
"PSN254 ",
"PSN255 "
];
ITEM PSN$NUMV (0,42,18) = [ 1, # PSN NUMERICAL VALUES#
2,
3,
4,
5,
6,
7,
253,
254,
255
];
END
SWITCH X25JUMP , , # UNKNOWN , NODE ,#
, , # VARIANT , OPGO ,#
, , # DMP , LLNAME ,#
, , # , ,#
, , # , ,#
, , # HNAME , LOC ,#
, , # , ,#
, , # , ,#
, , # , ,#
, , # NCNAME , DI ,#
, , # N1 , P1 ,#
, , # N2 , P2 ,#
, , # NOLOAD1 , NOLOAD2 ,#
, , # , ,#
, , # , ,#
, , # NI , PORT ,#
, , # LTYPE , TIPTYPE ,#
, , # AUTO , SL ,#
, DFL , # LSPEED , DFL ,#
FRAME , RTIME , # FRAME , RTIME ,#
RCOUNT , NSVC , # RCOUNT , NSVC ,#
PSN , DCE , # PSN , DCE ,#
DTEA , , # DTEA , ,#
LCN , , # LCN , ,#
, , # , ,#
, , # STIP , TC ,#
, , # RIC , CSET ,#
, , # TSPEED , CA ,#
, , # CO , BCF ,#
, ; # MREC , W #
# #
# X25LINE CODE BEGINS HERE #
# #
GOTO X25JUMP[STKWID[I]]; # CASE ON KEYWORD I.D. #
DFL:
DFLUSED = TRUE; # SET DFL SPECIFIED FLAG #
IF NOT STVLERR[I] # IF THE VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID2,NUM"DEC",X25$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # NORMAL RANGE #
# CHECKS #
END
IF X25$STAT # IF IT IS IN RANGE #
THEN # STORE DFL VALUE IN LINE #
BEGIN # CONFIGURE RECORD #
IF CRNT$TIP EQ TIP"X25"
THEN
BEGIN
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
LINFNFV(FN"DFL",J); # STORE DFL VALUE #
IF STVALNUM[I] NQ ITEMP
THEN # VALUE IS NOT POWER OF 2 #
BEGIN # FLAG WARNING #
PARAM[0] = X25$PNAM[STKWID[I]]; # PARAMETER NAME #
PVALUE[0] = XCDD(ITEMP); # STORE VALUE #
NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
END
END
ELSE # MUST BE A USER TIPTYPE #
BEGIN
LINFNFV(FN"DFL",STVALNUM[I]); # STORE DFL VALUE #
END
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
FRAME:
FRMUSED = TRUE; # SET FRAME SPECIFIED FLAG #
IF NOT STVLERR[I] # IF THE VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"DEC",X25$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # NORMAL RANGE #
# CHECKS #
END
IF X25$STAT # IF VALUE IS WITHIN RANGE #
THEN # STORE FRAME VALUE #
BEGIN
LINFNFV(FN"FRAME",STVALNUM[I]);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
LCN:
IF NOT STVLERR[I] # IF THE VALUE IS O.K. #
THEN
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # CHECK RANGE #
IF X25$STAT # IF VALUE IS WITHIN RANGE #
THEN # STORE LCN VALUE #
BEGIN
LINFNFV(FN"LCN",STVALNUM[I]);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
RTIME:
RTMUSED = TRUE; # SET RTIME SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1*100,NUM"DEC",X25$STAT);
# MULTIPLES OF 100#
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # NORMAL RANGE #
# CHECKS #
END
IF X25$STAT # IF VALUE IS IN RANGE #
THEN # DIVIDE THE VALUE BY 100 #
BEGIN # AND ROUND UP TO THE NEAREST #
ITEMP = STVALNUM[I]; # MULTIPLE OF 100 #
FOR VALUE=0 STEP 1 WHILE ITEMP GR 0
DO
BEGIN
ITEMP = ITEMP - 100;
END # STORE VALUE IN LIN$CON$REC #
LINFNFV(FN"RTIME",VALUE);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
RCOUNT:
RCNTUSED = TRUE; # SET RCOUNT SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID1,NUM"DEC",X25$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # NORMAL RANGE #
# CHECKS #
END
IF X25$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN # STORE RCOUNT IN LIN$CON$REC #
LINFNFV(FN"RCOUNT",STVALNUM[I]);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
NSVC:
NSVCUSED = TRUE; # SET NSVC SPECIFIED FLAG #
NSVCERR = TRUE; # SET NSVC ERROR FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(STVALNUM[I],USR$WID2,NUM"DEC",X25$STAT);
END
ELSE
BEGIN
NDLCKRG(STKWID[I],STVALNUM[I],X25$STAT); # NORMAL RANGE #
# CHECKS #
END
IF X25$STAT # IF VALUE IS WITHIN RANGE #
THEN
BEGIN
NSVCERR = FALSE; # CLEAR NSVC ERROR FLAG #
SVC$CNT = STVALNUM[I]; # SAVE NSVC VALUE #
LINFNFV(FN"SVC",SVC$CNT);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
PSN:
PSNUSED = TRUE; # SET PSN SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # SEARCH PSN TABLE FOR VALUE #
FOR J=1 STEP 1 UNTIL MXPSN
DO
BEGIN
IF STVALNAM[I] EQ PSN$VAL[J] # IF VALUE IS FOUND #
THEN
BEGIN #STORE NUMERICAL VALUE IN RECORD#
LINFNFV(FN"PSN",PSN$NUMV[J]);
END
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
DCE:
DCEUSED = TRUE; # SET DCE SPECIFIED FLAG #
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
IF STVALNAM[I] EQ "YES" # IF VALUE IS YES #
THEN
BEGIN # STORE VALUE -TRUE- IN RECORD #
LINFNFV(FN"DCE",TRUE);
DCE$FLG = TRUE; # SET DCE FLAG #
END
ELSE # VALUE IS NO #
BEGIN # STORE VALUE -FALSE- IN RECORD #
LINFNFV(FN"DCE",FALSE);
END
END
GOTO NEXT$PARAM; # GO TO NEXT PARAMETER #
DTEA:
DTEAUSED = TRUE; # SET DTEA SPECIFIED FLAG #
IF NOT STVLERR[I]
THEN # IF VALUE IS O.K. #
BEGIN
IF STVALLEN[I] LQ MXDTEA
THEN # IF VALUE IS WITHIN RANGE #
BEGIN # CONVERT VALUE #
DTEA$VAL[0] = 0; # CLEAR DTEA TEMPORARY #
DTEA$VL1[0] = C<0,1>STVALNAM[I] - ZERO;
IF STVALLEN[I] GR 1
THEN # IF VALUE IS TWO DIGITS #
BEGIN
DTEA$VL2[0] = C<1,1>STVALNAM[I] - ZERO;
END
LINFNFV(FN"DTEA",DTEA$VAL[0]); # PUT VALUE IN LINE ENTRY #
END
ELSE # VALUE IS TOO BIG #
BEGIN # FLAG ERROR -- VALUE OUT OF RANGE #
NDLEM2(ERR100,STLNUM[0],STVALNAM[I]);
END
END
GOTO NEXT$PARAM;
GOTO NEXT$PARAM;
NEXT$PARAM:
RETURN; # **** RETURN **** #
END # X25LINE #
CONTROL EJECT;
# #
# LINGRPR CODE BEGINS HERE #
# #
CRNT$LSPD = LSPD"UNKNOWN"; # AND INITIALIZE VALUES #
DCEUSED = FALSE;
DCE$FLG = FALSE;
DEVCNT = 0;
DFLUSED = FALSE;
DTEAUSED = FALSE;
FRMUSED = FALSE;
LSPDUSED = FALSE;
ARSUSED = FALSE;
NSVCUSED = FALSE;
PORTUSED = FALSE;
AL$USED = FALSE;
PSNUSED = FALSE;
RCNTUSED = FALSE;
RTMUSED = FALSE;
LCR$EXIST = TRUE; # SET LINE CONFIG REC EXISTS FLG#
LCTWC[1] = LCTWC[1] + 1; # INCREMENT WORD COUNT IN XREF #
LCTWORD[LCTWC[1]] = 0; # CLEAR ENTRY WORD IN XREF #
LR$EXIST = TRUE; # SET LINE RECORD EXISTS FLAG #
LRWORD[1] = 0; # CLEAR WORD 1 IN LINE RECORD #
LRWORD[2] = 0; # CLEAR WORD 2 IN LINE RECORD #
LRWC[1] = 2; # SET WORD COUNT IN LINE RECORD #
LCWORD[0] = 0; # CLEAR FIRST WORD IN LC ENTRY #
LCWC[0] = LC$FIX$ENT; # SET WORD COUNT FOR LIN$CON$REC#
PVC$CNT = 0; # CLEAR PVC COUNT #
SVC$CNT = 0; # CLEAR SVC COUNT #
XTERMASK = 0; # CLEAR X.25 TERMINAL MASK #
SVC$SPEC = FALSE; # CLEAR SVC SPECIFIED FLAG #
FOR I=1 STEP 1 UNTIL LC$LENG # CLEAR LINE CONFIGURATION #
DO # RECORD #
BEGIN
LCWORD[I] = 0;
END
IF LCTWC[1] GQ LCT$LENG
THEN # IF NEED MORE TABLE SPACE FOR ENTRY #
BEGIN
SSTATS(P<LINE$XREF>,50); # ALLOCATE MORE SPACE #
END
IF NOT STLBERR[1] # IF NO LABEL ERROR #
THEN
BEGIN
LCTNAME[LCTWC[1]] = STLABEL[1];# PUT LABEL IN LINE XREF TABLE #
LRNAME[2] = STLABEL[1]; # PUT LABEL IN LINE RECORD #
IF STSTID[0] EQ STID"GROUP" # IF STATEMENT IS A GROUP STMT #
THEN
BEGIN
LRGC[1] = 0; # SET GROUP COUNT TO DEFAULT VALUE IN THE #
LCNI[0] = 1; # LINE RECORD AND LIN$CON$REC #
LCTNAME[LCTWC[1]] = LABLNAM[STLBPNTR[1]]; # GENERATED LABEL #
LCTPORT[LCTWC[1]] = LABLPORT[STLBPNTR[1]]; # GENERATED PORT #
LRPORT[2] = LABLPORT[STLBPNTR[1]];
END
END
LCTNID[LCTWC[1]] = CRNT$NID; # CURRENT NPU NODE I.D. IN XREF #
LRNID[2] = CRNT$NID; # PUT CURRENT NODE I.D. IN LINE RECORD #
IF STORD1[2] NQ 0 # IF LINE TYPE WAS SPECIFIED #
THEN
BEGIN
LTYPE = " "; # CLEAR CURRENT LINE TYPE #
IF NOT STVLERR[STORD1[2]] # IF VALUE IS O.K. #
THEN
BEGIN # SEARCH FOR LTYPE IN TABLE #
FOR I=1 STEP 1 UNTIL MXLTYPE
DO
BEGIN # IF VALUE IS FOUND IN TABLE #
IF STVALNAM[STORD1[2]] EQ LT$VAL[I]
THEN
BEGIN
LTYPE = LT$CAT[I]; # STORE LTYPE CATEGORY #
LCLTYPE[2] = LT$NUMV[I]; # STORE LTYPE NUMBER #
END
END
END
END
ELSE # LTYPE WAS NOT SPECIFIED #
BEGIN # FLAG ERROR -- REQUIRED PARAM #
NDLEM2(ERR103,STLNUM[0],"LTYPE"); # MISSING #
LTYPE = " "; # CLEAR CURRENT LTYPE #
END
IF STORD2[2] NQ 0 # IF TIPTYPE WAS SPECIFIED #
THEN
BEGIN
CRNT$TIP = TIP"UNKNOWN"; # CLEAR CURRENT TIPTYPE #
TT$USED = TRUE; # SET TIPTYPE SPECIFIED FLAG #
IF NOT STVLERR[STORD2[2]] # IF VALUE IS O.K. #
THEN
BEGIN # SEARCH TABLE FOR TIPTYPE VALUE#
FOR I=1 STEP 1 UNTIL MXTTYPE
DO
BEGIN # IF VALUE IS FOUND #
IF STVALNAM[STORD2[2]] EQ TT$VAL[I]
THEN
BEGIN
IF TT$NUMV[I] GQ 12 AND # IF NUMBER VALUE IS BETWEEN #
TT$NUMV[I] LQ 14 # 12 AND 14 #
THEN
BEGIN
CRNT$TIP = TIP"USER"; # MUST BE A USER TIPTYPE #
LCTTYP$IP[2] = TT$NUMV[I]; # STORE NUMERIC VAL OF TIP #
END
ELSE # TIPTYPE IS NOT A USER TIP #
BEGIN
IF TT$NUMV[I] EQ 15
THEN # THIS MUST BE 3270 #
CRNT$TIP = TIP"$3270";
ELSE
CRNT$TIP = TT$NUMV[I]; # STORE TIPTYPE NUMBER VALUE #
LCTTYP$IP[2] = TT$NUMV[I];# STORE NUMBER VALUE OF TIP #
IF LTYPE NQ " " # IF LINE TYPE WAS SPECIFIED #
THEN # CHECK IF THEY ARE COMPATIBLE#
BEGIN
IF CRNT$TIP EQ TIP"ASYNC"
THEN # IF ASYNC TIPTYPE #
BEGIN
IF LTYPE NQ "ASYNC"
THEN # IF LTYPE IS NOT ASYNC #
BEGIN
NDLEM2(ERR104,STLNUM[0]," "); # FLAG ERROR #
END
END
ELSE # TIP IS NOT ASYNC #
BEGIN # IF X25 TIPTYPE #
IF CRNT$TIP EQ TIP"X25"
THEN
BEGIN # IF LINE TYPE IS NOT X25 #
IF LTYPE NQ "X25"
THEN
BEGIN
NDLEM2(ERR104,STLNUM[0]," "); # FLAG ERROR #
END
END
ELSE # NOT ASYNC OR X25 TIPTYPE #
BEGIN # IF LTYPE IS NOT SYNCHRONOUS #
IF LTYPE NQ "SYNC"
THEN
BEGIN
NDLEM2(ERR104,STLNUM[0]," "); # FLAG ERROR #
END
END
END
END
END
END
END
END
END
ELSE # TIPTYPE WAS NOT SPECIFIED #
BEGIN
CRNT$TIP = TIP"UNKNOWN"; # CLEAR CURRENT TIPTYPE #
TT$USED = FALSE; # CLEAR TIPTYPE SPECIFIED FLAG #
END # PARAMETER MISSING #
AUTO$REC = FALSE; # CLEAR AUTO RECOGNITION FLAG #
XAUTO$REC = FALSE; # CLEAR XAUTO RECOGNITION FLAG #
IF STORD3[2] NQ 0 # IF AUTO PARAMETER WAS SPECIFIED #
THEN
BEGIN
IF CRNT$TIP NQ TIP"X25" # IF TIPTYPE IS NOT X25 OR 3270 #
AND CRNT$TIP NQ TIP"$3270"
THEN
BEGIN
IF STVALNAM[STORD3[2]] EQ "YES"
THEN # IF VALUE IS YES #
BEGIN
AUTO$REC = TRUE; # SET AUTO RECOGNITION FLAG #
LCTTYP$A[2] = TRUE; # SET FLAG IN LIN$CON$REC #
LRAUTO[2] = TRUE; # SET FLAG IN LINE RECORD #
IF STKWID[STORD3[2]] EQ KID"XAUTO" # IF XAUTO IS USED #
THEN
BEGIN
LC$SRANGE[2] = TRUE; # SET HIGH SPEED FLAG ON #
XAUTO$REC = TRUE; # SET XAUTO$FLAG ON #
END
END
END
ELSE # CURRENT TIPTYPE IS X25 OR 3270 #
BEGIN # FLAG ERROR -- INVALID WITH TIP SPECIFIED#
IF STKWID[STORD3[2]] EQ KID"XAUTO" # XAUTO IS USED #
THEN
BEGIN
NDLEM2(ERR106,STLNUM[0],"XAUTO");
END
ELSE # MUST BE AUTO #
BEGIN
NDLEM2(ERR106,STLNUM[0],"AUTO");
END
END
END
IF NOT TT$USED # IF TIPTYPE WAS NOT SPECIFIED #
THEN
BEGIN
IF NOT(LTYPE EQ "SYNC" AND # IF LTYPE IS NOT SYNC #
AUTO$REC) # AND THIS IS NOT AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- TIPTYPE MUST BE SPECIFIED #
NDLEM2(ERR103,STLNUM[0],"TIPTYPE");
END
ELSE # MUST BE A SYNAUTO LINE #
BEGIN
LCTTYP$IP[2] = SYNAUTO; # PUT SYNAUTO VALUE FOR TIPTYPE #
END
END
FOR I=3 STEP 1 UNTIL STWC[0] # CHECK REMAINDER OF PARAMETERS #
DO # -- INDEPENDENT PARAMETERS #
BEGIN
GOTO LINJUMP[STKWID[I]]; # CLASSIFY PARAMETER BY KEYWORD #
GEN$PARAM: # I.D. #
GENLINE; # GENERAL LINE PARAMETERS #
TEST I;
X25$PARAM:
IF CRNT$TIP EQ TIP"X25" OR
CRNT$TIP EQ TIP"USER" # IF CRNT TIP IS X.25 OR USER #
THEN
BEGIN
X25LINE; # CHECK X25 LINE PARAMETERS #
END
ELSE # CRNT TIP IS NOT COMPATIBLE WITH PARAM #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],X25$PNAM[STKWID[I]]);
END
TEST I;
ASY$PARAM: # ASYNCHRONOUS LINE PARAMETERS #
IF STKWID[I] EQ KID"ARSPEED" # IF ARSPEED IS THE PARAM #
THEN
BEGIN
IF CRNT$TIP EQ TIP"ASYNC" OR
CRNT$TIP EQ TIP"USER" # IF ASYNC OR USER TIPTYPE #
THEN
BEGIN
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN
ARSUSED = TRUE; # SET FLAG TO TRUE #
LC$ARSPEED[2] = (STVALNAM[I] EQ "YES");# SET FLAG IF YES #
END
END
ELSE
BEGIN
NDLEM2(ERR106,STLNUM[0],"ARSPEED"); # TIPTYPE NOT COMPATIBLE #
END
END
ELSE
BEGIN
LSPDUSED = TRUE; # SET LSPEED SPECIFIED FLAG #
IF CRNT$TIP EQ TIP"ASYNC" OR
CRNT$TIP EQ TIP"USER"
THEN # IF TIPTYPE IS ASYNC OR USER #
BEGIN
IF CRNT$TIP EQ TIP"ASYNC" AND
AUTO$REC
THEN # IF ASYNC TIP AND AUTO REC LINE #
BEGIN # FLAG ERROR -- LSPEED ALLOWED ON NON- #
NDLEM2(ERR105,STLNUM[0]," "); # AUTO REC ASYNC LINES #
END
ELSE # MUST BE NON-AUTO REC OR USER TIP LINE #
BEGIN
IF NOT STVLERR[I] # IF VALUE IS O.K. #
THEN
BEGIN # SEARCH LSPEED TABLE FOR VALUE #
FOR J=1 STEP 1 UNTIL MXLSPD
DO
BEGIN # IF VALUE IS FOUND #
IF STVALNAM[I] EQ LST$VAL[J]
THEN
BEGIN # MAKE FNFV PAIR ENTRY #
LINFNFV(FN"LSPEED",LST$NUMV[J]);
CRNT$LSPD = LST$NUMV[J]; # SAVE CURRENT LSPEED #
END
END
END
END
END
ELSE # TIP IS NOT ASYNC OR USER #
BEGIN # FLAG ERROR -- LSPEED ALLOWED ON NON-AUTO#
NDLEM2(ERR105,STLNUM[0]," "); # REC ASYNC LINES ONLY #
END
END
TEST I;
NEXT: # GOTO NEXT PARAMETER #
END
IF LCNI[0] EQ 1
THEN
BEGIN
LRNAME[2] = LABLNAM[STLBPNTR[1]];
END
IF NOT PORTUSED # IF PORT WAS NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"PORT");
END
IF CRNT$TIP EQ TIP"ASYNC" # IF TIPTYPE IS ASYNC #
THEN
BEGIN
IF NOT AUTO$REC AND # IF NON-AUTO REC AND LSPEED NOT SPECIFIED#
NOT LSPDUSED
THEN
BEGIN # MAKE FNFV PAIR ENTRY WITH DEFAULT LSPEED#
LINFNFV(FN"LSPEED",DEF$LSPD);
CRNT$LSPD = DEF$LSPD; # SAVE DEFAULT LSPEED #
END
END
IF CRNT$TIP EQ TIP"X25" AND
STSTID[0] NQ STID"GROUP" # X25 TIPTYPE AND NOT GROUP STMT#
THEN
BEGIN
IF NOT DFLUSED # IF DFL WAS NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"DFL");
END
IF NOT FRMUSED # IF FRAME WAS NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"FRAME");
END
IF NOT RTMUSED # IF RTIME WAS NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"RTIME");
END
IF NOT PSNUSED # IF PSN WAS NOT SPECIFIED #
THEN
BEGIN # FLAG ERROR -- REQUIRED PARAMETER MISSING#
NDLEM2(ERR103,STLNUM[0],"PSN");
END
IF NOT RCNTUSED # IF RCOUNT NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY WITH DEFAULT RCOUNT#
LINFNFV(FN"RCOUNT",DEF$RCNT);
END
IF NOT DCEUSED # IF DCE NOT SPECIFIED #
THEN
BEGIN # MAKE FNFV PAIR ENTRY WITH DEFAULT DCE #
LINFNFV(FN"DCE",DEF$DCE);
END
IF NOT DCE$FLG AND
DTEAUSED # IF DCE WAS NOT SPECIFIED AND DTEA WAS #
THEN
BEGIN # FLAG ERROR -- DTEA INVALID ON NON DCE LN#
NDLEM2(ERR156,STLNUM[0]," ");
END
END
IF CRNT$TIP EQ TIP"X25" OR # IF USER TIP AND X25 LINE #
(CRNT$TIP EQ TIP"USER" AND LTYPE EQ "X25")
THEN
BEGIN
IF NOT NSVCUSED # IF NSVC NOT SPECIFED #
THEN # PUT DEFAULT IN LIN$CON$REC #
BEGIN
LINFNFV(FN"SVC",SVC$CNT);
END
END
IF NOT ARSUSED # IF NOT ARSUSED #
THEN
BEGIN
IF CRNT$TIP EQ TIP"ASYNC" # IF ASYNC TIPTYPE #
THEN
BEGIN
IF AUTO$REC OR XAUTO$REC # IF AUTO-RECOGNITION LINE #
THEN
BEGIN
LC$ARSPEED[2] = TRUE; # SET FLAG TO TRUE #
END
END
END
IF NOT AUTO$REC
THEN # IF NOT AN AUTO-REC LINE, #
BEGIN
MAXTERM = TRM$MAX[CRNT$TIP]; # SAVE MAXIMUM NUMBER OF TERMS #
TERMCNT = 0; # CLEAR TERMINAL STMT COUNT #
END
IF NOT AL$USED
THEN
BEGIN
LINFNFV(FN"AL",0); # MAKE 0 ENTRY FOR AL #
END
CA$MAP = 0; # CLEAR -CA- BIT MAP #
RETURN; # **** RETURN **** #
END # LINGRPR #
CONTROL EJECT;
PROC TERMPR;
BEGIN
*IF,DEF,IMS
#
** TERMPR - TERMINAL STATEMENT PROC.
*
* D.K. ENDO 81/11/20
*
* THIS PROCEDURE CHECKS THE TC AND STIP PARAMETERS, TERMINAL STMT
* COUNT, AND CALL A PROC, BASED ON TIPTYPE, TO CHECK THE REMAINING
* PARAMETERS.
*
* PROC TERMPR
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* INITIALIZE FLAGS AND VALUES.
* INITIALIZE NEXT TERMINAL ENTRY.
* IF LINE IS AUTO-REC,
* CLEAR DEVICE STATEMENT COUNT.
* INCREMENT TERMINAL STATEMENT COUNT.
* IF TERMINAL COUNT GREATER THAN MAXIMUM ALLOWED,
* FLAG ERROR -- MAXIMUM TERMINAL COUNT EXCEEDED.
* PUT CURRENT TIPTYPE IN TERMINAL ENTRY FROM LINE CONFIG ENTRY.
* IF STIP WAS SPECIFIED,
* IF VALUE IS O.K.,
* IF VALUE IS -AUTOREC-,
* THEN,
* IF LINE IS NOT AUTO-REC,
* FLAG ERROR -- INVALID VALUE.
* OTHERWISE,
* MAP STIP NUMERIC VALUE.
* PUT STIP VALUE IN TERMINAL ENTRY.
* IF TIP IS NOT USER OR UNKNOWN,
* IF TIPTYPE IS NOT COMPATIBLE WITH STIP,
* FLAG ERROR -- STIP AND TIPTYPE VALUE NOT COMPATIBLE.
* SET CURRENT STIP TO UNKNOWN.
* IF TC WAS SPECIFIED,
* IF VALUE IS O.K.,
* IF VALUE IS -CCP-,
* THEN
* CLEAR TC SPECIFIED FLAG.
* OTHERWISE,
* MAP TC NUMERIC VALUE.
* PUT VALUE IN TERMINAL ENTRY.
* IF TIPTYPE IS NOT USER AND TC IS NOT USER,
* IF STIP IS NOT UNKNOWN,
* THEN,
* IF STIP IS NOT COMPATIBLE WITH TC,
* FLAG ERROR -- TC AND STIP NOT COMPATIBLE
* SET CURRENT TC TO UNKNOWN.
* OTHERWISE,
* IF TIPTYPE IS NOT UNKNOWN,
* IF TIPTYPE AND TC ARE NOT COMPATIBLE,
* FLAG ERROR -- TC AND TIPTYPE NOT COMPATIBLE.
* SET CURRENT TC TO UNKNOWN.
* IF TIPTYPE IS NOT USER
* IF STIP WAS NOT SPECIFIED,
* IF TC WAS SPECIFIED,
* THEN,
* DEFAULT STIP ACCORDING TO TC.
* IF TIPTYPE IS X.25,
* DEFAULT STIP TO -PAD-.
* PUT STIP IN TERMINAL ENTRY.
* OTHERWISE,
* FLAG ERROR -- TC OR STIP REQUIRED.
* IF TIPTYPE IS SYNAUTO,
* DEFAULT TIPTYPE ACCORDING TO STIP.
* PUT TIPTYPE VALUE IN TERMINAL ENTRY.
* SELECT CASE THAT APPLIES,
* CASE 1(ASYNC TIP):
* CHECK ASYNC TERMINAL STMT ENTRY.
* CASE 2(MODE4 TIP):
* CHECK MODE4 TERMINAL STMT ENTRY.
* CASE 3(HASP TIP):
* CHECK HASP TERMINAL STMT ENTRY.
* CASE 4(X25 TIP):
* CHECK X25 TERMINAL STMT ENTRY.
* CASE 5(BSC TIP):
* CHECK BSC TERMINAL STMT ENTRY.
* CASE 6(USER OR UNKNOWN TIP):
* CHECK USER TERMINAL STMT ENTRY.
* IF CSET WAS NOT SPECIFIED AND NOT AN AUTO-REC LINE,
* DEFAULT CSET ACCORDING TO STIP.
* PUT VALUE IN TERMINAL ENTRY.
* IF LINE IS NOT AUTOREC,
* THEN,
* DEFAULT MAXIMUM DEVICE STMTS ALLOWED ACCORDING TO TIPTYPE.
* OTHERWISE,
* SET MAXIMUM NUMBER OF DEVICE STMTS TO 255.
*
#
*ENDIF
#
**** PROC TERMPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRIES IN PASS 2 ERROR FILE #
END
#
****
#
DEF MXTRENT # 3 #; # MAXIMUM WORD COUNT FOR TERMINAL ENTRY #
DEF NCIR$DEF # 1 #; # DEFAULT VALUE FOR NCIR #
ITEM CA$USED B; # CA SPECIFIED FLAG #
ITEM CSET$USED B; # CSET SPECIFIED FLAG #
ITEM I; # SCRATCH ITEM #
ITEM RIC$USED B; # RIC SPECIFIED FLAG #
ITEM STIP$USED B; # STIP SPECIFIED FLAG #
ITEM TC$USED B; # TC SPECIFIED FLAG #
DEF MXTKWD # 78 #; # MAXIMUM NUMBER TERMINAL KEYWORDS #
DEF W$DEF # 2 #; # W DEFAULT #
ARRAY KYWD$NAM$TAB [0:MXTKWD] S(1);
BEGIN
ITEM KWDNAME C(0,0,10) = ["STIP",
"TC",
"RIC",
"CSET",
"TSPEED",
"CA",
"CO",
"BCF",
"MREC",
"W",
"CTYP",
"NCIR",
"NEN",
"COLLECT",
, # XAUTO #
, # 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 #
, # AB #
, # BR #
, # BS #
, # B1 #
, # B2 #
, # CI #
, # CN #
, # CT #
, # DLC #
, # DLTO #
, # DLX #
, # EP #
, # IN #
, # LI #
, # OP #
, # PA #
, # PG #
, # PL #
, # PW #
, # SE #
, # FA #
, # XLC #
, # XLX #
, # XLTO #
, # ELO #
, # ELX #
, # ELR #
, # EBO #
, # EBR #
, # CP #
, # IC #
, # OC #
, # LK #
, # EBX #
, # HD #
, # MC #
, # XLY #
"EOF", # EOF #
"PAD" # PAD #
];
END
DEF MXSTIP # 11 #; # MAXIMUM NUMBER OF STIPS #
ARRAY STIP$TABLE [0:MXSTIP] S(2);
BEGIN
ITEM STIP$VAL C(0,0,7) = [,"M4A", # STIP VALUES #
"M4C",
"2741",
"N2741",
"POST",
"PRE",
"PAD",
"USER",
"XAA",
"2780",
"3780"
];
ITEM STIP$NUMV U(0,42,3) = [0, # UNKNOWN -- NUMERICAL VALUES #
1, # M4A #
2, # M4C #
2, # 2741 #
1, # N2741 #
1, # POST #
2, # PRE #
1, # PAD #
6, # USER #
3, # XAA #
1, # 2780 #
2, # 3780 #
];
ITEM STIP$STATUS U(0,45,5) =[STIP"UNKNOWN", # STIP STATUS VALUE#
STIP"M4A",
STIP"M4C",
STIP"$2741",
STIP"N2741",
STIP"POST",
STIP"PRE",
STIP"PAD",
STIP"USER",
STIP"XAA",
STIP"$2780",
STIP"$3780"
];
ITEM STIP$TIP U(0,50,5) = [TIP"UNKNOWN", # ALLOWABLE TIP VALUE #
TIP"MODE4",
TIP"MODE4",
TIP"ASYNC",
TIP"ASYNC",
TIP"HASP",
TIP"HASP",
TIP"X25",
TIP"X25",
TIP"X25",
TIP"BSC",
TIP"BSC"
];
ITEM STIP$TIP$MAP U(1,0,15) = [ 0, # TIPTYPE ALLOWED MAP #
O"10000",
O"10000",
O"20000",
O"20000",
O"04000",
O"04000",
O"02000",
O"02000",
O"02000",
O"01000",
O"01000"
];
ITEM CSET$DEF (1,30,15) = [CSET"UNKNOWN", # UNKNOWN #
CSET"ASCII", # M4A #
CSET"ASCII", # M4C #
CSET"CORRES", # 2741 #
CSET"ASCII", # N2741 #
CSET"EBCDIC", # POST #
CSET"EBCDIC", # PRE #
CSET"ASCII", # PAD #
CSET"ASCII", # USER #
CSET"ASCII", # XAA #
CSET"EBCDIC", # 2780 #
CSET"EBCDIC" # 3780 #
];
END
DEF MXTC # 24 #; # MAXIMUM NUMBER OF TC VALUES #
ARRAY TC$TABLE [1:MXTC] S(2);
BEGIN
ITEM TC$VAL C(0,0,7) = ["M33", # TC VALUES #
"713",
"721",
"2741",
"M40",
"H2000",
"751",
"T4014",
"HASP",
"200UT",
"714X",
"711",
"714",
"HPRE",
"734",
"2780",
"3780",
"752",
"X364",
"3270",
"TC28",
"TC29",
"TC30",
"TC31",
];
ITEM TC$NUMV U(0,45,5) = [1, # M33 -- TC NUMERICAL VALUE #
2, # 713 #
3, # 721 #
4, # 2741 #
5, # M40 #
6, # H2000 #
2, # 751 #
8, # T4014 #
9, # HASP #
10, # 200UT #
11, # 714X #
12, # 711 #
13, # 714 #
14, # HPRE #
15, # 734 #
16, # 2780 #
17, # 3780 #
2, # 752 #
7, # X364 #
18, # 3270 #
28, # TC28 #
29, # TC29 #
30, # TC30 #
31, # TC31 #
];
ITEM TC$STATUS U(0,50,5) = [TC"M33", # TC STATUS VALUE #
TC"$713",
TC"$721",
TC"$2741",
TC"M40",
TC"H2000",
TC"$751",
TC"T4014",
TC"HASP",
TC"$200UT",
TC"$714X",
TC"$711",
TC"$714",
TC"HPRE",
TC"$734",
TC"$2780",
TC"$3780",
TC"$752",
TC"X364",
TC"$3270",
TC"USER",
TC"USER",
TC"USER",
TC"USER",
];
ITEM DEF$STIP U(0,55,5) = [STIP"N2741", # M33 -- DEFAULT STIP #
STIP"N2741", # 713/751/X364 #
STIP"N2741", # 721 #
STIP"$2741", # 2741 #
STIP"N2741", # M40 #
STIP"N2741", # H2000 #
STIP"N2741", # 751 #
STIP"N2741", # T4014 #
STIP"POST", # HASP #
STIP"M4A", # 200UT #
STIP"M4C", # 714X #
STIP"M4C", # 711 #
STIP"M4C", # 714 #
STIP"PRE", # HPRE #
STIP"M4A", # 734 #
STIP"$2780", # 2780 #
STIP"$3780", # 3780 #
STIP"N2741", # 752 #
STIP"N2741", # X364 #
STIP"UNKNOWN",# 3270 #
STIP"UNKNOWN",# TC28 #
STIP"UNKNOWN",# TC29 #
STIP"UNKNOWN",# TC30 #
STIP"UNKNOWN",# TC31 #
];
ITEM STIP$AMAP U(1,0,15) = [O"02200", # M33 -- STIP ALLOWED #
O"02200", # 713 #
O"02200", # 721 #
O"04000", # 2741 #
O"02200", # M40 #
O"02200", # H2000 #
O"02200", # 751 #
O"02200", # T4014 #
O"01000", # HASP #
O"20000", # 200UT #
O"10000", # 714X #
O"10000", # 711 #
O"10000", # 714 #
O"00400", # HPRE #
O"20000", # 734 #
O"00020", # 2780 #
O"00010", # 3780 #
O"02200", # 752 #
O"02200", # X364 #
0, # 3270 -- N/A #
O"37770", # TC28 #
O"37770", # TC29 #
O"37770", # TC30 #
O"37770", # TC31 #
];
ITEM TC$TIP$AMAP U(1,15,15) = [O"22000", # M33 -- TIP ALLOWED #
O"22000", # 713 #
O"22000", # 721 #
O"20000", # 2741 #
O"22000", # M40 #
O"22000", # H2000 #
O"22000", # 751 #
O"22000", # T4014 #
O"04000", # HASP #
O"10000", # 200UT #
O"10000", # 714X #
O"10000", # 711 #
O"10000", # 714 #
O"04000", # HPRE #
O"10000", # 734 #
O"01000", # 2780 #
O"01000", # 3780 #
O"22000", # 752 #
O"22000", # X364 #
O"00400", # 3270 #
O"37000", # TC28 #
O"37000", # TC29 #
O"37000", # TC30 #
O"37000", # TC31 #
];
END
SWITCH TRMJUMP USER, # UNKNOWN TIPTYPE #
ASYNC, # ASYNC TIPTYPE #
MODE4, # MODE4 TIPTYPE #
HASP, # HASP TIPTYPE #
X25, # X25 TIPTYPE #
BSC, # BISYNC TIPTYPE #
$3270, # 3270 TIPTYPE #
USER; # USER TIPTYPE #
CONTROL EJECT;
PROC ASYTERM;
BEGIN
*IF,DEF,IMS
#
** ASYTERM -- CHECKS TERMINAL PARAMETERS LEGAL FOR ASYNC TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMRTER
* ON THE STATEMENT.
*
* PROC ASYTERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(TSPEED):
* IF LINE IS AUTO-REC,
* THEN
* CHECK ASYNC PARAMETER.
* OTHERWISE,
* FLAG ERROR -- TSPEED VALID ON AUTO-REC LINES ONLY.
* CASE 3(CA,CO,BCF,MREC,W,CTYP,NCIR,NEN,COLLECT,EOF):
* FLAG ERROR -- INVALID PARAMETER.
*
#
*ENDIF
#
**** PROC ASYTERM XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
DEF TS2400 # 7 #; # TERMINAL SPEED 2400 #
DEF TS600 # 5 #; # TERMINAL SPEED 600 #
ITEM I; # SCRATCH ITEM #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH ASYTJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
ASY$PARAM , # TSPEED #
OTHERS , # CA #
OTHERS , # CO #
OTHERS , # BCF #
OTHERS , # MREC #
OTHERS , # W #
OTHERS , # CTYP #
OTHERS , # NCIR #
OTHERS , # NEN #
OTHERS , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
OTHERS , # EOF #
OTHERS ; # PAD #
# #
# ASYTERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE-DECLARATION #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO ASYTJUMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
ASY$PARAM:
IF AUTO$REC # IF TERMINAL IS ON A AUTO-REC LINE #
THEN
BEGIN # CHECK ASYNC PARAMETER #
ATRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]);
IF NOT XAUTO$REC # IF NOT XAUTO FLAG SET #
THEN
BEGIN
IF CRNT$TSPD GR TS2400 # IF TSPEED GR 2400 #
THEN
BEGIN
NDLEM2(ERR162,STLNUM[0],"AUTO");
END
END
ELSE
BEGIN
IF XAUTO$REC # IF XAUTO FLAG IS SET #
THEN
BEGIN
IF CRNT$TSPD LS TS600 # IF TSPEED LESS THAN 600 #
THEN
BEGIN
NDLEM2(ERR162,STLNUM[0],"XAUTO");
END
END
END
END
ELSE # NON-AUTO-REC LINE #
BEGIN # FLAG ERROR -- VALID FOR AUTO-REC ONLY #
NDLEM2(ERR107,STLNUM[0],KWDNAME[SWITCH$ID]);
END
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]); # FOR ASYNC LINES #
GOTO NEXT$PARAM;
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
RETURN; # **** RETURN **** #
END # ASYTERM #
CONTROL EJECT;
PROC ATRMPRM(ASY$ID,ASY$WORD,ASY$LINE);
BEGIN
*IF,DEF,IMS
#
** ATRMPRM -- CHECK ASYNC TERMINAL PARAMETER.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CHECKS PARAMETERS THAT CAN ONLY BE SPECIFIED FOR
* AN ASYNC TERMINAL.
*
* PROC ATRMPRM(ASY$ID,ASY$WORD,ASY$LINE)
*
* ENTRY ASY$ID = NUMBER IDENTIFYING KEYWORD.
* ASY$WORD = VALUE DECLARATION ENTRY.
* ASY$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS NOT -AUTOREC-
* THEN,
* IF VALUE IS O.K.
* MAP NUMERIC VALUE FOR TSPEED.
* PUT TSPEED VALUE IN CURRENT TERMINAL ENTRY.
* IF TIPTYPE IS NOT USER AND STIP IS NOT UNKNOWN,
* IF STIP IS NOT COMPATIBLE WITH TSPEED,
* FLAG ERROR
* OTHERWISE,
* IF LINE IS NOT AUTO-REC,
* FLAG ERROR -- AUTOREC VALUE NOT VALID.
*
#
*ENDIF
ITEM ASY$ID; # KEYWORD I.D. FOR SWITCH #
ITEM ASY$LINE; # STATEMENT LINE NUMBER #
ARRAY ASY$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM ASY$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM ASY$VALNAM C(0,18,7); # CHARACTER VALUE #
ITEM ASY$VALNUM (0,18,42); # INTEGER VALUE #
END
#
**** PROC ATRMPRM - XREF LIST BEGINS
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRIES IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
DEF MXTSPD # 11 #; # MAXIMUM NUMBER OF TSPEED VALUES #
ARRAY TSPEED$TABLE [1:MXTSPD] S(1);
BEGIN
ITEM TSPD$VAL C(0,0,7) = ["110", # TSPEED VALUE #
"134",
"150",
"300",
"600",
"1200",
"2400",
"4800",
"9600",
"19200",
"38400"
];
ITEM TSPD$ST$ALLW U(00,42,09) = [O"020", # STIP ALLOWED MAP #
O"040",
O"020",
O"060",
O"020",
O"020",
O"020",
O"020",
O"20",
O"20",
O"20"
];
ITEM TSPD$NUMV U(0,51,09) = [ 1, # TSPEED INTEGER VALUE#
2,
3,
4,
5,
6,
7,
8,
9,
10,
11
];
END
# #
# ATRMPRM CODE BEGINS HERE #
# #
IF ASY$VALNAM[0] NQ "AUTOREC" # IF VALUE IS NOT AUTOREC #
THEN
BEGIN
IF NOT ASY$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
FOR I=0 STEP 1 UNTIL MXTSPD # SEARCH TABLE FOR TSPEED #
DO
BEGIN # IF VALUE IS FOUND #
IF ASY$VALNAM[0] EQ TSPD$VAL[I]
THEN
BEGIN # PUT INTEGER VAL IN TERM ENTRY #
TETS[CRNT$TERM + 1] = TSPD$NUMV[I];
CRNT$TSPD = TSPD$NUMV[I];
IF CRNT$TIP NQ TIP"USER" AND
CRNT$STIP NQ STIP"UNKNOWN"
THEN # CURRENT TIP IS NOT USER AND STIP NOT UNK#
BEGIN
IF B<CRNT$STIP,1>TSPD$ST$ALLW[I] NQ 1
THEN # IF TSPEED NOT ALLOWED WITH STIP #
BEGIN # FLAG ERROR -- VALUE NOT VALID WITH STIP #
NDLEM2(ERR111,ASY$LINE,ASY$VALNAM[0]);
END
END
END
END
END
END
ELSE # VALUE IS NOT AUTOREC #
BEGIN
IF NOT AUTO$REC # IF FIXED CONFIGURED LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID #
NDLEM2(ERR113,ASY$LINE," ");
END
END
RETURN; # **** RETURN **** #
END # ATRMPRM #
CONTROL EJECT;
PROC BSCTERM;
BEGIN
*IF,DEF,IMS
#
** BSCTERM -- CHECK TERMINAL PARAMETERS LEGAL FOR BSC TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC BSCTERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION ENTRY,
* SELECT THE CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(CO):
* IF LINE IS AUTO-REC,
* THEN,
* CHECK HASP/BSC PARAMETERS.
* OTHERWISE,
* FLAG ERROR -- VALID FOR AUTO-REC LINES ONLY.
* CASE 3(BCF,MREC):
* IF STIP IS 3780,
* THEN,
* FLAG ERROR -- PARAMETER VALID FOR 2780 TERMINALS ONLY.
* OTHERWISE,
* CHECK BISYNC PARAMETER.
*
* CASE 4(TSPEED,CA,W,CTYP,NCIR,NEN,COLLECT,EOF):
* FLAG ERROR -- PARAMETER NOT ALLOWED.
* IF RIC WAS NOT SPECIFIED,
* SET RIC FLAG TO TRUE.
*
#
*ENDIF
#
**** PROC BSCTERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM -- POINTS TO CURRNT VAL-DEC#
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH BSCTJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
OTHERS , # TSPEED #
OTHERS , # CA #
HB$PARAM , # CO #
BSC$PARAM , # BCF #
BSC$PARAM , # MREC #
OTHERS , # W #
OTHERS , # CTYP #
OTHERS , # NCIR #
OTHERS , # NEN #
OTHERS , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
OTHERS , # EOF #
OTHERS ; # PAD #
# #
# BSCTERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO BSCTJUMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
HB$PARAM:
IF AUTO$REC # IF TERMINAL IS ON A AUTO-REC LINE #
THEN
BEGIN
HBTRMPR(SWITCH$ID,STWORD[I],STLNUM[0]);# HASP/BSC PARAMETERS #
END
ELSE # NON-AUTO-REC LINE #
BEGIN # FLAG ERROR -- VALID FOR AUTO-REC ONLY #
NDLEM2(ERR107,STLNUM[0],KWDNAME[SWITCH$ID]);
END
GOTO NEXT$PARAM;
BSC$PARAM:
IF CRNT$STIP NQ STIP"$2780" AND
CRNT$STIP NQ STIP"UNKNOWN"
THEN # IF STIP IS NOT 2780 OR UNKNOWN #
BEGIN # FLAG ERROR -- VALID ON 2780 TERMS ONLY #
NDLEM2(ERR108,STLNUM[0],KWDNAME[SWITCH$ID]);
END
ELSE # MUST BE 2780 OR UNKNOWN #
BEGIN
BTRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]);# CHECK BSC PARAMETER #
END
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[SWITCH$ID]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]);
END
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
IF NOT RIC$USED # IF RIC NOT SPECIFIED #
THEN
BEGIN
RIC$FLAG = TRUE; # DEFAULT RIC VALUE #
END
RETURN; # **** RETURN **** #
END # BSCTERM #
CONTROL EJECT;
PROC BTRMPRM(BTRM$ID,BTRM$WORD,BTRM$LINE);
BEGIN
*IF,DEF,IMS
#
** BTRMPRM -- CHECKS BSC TERMINAL PARAMETERS.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE PARAMETERS THAT CAN ONLY BE SPECIFIED FOR BISYNC
* TERMINALS.
*
* PROC BTRMPRM(BTRM$ID,BTRM$WORD,BTRM$LINE)
*
* ENTRY BTRM$ID = NUMBER IDENTIFYING KEYWORD.
* BTRM$WORD = VALUE DECLARATION ENTRY.
* BTRM$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES,
* CASE 1(BCF):
* IF VALUE IS O.K.
* IF VALUE IS -YES-
* SET BCF FLAG.
* CASE 2(MREC):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* SAVE CURRENT MREC VALUE
*
#
*ENDIF
ITEM BTRM$ID; # KEYWORD I.D. FOR SWITCH #
ITEM BTRM$LINE; # STATEMENT LINE NUMBER #
ARRAY BTRM$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM BTRM$KWID (0,0,9); # KEYWORD I.D. FROM PASS 1 #
ITEM BTRM$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM BTRM$VALNAM C(0,18,7); # CHARACTER VALUE #
ITEM BTRM$VALNUM (0,18,42); # INTEGER VALUE #
END
#
**** PROC BTRMPRM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECK IF VALUE IS WITHIN RANGE #
END
#
****
#
ITEM BTRM$STAT B; # RETURNED STATUS FROM RANGE CHECK PROC #
SWITCH BTRMJUMP , # STIP #
, # TC #
, # RIC #
, # CSET #
, # TSPEED #
, # CA #
, # CO #
BCF, # BCF #
MREC; # MREC #
# #
# BTRMPRM CODE BEGINS HERE #
# #
GOTO BTRMJUMP[BTRM$ID]; # CHECK GIVEN VALUE DECLARATION #
BCF:
IF NOT BTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF BTRM$VALNAM[0] EQ "YES" # IF VALUE IS -YES- #
THEN
BEGIN
BCF$FLAG = TRUE; # SET BCF FLAG #
END
END
GOTO NEXT$PARAM;
MREC:
IF NOT BTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF USER TIP IS USER DEFINED #
THEN
BEGIN
USR$RANGE(BTRM$VALNUM[0],USR$WID1,NUM"DEC",BTRM$STAT);
# RANGE #
END
ELSE
BEGIN
NDLCKRG(BTRM$KWID[0],BTRM$VALNUM[0],BTRM$STAT);
END
IF BTRM$STAT # IF WITHIN RANGE #
THEN
BEGIN
CRNT$MREC = BTRM$VALNUM[0]; # SAVE MREC VALUE #
END
END
GOTO NEXT$PARAM;
NEXT$PARAM:
RETURN; # **** RETURN **** #
END # BTRMPRM #
CONTROL EJECT;
PROC GENTERM(GTRM$ID,GTRM$WORD,GTRM$LINE);
BEGIN
*IF,DEF,IMS
#
** GENTERM -- CHECK GENERAL TERMINAL PARAMETERS.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CHECKS TERMINAL PARAMETERS THAT ARE LEGAL FOR ALL
* TIPTYPES.
*
* PROC GENTERM(GTRM$ID,GTRM$WORD,GTRM$LINE)
*
* ENTRY GTRM$ID = NUMBER IDENTIFYING KEYWORD.
* GTRM$WORD = VALUE DECLARATION ENTRY.
* GTRM$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES,
* CASE 1(CSET):
* IF VALUE IS O.K.,
* IF VALUE IS NOT -AUTOREC-,
* THEN,
* MAP CSET NUMERIC VALUE.
* IF TIPTYPE AND CSET IS NOT -USER-
* IF TC IS NOT USER OR UNKNOWN,
* THEN,
* IF TC AND CSET ARE NOT COMPATIBLE,
* FLAG ERROR.
* OTHERWISE,
* IF STIP IS NOT UNKNOWN,
* THEN,
* IF STIP AND CSET ARE NOT COMPATIBLE,
* FLAG ERROR.
* OTHERWISE,
* IF TIPTYPE IS NOT UNKNOWN,
* IF TIPTYPE AND CSET ARE NOT COMPATIBLE,
* FLAG ERROR.
* PUT CSET VALUE IN CURRENT TERMINAL ENTRY.
* OTHERWISE,
* IF LINE IS NOT AUTO-REC
* FLAG ERROR -- AUTOREC VALUE INVALID.
* CASE 2(RIC):
* IF VALUE IS O.K.,
* IF VALUE IS -YES-,
* SET RIC FLAG.
*
#
*ENDIF
ITEM GTRM$ID; # KEYWORD I.D. FOR SWITCH #
ITEM GTRM$LINE; # STATEMENT LINE NUMBER #
ARRAY GTRM$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM GTRM$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM GTRM$VALNAM C(0,18,7); # CHARACTER VALUE #
ITEM GTRM$VALNUM (0,18,42); # INTEGER VALUE #
END
#
**** PROC GENTERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
DEF MXCSET # 10 #; # MAXIMUM NUMBER OF CODE SETS #
ARRAY CSET$TABLE [1:MXCSET] S(1);
BEGIN
ITEM CSET$VAL C(0,0,7) = ["BCD", # CHARACTER VALUE #
"ASCII",
"APLTP",
"APLBP",
"EBCD",
"EBCDAPL",
"CORRES",
"CORAPL",
"EBCDIC",
"CSET15"
];
ITEM CSET$NUMV (0,42,18) = [1, # BCD -- INTEGER VALUE #
2, # ASCII #
3, # APLTP #
4, # APLBP #
5, # EBCD #
6, # EBCDAPL #
7, # CORRES #
8, # CORAPL #
9, # EBCDIC #
15 # CSET15 #
];
END
ARRAY CSET$ALLOWED [1:15] S(1); # CODE SET ALLOWED MAP -- BIT #
BEGIN # SET IF PARAM VALUE IS COMPAT#
ITEM TC$AMAP U(0,0,30) = [O"0002040000", # BCD -- AND TC VALUE #
O"3573646000", # ASCII #
O"3570000000", # APLTP #
O"3570000000", # APLBP #
O"0200000000", # EBCD #
O"0200000000", # EBCDAPL #
O"0200000000", # CORRES #
O"0200000000", # CORAPL #
O"0004131000", # EBCDIC #
,,,,,
O"3377770000" # CSET15 #
];
ITEM STIP$AMAP U(0,30,15) = [O"20000", # BCD -- AND STIP VAL #
O"32340", # ASCII #
O"02000", # APLTP #
O"02000", # APLBP #
O"04000", # EBCD #
O"04000", # EBCDAPL #
O"04000", # CORRES #
O"04000", # CORAPL #
O"01430", # EBCDIC #
,,,,,
O"37770" # CSET15 #
];
ITEM TTYP$AMAP U(0,45,15) =[O"10200", # BCD -- AND TIPTYPE #
O"32200", # ASCII #
O"20200", # APLTP #
O"20200", # APLBP #
O"20200", # EBCD #
O"20200", # EBCDAPL #
O"20200", # CORRES #
O"20200", # CORAPL #
O"05600", # EBCDIC #
,,,,,
O"37600" # CSET15 #
];
END
SWITCH GTRMJUMP , # STIP #
, # TC #
RIC , # RIC #
CSET$; # CSET #
CONTROL EJECT;
# #
# GTRMPRM CODE BEGINS HERE #
# #
GOTO GTRMJUMP[GTRM$ID]; # PROCESS GIVEN PARAMETER #
CSET$:
CSET$USED = TRUE; # SET CSET SPECIFIED FLAG #
IF NOT GTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF GTRM$VALNAM[0] NQ "AUTOREC" # IF VALUE IS NOT AUTO#
THEN
BEGIN
FOR I=1 STEP 1 UNTIL MXCSET # SEARCH FOR CSET IN #
DO # TABLE #
BEGIN
IF GTRM$VALNAM[0] EQ CSET$VAL[I] # IF CSET FOUND #
THEN
BEGIN
CRNT$CSET = CSET$NUMV[I]; # SAVE CSET I.D. #
END
END
IF CRNT$TIP NQ TIP"USER" AND # IF TIPTYPE IS NOT #
CRNT$CSET NQ CSET"USER" # USER AND CSET IS #
THEN # NOT USER #
BEGIN
IF CRNT$TC NQ TC"USER" AND # IF TC IS NOT USER OR#
CRNT$TC NQ TC"UNKNOWN" # UNKNOWN, #
THEN # COMPARE TC AGAINST #
BEGIN # CSET #
IF B<CRNT$TC,1>TC$AMAP[CRNT$CSET] NQ 1
THEN # IF NOT COMPATIBLE #
BEGIN # FLAG ERROR -- NOT COMPATIBLE#
NDLEM2(ERR110,GTRM$LINE,GTRM$VALNAM[0]);
END
END
ELSE # TC IS USER OR UNKNOWN #
BEGIN # CHECK CSET AGAINST STIP #
IF CRNT$STIP NQ STIP"UNKNOWN"
THEN # IF STIP IS NOT UNKNOWN #
BEGIN
IF B<CRNT$STIP,1>STIP$AMAP[CRNT$CSET] NQ 1
THEN # IF NOT COMPATIBLE #
BEGIN # FLAG ERROR -- NOT COMPATIBLE#
NDLEM2(ERR111,GTRM$LINE,GTRM$VALNAM[0]);
END
END
ELSE # STIP IS UNKNOWN #
BEGIN # CHECK CSET AGAINST TIPTYPE #
IF CRNT$TIP NQ TIP"UNKNOWN"
THEN # IF TIPTYPE IS NOT UNKNOWN #
BEGIN # CHECK CSET AGAINST TIPTYPE #
IF B<CRNT$TIP,1>TTYP$AMAP[CRNT$CSET] NQ 1
THEN # IF NOT COMPATIBLE #
BEGIN # FLAG ERROR -- NOT COMPATIBLE#
NDLEM2(ERR112,GTRM$LINE,GTRM$VALNAM);
END
END
END
END
END
TECD[CRNT$TERM+1] = CRNT$CSET; # SAVE CSET VALUE #
END
ELSE # CSET VALUE IS AUTO-REC #
BEGIN
IF NOT AUTO$REC # IF FIXED CONFIGURED LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID #
NDLEM2(ERR113,GTRM$LINE," ");
END
END
END
GOTO NEXT$PARAM;
RIC:
RIC$USED = TRUE; # SET RIC SPECIFIED FLAG #
IF NOT GTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF GTRM$VALNAM[0] EQ "YES"
THEN # IF VALUE IS -YES- #
BEGIN
RIC$FLAG = TRUE; # SET RIC FLAG #
END
END
GOTO NEXT$PARAM;
NEXT$PARAM:
RETURN; # **** RETURN **** #
END # GTRMPRM #
CONTROL EJECT;
PROC HBTRMPR(HBTRM$ID,HBTRM$WORD,HBTRM$LINE);
BEGIN
*IF,DEF,IMS
#
** HBTRMPR -- CHECK HASP/BSC TERMINAL PARAMETERS
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE ONLY LEGAL FOR HASP
* AND BSC TERMINALS.
*
* PROC HBTRMPR(HBTRM$ID,HBTRM$WORD,HBTRM$LINE)
*
* ENTRY HBTRM$ID = NUMBER IDENTIFYING KEYWORD.
* HBTRM$WORD = VALUE DECLARATION ENTRY.
* HBTRM$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS O.K.,
* IF VALUE IS NOT -AUTOREC-,
* THEN,
* CHECK IF VALUE IS WITHIN RANGE.
* IF IN RANGE,
* PUT CO VALUE IN CURRENT TERMINAL ENTRY.
* OTHERWISE,
* IF LINE IS NOT AUTO-REC
* FLAG ERROR -- AUTOREC VALUE IS INVALID.
*
#
*ENDIF
ITEM HBTRM$ID; # KEYWORD I.D. FOR SWITCH #
ITEM HBTRM$LINE; # STATEMENT LINE NUMBER #
ARRAY HBTRM$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM HBTRM$KWID (0,0,9); # KEYWORD I.D. FROM PASS 1 #
ITEM HBTRM$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM HBTRM$VALNAM (0,18,7); # CHARACTER VALUE #
ITEM HBTRM$VALNUM (0,18,42); # INTEGER VALUE #
END
#
**** PROC HBTRMPR - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECKS IF VALUE IS WITHIN RANGE #
PROC NDLEM2; # MAKES ENTRIES IN PASS 2 ERROR FILE #
END
#
****
#
ITEM HBTRM$STAT B; # RETURNED STATUS FROM RANGE CHECK PROC #
# #
# HBTRMPR CODE BEGINS HERE #
# #
IF NOT HBTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN # IF VALUE IS NOT AUTOREC #
IF HBTRM$VALNAM[0] NQ "AUTOREC"
THEN
BEGIN # CHECK IF VALUE IS WITHIN RANGE#
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(HBTRM$VALNUM[0],USR$WID1,NUM"HEX",HBTRM$STAT);
# USER #
# RANGE #
END
ELSE
BEGIN
NDLCKRG(HBTRM$KWID,HBTRM$VALNUM[0],HBTRM$STAT);
END
IF HBTRM$STAT # IF WITHIN RANGE #
THEN
BEGIN # PUT CO VALUE IN TERM ENTRY #
TEA1[CRNT$TERM + 1] = HBTRM$VALNUM[0];
END
END
ELSE
BEGIN # VALUE IS AUTOREC #
IF NOT AUTO$REC # IF NOT A FIXED CONFIGURED LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID #
NDLEM2(ERR113,HBTRM$LINE," ");
END
END
END
RETURN; # **** RETURN **** #
END # HBTRMPR #
CONTROL EJECT;
PROC HSPTERM;
BEGIN
*IF,DEF,IMS
#
** HSPTERM -- CHECK TERMINAL PARAMETERS LEGAL FOR HASP TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC HSPTERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(CO):
* IF AUTO-REC LINE,
* THEN,
* CHECK HASP/BSC PARAMETER.
* OTHERWISE,
* FLAG ERROR -- ALLOWED ON AUTO-REC LINE ONLY.
* CASE 3(TSPEED,CA,BCF,MREC,W,CTYP,NCIR,NEN,COLLECT,EOF):
* FLAG ERROR -- INVALID PARAMETER.
*
#
*ENDIF
#
**** PROC HSPTERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH HSPTJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
OTHERS , # TSPEED #
OTHERS , # CA #
HB$PARAM , # CO #
OTHERS , # BCF #
OTHERS , # MREC #
OTHERS , # W #
OTHERS , # CTYP #
OTHERS , # NCIR #
OTHERS , # NEN #
OTHERS , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
OTHERS , # EOF #
OTHERS ; # PAD #
# #
# HSPTERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE-DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO HSPTJUMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
HB$PARAM:
IF AUTO$REC # IF ON AUTO-REC LINE #
THEN
BEGIN # CHECK HASP/BISYNC PARAMETER #
HBTRMPR(SWITCH$ID,STWORD[I],STLNUM[0]);
END
ELSE # MUST BE ON NON-AUTO-REC LINE #
BEGIN # FLAG ERROR -- VALID FOR AUTO-REC ONLY #
NDLEM2(ERR107,STLNUM[0],KWDNAME[SWITCH$ID]);
END
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[SWITCH$ID]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]);
END
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
IF NOT RIC$USED # IF RIC NOT SPECIFIED #
THEN
BEGIN
RIC$FLAG = TRUE; # DEFAULT RIC VALUE TO YES #
END
RETURN; # **** RETURN **** #
END # HSPTERM #
CONTROL EJECT;
PROC MD4TERM;
BEGIN
*IF,DEF,IMS
#
** MD4TERM -- CHECK TERMINAL PARAMETERS LEGAL FOR MODE4 TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC MD4TERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(CA)
* CHECK MODE4 PARAMETER.
* CASE 3(TSPEED,CO,BCF,MREC,W,CTYP,NCIR,NEN,COLLECT):
* FLAG ERROR -- INVALID PARAMETER.
* CASE 4(EOF):
* SET EOF FLAG TO BE TRUE IF VALUE IS "YES".
* IF CA WAS NOT SPECIFIED AND NOT AN AUTO-REC LINE.
* FLAG ERROR -- REQUIRE PARAMETER MISSING.
*
#
*ENDIF
#
**** PROC MD4TERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH MD4TJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
OTHERS , # TSPEED #
MD4$PARAM , # CA #
OTHERS , # CO #
OTHERS , # BCF #
OTHERS , # MREC #
OTHERS , # W #
OTHERS , # CTYP #
OTHERS , # NCIR #
OTHERS , # NEN #
OTHERS , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
EOF$ , # EOF #
OTHERS ; # PAD #
# #
# MD4TERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE-DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO MD4TJUMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
MD4$PARAM:
MTRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]); # MODE4 PARAMETERS #
GOTO NEXT$PARAM;
EOF$: EOF$USED = TRUE; # SET EOF SPECIFIED TO TRUE #
CRNT$EOF = ( STVALNAM[I] EQ "YES" ); # IF YES THEN TRUE ELSE #
# FALSE #
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[SWITCH$ID]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]);
END
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
IF NOT CA$USED AND # IF CA NOT SPECIFIED AND NOT #
NOT AUTO$REC # AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- CA PARAMETER MISSING #
NDLEM2(ERR103,STLNUM[0],"CA");
END
RETURN; # **** RETURN **** #
END # MD4TERM #
CONTROL EJECT;
PROC MTRMPRM(MTRM$ID,MTRM$WORD,MTRM$LINE);
BEGIN
*IF,DEF,IMS
#
** MTRMPRM -- CHECK MODE4 TERMINAL PARAMETERS.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CHECKS PARAMETERS THAT ARE ONLY LEGAL FOR MODE4
* TERMINALS.
*
* PROC MTRMPRM(MTRM$ID,MTRM$WORD,MTRM$LINE)
*
* ENTRY MTRM$ID = NUMBER IDENTIFYING KEYWORD.
* MTRM$WORD = VALUE DECLARATION ENTRY.
* MTRM$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* IF VALUE IS O.K.,
* IF VALUE IS NOT -AUTO-REC-,
* THEN,
* CHECK IF VALUE IS IN RANGE,
* IF IN RANGE,
* IF VALUE IS NOT UNIQUE,
* FLAG ERROR -- CA VALUE IS NOT UNIQUE.
* PUT CA VALUE IN CURRENT TERMINAL ENTRY.
* OTHERWISE,
* IF CURRENT LINE IS AUTO-REC,
* FLAG ERROR -- AUTOREC VALUE NOT VALID.
*
#
*ENDIF
ITEM MTRM$ID; # KEYWORD I.D. FOR SWITCH #
ITEM MTRM$LINE; # STATEMENT LINE NUMBER #
ARRAY MTRM$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM MTRM$KWID (0,0,9); # KEYWORD I.D. FROM PASS 1 #
ITEM MTRM$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM MTRM$VALNAM C(0,18,7); # CHARACTER VALUE #
ITEM MTRM$VALNUM (0,18,42); # INTEGER VALUE #
END
#
**** PROC MTRMPRM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECK IF VALUE IS IN RANGE #
PROC NDLEM2; # MAKE ENTRY IN PASS 2 ERROR FILE #
FUNC XCHD; # CONVERTS HEX VALUE TO HEX DISPLAY CODE #
END
#
****
#
ITEM ITEMP; # INTEGER TEMPORARY #
DEF ZERO # 0 #; # ZERO = 0 #
DEF MAX$USR # 255 #; # MAXIMUM VALUE OF CA FOR USER #
ITEM MTRM$STAT B; # RETURNED STATUS FROM RANGE CHECK PROC #
CONTROL EJECT;
# #
# MTRMPRM CODE BEGINS HERE #
# #
CA$USED = TRUE; # SET CA SPECIFIED FLAG #
IF NOT MTRM$VLERR[0] # VALUE IS O.K. #
THEN
BEGIN
IF MTRM$VALNAM NQ "AUTOREC" # IF VALUE IS NOT AUTOREC #
THEN
BEGIN # CHECK IF CA IS WITHIN RANGE #
IF CRNT$TIP EQ TIP"USER"
THEN
BEGIN
MTRM$STAT = TRUE; # SET STATUS TO TRUE #
IF MTRM$VALNUM[0] LS ZERO OR
MTRM$VALNUM[0] GR MAX$USR
THEN
BEGIN
NDLEM2(ERR100,STLNUM[0],XCHD(MTRM$VALNUM[0]));
# GENERATE ERR100 #
MTRM$STAT = FALSE;
END
END
ELSE IF CRNT$TIP EQ TIP"$3270"
THEN
BEGIN # IF TIPTYPE IS 3270 #
MTRM$STAT = TRUE; # SET STATUS TO O.K. #
IF MTRM$VALNUM[0] LS 0 OR
MTRM$VALNUM[0] GR 31
THEN # VALUE IS OUT OF RANGE #
BEGIN # FLAG ERROR ---> #
NDLEM2(ERR100,STLNUM[0],XCHD(MTRM$VALNUM[0]));
MTRM$STAT = FALSE; # SET ERROR STATUS #
END
END
ELSE
BEGIN # ALL OTHER TIPTYPES #
NDLCKRG(MTRM$KWID[0],MTRM$VALNUM[0],MTRM$STAT);
# CALL THE CHECK RANGE PROC #
END
IF MTRM$STAT # IF IT IS WITHIN RANGE #
THEN
BEGIN # IF TIPTYPE IS NOT USER OR #
IF CRNT$TIP NQ TIP"USER" AND # UNKNOWN, AND NOT AN #
CRNT$TIP NQ TIP"UNKNOWN" AND # AUTO-REC LINE #
NOT AUTO$REC
THEN # CHECK FOR DUPLICATE CA VALUE #
BEGIN
IF CRNT$TIP NQ TIP"$3270"
THEN
ITEMP = MTRM$VALNUM[0] - X"70";
ELSE
ITEMP = MTRM$VALNUM[0];# FOR 3270 #
IF B<ITEMP,1>CA$MAP EQ 1
THEN # IF CA VALUE IS ALREADY USED #
BEGIN # FLAG ERROR -- DUPLICATE CA #
NDLEM2(ERR109,MTRM$LINE," ");
END
ELSE # CA VALUE HAS NOT BEEN USED #
BEGIN # SET FLAG FOR VALUE #
B<ITEMP,1>CA$MAP = 1;
END
END
TEA1[CRNT$TERM+1] = MTRM$VALNUM[0];
END
END
ELSE # VALUE IS AUTOREC #
BEGIN
IF NOT AUTO$REC # IF NOT AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID #
NDLEM2(ERR113,MTRM$LINE," ");
END
END
END
RETURN; # **** RETURN **** #
END # MTRMPRM #
CONTROL EJECT;
PROC USRTERM;
BEGIN
*IF,DEF,IMS
#
** USRTERM -- CHECK TERMINALS PARAMETERS LEGAL FOR USER TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC USRTERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(TSPEED):
* CHECK ASYNC PARAMETER.
* CASE 3(CA):
* CHECK MODE4 PARAMETER.
* CASE 4(CO):
* CHECK HASP/BSC PARAMETER.
* CASE 5(EOF):
* SET EOF FLAG TO TRUE IF VALUE IS "YES".
* CASE 6(W,CTYP,NCIR,NEN,COLLECT):
* CHECK X.25 PARAMETER.
* CASE 7(BCF,MREC):
* CHECK BSC PARAMETER.
* IF NEN IS NOT USED,
* SET VALUE OF NEN TO BE CURRENT VALEU OF NCIR.
*
#
*ENDIF
ITEM I; # SCRATCH ITEM -- POINTS TO CURRNT VAL-DEC#
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH USRTJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
ASY$PARAM , # TSPEED #
MD4$PARAM , # CA #
HB$PARAM , # CO #
BSC$PARAM , # BCF #
BSC$PARAM , # MREC #
X25$PARAM , # W #
X25$PARAM , # CTYP #
X25$PARAM , # NCIR #
X25$PARAM , # NEN #
X25$PARAM , # COLLECT #
NEXT$PARAM, # XAUTO #
NEXT$PARAM, # DT #
NEXT$PARAM, # SDT #
NEXT$PARAM, # TA #
NEXT$PARAM, # ABL #
NEXT$PARAM, # DBZ #
NEXT$PARAM, # UBZ #
NEXT$PARAM, # DBL #
NEXT$PARAM, # UBL #
NEXT$PARAM, # XBZ #
NEXT$PARAM, # DO #
NEXT$PARAM, # STREAM #
NEXT$PARAM, # HN #
NEXT$PARAM, # AUTOLOG #
NEXT$PARAM, # AUTOCON #
NEXT$PARAM, # PRI #
NEXT$PARAM, # P80 #
NEXT$PARAM, # P81 #
NEXT$PARAM, # P82 #
NEXT$PARAM, # P83 #
NEXT$PARAM, # P84 #
NEXT$PARAM, # P85 #
NEXT$PARAM, # P86 #
NEXT$PARAM, # P87 #
NEXT$PARAM, # P88 #
NEXT$PARAM, # P89 #
NEXT$PARAM, # AB #
NEXT$PARAM, # BR #
NEXT$PARAM, # BS #
NEXT$PARAM, # B1 #
NEXT$PARAM, # B2 #
NEXT$PARAM, # CI #
NEXT$PARAM, # CN #
NEXT$PARAM, # CT #
NEXT$PARAM, # DLC #
NEXT$PARAM, # DLTO #
NEXT$PARAM, # DLX #
NEXT$PARAM, # EP #
NEXT$PARAM, # IN #
NEXT$PARAM, # LI #
NEXT$PARAM, # OP #
NEXT$PARAM, # PA #
NEXT$PARAM, # PG #
NEXT$PARAM, # PL #
NEXT$PARAM, # PW #
NEXT$PARAM, # SE #
NEXT$PARAM, # FA #
NEXT$PARAM, # XLC #
NEXT$PARAM, # XLX #
NEXT$PARAM, # XLTO #
NEXT$PARAM, # ELO #
NEXT$PARAM, # ELX #
NEXT$PARAM, # ELR #
NEXT$PARAM, # EBO #
NEXT$PARAM, # EBR #
NEXT$PARAM, # CP #
NEXT$PARAM, # IC #
NEXT$PARAM, # OC #
NEXT$PARAM, # LK #
NEXT$PARAM, # EBX #
NEXT$PARAM, # HD #
NEXT$PARAM, # MC #
NEXT$PARAM, # XLY #
EOF$ , # EOF #
X25$PARAM ; # PAD #
# #
# USRTERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO USRTJUMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM: # CHECK GENERAL PARAMETERS #
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]);
GOTO NEXT$PARAM;
ASY$PARAM: # CHECK ASYNC PARAMETERS #
ATRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]);
GOTO NEXT$PARAM;
MD4$PARAM: # CHECK MODE4 PARAMETERS #
MTRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]);
GOTO NEXT$PARAM;
EOF$: EOF$USED = TRUE; # SET EOF USED TO TRUE #
CRNT$EOF = (STVALNAM[I] EQ "YES");
GOTO NEXT$PARAM;
HB$PARAM: # CHECK HASP/BSC PARAMETERS #
HBTRMPR(SWITCH$ID,STWORD[I],STLNUM[0]);
GOTO NEXT$PARAM;
X25$PARAM: # CHECK X25 PARAMETERS #
XTRMPRM(SWITCH$ID,STMT$TABLE[I],STLNUM[0]);
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
GOTO NEXT$PARAM;
BSC$PARAM: # CHECK BSC PARAMETERS #
BTRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]);
GOTO NEXT$PARAM;
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
CTEMP = "STIP";
C$USR$PRM2(CRNT$STIP,CTEMP); # CHECK IF STIP IS USED #
CTEMP = "TC";
C$USR$PRM2(CRNT$TC,CTEMP); # CHECK IF TC IS SPECIFIED #
IF NOT NEN$USED
THEN # IF NEN IS NOT USED, CHECK THE #
BEGIN # CURRENT NEN VALUE AGAIN #
CRNT$NEN = CRNT$NCIR; # ASSUME LATEST VALUE OF NCIR #
END
RETURN; # **** RETURN **** #
END # USRTERM #
CONTROL EJECT;
PROC XTRMPRM(XTRM$ID,XTRM$WORD,XTRM$LINE);
BEGIN
*IF,DEF,IMS
#
** XTRMPRM -- CHECK X.25 TERMINAL PARAMETER.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CHECK PARAMETERS THAT ARE ONLY LEGAL FOR X.25
* TERMINALS.
*
* PROC XTRMPRM(XTRM$ID,XTRM$WORD,XTRM$LINE)
*
* ENTRY XTRM$ID = NUMBER IDENTIFYING KEYWORD.
* XTRM$WORD = VALUE DECLARATION ENTRY.
* XTRM$LINE = CURRENT SOURCE LINE NUMBER.
*
* EXIT NONE.
*
* METHOD
*
* SELECT CASE THAT APPLIES,
* CASE 1(W):
* IF VALUE IS O.K.
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* SAVE CURRENT W VALUE.
* CASE 2(CTYP):
* IF VALUE IS O.K.,
* IF VALUE IS PVC,
* THEN
* SET CURRENT CTYP TO PVC.
* INCREMENT PVC COUNT.
* IF SUBTIPTYPE IS NOT XAA,
* FLAG ERROR - SUBTIP MUST BE XAA FOR PVC.
* IF SVC WAS PREVIOUSLY SPECIFIED,
* FLAG ERROR -- ALL PVC-S MUST BE SPECIFIED BEFORE ANY SVC
* OTHERWISE,
* SET CURRENT CTYP TO SVC.
* CASE 3(NCIR):
* IF VALUE IS O.K.
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* SAVE CURRENT NCIR VALUE.
* CASE 4(NEN):
* IF VALUE IS O.K.,
* CHECK IF VALUE IS IN RANGE.
* IF IN RANGE,
* SAVE CURRENT NEN VALUE.
* CASE 5(COLLECT):
* SET COLLECT SPECIFIED FLAG.
* IF STIP IS NOT *PAD*
* FLAG ERROR -- PARAM INVALID WITH SSTIP SPECIFIED.
* IF VALUE IS *YES*
* SET THE COLLECT FLAG.
*
#
*ENDIF
ITEM XTRM$ID; # KEYWORD I.D. FOR SWITCH #
ITEM XTRM$LINE; # STATEMENT LINE NUMBER #
ARRAY XTRM$WORD [0:0] S(1); # VALUE DECLARATION ENTRY #
BEGIN
ITEM XTRM$KWID (0,0,9); # KEYWORD I.D. FROM PASS 1 #
ITEM XTRM$VLERR B(0,17,1); # VALUE ERROR FLAG #
ITEM XTRM$VALNAM C(0,18,7); # CHARACTER VALUE #
ITEM XTRM$VALNUM (0,18,42); # INTEGER VALUE #
ITEM XTRM$PAD (0,0,60); # PAD ENTRY VALUES #
END
#
**** PROC XTRMPRM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLCKRG; # CHECK IF VALUE IS WITHIN RANGE #
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM XTRM$STAT B; # STATUS RETURNED BY RANGE CHECK PROC #
ITEM I; # SCRATCH VARIABLE #
SWITCH XTRMJUMP , # STIP #
, # TC #
, # RIC #
, # CSET #
, # TSPEED #
, # CA #
, # CO #
, # BCF #
, # MREC #
W, # W #
CTYP$, # CTYP #
NCIR, # NCIR #
NEN, # NEN #
COLLECT, # COLLECT #
, # XAUTO #
, # 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 #
, # AB #
, # BR #
, # BS #
, # B1 #
, # B2 #
, # CI #
, # CN #
, # CT #
, # DLC #
, # DLTO #
, # DLX #
, # EP #
, # IN #
, # LI #
, # OP #
, # PA #
, # PG #
, # PL #
, # PW #
, # SE #
, # FA #
, # XLC #
, # XLX #
, # XLTO #
, # ELO #
, # ELX #
, # ELR #
, # EBO #
, # EBR #
, # CP #
, # IC #
, # OC #
, # LK #
, # EBX #
, # HD #
, # MC #
, # XLY #
, # EOF #
PAD$ ; # PAD #
CONTROL EJECT;
# #
# XTRMPRM CODE BEGINS HERE #
# #
GOTO XTRMJUMP[XTRM$ID]; # CHECK GIVEN VALUE DECLARATION #
W:
W$USED = TRUE; # SET W SPECIFIED FLAG #
IF NOT XTRM$VLERR # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF W IS WITHIN RANGE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(XTRM$VALNUM[0],USR$WID1,NUM"DEC",XTRM$STAT);
END
ELSE
BEGIN
NDLCKRG(XTRM$KWID[0],XTRM$VALNUM[0],XTRM$STAT);
END
IF XTRM$STAT # IF IT IS WITHIN RANGE #
THEN
BEGIN
CRNT$W = XTRM$VALNUM[0]; # SAVE W VALUE #
END
END
GOTO NEXT$PARAM;
CTYP$:
CTYP$USED = TRUE; # SET CTYP SPECIFIED FLAG #
IF NOT XTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF XTRM$VALNAM[0] EQ "PVC" # IF VALUE IS -PVC- #
THEN
BEGIN
CRNT$CTYP = CTYP"PVC"; # SET CURRENT CTYP TO BE PVC #
PVC$CNT = PVC$CNT + 1; # INCREMENT PVC COUNT #
IF CRNT$STIP NQ STIP"XAA" # IF STIP IS NOT XAA #
THEN
BEGIN
NDLEM2(ERR111,XTRM$LINE,"PVC");
END
IF SVC$SPEC # IF SVC HAS BEEN PREVIOUSLY SPECIFIED #
THEN
BEGIN # FLAG ERROR -- SPECIFY PVC BEFORE ALL SVC#
NDLEM2(ERR114,XTRM$LINE," ");
END
END
ELSE # VALUE MUST BE -SVC- #
BEGIN
CRNT$CTYP = CTYP"SVC"; # SET CRNT CTYP TO SVC #
END
END
GOTO NEXT$PARAM;
NCIR:
NCIR$USED = TRUE; # SET NCIR SPECIFIED FLAG #
IF NOT XTRM$VLERR # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF NCIR IS WITHIN RANGE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(XTRM$VALNUM[0],USR$WID1,NUM"DEC",XTRM$STAT);
# CHECK USER RANGE #
END
ELSE
BEGIN
NDLCKRG(XTRM$KWID[0],XTRM$VALNUM[0],XTRM$STAT);
# CHECK NORMAL RANGE #
END
CRNT$NCIR = XTRM$VALNUM[0]; # SAVE NCIR VALUE #
END
GOTO NEXT$PARAM;
NEN:
NEN$USED = TRUE; # SET NEN SPECIFIED FLAG #
IF NOT XTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN # CHECK IF NEN IS WITHIN RANGE #
IF CRNT$TIP EQ TIP"USER" # IF TIPTYPE IS USER DEFINED #
THEN
BEGIN
USR$RANGE(XTRM$VALNUM[0],USR$WID1,NUM"DEC",XTRM$STAT);
# CHECK USER RANGE #
END
ELSE
BEGIN
NDLCKRG(XTRM$KWID[0],XTRM$VALNUM[0],XTRM$STAT);
# CHECK NORMAL RANGE #
END
IF XTRM$STAT # IF IT IS IN RANGE #
THEN
BEGIN
CRNT$NEN = XTRM$VALNUM[0]; # SAVE NEN VALUE #
END
END
GOTO NEXT$PARAM;
COLLECT:
COLLECT$USED = TRUE; # SET COLLECT SPECIFIED FLAG #
IF NOT XTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP NQ TIP"USER" AND
CRNT$STIP NQ STIP"PAD" AND
CRNT$STIP NQ STIP"USER"
THEN
BEGIN # FLAG ERROR -- PARAM INVALID WITH STIP #
NDLEM2(ERR135,XTRM$LINE,"COLLECT");
END
IF XTRM$VALNAM[0] EQ "YES"
THEN
BEGIN
COLLECT$FLAG = TRUE;
END
END
GOTO NEXT$PARAM;
PAD$:
IF NOT XTRM$VLERR[0] # IF VALUE IS O.K. #
THEN
BEGIN
IF CRNT$TIP NQ TIP"USER" AND
CRNT$STIP NQ STIP"XAA" AND
CRNT$STIP NQ STIP"PAD"
THEN
BEGIN # FLAG ERROR -- PARAM INVALID WITH STIP #
NDLEM2(ERR135,XTRM$LINE,"PAD");
END
ELSE
BEGIN # SAVE NUMBER OF 8-BIT PAD ENTRIES #
CRNT$DEPAD = XTRM$VALNUM[0];
CRNT$DEPADW = (CRNT$DEPAD*8 +59) / 60; # NO. WORDS FOR PAD #
FOR I = 1 STEP 1 UNTIL CRNT$DEPADW
DO
BEGIN # SAVE CURRENT PAD VALUE #
CRNT$PAD[I] = XTRM$PAD[I];
END
END
END
GOTO NEXT$PARAM;
NEXT$PARAM:
RETURN; # **** RETURN **** #
END # XTRMPRM #
CONTROL EJECT;
PROC X25TERM;
BEGIN
*IF,DEF,IMS
#
** X25TERM -- CHECKS TERMINALS PARAMETERS LEGAL FOR X.25 TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC X25TERM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES.
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(W,CTYP,NCIR,NEN,COLLECT):
* CHECK X.25 PARAMETER.
* CASE 3(TSPEED,CA,CO,BCF,MREC,EOF):
* FLAG ERROR -- ILLEGAL WITH TIPTYPE SPECIFIED.
* IF W WAS NOT SPECIFIED,
* FLAG ERROR -- REQUIRED PARAMETER MISSING.
* IF CTYP WAS NOT SPECIFIED
* DEFAULT CTYP TO SVC.
* IF CTYP IS SVC,
* THEN,
* IF NCIR IS GREATER THAN NSVC VALUE,
* FLAG ERROR -- NCIR VALUE TOO LARGE.
* IF NEN WAS NOT SPECIFIED,
* THEN,
* DEFAULT NEN TO NCIR VALUE.
* OTHERWISE,
* IF NEN IS GREATER THAN NCIR VALUE,
* FLAG ERROR -- NEN VALUE TO LARGE.
* OTHERWISE,(CTYP IS PVC)
* IF NCIR WAS SPECIFIED,
* FLAG ERROR -- NCIR ONLY VALID WITH SVC.
* IF NEN WAS SPECIFIED,
* FLAG ERROR -- NEN ONLY VALID WITH SVC.
*
#
*ENDIF
#
**** PROC X25TERM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH X25TJUMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
OTHERS , # TSPEED #
OTHERS , # CA #
OTHERS , # CO #
OTHERS , # BCF #
OTHERS , # MREC #
X25$PARAM , # W #
X25$PARAM , # CTYP #
X25$PARAM , # NCIR #
X25$PARAM , # NEN #
X25$PARAM , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
OTHERS , # EOF #
X25$PARAM ; # PAD #
# #
# X25TERM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO X25TJUMP[SWITCH$ID]; # GOTO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
X25$PARAM:
XTRMPRM(SWITCH$ID,STMT$TABLE[I],STLNUM[0]); # X25 PARAMETERS #
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]); # FOR X25 LINES #
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
IF NOT W$USED # IF W NOT SPECIFIED #
THEN
BEGIN # ASSIGN DEFAULT VALUE #
CRNT$W = W$DEF;
END
IF NOT CTYP$USED # IF CTYP NOT SPECIFIED #
THEN
BEGIN
CRNT$CTYP = CTYP"SVC"; # DEFAULT CTYP #
END
IF SVC$CNT GR 0 # LINE SUPPORTS SVC #
THEN
BEGIN
IF CRNT$CTYP EQ CTYP"SVC"
THEN
BEGIN
IF B<CRNT$STIP,1>XTERMASK EQ 0 # NO TERMINAL DEFINED YET #
THEN
BEGIN
B<CRNT$STIP,1>XTERMASK = 1; # SET FLAG #
END
ELSE
BEGIN
NDLEM2(ERR167,STLNUM[0],STIP$VAL[CRNT$STIP]);
END
END
END
IF CRNT$CTYP EQ CTYP"SVC" # IF CTYP IS SVC #
THEN
BEGIN
IF CRNT$NCIR GR SVC$CNT
THEN # NCIR VALUE LARGER THAN SVC COUNT ALLOTED#
BEGIN
NDLEM2(ERR150,STLNUM[0]," "); # FLAG ERROR -- NCIR TOO BIG #
END
SVC$SPEC = TRUE; # SET SVC SPECIFIED FLAG #
IF NOT NEN$USED # IF NEN NOT SPECIFIED #
THEN
BEGIN
CRNT$NEN = CRNT$NCIR; # DEFAULT NEN IS NCIR VALUE #
END
ELSE # NEN SPECIFIED #
BEGIN
IF CRNT$NEN GR CRNT$NCIR # IF NEN VALUE GREATER THAN NCIR#
THEN
BEGIN # FLAG ERROR -- NEN MUST NOT BE GREATER #
NDLEM2(ERR118,STLNUM[0]," "); # THAN NCIR VALUE #
END
END
END
ELSE # CTYP IS PVC OR UNKNOWN #
BEGIN
IF NCIR$USED # IF NCIR WAS SPECIFIED #
THEN
BEGIN # FLAG ERROR -- NCIR ONLY VALID WITH SVC #
NDLEM2(ERR101,STLNUM[0],"NCIR");
END
IF NEN$USED # IF NEN WAS SPECIFIED #
THEN
BEGIN # FLAG ERROR -- NEN VALID WITH SVC ONLY #
NDLEM2(ERR101,STLNUM[0],"NEN");
END
END
RETURN; # **** RETURN **** #
END # X25TERM #
CONTROL EJECT;
PROC $3270TRM;
BEGIN
*IF,DEF,IMS
#
** $3270TRM -- CHECK TERMINAL PARAMETERS LEGAL FOR MODE4 TIP.
*
* D.K. ENDO 81/12/01
*
* THIS PROCEDURE CALLS THE APPROPRIATE PROC TO CHECK EACH PARAMETER
* ON THE STATEMENT.
*
* PROC $3270TRM
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH VALUE DECLARATION,
* SELECT CASE THAT APPLIES,
* CASE 1(RIC,CSET):
* CHECK GENERAL PARAMETER.
* CASE 2(CA)
* CHECK MODE4 PARAMETER.
* CASE 3(TSPEED,CO,BCF,MREC,W,CTYP,NCIR,NEN,COLLECT,EOF):
* FLAG ERROR -- INVALID PARAMETER.
* IF CA WAS NOT SPECIFIED AND NOT AN AUTO-REC LINE.
* FLAG ERROR -- REQUIRE PARAMETER MISSING.
*
#
*ENDIF
#
**** PROC $3270TRM - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLEM2; # MAKES ENTRY IN PASS 2 ERROR FILE #
END
#
****
#
ITEM I; # SCRATCH ITEM #
ITEM SWITCH$ID; # USED AS I.D. FOR KEYWORD #
SWITCH $3270JMP NEXT$PARAM, # STIP #
NEXT$PARAM, # TC #
GEN$PARAM , # RIC #
GEN$PARAM , # CSET #
OTHERS , # TSPEED #
MD4$PARAM , # CA #
OTHERS , # CO #
OTHERS , # BCF #
OTHERS , # MREC #
OTHERS , # W #
OTHERS , # CTYP #
OTHERS , # NCIR #
OTHERS , # NEN #
OTHERS , # COLLECT #
OTHERS , # XAUTO #
OTHERS , # DT #
OTHERS , # SDT #
OTHERS , # TA #
OTHERS , # ABL #
OTHERS , # DBZ #
OTHERS , # UBZ #
OTHERS , # DBL #
OTHERS , # UBL #
OTHERS , # XBZ #
OTHERS , # DO #
OTHERS , # STREAM #
OTHERS , # HN #
OTHERS , # AUTOLOG #
OTHERS , # AUTOCON #
OTHERS , # PRI #
OTHERS , # P80 #
OTHERS , # P81 #
OTHERS , # P82 #
OTHERS , # P83 #
OTHERS , # P84 #
OTHERS , # P85 #
OTHERS , # P86 #
OTHERS , # P87 #
OTHERS , # P88 #
OTHERS , # P89 #
OTHERS , # AB #
OTHERS , # BR #
OTHERS , # BS #
OTHERS , # B1 #
OTHERS , # B2 #
OTHERS , # CI #
OTHERS , # CN #
OTHERS , # CT #
OTHERS , # DLC #
OTHERS , # DLTO #
OTHERS , # DLX #
OTHERS , # EP #
OTHERS , # IN #
OTHERS , # LI #
OTHERS , # OP #
OTHERS , # PA #
OTHERS , # PG #
OTHERS , # PL #
OTHERS , # PW #
OTHERS , # SE #
OTHERS , # FA #
OTHERS , # XLC #
OTHERS , # XLX #
OTHERS , # XLTO #
OTHERS , # ELO #
OTHERS , # ELX #
OTHERS , # ELR #
OTHERS , # EBO #
OTHERS , # EBR #
OTHERS , # CP #
OTHERS , # IC #
OTHERS , # OC #
OTHERS , # LK #
OTHERS , # EBX #
OTHERS , # HD #
OTHERS , # MC #
OTHERS , # XLY #
OTHERS , # EOF #
OTHERS ; # PAD #
# #
# $3270TRM CODE BEGINS HERE #
# #
FOR I=2 STEP 1 UNTIL STWC[0]
DO # FOR EACH VALUE-DECLARATION ENTRY #
BEGIN
SWITCH$ID = STKWID[I] - KID"STIP"; # CALCULATE SWITCH ID #
GOTO $3270JMP[SWITCH$ID]; # GO TO APPROPRIATE PARAGRAPH #
GEN$PARAM:
GENTERM(SWITCH$ID,STWORD[I],STLNUM[0]); # GENERAL PARAMETERS #
GOTO NEXT$PARAM;
MD4$PARAM:
MTRMPRM(SWITCH$ID,STWORD[I],STLNUM[0]); # MODE4 PARAMETERS #
GOTO NEXT$PARAM;
OTHERS: # ALL OTHER PARAMETERS FLAG AS INVALID #
IF NOT TT$USED # IF THIS LINE IS AUTO-SYNC #
THEN
BEGIN # FLAG ERROR -- INVALID WITH STIP/TC SPEC #
NDLEM2(ERR135,STLNUM[0],KWDNAME[SWITCH$ID]);
END
ELSE # TIPTYPE MUST HAVE BEEN SPECIFIED #
BEGIN # FLAG ERROR -- INVALID WITH TIPTYPE SPEC #
NDLEM2(ERR106,STLNUM[0],KWDNAME[SWITCH$ID]);
END
IF STKWID[I] EQ KID"PAD"
THEN
BEGIN # STATEMENT TABLE #
I = I + MAXPADW; # PAD ENTRIES ARE 1+MAXPADW LONG#
END
NEXT$PARAM: # GO TO NEXT PARAMETER #
END
RETURN; # **** RETURN **** #
END # $3270TRM #
CONTROL EJECT;
# #
# TERMPR CODE BEGINS HERE #
# #
COLLECT$FLAG = FALSE;
COLLECT$USED = FALSE;
CRNT$STIP = STIP"UNKNOWN";
CRNT$TC = TC"UNKNOWN";
BCF$FLAG = FALSE;
CA$USED = FALSE;
CRNT$CSET = CSET"UNKNOWN";
CRNT$CTYP = CTYP"UNKNOWN";
CRNT$MREC = 0;
CRNT$NCIR = NCIR$DEF;
CRNT$NEN = NCIR$DEF;
CRNT$EOF = FALSE;
EOF$USED = FALSE;
CRNT$TSPD = LSPD"UNKNOWN";
CRNT$W = 0;
CRNT$DEPAD = 0; # INITIALIZE PAD ENTRY COUNT #
CRNT$DEPADW = 0; # INITIALIZE PAD ENTRY "(WORDS)#
CSET$USED = FALSE;
CTYP$USED = FALSE;
NCIR$USED = FALSE;
NEN$USED = FALSE;
RIC$FLAG = FALSE;
RIC$USED = FALSE;
STIP$USED = FALSE;
TC$USED = FALSE;
W$USED = FALSE;
# #
IF LRWC[1]+MXTRENT GQ LR$LENG
THEN # IF NEED MORE TABLE SPACE FOR ENTRY #
BEGIN
SSTATS(P<LINE$RECORD>,MXTRENT); # ALLOCATE MORE TABLE SPACE #
END
CRNT$TERM = LRWC[1] + 1; # SET POINTER TO CURRENT TERM #
LRWORD[CRNT$TERM] = 0; # CLEAR 1ST WORD IN ENTRY #
TE$IDENT[CRNT$TERM] = "TRM"; # ENTER TERMINAL IDENTIFIER #
TEWC[CRNT$TERM] = 2; # ENTER ENTRY WORD COUNT #
LRWC[1] = LRWC[1] + 2; # INCREMENT LINE REC WORD COUNT #
LRWORD[LRWC[1]] = 0; # CLEAR 2ND WORD IN ENTRY #
IF NOT AUTO$REC # IF NOT AN AUTO REC LINE #
THEN
BEGIN
DEVCNT = 0; # CLEAR DEVICE COUNT #
TERMCNT = TERMCNT + 1; # CLEAR TERMINAL COUNT #
IF TERMCNT GR MAXTERM # IF COUNT EXCEEDS MAX FOR TERMS#
THEN
BEGIN # FLAG ERROR -- MAX TERMS EXCEEDED #
NDLEM2(ERR115,STLNUM[0]," ");
END
END # PUT CURRENT TIP IN TERM ENTRY #
TETP[CRNT$TERM + 1] = LCTTYP$IP[2];
IF LCTTYP$IP[2] EQ SYNAUTO
THEN # IF TIPTYPE IS SYNC AUTO-REC #
BEGIN
CRNT$TIP = TIP"UNKNOWN"; # CLEAR CURRENT TIPTYPE VALUE #
END
IF STORD1[1] NQ 0 # IF STIP HAS BEEN SPECIFIED #
THEN
BEGIN
STIP$USED = TRUE; # SET STIP SPECIFIED FLAG #
IF NOT STVLERR[STORD1[1]] # IF VALUE IS O.K. #
THEN
BEGIN # IF VALUE IS AUTOREC #
IF STVALNAM[STORD1[1]] EQ "AUTOREC"
THEN
BEGIN
IF NOT AUTO$REC # IF NOT AN AUTO-REC LINE #
THEN
BEGIN # FLAG ERROR -- AUTOREC NOT VALID #
NDLEM2(ERR113,STLNUM[0]," ");
END
ELSE # NOT AN AUTO-REC LINE #
BEGIN
STIP$USED = FALSE; # CLEAR STIP SPECIFIED FLAG #
END
END
ELSE # VALUE IS NOT AUTOREC #
BEGIN # SEARCH STIP TABLE FOR VALUE #
FOR I=1 STEP 1 UNTIL MXSTIP
DO
BEGIN # IF VALUE IS FOUND #
IF STVALNAM[STORD1[1]] EQ STIP$VAL[I]
THEN
BEGIN
CRNT$STIP = STIP$STATUS[I]; # SET CURRENT STIP #
TESTIP[CRNT$TERM + 1] = STIP$NUMV[I]; #SET FIELD IN ENT#
END
END
IF CRNT$TIP NQ TIP"USER" AND # IF TIPTYPE IS NOT #
CRNT$TIP NQ TIP"UNKNOWN" # USER OR UNKNOWN #
THEN
BEGIN # STIP AND NOT COMPATIBLE #
IF B<CRNT$TIP,1>STIP$TIP$MAP[CRNT$STIP] NQ 1
THEN
BEGIN # FLAG ERROR -- INVALID WITH TIP#
NDLEM2(ERR112,STLNUM[0],STIP$VAL[CRNT$STIP]);
CRNT$STIP = STIP"UNKNOWN"; # CLEAR CURRENT STIP #
END
END
END
END
END
IF STORD2[1] NQ 0 # IF TC WAS SPECIFIED #
THEN
BEGIN
TC$USED = TRUE; # SET TC SPECIFIED FLAG #
IF NOT STVLERR[STORD2[1]] # IF VALUE IS O.K. #
THEN
BEGIN # IF VALUE IS CCP #
IF STVALNAM[STORD2[1]] EQ "CCP"
THEN
BEGIN
TC$USED = FALSE; # CLEAR TC SPECIFIED FLAG #
END
ELSE # VALUE IS NOT CCP #
BEGIN # SEARCH TABLE FOR VALUE #
FOR I=1 STEP 1 UNTIL MXTC
DO
BEGIN # IF VALUE IS FOUND #
IF STVALNAM[STORD2[1]] EQ TC$VAL[I]
THEN
BEGIN
CRNT$TC = TC$STATUS[I]; # SET CURRENT TC #
TETC[CRNT$TERM + 1] = TC$NUMV[I]; # PUT VALUE IN ENTRY#
END
END
IF CRNT$TIP NQ TIP"USER" AND # IF TIPTYPE TC NOT #
CRNT$TC NQ TC"USER" # USER AND TC IS NOT#
THEN # USER #
BEGIN
IF CRNT$STIP NQ STIP"UNKNOWN" # IF STIP IS NOT #
THEN # UNKNOWN #
BEGIN # IF STIP AND TC NOT COMPATIBLE #
IF B<CRNT$STIP,1>STIP$AMAP[CRNT$TC] NQ 1
THEN
BEGIN # FLAG ERROR -- STIP AND TC NOT COMPATIBLE#
NDLEM2(ERR111,STLNUM[0],STVALNAM[STORD2[1]]);
CRNT$TC = TC"UNKNOWN"; # CLEAR CURRENT TC #
END
END
ELSE # CURRENT STIP IS UNKNOWN #
BEGIN # IF CURRENT TIPTYPE NOT UNKNOWN#
IF CRNT$TIP NQ TIP"UNKNOWN"
THEN
BEGIN # IF TIPTYPE AND TC NOT COMPATBL#
IF B<CRNT$TIP,1>TC$TIP$AMAP[CRNT$TC] NQ 1
THEN
BEGIN # FLAG ERROR -- TIPTYPE AND TC NOT COMPAT #
NDLEM2(ERR112,STLNUM[0],STVALNAM[STORD2[1]]);
CRNT$TC = TC"UNKNOWN"; # CLEAR CURRENT TC #
END
END
END
END
END
END
END
IF CRNT$TIP NQ TIP"USER" # IF TIPTYPE IS NOT USER #
THEN
BEGIN
IF NOT STIP$USED # IF STIP NOT SPECIFIED #
THEN
BEGIN
IF TC$USED # IF TC NOT SPECIFIED #
THEN
BEGIN
IF (CRNT$TIP EQ TIP"ASYNC" OR CRNT$TIP EQ TIP"MODE4"
OR CRNT$TIP EQ TIP"HASP") AND (CRNT$TC EQ TC"USER")
THEN
BEGIN
NDLEM2(ERR160,STLNUM[0]," ");
END
ELSE
BEGIN
CRNT$STIP = DEF$STIP[CRNT$TC]; # SAVE DEFAULT STIP #
IF CRNT$TIP EQ TIP"X25" # IF TIPTYPE IS X25 #
THEN
BEGIN
CRNT$STIP = STIP"PAD"; # DEFAULT STIP TO PAD #
END # STORE STIP VALUE IN TERM ENTRY#
TESTIP[CRNT$TERM + 1] = STIP$NUMV[CRNT$STIP];
END
END
ELSE # TC NOT SPECIFIED #
BEGIN # FLAG ERROR -- TC OR STIP REQUIRED #
NDLEM2(ERR117,STLNUM[0]," ");
END
END
END
IF NOT TT$USED # IF TIPTYPE WAS NOT SPECIFIED #
THEN
BEGIN
IF LTYPE EQ "SYNC" AND # IF LTYPE IS SYNCHRONOUS #
AUTO$REC # AND AUTO-REC #
THEN
BEGIN # DEFAULT TIPTYPE BASED ON STIP #
TETP[CRNT$TERM+1] = STIP$TIP[CRNT$STIP];
CRNT$TIP = STIP$TIP[CRNT$STIP];
END
END
GOTO TRMJUMP[CRNT$TIP]; # CHECK REST OF PARAMETERS #
ASYNC:
ASYTERM; # CHECK ASYNC TERMINAL PARAMS #
GOTO GEN$CHECK;
MODE4:
MD4TERM; # CHECK MODE4 TERMINAL PARAMS #
GOTO GEN$CHECK;
HASP:
HSPTERM; # CHECK HASP TERMINAL PARAMETERS#
GOTO GEN$CHECK;
X25:
X25TERM; # CHECK X25 TERMINAL PARAMETERS #
GOTO GEN$CHECK;
BSC:
BSCTERM; # CHECK BSC TERMINAL PARAMETERS #
GOTO GEN$CHECK;
$3270:
$3270TRM;
GOTO GEN$CHECK;
USER:
USRTERM; # CHECK USER TERMINAL PARAMETERS#
GOTO NEXT;
GEN$CHECK: # FINAL GENERAL CHECKS #
IF NOT CSET$USED AND # IF CSET NOT SPECIFIED AND NOT #
NOT AUTO$REC # AN AUTO-REC LINE #
THEN
BEGIN # DEFAULT CSET #
IF CRNT$TIP EQ TIP"$3270"
THEN # IF TIP IS 3270 #
BEGIN
CRNT$CSET = CSET"EBCDIC";
TECD[CRNT$TERM+1] = CRNT$CSET;
END
ELSE # DEFAULT BY STIP #
BEGIN
CRNT$CSET = CSET$DEF[CRNT$STIP];
TECD[CRNT$TERM+1] = CRNT$CSET;
END
END
NEXT:
FOR I=1 STEP 1 UNTIL MXDT
DO
BEGIN
DT$CNT[I] = 0; # CLEAR DEVICE TYPE COUNT #
DO$MAP[I] = 0; # CLEAR -DO- AND STREAM MAP #
STRM$MAP[I] = 0;
FIRST$DT[I] = TRUE; # SET FIRST DEVICE TYPE MAP #
END
CP$PL$MAP = 0; # CLEAR CP/PL BIT MAP #
TA$MAP = 0; # CLEAR -TA- MAP #
IF NOT AUTO$REC # IF NOT AN AUTO-REC LINE #
THEN # SET MAXIMUM NUMBER OF DEVICE TYPES #
BEGIN
MAXDEV = DEV$MAX[CRNT$TIP]; # SET MAX NUMBER OF DEVICE STMTS#
IF CRNT$STIP EQ STIP"M4A" # IF CURRENT STIP IS M4A #
THEN
BEGIN
MAXDEV = DEV$MX$M4A;
DT$MAX[DT"CON"] = CON$MX$M4A;
DT$MAX[DT"CR"] = CR$MAX$M4A;
DT$MAX[DT"LP"] = LP$MAX$M4A;
DT$MAX[DT"USER"] = DT7$MX$M4A;
END
ELSE # ALL OTHER STIP-S #
BEGIN
DT$MAX[DT"CON"] = CON$MAX[CRNT$TIP];
DT$MAX[DT"CR"] = CR$MAX[CRNT$TIP];
DT$MAX[DT"LP"] = LP$MAX[CRNT$TIP];
DT$MAX[DT"USER"] = DT7$MAX[CRNT$TIP];
END
DT$MAX[DT"CP"] = CP$MAX[CRNT$TIP];
DT$MAX[DT"PL"] = PL$MAX[CRNT$TIP];
DT$MAX[DT"AP"] = AP$MAX[CRNT$TIP];
END
ELSE # LINE IS AUTO-REC #
BEGIN
MAXDEV = 255;
END
RETURN; # **** RETURN **** #
END # TERMPR #
CONTROL EJECT;
PROC USR$RANGE(UVALNUM,U$RANGE,UMODE,USTAT);
BEGIN
*IF,DEF,IMS
#
**
* THIS PROCEDURE CHECKS THE RANGE OF DEVICE, LINE OR TERMINAL
* PARAMETERS FOR USER DEFINED TIPTYPES.
*
* Y. C. YIP 11/24/1982
*
* PROC USR$RANGE(UVALNUM,U$RANGE,UMODE,USTAT)
*
* ENTRY UVALNUM = VALUE WHOSE RANGE TO BE CHECKED.
*
* USTAT = STATUS SET TO FALSE IF OUT OF RANGE
*
* ELSE TO TRUE.
*
* U$RANGE = UPPER RANGE APPLICABLE FOR THIS PARAMETER.
*
* UMODE = 1 FOR DECIMAL AND 2 FOR HEX.
* EXIT NONE.
*
* METHOD THIS PROCEDURE PICKS UP THE UVALNUM OF THE PARAMETER
*
* CHECKS IF IT IS GREATER THAN OR EQUAL TO 0 AND
*
* IF IT IS LESS THAN OR EQUAL TO U$RANGE. IF SO,
*
* USTAT IS LEFT SET AT TRUE ELSE IT IS SET TO FALSE.
*
* ALSO, ERR100 IS GENERATED IF VALUE IS OUT OF RANGE.
*
#
*ENDIF
XREF
BEGIN
FUNC XCDD C(10); # CONVERTS DECIMAL TO DISPLAY CODE #
FUNC XCHD C(10); # CONVERTS HEXIDECIMAL TO DISPLAY #
END
DEF ZERO # 0 #; # VALUE 0 #
ITEM UVALNUM ; # USER VALUE #
ITEM U$RANGE ; # UPPER LIMIT OF THIS USER PARAMETER#
ITEM CTEMP C(10); # CHARACTER TEMPORARY #
ITEM UMODE; # 1 FOR DECIMAL AND 2 FOR HEX #
ITEM USTAT B ; # USER STATUS #
USTAT = TRUE; # PRSETTING USTAT IS TRUE #
IF NOT (UVALNUM GQ ZERO AND
UVALNUM LQ U$RANGE) # IF NOT WITHIN RANGE #
THEN
BEGIN
USTAT = FALSE; # SET ERROR STATUS FLAG #
IF UMODE EQ NUM"DEC" # IF DECIMAL #
THEN
BEGIN
CTEMP = XCDD(UVALNUM); # CONVERT TO DECIMAL #
END
ELSE
BEGIN
CTEMP = XCHD(UVALNUM); # CONVERTS TO DISPLAY CODE #
END
NDLEM2(ERR100,STLNUM[0],C<4,6>CTEMP); # ERROR MESSAGE #
END
RETURN;
END # END OF PROC USR$RANGE #
CONTROL EJECT;
# #
# NDLNFCM CODE BEGINS HERE #
# #
COM$ELMT = TRUE; # SET COMMUNICATION ELEMENT FLAG #
LCR$EXIST = FALSE; # CLEAR LINE CONFIG REC EXISTS FLAG #
LR$EXIST = FALSE; # CLEAR LINE RECORD EXISTS FLAG #
FOR I=1 WHILE COM$ELMT
DO # WHILE THE ENTRIES DESCRIBE COMMUNICATION#
BEGIN # ELEMENTS #
GOTO COMJUMP[STSTID[0]]; # JUMP TO APPROPRIATE PARAGRAPH #
# #
LINE:
IF LR$EXIST # IF A LINE RECORD EXISTS #
THEN # WRITE IT OUT TO NCF #
BEGIN
LRWORD[LRWC[1]+1] = 0; # CLEAR NEXT WORD #
NWDS16 = ((LRWC[1]+2)*60)/16; # CALCULATE NPU WORD COUNT #
# CALCULATE CHECK SUM #
LFGCKSM(LOC(LINE$RECORD),59,NWDS16,CKSUM);
# ADD CHECK SUM TO TOTAL #
NPCKSM[NPWC[0]] = NPCKSM[NPWC[0]] + CKSUM;
LENGTH = LRWC[1] + 1; # SAVE LENGTH OF RECORD #
NDLWNCF(TABLE"LR",P<LINE$RECORD>,LENGTH); # WRITE RECORD TO NCF#
LR$EXIST = FALSE; # CLEAR LINE RECORD EXISTS FLAG #
END
IF LCR$EXIST # IF LINE CONFIGURATION RECORD EXISTS #
THEN # WRITE RECORD TO FILE #
BEGIN
IF CRNT$TIP EQ TIP"X25" OR # IF X25 LINE #
(CRNT$TIP EQ TIP"USER" AND LTYPE EQ "X25")
THEN
BEGIN # STORE PVC COUNT #
LINFNFV(FN"PVC",PVC$CNT);
END
NDLWLCR(CRNT$NPU,FALSE);
LCR$EXIST = FALSE; # CLEAR LINE CON REC EXISTS FLAG#
END
READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); # READ STMT ENTRY #
LINGRPR; # CALL PROC TO PROCESS ENTRY #
GOTO NEXT;
TERMINAL$:
READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); # READ STMT ENTRY #
TERMPR; # CALL PROC TO PROCESS ENTRY #
GOTO NEXT;
DEVICE:
READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); # READ STMT ENTRY #
DEVPR; # CALL PROC TO PROCESS ENTRY #
GOTO NEXT;
TRUNK:
READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); # READ STMT ENTRY #
NDLTRNK; # CALL PROC TO PROCESS ENTRY #
GOTO NEXT;
NET$ELMT:
COM$ELMT = FALSE; # CLEAR COMMUNICATION ELEMENT FLAG #
IF LR$EXIST # IF A LINE RECORD EXISTS #
THEN # WRITE IT TO THE NCF #
BEGIN
LRWORD[LRWC[1]+1] = 0; # CLEAR NEXT WORD #
NWDS16 = ((LRWC[1]+2)*60)/16; # CALCULATE NPU WORD COUNT #
# CALCULATE CHECK SUM #
LFGCKSM(LOC(LINE$RECORD),59,NWDS16,CKSUM);
# ADD CHECK SUM TO TOTAL #
NPCKSM[NPWC[0]] = NPCKSM[NPWC[0]] + CKSUM;
LENGTH = LRWC[1] + 1; # SAVE LENGTH OF RECORD #
NDLWNCF(TABLE"LR",P<LINE$RECORD>,LENGTH); # WRITE RECORD TO NCF#
END
IF LCR$EXIST # IF LINE CONFIGURATION RECORD EXISTS #
THEN # WRITE RECORD TO FILE #
BEGIN
IF CRNT$TIP EQ TIP"X25" OR # IF X25 LINE #
(CRNT$TIP EQ TIP"USER" AND LTYPE EQ "X25")
THEN
BEGIN # STORE PVC COUNT #
LINFNFV(FN"PVC",PVC$CNT);
END
NDLWLCR(CRNT$NPU,FALSE);
END
NDLWLCR(CRNT$NPU,TRUE); # CLEAR LINE CONFIG RECORD BUFFER #
TEST I; # EXIT LOOP #
NEXT:
READW(STFET,STMT$TABLE,1,STMT$STAT); # READ HEADER OF NEXT ENT #
IF STMT$STAT NQ TRNS$OK # IF NOTHING WAS READ #
THEN # DO END PROCESSING #
BEGIN
GOTO NET$ELMT;
END
END # FOR LOOP #
RETURN; # **** RETURN **** #
END # NDLNFCM #
TERM