*DECK NDLINIT
USETEXT NDLDATT
USETEXT NDLFETT
USETEXT NDLTBLT
PROC NDLINIT;
BEGIN
*IF,DEF,IMS
#
** NDLINIT - INITIALIZES NDLP.
*
* D.K. ENDO 81/10/09
*
* THIS PROGRAM CAUSES INITIALIZATION OF NDLP-S FLAGS, VALUES
* AND TABLES.
*
* PROC NDLINIT
*
* ENTRY NONE.
*
* EXIT APPROPRIATE INITIALIZING OF FLAGS, VALUES,
* AND ARRAYS.
*
* MESSAGES INVALID CONTROL CARD OPTION.
*
* METHOD
*
* INITIALIZE VARIOUS FLAGS.
* CALL THE TABLE MANAGER TO INITIALIZE TABLE POINTERS.
* CALL THE CONTROL CARD CRACKER.
* INITIALIZE OUTPUT FET.
* IF THIS IS A CREATION RUN.
* INITIALIZE INPUT FET AND READ INTO CIO BUFFER.
* INITIALIZE OTHER FETS.
* ALLOCATE TABLE SPACE TO DEFINE AND LABEL TABLES.
*
#
*ENDIF
#
**** PROC NDLINIT - XREF LIST BEGINS.
#
XREF
BEGIN
PROC ABORT;
PROC SSTATS; # ALLOCATES SPACE TO A GIVEN TABLE #
PROC SSTITM; # CALLS MANAGER TO DO ITS INITIALIZATION #
PROC MEMORY; # UTILITY FOR REQUESTING MORE MEMORY #
PROC MESSAGE; # SENDS MESSAGE TO DAYFILE #
PROC READ; # READS INTO BUFFER FROM FILE #
PROC RECALL;
END
#
****
#
ITEM
CC$ERROR B, # CONTROL CARD ERROR STATUS #
EXTRA U, # CONTAINS AMOUNT OF BUFFER SPACE FOR TBLS#
INFILE C(10), # NAME OF INPUT FILE #
MEMSTAT U, # CONTAINS AMOUNT OF MEMORY REQUESTED #
OUTFILE C(10), # NAME OF OUTPUT FILE #
RQTYPE C(10); # CONTAINS REQUEST TYPE FOR MEMORY #
BASED ARRAY RA104[0:0] S(1);
ITEM # POINTED TO RANDOM ADDRESS 104(OCTAL) #
HHA U(0,42,18); # CONTAINS HIGHEST HIGH ADDRESS FOR NDLP #
ARRAY INVCCRD[0:0] S(4);
ITEM
ICCMESS C(0,0,30) = [" INVALID CONTROL CARD OPTION. "],
ICCZBYT U(3,0,60) = [0]; # ZERO FILL MESSAGE #
DEF TFL #10000#; # MINIMUM BUFFER SPACE #
CONTROL EJECT;
PROC CRACKER(ERROR);
BEGIN
*IF,DEF,IMS
#
** CRACKER - INTERPRETS CONTROL CARD OPTIONS
*
* D.K. ENDO 81/10/09
*
* THIS PROCEDURE VALIDATES THE NDLP CONTROL CARD PARAMETERS AND
* SETS FLAG AND VALUES ACCORDINGLY.
*
* PROC CRACK(ERROR)
*
* ENTRY NONE.
*
* EXIT ERROR = FLAG SET IF ERROR DETECTED ON CONTROL CARD.
*
* MESSAGES NONE.
*
* METHOD
*
* IF THERE ARE PARAMETERS ON CONTROL CARD
* FOR EACH PARAMETER WHILE NOT DONE,
* SEARCH TABLE FOR PARAMETER.
* IF NOT FOUND,
* THEN,
* FLAG ERROR.
* OTHERWISE,
* GOTO TO APPROPRIATE PARAGRAPH TO CHECK PARAMETER.
* CHECK IF LEGAL COMBINATION OF PARAMETERS WAS SPECIFIED.
* IF NOT SPECIFIED CORRECTLY,
* FLAG ERROR.
*
#
*ENDIF
ITEM ERROR B; # ERROR STATUS RETURNED TO CALLER #
#
**** PROC CRACKER - XREF LIST BEGINS.
#
XREF
BEGIN
PROC NDLZFIL; # ZERO FILLS GIVEN NAME #
END
#
****
#
DEF COMMA # O"1" #; # NUMBER REPRESENTING COMMA FOR PARAM LIST#
DEF EQUAL # O"2" #; # NUMBER REPRESENTING EQUAL #
DEF TRMNAT # O"17" #; # NUMBER INDICATING TERMINATING OF LIST #
DEF ZERO # O"33000000000000" #; # ZERO FILLED VALUE FOR ZERO #
# #
ITEM DONE B; # COMPLETION FLAG #
ITEM FOUND B; # FOUND INDICATOR #
ITEM I; # SCRATCH ITEM #
ITEM J; # SCRATCH ITEM #
ITEM SWTCHVCTR; # SWITCH VECTOR FOR PARAMETER CHECKING #
# #
BASED ARRAY PARAMS [0:0] S(1); # PARAMETER LIST #
BEGIN
ITEM PARAM U(00,00,42); # PARAMETER NAME #
ITEM PVALUE C(00,00,07); # PARAMETER VALUE #
ITEM PCODE U(00,54,06); # DELIMITER CODE #
END
BASED ARRAY NUM$PRM [0:0] S(1);
BEGIN
ITEM NUM$PARAM U(00,42,18);
END
DEF MXPRMS # 5 #;
ARRAY PARAM$TABLE [1:MXPRMS] S(1);
BEGIN
ITEM PRMNAME U(00,00,42) = [O"11000000000000", # I -- NAME #
O"14000000000000", # L #
O"14060000000000", # LF #
O"14170000000000", # LO #
O"16060000000000", # NF #
];
ITEM PRMSVCTR U(00,42,18) = [0, # I -- SWITCH VECTOR #
1, # L #
2, # LF #
3, # LO #
4 # NF #
];
END
SWITCH LO$JUMP NEXTVAL,# ZERO -- JUMP FOR LIST OPTIONS #
ERR$VAL,# A #
ERR$VAL,# B #
ERR$VAL,# C #
D$VAL, # D #
ERR$VAL,# E #
F$VAL, # F #
ERR$VAL,# G #
ERR$VAL,# H #
ERR$VAL,# I #
ERR$VAL,# J #
ERR$VAL,# K #
ERR$VAL,# L #
ERR$VAL,# M #
N$VAL, # N #
ERR$VAL,# O #
ERR$VAL,# P #
ERR$VAL,# Q #
ERR$VAL,# R #
S$VAL, # S #
ERR$VAL,# T #
ERR$VAL,# U #
ERR$VAL,# V #
ERR$VAL,# W #
ERR$VAL,# X #
ERR$VAL,# Y #
ERR$VAL,# Z #
ERR$VAL,# 0 #
ERR$VAL,# 1 #
ERR$VAL,# 2 #
ERR$VAL,# 3 #
ERR$VAL,# 4 #
ERR$VAL,# 5 #
ERR$VAL,# 6 #
ERR$VAL,# 7 #
ERR$VAL,# 8 #
ERR$VAL;# 9 #
SWITCH PRMJUMP I$PARAM,# INPUT FILE NAME -- PARAMETER JUMP #
L$PARAM,# OUTPUT FILE NAME #
LF$PARM,# LCF FILE NAME #
LO$PARM,# LIST OPTIONS #
NF$PARM;# NCF FILE NAME #
CONTROL EJECT;
# #
# CRACKER CODE BEGINS HERE #
# #
P<PARAMS> = O
"2"; # POINT TO PARAMETER LIST # P<NUM$PRM> = O"64"; # POINT TO PARAMETER COUNT #
ERROR = FALSE; # CLEAR ERROR FLAG #
DONE = FALSE; # CLEAR TERMINATION FLAG #
IF NUM$PARAM[0] NQ 0 # IF THERE WERE PARAMETERS SPECIFIED #
THEN
BEGIN
FOR I=0 STEP 1 WHILE NOT DONE
DO # FOR EACH PARAMETER SPECIFIED #
BEGIN
IF PCODE[I] EQ TRMNAT OR # IF CODE FOR TERMINATION #
PCODE[I+1] EQ TRMNAT # DETECTED #
THEN
BEGIN
DONE = TRUE; # SET DONE FLAG #
END
FOUND = FALSE; # CLEAR FOUND FLAG #
FOR J=1 STEP 1 WHILE NOT FOUND AND
J LQ MXPRMS
DO # SEARCH TABLE FOR PARAMETER #
BEGIN
IF PARAM[I] EQ PRMNAME[J] # IF PARAMETER IS FOUND #
THEN
BEGIN
FOUND = TRUE; # SET FOUND FLAG #
SWTCHVCTR = PRMSVCTR[J]; # SAVE SWITCH VECTOR FOR PARAM #
END
END
IF NOT FOUND # IF PARAM NOT FOUND IN TABLE #
THEN
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
TEST I;
END
ELSE # PARAMETER IS LEGAL #
BEGIN
GOTO PRMJUMP[SWTCHVCTR]; # GOTO APPROPRIATE PARAGRAPH #
I$PARAM:
CRERUN = TRUE; # SET CREATION RUN FLAG #
IF PCODE[I] EQ EQUAL # IF DELIMITER IS EQUAL #
THEN
BEGIN
I = I + 1; # POINT TO VALUE #
INFILE = PVALUE[I]; # SAVE INPUT FILE NAME #
END
ELSE # DELIMITER NOT EQUAL #
BEGIN
IF PCODE[I] EQ COMMA OR # IF DELIMITER IS COMMA OR #
PCODE[I] EQ TRMNAT # TERMINATOR #
THEN
BEGIN
INFILE = "COMPILE"; # DEFAULT INPUT FILE NAME #
END
ELSE # ILLEGAL DELIMITER #
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
END
END
TEST I;
L$PARAM:
IF PCODE[I] EQ EQUAL # IF DELIMITER IS EQUAL #
THEN
BEGIN
I = I + 1; # POINT TO VALUE #
IF PVALUE[I] EQ ZERO # IF VALUE IS ZERO, NO OUTPUT #
THEN # LISTING DESIRED #
BEGIN
LISTFLG = FALSE; # CLEAR LISTING FLAG #
END
ELSE # VALUE IS NOT ZERO #
BEGIN
OUTFILE = PVALUE[I]; # SAVE OUTPUT FILE NAME #
END
END
ELSE # DELIMITER IS NOT EQUAL #
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
END
TEST I;
LF$PARM:
IF PCODE[I] EQ EQUAL # IF DELIMITER IS EQUAL #
THEN
BEGIN
SUMRUN = TRUE; # SET SUMMARY RUN FLAG #
LISTLF = TRUE; # SET LCF SUMMARY FLAG #
I = I + 1; # POINT TO VALUE #
LFFILE = PVALUE[I]; # SAVE LCF FILE NAME #
NDLZFIL(LFFILE); # ZERO FILL NAME #
END
ELSE # DELIMITER IS NOT ZERO #
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
END
TEST I;
LO$PARM:
IF PCODE[I] EQ EQUAL # IF DELIMITER IS EQUAL #
THEN
BEGIN
I = I + 1; # POINT TO VALUE #
CRERUN = TRUE; # SET CREATION RUN FLAG #
LISTN = FALSE; # CLEAR NORMAL SOURCE LIST FLAG #
LISTD = FALSE; # CLEAR DEFINE LISTING FLAG #
FOR J=0 STEP 1 UNTIL 7
DO # FOR EACH CHARACTER IN VALUE #
BEGIN # GOTO APPROPRIATE PARAGRAPH #
GOTO LO$JUMP[C<J,1>PVALUE[I]];
N$VAL:
LISTN = TRUE; # SET NORMAL SOURCE LISTING FLAG#
TEST J;
D$VAL:
LISTD = TRUE; # SET DEFINE LISTING FLAG #
TEST J;
S$VAL:
LISTS = TRUE; # SET EXPANDED SOURCE LIST FLAG #
TEST J;
F$VAL:
LISTF = TRUE; # SET FILE SUMMARY FLAG #
TEST J;
ERR$VAL:
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
NEXTVAL:
TEST J;
END
END
ELSE # DELIMITER IS NOT EQUAL #
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
END
TEST I;
NF$PARM:
IF PCODE[I] EQ EQUAL # IF DELIMITER IS EQUAL #
THEN
BEGIN
SUMRUN = TRUE; # SET SUMMARY RUN FLAG #
LISTNF = TRUE; # SET NCF SUMMARY LIST FLAG #
I = I + 1; # POINT TO VALUE #
NFFILE = PVALUE[I]; # SAVE NCF FILE NAME #
NDLZFIL(NFFILE); # ZERO FILL NAME #
END
ELSE # DELIMITER IS NOT EQUAL #
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
DONE = TRUE; # SET DONE FLAG #
END
TEST I;
END
END
END
ELSE # NO PARAMETER SPECIFIED #
BEGIN
CRERUN = TRUE; # SET CREATION RUN FLAG #
SUMRUN = FALSE; # CLEAR SUMMARY RUN FLAG #
END
NDLZFIL(OUTFILE); # ZERO FILL OUTPUT FILE NAME #
NDLZFIL(INFILE); # ZERO FILL INPUT FILE NAME #
IF CRERUN AND # IF BOTH CREATION RUN AND SUMMARY RUN #
SUMRUN # PARAMETERS SPECIFIED #
THEN
BEGIN
ERROR = TRUE; # SET ERROR FLAG #
END
IF NOT CRERUN AND # IF BOTH FLAG ARE NOT SET, THEN ONLY THE #
NOT SUMRUN # -L- PARAMETER WAS SPECIFIED #
THEN
BEGIN
CRERUN = TRUE; # SET CREATION RUN FLAG #
SUMRUN = FALSE; # CLEAR SUMMARY RUN FLAG #
END
RETURN; # **** RETURN **** #
END # CRACKER #
CONTROL EJECT;
# #
# NDLINIT CODE BEGINS HERE #
# #
# INITIALIZE FLAGS AND FILE NAMES #
LISTLF = FALSE;
LISTNF = FALSE;
LISTN = TRUE;
LISTD = TRUE;
LISTS = FALSE;
LISTF = FALSE;
INFILE = "INPUT";
OUTFILE = "OUTPUT";
LISTFLG = TRUE;
CRERUN = FALSE;
SUMRUN = FALSE;
EOINP = FALSE;
# INITIALIZE TABLE MANAGER #
RQTYPE = "CM"; # SET REQUEST TYPE #
MEMSTAT = 0;
P<RA104> = O"104"; # POINT BASED ARRAY TO REL ADDR 104 #
MEMORY(RQTYPE,MEMSTAT);# FIND SIZE OF FIELD LENGTH #
MEML = HHA[0]; #SAVE POINTER TO BEGINNING OF MANAGED AREA#
SSTITM(MEML,P<TEND>,LOC(MEML)); # INITIALIZE MANAGER #
# CRACK CONTROL CARD #
CRACKER(CC$ERROR);
IF CC$ERROR # IF CONTROL CARD ERROR DETECTED #
THEN
BEGIN
MESSAGE(INVCCRD,0); # SEND DAYFILE MESSAGE #
ABORT; # **** ABORT RUN **** #
END
# OPEN FILES #
OUTLFN[0] = OUTFILE;
OUTFIRST[0] = LOC(OUTWB);
OUTIN[0] = LOC(OUTWB);
OUTOUT[0] = LOC(OUTWB);
OUTLIMIT[0] = LOC(OUTWB) + PRULNGTH + 1;
IF CRERUN
THEN
BEGIN
INLFN[0] = INFILE;
INFIRST[0] = LOC(INWB);
ININ[0] = LOC(INWB);
INOUT[0] = LOC(INWB);
INLIMIT[0] = LOC(INWB) + PRULNGTH + 1;
READ(INFET);
RECALL(INFET);
SECFIRST[0] = LOC(SECWB);
SECIN[0] = LOC(SECWB);
SECOUT[0] = LOC(SECWB);
SECLIMIT[0] = LOC(SECWB) + PRULNGTH + 1;
ESIFIRST[0] = LOC(ESIWB);
ESIIN[0] = LOC(ESIWB);
ESIOUT[0] = LOC(ESIWB);
ESILIMIT[0] = LOC(ESIWB) + PRULNGTH + 1;
STFIRST[0] = LOC(STWB);
STIN[0] = LOC(STWB);
STOUT[0] = LOC(STWB);
STLIMIT[0] = LOC(STWB) + PRULNGTH + 1;
E1FIRST[0] = LOC(E1WB);
E1IN[0] = LOC(E1WB);
E1OUT[0] = LOC(E1WB);
E1LIMIT[0] = LOC(E1WB) + PRULNGTH + 1;
E2FIRST[0] = LOC(E2WB);
E2IN[0] = LOC(E2WB);
E2OUT[0] = LOC(E2WB);
E2LIMIT[0] = LOC(E2WB) + PRULNGTH + 1;
# ALLOCATE TABLE SPACE FOR LABELS AND DEFINES #
SSTATS(P<DEFINE$TABLE>,MAXDT); # GET SPACE FOR DEFINE TABLE #
SSTATS(P<LABEL$TABLE>,MAXLT); # GET SPACE FOR LABEL TABLE #
SSTATS(P<STMT$TABLE>,MXSTBL); # GET SPACE FOR STMT TABLE #
SSTATS(P<TERM$BUFFER>,MXTBUFF);# GET SPACE FOR TERM STMT BUFFER#
END
RETURN;
END # NDLINIT #
TERM