*DECK LFGCRAK
USETEXT LFGFET,LFGFN
PROC LFGCRAK;
BEGIN
*IF DEF,IMS
#
** LFGCRAK - CRACK CONTROL CARD.
*
* M. E. VATCHER 81/02/19
* D. K. ENDO 81/12/22 (ADD -Z- AND -BC- PARAMETERS)
*
* LFGCRAK CRACKS THE LFG CONTROL CARD. ALL FILE NAMES ARE
* CHECKED TO MAKE SURE THEY ARE VALID.
*
* PROC LFGCRAK
*
* ENTRY NONE.
*
* EXIT NONE.
*
* METHOD
*
* FOR EACH WORD BEGINNING AT RA+2
* IF ITS AN "I" PARAMETER
* THEN
* CHECK FILE NAME
* SET FILE NAME IN INPUT FET
* ELSE IF ITS AN "L" PARAMETER
* THEN
* CHECK FILE NAME
* SET FILE NAME IN OUTPUT FET
* ELSE IF ITS AN "NLF" PARAMETER
* THEN
* CHECK FILE NAME
* SET FILE NAME IN NLF FET
* ELSE IF ITS A "Z" PARAMETER
* THEN
* CALL *Z* ARGUMENT PROCESSOR
* ELSE IF ITS A "BC" PARAMETER
* THEN
* CHECK DECIMAL NUMBER
* CONVERT TO INTEGER AND SAVE IT
* END
*
#
*ENDIF
#
**** PROC LFGCRAK - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # ABORTS JOB ON REQUEST #
ITEM INPUT; # INPUT DIRECTIVE FET #
PROC LFGZAP; # *Z* ARGUMENT PROCCESSOR #
PROC MESSAGE; # PUTS MESSAGE INTO DAYFILE #
ITEM OUTPUT U; # FWA OF LIST OUTPUT FET #
PROC READ; # FILLS CIO BUFFER #
PROC RECALL; # RETURNS CONTROL WHEN RECALL BIT IS SET #
ITEM WFET U; # FWA OF NLF FET #
END
#
****
#
DEF COMMA # 1 #; # JOB COMM. AREA CODE FOR , #
DEF EQUAL # 2 #; # JOB COMM. AREA CODE FOR = #
DEF MAX$BC # 64 #; # MAXIMUM BC VALUE ALLOWED #
DEF MIN$BC # 1 #; # MINIMUM BC VALUE ALLOWED #
DEF NO$LIST #O"33000000000000"#; # LEFT JUSTIFIED ZERO #
DEF PARTERM #O"17"#; # JOB COMM. AREA CODE FOR ) OR . #
DEF PLWC # O"64" #; # WORD WHERE PARAMTER LIST WORD COUNT IS #
DEF PRMLIST # 2 #; # WORD WHERE PARAMETER LIST STARTS #
CONTROL NOLIST; # LFGSTAN COMMON DECK #
*CALL LFGSTAN
CONTROL LIST;
ITEM DONEII B; # LOOP TERMINATION CONDITION #
ITEM DONEK B; # LOOP TERMINATION CONDITION #
ITEM II U; # LOOP INDEX #
ITEM J I; # POINTER TO WORD IN JOB COMM. AREA #
ITEM K U; # LOOP INDEX #
ITEM SUCCESS B; # SUCCESSFUL COMPLETION INDICATOR #
ITEM SWTCHVCTR I; # SWITCH VECTOR #
ITEM Z$USED B; # Z PARAMETER SPECIFIED FLAG #
BASED ARRAY PARAMS [1:1] S(1);
BEGIN
ITEM PARVAL C(0,0,7);
ITEM PARCODE U(0,56,4);
END
DEF MAXPT # 5 #; # MAXIMUM NUMBER OF PARAMETERS #
ARRAY PARAM$TABLE [01:MAXPT] S(1);
BEGIN
ITEM PT$NAME C(00,00,07) = [O"11000000000000",
O"14000000000000",
O"16140600000000",
O"32000000000000",
O"02030000000000"
];
ITEM PT$SWTCHV I(00,42,18) = [1,
2,
3,
4,
5
];
END
BASED ARRAY PARAM$WC [00:00] S(1);
BEGIN # PARAMETER LIST WORD COUNT #
ITEM PLIST$WC I(00,42,18);
END
ARRAY BC$RANGE [00:00] S(4);
BEGIN
ITEM BR$MSG C(00,00,30) = [" BC VALUE OUT OF RANGE(1-64)."];
ITEM BR$ZBYT I(03,00,60) = [0];
END
ARRAY NOVAL [0:0] S(3);
BEGIN
ITEM NOVAL1 C(0,0,28) =
[" NO VALUE FOR PARAMETER XXX."];
ITEM NOVAL2 C(2,24,3);
ITEM NOVALZ U(2,48,12) = [ 0 ];
END
ARRAY UNREC$DELIM [00:00] S(3);
BEGIN
ITEM UD$MSG C(00,00,24) = [" UNRECOGNIZED DELIMETER."];
ITEM UD$ZBYT I(02,24,36) = [0];
END
ARRAY NO$EQUAL [00:00] S(3);
BEGIN
ITEM NE$MSG C(00,00,25) = [" CANNOT ASSIGN VALUE TO Z."];
ITEM NE$ZBYT I(02,30,30) = [0];
END
ARRAY NOT$DEC [00:00] S(3);
BEGIN
ITEM ND$MSG C(00,00,28) = [" BC VALUE SHOULD BE DECIMAL."];
ITEM ND$ZBYT I(02,48,12) = [0];
END
ARRAY UNREC$PRM [0:0] S(3);
BEGIN
ITEM UNREC1 C(0,0,24) =
[" UNRECOGNIZED PARAMETER."];
ITEM UNRECZ U(2,24,36) = [ 0 ];
END
SWITCH GFNSWTCH UNK,
I$PRM,
L$PRM,
NLF$PRM,
Z$PRM,
BC$PRM;
CONTROL EJECT;
PROC LFGCDN(VALUE,NUMBER,STATIS);
BEGIN # CHECK DECIMAL NUMBER #
ITEM VALUE C(7); # VALUE TO BE CHECKED AND CONVERTED #
ITEM NUMBER I; # CONVERTED NUMBER #
ITEM STATIS B; # ERROR STATUS #
DEF NINE # O"44" #;
DEF ZERO # O"33" #; # DISPLAY CODE ZERO #
ITEM CTEMP C(1); # CHARACTER TEMPORARY #
ITEM EXPONENT I; # CURRENT EXPONENT VALUE #
ITEM I I; # SCRATCH ITEM #
# #
# LFGCDN CODE BEGINS HERE #
# #
STATIS = TRUE; # SET RETURN STATUS TO O.K. #
NUMBER = 0; # CLEAR NUMBER TEMPORARY #
EXPONENT = 0; # CLEAR EXPONENT #
FOR I=6 STEP -1 UNTIL 0
DO # FOR EACH CHARACTER OF VALUE(FROM RIGHT) #
BEGIN
CTEMP = C<I,1>VALUE; # MASK CHARACTER #
IF CTEMP NQ 0 # IF CHARACTER IS NOT BLANK #
THEN
BEGIN
IF CTEMP GQ ZERO AND
CTEMP LQ NINE # IF CHARACTER IS A DECIMAL NUM #
THEN
BEGIN
CTEMP = CTEMP - ZERO; # CALCULATE VALUE #
NUMBER = NUMBER + (CTEMP * 10**EXPONENT);
EXPONENT = EXPONENT + 1; # INCREMENT EXPONENT VALUE #
END
ELSE # CHARACTER IS NOT DECIMAL #
BEGIN
SUCCESS = FALSE; # SET ERROR STATUS #
END
END
END
RETURN; # **** RETURN ***** #
END
CONTROL EJECT;
PROC LFGCKFN(FNAME,SUCCESS);
BEGIN # CHECK FILE NAME #
ITEM CHAR C(1);
ITEM FNAME C(7); # FILE NAME CANDIDATE #
ITEM III U; # LOOP VARIABLE #
ITEM SUCCESS B;
ARRAY CNA [0:0] S(4);
BEGIN
ITEM CNA1 C(0,0,38) =
[" FILE NAME CHARACTER NOT ALPHANUMERIC."];
ITEM CNAZ U(3,48,12) = [ 0 ];
END
ARRAY ZFFN [0:0] S(3);
BEGIN
ITEM ZFFN1 C(0,0,23) =
[" ZERO FILLED FILE NAME."];
ITEM ZFFNZ U(2,18,42) = [ 0 ];
END
SUCCESS = TRUE;
FOR III = 0 STEP 1 UNTIL 6 DO
BEGIN # FOR EACH CHARACTER IN THE FILE NAME #
CHAR = C<III,1>FNAME;
IF III EQ 0 AND CHAR EQ 0
THEN # ZERO FILLED NAME #
BEGIN
MESSAGE(ZFFN,0);
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
IF CHAR EQ 0
THEN # END OF FILE NAME #
BEGIN
RETURN; # ***** EXIT ***** #
END
IF CHAR GR O"44"
THEN # IT IS NOT ALPHANUMERIC #
BEGIN
MESSAGE(CNA,0);
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
END # GET NEXT CHARACTER #
END # END OF ROUTINE #
CONTROL EJECT;
P<PARAMS> = PRMLIST; # PARAMETERS IN JOB COMMUNICATION AREA #
P<PARAM$WC> = PLWC; # POINT ARRAY TO WORD COUNT #
LISTFLG = TRUE; # SET LISTING REQUESTED FLAG #
SUCCESS = TRUE;
Z$USED = FALSE;
J = 0;
IF PLIST$WC[0] EQ 0 # IF NO PARAMETERS SPECIFIED #
THEN
BEGIN
DONEII = TRUE; # SET DONE FLAG #
END
ELSE # PARAMTERS SPECIFIED #
BEGIN
DONEII = FALSE; # CLEAR DONE FLAG #
END
FOR II=0 WHILE NOT DONEII AND SUCCESS
DO
BEGIN # FOR EACH WORD BEGINNING AT RA+2 #
J = J + 1;
IF J GR PLIST$WC[0] # IF REACHED END OF PARAMETER LIST #
THEN
BEGIN
DONEII = TRUE; # SET DONE FLAG #
END
IF NOT DONEII
THEN
BEGIN
SWTCHVCTR = 0; # SET SWITCH VECTOR TO UNKNOWN #
FOR K=0 STEP 1 UNTIL MAXPT
DO # FOR EACH ENTRY IN PARAMETER TABLE #
BEGIN
IF PT$NAME[K] EQ PARVAL[J]
THEN # IF PARAMTER IS IN TABLE #
BEGIN
SWTCHVCTR = PT$SWTCHV[K];# SAVE SWITCH VALUE #
END
END
GOTO GFNSWTCH[SWTCHVCTR]; # JUMP TO APPROPRIATE PARAGRAPH #
I$PRM: # I PARAMETER IS SPECIFIED #
IF PARCODE[J] NQ EQUAL
THEN # NO EQUALS SIGN #
BEGIN
NOVAL2[0] = " I";
MESSAGE(NOVAL,0);
SUCCESS = FALSE;
END
ELSE # AN EQUAL WAS SPECIFIED #
BEGIN
J = J + 1; # POINT TO FILE NAME #
LFGCKFN(PARVAL[J],SUCCESS);# CHECK FILE NAME #
P<SIOFET> = LOC(INPUT);
FETLFN[0] = PARVAL[J]; # PUT FILE NAME IN INPUT FET #
END
GOTO NEXT;
L$PRM: # L PARAMETER IS SPECIFIED #
IF PARCODE[J] NQ EQUAL
THEN # NO = SIGN AFTER L PARAMETER #
BEGIN
NOVAL2[0] = " L";
MESSAGE(NOVAL,0);
SUCCESS = FALSE;
END
ELSE # AN EQUAL WAS SPECIFIED #
BEGIN
J = J + 1;
IF PARVAL[J] EQ NO$LIST
THEN # IF NO OUTPUT LISTING REQUESTED #
BEGIN
LISTFLG = FALSE; # CLEAR LISTING FLAG #
END
ELSE # FILE NAME WAS SPECIFIED #
BEGIN
LFGCKFN(PARVAL[J],SUCCESS); # CHECK FILE NAME #
P<SIOFET> = LOC(OUTPUT);
FETLFN[0] = PARVAL[J];
END
END
GOTO NEXT;
NLF$PRM: # NLF PARAMETER IS SPECIFIED #
IF PARCODE[J] NQ EQUAL
THEN # NO = SIGN AFTER NLF #
BEGIN
NOVAL2[0] = "NLF";
MESSAGE(NOVAL,0);
SUCCESS = FALSE;
END
ELSE # AN EQUAL WAS SPECIFIED #
BEGIN
J = J + 1; # GO TO NEXT WORD IN JOB COMM. AREA #
LFGCKFN(PARVAL[J],SUCCESS); # CHECK FILE NAME #
P<SIOFET> = WFET;
FETLFN[0] = PARVAL[J];
END
GOTO NEXT;
Z$PRM: # Z PARAMETER IS SPECIFIED #
IF PARCODE[J] EQ COMMA OR # IF DELIMITER IS COMMA OR -)- #
PARCODE[J] EQ PARTERM
THEN
BEGIN
LFGZAP(INPUT); # CALL *Z* ARGUMENT PROCESSOR #
Z$USED = TRUE; # SET Z SPECIFIED FLAG #
END
ELSE # DELIMITER IS NOT VALID #
BEGIN
IF PARCODE EQ EQUAL # TRIED TO ASSIGN VALUE TO Z #
THEN
BEGIN
J = J + 1; # POINT TO NEXT WORD #
MESSAGE(NO$EQUAL,0);
SUCCESS = FALSE;
END
ELSE # CONNOT RECOGNIZE DELIMITER #
BEGIN
MESSAGE(UNREC$DELIM,0);
SUCCESS = FALSE;
END
END
GOTO NEXT;
BC$PRM: # BC PARAMETER IS SPECIFIED #
IF PARCODE[J] NQ EQUAL
THEN # NO EQUAL AFTER BC #
BEGIN
NOVAL2[0] = "BC";
MESSAGE(NOVAL,0);
SUCCESS = FALSE;
END
ELSE # AN EQUAL WAS SPECIFIED #
BEGIN
J = J + 1; # POINT TO NEXT WORD #
LFGCDN(PARVAL[J],BC$VAL,SUCCESS); # CHECK DECIMAL NUMBER #
IF NOT SUCCESS
THEN # IF NOT A DECIMAL NUMBER #
BEGIN
MESSAGE(NOT$DEC,0);
END
ELSE # NUMBER VALUE IS O.K. #
BEGIN
IF BC$VAL LS MIN$BC OR
BC$VAL GR MAX$BC # IF VALUE IS NOT IN RANGE #
THEN
BEGIN
MESSAGE(BC$RANGE,0);
SUCCESS = FALSE;
END
END
END
GOTO NEXT;
UNK: # UNKNOWN PARAMETER #
MESSAGE(UNREC$PRM,0); # SENT DAYFILE MESSAGE #
SUCCESS = FALSE; # CLEAR SUCCESS FLAG #
IF PARCODE[J] EQ EQUAL
THEN # IF VALUE ASSIGNED TO UNKNOWN PARAMETER #
BEGIN
J = J + 1; # SKIP THE VALUE #
END
NEXT:
IF PARCODE[J] NQ COMMA AND # IF DELIM IS NOT COMMA OR -)- #
PARCODE[J] NQ PARTERM
THEN
BEGIN
MESSAGE(UNREC$DELIM,0); # SEND DAYFILE MESSAGE #
SUCCESS = FALSE; # CLEAR SUCCESS FLAG #
END
END
END
IF NOT SUCCESS # IF ERRORS WERE DETECTED #
THEN
BEGIN
ABORT; # ABORT JOB #
END
IF NOT Z$USED # IF -Z- WAS NOT SPECIFED #
THEN
BEGIN
READ(INPUT); # FILL CIO BUFFER WITH INPUT DIRECTIVES #
RECALL(INPUT);
END
RETURN; # **** RETURN **** #
END TERM