./ ADD SSI=01012165,NAME=IPDAGH,SOURCE=0 AGH TITLE 'IPDAGH, FORTRAN IV LEVELS G AND H DEFINITION ' 00010019 EJECT 00020019 *********************************************************************** 00030019 * * 00040019 *SYNTAX IPDAGH * 00050019 * * 00060019 *********************************************************************** 00070019 IPDAGH CSECT 00080019 DC AL2(LIN00001-IPDAGH) POINT TO FIRST STMNT. DEF. 00090019 EJECT 00100019 *********************************************************************** 00110019 * * 00120019 *IPDAGH = *3 < 'DO' DO ³ M ASSIGNMENT ³ KEYWORD ³ N ASSIGNMENT > * 00130019 * * 00140019 * THIS LINE DETERMINES THE OVERALL STRATEGY * 00150019 * IN SCANNING STATEMENTS. ERROR MESSAGE * 00160019 * 3 IS ISSUED IF THE STATEMENT IS NONE OF * 00170019 * THE ALTERNATIVES, SINCE THIS IS THE FIRST * 00180019 * LINE OF THE SYNTAX AND IS THEREFORE AUTOMATIC- * 00190019 * ALLY COMMITTED. ERROR MESSAGE 3 IS * 00200019 * "UNRECOGNIZABLE STMNT OR MISSPELLED KEYWORD". * 00210019 * * 00220019 * AS THIS LINE INDICATES, EACH * 00230019 * STATEMENT IS FIRST EXAMINED TO SEE WHETHER * 00240019 * IT IS A DO STATEMENT. IF IT IS NOT, * 00250019 * IT IS EXAMINED TO SEE WHETHER IT IS AN * 00260019 * ASSIGNMENT STATEMENT, THEN A KEYWORD * 00270019 * STATEMENT, AND FINALLY, IF IT IS NONE * 00280019 * OF THESE, ASSIGNMENT STATEMENT IS ATTEMPTED * 00290019 * ONCE MORE USING A SLIGHTLY DIFFERENT * 00300019 * SYNTAX WHICH ALLOWS THE ASSIGNMENT * 00310019 * STATEMENT TO BEGIN WITH A NAME THAT * 00320019 * IS LONGER THAN SIX CHARACTERS. * 00330019 * IF THE N ASSIGNMENT FORM IS TRIED, THE N * 00340019 * OPERATOR WILL ISSUE A "NAME TOO LONG" MESSAGE * 00350019 * FOR INITIAL NAMES OF MORE THAN SIX CHARACTERS * 00360019 * EVEN THOUGH ASSIGNMENT MAY NEVER BECOME COMMITTED. * 00370019 * * 00380019 *********************************************************************** 00390019 LIN00001 EQU * START OF DEFINITION 00400019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 00410019 DC AL1(COD003) ERROR CODE 00420019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 00430019 DC AL1(ALT00001-LIN00001) FALSE DISP. 00440019 DC AL1(BRC00001-LIN00001) TRUE DISP. 00450019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 00460019 DC AL1(002) LENGTH OF LITERAL 00470019 DC C'DO' 00480019 DC AL1(DEFSYMBL) NEST OPERATOR 00490019 DC AL2(LIN00002-IPDAGH) DO 00500019 ALT00001 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 00510019 DC AL1(ALT00002-LIN00001) FALSE DISP. 00520019 DC AL1(DEFMNAME) M NAME OPERATOR M 00530019 DC AL1(DEFSYMBL) NEST OPERATOR 00540019 DC AL2(LIN00003-IPDAGH) ASSIGNMENT 00550019 ALT00002 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 00560019 DC AL1(ALT00003-LIN00001) FALSE DISP. 00570019 DC AL1(DEFSYMBL) NEST OPERATOR 00580019 DC AL2(LIN00004-IPDAGH) KEYWORD 00590019 ALT00003 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 00600019 DC AL1(ALT00004-LIN00001) FALSE DISP. 00610019 DC AL1(DEFNAME) NAME OPERATOR N 00620019 DC AL1(DEFSYMBL) NEST OPERATOR 00630019 DC AL2(LIN00003-IPDAGH) ASSIGNMENT 00640019 ALT00004 EQU * 00650019 BRC00001 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 00660019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 00670019 EJECT 00680019 *********************************************************************** 00690019 * * 00700019 *DO = ( '0' ... ) D ( D .4. ) * 00710019 * ( ',' : *140 $801 *33 ) N *143 '=' *5 * 00720019 * < N ³ USNZINT > *53 ',' : < N ³ / USNZINT > * 00730019 * ( ',' < N ³ / USNZINT > ) * 00740019 * * 00750019 * DEFINES THE SYNTAX OF A DO STATEMENT. * 00760019 * THE N-OPERATOR IS USED HERE INSTEAD OF * 00770019 * THE M-OPERATOR EVEN THOUGH N WILL REQUIRE * 00780019 * AT LEAST ONE VALID NAME BEFORE THE STATEMENT IS * 00790019 * COMMITTED TO BEING A DO STATEMENT. THIS * 00800019 * IS PERMISSIBLE BECAUSE THE INITIAL DIGITS REQUIRED * 00810019 * BY THIS DEFINITION RULE OUT THE POSSIBILITY THAT * 00820019 * A KEYWORD STATEMENT WILL SATISFY THIS DEFINITION. * 00830019 * EACH PARAMETER OF THE DO IS A NAME OR AN * 00840019 * UNSIGNED, NON-ZERO INTEGER. * 00850019 * * 00860019 * THIS DEFINITION WILL ALMOST ALWAYS FAIL * 00870019 * AT THE INITIAL DIGITS, FOR STATEMENTS THAT * 00880019 * ARE NOT DO STATEMENTS. HOWEVER, UNTIL * 00890019 * THE FIRST COMMA IN THE PARAMETER LIST IS * 00900019 * FOUND, IT COULD BE AN ASSIGNMENT STATEMENT * 00910019 * SUCH AS "DO3I=N**2". THEREFORE * 00920019 * THE STATEMENT CANNOT BE COMMITTED TO BEING * 00930019 * A DO STATEMENT UNTIL THE COMMA IS * 00940019 * ENCOUNTERED. * 00950019 * * 00960019 * SHOULD THERE BE A COMMA AFTER THE STATEMENT NUMBER, * 00970019 * ACTION CODE 801 CAUSES MESSAGE 140 TO BE ISSUED, * 00980019 * AND THE STATEMENT IS COMMITTED TO THIS LINE. * 00990019 * * 01000019 *********************************************************************** 01010019 LIN00002 EQU * START OF DEFINITION 01020019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 01030019 DC AL1(PAR00001-LIN00002) POINT TO END OF OPT. ITEMS 01040019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01050019 DC AL1(001) LENGTH OF LITERAL 01060019 DC C'0' 01070019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 01080019 PAR00001 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 01090019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 01100019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 01110019 DC AL1(PAR00002-LIN00002) POINT TO END OF OPT. ITEMS 01120019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 01130019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 01140019 DC AL1(004) ITERATION COUNT 01150019 PAR00002 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 01160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 01170019 DC AL1(PAR00003-LIN00002) POINT TO END OF OPT. ITEMS 01180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01190019 DC AL1(001) LENGTH OF LITERAL 01200019 DC C',' 01210019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 01220019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01230019 DC AL1(COD140) ERROR CODE 01240019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 01250019 DC AL1(ACT801) ACTION CODE 01260019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01270019 DC AL1(COD033) ERROR CODE 01280019 PAR00003 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 01290019 DC AL1(DEFNAME) NAME OPERATOR N 01300019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01310019 DC AL1(COD143) ERROR CODE 01320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01330019 DC AL1(001) LENGTH OF LITERAL 01340019 DC C'=' 01350019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01360019 DC AL1(COD005) ERROR CODE 01370019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 01380019 DC AL1(ALT00005-LIN00002) FALSE DISP. 01390019 DC AL1(BRC00002-LIN00002) TRUE DISP. 01400019 DC AL1(DEFNAME) NAME OPERATOR N 01410019 ALT00005 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 01420019 DC AL1(ALT00006-LIN00002) FALSE DISP. 01430019 DC AL1(DEFSYMBL) NEST OPERATOR 01440019 DC AL2(LIN00005-IPDAGH) USNZINT 01450019 ALT00006 EQU * 01460019 BRC00002 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 01470019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01480019 DC AL1(COD053) ERROR CODE 01490019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01500019 DC AL1(001) LENGTH OF LITERAL 01510019 DC C',' 01520019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 01530019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 01540019 DC AL1(ALT00007-LIN00002) FALSE DISP. 01550019 DC AL1(BRC00003-LIN00002) TRUE DISP. 01560019 DC AL1(DEFNAME) NAME OPERATOR N 01570019 ALT00007 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 01580019 DC AL1(ALT00008-LIN00002) FALSE DISP. 01590019 DC AL1(DEFCOMIT) LOCAL COMMIT / 01600019 DC AL1(DEFSYMBL) NEST OPERATOR 01610019 DC AL2(LIN00005-IPDAGH) USNZINT 01620019 ALT00008 EQU * 01630019 BRC00003 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 01640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 01650019 DC AL1(PAR00004-LIN00002) POINT TO END OF OPT. ITEMS 01660019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01670019 DC AL1(001) LENGTH OF LITERAL 01680019 DC C',' 01690019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 01700019 DC AL1(ALT00009-LIN00002) FALSE DISP. 01710019 DC AL1(BRC00004-LIN00002) TRUE DISP. 01720019 DC AL1(DEFNAME) NAME OPERATOR N 01730019 ALT00009 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 01740019 DC AL1(ALT00010-LIN00002) FALSE DISP. 01750019 DC AL1(DEFCOMIT) LOCAL COMMIT / 01760019 DC AL1(DEFSYMBL) NEST OPERATOR 01770019 DC AL2(LIN00005-IPDAGH) USNZINT 01780019 ALT00010 EQU * 01790019 BRC00004 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 01800019 PAR00004 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 01810019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 01820019 EJECT 01830019 *********************************************************************** 01840019 * * 01850019 *USNZINT = *4 ª'+' ª'-' K $100 * 01860019 * * 01870019 * DEFINES UNSIGNED, NONZERO INTEGER. ACTION CODE * 01880019 * 100 AFTER THE K OPERATOR CHECKS TO SEE THAT * 01890019 * THE NUMERIC CONSTANT FOUND BY THE K OPERATOR * 01900019 * WAS A NON-ZERO INTEGER. * 01910019 * * 01920019 *********************************************************************** 01930019 LIN00005 EQU * START OF DEFINITION 01940019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01950019 DC AL1(COD004) ERROR CODE 01960019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 01970019 DC AL1(001) LENGTH OF LITERAL 01980019 DC C'+' 01990019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 02000019 DC AL1(001) LENGTH OF LITERAL 02010019 DC C'-' 02020019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 02030019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 02040019 DC AL1(ACT100) ACTION CODE 02050019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 02060019 EJECT 02070019 *********************************************************************** 02080019 * * 02090019 *ASSIGNMENT = < '=' : ³ '(' &= < N ( ',' N ... ) ')=' : $200 ³ * 02100019 * ARITHEXP2 ( ',' ARITHEXP2 ... ) ')=' : $202 > > * 02110019 * *7 < ARITHEXP ³ LOGICEXP > * 02120019 * * 02130019 * DEFINES TWO CLASSES OF STATEMENTS * 02140019 * * 02150019 * A. ARITHMETIC AND LOGICAL ASSIGNMENT STATEMENTS * 02160019 * * 02170019 * B. ARITHMETIC AND LOGICAL STATEMENT FUNCTION DEFINITIONS * 02180019 * * 02190019 * A VALID SYMBOLIC NAME HAS BEEN FOUND BEFORE * 02200019 * THIS LINE IS INVOKED, SO THE SYNTAX OF THE * 02210019 * PART OF THE ASSIGNMENT BEFORE THE EQUALS * 02220019 * SIGN IS ONE OF: * 02230019 * * 02240019 * 1. A NAME * 02250019 * * 02260019 * 2. A NAME FOLLOWED BY A PARENTHESIZED LIST OF NAMES * 02270019 * * 02280019 * 3. A NAME FOLLOWED BY A PARENTHESIZED LIST OF * 02290019 * EXPRESSIONS, AT LEAST ONE OF WHICH IS NOT * 02300019 * SIMPLY A NAME * 02310019 * * 02320019 * IN CASES 1 AND 3, THE STATEMENT IS IN * 02330019 * CLASS A, SINCE CLASS B STATEMENTS MUST * 02340019 * HAVE AT LEAST ONE NAME IN PARENTHESES * 02350019 * BEFORE THE EQUALS SIGN, AND NO EXPRESSION * 02360019 * EXCEPT A NAME IS PERMITTED IN THE PARENTHESES * 02370019 * IN CLASS B STATEMENTS. THEREFORE, IN * 02380019 * CASE 3, ACTION CODE 202 IS USED TO CHECK * 02390019 * FOR MORE THAN SEVEN SUBSCRIPTS. ACTION * 02400019 * CODE 202 ISSUES A "TOO MANY SUBSCRIPTS PRECEDE" * 02410019 * MESSAGE IF THERE WERE MORE THAN SEVEN * 02420019 * EXPRESSIONS. * 02430019 * * 02440019 * IN CASE 2, THE STATEMENT COULD BE IN * 02450019 * EITHER CLASS A OR CLASS B, AND SO, IF * 02460019 * MORE THAN SEVEN NAMES ARE PRESENT, * 02470019 * A "POSSIBLY TOO MANY SUBSCRIPTS PRECEDE" MESSAGE * 02480019 * IS ISSUED BY ACTION CODE 200. * 02490019 * * 02500019 * IF THE STATEMENT IS NOT CASE 1, IT * 02510019 * IS SCANNED TO SEE WHETHER IT CONTAINS * 02520019 * AN EQUALS SIGN SOMEWHERE TO THE RIGHT * 02530019 * OF THE INITIAL NAME. ASSIGNMENT * 02540019 * FAILS IF AN EQUAL SIGN IS NOT FOUND. * 02550019 * UNLESS A HOLLERITH FIELD CONTAINS THE * 02560019 * EQUAL SIGN THAT SATISFIES THE SCANNING * 02570019 * OPERATION, THIS TEST AVOIDS ANALYSIS * 02580019 * OF A PARENTHESIZED FORM ( IN SUCH * 02590019 * STATEMENTS AS FORMAT AND IF ) BY THE * 02600019 * ASSIGNMENT SYNTACTIC LINE, WHEN THERE IS * 02610019 * NO POSSIBITITY THAT THE STATEMENT IS AN ASSIGNMENT. * 02620019 * WHEN AN EQUALS SIGN IS FOUND IN THE * 02630019 * PROPER PLACE, THE STATEMENT IS COMMITTED. * 02640019 * * 02650019 * THE SYNTAX TO THE RIGHT OF THE EQUALS * 02660019 * IS THE SAME FOR CLASSES A AND B, EVEN * 02670019 * THOUGH CLASS B DOES NOT ALLOW REFERENCES * 02680019 * TO SUBSCRIPTED VARIABLES IN THE EXPRESSION. * 02690019 * THIS IS BECAUSE THE SYNTAX CHECKER DOES NOT * 02700019 * HAVE THE INFORMATION THAT WOULD ENABLE IT TO * 02710019 * DETERMINE THAT A NAME FOLLOWED BY A * 02720019 * PARENTHESIZED LIST OF EXPRESSIONS * 02730019 * WAS AN ARRAY ELEMENT REFERENCE AND * 02740019 * NOT A FUNCTION REFERENCE. THE * 02750019 * SYNTAX CHECKER WOULD HAVE TO SAVE * 02760019 * INFORMATION FROM DIMENSION AND OTHER * 02770019 * ARRAY-DECLARING STATEMENTS TO MAKE * 02780019 * THE DISTINCTION, AND THE SYNTAX CHECKER * 02790019 * DOES NOT SAVE SUCH INFORMATION. * 02800019 * * 02810019 *********************************************************************** 02820019 LIN00003 EQU * START OF DEFINITION 02830019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 02840019 DC AL1(ALT00011-LIN00003) FALSE DISP. 02850019 DC AL1(BRC00005-LIN00003) TRUE DISP. 02860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 02870019 DC AL1(001) LENGTH OF LITERAL 02880019 DC C'=' 02890019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 02900019 ALT00011 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 02910019 DC AL1(ALT00012-LIN00003) FALSE DISP. 02920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 02930019 DC AL1(001) LENGTH OF LITERAL 02940019 DC C'(' 02950019 DC AL1(DEFSCAN) SEARCH OPERATOR & 02960019 DC C'=' 02970019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 02980019 DC AL1(ALT00013-LIN00003) FALSE DISP. 02990019 DC AL1(BRC00006-LIN00003) TRUE DISP. 03000019 DC AL1(DEFNAME) NAME OPERATOR N 03010019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 03020019 DC AL1(PAR00005-LIN00003) POINT TO END OF OPT. ITEMS 03030019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03040019 DC AL1(001) LENGTH OF LITERAL 03050019 DC C',' 03060019 DC AL1(DEFNAME) NAME OPERATOR N 03070019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 03080019 PAR00005 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 03090019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03100019 DC AL1(002) LENGTH OF LITERAL 03110019 DC C')=' 03120019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 03130019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 03140019 DC AL1(ACT200) ACTION CODE 03150019 ALT00013 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 03160019 DC AL1(ALT00014-LIN00003) FALSE DISP. 03170019 DC AL1(DEFSYMBL) NEST OPERATOR 03180019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 03190019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 03200019 DC AL1(PAR00006-LIN00003) POINT TO END OF OPT. ITEMS 03210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03220019 DC AL1(001) LENGTH OF LITERAL 03230019 DC C',' 03240019 DC AL1(DEFSYMBL) NEST OPERATOR 03250019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 03260019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 03270019 PAR00006 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 03280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03290019 DC AL1(002) LENGTH OF LITERAL 03300019 DC C')=' 03310019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 03320019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 03330019 DC AL1(ACT202) ACTION CODE 03340019 ALT00014 EQU * 03350019 BRC00006 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 03360019 ALT00012 EQU * 03370019 BRC00005 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 03380019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 03390019 DC AL1(COD007) ERROR CODE 03400019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 03410019 DC AL1(ALT00015-LIN00003) FALSE DISP. 03420019 DC AL1(BRC00007-LIN00003) TRUE DISP. 03430019 DC AL1(DEFSYMBL) NEST OPERATOR 03440019 DC AL2(LIN00007-IPDAGH) ARITHEXP 03450019 ALT00015 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 03460019 DC AL1(ALT00016-LIN00003) FALSE DISP. 03470019 DC AL1(DEFSYMBL) NEST OPERATOR 03480019 DC AL2(LIN00008-IPDAGH) LOGICEXP 03490019 ALT00016 EQU * 03500019 BRC00007 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 03510019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 03520019 EJECT 03530019 *********************************************************************** 03540019 * * 03550019 *ARITHEXP2 = ( < '+' ³ '-' > ) OPERANDA2 *55 * 03560019 * ( +ARITHOP / OPERANDA2 ... ) ª'.' * 03570019 * * 03580019 * THIS STATEMENT DEFINES ARITHMETIC EXPRESSIONS * 03590019 * OF TYPE REAL OR INTEGER, BUT NOT COMPLEX. * 03600019 * ANY ARITHMETIC EXPRESSION WHICH DOES NOT * 03610019 * CONTAIN A COMPLEX, LOGICAL, OR LITERAL * 03620019 * CONSTANT (EXCEPT AS AN ARGUMENT OF A * 03630019 * FUNCTION REFERENCE) WILL SATISFY THIS * 03640019 * DEFINITION. THE SYNTAX CHECKER ASSUMES * 03650019 * THAT ANY SYMBOLIC NAME IS OF THE CORRECT * 03660019 * TYPE, SINCE IT HAS NO WAY OF CHECKING * 03670019 * THE TYPE OF A SYMBOLIC NAME. ARITHEXP2 * 03680019 * IS USED WHERE AN EXPRESSION CANNOT BE COMPLEX * 03690019 * AS IN SUBSCRIPTS OR IN ARITHMETIC IF STATEMENTS. * 03700019 * * 03710019 *********************************************************************** 03720019 LIN00006 EQU * START OF DEFINITION 03730019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 03740019 DC AL1(PAR00007-LIN00006) POINT TO END OF OPT. ITEMS 03750019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 03760019 DC AL1(ALT00017-LIN00006) FALSE DISP. 03770019 DC AL1(BRC00008-LIN00006) TRUE DISP. 03780019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03790019 DC AL1(001) LENGTH OF LITERAL 03800019 DC C'+' 03810019 ALT00017 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 03820019 DC AL1(ALT00018-LIN00006) FALSE DISP. 03830019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 03840019 DC AL1(001) LENGTH OF LITERAL 03850019 DC C'-' 03860019 ALT00018 EQU * 03870019 BRC00008 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 03880019 PAR00007 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 03890019 DC AL1(DEFSYMBL) NEST OPERATOR 03900019 DC AL2(LIN00009-IPDAGH) OPERANDA2 03910019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 03920019 DC AL1(COD055) ERROR CODE 03930019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 03940019 DC AL1(PAR00008-LIN00006) POINT TO END OF OPT. ITEMS 03950019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 03960019 DC AL2(LIN00010-IPDAGH) ARITHOP 03970019 DC AL1(DEFCOMIT) LOCAL COMMIT / 03980019 DC AL1(DEFSYMBL) NEST OPERATOR 03990019 DC AL2(LIN00009-IPDAGH) OPERANDA2 04000019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 04010019 PAR00008 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 04020019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 04030019 DC AL1(001) LENGTH OF LITERAL 04040019 DC C'.' 04050019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 04060019 EJECT 04070019 *********************************************************************** 04080019 * * 04090019 *OPERANDA2 = < K ³ N ( '(' / *7 FUNCACTARG ( * 04100019 * ',' / FUNCACTARG ... ) $200 *12 ')' ) * 04110019 * ³ '(' ARITHEXP2 / *12 ')' > * 04120019 * * 04130019 * DEFINES NON-COMPLEX OPERANDS FOR ARITHEXP2. * 04140019 * THE OPTIONAL PARENTHESIZED LIST AFTER A NAME * 04150019 * MAY BE A LIST OF SUBSCRIPTS OR A LIST OF * 04160019 * FUNCTION ACTUAL ARGUMENTS. HOWEVER, SINCE * 04170019 * THE SYNTAX CHECKER CANNOT DISTINGUISH * 04180019 * BETWEEN ARRAY ELEMENT REFERENCES AND FUNCTION * 04190019 * REFERENCES, THE LIST IS TREATED AS A * 04200019 * LIST OF FUNCTION ACTUAL ARGUMENTS. THE * 04210019 * PERMISSIBLE FORMS FOR SUBSCRIPTS ARE * 04220019 * A SUBSET OF THOSE FOR FUNCTION ACTUAL * 04230019 * ARGUMENTS, SO THE SYNTAX CHECKER EXCLUDES * 04240019 * NO PERMISSIBLE FORMS. * 04250019 * * 04260019 * THE FORM "ARITHMETIC EXPRESSION IN PARENTHESES" * 04270019 * CANNOT BE COMMITTED UNTIL AFTER THE ARITHMETIC * 04280019 * EXPRESSION IS FOUND. THIS IS BECAUSE * 04290019 * THERE ARE CASES IN WHICH IT WOULD NOT * 04300019 * BE AN ERROR IF THE EXPRESSION IN THE PARENTHESES * 04310019 * IS A LOGICAL EXPRESSION. THIS POSSIBILITY * 04320019 * ARISES IN ANY PLACE WHERE EITHER AN * 04330019 * ARITHMETIC EXPRESSION OR A LOGICAL EXPRESSION * 04340019 * IS PERMITTED, FOR EXAMPLE, IN ACTUAL * 04350019 * ARGUMENT LISTS AND IN IF STATEMENTS. IN * 04360019 * ALL THESE CASES, THE SOURCE STATEMENT IS * 04370019 * CHECKED FOR THE ARITHMETIC FORM FIRST, * 04380019 * THEN THE LOGICAL, SINCE ARITHMETIC * 04390019 * EXPRESSIONS ARE MORE COMMON THAN LOGICAL * 04400019 * EXPRESSIONS. IF, FOR EXAMPLE, AN EXPRESSION * 04410019 * IN ONE OF THESE PLACES WERE OF THE FORM * 04420019 * * 04430019 * (A.GT.B) * 04440019 * * 04450019 * WHICH IS A VALID FORM, A COMMIT BEFORE ARITHEXP2 * 04460019 * ON THE THIRD LINE WOULD CAUSE A SPURIOUS * 04470019 * ERROR MESSAGE TO BE ISSUED. * 04480019 * * 04490019 *********************************************************************** 04500019 LIN00009 EQU * START OF DEFINITION 04510019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 04520019 DC AL1(ALT00019-LIN00009) FALSE DISP. 04530019 DC AL1(BRC00009-LIN00009) TRUE DISP. 04540019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 04550019 ALT00019 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 04560019 DC AL1(ALT00020-LIN00009) FALSE DISP. 04570019 DC AL1(DEFNAME) NAME OPERATOR N 04580019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 04590019 DC AL1(PAR00009-LIN00009) POINT TO END OF OPT. ITEMS 04600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04610019 DC AL1(001) LENGTH OF LITERAL 04620019 DC C'(' 04630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 04640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 04650019 DC AL1(COD007) ERROR CODE 04660019 DC AL1(DEFSYMBL) NEST OPERATOR 04670019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 04680019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 04690019 DC AL1(PAR00010-LIN00009) POINT TO END OF OPT. ITEMS 04700019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04710019 DC AL1(001) LENGTH OF LITERAL 04720019 DC C',' 04730019 DC AL1(DEFCOMIT) LOCAL COMMIT / 04740019 DC AL1(DEFSYMBL) NEST OPERATOR 04750019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 04760019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 04770019 PAR00010 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 04780019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 04790019 DC AL1(ACT200) ACTION CODE 04800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 04810019 DC AL1(COD012) ERROR CODE 04820019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04830019 DC AL1(001) LENGTH OF LITERAL 04840019 DC C')' 04850019 PAR00009 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 04860019 ALT00020 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 04870019 DC AL1(ALT00021-LIN00009) FALSE DISP. 04880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04890019 DC AL1(001) LENGTH OF LITERAL 04900019 DC C'(' 04910019 DC AL1(DEFSYMBL) NEST OPERATOR 04920019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 04930019 DC AL1(DEFCOMIT) LOCAL COMMIT / 04940019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 04950019 DC AL1(COD012) ERROR CODE 04960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04970019 DC AL1(001) LENGTH OF LITERAL 04980019 DC C')' 04990019 ALT00021 EQU * 05000019 BRC00009 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 05010019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 05020019 EJECT 05030019 *********************************************************************** 05040019 * * 05050019 *ARITHOP = " '+' 0 '-' 0 '/' 0 '**' 0 '*' 0 " * 05060019 * * 05070019 * TABLE OF THE ARITHMETIC OPERATORS. THE * 05080019 * DOUBLE ASTERISK MUST PRECEDE THE SINGLE * 05090019 * ASTERISK SO THAT A SPURIOUS MATCH ON * 05100019 * "SINGLE ASTERISK" WILL NOT OCCUR WHEN THE * 05110019 * SOURCE STATEMENT CONTAINS A DOUBLE * 05120019 * ASTERISK. * 05130019 * * 05140019 *********************************************************************** 05150019 LIN00010 EQU * START OF DEFINITION 05160019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 05170019 DC AL2(TAB00001-*+1) LENGTH OF TABLE 05180019 DC AL1(001) LENGTH OF LITERAL 05190019 DC C'+' 05200019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 05210019 DC X'FF' NULL ACTION CODE 05220019 DC C'T' TABLE FUNCTION PAD CHARACTER 05230019 DC AL1(001) LENGTH OF LITERAL 05240019 DC C'-' 05250019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 05260019 DC X'FF' NULL ACTION CODE 05270019 DC C'T' TABLE FUNCTION PAD CHARACTER 05280019 DC AL1(001) LENGTH OF LITERAL 05290019 DC C'/' 05300019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 05310019 DC X'FF' NULL ACTION CODE 05320019 DC C'T' TABLE FUNCTION PAD CHARACTER 05330019 DC AL1(002) LENGTH OF LITERAL 05340019 DC C'**' 05350019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 05360019 DC X'FF' NULL ACTION CODE 05370019 DC C'T' TABLE FUNCTION PAD CHARACTER 05380019 DC AL1(001) LENGTH OF LITERAL 05390019 DC C'*' 05400019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 05410019 DC X'FF' NULL ACTION CODE 05420019 DC C'T' TABLE FUNCTION PAD CHARACTER 05430019 TAB00001 DC AL1(002) LENGTH OF LONGEST TABLE ARG 05440019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 05450019 EJECT 05460019 *********************************************************************** 05470019 * * 05480019 *FUNCACTARG = < ARITHEXP ³ LOGICEXP ³ C ³ H > * 05490019 * * 05500019 * DEFINITION OF THE FORMS THAT MAY APPEAR * 05510019 * AS ACTUAL ARGUMENTS IN A FUNCTION * 05520019 * REFERENCE. THESE ARE VALID FORMS FOR * 05530019 * FUNCTION ACTUAL ARGUMENTS REGARDLESS OF * 05540019 * THE TYPE OF THE EXPRESSION IN WHICH THE * 05550019 * FUNCTION REFERENCE OCCURS. * 05560019 * * 05570019 *********************************************************************** 05580019 LIN00011 EQU * START OF DEFINITION 05590019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 05600019 DC AL1(ALT00022-LIN00011) FALSE DISP. 05610019 DC AL1(BRC00010-LIN00011) TRUE DISP. 05620019 DC AL1(DEFSYMBL) NEST OPERATOR 05630019 DC AL2(LIN00007-IPDAGH) ARITHEXP 05640019 ALT00022 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 05650019 DC AL1(ALT00023-LIN00011) FALSE DISP. 05660019 DC AL1(DEFSYMBL) NEST OPERATOR 05670019 DC AL2(LIN00008-IPDAGH) LOGICEXP 05680019 ALT00023 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 05690019 DC AL1(ALT00024-LIN00011) FALSE DISP. 05700019 DC AL1(DEFCSTRG) CHARACTER STRING C 05710019 ALT00024 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 05720019 DC AL1(ALT00025-LIN00011) FALSE DISP. 05730019 DC AL1(DEFHOLLR) HOLLERITH OPERATOR H 05740019 ALT00025 EQU * 05750019 BRC00010 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 05760019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 05770019 EJECT 05780019 *********************************************************************** 05790019 * * 05800019 *ARITHEXP = ( < '+' ³ '-' > ) *55 OPERANDA ( < * 05810019 * '**' / OPERANDA2 ³ +ARITHOP / OPERANDA * 05820019 * > ... ) ª'.' * 05830019 * * 05840019 * DEFINES THE MOST GENERAL FORM OF ARITHMETIC * 05850019 * EXPRESSION. THE OPERANDS WHICH ARE * 05860019 * CONSTANTS MAY BE OF ANY NUMERIC TYPE, * 05870019 * EXCEPT THAT OPERANDS WHICH FOLLOW THE * 05880019 * EXPONENTIATION OPERATOR MUST * 05890019 * BE OF TYPE REAL OR INTEGER. SINCE * 05900019 * THIS DEFINITION EXPLICITLY CHECKS FOR THE * 05910019 * EXPONENTIATION OPERATOR BEFORE USING THE * 05920019 * ARITHOP TABLE, A MATCH TO THE * 05930019 * EXPONENTIATION OPERATOR IN THE TABLE WILL * 05940019 * NOT OCCUR. * 05950019 * * 05960019 * IF A PERIOD OCCURS AFTER AN ARITHMETIC * 05970019 * EXPRESSION, THE EXPRESSION WAS PROBABLY * 05980019 * THE FIRST PART OF A LOGICAL EXPRESSION. * 05990019 * THE ª'.' AT THE END OF THIS DEFINITION * 06000019 * CAUSES IT TO FAIL IN SUCH CASES. * 06010019 * * 06020019 *********************************************************************** 06030019 LIN00007 EQU * START OF DEFINITION 06040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 06050019 DC AL1(PAR00011-LIN00007) POINT TO END OF OPT. ITEMS 06060019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 06070019 DC AL1(ALT00026-LIN00007) FALSE DISP. 06080019 DC AL1(BRC00011-LIN00007) TRUE DISP. 06090019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06100019 DC AL1(001) LENGTH OF LITERAL 06110019 DC C'+' 06120019 ALT00026 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 06130019 DC AL1(ALT00027-LIN00007) FALSE DISP. 06140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06150019 DC AL1(001) LENGTH OF LITERAL 06160019 DC C'-' 06170019 ALT00027 EQU * 06180019 BRC00011 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 06190019 PAR00011 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 06200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 06210019 DC AL1(COD055) ERROR CODE 06220019 DC AL1(DEFSYMBL) NEST OPERATOR 06230019 DC AL2(LIN00012-IPDAGH) OPERANDA 06240019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 06250019 DC AL1(PAR00012-LIN00007) POINT TO END OF OPT. ITEMS 06260019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 06270019 DC AL1(ALT00028-LIN00007) FALSE DISP. 06280019 DC AL1(BRC00012-LIN00007) TRUE DISP. 06290019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06300019 DC AL1(002) LENGTH OF LITERAL 06310019 DC C'**' 06320019 DC AL1(DEFCOMIT) LOCAL COMMIT / 06330019 DC AL1(DEFSYMBL) NEST OPERATOR 06340019 DC AL2(LIN00009-IPDAGH) OPERANDA2 06350019 ALT00028 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 06360019 DC AL1(ALT00029-LIN00007) FALSE DISP. 06370019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 06380019 DC AL2(LIN00010-IPDAGH) ARITHOP 06390019 DC AL1(DEFCOMIT) LOCAL COMMIT / 06400019 DC AL1(DEFSYMBL) NEST OPERATOR 06410019 DC AL2(LIN00012-IPDAGH) OPERANDA 06420019 ALT00029 EQU * 06430019 BRC00012 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 06440019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 06450019 PAR00012 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 06460019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 06470019 DC AL1(001) LENGTH OF LITERAL 06480019 DC C'.' 06490019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 06500019 EJECT 06510019 *********************************************************************** 06520019 * * 06530019 *OPERANDA = < K ³ N ( '(' / *7 FUNCACTARG ( * 06540019 * ',' / FUNCACTARG ... ) $200 *12 ')' ) ³ * 06550019 * '(' ( < '+' ³ '-' > ) K $103 ',' / * 06560019 * ( < '+' ³ '-' > ) K $104 *12 ')' ³ * 06570019 * '(' ARITHEXP / *12 ')' > * 06580019 * * 06590019 * DEFINES OPERANDS OF ANY NUMERIC TYPE * 06600019 * INCLUDING COMPLEX. ACTION CODES 103 * 06610019 * AND 104 ARE USED TO CHECK THAT THE * 06620019 * TWO NUMERIC CONSTANTS WHICH FORM A * 06630019 * COMPLEX CONSTANT AGREE IN LENGTH. THE * 06640019 * FORM "ARITHMETIC EXPRESSION IN PARENTHESES" * 06650019 * CANNOT BE COMMITTED UNTIL AFTER THE ARITHMETIC * 06660019 * EXPRESSION IS FOUND, FOR THE REASON GIVEN IN * 06670019 * THE DISCUSSION OF OPERANDA2. * 06680019 * * 06690019 *********************************************************************** 06700019 LIN00012 EQU * START OF DEFINITION 06710019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 06720019 DC AL1(ALT00030-LIN00012) FALSE DISP. 06730019 DC AL1(BRC00013-LIN00012) TRUE DISP. 06740019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 06750019 ALT00030 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 06760019 DC AL1(ALT00031-LIN00012) FALSE DISP. 06770019 DC AL1(DEFNAME) NAME OPERATOR N 06780019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 06790019 DC AL1(PAR00013-LIN00012) POINT TO END OF OPT. ITEMS 06800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06810019 DC AL1(001) LENGTH OF LITERAL 06820019 DC C'(' 06830019 DC AL1(DEFCOMIT) LOCAL COMMIT / 06840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 06850019 DC AL1(COD007) ERROR CODE 06860019 DC AL1(DEFSYMBL) NEST OPERATOR 06870019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 06880019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 06890019 DC AL1(PAR00014-LIN00012) POINT TO END OF OPT. ITEMS 06900019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06910019 DC AL1(001) LENGTH OF LITERAL 06920019 DC C',' 06930019 DC AL1(DEFCOMIT) LOCAL COMMIT / 06940019 DC AL1(DEFSYMBL) NEST OPERATOR 06950019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 06960019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 06970019 PAR00014 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 06980019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 06990019 DC AL1(ACT200) ACTION CODE 07000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 07010019 DC AL1(COD012) ERROR CODE 07020019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07030019 DC AL1(001) LENGTH OF LITERAL 07040019 DC C')' 07050019 PAR00013 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 07060019 ALT00031 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 07070019 DC AL1(ALT00032-LIN00012) FALSE DISP. 07080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07090019 DC AL1(001) LENGTH OF LITERAL 07100019 DC C'(' 07110019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 07120019 DC AL1(PAR00015-LIN00012) POINT TO END OF OPT. ITEMS 07130019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 07140019 DC AL1(ALT00033-LIN00012) FALSE DISP. 07150019 DC AL1(BRC00014-LIN00012) TRUE DISP. 07160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07170019 DC AL1(001) LENGTH OF LITERAL 07180019 DC C'+' 07190019 ALT00033 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 07200019 DC AL1(ALT00034-LIN00012) FALSE DISP. 07210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07220019 DC AL1(001) LENGTH OF LITERAL 07230019 DC C'-' 07240019 ALT00034 EQU * 07250019 BRC00014 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 07260019 PAR00015 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 07270019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 07280019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 07290019 DC AL1(ACT103) ACTION CODE 07300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07310019 DC AL1(001) LENGTH OF LITERAL 07320019 DC C',' 07330019 DC AL1(DEFCOMIT) LOCAL COMMIT / 07340019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 07350019 DC AL1(PAR00016-LIN00012) POINT TO END OF OPT. ITEMS 07360019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 07370019 DC AL1(ALT00035-LIN00012) FALSE DISP. 07380019 DC AL1(BRC00015-LIN00012) TRUE DISP. 07390019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07400019 DC AL1(001) LENGTH OF LITERAL 07410019 DC C'+' 07420019 ALT00035 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 07430019 DC AL1(ALT00036-LIN00012) FALSE DISP. 07440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07450019 DC AL1(001) LENGTH OF LITERAL 07460019 DC C'-' 07470019 ALT00036 EQU * 07480019 BRC00015 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 07490019 PAR00016 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 07500019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 07510019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 07520019 DC AL1(ACT104) ACTION CODE 07530019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 07540019 DC AL1(COD012) ERROR CODE 07550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07560019 DC AL1(001) LENGTH OF LITERAL 07570019 DC C')' 07580019 ALT00032 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 07590019 DC AL1(ALT00037-LIN00012) FALSE DISP. 07600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07610019 DC AL1(001) LENGTH OF LITERAL 07620019 DC C'(' 07630019 DC AL1(DEFSYMBL) NEST OPERATOR 07640019 DC AL2(LIN00007-IPDAGH) ARITHEXP 07650019 DC AL1(DEFCOMIT) LOCAL COMMIT / 07660019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 07670019 DC AL1(COD012) ERROR CODE 07680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07690019 DC AL1(001) LENGTH OF LITERAL 07700019 DC C')' 07710019 ALT00037 EQU * 07720019 BRC00013 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 07730019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 07740019 EJECT 07750019 *********************************************************************** 07760019 * * 07770019 *LOGICEXP = ( '.NOT.' ) OPERANDL *57 ( +LOGOP / * 07780019 * OPERANDL ... ) * 07790019 * * 07800019 * DEFINES LOGICAL EXPRESSIONS. * 07810019 * * 07820019 *********************************************************************** 07830019 LIN00008 EQU * START OF DEFINITION 07840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 07850019 DC AL1(PAR00017-LIN00008) POINT TO END OF OPT. ITEMS 07860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 07870019 DC AL1(005) LENGTH OF LITERAL 07880019 DC C'.NOT.' 07890019 PAR00017 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 07900019 DC AL1(DEFSYMBL) NEST OPERATOR 07910019 DC AL2(LIN00013-IPDAGH) OPERANDL 07920019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 07930019 DC AL1(COD057) ERROR CODE 07940019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 07950019 DC AL1(PAR00018-LIN00008) POINT TO END OF OPT. ITEMS 07960019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 07970019 DC AL2(LIN00014-IPDAGH) LOGOP 07980019 DC AL1(DEFCOMIT) LOCAL COMMIT / 07990019 DC AL1(DEFSYMBL) NEST OPERATOR 08000019 DC AL2(LIN00013-IPDAGH) OPERANDL 08010019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 08020019 PAR00018 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 08030019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 08040019 EJECT 08050019 *********************************************************************** 08060019 * * 08070019 *OPERANDL = < NAME -ARITHOP ( +RELOP / *139 ARITHEXP3 ) * 08080019 * ³ ARITHEXP3 / *51 +RELOP *139 ARITHEXP3 * 08090019 * ³ '(' / LOGICEXP *12 ')' * 08100019 * ³ '.TRUE.' ³ '.FALSE.' > * 08110019 * * 08120019 * DEFINES THE OPERANDS THAT CAN APPEAR IN * 08130019 * LOGICAL EXPRESSIONS. NOTE THAT THE COMMIT IN * 08140019 * THE FORM "LOGICAL EXPRESSION IN PARENTHESES" * 08150019 * PRECEDES THE EXPRESSION. THIS COMMIT IS * 08160019 * POSSIBLE SINCE ANY SOURCE BEING TESTED * 08170019 * AGAINST LOGICAL EXPRESSION HAS ALREADY * 08180019 * BEEN TESTED AGAINST ARITHMETIC EXPRESSION * 08190019 * IF ARITHMETIC EXPRESSION WAS A POSSIBLE * 08200019 * ALTERNATIVE. * 08210019 * * 08220019 * WHEN A NAME IS FOUND, THIS DEFINITION TESTS FOR THE * 08230019 * ABSENCE OF AN ARITHMETIC OPERATOR FOLLOWING IT. IF * 08240019 * NO ARITHMETIC OPERATOR FOLLOWS, THE NAME COULD STILL * 08250019 * BE AN ARITHMETIC EXPRESSION, SO THE DEFINITION TESTS * 08260019 * FOR A RELATIONAL OPERATOR FOLLOWED BY AN ARITHMETIC * 08270019 * EXPRESSION AS AN OPTION AFTER THE NAME. IF AN * 08280019 * ARITHMETIC OPERATOR DOES OCCUR AFTER THE NAME, THE * 08290019 * NAME ALTERNATIVE FAILS, AND THE EXPRESSION IS PROCESSED * 08300019 * BY ARITHEXP3 IN THE NEXT ALTERNATIVE. THE RELATIONAL * 08310019 * OPERATOR IS NOT OPTIONAL IN THIS CASE. * 08320019 * * 08330019 *********************************************************************** 08340019 LIN00013 EQU * START OF DEFINITION 08350019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 08360019 DC AL1(ALT00038-LIN00013) FALSE DISP. 08370019 DC AL1(BRC00016-LIN00013) TRUE DISP. 08380019 DC AL1(DEFSYMBL) NEST OPERATOR 08390019 DC AL2(LIN00015-IPDAGH) NAME 08400019 DC AL1(DEFTABLM) -TABLE-NAME OPERATOR - 08410019 DC AL2(LIN00010-IPDAGH) ARITHOP 08420019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 08430019 DC AL1(PAR00019-LIN00013) POINT TO END OF OPT. ITEMS 08440019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 08450019 DC AL2(LIN00016-IPDAGH) RELOP 08460019 DC AL1(DEFCOMIT) LOCAL COMMIT / 08470019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 08480019 DC AL1(COD139) ERROR CODE 08490019 DC AL1(DEFSYMBL) NEST OPERATOR 08500019 DC AL2(LIN00017-IPDAGH) ARITHEXP3 08510019 PAR00019 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 08520019 ALT00038 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 08530019 DC AL1(ALT00039-LIN00013) FALSE DISP. 08540019 DC AL1(DEFSYMBL) NEST OPERATOR 08550019 DC AL2(LIN00017-IPDAGH) ARITHEXP3 08560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 08570019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 08580019 DC AL1(COD051) ERROR CODE 08590019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 08600019 DC AL2(LIN00016-IPDAGH) RELOP 08610019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 08620019 DC AL1(COD139) ERROR CODE 08630019 DC AL1(DEFSYMBL) NEST OPERATOR 08640019 DC AL2(LIN00017-IPDAGH) ARITHEXP3 08650019 ALT00039 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 08660019 DC AL1(ALT00040-LIN00013) FALSE DISP. 08670019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 08680019 DC AL1(001) LENGTH OF LITERAL 08690019 DC C'(' 08700019 DC AL1(DEFCOMIT) LOCAL COMMIT / 08710019 DC AL1(DEFSYMBL) NEST OPERATOR 08720019 DC AL2(LIN00008-IPDAGH) LOGICEXP 08730019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 08740019 DC AL1(COD012) ERROR CODE 08750019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 08760019 DC AL1(001) LENGTH OF LITERAL 08770019 DC C')' 08780019 ALT00040 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 08790019 DC AL1(ALT00041-LIN00013) FALSE DISP. 08800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 08810019 DC AL1(006) LENGTH OF LITERAL 08820019 DC C'.TRUE.' 08830019 ALT00041 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 08840019 DC AL1(ALT00042-LIN00013) FALSE DISP. 08850019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 08860019 DC AL1(007) LENGTH OF LITERAL 08870019 DC C'.FALSE.' 08880019 ALT00042 EQU * 08890019 BRC00016 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 08900019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 08910019 EJECT 08920019 *********************************************************************** 08930019 * * 08940019 *LOGOP = " '.AND..NOT.' 0 '.AND.' 0 * 08950019 * '.OR..NOT.' 0 '.OR.' 0 " * 08960019 * * 08970019 * TABLE OF THE LOGICAL OPERATORS. THE OPERATOR * 08980019 * ".NOT." IS NOT A MEMBER OF THIS TABLE BECAUSE * 08990019 * ALL OF ITS VALID USES ARE ACCOUNTED FOR BY * 09000019 * THE OPTIONAL ".NOT." IN LOGICEXP. * 09010019 * * 09020019 *********************************************************************** 09030019 LIN00014 EQU * START OF DEFINITION 09040019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 09050019 DC AL2(TAB00002-*+1) LENGTH OF TABLE 09060019 DC AL1(010) LENGTH OF LITERAL 09070019 DC C'.AND..NOT.' 09080019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09090019 DC X'FF' NULL ACTION CODE 09100019 DC C'T' TABLE FUNCTION PAD CHARACTER 09110019 DC AL1(005) LENGTH OF LITERAL 09120019 DC C'.AND.' 09130019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09140019 DC X'FF' NULL ACTION CODE 09150019 DC C'T' TABLE FUNCTION PAD CHARACTER 09160019 DC AL1(009) LENGTH OF LITERAL 09170019 DC C'.OR..NOT.' 09180019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09190019 DC X'FF' NULL ACTION CODE 09200019 DC C'T' TABLE FUNCTION PAD CHARACTER 09210019 DC AL1(004) LENGTH OF LITERAL 09220019 DC C'.OR.' 09230019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09240019 DC X'FF' NULL ACTION CODE 09250019 DC C'T' TABLE FUNCTION PAD CHARACTER 09260019 TAB00002 DC AL1(010) LENGTH OF LONGEST TABLE ARG 09270019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 09280019 EJECT 09290019 *********************************************************************** 09300019 * * 09310019 *RELOP = " '.LT.' 0 '.LE.' 0 '.EQ.' 0 '.NE.' 0 * 09320019 * '.GE.' 0 '.GT.' 0 " * 09330019 * * 09340019 * TABLE OF THE RELATIONAL OPERATORS. * 09350019 * * 09360019 *********************************************************************** 09370019 LIN00016 EQU * START OF DEFINITION 09380019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 09390019 DC AL2(TAB00003-*+1) LENGTH OF TABLE 09400019 DC AL1(004) LENGTH OF LITERAL 09410019 DC C'.LT.' 09420019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09430019 DC X'FF' NULL ACTION CODE 09440019 DC C'T' TABLE FUNCTION PAD CHARACTER 09450019 DC AL1(004) LENGTH OF LITERAL 09460019 DC C'.LE.' 09470019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09480019 DC X'FF' NULL ACTION CODE 09490019 DC C'T' TABLE FUNCTION PAD CHARACTER 09500019 DC AL1(004) LENGTH OF LITERAL 09510019 DC C'.EQ.' 09520019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09530019 DC X'FF' NULL ACTION CODE 09540019 DC C'T' TABLE FUNCTION PAD CHARACTER 09550019 DC AL1(004) LENGTH OF LITERAL 09560019 DC C'.NE.' 09570019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09580019 DC X'FF' NULL ACTION CODE 09590019 DC C'T' TABLE FUNCTION PAD CHARACTER 09600019 DC AL1(004) LENGTH OF LITERAL 09610019 DC C'.GE.' 09620019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09630019 DC X'FF' NULL ACTION CODE 09640019 DC C'T' TABLE FUNCTION PAD CHARACTER 09650019 DC AL1(004) LENGTH OF LITERAL 09660019 DC C'.GT.' 09670019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 09680019 DC X'FF' NULL ACTION CODE 09690019 DC C'T' TABLE FUNCTION PAD CHARACTER 09700019 TAB00003 DC AL1(004) LENGTH OF LONGEST TABLE ARG 09710019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 09720019 EJECT 09730019 *********************************************************************** 09740019 * * 09750019 *ARITHEXP3 = ( < '+' ³ '-' > ) OPERANDA2 *55 * 09760019 * ( +ARITHOP / OPERANDA2 ... ) * 09770019 * * 09780019 * DEFINES NON-COMPLEX ARITHMETIC EXPRESSIONS FOR * 09790019 * USE IN LOGICAL EXPRESSIONS. UNLIKE ARITHEXP2, * 09800019 * THIS DEFINITION ALLOWS THE ARITHMETIC EXPRESSION * 09810019 * TO BE FOLLOWED BY A PERIOD. * 09820019 * * 09830019 *********************************************************************** 09840019 LIN00017 EQU * START OF DEFINITION 09850019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 09860019 DC AL1(PAR00020-LIN00017) POINT TO END OF OPT. ITEMS 09870019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 09880019 DC AL1(ALT00043-LIN00017) FALSE DISP. 09890019 DC AL1(BRC00017-LIN00017) TRUE DISP. 09900019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 09910019 DC AL1(001) LENGTH OF LITERAL 09920019 DC C'+' 09930019 ALT00043 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 09940019 DC AL1(ALT00044-LIN00017) FALSE DISP. 09950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 09960019 DC AL1(001) LENGTH OF LITERAL 09970019 DC C'-' 09980019 ALT00044 EQU * 09990019 BRC00017 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 10000019 PAR00020 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 10010019 DC AL1(DEFSYMBL) NEST OPERATOR 10020019 DC AL2(LIN00009-IPDAGH) OPERANDA2 10030019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 10040019 DC AL1(COD055) ERROR CODE 10050019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 10060019 DC AL1(PAR00021-LIN00017) POINT TO END OF OPT. ITEMS 10070019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 10080019 DC AL2(LIN00010-IPDAGH) ARITHOP 10090019 DC AL1(DEFCOMIT) LOCAL COMMIT / 10100019 DC AL1(DEFSYMBL) NEST OPERATOR 10110019 DC AL2(LIN00009-IPDAGH) OPERANDA2 10120019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 10130019 PAR00021 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 10140019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 10150019 EJECT 10160019 *********************************************************************** 10170019 * * 10180019 *KEYWORD = < 'IF' / *31 '(' : < ARITHIF ³ / *17 LOGICEXP* 10190019 * *13 ')' LOGICIF > ³ +AFTERIF ³ +OTHERKW > * 10200019 * * 10210019 * DEFINES ALL THE STATEMENTS STARTING WITH A KEYWORD * 10220019 * EXCEPT FOR THE DO STATEMENT. EXCEPT FOR THE IF * 10230019 * KEYWORD, ALL THE KEYWORDS ARE IN ONE OF THE * 10240019 * TWO TABLES AFTERIF AND OTHERKW. THESE * 10250019 * TABLES TRANSFER THE SYNTAX TABLE SCAN TO THE * 10260019 * APPROPRIATE SYNTACTIC LINE OR ACTION CODE IF THE FIRST * 10270019 * AVAILABLE SOURCE CHARACTERS MATCH A KEYWORD. * 10280019 * * 10290019 * THE STATEMENTS STARTING WITH THE IF KEYWORD MUST BE * 10300019 * HANDLED SPECIALLY SINCE THERE ARE TWO * 10310019 * SYNTACTIC FORMS STARTING WITH 'IF(', * 10320019 * AND THE REQUIRED DISTINCTION BETWEEN * 10330019 * THEM CANNOT BE MADE IF THE 'IF(' KEYWORD * 10340019 * IS PLACED IN THE TABLE OF THE KEYWORDS * 10350019 * PERMITTED AFTER ONE OF THEM, THE LOGICAL IF. * 10360019 * THE 'IF(' STATEMENTS ARE COMMITTED AFTER THE * 10370019 * 'IF' IN ORDER TO DIAGNOSE A MISSING LEFT * 10380019 * PARENTHESIS. * 10390019 * * 10400019 *********************************************************************** 10410019 LIN00004 EQU * START OF DEFINITION 10420019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 10430019 DC AL1(ALT00045-LIN00004) FALSE DISP. 10440019 DC AL1(BRC00018-LIN00004) TRUE DISP. 10450019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 10460019 DC AL1(002) LENGTH OF LITERAL 10470019 DC C'IF' 10480019 DC AL1(DEFCOMIT) LOCAL COMMIT / 10490019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 10500019 DC AL1(COD031) ERROR CODE 10510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 10520019 DC AL1(001) LENGTH OF LITERAL 10530019 DC C'(' 10540019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 10550019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 10560019 DC AL1(ALT00046-LIN00004) FALSE DISP. 10570019 DC AL1(BRC00019-LIN00004) TRUE DISP. 10580019 DC AL1(DEFSYMBL) NEST OPERATOR 10590019 DC AL2(LIN00018-IPDAGH) ARITHIF 10600019 ALT00046 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 10610019 DC AL1(ALT00047-LIN00004) FALSE DISP. 10620019 DC AL1(DEFCOMIT) LOCAL COMMIT / 10630019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 10640019 DC AL1(COD017) ERROR CODE 10650019 DC AL1(DEFSYMBL) NEST OPERATOR 10660019 DC AL2(LIN00008-IPDAGH) LOGICEXP 10670019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 10680019 DC AL1(COD013) ERROR CODE 10690019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 10700019 DC AL1(001) LENGTH OF LITERAL 10710019 DC C')' 10720019 DC AL1(DEFSYMBL) NEST OPERATOR 10730019 DC AL2(LIN00019-IPDAGH) LOGICIF 10740019 ALT00047 EQU * 10750019 BRC00019 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 10760019 ALT00045 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 10770019 DC AL1(ALT00048-LIN00004) FALSE DISP. 10780019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 10790019 DC AL2(LIN00020-IPDAGH) AFTERIF 10800019 ALT00048 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 10810019 DC AL1(ALT00049-LIN00004) FALSE DISP. 10820019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 10830019 DC AL2(LIN00021-IPDAGH) OTHERKW 10840019 ALT00049 EQU * 10850019 BRC00018 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 10860019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 10870019 EJECT 10880019 *********************************************************************** 10890019 * * 10900019 *ARITHIF = < NAME ')' < S : ³ LOGICIF > ³ ARITHEXP2 : * 10910019 * *13 ')' *15 S > *53 ',' *43 S *53 ',' *43 S * 10920019 * * 10930019 * DEFINES THE ARITHMETIC IF STATEMENT AND A * 10940019 * SPECIAL CASE OF THE LOGICAL IF STATEMENT. * 10950019 * * 10960019 * THE SPECIAL CASE OF THE LOGICAL IF STATEMENT CAN * 10970019 * OCCUR WHEN THE PARENTHESIZED EXPRESSION * 10980019 * FOLLOWING THE IF KEYWORD CONSISTS SOLELY * 10990019 * OF AN OPTIONALLY SUBSCRIPTED VARIABLE NAME * 11000019 * ENCLOSED IN ANY NUMBER OF PARENTHESES. SINCE * 11010019 * SUCH AN EXPRESSION COULD EITHER BE AN ARITHMETIC * 11020019 * EXPRESSION OR A LOGICAL EXPRESSION, THIS LINE * 11030019 * CANNOT BE COMMITTED UNTIL A STATEMENT LABEL IS * 11040019 * FOUND AFTER THE PARENTHESIZED EXPRESSION. IF NO * 11050019 * STATEMENT LABEL IS FOUND, THE IF IS ASSUMED * 11060019 * TO BE LOGICAL, AND NESTING TO THE LOGICIF LINE * 11070019 * OCCURS. (LOGICIF BEGINS WITH A STATEMENT COMMIT.) * 11080019 * * 11090019 * BECAUSE THE SPECIAL CASE IS TRIED FIRST, ANY * 11100019 * EXPRESSION WHICH SATISFIES ARITHEXP2 WILL * 11110019 * CONTAIN AT LEAST ONE NUMERIC CONSTANT OR ARITHMETIC * 11120019 * OPERATOR. FURTHER, THE ª'.' AT THE END OF ARITHEXP2 * 11130019 * ASSURES THAT IT IS NOT FOLLOWED BY A RELATIONAL * 11140019 * OPERATOR. THUS, THE STATEMENT COMMIT CAN OCCUR * 11150019 * IMMEDIATELY AFTER THE REFERENCE TO ARITHEXP2. * 11160019 * * 11170019 *********************************************************************** 11180019 LIN00018 EQU * START OF DEFINITION 11190019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 11200019 DC AL1(ALT00050-LIN00018) FALSE DISP. 11210019 DC AL1(BRC00020-LIN00018) TRUE DISP. 11220019 DC AL1(DEFSYMBL) NEST OPERATOR 11230019 DC AL2(LIN00015-IPDAGH) NAME 11240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11250019 DC AL1(001) LENGTH OF LITERAL 11260019 DC C')' 11270019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 11280019 DC AL1(ALT00051-LIN00018) FALSE DISP. 11290019 DC AL1(BRC00021-LIN00018) TRUE DISP. 11300019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 11310019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 11320019 ALT00051 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 11330019 DC AL1(ALT00052-LIN00018) FALSE DISP. 11340019 DC AL1(DEFSYMBL) NEST OPERATOR 11350019 DC AL2(LIN00019-IPDAGH) LOGICIF 11360019 ALT00052 EQU * 11370019 BRC00021 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 11380019 ALT00050 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 11390019 DC AL1(ALT00053-LIN00018) FALSE DISP. 11400019 DC AL1(DEFSYMBL) NEST OPERATOR 11410019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 11420019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 11430019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11440019 DC AL1(COD013) ERROR CODE 11450019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11460019 DC AL1(001) LENGTH OF LITERAL 11470019 DC C')' 11480019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11490019 DC AL1(COD015) ERROR CODE 11500019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 11510019 ALT00053 EQU * 11520019 BRC00020 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 11530019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11540019 DC AL1(COD053) ERROR CODE 11550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11560019 DC AL1(001) LENGTH OF LITERAL 11570019 DC C',' 11580019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11590019 DC AL1(COD043) ERROR CODE 11600019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 11610019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11620019 DC AL1(COD053) ERROR CODE 11630019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11640019 DC AL1(001) LENGTH OF LITERAL 11650019 DC C',' 11660019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11670019 DC AL1(COD043) ERROR CODE 11680019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 11690019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 11700019 EJECT 11710019 *********************************************************************** 11720019 * * 11730019 *NAME = < N ( '(' / *7 FUNCACTARG ( ',' / * 11740019 * FUNCACTARG ... ) $200 *12 ')' ) ³ * 11750019 * '(' NAME ')' > * 11760019 * * 11770019 * DEFINES AN OPTIONALLY SUBSCRIPTED VARIABLE NAME * 11780019 * ENCLOSED BY ANY NUMBER OF PAIRS OF PARENTHESES. * 11790019 * * 11800019 *********************************************************************** 11810019 LIN00015 EQU * START OF DEFINITION 11820019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 11830019 DC AL1(ALT00054-LIN00015) FALSE DISP. 11840019 DC AL1(BRC00022-LIN00015) TRUE DISP. 11850019 DC AL1(DEFNAME) NAME OPERATOR N 11860019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 11870019 DC AL1(PAR00022-LIN00015) POINT TO END OF OPT. ITEMS 11880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11890019 DC AL1(001) LENGTH OF LITERAL 11900019 DC C'(' 11910019 DC AL1(DEFCOMIT) LOCAL COMMIT / 11920019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 11930019 DC AL1(COD007) ERROR CODE 11940019 DC AL1(DEFSYMBL) NEST OPERATOR 11950019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 11960019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 11970019 DC AL1(PAR00023-LIN00015) POINT TO END OF OPT. ITEMS 11980019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11990019 DC AL1(001) LENGTH OF LITERAL 12000019 DC C',' 12010019 DC AL1(DEFCOMIT) LOCAL COMMIT / 12020019 DC AL1(DEFSYMBL) NEST OPERATOR 12030019 DC AL2(LIN00011-IPDAGH) FUNCACTARG 12040019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 12050019 PAR00023 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 12060019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 12070019 DC AL1(ACT200) ACTION CODE 12080019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 12090019 DC AL1(COD012) ERROR CODE 12100019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12110019 DC AL1(001) LENGTH OF LITERAL 12120019 DC C')' 12130019 PAR00022 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 12140019 ALT00054 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 12150019 DC AL1(ALT00055-LIN00015) FALSE DISP. 12160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12170019 DC AL1(001) LENGTH OF LITERAL 12180019 DC C'(' 12190019 DC AL1(DEFSYMBL) NEST OPERATOR 12200019 DC AL2(LIN00015-IPDAGH) NAME 12210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12220019 DC AL1(001) LENGTH OF LITERAL 12230019 DC C')' 12240019 ALT00055 EQU * 12250019 BRC00022 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 12260019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 12270019 EJECT 12280019 *********************************************************************** 12290019 * * 12300019 *LOGICIF = : < 'DO' DO2 / *23 $801 ³ M ARITHASG ³ * 12310019 * +AFTERIF ³ 'IF' / *19 '(' *147 ARITHEXP2 ')' S * 12320019 * *53 ',' *43 S *53 ',' *43 S ³ / *23 -OTHERKW * 12330019 * *19 N ARITHASG > * 12340019 * * 12350019 * DEFINES THE PART OF THE LOGICAL IF STATEMENT TO THE * 12360019 * RIGHT OF THE PARENTHESIZED EXPRESSION WHICH FOLLOWS * 12370019 * THE IF KEYWORD. THIS LINE IS SIMILAR TO THE FIRST * 12380019 * SYNTACTIC LINE (IPDAGH) OF THE DEFINITION, BUT NOT * 12390019 * IDENTICAL, SINCE THERE ARE RESTRICTIONS ON THE * 12400019 * TYPE OF STATEMENT AFTER THE IF(EXPRESSION) PART OF * 12410019 * A LOGICAL IF. * 12420019 * * 12430019 * THE STATEMENT IS FIRST EXAMINED TO SEE WHETHER IT IS * 12440019 * A DO STATEMENT, JUST AS ON LINE IPDAGH. HOWEVER, * 12450019 * SINCE DO STATEMENTS ARE INVALID, ACTION CODE 801 IS * 12460019 * USED TO ISSUE MESSAGE 23 IF DO2 PRODUCES A T. * 12470019 * * 12480019 * THE NEXT ALTERNATIVE IS M ARITHASG, JUST AS IN IPDAGH. * 12490019 * THE THIRD AND FOURTH ALTERNATIVES CORRESPOND TO * 12500019 * THE THIRD ALTERNATIVE OF IPDAGH: THEY DEFINE ALL * 12510019 * THE KEYWORD STATEMENTS VALID AFTER A LOGICAL IF. * 12520019 * THE IF ALTERNATIVE DESCRIBES ONLY THE ARITHMETIC * 12530019 * IF, SINCE A LOGICAL IF CANNOT FOLLOW A LOGICAL IF. * 12540019 * * 12550019 * FINALLY, THE FIFTH ALTERNATIVE CHECKS THE NEXT AVAILABLE * 12560019 * SOURCE AGAINST THE TABLE OF KEYWORDS WHICH CANNOT * 12570019 * FOLLOW A LOGICAL IF. IF THE AVAILABLE SOURCE MATCHES * 12580019 * ONE OF THESE KEYWORDS, MESSAGE 23 IS ISSUED. * 12590019 * OTHERWISE, N ARITHASG IS TRIED, AND MESSAGE 19 * 12600019 * IS ISSUED IF THAT FAILS. * 12610019 * * 12620019 *********************************************************************** 12630019 LIN00019 EQU * START OF DEFINITION 12640019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 12650019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 12660019 DC AL1(ALT00056-LIN00019) FALSE DISP. 12670019 DC AL1(BRC00023-LIN00019) TRUE DISP. 12680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12690019 DC AL1(002) LENGTH OF LITERAL 12700019 DC C'DO' 12710019 DC AL1(DEFSYMBL) NEST OPERATOR 12720019 DC AL2(LIN00022-IPDAGH) DO2 12730019 DC AL1(DEFCOMIT) LOCAL COMMIT / 12740019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 12750019 DC AL1(COD023) ERROR CODE 12760019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 12770019 DC AL1(ACT801) ACTION CODE 12780019 ALT00056 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 12790019 DC AL1(ALT00057-LIN00019) FALSE DISP. 12800019 DC AL1(DEFMNAME) M NAME OPERATOR M 12810019 DC AL1(DEFSYMBL) NEST OPERATOR 12820019 DC AL2(LIN00023-IPDAGH) ARITHASG 12830019 ALT00057 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 12840019 DC AL1(ALT00058-LIN00019) FALSE DISP. 12850019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 12860019 DC AL2(LIN00020-IPDAGH) AFTERIF 12870019 ALT00058 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 12880019 DC AL1(ALT00059-LIN00019) FALSE DISP. 12890019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12900019 DC AL1(002) LENGTH OF LITERAL 12910019 DC C'IF' 12920019 DC AL1(DEFCOMIT) LOCAL COMMIT / 12930019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 12940019 DC AL1(COD019) ERROR CODE 12950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12960019 DC AL1(001) LENGTH OF LITERAL 12970019 DC C'(' 12980019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 12990019 DC AL1(COD147) ERROR CODE 13000019 DC AL1(DEFSYMBL) NEST OPERATOR 13010019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 13020019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13030019 DC AL1(001) LENGTH OF LITERAL 13040019 DC C')' 13050019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 13060019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13070019 DC AL1(COD053) ERROR CODE 13080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13090019 DC AL1(001) LENGTH OF LITERAL 13100019 DC C',' 13110019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13120019 DC AL1(COD043) ERROR CODE 13130019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 13140019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13150019 DC AL1(COD053) ERROR CODE 13160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13170019 DC AL1(001) LENGTH OF LITERAL 13180019 DC C',' 13190019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13200019 DC AL1(COD043) ERROR CODE 13210019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 13220019 ALT00059 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 13230019 DC AL1(ALT00060-LIN00019) FALSE DISP. 13240019 DC AL1(DEFCOMIT) LOCAL COMMIT / 13250019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13260019 DC AL1(COD023) ERROR CODE 13270019 DC AL1(DEFTABLM) -TABLE-NAME OPERATOR - 13280019 DC AL2(LIN00021-IPDAGH) OTHERKW 13290019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13300019 DC AL1(COD019) ERROR CODE 13310019 DC AL1(DEFNAME) NAME OPERATOR N 13320019 DC AL1(DEFSYMBL) NEST OPERATOR 13330019 DC AL2(LIN00023-IPDAGH) ARITHASG 13340019 ALT00060 EQU * 13350019 BRC00023 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 13360019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 13370019 EJECT 13380019 *********************************************************************** 13390019 * * 13400019 *DO2 = S ( ',' ) N '=' < N ³ USNZINT > ',' * 13410019 * * 13420019 * DEFINES THE SYNTAX OF THE BEGINNING OF A DO * 13430019 * STATEMENT FOR USE IN DIAGNOSING ITS PRESENCE * 13440019 * AFTER A LOGICAL IF. THERE IS NO STATEMENT * 13450019 * COMMIT ON THIS LINE SO THAT IT CAN UNNEST * 13460019 * BACK TO THE LOGICIF LINE WHICH WILL ISSUE A * 13470019 * MESSAGE IF THIS LINE PRODUCES A 'T' . * 13480019 * * 13490019 *********************************************************************** 13500019 LIN00022 EQU * START OF DEFINITION 13510019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 13520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 13530019 DC AL1(PAR00024-LIN00022) POINT TO END OF OPT. ITEMS 13540019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13550019 DC AL1(001) LENGTH OF LITERAL 13560019 DC C',' 13570019 PAR00024 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 13580019 DC AL1(DEFNAME) NAME OPERATOR N 13590019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13600019 DC AL1(001) LENGTH OF LITERAL 13610019 DC C'=' 13620019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 13630019 DC AL1(ALT00061-LIN00022) FALSE DISP. 13640019 DC AL1(BRC00024-LIN00022) TRUE DISP. 13650019 DC AL1(DEFNAME) NAME OPERATOR N 13660019 ALT00061 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 13670019 DC AL1(ALT00062-LIN00022) FALSE DISP. 13680019 DC AL1(DEFSYMBL) NEST OPERATOR 13690019 DC AL2(LIN00005-IPDAGH) USNZINT 13700019 ALT00062 EQU * 13710019 BRC00024 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 13720019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13730019 DC AL1(001) LENGTH OF LITERAL 13740019 DC C',' 13750019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 13760019 EJECT 13770019 *********************************************************************** 13780019 * * 13790019 *ARITHASG = < '=' : ³ &= '(' ARITHEXP2 ( ',' ARITHEXP2 ... ) * 13800019 * ')=' : $202 > *7 < ARITHEXP ³ LOGICEXP > * 13810019 * * 13820019 * DEFINES THAT PORTION OF ASSIGNMENT THAT * 13830019 * MAY APPEAR AFTER A LOGICAL IF. SINCE * 13840019 * STATEMENT FUNCTION DEFINITIONS CANNOT APPEAR * 13850019 * AFTER A LOGICAL IF, THE SECOND ALTERNATIVE * 13860019 * OF ASSIGNMENT IS NOT INCLUDED IN THIS * 13870019 * DEFINITION, AND THE "TOO MANY SUBSCRIPTS PRECEDE" * 13880019 * ACTION CODE IS USED. * 13890019 * * 13900019 *********************************************************************** 13910019 LIN00023 EQU * START OF DEFINITION 13920019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 13930019 DC AL1(ALT00063-LIN00023) FALSE DISP. 13940019 DC AL1(BRC00025-LIN00023) TRUE DISP. 13950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13960019 DC AL1(001) LENGTH OF LITERAL 13970019 DC C'=' 13980019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 13990019 ALT00063 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 14000019 DC AL1(ALT00064-LIN00023) FALSE DISP. 14010019 DC AL1(DEFSCAN) SEARCH OPERATOR & 14020019 DC C'=' 14030019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 14040019 DC AL1(001) LENGTH OF LITERAL 14050019 DC C'(' 14060019 DC AL1(DEFSYMBL) NEST OPERATOR 14070019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 14080019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 14090019 DC AL1(PAR00025-LIN00023) POINT TO END OF OPT. ITEMS 14100019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 14110019 DC AL1(001) LENGTH OF LITERAL 14120019 DC C',' 14130019 DC AL1(DEFSYMBL) NEST OPERATOR 14140019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 14150019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 14160019 PAR00025 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 14170019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 14180019 DC AL1(002) LENGTH OF LITERAL 14190019 DC C')=' 14200019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 14210019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 14220019 DC AL1(ACT202) ACTION CODE 14230019 ALT00064 EQU * 14240019 BRC00025 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 14250019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 14260019 DC AL1(COD007) ERROR CODE 14270019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 14280019 DC AL1(ALT00065-LIN00023) FALSE DISP. 14290019 DC AL1(BRC00026-LIN00023) TRUE DISP. 14300019 DC AL1(DEFSYMBL) NEST OPERATOR 14310019 DC AL2(LIN00007-IPDAGH) ARITHEXP 14320019 ALT00065 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 14330019 DC AL1(ALT00066-LIN00023) FALSE DISP. 14340019 DC AL1(DEFSYMBL) NEST OPERATOR 14350019 DC AL2(LIN00008-IPDAGH) LOGICEXP 14360019 ALT00066 EQU * 14370019 BRC00026 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 14380019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 14390019 EJECT 14400019 *********************************************************************** 14410019 * * 14420019 *AFTERIF = " 'ASSI' ASSIGN 'BACK' BACKSPACE 'CALL' CALL * 14430019 * 'CONT' CONTINUE 'ENDF' ENDFILE 'FIND' FIND * 14440019 * 'GOTO' GOTO 'PAUS' PAUSE 'PRIN' PRINT * 14450019 * 'PUNC' PUNCH 'READ' READ 'RETU' RETURN * 14460019 * 'REWI' REWIND 'STOP' STOP 'WRIT' WRITE "* 14470019 * * 14480019 * TABLE OF ALL THE KEYWORDS (EXCEPT IF) THAT * 14490019 * ARE PERMITTED AFTER A LOGICAL IF. A REFERENCE * 14500019 * TO THIS TABLE CAUSES TRANSFER TO THE APPROPRIATE * 14510019 * SYNTACTIC LINE IF A MATCH IS FOUND. WHEN * 14520019 * A TRANSFER OCCURS, THE LINE TO WHICH THE * 14530019 * TRANSFER IS MADE BEGINS CHECKING WITH THE * 14540019 * FIRST CHARACTER AFTER THE CHARACTERS THAT * 14550019 * MATCHED THE TABLE ENTRY. * 14560019 * * 14570019 *********************************************************************** 14580019 LIN00020 EQU * START OF DEFINITION 14590019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 14600019 DC AL2(TAB00004-*+1) LENGTH OF TABLE 14610019 DC AL1(004) LENGTH OF LITERAL 14620019 DC C'ASSI' 14630019 DC AL1(DEFSYMBL) NEST OPERATOR 14640019 DC AL2(LIN00024-IPDAGH) ASSIGN 14650019 DC AL1(004) LENGTH OF LITERAL 14660019 DC C'BACK' 14670019 DC AL1(DEFSYMBL) NEST OPERATOR 14680019 DC AL2(LIN00025-IPDAGH) BACKSPACE 14690019 DC AL1(004) LENGTH OF LITERAL 14700019 DC C'CALL' 14710019 DC AL1(DEFSYMBL) NEST OPERATOR 14720019 DC AL2(LIN00026-IPDAGH) CALL 14730019 DC AL1(004) LENGTH OF LITERAL 14740019 DC C'CONT' 14750019 DC AL1(DEFSYMBL) NEST OPERATOR 14760019 DC AL2(LIN00027-IPDAGH) CONTINUE 14770019 DC AL1(004) LENGTH OF LITERAL 14780019 DC C'ENDF' 14790019 DC AL1(DEFSYMBL) NEST OPERATOR 14800019 DC AL2(LIN00028-IPDAGH) ENDFILE 14810019 DC AL1(004) LENGTH OF LITERAL 14820019 DC C'FIND' 14830019 DC AL1(DEFSYMBL) NEST OPERATOR 14840019 DC AL2(LIN00029-IPDAGH) FIND 14850019 DC AL1(004) LENGTH OF LITERAL 14860019 DC C'GOTO' 14870019 DC AL1(DEFSYMBL) NEST OPERATOR 14880019 DC AL2(LIN00030-IPDAGH) GOTO 14890019 DC AL1(004) LENGTH OF LITERAL 14900019 DC C'PAUS' 14910019 DC AL1(DEFSYMBL) NEST OPERATOR 14920019 DC AL2(LIN00031-IPDAGH) PAUSE 14930019 DC AL1(004) LENGTH OF LITERAL 14940019 DC C'PRIN' 14950019 DC AL1(DEFSYMBL) NEST OPERATOR 14960019 DC AL2(LIN00032-IPDAGH) PRINT 14970019 DC AL1(004) LENGTH OF LITERAL 14980019 DC C'PUNC' 14990019 DC AL1(DEFSYMBL) NEST OPERATOR 15000019 DC AL2(LIN00033-IPDAGH) PUNCH 15010019 DC AL1(004) LENGTH OF LITERAL 15020019 DC C'READ' 15030019 DC AL1(DEFSYMBL) NEST OPERATOR 15040019 DC AL2(LIN00034-IPDAGH) READ 15050019 DC AL1(004) LENGTH OF LITERAL 15060019 DC C'RETU' 15070019 DC AL1(DEFSYMBL) NEST OPERATOR 15080019 DC AL2(LIN00035-IPDAGH) RETURN 15090019 DC AL1(004) LENGTH OF LITERAL 15100019 DC C'REWI' 15110019 DC AL1(DEFSYMBL) NEST OPERATOR 15120019 DC AL2(LIN00036-IPDAGH) REWIND 15130019 DC AL1(004) LENGTH OF LITERAL 15140019 DC C'STOP' 15150019 DC AL1(DEFSYMBL) NEST OPERATOR 15160019 DC AL2(LIN00037-IPDAGH) STOP 15170019 DC AL1(004) LENGTH OF LITERAL 15180019 DC C'WRIT' 15190019 DC AL1(DEFSYMBL) NEST OPERATOR 15200019 DC AL2(LIN00038-IPDAGH) WRITE 15210019 TAB00004 DC AL1(004) LENGTH OF LONGEST TABLE ARG 15220019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 15230019 EJECT 15240019 *********************************************************************** 15250019 * * 15260019 *ASSIGN = 'GN' : *42 S *44 'TO' *33 N * 15270019 * * 15280019 * DEFINES THE ASSIGN STATEMENT. * 15290019 * * 15300019 *********************************************************************** 15310019 LIN00024 EQU * START OF DEFINITION 15320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 15330019 DC AL1(002) LENGTH OF LITERAL 15340019 DC C'GN' 15350019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 15360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 15370019 DC AL1(COD042) ERROR CODE 15380019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 15390019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 15400019 DC AL1(COD044) ERROR CODE 15410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 15420019 DC AL1(002) LENGTH OF LITERAL 15430019 DC C'TO' 15440019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 15450019 DC AL1(COD033) ERROR CODE 15460019 DC AL1(DEFNAME) NAME OPERATOR N 15470019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 15480019 EJECT 15490019 *********************************************************************** 15500019 * * 15510019 *BACKSPACE = 'SPACE' : DSREFNO * 15520019 * * 15530019 * DEFINES THE BACKSPACE STATEMENT. * 15540019 * * 15550019 *********************************************************************** 15560019 LIN00025 EQU * START OF DEFINITION 15570019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 15580019 DC AL1(005) LENGTH OF LITERAL 15590019 DC C'SPACE' 15600019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 15610019 DC AL1(DEFSYMBL) NEST OPERATOR 15620019 DC AL2(LIN00039-IPDAGH) DSREFNO 15630019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 15640019 EJECT 15650019 *********************************************************************** 15660019 * * 15670019 *DSREFNO = *27 < N ³ K / $105 > * 15680019 * * 15690019 * DEFINES DATA SET REFERENCE NUMBER. * 15700019 * ACTION CODE 105 ISSUES AN APPROPRIATE * 15710019 * MESSAGE IF THE K ALTERNATIVE ENCOUNTERS * 15720019 * ANY NUMERIC CONSTANT OTHER THAN A NON-ZERO * 15730019 * INTEGER LESS THAN OR EQUAL TO 99. * 15740019 * * 15750019 *********************************************************************** 15760019 LIN00039 EQU * START OF DEFINITION 15770019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 15780019 DC AL1(COD027) ERROR CODE 15790019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 15800019 DC AL1(ALT00067-LIN00039) FALSE DISP. 15810019 DC AL1(BRC00027-LIN00039) TRUE DISP. 15820019 DC AL1(DEFNAME) NAME OPERATOR N 15830019 ALT00067 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 15840019 DC AL1(ALT00068-LIN00039) FALSE DISP. 15850019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 15860019 DC AL1(DEFCOMIT) LOCAL COMMIT / 15870019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 15880019 DC AL1(ACT105) ACTION CODE 15890019 ALT00068 EQU * 15900019 BRC00027 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 15910019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 15920019 EJECT 15930019 *********************************************************************** 15940019 * * 15950019 *CALL = : *33 N ( '(' / *46 CALLARG ( ',' / * 15960019 * CALLARG ... ) *13 ')' ) * 15970019 * * 15980019 * DEFINES THE CALL STATEMENT. * 15990019 * * 16000019 *********************************************************************** 16010019 LIN00026 EQU * START OF DEFINITION 16020019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 16030019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 16040019 DC AL1(COD033) ERROR CODE 16050019 DC AL1(DEFNAME) NAME OPERATOR N 16060019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 16070019 DC AL1(PAR00026-LIN00026) POINT TO END OF OPT. ITEMS 16080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16090019 DC AL1(001) LENGTH OF LITERAL 16100019 DC C'(' 16110019 DC AL1(DEFCOMIT) LOCAL COMMIT / 16120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 16130019 DC AL1(COD046) ERROR CODE 16140019 DC AL1(DEFSYMBL) NEST OPERATOR 16150019 DC AL2(LIN00040-IPDAGH) CALLARG 16160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 16170019 DC AL1(PAR00027-LIN00026) POINT TO END OF OPT. ITEMS 16180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16190019 DC AL1(001) LENGTH OF LITERAL 16200019 DC C',' 16210019 DC AL1(DEFCOMIT) LOCAL COMMIT / 16220019 DC AL1(DEFSYMBL) NEST OPERATOR 16230019 DC AL2(LIN00040-IPDAGH) CALLARG 16240019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 16250019 PAR00027 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 16260019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 16270019 DC AL1(COD013) ERROR CODE 16280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16290019 DC AL1(001) LENGTH OF LITERAL 16300019 DC C')' 16310019 PAR00026 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 16320019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 16330019 EJECT 16340019 *********************************************************************** 16350019 * * 16360019 *CALLARG = < ARITHEXP ³ LOGICEXP ³ C ³ H ³ '&&' / *42 S > * 16370019 * * 16380019 * DEFINES THE FORMS PERMITTED FOR AN ACTUAL * 16390019 * ARGUMENT IN A CALL STATEMENT. * 16400019 * * 16410019 *********************************************************************** 16420019 LIN00040 EQU * START OF DEFINITION 16430019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 16440019 DC AL1(ALT00069-LIN00040) FALSE DISP. 16450019 DC AL1(BRC00028-LIN00040) TRUE DISP. 16460019 DC AL1(DEFSYMBL) NEST OPERATOR 16470019 DC AL2(LIN00007-IPDAGH) ARITHEXP 16480019 ALT00069 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 16490019 DC AL1(ALT00070-LIN00040) FALSE DISP. 16500019 DC AL1(DEFSYMBL) NEST OPERATOR 16510019 DC AL2(LIN00008-IPDAGH) LOGICEXP 16520019 ALT00070 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 16530019 DC AL1(ALT00071-LIN00040) FALSE DISP. 16540019 DC AL1(DEFCSTRG) CHARACTER STRING C 16550019 ALT00071 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 16560019 DC AL1(ALT00072-LIN00040) FALSE DISP. 16570019 DC AL1(DEFHOLLR) HOLLERITH OPERATOR H 16580019 ALT00072 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 16590019 DC AL1(ALT00073-LIN00040) FALSE DISP. 16600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16610019 DC AL1(001) LENGTH OF LITERAL 16620019 DC C'&&' 16630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 16640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 16650019 DC AL1(COD042) ERROR CODE 16660019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 16670019 ALT00073 EQU * 16680019 BRC00028 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 16690019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 16700019 EJECT 16710019 *********************************************************************** 16720019 * * 16730019 *CONTINUE = 'INUE' : * 16740019 * * 16750019 * DEFINES THE CONTINUE STATEMENT * 16760019 * * 16770019 *********************************************************************** 16780019 LIN00027 EQU * START OF DEFINITION 16790019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16800019 DC AL1(004) LENGTH OF LITERAL 16810019 DC C'INUE' 16820019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 16830019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 16840019 EJECT 16850019 *********************************************************************** 16860019 * * 16870019 *ENDFILE = 'ILE' : DSREFNO * 16880019 * * 16890019 * DEFINES THE ENDFILE STATEMENT. * 16900019 * * 16910019 *********************************************************************** 16920019 LIN00028 EQU * START OF DEFINITION 16930019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16940019 DC AL1(003) LENGTH OF LITERAL 16950019 DC C'ILE' 16960019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 16970019 DC AL1(DEFSYMBL) NEST OPERATOR 16980019 DC AL2(LIN00039-IPDAGH) DSREFNO 16990019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 17000019 EJECT 17010019 *********************************************************************** 17020019 * * 17030019 *FIND = : *30 '(' DSREFNO *61 '''' *7 ARITHEXP2 *13 ')' * 17040019 * * 17050019 * DEFINES THE FIND STATEMENT. THE FOUR * 17060019 * QUOTATION MARKS REPRESENT A LITERAL CONSISTING * 17070019 * OF ONE QUOTE IN THE SOURCE. * 17080019 * * 17090019 *********************************************************************** 17100019 LIN00029 EQU * START OF DEFINITION 17110019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 17120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17130019 DC AL1(COD030) ERROR CODE 17140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17150019 DC AL1(001) LENGTH OF LITERAL 17160019 DC C'(' 17170019 DC AL1(DEFSYMBL) NEST OPERATOR 17180019 DC AL2(LIN00039-IPDAGH) DSREFNO 17190019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17200019 DC AL1(COD061) ERROR CODE 17210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17220019 DC AL1(001) LENGTH OF LITERAL 17230019 DC C'''' 17240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17250019 DC AL1(COD007) ERROR CODE 17260019 DC AL1(DEFSYMBL) NEST OPERATOR 17270019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 17280019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17290019 DC AL1(COD013) ERROR CODE 17300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17310019 DC AL1(001) LENGTH OF LITERAL 17320019 DC C')' 17330019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 17340019 EJECT 17350019 *********************************************************************** 17360019 * * 17370019 *GOTO = : < '(' / *43 S ( ',' / S ... ) *13 ')' * 17380019 * *52 ',' *33 N ³ N / *52 ',' *30 '(' * 17390019 * *43 S ( ',' / S ... ) *13 ')' ³ / * 17400019 * *43 S > * 17410019 * * 17420019 * DEFINES THE THREE KINDS OF GOTO STATEMENT. * 17430019 * THESE ARE DEFINED IN THE ORDER: COMPUTED * 17440019 * GOTO, ASSIGNED GOTO, UNCONDITIONAL * 17450019 * GOTO. THIS ORDERING ALLOWS A COMMIT * 17460019 * TO PRECEDE THE S OPERATOR IN THE DEFINITION OF * 17470019 * THE UNCONDITIONAL GOTO. * 17480019 * * 17490019 *********************************************************************** 17500019 LIN00030 EQU * START OF DEFINITION 17510019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 17520019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 17530019 DC AL1(ALT00074-LIN00030) FALSE DISP. 17540019 DC AL1(BRC00029-LIN00030) TRUE DISP. 17550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17560019 DC AL1(001) LENGTH OF LITERAL 17570019 DC C'(' 17580019 DC AL1(DEFCOMIT) LOCAL COMMIT / 17590019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17600019 DC AL1(COD043) ERROR CODE 17610019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 17620019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 17630019 DC AL1(PAR00028-LIN00030) POINT TO END OF OPT. ITEMS 17640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17650019 DC AL1(001) LENGTH OF LITERAL 17660019 DC C',' 17670019 DC AL1(DEFCOMIT) LOCAL COMMIT / 17680019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 17690019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 17700019 PAR00028 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 17710019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17720019 DC AL1(COD013) ERROR CODE 17730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17740019 DC AL1(001) LENGTH OF LITERAL 17750019 DC C')' 17760019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17770019 DC AL1(COD052) ERROR CODE 17780019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17790019 DC AL1(001) LENGTH OF LITERAL 17800019 DC C',' 17810019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17820019 DC AL1(COD033) ERROR CODE 17830019 DC AL1(DEFNAME) NAME OPERATOR N 17840019 ALT00074 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 17850019 DC AL1(ALT00075-LIN00030) FALSE DISP. 17860019 DC AL1(DEFNAME) NAME OPERATOR N 17870019 DC AL1(DEFCOMIT) LOCAL COMMIT / 17880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17890019 DC AL1(COD052) ERROR CODE 17900019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17910019 DC AL1(001) LENGTH OF LITERAL 17920019 DC C',' 17930019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17940019 DC AL1(COD030) ERROR CODE 17950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 17960019 DC AL1(001) LENGTH OF LITERAL 17970019 DC C'(' 17980019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17990019 DC AL1(COD043) ERROR CODE 18000019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 18010019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 18020019 DC AL1(PAR00029-LIN00030) POINT TO END OF OPT. ITEMS 18030019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 18040019 DC AL1(001) LENGTH OF LITERAL 18050019 DC C',' 18060019 DC AL1(DEFCOMIT) LOCAL COMMIT / 18070019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 18080019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 18090019 PAR00029 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 18100019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 18110019 DC AL1(COD013) ERROR CODE 18120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 18130019 DC AL1(001) LENGTH OF LITERAL 18140019 DC C')' 18150019 ALT00075 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 18160019 DC AL1(ALT00076-LIN00030) FALSE DISP. 18170019 DC AL1(DEFCOMIT) LOCAL COMMIT / 18180019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 18190019 DC AL1(COD043) ERROR CODE 18200019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 18210019 ALT00076 EQU * 18220019 BRC00029 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 18230019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 18240019 EJECT 18250019 *********************************************************************** 18260019 * * 18270019 *PAUSE = 'E' : < C ³ ( D .5. ) > *129 $800 * 18280019 * * 18290019 * DEFINES THE PAUSE STATEMENT. * 18300019 * * 18310019 *********************************************************************** 18320019 LIN00031 EQU * START OF DEFINITION 18330019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 18340019 DC AL1(001) LENGTH OF LITERAL 18350019 DC C'E' 18360019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 18370019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 18380019 DC AL1(ALT00077-LIN00031) FALSE DISP. 18390019 DC AL1(BRC00030-LIN00031) TRUE DISP. 18400019 DC AL1(DEFCSTRG) CHARACTER STRING C 18410019 ALT00077 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 18420019 DC AL1(ALT00078-LIN00031) FALSE DISP. 18430019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 18440019 DC AL1(PAR00030-LIN00031) POINT TO END OF OPT. ITEMS 18450019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 18460019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 18470019 DC AL1(005) ITERATION COUNT 18480019 PAR00030 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 18490019 ALT00078 EQU * 18500019 BRC00030 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 18510019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 18520019 DC AL1(COD129) ERROR CODE 18530019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 18540019 DC AL1(ACT800) ACTION CODE 18550019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 18560019 EJECT 18570019 *********************************************************************** 18580019 * * 18590019 *PRINT = 'T' OLDIO * 18600019 * * 18610019 * DEFINES THE PRINT STATEMENT. * 18620019 * * 18630019 *********************************************************************** 18640019 LIN00032 EQU * START OF DEFINITION 18650019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 18660019 DC AL1(001) LENGTH OF LITERAL 18670019 DC C'T' 18680019 DC AL1(DEFSYMBL) NEST OPERATOR 18690019 DC AL2(LIN00041-IPDAGH) OLDIO 18700019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 18710019 EJECT 18720019 *********************************************************************** 18730019 * * 18740019 *OLDIO = : *133 < S ³ N > ( ',' / IOLIST ) * 18750019 * * 18760019 * DEFINES THE SYNTAX TO THE RIGHT OF THE KEYWORD * 18770019 * FOR PRINT, PUNCH, AND THE OLD FORM OF READ. * 18780019 * * 18790019 *********************************************************************** 18800019 LIN00041 EQU * START OF DEFINITION 18810019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 18820019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 18830019 DC AL1(COD133) ERROR CODE 18840019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 18850019 DC AL1(ALT00079-LIN00041) FALSE DISP. 18860019 DC AL1(BRC00031-LIN00041) TRUE DISP. 18870019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 18880019 ALT00079 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 18890019 DC AL1(ALT00080-LIN00041) FALSE DISP. 18900019 DC AL1(DEFNAME) NAME OPERATOR N 18910019 ALT00080 EQU * 18920019 BRC00031 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 18930019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 18940019 DC AL1(PAR00031-LIN00041) POINT TO END OF OPT. ITEMS 18950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 18960019 DC AL1(001) LENGTH OF LITERAL 18970019 DC C',' 18980019 DC AL1(DEFCOMIT) LOCAL COMMIT / 18990019 DC AL1(DEFSYMBL) NEST OPERATOR 19000019 DC AL2(LIN00042-IPDAGH) IOLIST 19010019 PAR00031 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 19020019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 19030019 EJECT 19040019 *********************************************************************** 19050019 * * 19060019 *IOLIST = *58 < IOVAR ³ PARENLIST > ( ',' / * 19070019 * < IOVAR ³ PARENLIST > ... ) * 19080019 * * 19090019 * DEFINES AN INPUT/OUTPUT LIST. * 19100019 * * 19110019 *********************************************************************** 19120019 LIN00042 EQU * START OF DEFINITION 19130019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 19140019 DC AL1(COD058) ERROR CODE 19150019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 19160019 DC AL1(ALT00081-LIN00042) FALSE DISP. 19170019 DC AL1(BRC00032-LIN00042) TRUE DISP. 19180019 DC AL1(DEFSYMBL) NEST OPERATOR 19190019 DC AL2(LIN00043-IPDAGH) IOVAR 19200019 ALT00081 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 19210019 DC AL1(ALT00082-LIN00042) FALSE DISP. 19220019 DC AL1(DEFSYMBL) NEST OPERATOR 19230019 DC AL2(LIN00044-IPDAGH) PARENLIST 19240019 ALT00082 EQU * 19250019 BRC00032 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 19260019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 19270019 DC AL1(PAR00032-LIN00042) POINT TO END OF OPT. ITEMS 19280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 19290019 DC AL1(001) LENGTH OF LITERAL 19300019 DC C',' 19310019 DC AL1(DEFCOMIT) LOCAL COMMIT / 19320019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 19330019 DC AL1(ALT00083-LIN00042) FALSE DISP. 19340019 DC AL1(BRC00033-LIN00042) TRUE DISP. 19350019 DC AL1(DEFSYMBL) NEST OPERATOR 19360019 DC AL2(LIN00043-IPDAGH) IOVAR 19370019 ALT00083 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 19380019 DC AL1(ALT00084-LIN00042) FALSE DISP. 19390019 DC AL1(DEFSYMBL) NEST OPERATOR 19400019 DC AL2(LIN00044-IPDAGH) PARENLIST 19410019 ALT00084 EQU * 19420019 BRC00033 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 19430019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 19440019 PAR00032 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 19450019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 19460019 EJECT 19470019 *********************************************************************** 19480019 * * 19490019 *IOVAR = N $600 ( '(' / $601 *7 ARITHEXP2 ( ',' * 19500019 * / $201 ARITHEXP2 ... ) *12 ')' ) * 19510019 * * 19520019 * DEFINES THE ITEMS WHICH MAKE UP INPUT/OUTPUT * 19530019 * LISTS. ACTION CODES 600 AND 601 ARE USED TO * 19540019 * SET A FLAG THAT CAN BE TESTED LATER TO DETERMINE * 19550019 * WHETHER THE LAST INPUT/OUTPUT VARIABLE * 19560019 * WAS SUBSCRIPTED. ACTION CODE 600 SETS * 19570019 * THIS FLAG TO "UNSUBSCRIPTED", AND ACTION CODE * 19580019 * 601 SETS IT TO "SUBSCRIPTED". ACTION CODE * 19590019 * 201 TESTS FOR TOO MANY SUBSCRIPTS. * 19600019 * * 19610019 *********************************************************************** 19620019 LIN00043 EQU * START OF DEFINITION 19630019 DC AL1(DEFNAME) NAME OPERATOR N 19640019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 19650019 DC AL1(ACT600) ACTION CODE 19660019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 19670019 DC AL1(PAR00033-LIN00043) POINT TO END OF OPT. ITEMS 19680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 19690019 DC AL1(001) LENGTH OF LITERAL 19700019 DC C'(' 19710019 DC AL1(DEFCOMIT) LOCAL COMMIT / 19720019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 19730019 DC AL1(ACT601) ACTION CODE 19740019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 19750019 DC AL1(COD007) ERROR CODE 19760019 DC AL1(DEFSYMBL) NEST OPERATOR 19770019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 19780019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 19790019 DC AL1(PAR00034-LIN00043) POINT TO END OF OPT. ITEMS 19800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 19810019 DC AL1(001) LENGTH OF LITERAL 19820019 DC C',' 19830019 DC AL1(DEFCOMIT) LOCAL COMMIT / 19840019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 19850019 DC AL1(ACT201) ACTION CODE 19860019 DC AL1(DEFSYMBL) NEST OPERATOR 19870019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 19880019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 19890019 PAR00034 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 19900019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 19910019 DC AL1(COD012) ERROR CODE 19920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 19930019 DC AL1(001) LENGTH OF LITERAL 19940019 DC C')' 19950019 PAR00033 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 19960019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 19970019 EJECT 19980019 *********************************************************************** 19990019 * * 20000019 *PARENLIST = '(' / *58 < IOVAR ³ PARENLIST > ( ',' * 20010019 * / *32 < IOVAR ( '=' / $602 < N ³ / * 20020019 * USNZINT > *52 ',' < N ³ / USNZINT > ( ',' < * 20030019 * N ³ / USNZINT > ) $603 ) ³ * 20040019 * PARENLIST > ... ) *12 ')' * 20050019 * * 20060019 * DEFINES THE PARENTHESIZED LIST THAT MAY BE * 20070019 * A MEMBER OF AN INPUT/OUTPUT LIST. THIS * 20080019 * COMPLICATED LOOKING DEFINITION IS BASICALLY * 20090019 * JUST: * 20100019 * * 20110019 * PARENLIST = '(' < IOVAR ³ PARENLIST > * 20120019 * ( ',' / < IOVAR ³ PARENLIST > ... ) ')' * 20130019 * * 20140019 * HOWEVER, THERE IS A LENGTHY OPTION AFTER * 20150019 * THE SECOND OCCURRENCE OF IOVAR. THE OPTION * 20160019 * DESCRIBES THE SYNTAX FOUND WHEN THE SOURCE * 20170019 * CONTAINS AN IMPLIED DO. THIS OPTION * 20180019 * BEGINS WITH THE LEFT PARENTHESIS ON THE SECOND * 20190019 * LINE AND ENDS WITH THE LAST RIGHT * 20200019 * PARENTHESIS ON THE FOURTH LINE. * 20210019 * * 20220019 * THE FIRST OCCURRENCE OF IOVAR DOES NOT * 20230019 * HAVE THE OPTION, BECAUSE AN IMPLIED * 20240019 * DO SPECIFICATION MAY NOT BE THE FIRST * 20250019 * ITEM INSIDE A PARENTHESIS. IF AN EQUAL * 20260019 * SIGN IS ENCOUNTERED AFTER SOME INPUT/OUTPUT * 20270019 * VARIABLE AFTER THE FIRST VARIABLE OR PARENTHESIZED * 20280019 * LIST, THE OPTION IS COMMITTED. ACTION CODE * 20290019 * 602 IMMEDIATELY CHECKS THE FLAG SET BY * 20300019 * ACTION CODES 600 AND 601 TO SEE WHETHER * 20310019 * THE VARIABLE PRECEDING THE EQUAL SIGN * 20320019 * WAS SUBSCRIPTED. IF IT WAS, AN APPROPRIATE * 20330019 * ERROR MESSAGE IS ISSUED. THEN THE * 20340019 * PARAMETERS OF THE IMPLIED DO ARE CHECKED. * 20350019 * THERE MUST BE A PARENTHESIS IMMEDIATELY * 20360019 * AFTER AN IMPLIED DO SPECIFICATION. ACTION * 20370019 * CODE 603 CHECKS FOR THIS PARENTHESIS AND ISSUES * 20380019 * AN APPROPRIATE MESSAGE IF IT IS ABSENT, BUT * 20390019 * DOES NOT ADVANCE THE SOURCE POINTER, ALLOWING * 20400019 * THE RIGHT PARENTHESIS LITERAL AT THE * 20410019 * END OF THE DEFINITION TO BE * 20420019 * MATCHED IF THE RIGHT PARENTHESIS IS * 20430019 * PRESENT. ANY OTHER METHOD OF CHECKING * 20440019 * FOR THE RIGHT PARENTHESIS WOULD ADVANCE * 20450019 * THE SOURCE POINTER AND CAUSE A FAILURE * 20460019 * ON THE RIGHT PARENTHESIS LITERAL AT THE * 20470019 * END OF THE DEFINITION. * 20480019 * * 20490019 *********************************************************************** 20500019 LIN00044 EQU * START OF DEFINITION 20510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20520019 DC AL1(001) LENGTH OF LITERAL 20530019 DC C'(' 20540019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20550019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 20560019 DC AL1(COD058) ERROR CODE 20570019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 20580019 DC AL1(ALT00085-LIN00044) FALSE DISP. 20590019 DC AL1(BRC00034-LIN00044) TRUE DISP. 20600019 DC AL1(DEFSYMBL) NEST OPERATOR 20610019 DC AL2(LIN00043-IPDAGH) IOVAR 20620019 ALT00085 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 20630019 DC AL1(ALT00086-LIN00044) FALSE DISP. 20640019 DC AL1(DEFSYMBL) NEST OPERATOR 20650019 DC AL2(LIN00044-IPDAGH) PARENLIST 20660019 ALT00086 EQU * 20670019 BRC00034 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 20680019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 20690019 DC AL1(PAR00035-LIN00044) POINT TO END OF OPT. ITEMS 20700019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20710019 DC AL1(001) LENGTH OF LITERAL 20720019 DC C',' 20730019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20740019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 20750019 DC AL1(COD032) ERROR CODE 20760019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 20770019 DC AL1(ALT00087-LIN00044) FALSE DISP. 20780019 DC AL1(BRC00035-LIN00044) TRUE DISP. 20790019 DC AL1(DEFSYMBL) NEST OPERATOR 20800019 DC AL2(LIN00043-IPDAGH) IOVAR 20810019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 20820019 DC AL1(PAR00036-LIN00044) POINT TO END OF OPT. ITEMS 20830019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20840019 DC AL1(001) LENGTH OF LITERAL 20850019 DC C'=' 20860019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20870019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 20880019 DC AL1(ACT602) ACTION CODE 20890019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 20900019 DC AL1(ALT00088-LIN00044) FALSE DISP. 20910019 DC AL1(BRC00036-LIN00044) TRUE DISP. 20920019 DC AL1(DEFNAME) NAME OPERATOR N 20930019 ALT00088 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 20940019 DC AL1(ALT00089-LIN00044) FALSE DISP. 20950019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20960019 DC AL1(DEFSYMBL) NEST OPERATOR 20970019 DC AL2(LIN00005-IPDAGH) USNZINT 20980019 ALT00089 EQU * 20990019 BRC00036 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 21010019 DC AL1(COD052) ERROR CODE 21020019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21030019 DC AL1(001) LENGTH OF LITERAL 21040019 DC C',' 21050019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 21060019 DC AL1(ALT00090-LIN00044) FALSE DISP. 21070019 DC AL1(BRC00037-LIN00044) TRUE DISP. 21080019 DC AL1(DEFNAME) NAME OPERATOR N 21090019 ALT00090 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 21100019 DC AL1(ALT00091-LIN00044) FALSE DISP. 21110019 DC AL1(DEFCOMIT) LOCAL COMMIT / 21120019 DC AL1(DEFSYMBL) NEST OPERATOR 21130019 DC AL2(LIN00005-IPDAGH) USNZINT 21140019 ALT00091 EQU * 21150019 BRC00037 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 21170019 DC AL1(PAR00037-LIN00044) POINT TO END OF OPT. ITEMS 21180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21190019 DC AL1(001) LENGTH OF LITERAL 21200019 DC C',' 21210019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 21220019 DC AL1(ALT00092-LIN00044) FALSE DISP. 21230019 DC AL1(BRC00038-LIN00044) TRUE DISP. 21240019 DC AL1(DEFNAME) NAME OPERATOR N 21250019 ALT00092 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 21260019 DC AL1(ALT00093-LIN00044) FALSE DISP. 21270019 DC AL1(DEFCOMIT) LOCAL COMMIT / 21280019 DC AL1(DEFSYMBL) NEST OPERATOR 21290019 DC AL2(LIN00005-IPDAGH) USNZINT 21300019 ALT00093 EQU * 21310019 BRC00038 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21320019 PAR00037 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 21330019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 21340019 DC AL1(ACT603) ACTION CODE 21350019 PAR00036 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 21360019 ALT00087 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 21370019 DC AL1(ALT00094-LIN00044) FALSE DISP. 21380019 DC AL1(DEFSYMBL) NEST OPERATOR 21390019 DC AL2(LIN00044-IPDAGH) PARENLIST 21400019 ALT00094 EQU * 21410019 BRC00035 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21420019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 21430019 PAR00035 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 21440019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 21450019 DC AL1(COD012) ERROR CODE 21460019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21470019 DC AL1(001) LENGTH OF LITERAL 21480019 DC C')' 21490019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 21500019 EJECT 21510019 *********************************************************************** 21520019 * * 21530019 *PUNCH = 'H' OLDIO * 21540019 * * 21550019 * DEFINES THE PUNCH STATEMENT. * 21560019 * * 21570019 *********************************************************************** 21580019 LIN00033 EQU * START OF DEFINITION 21590019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21600019 DC AL1(001) LENGTH OF LITERAL 21610019 DC C'H' 21620019 DC AL1(DEFSYMBL) NEST OPERATOR 21630019 DC AL2(LIN00041-IPDAGH) OLDIO 21640019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 21650019 EJECT 21660019 *********************************************************************** 21670019 * * 21680019 *READ = < ª'(' OLDIO ³ NEWIO > * 21690019 * * 21700019 * DEFINES READ STATEMENTS. IF THERE IS NOT * 21710019 * A LEFT PARENTHESIS AFTER THE READ, THE * 21720019 * STATEMENT IS THE OLD FORM OF READ. * 21730019 * * 21740019 *********************************************************************** 21750019 LIN00034 EQU * START OF DEFINITION 21760019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 21770019 DC AL1(ALT00095-LIN00034) FALSE DISP. 21780019 DC AL1(BRC00039-LIN00034) TRUE DISP. 21790019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 21800019 DC AL1(001) LENGTH OF LITERAL 21810019 DC C'(' 21820019 DC AL1(DEFSYMBL) NEST OPERATOR 21830019 DC AL2(LIN00041-IPDAGH) OLDIO 21840019 ALT00095 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 21850019 DC AL1(ALT00096-LIN00034) FALSE DISP. 21860019 DC AL1(DEFSYMBL) NEST OPERATOR 21870019 DC AL2(LIN00045-IPDAGH) NEWIO 21880019 ALT00096 EQU * 21890019 BRC00039 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21900019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 21910019 EJECT 21920019 *********************************************************************** 21930019 * * 21940019 *NEWIO = : *30 '(' DSREFNO ( '''' / *7 ARITHEXP2 ) * 21950019 * ( ',' < S ³ N ª'=' > ) ( < *42 ',END=' / S * 21960019 * ( ',ERR=' / S ) ³ ',ERR=' / S ( ',END=' * 21970019 * / S ) > ) *13 ')' ( IOLIST ) * 21980019 * * 21990019 * DEFINES THE FORM OF EITHER READ (NEW FORM) * 22000019 * OR WRITE AFTER THE KEYWORD. THIS DEFINITION * 22010019 * ENCOMPASSES SEQUENTIAL OR DIRECT ACCESS, * 22020019 * FORMATTED OR UNFORMATTED, READ AND WRITE * 22030019 * STATEMENTS. ANY OF THESE STATEMENTS MAY * 22040019 * HAVE THE ERR= AND END= PARAMETERS, * 22050019 * ALTHOUGH NO INTERPRETATION IS GIVEN EITHER * 22060019 * PARAMETER IN ANY WRITE, AND THE END= PARAMETER * 22070019 * HAS NO INTERPRETATION IN A DIRECT ACCESS READ. * 22080019 * THE IOLIST IS OPTIONAL IN ALL FORMS. * 22090019 * THE DEFINITION IS MADE COMPLICATED BY * 22100019 * THE FACT THAT WHEN BOTH END= AND * 22110019 * ERR= OCCUR, EITHER ONE MAY OCCUR FIRST. * 22120019 * * 22130019 *********************************************************************** 22140019 LIN00045 EQU * START OF DEFINITION 22150019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 22160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 22170019 DC AL1(COD030) ERROR CODE 22180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22190019 DC AL1(001) LENGTH OF LITERAL 22200019 DC C'(' 22210019 DC AL1(DEFSYMBL) NEST OPERATOR 22220019 DC AL2(LIN00039-IPDAGH) DSREFNO 22230019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22240019 DC AL1(PAR00038-LIN00045) POINT TO END OF OPT. ITEMS 22250019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22260019 DC AL1(001) LENGTH OF LITERAL 22270019 DC C'''' 22280019 DC AL1(DEFCOMIT) LOCAL COMMIT / 22290019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 22300019 DC AL1(COD007) ERROR CODE 22310019 DC AL1(DEFSYMBL) NEST OPERATOR 22320019 DC AL2(LIN00006-IPDAGH) ARITHEXP2 22330019 PAR00038 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 22340019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22350019 DC AL1(PAR00039-LIN00045) POINT TO END OF OPT. ITEMS 22360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22370019 DC AL1(001) LENGTH OF LITERAL 22380019 DC C',' 22390019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 22400019 DC AL1(ALT00097-LIN00045) FALSE DISP. 22410019 DC AL1(BRC00040-LIN00045) TRUE DISP. 22420019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 22430019 ALT00097 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 22440019 DC AL1(ALT00098-LIN00045) FALSE DISP. 22450019 DC AL1(DEFNAME) NAME OPERATOR N 22460019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 22470019 DC AL1(001) LENGTH OF LITERAL 22480019 DC C'=' 22490019 ALT00098 EQU * 22500019 BRC00040 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 22510019 PAR00039 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 22520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22530019 DC AL1(PAR00040-LIN00045) POINT TO END OF OPT. ITEMS 22540019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 22550019 DC AL1(ALT00099-LIN00045) FALSE DISP. 22560019 DC AL1(BRC00041-LIN00045) TRUE DISP. 22570019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 22580019 DC AL1(COD042) ERROR CODE 22590019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22600019 DC AL1(005) LENGTH OF LITERAL 22610019 DC C',END=' 22620019 DC AL1(DEFCOMIT) LOCAL COMMIT / 22630019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 22640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22650019 DC AL1(PAR00041-LIN00045) POINT TO END OF OPT. ITEMS 22660019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22670019 DC AL1(005) LENGTH OF LITERAL 22680019 DC C',ERR=' 22690019 DC AL1(DEFCOMIT) LOCAL COMMIT / 22700019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 22710019 PAR00041 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 22720019 ALT00099 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 22730019 DC AL1(ALT00100-LIN00045) FALSE DISP. 22740019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22750019 DC AL1(005) LENGTH OF LITERAL 22760019 DC C',ERR=' 22770019 DC AL1(DEFCOMIT) LOCAL COMMIT / 22780019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 22790019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22800019 DC AL1(PAR00042-LIN00045) POINT TO END OF OPT. ITEMS 22810019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22820019 DC AL1(005) LENGTH OF LITERAL 22830019 DC C',END=' 22840019 DC AL1(DEFCOMIT) LOCAL COMMIT / 22850019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 22860019 PAR00042 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 22870019 ALT00100 EQU * 22880019 BRC00041 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 22890019 PAR00040 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 22900019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 22910019 DC AL1(COD013) ERROR CODE 22920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 22930019 DC AL1(001) LENGTH OF LITERAL 22940019 DC C')' 22950019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 22960019 DC AL1(PAR00043-LIN00045) POINT TO END OF OPT. ITEMS 22970019 DC AL1(DEFSYMBL) NEST OPERATOR 22980019 DC AL2(LIN00042-IPDAGH) IOLIST 22990019 PAR00043 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 23000019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 23010019 EJECT 23020019 *********************************************************************** 23030019 * * 23040019 *RETURN = 'RN' : ( < N ³ USNZINT > ) * 23050019 * * 23060019 * DEFINES THE RETURN STATEMENT. THE * 23070019 * RETURN I FORM IS ALWAYS PERMITTED BECAUSE * 23080019 * THE SYNTAX CHECKER HAS NO INFORMATION * 23090019 * AVAILABLE REGARDING THE KIND OF PROGRAM * 23100019 * UNIT THE RETURN OCCURS IN. * 23110019 * * 23120019 *********************************************************************** 23130019 LIN00035 EQU * START OF DEFINITION 23140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 23150019 DC AL1(002) LENGTH OF LITERAL 23160019 DC C'RN' 23170019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 23180019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 23190019 DC AL1(PAR00044-LIN00035) POINT TO END OF OPT. ITEMS 23200019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 23210019 DC AL1(ALT00101-LIN00035) FALSE DISP. 23220019 DC AL1(BRC00042-LIN00035) TRUE DISP. 23230019 DC AL1(DEFNAME) NAME OPERATOR N 23240019 ALT00101 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 23250019 DC AL1(ALT00102-LIN00035) FALSE DISP. 23260019 DC AL1(DEFSYMBL) NEST OPERATOR 23270019 DC AL2(LIN00005-IPDAGH) USNZINT 23280019 ALT00102 EQU * 23290019 BRC00042 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 23300019 PAR00044 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 23310019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 23320019 EJECT 23330019 *********************************************************************** 23340019 * * 23350019 *REWIND = 'ND' : DSREFNO * 23360019 * * 23370019 * DEFINES THE REWIND STATEMENT. * 23380019 * * 23390019 *********************************************************************** 23400019 LIN00036 EQU * START OF DEFINITION 23410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 23420019 DC AL1(002) LENGTH OF LITERAL 23430019 DC C'ND' 23440019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 23450019 DC AL1(DEFSYMBL) NEST OPERATOR 23460019 DC AL2(LIN00039-IPDAGH) DSREFNO 23470019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 23480019 EJECT 23490019 *********************************************************************** 23500019 * * 23510019 *STOP = : ( D .5. ) *129 $800 * 23520019 * * 23530019 * DEFINES THE STOP STATEMENT. * 23540019 * * 23550019 *********************************************************************** 23560019 LIN00037 EQU * START OF DEFINITION 23570019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 23580019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 23590019 DC AL1(PAR00045-LIN00037) POINT TO END OF OPT. ITEMS 23600019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 23610019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 23620019 DC AL1(005) ITERATION COUNT 23630019 PAR00045 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 23640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 23650019 DC AL1(COD129) ERROR CODE 23660019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 23670019 DC AL1(ACT800) ACTION CODE 23680019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 23690019 EJECT 23700019 *********************************************************************** 23710019 * * 23720019 *WRITE = 'E' NEWIO * 23730019 * * 23740019 * DEFINES THE WRITE STATEMENT. * 23750019 * * 23760019 *********************************************************************** 23770019 LIN00038 EQU * START OF DEFINITION 23780019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 23790019 DC AL1(001) LENGTH OF LITERAL 23800019 DC C'E' 23810019 DC AL1(DEFSYMBL) NEST OPERATOR 23820019 DC AL2(LIN00045-IPDAGH) NEWIO 23830019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 23840019 EJECT 23850019 *********************************************************************** 23860019 * * 23870019 *OTHERKW = " 'AT' AT 'BLOC' BLOCKDATA 'COMM' COMMON * 23880019 * 'COMP' COMPLEX 'DATA' DATA 'DEBU' DEBUG * 23890019 * 'DEFI' DEFINEFILE 'DIME' DIMENSION 'DISP' DISPLAY * 23900019 * 'DOUB' DOUBLE 'END' END 'ENTR' ENTRY * 23910019 * 'EQUI' EQUIVALENCE 'EXTE' EXTERNAL 'FORM' FORMAT * 23920019 * 'FUNC' FUNCTION 'IMPL' IMPLICIT 'INTE' INTEGER * 23930019 * 'LOGI' LOGICAL 'NAME' NAMELIST 'REAL' REAL * 23940019 * 'SUBR' SUBROUTINE 'TRAC' TRACE " * 23950019 * * 23960019 * TABLE OF ALL KEYWORDS THAT CANNOT FOLLOW * 23970019 * A LOGICAL IF. FOR EACH OF THE ENTRIES, * 23980019 * A MATCH WITH THE LITERAL RESULTS IN A * 23990019 * TRANSFER TO THE APPROPRIATE SYNTACTIC LINE. * 24000019 * * 24010019 *********************************************************************** 24020019 LIN00021 EQU * START OF DEFINITION 24030019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 24040019 DC AL2(TAB00005-*+1) LENGTH OF TABLE 24050019 DC AL1(002) LENGTH OF LITERAL 24060019 DC C'AT' 24070019 DC AL1(DEFSYMBL) NEST OPERATOR 24080019 DC AL2(LIN00046-IPDAGH) AT 24090019 DC AL1(004) LENGTH OF LITERAL 24100019 DC C'BLOC' 24110019 DC AL1(DEFSYMBL) NEST OPERATOR 24120019 DC AL2(LIN00047-IPDAGH) BLOCKDATA 24130019 DC AL1(004) LENGTH OF LITERAL 24140019 DC C'COMM' 24150019 DC AL1(DEFSYMBL) NEST OPERATOR 24160019 DC AL2(LIN00048-IPDAGH) COMMON 24170019 DC AL1(004) LENGTH OF LITERAL 24180019 DC C'COMP' 24190019 DC AL1(DEFSYMBL) NEST OPERATOR 24200019 DC AL2(LIN00049-IPDAGH) COMPLEX 24210019 DC AL1(004) LENGTH OF LITERAL 24220019 DC C'DATA' 24230019 DC AL1(DEFSYMBL) NEST OPERATOR 24240019 DC AL2(LIN00050-IPDAGH) DATA 24250019 DC AL1(004) LENGTH OF LITERAL 24260019 DC C'DEBU' 24270019 DC AL1(DEFSYMBL) NEST OPERATOR 24280019 DC AL2(LIN00051-IPDAGH) DEBUG 24290019 DC AL1(004) LENGTH OF LITERAL 24300019 DC C'DEFI' 24310019 DC AL1(DEFSYMBL) NEST OPERATOR 24320019 DC AL2(LIN00052-IPDAGH) DEFINEFILE 24330019 DC AL1(004) LENGTH OF LITERAL 24340019 DC C'DIME' 24350019 DC AL1(DEFSYMBL) NEST OPERATOR 24360019 DC AL2(LIN00053-IPDAGH) DIMENSION 24370019 DC AL1(004) LENGTH OF LITERAL 24380019 DC C'DISP' 24390019 DC AL1(DEFSYMBL) NEST OPERATOR 24400019 DC AL2(LIN00054-IPDAGH) DISPLAY 24410019 DC AL1(004) LENGTH OF LITERAL 24420019 DC C'DOUB' 24430019 DC AL1(DEFSYMBL) NEST OPERATOR 24440019 DC AL2(LIN00055-IPDAGH) DOUBLE 24450019 DC AL1(003) LENGTH OF LITERAL 24460019 DC C'END' 24470019 DC AL1(DEFSYMBL) NEST OPERATOR 24480019 DC AL2(LIN00056-IPDAGH) END 24490019 DC AL1(004) LENGTH OF LITERAL 24500019 DC C'ENTR' 24510019 DC AL1(DEFSYMBL) NEST OPERATOR 24520019 DC AL2(LIN00057-IPDAGH) ENTRY 24530019 DC AL1(004) LENGTH OF LITERAL 24540019 DC C'EQUI' 24550019 DC AL1(DEFSYMBL) NEST OPERATOR 24560019 DC AL2(LIN00058-IPDAGH) EQUIVALENCE 24570019 DC AL1(004) LENGTH OF LITERAL 24580019 DC C'EXTE' 24590019 DC AL1(DEFSYMBL) NEST OPERATOR 24600019 DC AL2(LIN00059-IPDAGH) EXTERNAL 24610019 DC AL1(004) LENGTH OF LITERAL 24620019 DC C'FORM' 24630019 DC AL1(DEFSYMBL) NEST OPERATOR 24640019 DC AL2(LIN00060-IPDAGH) FORMAT 24650019 DC AL1(004) LENGTH OF LITERAL 24660019 DC C'FUNC' 24670019 DC AL1(DEFSYMBL) NEST OPERATOR 24680019 DC AL2(LIN00061-IPDAGH) FUNCTION 24690019 DC AL1(004) LENGTH OF LITERAL 24700019 DC C'IMPL' 24710019 DC AL1(DEFSYMBL) NEST OPERATOR 24720019 DC AL2(LIN00062-IPDAGH) IMPLICIT 24730019 DC AL1(004) LENGTH OF LITERAL 24740019 DC C'INTE' 24750019 DC AL1(DEFSYMBL) NEST OPERATOR 24760019 DC AL2(LIN00063-IPDAGH) INTEGER 24770019 DC AL1(004) LENGTH OF LITERAL 24780019 DC C'LOGI' 24790019 DC AL1(DEFSYMBL) NEST OPERATOR 24800019 DC AL2(LIN00064-IPDAGH) LOGICAL 24810019 DC AL1(004) LENGTH OF LITERAL 24820019 DC C'NAME' 24830019 DC AL1(DEFSYMBL) NEST OPERATOR 24840019 DC AL2(LIN00065-IPDAGH) NAMELIST 24850019 DC AL1(004) LENGTH OF LITERAL 24860019 DC C'REAL' 24870019 DC AL1(DEFSYMBL) NEST OPERATOR 24880019 DC AL2(LIN00066-IPDAGH) REAL 24890019 DC AL1(004) LENGTH OF LITERAL 24900019 DC C'SUBR' 24910019 DC AL1(DEFSYMBL) NEST OPERATOR 24920019 DC AL2(LIN00067-IPDAGH) SUBROUTINE 24930019 DC AL1(004) LENGTH OF LITERAL 24940019 DC C'TRAC' 24950019 DC AL1(DEFSYMBL) NEST OPERATOR 24960019 DC AL2(LIN00068-IPDAGH) TRACE 24970019 TAB00005 DC AL1(004) LENGTH OF LONGEST TABLE ARG 24980019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 24990019 EJECT 25000019 *********************************************************************** 25010019 * * 25020019 *AT = : $400 *43 S * 25030019 * * 25040019 * DEFINES THE AT STATEMENT. * 25050019 * SINCE THE AT STATEMENT IS PART OF THE DEBUG * 25060019 * FACILITY AVAILABLE ONLY IN FORTRAN G, ACTION * 25070019 * CODE 400 IS USED TO CHECK THAT THE * 25080019 * SYNTAX DESIRED IS THAT OF FORTRAN G, AND * 25090019 * ISSUE AN APPROPRIATE MESSAGE IF THE * 25100019 * SYNTAX DESIRED WAS THAT OF FORTRAN H. * 25110019 * THE MESSAGE ISSUED IS "DEBUG FACILITY * 25120019 * NOT SUPPORTED". * 25130019 * * 25140019 *********************************************************************** 25150019 LIN00046 EQU * START OF DEFINITION 25160019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 25170019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 25180019 DC AL1(ACT400) ACTION CODE 25190019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 25200019 DC AL1(COD043) ERROR CODE 25210019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 25220019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 25230019 EJECT 25240019 *********************************************************************** 25250019 * * 25260019 *BLOCKDATA = 'KDATA' : * 25270019 * * 25280019 * DEFINES THE BLOCK DATA STATEMENT. * 25290019 * * 25300019 *********************************************************************** 25310019 LIN00047 EQU * START OF DEFINITION 25320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 25330019 DC AL1(005) LENGTH OF LITERAL 25340019 DC C'KDATA' 25350019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 25360019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 25370019 EJECT 25380019 *********************************************************************** 25390019 * * 25400019 *COMMON = 'ON' : ( COMMONLABEL ) *33 N ( DECLARATOR2 ) ( ',' * 25410019 * / N ( DECLARATOR2 ) ... ) ( COMMONLABEL * 25420019 * / N ( DECLARATOR2 ) ( ',' / N * 25430019 * ( DECLARATOR2 ) ... ) ... ) * 25440019 * * 25450019 * DEFINES THE COMMON STATEMENT. * 25460019 * * 25470019 *********************************************************************** 25480019 LIN00048 EQU * START OF DEFINITION 25490019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 25500019 DC AL1(002) LENGTH OF LITERAL 25510019 DC C'ON' 25520019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 25530019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25540019 DC AL1(PAR00046-LIN00048) POINT TO END OF OPT. ITEMS 25550019 DC AL1(DEFSYMBL) NEST OPERATOR 25560019 DC AL2(LIN00069-IPDAGH) COMMONLABEL 25570019 PAR00046 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 25580019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 25590019 DC AL1(COD033) ERROR CODE 25600019 DC AL1(DEFNAME) NAME OPERATOR N 25610019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25620019 DC AL1(PAR00047-LIN00048) POINT TO END OF OPT. ITEMS 25630019 DC AL1(DEFSYMBL) NEST OPERATOR 25640019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 25650019 PAR00047 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 25660019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25670019 DC AL1(PAR00048-LIN00048) POINT TO END OF OPT. ITEMS 25680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 25690019 DC AL1(001) LENGTH OF LITERAL 25700019 DC C',' 25710019 DC AL1(DEFCOMIT) LOCAL COMMIT / 25720019 DC AL1(DEFNAME) NAME OPERATOR N 25730019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25740019 DC AL1(PAR00049-LIN00048) POINT TO END OF OPT. ITEMS 25750019 DC AL1(DEFSYMBL) NEST OPERATOR 25760019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 25770019 PAR00049 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 25780019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 25790019 PAR00048 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 25800019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25810019 DC AL1(PAR00050-LIN00048) POINT TO END OF OPT. ITEMS 25820019 DC AL1(DEFSYMBL) NEST OPERATOR 25830019 DC AL2(LIN00069-IPDAGH) COMMONLABEL 25840019 DC AL1(DEFCOMIT) LOCAL COMMIT / 25850019 DC AL1(DEFNAME) NAME OPERATOR N 25860019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25870019 DC AL1(PAR00051-LIN00048) POINT TO END OF OPT. ITEMS 25880019 DC AL1(DEFSYMBL) NEST OPERATOR 25890019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 25900019 PAR00051 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 25910019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25920019 DC AL1(PAR00052-LIN00048) POINT TO END OF OPT. ITEMS 25930019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 25940019 DC AL1(001) LENGTH OF LITERAL 25950019 DC C',' 25960019 DC AL1(DEFCOMIT) LOCAL COMMIT / 25970019 DC AL1(DEFNAME) NAME OPERATOR N 25980019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 25990019 DC AL1(PAR00053-LIN00048) POINT TO END OF OPT. ITEMS 26000019 DC AL1(DEFSYMBL) NEST OPERATOR 26010019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 26020019 PAR00053 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 26030019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 26040019 PAR00052 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 26050019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 26060019 PAR00050 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 26070019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 26080019 EJECT 26090019 *********************************************************************** 26100019 * * 26110019 *COMMONLABEL = *38 '/' / ( N ) '/' * 26120019 * * 26130019 * DEFINES THE FORM OF THE LABEL OF A COMMON * 26140019 * IN A COMMON STATEMENT. THE NAME WILL * 26150019 * BE ABSENT WHEN THE SOURCE IS DESCRIBING * 26160019 * BLANK COMMON. * 26170019 * * 26180019 *********************************************************************** 26190019 LIN00069 EQU * START OF DEFINITION 26200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 26210019 DC AL1(COD038) ERROR CODE 26220019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26230019 DC AL1(001) LENGTH OF LITERAL 26240019 DC C'/' 26250019 DC AL1(DEFCOMIT) LOCAL COMMIT / 26260019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 26270019 DC AL1(PAR00054-LIN00069) POINT TO END OF OPT. ITEMS 26280019 DC AL1(DEFNAME) NAME OPERATOR N 26290019 PAR00054 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 26300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26310019 DC AL1(001) LENGTH OF LITERAL 26320019 DC C'/' 26330019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 26340019 EJECT 26350019 *********************************************************************** 26360019 * * 26370019 *DECLARATOR2 = '(' / USNZINT ( ',' / $201 USNZINT * 26380019 * ... ) *12 ')' * 26390019 * * 26400019 * DEFINES ARRAY DECLARATORS WITH CONSTANT * 26410019 * DIMENSIONS. THIS KIND OF DECLARATOR IS * 26420019 * USED IN STATEMENTS (SUCH AS COMMON * 26430019 * AND EQUIVALENCE STATEMENTS) WHICH DO * 26440019 * NOT PERMIT VARIABLY DIMENSIONED ARRAYS. * 26450019 * * 26460019 *********************************************************************** 26470019 LIN00070 EQU * START OF DEFINITION 26480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26490019 DC AL1(001) LENGTH OF LITERAL 26500019 DC C'(' 26510019 DC AL1(DEFCOMIT) LOCAL COMMIT / 26520019 DC AL1(DEFSYMBL) NEST OPERATOR 26530019 DC AL2(LIN00005-IPDAGH) USNZINT 26540019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 26550019 DC AL1(PAR00055-LIN00070) POINT TO END OF OPT. ITEMS 26560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26570019 DC AL1(001) LENGTH OF LITERAL 26580019 DC C',' 26590019 DC AL1(DEFCOMIT) LOCAL COMMIT / 26600019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 26610019 DC AL1(ACT201) ACTION CODE 26620019 DC AL1(DEFSYMBL) NEST OPERATOR 26630019 DC AL2(LIN00005-IPDAGH) USNZINT 26640019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 26650019 PAR00055 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 26660019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 26670019 DC AL1(COD012) ERROR CODE 26680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26690019 DC AL1(001) LENGTH OF LITERAL 26700019 DC C')' 26710019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 26720019 EJECT 26730019 *********************************************************************** 26740019 * * 26750019 *COMPLEX = 'LEX' < 'FUNCTION' : *33 N CLENGTH * 26760019 * FUNCTIONARGS ³ '*' ( D ... ) 'FUNCTION' : * 26770019 * *134 $801 *33 N CLENGTH FUNCTIONARGS ³ * 26780019 * : CLENGTH *32 N CLENGTH ( < ( DECLARATOR3 ) * 26790019 * CDATA ³ DECLARATOR / *125 ª'/' > ) ( ',' * 26800019 * / *32 N CLENGTH ( < ( DECLARATOR3 ) CDATA * 26810019 * ³ DECLARATOR / *125 ª'/' > ) ... ) > * 26820019 * * 26830019 * DEFINES THE COMPLEX FUNCTION STATEMENT AND * 26840019 * THE COMPLEX TYPE-STATEMENT. * 26850019 * * 26860019 * SINCE DECLARATOR IS TESTED AFTER DECLARATOR3, * 26870019 * DECLARATOR WILL BE SATISFIED IF AND ONLY IF * 26880019 * THE ARRAY HAS A DUMMY DIMENSION. IN SUCH A * 26890019 * CASE, NO DATA-VALUE-INITIALIZATION LIST IS * 26900019 * ALLOWED, AND THE ª'/' TESTS FOR AND DIAGNOSES * 26910019 * THE PRESENCE OF THE START OF SUCH A LIST. * 26920019 * * 26930019 *********************************************************************** 26940019 LIN00049 EQU * START OF DEFINITION 26950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 26960019 DC AL1(003) LENGTH OF LITERAL 26970019 DC C'LEX' 26980019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 26990019 DC AL1(ALT00103-LIN00049) FALSE DISP. 27000019 DC AL1(BRC00043-LIN00049) TRUE DISP. 27010019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 27020019 DC AL1(008) LENGTH OF LITERAL 27030019 DC C'FUNCTION' 27040019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 27050019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27060019 DC AL1(COD033) ERROR CODE 27070019 DC AL1(DEFNAME) NAME OPERATOR N 27080019 DC AL1(DEFSYMBL) NEST OPERATOR 27090019 DC AL2(LIN00071-IPDAGH) CLENGTH 27100019 DC AL1(DEFSYMBL) NEST OPERATOR 27110019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 27120019 ALT00103 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 27130019 DC AL1(ALT00104-LIN00049) FALSE DISP. 27140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 27150019 DC AL1(001) LENGTH OF LITERAL 27160019 DC C'*' 27170019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27180019 DC AL1(PAR00056-LIN00049) POINT TO END OF OPT. ITEMS 27190019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 27200019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 27210019 PAR00056 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 27220019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 27230019 DC AL1(008) LENGTH OF LITERAL 27240019 DC C'FUNCTION' 27250019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 27260019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27270019 DC AL1(COD134) ERROR CODE 27280019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 27290019 DC AL1(ACT801) ACTION CODE 27300019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27310019 DC AL1(COD033) ERROR CODE 27320019 DC AL1(DEFNAME) NAME OPERATOR N 27330019 DC AL1(DEFSYMBL) NEST OPERATOR 27340019 DC AL2(LIN00071-IPDAGH) CLENGTH 27350019 DC AL1(DEFSYMBL) NEST OPERATOR 27360019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 27370019 ALT00104 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 27380019 DC AL1(ALT00105-LIN00049) FALSE DISP. 27390019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 27400019 DC AL1(DEFSYMBL) NEST OPERATOR 27410019 DC AL2(LIN00071-IPDAGH) CLENGTH 27420019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27430019 DC AL1(COD032) ERROR CODE 27440019 DC AL1(DEFNAME) NAME OPERATOR N 27450019 DC AL1(DEFSYMBL) NEST OPERATOR 27460019 DC AL2(LIN00071-IPDAGH) CLENGTH 27470019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27480019 DC AL1(PAR00057-LIN00049) POINT TO END OF OPT. ITEMS 27490019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 27500019 DC AL1(ALT00106-LIN00049) FALSE DISP. 27510019 DC AL1(BRC00044-LIN00049) TRUE DISP. 27520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27530019 DC AL1(PAR00058-LIN00049) POINT TO END OF OPT. ITEMS 27540019 DC AL1(DEFSYMBL) NEST OPERATOR 27550019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 27560019 PAR00058 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 27570019 DC AL1(DEFSYMBL) NEST OPERATOR 27580019 DC AL2(LIN00074-IPDAGH) CDATA 27590019 ALT00106 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 27600019 DC AL1(ALT00107-LIN00049) FALSE DISP. 27610019 DC AL1(DEFSYMBL) NEST OPERATOR 27620019 DC AL2(LIN00075-IPDAGH) DECLARATOR 27630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 27640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27650019 DC AL1(COD125) ERROR CODE 27660019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 27670019 DC AL1(001) LENGTH OF LITERAL 27680019 DC C'/' 27690019 ALT00107 EQU * 27700019 BRC00044 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 27710019 PAR00057 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 27720019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27730019 DC AL1(PAR00059-LIN00049) POINT TO END OF OPT. ITEMS 27740019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 27750019 DC AL1(001) LENGTH OF LITERAL 27760019 DC C',' 27770019 DC AL1(DEFCOMIT) LOCAL COMMIT / 27780019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27790019 DC AL1(COD032) ERROR CODE 27800019 DC AL1(DEFNAME) NAME OPERATOR N 27810019 DC AL1(DEFSYMBL) NEST OPERATOR 27820019 DC AL2(LIN00071-IPDAGH) CLENGTH 27830019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27840019 DC AL1(PAR00060-LIN00049) POINT TO END OF OPT. ITEMS 27850019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 27860019 DC AL1(ALT00108-LIN00049) FALSE DISP. 27870019 DC AL1(BRC00045-LIN00049) TRUE DISP. 27880019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 27890019 DC AL1(PAR00061-LIN00049) POINT TO END OF OPT. ITEMS 27900019 DC AL1(DEFSYMBL) NEST OPERATOR 27910019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 27920019 PAR00061 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 27930019 DC AL1(DEFSYMBL) NEST OPERATOR 27940019 DC AL2(LIN00074-IPDAGH) CDATA 27950019 ALT00108 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 27960019 DC AL1(ALT00109-LIN00049) FALSE DISP. 27970019 DC AL1(DEFSYMBL) NEST OPERATOR 27980019 DC AL2(LIN00075-IPDAGH) DECLARATOR 27990019 DC AL1(DEFCOMIT) LOCAL COMMIT / 28000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 28010019 DC AL1(COD125) ERROR CODE 28020019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 28030019 DC AL1(001) LENGTH OF LITERAL 28040019 DC C'/' 28050019 ALT00109 EQU * 28060019 BRC00045 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 28070019 PAR00060 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 28080019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 28090019 PAR00059 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 28100019 ALT00105 EQU * 28110019 BRC00043 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 28120019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 28130019 EJECT 28140019 *********************************************************************** 28150019 * * 28160019 *CLENGTH = ( '*' < '16' ³ '8' ³ / *28 $801 ( D ... ) > ) * 28170019 * * 28180019 * DEFINES LENGTH SPECIFICATIONS VALID FOR COMPLEX TYPE. * 28190019 * * 28200019 *********************************************************************** 28210019 LIN00071 EQU * START OF DEFINITION 28220019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 28230019 DC AL1(PAR00062-LIN00071) POINT TO END OF OPT. ITEMS 28240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28250019 DC AL1(001) LENGTH OF LITERAL 28260019 DC C'*' 28270019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 28280019 DC AL1(ALT00110-LIN00071) FALSE DISP. 28290019 DC AL1(BRC00046-LIN00071) TRUE DISP. 28300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28310019 DC AL1(002) LENGTH OF LITERAL 28320019 DC C'16' 28330019 ALT00110 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 28340019 DC AL1(ALT00111-LIN00071) FALSE DISP. 28350019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28360019 DC AL1(001) LENGTH OF LITERAL 28370019 DC C'8' 28380019 ALT00111 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 28390019 DC AL1(ALT00112-LIN00071) FALSE DISP. 28400019 DC AL1(DEFCOMIT) LOCAL COMMIT / 28410019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 28420019 DC AL1(COD028) ERROR CODE 28430019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 28440019 DC AL1(ACT801) ACTION CODE 28450019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 28460019 DC AL1(PAR00063-LIN00071) POINT TO END OF OPT. ITEMS 28470019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 28480019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 28490019 PAR00063 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 28500019 ALT00112 EQU * 28510019 BRC00046 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 28520019 PAR00062 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 28530019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 28540019 EJECT 28550019 *********************************************************************** 28560019 * * 28570019 *DECLARATOR3 = '(' USNZINT ( ',' USNZINT ... ) ')' / $202 * 28580019 * * 28590019 * DEFINES ARRAY DECLARATORS WITH CONSTANT * 28600019 * DIMENSIONS. THIS DEFINITION IS IDENTICAL * 28610019 * TO DECLARATOR2, EXCEPT THAT NO MESSAGE IS * 28620019 * ISSUED IF A FAILURE OCCURS BEFORE THE FINAL * 28630019 * RIGHT PARENTHESIS OF THE DECLARATOR. * 28640019 * * 28650019 *********************************************************************** 28660019 LIN00073 EQU * START OF DEFINITION 28670019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28680019 DC AL1(001) LENGTH OF LITERAL 28690019 DC C'(' 28700019 DC AL1(DEFSYMBL) NEST OPERATOR 28710019 DC AL2(LIN00005-IPDAGH) USNZINT 28720019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 28730019 DC AL1(PAR00064-LIN00073) POINT TO END OF OPT. ITEMS 28740019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28750019 DC AL1(001) LENGTH OF LITERAL 28760019 DC C',' 28770019 DC AL1(DEFSYMBL) NEST OPERATOR 28780019 DC AL2(LIN00005-IPDAGH) USNZINT 28790019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 28800019 PAR00064 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 28810019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28820019 DC AL1(001) LENGTH OF LITERAL 28830019 DC C')' 28840019 DC AL1(DEFCOMIT) LOCAL COMMIT / 28850019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 28860019 DC AL1(ACT202) ACTION CODE 28870019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 28880019 EJECT 28890019 *********************************************************************** 28900019 * * 28910019 *CDATA = '/' / ( K '*' / $100 ) CCONSTANT ( ',' / * 28920019 * ( K '*' / $100 ) CCONSTANT ... ) *38 '/' * 28930019 * * 28940019 * DEFINES A LIST OF COMPLEX CONSTANTS ENCLOSED IN SLASHES. * 28950019 * * 28960019 *********************************************************************** 28970019 LIN00074 EQU * START OF DEFINITION 28980019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 28990019 DC AL1(001) LENGTH OF LITERAL 29000019 DC C'/' 29010019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29020019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29030019 DC AL1(PAR00065-LIN00074) POINT TO END OF OPT. ITEMS 29040019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 29050019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29060019 DC AL1(001) LENGTH OF LITERAL 29070019 DC C'*' 29080019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29090019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 29100019 DC AL1(ACT100) ACTION CODE 29110019 PAR00065 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 29120019 DC AL1(DEFSYMBL) NEST OPERATOR 29130019 DC AL2(LIN00076-IPDAGH) CCONSTANT 29140019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29150019 DC AL1(PAR00066-LIN00074) POINT TO END OF OPT. ITEMS 29160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29170019 DC AL1(001) LENGTH OF LITERAL 29180019 DC C',' 29190019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29200019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29210019 DC AL1(PAR00067-LIN00074) POINT TO END OF OPT. ITEMS 29220019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 29230019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29240019 DC AL1(001) LENGTH OF LITERAL 29250019 DC C'*' 29260019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29270019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 29280019 DC AL1(ACT100) ACTION CODE 29290019 PAR00067 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 29300019 DC AL1(DEFSYMBL) NEST OPERATOR 29310019 DC AL2(LIN00076-IPDAGH) CCONSTANT 29320019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 29330019 PAR00066 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 29340019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29350019 DC AL1(COD038) ERROR CODE 29360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29370019 DC AL1(001) LENGTH OF LITERAL 29380019 DC C'/' 29390019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 29400019 EJECT 29410019 *********************************************************************** 29420019 * * 29430019 *CCONSTANT = *41 < '(' / ( < '-' ³ '+' > ) K $103 * 29440019 * *52 ',' ( < '-' ³ '+' > ) K $104 *12 ')' * 29450019 * ³ HCHEX > * 29460019 * * 29470019 * DEFINES THE KINDS OF CONSTANTS THAT MAY APPEAR IN * 29480019 * COMPLEX TYPE-STATEMENTS IN THE DATA LIST. THESE * 29490019 * ARE: COMPLEX CONSTANTS, BOTH FORMS OF LITERAL * 29500019 * CONSTANT, AND HEXADECIMAL CONSTANTS. * 29510019 * * 29520019 *********************************************************************** 29530019 LIN00076 EQU * START OF DEFINITION 29540019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29550019 DC AL1(COD041) ERROR CODE 29560019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 29570019 DC AL1(ALT00113-LIN00076) FALSE DISP. 29580019 DC AL1(BRC00047-LIN00076) TRUE DISP. 29590019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29600019 DC AL1(001) LENGTH OF LITERAL 29610019 DC C'(' 29620019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29630019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29640019 DC AL1(PAR00068-LIN00076) POINT TO END OF OPT. ITEMS 29650019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 29660019 DC AL1(ALT00114-LIN00076) FALSE DISP. 29670019 DC AL1(BRC00048-LIN00076) TRUE DISP. 29680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29690019 DC AL1(001) LENGTH OF LITERAL 29700019 DC C'-' 29710019 ALT00114 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 29720019 DC AL1(ALT00115-LIN00076) FALSE DISP. 29730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29740019 DC AL1(001) LENGTH OF LITERAL 29750019 DC C'+' 29760019 ALT00115 EQU * 29770019 BRC00048 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 29780019 PAR00068 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 29790019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 29800019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 29810019 DC AL1(ACT103) ACTION CODE 29820019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29830019 DC AL1(COD052) ERROR CODE 29840019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29850019 DC AL1(001) LENGTH OF LITERAL 29860019 DC C',' 29870019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29880019 DC AL1(PAR00069-LIN00076) POINT TO END OF OPT. ITEMS 29890019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 29900019 DC AL1(ALT00116-LIN00076) FALSE DISP. 29910019 DC AL1(BRC00049-LIN00076) TRUE DISP. 29920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29930019 DC AL1(001) LENGTH OF LITERAL 29940019 DC C'-' 29950019 ALT00116 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 29960019 DC AL1(ALT00117-LIN00076) FALSE DISP. 29970019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29980019 DC AL1(001) LENGTH OF LITERAL 29990019 DC C'+' 30000019 ALT00117 EQU * 30010019 BRC00049 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 30020019 PAR00069 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 30030019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 30040019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 30050019 DC AL1(ACT104) ACTION CODE 30060019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30070019 DC AL1(COD012) ERROR CODE 30080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30090019 DC AL1(001) LENGTH OF LITERAL 30100019 DC C')' 30110019 ALT00113 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 30120019 DC AL1(ALT00118-LIN00076) FALSE DISP. 30130019 DC AL1(DEFSYMBL) NEST OPERATOR 30140019 DC AL2(LIN00077-IPDAGH) HCHEX 30150019 ALT00118 EQU * 30160019 BRC00047 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 30170019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 30180019 EJECT 30190019 *********************************************************************** 30200019 * * 30210019 *FUNCTIONARGS = *35 '(' < N ³ '/' / *33 * 30220019 * N *38 '/' > ( ',' / *35 < N ³ * 30230019 * '/' / *33 N *38 '/' > ... ) *13 ')' * 30240019 * * 30250019 * DEFINES THE LIST OF DUMMY ARGUMENTS, * 30260019 * INCLUDING THE PARENTHESES WHICH ENCLOSE * 30270019 * THE LIST, IN A FUNCTION STATEMENT. * 30280019 * * 30290019 *********************************************************************** 30300019 LIN00072 EQU * START OF DEFINITION 30310019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30320019 DC AL1(COD035) ERROR CODE 30330019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30340019 DC AL1(001) LENGTH OF LITERAL 30350019 DC C'(' 30360019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 30370019 DC AL1(ALT00119-LIN00072) FALSE DISP. 30380019 DC AL1(BRC00050-LIN00072) TRUE DISP. 30390019 DC AL1(DEFNAME) NAME OPERATOR N 30400019 ALT00119 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 30410019 DC AL1(ALT00120-LIN00072) FALSE DISP. 30420019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30430019 DC AL1(001) LENGTH OF LITERAL 30440019 DC C'/' 30450019 DC AL1(DEFCOMIT) LOCAL COMMIT / 30460019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30470019 DC AL1(COD033) ERROR CODE 30480019 DC AL1(DEFNAME) NAME OPERATOR N 30490019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30500019 DC AL1(COD038) ERROR CODE 30510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30520019 DC AL1(001) LENGTH OF LITERAL 30530019 DC C'/' 30540019 ALT00120 EQU * 30550019 BRC00050 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 30560019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 30570019 DC AL1(PAR00070-LIN00072) POINT TO END OF OPT. ITEMS 30580019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30590019 DC AL1(001) LENGTH OF LITERAL 30600019 DC C',' 30610019 DC AL1(DEFCOMIT) LOCAL COMMIT / 30620019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30630019 DC AL1(COD035) ERROR CODE 30640019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 30650019 DC AL1(ALT00121-LIN00072) FALSE DISP. 30660019 DC AL1(BRC00051-LIN00072) TRUE DISP. 30670019 DC AL1(DEFNAME) NAME OPERATOR N 30680019 ALT00121 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 30690019 DC AL1(ALT00122-LIN00072) FALSE DISP. 30700019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30710019 DC AL1(001) LENGTH OF LITERAL 30720019 DC C'/' 30730019 DC AL1(DEFCOMIT) LOCAL COMMIT / 30740019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30750019 DC AL1(COD033) ERROR CODE 30760019 DC AL1(DEFNAME) NAME OPERATOR N 30770019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30780019 DC AL1(COD038) ERROR CODE 30790019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30800019 DC AL1(001) LENGTH OF LITERAL 30810019 DC C'/' 30820019 ALT00122 EQU * 30830019 BRC00051 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 30840019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 30850019 PAR00070 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 30860019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30870019 DC AL1(COD013) ERROR CODE 30880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30890019 DC AL1(001) LENGTH OF LITERAL 30900019 DC C')' 30910019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 30920019 EJECT 30930019 *********************************************************************** 30940019 * * 30950019 *DECLARATOR = *37 '(' / < USNZINT ³ N > ( ',' / $201 * 30960019 * < USNZINT ³ N > ... ) *12 ')' * 30970019 * * 30980019 * DEFINITION OF ARRAY DECLARATOR. THIS DEFINITION * 30990019 * IS USED WHERE VARIABLY - DIMENSIONED ARRAYS * 31000019 * MAY BE DECLARED. * 31010019 * * 31020019 *********************************************************************** 31030019 LIN00075 EQU * START OF DEFINITION 31040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 31050019 DC AL1(COD037) ERROR CODE 31060019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31070019 DC AL1(001) LENGTH OF LITERAL 31080019 DC C'(' 31090019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31100019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 31110019 DC AL1(ALT00123-LIN00075) FALSE DISP. 31120019 DC AL1(BRC00052-LIN00075) TRUE DISP. 31130019 DC AL1(DEFSYMBL) NEST OPERATOR 31140019 DC AL2(LIN00005-IPDAGH) USNZINT 31150019 ALT00123 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 31160019 DC AL1(ALT00124-LIN00075) FALSE DISP. 31170019 DC AL1(DEFNAME) NAME OPERATOR N 31180019 ALT00124 EQU * 31190019 BRC00052 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 31200019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31210019 DC AL1(PAR00071-LIN00075) POINT TO END OF OPT. ITEMS 31220019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31230019 DC AL1(001) LENGTH OF LITERAL 31240019 DC C',' 31250019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31260019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 31270019 DC AL1(ACT201) ACTION CODE 31280019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 31290019 DC AL1(ALT00125-LIN00075) FALSE DISP. 31300019 DC AL1(BRC00053-LIN00075) TRUE DISP. 31310019 DC AL1(DEFSYMBL) NEST OPERATOR 31320019 DC AL2(LIN00005-IPDAGH) USNZINT 31330019 ALT00125 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 31340019 DC AL1(ALT00126-LIN00075) FALSE DISP. 31350019 DC AL1(DEFNAME) NAME OPERATOR N 31360019 ALT00126 EQU * 31370019 BRC00053 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 31380019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 31390019 PAR00071 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31400019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 31410019 DC AL1(COD012) ERROR CODE 31420019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31430019 DC AL1(001) LENGTH OF LITERAL 31440019 DC C')' 31450019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 31460019 EJECT 31470019 *********************************************************************** 31480019 * * 31490019 *DATALIST = '/' / ( K '*' / $100 ) CONSTANT ( ',' / * 31500019 * ( K '*' / $100 ) CONSTANT ... ) *38 '/' * 31510019 * * 31520019 * DEFINES THE DATA LISTS THAT MAY APPEAR IN * 31530019 * DATA STATEMENTS. * 31540019 * * 31550019 *********************************************************************** 31560019 LIN00078 EQU * START OF DEFINITION 31570019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31580019 DC AL1(001) LENGTH OF LITERAL 31590019 DC C'/' 31600019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31610019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31620019 DC AL1(PAR00072-LIN00078) POINT TO END OF OPT. ITEMS 31630019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 31640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31650019 DC AL1(001) LENGTH OF LITERAL 31660019 DC C'*' 31670019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31680019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 31690019 DC AL1(ACT100) ACTION CODE 31700019 PAR00072 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31710019 DC AL1(DEFSYMBL) NEST OPERATOR 31720019 DC AL2(LIN00079-IPDAGH) CONSTANT 31730019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31740019 DC AL1(PAR00073-LIN00078) POINT TO END OF OPT. ITEMS 31750019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31760019 DC AL1(001) LENGTH OF LITERAL 31770019 DC C',' 31780019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31790019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31800019 DC AL1(PAR00074-LIN00078) POINT TO END OF OPT. ITEMS 31810019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 31820019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31830019 DC AL1(001) LENGTH OF LITERAL 31840019 DC C'*' 31850019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31860019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 31870019 DC AL1(ACT100) ACTION CODE 31880019 PAR00074 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31890019 DC AL1(DEFSYMBL) NEST OPERATOR 31900019 DC AL2(LIN00079-IPDAGH) CONSTANT 31910019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 31920019 PAR00073 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31930019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 31940019 DC AL1(COD038) ERROR CODE 31950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31960019 DC AL1(001) LENGTH OF LITERAL 31970019 DC C'/' 31980019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 31990019 EJECT 32000019 *********************************************************************** 32010019 * * 32020019 *CONSTANT = *40 < ( < '+' ³ '-' > ) K ³ * 32030019 * HCHEX ³ '.TRUE.' ³ '.FALSE.' * 32040019 * ³ 'T' ³ 'F' ³ '(' / ( < '+' ³ '-' > ) * 32050019 * K $103 *52 ',' ( < '+' ³ '-' > ) K $104 * 32060019 * *12 ')' > * 32070019 * * 32080019 * DEFINES ALL THE TYPES OF CONSTANT THAT ARE * 32090019 * PERMITTED BY FORTRAN. * 32100019 * * 32110019 *********************************************************************** 32120019 LIN00079 EQU * START OF DEFINITION 32130019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 32140019 DC AL1(COD040) ERROR CODE 32150019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 32160019 DC AL1(ALT00127-LIN00079) FALSE DISP. 32170019 DC AL1(BRC00054-LIN00079) TRUE DISP. 32180019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 32190019 DC AL1(PAR00075-LIN00079) POINT TO END OF OPT. ITEMS 32200019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 32210019 DC AL1(ALT00128-LIN00079) FALSE DISP. 32220019 DC AL1(BRC00055-LIN00079) TRUE DISP. 32230019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32240019 DC AL1(001) LENGTH OF LITERAL 32250019 DC C'+' 32260019 ALT00128 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32270019 DC AL1(ALT00129-LIN00079) FALSE DISP. 32280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32290019 DC AL1(001) LENGTH OF LITERAL 32300019 DC C'-' 32310019 ALT00129 EQU * 32320019 BRC00055 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 32330019 PAR00075 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 32340019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 32350019 ALT00127 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32360019 DC AL1(ALT00130-LIN00079) FALSE DISP. 32370019 DC AL1(DEFSYMBL) NEST OPERATOR 32380019 DC AL2(LIN00077-IPDAGH) HCHEX 32390019 ALT00130 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32400019 DC AL1(ALT00131-LIN00079) FALSE DISP. 32410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32420019 DC AL1(006) LENGTH OF LITERAL 32430019 DC C'.TRUE.' 32440019 ALT00131 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32450019 DC AL1(ALT00132-LIN00079) FALSE DISP. 32460019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32470019 DC AL1(007) LENGTH OF LITERAL 32480019 DC C'.FALSE.' 32490019 ALT00132 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32500019 DC AL1(ALT00133-LIN00079) FALSE DISP. 32510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32520019 DC AL1(001) LENGTH OF LITERAL 32530019 DC C'T' 32540019 ALT00133 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32550019 DC AL1(ALT00134-LIN00079) FALSE DISP. 32560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32570019 DC AL1(001) LENGTH OF LITERAL 32580019 DC C'F' 32590019 ALT00134 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32600019 DC AL1(ALT00135-LIN00079) FALSE DISP. 32610019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32620019 DC AL1(001) LENGTH OF LITERAL 32630019 DC C'(' 32640019 DC AL1(DEFCOMIT) LOCAL COMMIT / 32650019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 32660019 DC AL1(PAR00076-LIN00079) POINT TO END OF OPT. ITEMS 32670019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 32680019 DC AL1(ALT00136-LIN00079) FALSE DISP. 32690019 DC AL1(BRC00056-LIN00079) TRUE DISP. 32700019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32710019 DC AL1(001) LENGTH OF LITERAL 32720019 DC C'+' 32730019 ALT00136 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32740019 DC AL1(ALT00137-LIN00079) FALSE DISP. 32750019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32760019 DC AL1(001) LENGTH OF LITERAL 32770019 DC C'-' 32780019 ALT00137 EQU * 32790019 BRC00056 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 32800019 PAR00076 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 32810019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 32820019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 32830019 DC AL1(ACT103) ACTION CODE 32840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 32850019 DC AL1(COD052) ERROR CODE 32860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32870019 DC AL1(001) LENGTH OF LITERAL 32880019 DC C',' 32890019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 32900019 DC AL1(PAR00077-LIN00079) POINT TO END OF OPT. ITEMS 32910019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 32920019 DC AL1(ALT00138-LIN00079) FALSE DISP. 32930019 DC AL1(BRC00057-LIN00079) TRUE DISP. 32940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32950019 DC AL1(001) LENGTH OF LITERAL 32960019 DC C'+' 32970019 ALT00138 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 32980019 DC AL1(ALT00139-LIN00079) FALSE DISP. 32990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33000019 DC AL1(001) LENGTH OF LITERAL 33010019 DC C'-' 33020019 ALT00139 EQU * 33030019 BRC00057 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 33040019 PAR00077 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 33050019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 33060019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 33070019 DC AL1(ACT104) ACTION CODE 33080019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 33090019 DC AL1(COD012) ERROR CODE 33100019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33110019 DC AL1(001) LENGTH OF LITERAL 33120019 DC C')' 33130019 ALT00135 EQU * 33140019 BRC00054 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 33150019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 33160019 EJECT 33170019 *********************************************************************** 33180019 * * 33190019 *HCHEX = < H ³ C ³ 'Z' / HEXDIG ( HEXDIG ... ) > * 33200019 * * 33210019 * DESCRIBES H-LITERALS, LITERALS, AND HEXADECIMAL * 33220019 * CONSTANTS. THIS LINE IS USED FOR DATA LISTS IN * 33230019 * DATA AND TYPE STATEMENTS. * 33240019 * * 33250019 *********************************************************************** 33260019 LIN00077 EQU * START OF DEFINITION 33270019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 33280019 DC AL1(ALT00140-LIN00077) FALSE DISP. 33290019 DC AL1(BRC00058-LIN00077) TRUE DISP. 33300019 DC AL1(DEFHOLLR) HOLLERITH OPERATOR H 33310019 ALT00140 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33320019 DC AL1(ALT00141-LIN00077) FALSE DISP. 33330019 DC AL1(DEFCSTRG) CHARACTER STRING C 33340019 ALT00141 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33350019 DC AL1(ALT00142-LIN00077) FALSE DISP. 33360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33370019 DC AL1(001) LENGTH OF LITERAL 33380019 DC C'Z' 33390019 DC AL1(DEFCOMIT) LOCAL COMMIT / 33400019 DC AL1(DEFSYMBL) NEST OPERATOR 33410019 DC AL2(LIN00080-IPDAGH) HEXDIG 33420019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 33430019 DC AL1(PAR00078-LIN00077) POINT TO END OF OPT. ITEMS 33440019 DC AL1(DEFSYMBL) NEST OPERATOR 33450019 DC AL2(LIN00080-IPDAGH) HEXDIG 33460019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 33470019 PAR00078 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 33480019 ALT00142 EQU * 33490019 BRC00058 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 33500019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 33510019 EJECT 33520019 *********************************************************************** 33530019 * * 33540019 *HEXDIG = < D ³ 'A' ³ 'B' ³ 'C' ³ 'D' ³ 'E' ³ 'F' > * 33550019 * * 33560019 * DEFINES A HEXADECIMAL DIGIT. * 33570019 * * 33580019 *********************************************************************** 33590019 LIN00080 EQU * START OF DEFINITION 33600019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 33610019 DC AL1(ALT00143-LIN00080) FALSE DISP. 33620019 DC AL1(BRC00059-LIN00080) TRUE DISP. 33630019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 33640019 ALT00143 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33650019 DC AL1(ALT00144-LIN00080) FALSE DISP. 33660019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33670019 DC AL1(001) LENGTH OF LITERAL 33680019 DC C'A' 33690019 ALT00144 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33700019 DC AL1(ALT00145-LIN00080) FALSE DISP. 33710019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33720019 DC AL1(001) LENGTH OF LITERAL 33730019 DC C'B' 33740019 ALT00145 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33750019 DC AL1(ALT00146-LIN00080) FALSE DISP. 33760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33770019 DC AL1(001) LENGTH OF LITERAL 33780019 DC C'C' 33790019 ALT00146 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33800019 DC AL1(ALT00147-LIN00080) FALSE DISP. 33810019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33820019 DC AL1(001) LENGTH OF LITERAL 33830019 DC C'D' 33840019 ALT00147 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33850019 DC AL1(ALT00148-LIN00080) FALSE DISP. 33860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33870019 DC AL1(001) LENGTH OF LITERAL 33880019 DC C'E' 33890019 ALT00148 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 33900019 DC AL1(ALT00149-LIN00080) FALSE DISP. 33910019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33920019 DC AL1(001) LENGTH OF LITERAL 33930019 DC C'F' 33940019 ALT00149 EQU * 33950019 BRC00059 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 33960019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 33970019 EJECT 33980019 *********************************************************************** 33990019 * * 34000019 *DATA = : *79 VARLIST *49 DATALIST ( ',' / *79 * 34010019 * VARLIST *49 DATALIST ... ) * 34020019 * * 34030019 * DEFINES THE DATA STATEMENT. * 34040019 * * 34050019 *********************************************************************** 34060019 LIN00050 EQU * START OF DEFINITION 34070019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 34080019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34090019 DC AL1(COD079) ERROR CODE 34100019 DC AL1(DEFSYMBL) NEST OPERATOR 34110019 DC AL2(LIN00081-IPDAGH) VARLIST 34120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34130019 DC AL1(COD049) ERROR CODE 34140019 DC AL1(DEFSYMBL) NEST OPERATOR 34150019 DC AL2(LIN00078-IPDAGH) DATALIST 34160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34170019 DC AL1(PAR00079-LIN00050) POINT TO END OF OPT. ITEMS 34180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 34190019 DC AL1(001) LENGTH OF LITERAL 34200019 DC C',' 34210019 DC AL1(DEFCOMIT) LOCAL COMMIT / 34220019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34230019 DC AL1(COD079) ERROR CODE 34240019 DC AL1(DEFSYMBL) NEST OPERATOR 34250019 DC AL2(LIN00081-IPDAGH) VARLIST 34260019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34270019 DC AL1(COD049) ERROR CODE 34280019 DC AL1(DEFSYMBL) NEST OPERATOR 34290019 DC AL2(LIN00078-IPDAGH) DATALIST 34300019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 34310019 PAR00079 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 34320019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 34330019 EJECT 34340019 *********************************************************************** 34350019 * * 34360019 *VARLIST = N ( DECLARATOR2 ) *33 ( ',' / N ( DECLARATOR2 ) * 34370019 * ... ) * 34380019 * * 34390019 * DEFINES A LIST OF VARIABLES OF THE KIND * 34400019 * THAT APPEARS IN A DATA STATEMENT. * 34410019 * * 34420019 *********************************************************************** 34430019 LIN00081 EQU * START OF DEFINITION 34440019 DC AL1(DEFNAME) NAME OPERATOR N 34450019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34460019 DC AL1(PAR00080-LIN00081) POINT TO END OF OPT. ITEMS 34470019 DC AL1(DEFSYMBL) NEST OPERATOR 34480019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 34490019 PAR00080 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 34500019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34510019 DC AL1(COD033) ERROR CODE 34520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34530019 DC AL1(PAR00081-LIN00081) POINT TO END OF OPT. ITEMS 34540019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 34550019 DC AL1(001) LENGTH OF LITERAL 34560019 DC C',' 34570019 DC AL1(DEFCOMIT) LOCAL COMMIT / 34580019 DC AL1(DEFNAME) NAME OPERATOR N 34590019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34600019 DC AL1(PAR00082-LIN00081) POINT TO END OF OPT. ITEMS 34610019 DC AL1(DEFSYMBL) NEST OPERATOR 34620019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 34630019 PAR00082 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 34640019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 34650019 PAR00081 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 34660019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 34670019 EJECT 34680019 *********************************************************************** 34690019 * * 34700019 *DEBUG = 'G' : $400 ( OPTION ( ',' / *65 OPTION * 34710019 * .4. ) ) * 34720019 * * 34730019 * DEFINES THE DEBUG STATEMENT. ACTION CODE * 34740019 * 400 ISSUES A "DEBUG FACILITY NOT SUPPORTED" * 34750019 * MESSAGE IF THE CHECKER IS CHECKING FORTRAN H. * 34760019 * ONLY FIVE OPTIONS ARE ALLOWED IN THE DEBUG * 34770019 * STATEMENT SINCE AT LEAST ONE OPTION WOULD * 34780019 * HAVE BEEN REPEATED IF MORE THAN FIVE * 34790019 * OPTIONS WERE PRESENT. HOWEVER, NO CHECK * 34800019 * IS MADE FOR REPEATED OPTIONS IF THERE * 34810019 * ARE FIVE OR FEWER OPTIONS PRESENT. * 34820019 * * 34830019 *********************************************************************** 34840019 LIN00051 EQU * START OF DEFINITION 34850019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 34860019 DC AL1(001) LENGTH OF LITERAL 34870019 DC C'G' 34880019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 34890019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 34900019 DC AL1(ACT400) ACTION CODE 34910019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34920019 DC AL1(PAR00083-LIN00051) POINT TO END OF OPT. ITEMS 34930019 DC AL1(DEFSYMBL) NEST OPERATOR 34940019 DC AL2(LIN00082-IPDAGH) OPTION 34950019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 34960019 DC AL1(PAR00084-LIN00051) POINT TO END OF OPT. ITEMS 34970019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 34980019 DC AL1(001) LENGTH OF LITERAL 34990019 DC C',' 35000019 DC AL1(DEFCOMIT) LOCAL COMMIT / 35010019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35020019 DC AL1(COD065) ERROR CODE 35030019 DC AL1(DEFSYMBL) NEST OPERATOR 35040019 DC AL2(LIN00082-IPDAGH) OPTION 35050019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 35060019 DC AL1(004) ITERATION COUNT 35070019 PAR00084 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 35080019 PAR00083 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 35090019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 35100019 EJECT 35110019 *********************************************************************** 35120019 * * 35130019 *OPTION = < 'TRACE' ³ 'SUBTRACE' ³ 'UNIT' / *30 '(' * 35140019 * DSREFNO *12 ')' ³ < 'SUBCHK' ³ 'INIT' > ( * 35150019 * '(' / *32 N ( ',' / N ... ) *12 ')' ) > * 35160019 * * 35170019 * DEFINES THE FIVE OPTIONS THAT MAY APPEAR * 35180019 * IN A DEBUG STATEMENT. * 35190019 * * 35200019 *********************************************************************** 35210019 LIN00082 EQU * START OF DEFINITION 35220019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 35230019 DC AL1(ALT00150-LIN00082) FALSE DISP. 35240019 DC AL1(BRC00060-LIN00082) TRUE DISP. 35250019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35260019 DC AL1(005) LENGTH OF LITERAL 35270019 DC C'TRACE' 35280019 ALT00150 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 35290019 DC AL1(ALT00151-LIN00082) FALSE DISP. 35300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35310019 DC AL1(008) LENGTH OF LITERAL 35320019 DC C'SUBTRACE' 35330019 ALT00151 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 35340019 DC AL1(ALT00152-LIN00082) FALSE DISP. 35350019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35360019 DC AL1(004) LENGTH OF LITERAL 35370019 DC C'UNIT' 35380019 DC AL1(DEFCOMIT) LOCAL COMMIT / 35390019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35400019 DC AL1(COD030) ERROR CODE 35410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35420019 DC AL1(001) LENGTH OF LITERAL 35430019 DC C'(' 35440019 DC AL1(DEFSYMBL) NEST OPERATOR 35450019 DC AL2(LIN00039-IPDAGH) DSREFNO 35460019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35470019 DC AL1(COD012) ERROR CODE 35480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35490019 DC AL1(001) LENGTH OF LITERAL 35500019 DC C')' 35510019 ALT00152 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 35520019 DC AL1(ALT00153-LIN00082) FALSE DISP. 35530019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 35540019 DC AL1(ALT00154-LIN00082) FALSE DISP. 35550019 DC AL1(BRC00061-LIN00082) TRUE DISP. 35560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35570019 DC AL1(006) LENGTH OF LITERAL 35580019 DC C'SUBCHK' 35590019 ALT00154 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 35600019 DC AL1(ALT00155-LIN00082) FALSE DISP. 35610019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35620019 DC AL1(004) LENGTH OF LITERAL 35630019 DC C'INIT' 35640019 ALT00155 EQU * 35650019 BRC00061 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 35660019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 35670019 DC AL1(PAR00085-LIN00082) POINT TO END OF OPT. ITEMS 35680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35690019 DC AL1(001) LENGTH OF LITERAL 35700019 DC C'(' 35710019 DC AL1(DEFCOMIT) LOCAL COMMIT / 35720019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35730019 DC AL1(COD032) ERROR CODE 35740019 DC AL1(DEFNAME) NAME OPERATOR N 35750019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 35760019 DC AL1(PAR00086-LIN00082) POINT TO END OF OPT. ITEMS 35770019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35780019 DC AL1(001) LENGTH OF LITERAL 35790019 DC C',' 35800019 DC AL1(DEFCOMIT) LOCAL COMMIT / 35810019 DC AL1(DEFNAME) NAME OPERATOR N 35820019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 35830019 PAR00086 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 35840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35850019 DC AL1(COD012) ERROR CODE 35860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35870019 DC AL1(001) LENGTH OF LITERAL 35880019 DC C')' 35890019 PAR00085 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 35900019 ALT00153 EQU * 35910019 BRC00060 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 35920019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 35930019 EJECT 35940019 *********************************************************************** 35950019 * * 35960019 *DEFINEFILE = 'NEFILE' : *27 K $105 *31 '(' USNZINT * 35970019 * *53 ',' USNZINT ',' *63 < 'L' ³ 'E' ³ 'U' > * 35980019 * *53 ',' *33 N *13 ')' ( ',' / *27 K $105 *31 * 35990019 * '(' USNZINT *53 ',' USNZINT ',' *63 * 36000019 * < 'L' ³ 'E' ³ 'U' > *53 ',' *33 N *13 ')' ... ) * 36010019 * * 36020019 * DEFINES THE DEFINE FILE STATEMENT. IN * 36030019 * THIS STATEMENT, THE DATA SET REFERENCE * 36040019 * NUMBER CANNOT BE A SYMBOLIC NAME, SO * 36050019 * THE K OPERATOR FOLLOWED BY ACTION CODE 105 * 36060019 * IS USED WHERE DATA SET REFERENCE NUMBERS ARE * 36070019 * REQUIRED. THE FORM OF THE BASIC ELEMENT * 36080019 * OF THIS STATEMENT IS GIVEN ON THE FIRST * 36090019 * TWO AND-A-HALF LINES. THE LAST TWO * 36100019 * AND-A-HALF LINES DESCRIBE THE OPTIONAL * 36110019 * REPETITION OF THIS ELEMENT FOLLOWING A COMMA. * 36120019 * * 36130019 *********************************************************************** 36140019 LIN00052 EQU * START OF DEFINITION 36150019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36160019 DC AL1(006) LENGTH OF LITERAL 36170019 DC C'NEFILE' 36180019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 36190019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36200019 DC AL1(COD027) ERROR CODE 36210019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 36220019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 36230019 DC AL1(ACT105) ACTION CODE 36240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36250019 DC AL1(COD031) ERROR CODE 36260019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36270019 DC AL1(001) LENGTH OF LITERAL 36280019 DC C'(' 36290019 DC AL1(DEFSYMBL) NEST OPERATOR 36300019 DC AL2(LIN00005-IPDAGH) USNZINT 36310019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36320019 DC AL1(COD053) ERROR CODE 36330019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36340019 DC AL1(001) LENGTH OF LITERAL 36350019 DC C',' 36360019 DC AL1(DEFSYMBL) NEST OPERATOR 36370019 DC AL2(LIN00005-IPDAGH) USNZINT 36380019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36390019 DC AL1(001) LENGTH OF LITERAL 36400019 DC C',' 36410019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36420019 DC AL1(COD063) ERROR CODE 36430019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 36440019 DC AL1(ALT00156-LIN00052) FALSE DISP. 36450019 DC AL1(BRC00062-LIN00052) TRUE DISP. 36460019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36470019 DC AL1(001) LENGTH OF LITERAL 36480019 DC C'L' 36490019 ALT00156 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 36500019 DC AL1(ALT00157-LIN00052) FALSE DISP. 36510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36520019 DC AL1(001) LENGTH OF LITERAL 36530019 DC C'E' 36540019 ALT00157 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 36550019 DC AL1(ALT00158-LIN00052) FALSE DISP. 36560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36570019 DC AL1(001) LENGTH OF LITERAL 36580019 DC C'U' 36590019 ALT00158 EQU * 36600019 BRC00062 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 36610019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36620019 DC AL1(COD053) ERROR CODE 36630019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36640019 DC AL1(001) LENGTH OF LITERAL 36650019 DC C',' 36660019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36670019 DC AL1(COD033) ERROR CODE 36680019 DC AL1(DEFNAME) NAME OPERATOR N 36690019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36700019 DC AL1(COD013) ERROR CODE 36710019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36720019 DC AL1(001) LENGTH OF LITERAL 36730019 DC C')' 36740019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 36750019 DC AL1(PAR00087-LIN00052) POINT TO END OF OPT. ITEMS 36760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36770019 DC AL1(001) LENGTH OF LITERAL 36780019 DC C',' 36790019 DC AL1(DEFCOMIT) LOCAL COMMIT / 36800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36810019 DC AL1(COD027) ERROR CODE 36820019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 36830019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 36840019 DC AL1(ACT105) ACTION CODE 36850019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36860019 DC AL1(COD031) ERROR CODE 36870019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36880019 DC AL1(001) LENGTH OF LITERAL 36890019 DC C'(' 36900019 DC AL1(DEFSYMBL) NEST OPERATOR 36910019 DC AL2(LIN00005-IPDAGH) USNZINT 36920019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36930019 DC AL1(COD053) ERROR CODE 36940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36950019 DC AL1(001) LENGTH OF LITERAL 36960019 DC C',' 36970019 DC AL1(DEFSYMBL) NEST OPERATOR 36980019 DC AL2(LIN00005-IPDAGH) USNZINT 36990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37000019 DC AL1(001) LENGTH OF LITERAL 37010019 DC C',' 37020019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37030019 DC AL1(COD063) ERROR CODE 37040019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 37050019 DC AL1(ALT00159-LIN00052) FALSE DISP. 37060019 DC AL1(BRC00063-LIN00052) TRUE DISP. 37070019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37080019 DC AL1(001) LENGTH OF LITERAL 37090019 DC C'L' 37100019 ALT00159 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 37110019 DC AL1(ALT00160-LIN00052) FALSE DISP. 37120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37130019 DC AL1(001) LENGTH OF LITERAL 37140019 DC C'E' 37150019 ALT00160 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 37160019 DC AL1(ALT00161-LIN00052) FALSE DISP. 37170019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37180019 DC AL1(001) LENGTH OF LITERAL 37190019 DC C'U' 37200019 ALT00161 EQU * 37210019 BRC00063 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 37220019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37230019 DC AL1(COD053) ERROR CODE 37240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37250019 DC AL1(001) LENGTH OF LITERAL 37260019 DC C',' 37270019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37280019 DC AL1(COD033) ERROR CODE 37290019 DC AL1(DEFNAME) NAME OPERATOR N 37300019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37310019 DC AL1(COD013) ERROR CODE 37320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37330019 DC AL1(001) LENGTH OF LITERAL 37340019 DC C')' 37350019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 37360019 PAR00087 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 37370019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 37380019 EJECT 37390019 *********************************************************************** 37400019 * * 37410019 *DIMENSION = 'NSION' : *33 N DECLARATOR ( ',' / N DECLARATOR * 37420019 * ... ) * 37430019 * * 37440019 * DEFINES THE DIMENSION STATEMENT. SINCE * 37450019 * THE LINE IS COMMITTED AFTER THE LITERAL IS * 37460019 * MATCHED, THE "ARRAY DIMENSIONS EXPECTED" MESSAGE * 37470019 * ON THE DECLARATOR LINE WILL BE ISSUED IF * 37480019 * A DECLARATOR IS MISSING. THE "NAME EXPECTED" * 37490019 * MESSAGE ON THIS LINE THEREFORE APPLIES TO THE * 37500019 * ENTIRE LINE. * 37510019 * * 37520019 *********************************************************************** 37530019 LIN00053 EQU * START OF DEFINITION 37540019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37550019 DC AL1(005) LENGTH OF LITERAL 37560019 DC C'NSION' 37570019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 37580019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37590019 DC AL1(COD033) ERROR CODE 37600019 DC AL1(DEFNAME) NAME OPERATOR N 37610019 DC AL1(DEFSYMBL) NEST OPERATOR 37620019 DC AL2(LIN00075-IPDAGH) DECLARATOR 37630019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 37640019 DC AL1(PAR00088-LIN00053) POINT TO END OF OPT. ITEMS 37650019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37660019 DC AL1(001) LENGTH OF LITERAL 37670019 DC C',' 37680019 DC AL1(DEFCOMIT) LOCAL COMMIT / 37690019 DC AL1(DEFNAME) NAME OPERATOR N 37700019 DC AL1(DEFSYMBL) NEST OPERATOR 37710019 DC AL2(LIN00075-IPDAGH) DECLARATOR 37720019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 37730019 PAR00088 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 37740019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 37750019 EJECT 37760019 *********************************************************************** 37770019 * * 37780019 *DISPLAY = 'LAY' : $400 *33 N ( ',' / N ... ) * 37790019 * * 37800019 * DEFINES THE DISPLAY STATEMENT. THIS * 37810019 * STATEMENT IS VALID ONLY IN LEVEL G OF * 37820019 * FORTRAN. ACTION CODE 400 DETERMINES * 37830019 * WHETHER THE CHECKER IS CHECKING THE G LEVEL * 37840019 * OF FORTRAN, AND ISSUES A MESSAGE IF NOT. * 37850019 * * 37860019 *********************************************************************** 37870019 LIN00054 EQU * START OF DEFINITION 37880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37890019 DC AL1(003) LENGTH OF LITERAL 37900019 DC C'LAY' 37910019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 37920019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 37930019 DC AL1(ACT400) ACTION CODE 37940019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37950019 DC AL1(COD033) ERROR CODE 37960019 DC AL1(DEFNAME) NAME OPERATOR N 37970019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 37980019 DC AL1(PAR00089-LIN00054) POINT TO END OF OPT. ITEMS 37990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38000019 DC AL1(001) LENGTH OF LITERAL 38010019 DC C',' 38020019 DC AL1(DEFCOMIT) LOCAL COMMIT / 38030019 DC AL1(DEFNAME) NAME OPERATOR N 38040019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 38050019 PAR00089 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 38060019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 38070019 EJECT 38080019 *********************************************************************** 38090019 * * 38100019 *DOUBLE = 'LEPRECISION' < 'FUNCTION' : *33 N FUNCTIONARGS * 38110019 * ³ : *32 N ( DECLARATOR ) ( ',' / N * 38120019 * ( DECLARATOR ) ... ) > * 38130019 * * 38140019 * DEFINES THE DOUBLE PRECISION TYPE-STATEMENT * 38150019 * AND THE DOUBLE PRECISION FUNCTION STATEMENT. * 38160019 * * 38170019 *********************************************************************** 38180019 LIN00055 EQU * START OF DEFINITION 38190019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38200019 DC AL1(011) LENGTH OF LITERAL 38210019 DC C'LEPRECISION' 38220019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 38230019 DC AL1(ALT00162-LIN00055) FALSE DISP. 38240019 DC AL1(BRC00064-LIN00055) TRUE DISP. 38250019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38260019 DC AL1(008) LENGTH OF LITERAL 38270019 DC C'FUNCTION' 38280019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 38290019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 38300019 DC AL1(COD033) ERROR CODE 38310019 DC AL1(DEFNAME) NAME OPERATOR N 38320019 DC AL1(DEFSYMBL) NEST OPERATOR 38330019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 38340019 ALT00162 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 38350019 DC AL1(ALT00163-LIN00055) FALSE DISP. 38360019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 38370019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 38380019 DC AL1(COD032) ERROR CODE 38390019 DC AL1(DEFNAME) NAME OPERATOR N 38400019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 38410019 DC AL1(PAR00090-LIN00055) POINT TO END OF OPT. ITEMS 38420019 DC AL1(DEFSYMBL) NEST OPERATOR 38430019 DC AL2(LIN00075-IPDAGH) DECLARATOR 38440019 PAR00090 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 38450019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 38460019 DC AL1(PAR00091-LIN00055) POINT TO END OF OPT. ITEMS 38470019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38480019 DC AL1(001) LENGTH OF LITERAL 38490019 DC C',' 38500019 DC AL1(DEFCOMIT) LOCAL COMMIT / 38510019 DC AL1(DEFNAME) NAME OPERATOR N 38520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 38530019 DC AL1(PAR00092-LIN00055) POINT TO END OF OPT. ITEMS 38540019 DC AL1(DEFSYMBL) NEST OPERATOR 38550019 DC AL2(LIN00075-IPDAGH) DECLARATOR 38560019 PAR00092 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 38570019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 38580019 PAR00091 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 38590019 ALT00163 EQU * 38600019 BRC00064 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 38610019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 38620019 EJECT 38630019 *********************************************************************** 38640019 * * 38650019 *END = $800 : $300 * 38660019 * * 38670019 * DEFINES THE END LINE. ACTION CODE 800 PRODUCES AN F * 38680019 * IF THERE ARE ANY CHARACTERS OTHER THAN BLANKS AFTER THE * 38690019 * CHARACTERS 'END' WHICH CAUSED NESTING TO THIS LINE. * 38700019 * IF THERE WERE NO NON-BLANK CHARACTERS AFTER 'END', ACTION * 38710019 * CODE 800 PRODUCES A T, CAUSING ACTION CODE 300 TO DETECT AND * 38720019 * DIAGNOSE ANY STATEMENT LABEL OR CONTINUATION FIELD ERRORS. * 38730019 * * 38740019 *********************************************************************** 38750019 LIN00056 EQU * START OF DEFINITION 38760019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 38770019 DC AL1(ACT800) ACTION CODE 38780019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 38790019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 38800019 DC AL1(ACT300) ACTION CODE 38810019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 38820019 EJECT 38830019 *********************************************************************** 38840019 * * 38850019 *ENTRY = 'Y' : SUBORENTRY * 38860019 * * 38870019 * DEFINES THE ENTRY STATEMENT. THE * 38880019 * SYNTAX TO THE RIGHT OF THE KEYWORD IS THE * 38890019 * SAME AS THAT OF A SUBROUTINE STATEMENT, SINCE * 38900019 * IT IS NOT KNOWN WHETHER THE ENTRY STATEMENT APPEARS * 38910019 * IN A FUNCTION SUBPROGRAM OR IN A SUBROUTINE SUBPROGRAM. * 38920019 * * 38930019 *********************************************************************** 38940019 LIN00057 EQU * START OF DEFINITION 38950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38960019 DC AL1(001) LENGTH OF LITERAL 38970019 DC C'Y' 38980019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 38990019 DC AL1(DEFSYMBL) NEST OPERATOR 39000019 DC AL2(LIN00083-IPDAGH) SUBORENTRY 39010019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 39020019 EJECT 39030019 *********************************************************************** 39040019 * * 39050019 *SUBORENTRY = *33 N ( '(' / *35 DUMMYARG * 39060019 * ( ',' / DUMMYARG ... ) *13 ')' ) * 39070019 * * 39080019 * DEFINES THE FORM TO THE RIGHT OF THE KEYWORD * 39090019 * IN A SUBROUTINE OR AN ENTRY STATEMENT. * 39100019 * * 39110019 *********************************************************************** 39120019 LIN00083 EQU * START OF DEFINITION 39130019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39140019 DC AL1(COD033) ERROR CODE 39150019 DC AL1(DEFNAME) NAME OPERATOR N 39160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 39170019 DC AL1(PAR00093-LIN00083) POINT TO END OF OPT. ITEMS 39180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39190019 DC AL1(001) LENGTH OF LITERAL 39200019 DC C'(' 39210019 DC AL1(DEFCOMIT) LOCAL COMMIT / 39220019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39230019 DC AL1(COD035) ERROR CODE 39240019 DC AL1(DEFSYMBL) NEST OPERATOR 39250019 DC AL2(LIN00084-IPDAGH) DUMMYARG 39260019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 39270019 DC AL1(PAR00094-LIN00083) POINT TO END OF OPT. ITEMS 39280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39290019 DC AL1(001) LENGTH OF LITERAL 39300019 DC C',' 39310019 DC AL1(DEFCOMIT) LOCAL COMMIT / 39320019 DC AL1(DEFSYMBL) NEST OPERATOR 39330019 DC AL2(LIN00084-IPDAGH) DUMMYARG 39340019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 39350019 PAR00094 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 39360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39370019 DC AL1(COD013) ERROR CODE 39380019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39390019 DC AL1(001) LENGTH OF LITERAL 39400019 DC C')' 39410019 PAR00093 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 39420019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 39430019 EJECT 39440019 *********************************************************************** 39450019 * * 39460019 *DUMMYARG = < N ³ '/' / *33 N *38 '/' ³ '*' > * 39470019 * * 39480019 * DEFINES DUMMY ARGUMENTS. DUMMY ARGUMENTS * 39490019 * SATISFYING THIS DEFINITION MAY BE USED IN * 39500019 * EITHER A SUBROUTINE OR AN ENTRY STATEMENT. * 39510019 * * 39520019 *********************************************************************** 39530019 LIN00084 EQU * START OF DEFINITION 39540019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 39550019 DC AL1(ALT00164-LIN00084) FALSE DISP. 39560019 DC AL1(BRC00065-LIN00084) TRUE DISP. 39570019 DC AL1(DEFNAME) NAME OPERATOR N 39580019 ALT00164 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 39590019 DC AL1(ALT00165-LIN00084) FALSE DISP. 39600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39610019 DC AL1(001) LENGTH OF LITERAL 39620019 DC C'/' 39630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 39640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39650019 DC AL1(COD033) ERROR CODE 39660019 DC AL1(DEFNAME) NAME OPERATOR N 39670019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39680019 DC AL1(COD038) ERROR CODE 39690019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39700019 DC AL1(001) LENGTH OF LITERAL 39710019 DC C'/' 39720019 ALT00165 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 39730019 DC AL1(ALT00166-LIN00084) FALSE DISP. 39740019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39750019 DC AL1(001) LENGTH OF LITERAL 39760019 DC C'*' 39770019 ALT00166 EQU * 39780019 BRC00065 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 39790019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 39800019 EJECT 39810019 *********************************************************************** 39820019 * * 39830019 *EQUIVALENCE = 'VALENCE' : *30 '(' *33 N ( DECLARATOR2 ) * 39840019 * *53 ',' *33 N ( DECLARATOR2 ) ( ',' / N * 39850019 * ( DECLARATOR2 ) ... ) *12 ')' ( ',' / *30 '(' * 39860019 * *33 N ( DECLARATOR2 ) *53 ',' *33 N ( DECLARATOR2 ) * 39870019 * ( ',' / N ( DECLARATOR2 ) ... ) *13 ')' ... ) * 39880019 * * 39890019 * DEFINES THE EQUIVALENCE STATEMENT. NONE OF THE * 39900019 * DECLARATORS IN THIS STATEMENT MAY CONTAIN A * 39910019 * SYMBOLIC NAME INSTEAD OF AN INTEGER CONSTANT. * 39920019 * AS IN THE DEFINEFILE DEFINITION, THE FIRST * 39930019 * TWO AND-A-HALF LINES OF THIS DEFINITION * 39940019 * DESCRIBE THE BASIC FORM. * 39950019 * * 39960019 *********************************************************************** 39970019 LIN00058 EQU * START OF DEFINITION 39980019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39990019 DC AL1(007) LENGTH OF LITERAL 40000019 DC C'VALENCE' 40010019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 40020019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40030019 DC AL1(COD030) ERROR CODE 40040019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40050019 DC AL1(001) LENGTH OF LITERAL 40060019 DC C'(' 40070019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40080019 DC AL1(COD033) ERROR CODE 40090019 DC AL1(DEFNAME) NAME OPERATOR N 40100019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40110019 DC AL1(PAR00095-LIN00058) POINT TO END OF OPT. ITEMS 40120019 DC AL1(DEFSYMBL) NEST OPERATOR 40130019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40140019 PAR00095 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40150019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40160019 DC AL1(COD053) ERROR CODE 40170019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40180019 DC AL1(001) LENGTH OF LITERAL 40190019 DC C',' 40200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40210019 DC AL1(COD033) ERROR CODE 40220019 DC AL1(DEFNAME) NAME OPERATOR N 40230019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40240019 DC AL1(PAR00096-LIN00058) POINT TO END OF OPT. ITEMS 40250019 DC AL1(DEFSYMBL) NEST OPERATOR 40260019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40270019 PAR00096 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40280019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40290019 DC AL1(PAR00097-LIN00058) POINT TO END OF OPT. ITEMS 40300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40310019 DC AL1(001) LENGTH OF LITERAL 40320019 DC C',' 40330019 DC AL1(DEFCOMIT) LOCAL COMMIT / 40340019 DC AL1(DEFNAME) NAME OPERATOR N 40350019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40360019 DC AL1(PAR00098-LIN00058) POINT TO END OF OPT. ITEMS 40370019 DC AL1(DEFSYMBL) NEST OPERATOR 40380019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40390019 PAR00098 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40400019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 40410019 PAR00097 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40420019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40430019 DC AL1(COD012) ERROR CODE 40440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40450019 DC AL1(001) LENGTH OF LITERAL 40460019 DC C')' 40470019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40480019 DC AL1(PAR00099-LIN00058) POINT TO END OF OPT. ITEMS 40490019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40500019 DC AL1(001) LENGTH OF LITERAL 40510019 DC C',' 40520019 DC AL1(DEFCOMIT) LOCAL COMMIT / 40530019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40540019 DC AL1(COD030) ERROR CODE 40550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40560019 DC AL1(001) LENGTH OF LITERAL 40570019 DC C'(' 40580019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40590019 DC AL1(COD033) ERROR CODE 40600019 DC AL1(DEFNAME) NAME OPERATOR N 40610019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40620019 DC AL1(PAR00100-LIN00058) POINT TO END OF OPT. ITEMS 40630019 DC AL1(DEFSYMBL) NEST OPERATOR 40640019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40650019 PAR00100 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40660019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40670019 DC AL1(COD053) ERROR CODE 40680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40690019 DC AL1(001) LENGTH OF LITERAL 40700019 DC C',' 40710019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40720019 DC AL1(COD033) ERROR CODE 40730019 DC AL1(DEFNAME) NAME OPERATOR N 40740019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40750019 DC AL1(PAR00101-LIN00058) POINT TO END OF OPT. ITEMS 40760019 DC AL1(DEFSYMBL) NEST OPERATOR 40770019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40780019 PAR00101 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40790019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40800019 DC AL1(PAR00102-LIN00058) POINT TO END OF OPT. ITEMS 40810019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40820019 DC AL1(001) LENGTH OF LITERAL 40830019 DC C',' 40840019 DC AL1(DEFCOMIT) LOCAL COMMIT / 40850019 DC AL1(DEFNAME) NAME OPERATOR N 40860019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40870019 DC AL1(PAR00103-LIN00058) POINT TO END OF OPT. ITEMS 40880019 DC AL1(DEFSYMBL) NEST OPERATOR 40890019 DC AL2(LIN00070-IPDAGH) DECLARATOR2 40900019 PAR00103 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40910019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 40920019 PAR00102 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40930019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40940019 DC AL1(COD013) ERROR CODE 40950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40960019 DC AL1(001) LENGTH OF LITERAL 40970019 DC C')' 40980019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 40990019 PAR00099 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 41000019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 41010019 EJECT 41020019 *********************************************************************** 41030019 * * 41040019 *EXTERNAL = 'RNAL' : *33 N ( ',' / N ... ) * 41050019 * * 41060019 * DEFINES THE EXTERNAL STATEMENT. * 41070019 * * 41080019 *********************************************************************** 41090019 LIN00059 EQU * START OF DEFINITION 41100019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41110019 DC AL1(004) LENGTH OF LITERAL 41120019 DC C'RNAL' 41130019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 41140019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 41150019 DC AL1(COD033) ERROR CODE 41160019 DC AL1(DEFNAME) NAME OPERATOR N 41170019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 41180019 DC AL1(PAR00104-LIN00059) POINT TO END OF OPT. ITEMS 41190019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41200019 DC AL1(001) LENGTH OF LITERAL 41210019 DC C',' 41220019 DC AL1(DEFCOMIT) LOCAL COMMIT / 41230019 DC AL1(DEFNAME) NAME OPERATOR N 41240019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 41250019 PAR00104 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 41260019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 41270019 EJECT 41280019 *********************************************************************** 41290019 * * 41300019 *FORMAT = 'AT' : $301 *30 '(' *77 ( '/' ... ) ( GROUP * 41310019 * ( < ',' / GROUP ³ '/' ( '/' ... ) GROUP > * 41320019 * ... ) ( '/' ... ) ) ')' * 41330019 * * 41340019 * DEFINES THE FORMAT STATEMENT. ESSENTIALLY, * 41350019 * THE DEFINITION IS A PARENTHESIZED LIST OF * 41360019 * GROUPS. (GROUP IS DEFINED ON ANOTHER LINE) * 41370019 * EACH DELIMITER IN THE LIST IS EITHER A COMMA * 41380019 * OR ANY NUMBER OF SLASHES. OPTIONALLY, THERE * 41390019 * MAY BE ANY NUMBER OF SLASHES BEFORE THE * 41400019 * FIRST GROUP IN THE LIST, OR AFTER THE LAST * 41410019 * GROUP IN THE LIST, OR BOTH. THERE * 41420019 * NEED NOT BE ANY GROUPS AT ALL. THE * 41430019 * LAST SET OF OPTIONAL SLASHES IS INCLUDED IN * 41440019 * THE OPTIONAL PARENTHESES FOR THE LIST * 41450019 * OF GROUPS BECAUSE, IF THERE ARE NO * 41460019 * GROUPS, THE FIRST SET OF OPTIONAL SLASHES * 41470019 * WILL HAVE MATCHED ALL THE VALID CHARACTERS * 41480019 * WITHIN THE SOURCE'S PARENTHESES. THE * 41490019 * MESSAGE ISSUED WHEN A RIGHT PARENTHESIS IS * 41500019 * NOT FOUND IS "DELIMITER MISSING OR INVALID * 41510019 * FORMAT CODE" SINCE ANY FAILURE TO MATCH * 41520019 * THE RIGHT PARENTHESIS LITERAL IS PROBABLY * 41530019 * DUE TO ONE OF THESE CAUSES. * 41540019 * * 41550019 *********************************************************************** 41560019 LIN00060 EQU * START OF DEFINITION 41570019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41580019 DC AL1(002) LENGTH OF LITERAL 41590019 DC C'AT' 41600019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 41610019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 41620019 DC AL1(ACT301) ACTION CODE 41630019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 41640019 DC AL1(COD030) ERROR CODE 41650019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41660019 DC AL1(001) LENGTH OF LITERAL 41670019 DC C'(' 41680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 41690019 DC AL1(COD077) ERROR CODE 41700019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 41710019 DC AL1(PAR00105-LIN00060) POINT TO END OF OPT. ITEMS 41720019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41730019 DC AL1(001) LENGTH OF LITERAL 41740019 DC C'/' 41750019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 41760019 PAR00105 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 41770019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 41780019 DC AL1(PAR00106-LIN00060) POINT TO END OF OPT. ITEMS 41790019 DC AL1(DEFSYMBL) NEST OPERATOR 41800019 DC AL2(LIN00085-IPDAGH) GROUP 41810019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 41820019 DC AL1(PAR00107-LIN00060) POINT TO END OF OPT. ITEMS 41830019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 41840019 DC AL1(ALT00167-LIN00060) FALSE DISP. 41850019 DC AL1(BRC00066-LIN00060) TRUE DISP. 41860019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41870019 DC AL1(001) LENGTH OF LITERAL 41880019 DC C',' 41890019 DC AL1(DEFCOMIT) LOCAL COMMIT / 41900019 DC AL1(DEFSYMBL) NEST OPERATOR 41910019 DC AL2(LIN00085-IPDAGH) GROUP 41920019 ALT00167 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 41930019 DC AL1(ALT00168-LIN00060) FALSE DISP. 41940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41950019 DC AL1(001) LENGTH OF LITERAL 41960019 DC C'/' 41970019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 41980019 DC AL1(PAR00108-LIN00060) POINT TO END OF OPT. ITEMS 41990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42000019 DC AL1(001) LENGTH OF LITERAL 42010019 DC C'/' 42020019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 42030019 PAR00108 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42040019 DC AL1(DEFSYMBL) NEST OPERATOR 42050019 DC AL2(LIN00085-IPDAGH) GROUP 42060019 ALT00168 EQU * 42070019 BRC00066 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 42080019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 42090019 PAR00107 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42100019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42110019 DC AL1(PAR00109-LIN00060) POINT TO END OF OPT. ITEMS 42120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42130019 DC AL1(001) LENGTH OF LITERAL 42140019 DC C'/' 42150019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 42160019 PAR00109 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42170019 PAR00106 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42190019 DC AL1(001) LENGTH OF LITERAL 42200019 DC C')' 42210019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 42220019 EJECT 42230019 *********************************************************************** 42240019 * * 42250019 *GROUP = < FIELDESCR ³ ( $700 ) '(' / ( '/' ... ) * 42260019 * ( GROUP2 ( < ',' / GROUP2 ³ '/' ( '/' ... ) * 42270019 * GROUP2 > ... ) ( '/' ... ) ) ')' > * 42280019 * * 42290019 * DEFINES GROUP FOR USE IN THE FORMAT DEFINITION. * 42300019 * A GROUP IS EITHER A FIELD DESCRIPTOR OR * 42310019 * ANOTHER FORM THAT IS ESSENTIALLY THE SAME AS A * 42320019 * FORMAT. THE DIFFERENCES BETWEEN FORMAT AND * 42330019 * THE SECOND FORM ARE 1) THE SECOND FORM OF * 42340019 * GROUP MAY HAVE A REPEAT COUNT BEFORE THE * 42350019 * INITIAL LEFT PARENTHESIS (ACTION CODE 700 * 42360019 * ADVANCES THE SOURCE POINTER PAST THIS COUNT * 42370019 * IF IT IS PRESENT), AND 2) THE ITEMS * 42380019 * IN THE PARENTHESIZED LIST ARE EACH GROUP2 * 42390019 * INSTEAD OF GROUP. THE SECOND DIFFERENCE * 42400019 * IS NECESSARY TO AVOID ALLOWING AN INDEFINITE NUMBER * 42410019 * OF LEVELS OF NESTING OF PARENTHESES IN FORMAT * 42420019 * STATEMENTS. FORTRAN ALLOWS ONLY TWO LEVELS * 42430019 * OF NESTING INSIDE THE PARENTHESES WHICH ENCLOSE * 42440019 * THE ENTIRE FORMAT SPECIFICATION. * 42450019 * * 42460019 *********************************************************************** 42470019 LIN00085 EQU * START OF DEFINITION 42480019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 42490019 DC AL1(ALT00169-LIN00085) FALSE DISP. 42500019 DC AL1(BRC00067-LIN00085) TRUE DISP. 42510019 DC AL1(DEFSYMBL) NEST OPERATOR 42520019 DC AL2(LIN00086-IPDAGH) FIELDESCR 42530019 ALT00169 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 42540019 DC AL1(ALT00170-LIN00085) FALSE DISP. 42550019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42560019 DC AL1(PAR00110-LIN00085) POINT TO END OF OPT. ITEMS 42570019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 42580019 DC AL1(ACT700) ACTION CODE 42590019 PAR00110 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42610019 DC AL1(001) LENGTH OF LITERAL 42620019 DC C'(' 42630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 42640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42650019 DC AL1(PAR00111-LIN00085) POINT TO END OF OPT. ITEMS 42660019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42670019 DC AL1(001) LENGTH OF LITERAL 42680019 DC C'/' 42690019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 42700019 PAR00111 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42710019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42720019 DC AL1(PAR00112-LIN00085) POINT TO END OF OPT. ITEMS 42730019 DC AL1(DEFSYMBL) NEST OPERATOR 42740019 DC AL2(LIN00087-IPDAGH) GROUP2 42750019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42760019 DC AL1(PAR00113-LIN00085) POINT TO END OF OPT. ITEMS 42770019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 42780019 DC AL1(ALT00171-LIN00085) FALSE DISP. 42790019 DC AL1(BRC00068-LIN00085) TRUE DISP. 42800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42810019 DC AL1(001) LENGTH OF LITERAL 42820019 DC C',' 42830019 DC AL1(DEFCOMIT) LOCAL COMMIT / 42840019 DC AL1(DEFSYMBL) NEST OPERATOR 42850019 DC AL2(LIN00087-IPDAGH) GROUP2 42860019 ALT00171 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 42870019 DC AL1(ALT00172-LIN00085) FALSE DISP. 42880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42890019 DC AL1(001) LENGTH OF LITERAL 42900019 DC C'/' 42910019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42920019 DC AL1(PAR00114-LIN00085) POINT TO END OF OPT. ITEMS 42930019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 42940019 DC AL1(001) LENGTH OF LITERAL 42950019 DC C'/' 42960019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 42970019 PAR00114 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42980019 DC AL1(DEFSYMBL) NEST OPERATOR 42990019 DC AL2(LIN00087-IPDAGH) GROUP2 43000019 ALT00172 EQU * 43010019 BRC00068 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 43020019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 43030019 PAR00113 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43050019 DC AL1(PAR00115-LIN00085) POINT TO END OF OPT. ITEMS 43060019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43070019 DC AL1(001) LENGTH OF LITERAL 43080019 DC C'/' 43090019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 43100019 PAR00115 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43110019 PAR00112 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43130019 DC AL1(001) LENGTH OF LITERAL 43140019 DC C')' 43150019 ALT00170 EQU * 43160019 BRC00067 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 43170019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 43180019 EJECT 43190019 *********************************************************************** 43200019 * * 43210019 *GROUP2 = < FIELDESCR ³ ( $700 ) '(' / ( < '/' ³ * 43220019 * ( $700 ) '(' / *69 $801 > ... ) * 43230019 * ( FIELDESCR ( < ',' / FIELDESCR ³ '/' ( * 43240019 * < '/' ³ ( $700 ) '(' / *69 $801 > ... ) * 43250019 * FIELDESCR > ... ) ( '/' ... ) ) ')' > * 43260019 * * 43270019 * DEFINES GROUP2 FOR USE IN GROUP. AGAIN, * 43280019 * THE SECOND FORM IS ESSENTIALLY THE SAME AS A * 43290019 * FORMAT WITH AN OPTIONAL REPEAT SPECIFICATION. * 43300019 * HOWEVER, IF THE SECOND ALTERNATIVE IS REACHED, THE * 43310019 * SOURCE IS ON THE SECOND LEVEL OF PARENTHESIS * 43320019 * NESTING, SO ONLY FIELD DESCRIPTORS, AND * 43330019 * NOT PARENTHESIZED LISTS, MAY BE MEMBERS * 43340019 * OF THE PARENTHESIZED LIST. * 43350019 * * 43360019 * ACTION CODE 801 IS USED TO ISSUE A MESSAGE * 43370019 * DIAGNOSING TOO MANY LEVELS OF PARENTHESES IF ANY * 43380019 * LEFT PARENTHESIS IS FOUND WITHIN THE PARENTHESES * 43390019 * WHICH ENCLOSE THE REST OF THE SECOND ALTERNATIVE. * 43400019 * * 43410019 *********************************************************************** 43420019 LIN00087 EQU * START OF DEFINITION 43430019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 43440019 DC AL1(ALT00173-LIN00087) FALSE DISP. 43450019 DC AL1(BRC00069-LIN00087) TRUE DISP. 43460019 DC AL1(DEFSYMBL) NEST OPERATOR 43470019 DC AL2(LIN00086-IPDAGH) FIELDESCR 43480019 ALT00173 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 43490019 DC AL1(ALT00174-LIN00087) FALSE DISP. 43500019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43510019 DC AL1(PAR00116-LIN00087) POINT TO END OF OPT. ITEMS 43520019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 43530019 DC AL1(ACT700) ACTION CODE 43540019 PAR00116 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43560019 DC AL1(001) LENGTH OF LITERAL 43570019 DC C'(' 43580019 DC AL1(DEFCOMIT) LOCAL COMMIT / 43590019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43600019 DC AL1(PAR00117-LIN00087) POINT TO END OF OPT. ITEMS 43610019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 43620019 DC AL1(ALT00175-LIN00087) FALSE DISP. 43630019 DC AL1(BRC00070-LIN00087) TRUE DISP. 43640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43650019 DC AL1(001) LENGTH OF LITERAL 43660019 DC C'/' 43670019 ALT00175 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 43680019 DC AL1(ALT00176-LIN00087) FALSE DISP. 43690019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43700019 DC AL1(PAR00118-LIN00087) POINT TO END OF OPT. ITEMS 43710019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 43720019 DC AL1(ACT700) ACTION CODE 43730019 PAR00118 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43740019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43750019 DC AL1(001) LENGTH OF LITERAL 43760019 DC C'(' 43770019 DC AL1(DEFCOMIT) LOCAL COMMIT / 43780019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 43790019 DC AL1(COD069) ERROR CODE 43800019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 43810019 DC AL1(ACT801) ACTION CODE 43820019 ALT00176 EQU * 43830019 BRC00070 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 43840019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 43850019 PAR00117 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43860019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43870019 DC AL1(PAR00119-LIN00087) POINT TO END OF OPT. ITEMS 43880019 DC AL1(DEFSYMBL) NEST OPERATOR 43890019 DC AL2(LIN00086-IPDAGH) FIELDESCR 43900019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43910019 DC AL1(PAR00120-LIN00087) POINT TO END OF OPT. ITEMS 43920019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 43930019 DC AL1(ALT00177-LIN00087) FALSE DISP. 43940019 DC AL1(BRC00071-LIN00087) TRUE DISP. 43950019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43960019 DC AL1(001) LENGTH OF LITERAL 43970019 DC C',' 43980019 DC AL1(DEFCOMIT) LOCAL COMMIT / 43990019 DC AL1(DEFSYMBL) NEST OPERATOR 44000019 DC AL2(LIN00086-IPDAGH) FIELDESCR 44010019 ALT00177 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 44020019 DC AL1(ALT00178-LIN00087) FALSE DISP. 44030019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44040019 DC AL1(001) LENGTH OF LITERAL 44050019 DC C'/' 44060019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 44070019 DC AL1(PAR00121-LIN00087) POINT TO END OF OPT. ITEMS 44080019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 44090019 DC AL1(ALT00179-LIN00087) FALSE DISP. 44100019 DC AL1(BRC00072-LIN00087) TRUE DISP. 44110019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44120019 DC AL1(001) LENGTH OF LITERAL 44130019 DC C'/' 44140019 ALT00179 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 44150019 DC AL1(ALT00180-LIN00087) FALSE DISP. 44160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 44170019 DC AL1(PAR00122-LIN00087) POINT TO END OF OPT. ITEMS 44180019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44190019 DC AL1(ACT700) ACTION CODE 44200019 PAR00122 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44220019 DC AL1(001) LENGTH OF LITERAL 44230019 DC C'(' 44240019 DC AL1(DEFCOMIT) LOCAL COMMIT / 44250019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 44260019 DC AL1(COD069) ERROR CODE 44270019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44280019 DC AL1(ACT801) ACTION CODE 44290019 ALT00180 EQU * 44300019 BRC00072 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 44310019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 44320019 PAR00121 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44330019 DC AL1(DEFSYMBL) NEST OPERATOR 44340019 DC AL2(LIN00086-IPDAGH) FIELDESCR 44350019 ALT00178 EQU * 44360019 BRC00071 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 44370019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 44380019 PAR00120 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44390019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 44400019 DC AL1(PAR00123-LIN00087) POINT TO END OF OPT. ITEMS 44410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44420019 DC AL1(001) LENGTH OF LITERAL 44430019 DC C'/' 44440019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 44450019 PAR00123 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44460019 PAR00119 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44470019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44480019 DC AL1(001) LENGTH OF LITERAL 44490019 DC C')' 44500019 ALT00174 EQU * 44510019 BRC00069 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 44520019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 44530019 EJECT 44540019 *********************************************************************** 44550019 * * 44560019 *FIELDESCR = < C ³ $700 'X' ³ ( $700 ) * 44570019 * < < 'E' ³ 'F' ³ 'D' > / $700 *80 '.' $701 * 44580019 * ³ 'G' / $700 ( '.' / *80 $701 ) * 44590019 * ³ < 'I' ³ 'A' ³ 'L' ³ 'Z' > / $700 > * 44600019 * ³ H ³ 'T' / $700 * 44610019 * ³ ( '-' ) < $700 ³ '0' ( '0' ... ) > 'P' ( $700 ) * 44620019 * < < 'E' ³ 'F' ³ 'D' > / $700 *80 '.' $701 * 44630019 * ³ 'G' / $700 ( '.' / *80 $701 ) > > * 44640019 * * 44650019 * DEFINES ALL THE FIELD DESCRIPTORS WHICH MAY * 44660019 * APPEAR IN A FORMAT STATEMENT. * 44670019 * * 44680019 *********************************************************************** 44690019 LIN00086 EQU * START OF DEFINITION 44700019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 44710019 DC AL1(ALT00181-LIN00086) FALSE DISP. 44720019 DC AL1(BRC00073-LIN00086) TRUE DISP. 44730019 DC AL1(DEFCSTRG) CHARACTER STRING C 44740019 ALT00181 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 44750019 DC AL1(ALT00182-LIN00086) FALSE DISP. 44760019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44770019 DC AL1(ACT700) ACTION CODE 44780019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44790019 DC AL1(001) LENGTH OF LITERAL 44800019 DC C'X' 44810019 ALT00182 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 44820019 DC AL1(ALT00183-LIN00086) FALSE DISP. 44830019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 44840019 DC AL1(PAR00124-LIN00086) POINT TO END OF OPT. ITEMS 44850019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44860019 DC AL1(ACT700) ACTION CODE 44870019 PAR00124 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 44880019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 44890019 DC AL1(ALT00184-LIN00086) FALSE DISP. 44900019 DC AL1(BRC00074-LIN00086) TRUE DISP. 44910019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 44920019 DC AL1(ALT00185-LIN00086) FALSE DISP. 44930019 DC AL1(BRC00075-LIN00086) TRUE DISP. 44940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 44950019 DC AL1(001) LENGTH OF LITERAL 44960019 DC C'E' 44970019 ALT00185 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 44980019 DC AL1(ALT00186-LIN00086) FALSE DISP. 44990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45000019 DC AL1(001) LENGTH OF LITERAL 45010019 DC C'F' 45020019 ALT00186 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45030019 DC AL1(ALT00187-LIN00086) FALSE DISP. 45040019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45050019 DC AL1(001) LENGTH OF LITERAL 45060019 DC C'D' 45070019 ALT00187 EQU * 45080019 BRC00075 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 45090019 DC AL1(DEFCOMIT) LOCAL COMMIT / 45100019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45110019 DC AL1(ACT700) ACTION CODE 45120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 45130019 DC AL1(COD080) ERROR CODE 45140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45150019 DC AL1(001) LENGTH OF LITERAL 45160019 DC C'.' 45170019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45180019 DC AL1(ACT701) ACTION CODE 45190019 ALT00184 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45200019 DC AL1(ALT00188-LIN00086) FALSE DISP. 45210019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45220019 DC AL1(001) LENGTH OF LITERAL 45230019 DC C'G' 45240019 DC AL1(DEFCOMIT) LOCAL COMMIT / 45250019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45260019 DC AL1(ACT700) ACTION CODE 45270019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 45280019 DC AL1(PAR00125-LIN00086) POINT TO END OF OPT. ITEMS 45290019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45300019 DC AL1(001) LENGTH OF LITERAL 45310019 DC C'.' 45320019 DC AL1(DEFCOMIT) LOCAL COMMIT / 45330019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 45340019 DC AL1(COD080) ERROR CODE 45350019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45360019 DC AL1(ACT701) ACTION CODE 45370019 PAR00125 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 45380019 ALT00188 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45390019 DC AL1(ALT00189-LIN00086) FALSE DISP. 45400019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 45410019 DC AL1(ALT00190-LIN00086) FALSE DISP. 45420019 DC AL1(BRC00076-LIN00086) TRUE DISP. 45430019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45440019 DC AL1(001) LENGTH OF LITERAL 45450019 DC C'I' 45460019 ALT00190 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45470019 DC AL1(ALT00191-LIN00086) FALSE DISP. 45480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45490019 DC AL1(001) LENGTH OF LITERAL 45500019 DC C'A' 45510019 ALT00191 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45520019 DC AL1(ALT00192-LIN00086) FALSE DISP. 45530019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45540019 DC AL1(001) LENGTH OF LITERAL 45550019 DC C'L' 45560019 ALT00192 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45570019 DC AL1(ALT00193-LIN00086) FALSE DISP. 45580019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45590019 DC AL1(001) LENGTH OF LITERAL 45600019 DC C'Z' 45610019 ALT00193 EQU * 45620019 BRC00076 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 45630019 DC AL1(DEFCOMIT) LOCAL COMMIT / 45640019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45650019 DC AL1(ACT700) ACTION CODE 45660019 ALT00189 EQU * 45670019 BRC00074 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 45680019 ALT00183 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45690019 DC AL1(ALT00194-LIN00086) FALSE DISP. 45700019 DC AL1(DEFHOLLR) HOLLERITH OPERATOR H 45710019 ALT00194 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45720019 DC AL1(ALT00195-LIN00086) FALSE DISP. 45730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45740019 DC AL1(001) LENGTH OF LITERAL 45750019 DC C'T' 45760019 DC AL1(DEFCOMIT) LOCAL COMMIT / 45770019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45780019 DC AL1(ACT700) ACTION CODE 45790019 ALT00195 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45800019 DC AL1(ALT00196-LIN00086) FALSE DISP. 45810019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 45820019 DC AL1(PAR00126-LIN00086) POINT TO END OF OPT. ITEMS 45830019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45840019 DC AL1(001) LENGTH OF LITERAL 45850019 DC C'-' 45860019 PAR00126 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 45870019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 45880019 DC AL1(ALT00197-LIN00086) FALSE DISP. 45890019 DC AL1(BRC00077-LIN00086) TRUE DISP. 45900019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 45910019 DC AL1(ACT700) ACTION CODE 45920019 ALT00197 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 45930019 DC AL1(ALT00198-LIN00086) FALSE DISP. 45940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45950019 DC AL1(001) LENGTH OF LITERAL 45960019 DC C'0' 45970019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 45980019 DC AL1(PAR00127-LIN00086) POINT TO END OF OPT. ITEMS 45990019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46000019 DC AL1(001) LENGTH OF LITERAL 46010019 DC C'0' 46020019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 46030019 PAR00127 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 46040019 ALT00198 EQU * 46050019 BRC00077 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 46060019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46070019 DC AL1(001) LENGTH OF LITERAL 46080019 DC C'P' 46090019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 46100019 DC AL1(PAR00128-LIN00086) POINT TO END OF OPT. ITEMS 46110019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 46120019 DC AL1(ACT700) ACTION CODE 46130019 PAR00128 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 46140019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 46150019 DC AL1(ALT00199-LIN00086) FALSE DISP. 46160019 DC AL1(BRC00078-LIN00086) TRUE DISP. 46170019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 46180019 DC AL1(ALT00200-LIN00086) FALSE DISP. 46190019 DC AL1(BRC00079-LIN00086) TRUE DISP. 46200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46210019 DC AL1(001) LENGTH OF LITERAL 46220019 DC C'E' 46230019 ALT00200 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 46240019 DC AL1(ALT00201-LIN00086) FALSE DISP. 46250019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46260019 DC AL1(001) LENGTH OF LITERAL 46270019 DC C'F' 46280019 ALT00201 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 46290019 DC AL1(ALT00202-LIN00086) FALSE DISP. 46300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46310019 DC AL1(001) LENGTH OF LITERAL 46320019 DC C'D' 46330019 ALT00202 EQU * 46340019 BRC00079 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 46350019 DC AL1(DEFCOMIT) LOCAL COMMIT / 46360019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 46370019 DC AL1(ACT700) ACTION CODE 46380019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46390019 DC AL1(COD080) ERROR CODE 46400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46410019 DC AL1(001) LENGTH OF LITERAL 46420019 DC C'.' 46430019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 46440019 DC AL1(ACT701) ACTION CODE 46450019 ALT00199 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 46460019 DC AL1(ALT00203-LIN00086) FALSE DISP. 46470019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46480019 DC AL1(001) LENGTH OF LITERAL 46490019 DC C'G' 46500019 DC AL1(DEFCOMIT) LOCAL COMMIT / 46510019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 46520019 DC AL1(ACT700) ACTION CODE 46530019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 46540019 DC AL1(PAR00129-LIN00086) POINT TO END OF OPT. ITEMS 46550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46560019 DC AL1(001) LENGTH OF LITERAL 46570019 DC C'.' 46580019 DC AL1(DEFCOMIT) LOCAL COMMIT / 46590019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46600019 DC AL1(COD080) ERROR CODE 46610019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 46620019 DC AL1(ACT701) ACTION CODE 46630019 PAR00129 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 46640019 ALT00203 EQU * 46650019 BRC00078 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 46660019 ALT00196 EQU * 46670019 BRC00073 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 46680019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 46690019 EJECT 46700019 *********************************************************************** 46710019 * * 46720019 *FUNCTION = 'TION' : *33 N FUNCTIONARGS * 46730019 * * 46740019 * DEFINITION OF THE FUNCTION STATEMENT WITH NO * 46750019 * LENGTH SPECIFICATION PERMITTED. USED FOR * 46760019 * FUNCTION STATEMENTS NOT PRECEDED BY A TYPE. * 46770019 * * 46780019 *********************************************************************** 46790019 LIN00061 EQU * START OF DEFINITION 46800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46810019 DC AL1(004) LENGTH OF LITERAL 46820019 DC C'TION' 46830019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 46840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46850019 DC AL1(COD033) ERROR CODE 46860019 DC AL1(DEFNAME) NAME OPERATOR N 46870019 DC AL1(DEFSYMBL) NEST OPERATOR 46880019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 46890019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 46900019 EJECT 46910019 *********************************************************************** 46920019 * * 46930019 *IMPLICIT = 'ICIT' : *41 +TYPE *31 '(' $500 ( ',' / $500 * 46940019 * ... ) *13 ')' ( ',' / *41 +TYPE *31 '(' $500 * 46950019 * ( ',' / $500 ... ) *13 ')' ... ) * 46960019 * * 46970019 * DEFINES THE IMPLICIT STATEMENT. ACTION CODE * 46980019 * 500 IS USED FOR THE ELEMENTS OF THE LISTS * 46990019 * THAT MAY APPEAR IN IMPLICIT STATEMENTS. THE * 47000019 * ACTION CODE CHECKS FOR THE SYNTAX * 47010019 * * 47020019 * L ( '-' / L ) * 47030019 * * 47040019 * THIS COULD BE DONE BY AN ORDINARY SYNTACTIC * 47050019 * DEFINITION, BUT THE ACTION CODE PERFORMS AN * 47060019 * ADDITIONAL TEST OF THE FORM WITH TWO LETTERS * 47070019 * WHICH COULD NOT BE DONE IN ORDINARY SYNTAX. * 47080019 * IF THE SECOND LETTER IS NOT LATER IN THE ALPHABETIC * 47090019 * SEQUENCE THAN THE FIRST, ACTION CODE 500 * 47100019 * ISSUES AN ERROR MESSAGE. * 47110019 * * 47120019 *********************************************************************** 47130019 LIN00062 EQU * START OF DEFINITION 47140019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47150019 DC AL1(004) LENGTH OF LITERAL 47160019 DC C'ICIT' 47170019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 47180019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47190019 DC AL1(COD041) ERROR CODE 47200019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 47210019 DC AL2(LIN00088-IPDAGH) TYPE 47220019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47230019 DC AL1(COD031) ERROR CODE 47240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47250019 DC AL1(001) LENGTH OF LITERAL 47260019 DC C'(' 47270019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 47280019 DC AL1(ACT500) ACTION CODE 47290019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 47300019 DC AL1(PAR00130-LIN00062) POINT TO END OF OPT. ITEMS 47310019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47320019 DC AL1(001) LENGTH OF LITERAL 47330019 DC C',' 47340019 DC AL1(DEFCOMIT) LOCAL COMMIT / 47350019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 47360019 DC AL1(ACT500) ACTION CODE 47370019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 47380019 PAR00130 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 47390019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47400019 DC AL1(COD013) ERROR CODE 47410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47420019 DC AL1(001) LENGTH OF LITERAL 47430019 DC C')' 47440019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 47450019 DC AL1(PAR00131-LIN00062) POINT TO END OF OPT. ITEMS 47460019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47470019 DC AL1(001) LENGTH OF LITERAL 47480019 DC C',' 47490019 DC AL1(DEFCOMIT) LOCAL COMMIT / 47500019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47510019 DC AL1(COD041) ERROR CODE 47520019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 47530019 DC AL2(LIN00088-IPDAGH) TYPE 47540019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47550019 DC AL1(COD031) ERROR CODE 47560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47570019 DC AL1(001) LENGTH OF LITERAL 47580019 DC C'(' 47590019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 47600019 DC AL1(ACT500) ACTION CODE 47610019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 47620019 DC AL1(PAR00132-LIN00062) POINT TO END OF OPT. ITEMS 47630019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47640019 DC AL1(001) LENGTH OF LITERAL 47650019 DC C',' 47660019 DC AL1(DEFCOMIT) LOCAL COMMIT / 47670019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 47680019 DC AL1(ACT500) ACTION CODE 47690019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 47700019 PAR00132 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 47710019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47720019 DC AL1(COD013) ERROR CODE 47730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47740019 DC AL1(001) LENGTH OF LITERAL 47750019 DC C')' 47760019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 47770019 PAR00131 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 47780019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 47790019 EJECT 47800019 *********************************************************************** 47810019 * * 47820019 *TYPE = " 'REAL' RLENGTH 'INTEGER' ILENGTH * 47830019 * 'COMPLEX' CLENGTH 'LOGICAL' LLENGTH " * 47840019 * * 47850019 * TABLE DEFINING THE TYPE AND LENGTH SPECIFICATIONS * 47860019 * THAT CAN APPEAR IN THE IMPLICIT STATEMENT. * 47870019 * * 47880019 *********************************************************************** 47890019 LIN00088 EQU * START OF DEFINITION 47900019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 47910019 DC AL2(TAB00006-*+1) LENGTH OF TABLE 47920019 DC AL1(004) LENGTH OF LITERAL 47930019 DC C'REAL' 47940019 DC AL1(DEFSYMBL) NEST OPERATOR 47950019 DC AL2(LIN00089-IPDAGH) RLENGTH 47960019 DC AL1(007) LENGTH OF LITERAL 47970019 DC C'INTEGER' 47980019 DC AL1(DEFSYMBL) NEST OPERATOR 47990019 DC AL2(LIN00090-IPDAGH) ILENGTH 48000019 DC AL1(007) LENGTH OF LITERAL 48010019 DC C'COMPLEX' 48020019 DC AL1(DEFSYMBL) NEST OPERATOR 48030019 DC AL2(LIN00071-IPDAGH) CLENGTH 48040019 DC AL1(007) LENGTH OF LITERAL 48050019 DC C'LOGICAL' 48060019 DC AL1(DEFSYMBL) NEST OPERATOR 48070019 DC AL2(LIN00091-IPDAGH) LLENGTH 48080019 TAB00006 DC AL1(007) LENGTH OF LONGEST TABLE ARG 48090019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 48100019 EJECT 48110019 *********************************************************************** 48120019 * * 48130019 *INTEGER = 'GER' < 'FUNCTION' : *33 N ILENGTH * 48140019 * FUNCTIONARGS ³ '*' ( D ... ) 'FUNCTION' : * 48150019 * *134 $801 *33 N ILENGTH FUNCTIONARGS ³ * 48160019 * : ILENGTH *32 N ILENGTH ( < ( DECLARATOR3 ) * 48170019 * IDATA ³ DECLARATOR / *125 ª'/' > ) ( ',' * 48180019 * / *32 N ILENGTH ( < ( DECLARATOR3 ) IDATA * 48190019 * ³ DECLARATOR / *125 ª'/' > ) ... ) > * 48200019 * * 48210019 * DEFINES THE INTEGER FUNCTION STATEMENT AND * 48220019 * THE INTEGER TYPE-STATEMENT. * 48230019 * * 48240019 * SINCE DECLARATOR IS TESTED AFTER DECLARATOR3, * 48250019 * DECLARATOR WILL BE SATISFIED IF AND ONLY IF * 48260019 * THE ARRAY HAS A DUMMY DIMENSION. IN SUCH A * 48270019 * CASE, NO DATA-VALUE-INITIALIZATION LIST IS * 48280019 * ALLOWED, AND THE ª'/' TESTS FOR AND DIAGNOSES * 48290019 * THE PRESENCE OF THE START OF SUCH A LIST. * 48300019 * * 48310019 *********************************************************************** 48320019 LIN00063 EQU * START OF DEFINITION 48330019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48340019 DC AL1(003) LENGTH OF LITERAL 48350019 DC C'GER' 48360019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 48370019 DC AL1(ALT00204-LIN00063) FALSE DISP. 48380019 DC AL1(BRC00080-LIN00063) TRUE DISP. 48390019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48400019 DC AL1(008) LENGTH OF LITERAL 48410019 DC C'FUNCTION' 48420019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 48430019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48440019 DC AL1(COD033) ERROR CODE 48450019 DC AL1(DEFNAME) NAME OPERATOR N 48460019 DC AL1(DEFSYMBL) NEST OPERATOR 48470019 DC AL2(LIN00090-IPDAGH) ILENGTH 48480019 DC AL1(DEFSYMBL) NEST OPERATOR 48490019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 48500019 ALT00204 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 48510019 DC AL1(ALT00205-LIN00063) FALSE DISP. 48520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48530019 DC AL1(001) LENGTH OF LITERAL 48540019 DC C'*' 48550019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48560019 DC AL1(PAR00133-LIN00063) POINT TO END OF OPT. ITEMS 48570019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 48580019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 48590019 PAR00133 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 48600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48610019 DC AL1(008) LENGTH OF LITERAL 48620019 DC C'FUNCTION' 48630019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 48640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48650019 DC AL1(COD134) ERROR CODE 48660019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 48670019 DC AL1(ACT801) ACTION CODE 48680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48690019 DC AL1(COD033) ERROR CODE 48700019 DC AL1(DEFNAME) NAME OPERATOR N 48710019 DC AL1(DEFSYMBL) NEST OPERATOR 48720019 DC AL2(LIN00090-IPDAGH) ILENGTH 48730019 DC AL1(DEFSYMBL) NEST OPERATOR 48740019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 48750019 ALT00205 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 48760019 DC AL1(ALT00206-LIN00063) FALSE DISP. 48770019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 48780019 DC AL1(DEFSYMBL) NEST OPERATOR 48790019 DC AL2(LIN00090-IPDAGH) ILENGTH 48800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48810019 DC AL1(COD032) ERROR CODE 48820019 DC AL1(DEFNAME) NAME OPERATOR N 48830019 DC AL1(DEFSYMBL) NEST OPERATOR 48840019 DC AL2(LIN00090-IPDAGH) ILENGTH 48850019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48860019 DC AL1(PAR00134-LIN00063) POINT TO END OF OPT. ITEMS 48870019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 48880019 DC AL1(ALT00207-LIN00063) FALSE DISP. 48890019 DC AL1(BRC00081-LIN00063) TRUE DISP. 48900019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48910019 DC AL1(PAR00135-LIN00063) POINT TO END OF OPT. ITEMS 48920019 DC AL1(DEFSYMBL) NEST OPERATOR 48930019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 48940019 PAR00135 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 48950019 DC AL1(DEFSYMBL) NEST OPERATOR 48960019 DC AL2(LIN00092-IPDAGH) IDATA 48970019 ALT00207 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 48980019 DC AL1(ALT00208-LIN00063) FALSE DISP. 48990019 DC AL1(DEFSYMBL) NEST OPERATOR 49000019 DC AL2(LIN00075-IPDAGH) DECLARATOR 49010019 DC AL1(DEFCOMIT) LOCAL COMMIT / 49020019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 49030019 DC AL1(COD125) ERROR CODE 49040019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 49050019 DC AL1(001) LENGTH OF LITERAL 49060019 DC C'/' 49070019 ALT00208 EQU * 49080019 BRC00081 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 49090019 PAR00134 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49100019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49110019 DC AL1(PAR00136-LIN00063) POINT TO END OF OPT. ITEMS 49120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 49130019 DC AL1(001) LENGTH OF LITERAL 49140019 DC C',' 49150019 DC AL1(DEFCOMIT) LOCAL COMMIT / 49160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 49170019 DC AL1(COD032) ERROR CODE 49180019 DC AL1(DEFNAME) NAME OPERATOR N 49190019 DC AL1(DEFSYMBL) NEST OPERATOR 49200019 DC AL2(LIN00090-IPDAGH) ILENGTH 49210019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49220019 DC AL1(PAR00137-LIN00063) POINT TO END OF OPT. ITEMS 49230019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 49240019 DC AL1(ALT00209-LIN00063) FALSE DISP. 49250019 DC AL1(BRC00082-LIN00063) TRUE DISP. 49260019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49270019 DC AL1(PAR00138-LIN00063) POINT TO END OF OPT. ITEMS 49280019 DC AL1(DEFSYMBL) NEST OPERATOR 49290019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 49300019 PAR00138 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49310019 DC AL1(DEFSYMBL) NEST OPERATOR 49320019 DC AL2(LIN00092-IPDAGH) IDATA 49330019 ALT00209 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 49340019 DC AL1(ALT00210-LIN00063) FALSE DISP. 49350019 DC AL1(DEFSYMBL) NEST OPERATOR 49360019 DC AL2(LIN00075-IPDAGH) DECLARATOR 49370019 DC AL1(DEFCOMIT) LOCAL COMMIT / 49380019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 49390019 DC AL1(COD125) ERROR CODE 49400019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 49410019 DC AL1(001) LENGTH OF LITERAL 49420019 DC C'/' 49430019 ALT00210 EQU * 49440019 BRC00082 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 49450019 PAR00137 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49460019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 49470019 PAR00136 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49480019 ALT00206 EQU * 49490019 BRC00080 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 49500019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 49510019 EJECT 49520019 *********************************************************************** 49530019 * * 49540019 *ILENGTH = ( '*' < '2' ³ '4' ³ / *28 $801 ( D ... ) > ) * 49550019 * * 49560019 * DEFINES LENGTH SPECIFICATIONS VALID FOR INTEGER TYPE. * 49570019 * * 49580019 *********************************************************************** 49590019 LIN00090 EQU * START OF DEFINITION 49600019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49610019 DC AL1(PAR00139-LIN00090) POINT TO END OF OPT. ITEMS 49620019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 49630019 DC AL1(001) LENGTH OF LITERAL 49640019 DC C'*' 49650019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 49660019 DC AL1(ALT00211-LIN00090) FALSE DISP. 49670019 DC AL1(BRC00083-LIN00090) TRUE DISP. 49680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 49690019 DC AL1(001) LENGTH OF LITERAL 49700019 DC C'2' 49710019 ALT00211 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 49720019 DC AL1(ALT00212-LIN00090) FALSE DISP. 49730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 49740019 DC AL1(001) LENGTH OF LITERAL 49750019 DC C'4' 49760019 ALT00212 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 49770019 DC AL1(ALT00213-LIN00090) FALSE DISP. 49780019 DC AL1(DEFCOMIT) LOCAL COMMIT / 49790019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 49800019 DC AL1(COD028) ERROR CODE 49810019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 49820019 DC AL1(ACT801) ACTION CODE 49830019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49840019 DC AL1(PAR00140-LIN00090) POINT TO END OF OPT. ITEMS 49850019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 49860019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 49870019 PAR00140 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49880019 ALT00213 EQU * 49890019 BRC00083 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 49900019 PAR00139 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49910019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 49920019 EJECT 49930019 *********************************************************************** 49940019 * * 49950019 *IDATA = '/' / ( K '*' / $100 ) ICONSTANT ( ',' / * 49960019 * ( K '*' / $100 ) ICONSTANT ... ) *38 '/' * 49970019 * * 49980019 * DEFINES A LIST OF INTEGER CONSTANTS ENCLOSED IN SLASHES. * 49990019 * * 50000019 *********************************************************************** 50010019 LIN00092 EQU * START OF DEFINITION 50020019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50030019 DC AL1(001) LENGTH OF LITERAL 50040019 DC C'/' 50050019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50060019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 50070019 DC AL1(PAR00141-LIN00092) POINT TO END OF OPT. ITEMS 50080019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 50090019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50100019 DC AL1(001) LENGTH OF LITERAL 50110019 DC C'*' 50120019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50130019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 50140019 DC AL1(ACT100) ACTION CODE 50150019 PAR00141 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 50160019 DC AL1(DEFSYMBL) NEST OPERATOR 50170019 DC AL2(LIN00093-IPDAGH) ICONSTANT 50180019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 50190019 DC AL1(PAR00142-LIN00092) POINT TO END OF OPT. ITEMS 50200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50210019 DC AL1(001) LENGTH OF LITERAL 50220019 DC C',' 50230019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50240019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 50250019 DC AL1(PAR00143-LIN00092) POINT TO END OF OPT. ITEMS 50260019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 50270019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50280019 DC AL1(001) LENGTH OF LITERAL 50290019 DC C'*' 50300019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50310019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 50320019 DC AL1(ACT100) ACTION CODE 50330019 PAR00143 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 50340019 DC AL1(DEFSYMBL) NEST OPERATOR 50350019 DC AL2(LIN00093-IPDAGH) ICONSTANT 50360019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 50370019 PAR00142 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 50380019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 50390019 DC AL1(COD038) ERROR CODE 50400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50410019 DC AL1(001) LENGTH OF LITERAL 50420019 DC C'/' 50430019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 50440019 EJECT 50450019 *********************************************************************** 50460019 * * 50470019 *ICONSTANT = *41 < HCHEX ³ ( < '-' ³ '+' > ) K / $102 > * 50480019 * * 50490019 * DEFINES THE FORMS OF CONSTANT THAT ARE VALID IN THE * 50500019 * DATA LIST OF AN INTEGER TYPE-STATEMENT. THESE ARE: * 50510019 * INTEGER CONSTANTS, BOTH FORMS OF LITERAL CONSTANT, * 50520019 * AND HEXADECIMAL CONSTANTS. * 50530019 * * 50540019 *********************************************************************** 50550019 LIN00093 EQU * START OF DEFINITION 50560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 50570019 DC AL1(COD041) ERROR CODE 50580019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 50590019 DC AL1(ALT00214-LIN00093) FALSE DISP. 50600019 DC AL1(BRC00084-LIN00093) TRUE DISP. 50610019 DC AL1(DEFSYMBL) NEST OPERATOR 50620019 DC AL2(LIN00077-IPDAGH) HCHEX 50630019 ALT00214 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 50640019 DC AL1(ALT00215-LIN00093) FALSE DISP. 50650019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 50660019 DC AL1(PAR00144-LIN00093) POINT TO END OF OPT. ITEMS 50670019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 50680019 DC AL1(ALT00216-LIN00093) FALSE DISP. 50690019 DC AL1(BRC00085-LIN00093) TRUE DISP. 50700019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50710019 DC AL1(001) LENGTH OF LITERAL 50720019 DC C'-' 50730019 ALT00216 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 50740019 DC AL1(ALT00217-LIN00093) FALSE DISP. 50750019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50760019 DC AL1(001) LENGTH OF LITERAL 50770019 DC C'+' 50780019 ALT00217 EQU * 50790019 BRC00085 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 50800019 PAR00144 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 50810019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 50820019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50830019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 50840019 DC AL1(ACT102) ACTION CODE 50850019 ALT00215 EQU * 50860019 BRC00084 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 50870019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 50880019 EJECT 50890019 *********************************************************************** 50900019 * * 50910019 *LOGICAL = 'CAL' < 'FUNCTION' : *33 N LLENGTH * 50920019 * FUNCTIONARGS ³ '*' ( D ... ) 'FUNCTION' : * 50930019 * *134 $801 *33 N LLENGTH FUNCTIONARGS ³ * 50940019 * : LLENGTH *32 N LLENGTH ( < ( DECLARATOR3 ) * 50950019 * LDATA ³ DECLARATOR / *125 ª'/' > ) ( ',' * 50960019 * / *32 N LLENGTH ( < ( DECLARATOR3 ) LDATA * 50970019 * ³ DECLARATOR / *125 ª'/' > ) ... ) > * 50980019 * * 50990019 * DEFINES THE LOGICAL FUNCTION STATEMENT AND * 51000019 * THE LOGICAL TYPE-STATEMENT. * 51010019 * * 51020019 * SINCE DECLARATOR IS TESTED AFTER DECLARATOR3, * 51030019 * DECLARATOR WILL BE SATISFIED IF AND ONLY IF * 51040019 * THE ARRAY HAS A DUMMY DIMENSION. IN SUCH A * 51050019 * CASE, NO DATA-VALUE-INITIALIZATION LIST IS * 51060019 * ALLOWED, AND THE ª'/' TESTS FOR AND DIAGNOSES * 51070019 * THE PRESENCE OF THE START OF SUCH A LIST. * 51080019 * * 51090019 *********************************************************************** 51100019 LIN00064 EQU * START OF DEFINITION 51110019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51120019 DC AL1(003) LENGTH OF LITERAL 51130019 DC C'CAL' 51140019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 51150019 DC AL1(ALT00218-LIN00064) FALSE DISP. 51160019 DC AL1(BRC00086-LIN00064) TRUE DISP. 51170019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51180019 DC AL1(008) LENGTH OF LITERAL 51190019 DC C'FUNCTION' 51200019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 51210019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51220019 DC AL1(COD033) ERROR CODE 51230019 DC AL1(DEFNAME) NAME OPERATOR N 51240019 DC AL1(DEFSYMBL) NEST OPERATOR 51250019 DC AL2(LIN00091-IPDAGH) LLENGTH 51260019 DC AL1(DEFSYMBL) NEST OPERATOR 51270019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 51280019 ALT00218 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 51290019 DC AL1(ALT00219-LIN00064) FALSE DISP. 51300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51310019 DC AL1(001) LENGTH OF LITERAL 51320019 DC C'*' 51330019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 51340019 DC AL1(PAR00145-LIN00064) POINT TO END OF OPT. ITEMS 51350019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 51360019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 51370019 PAR00145 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 51380019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51390019 DC AL1(008) LENGTH OF LITERAL 51400019 DC C'FUNCTION' 51410019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 51420019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51430019 DC AL1(COD134) ERROR CODE 51440019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 51450019 DC AL1(ACT801) ACTION CODE 51460019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51470019 DC AL1(COD033) ERROR CODE 51480019 DC AL1(DEFNAME) NAME OPERATOR N 51490019 DC AL1(DEFSYMBL) NEST OPERATOR 51500019 DC AL2(LIN00091-IPDAGH) LLENGTH 51510019 DC AL1(DEFSYMBL) NEST OPERATOR 51520019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 51530019 ALT00219 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 51540019 DC AL1(ALT00220-LIN00064) FALSE DISP. 51550019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 51560019 DC AL1(DEFSYMBL) NEST OPERATOR 51570019 DC AL2(LIN00091-IPDAGH) LLENGTH 51580019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51590019 DC AL1(COD032) ERROR CODE 51600019 DC AL1(DEFNAME) NAME OPERATOR N 51610019 DC AL1(DEFSYMBL) NEST OPERATOR 51620019 DC AL2(LIN00091-IPDAGH) LLENGTH 51630019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 51640019 DC AL1(PAR00146-LIN00064) POINT TO END OF OPT. ITEMS 51650019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 51660019 DC AL1(ALT00221-LIN00064) FALSE DISP. 51670019 DC AL1(BRC00087-LIN00064) TRUE DISP. 51680019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 51690019 DC AL1(PAR00147-LIN00064) POINT TO END OF OPT. ITEMS 51700019 DC AL1(DEFSYMBL) NEST OPERATOR 51710019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 51720019 PAR00147 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 51730019 DC AL1(DEFSYMBL) NEST OPERATOR 51740019 DC AL2(LIN00094-IPDAGH) LDATA 51750019 ALT00221 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 51760019 DC AL1(ALT00222-LIN00064) FALSE DISP. 51770019 DC AL1(DEFSYMBL) NEST OPERATOR 51780019 DC AL2(LIN00075-IPDAGH) DECLARATOR 51790019 DC AL1(DEFCOMIT) LOCAL COMMIT / 51800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51810019 DC AL1(COD125) ERROR CODE 51820019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 51830019 DC AL1(001) LENGTH OF LITERAL 51840019 DC C'/' 51850019 ALT00222 EQU * 51860019 BRC00087 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 51870019 PAR00146 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 51880019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 51890019 DC AL1(PAR00148-LIN00064) POINT TO END OF OPT. ITEMS 51900019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51910019 DC AL1(001) LENGTH OF LITERAL 51920019 DC C',' 51930019 DC AL1(DEFCOMIT) LOCAL COMMIT / 51940019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51950019 DC AL1(COD032) ERROR CODE 51960019 DC AL1(DEFNAME) NAME OPERATOR N 51970019 DC AL1(DEFSYMBL) NEST OPERATOR 51980019 DC AL2(LIN00091-IPDAGH) LLENGTH 51990019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52000019 DC AL1(PAR00149-LIN00064) POINT TO END OF OPT. ITEMS 52010019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 52020019 DC AL1(ALT00223-LIN00064) FALSE DISP. 52030019 DC AL1(BRC00088-LIN00064) TRUE DISP. 52040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52050019 DC AL1(PAR00150-LIN00064) POINT TO END OF OPT. ITEMS 52060019 DC AL1(DEFSYMBL) NEST OPERATOR 52070019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 52080019 PAR00150 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52090019 DC AL1(DEFSYMBL) NEST OPERATOR 52100019 DC AL2(LIN00094-IPDAGH) LDATA 52110019 ALT00223 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 52120019 DC AL1(ALT00224-LIN00064) FALSE DISP. 52130019 DC AL1(DEFSYMBL) NEST OPERATOR 52140019 DC AL2(LIN00075-IPDAGH) DECLARATOR 52150019 DC AL1(DEFCOMIT) LOCAL COMMIT / 52160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 52170019 DC AL1(COD125) ERROR CODE 52180019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 52190019 DC AL1(001) LENGTH OF LITERAL 52200019 DC C'/' 52210019 ALT00224 EQU * 52220019 BRC00088 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 52230019 PAR00149 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52240019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 52250019 PAR00148 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52260019 ALT00220 EQU * 52270019 BRC00086 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 52280019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 52290019 EJECT 52300019 *********************************************************************** 52310019 * * 52320019 *LLENGTH = ( '*' < '1' ³ '4' ³ / *28 $801 ( D ... ) > ) * 52330019 * * 52340019 * DEFINES LENGTH SPECIFICATIONS VALID FOR LOGICAL TYPE. * 52350019 * * 52360019 *********************************************************************** 52370019 LIN00091 EQU * START OF DEFINITION 52380019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52390019 DC AL1(PAR00151-LIN00091) POINT TO END OF OPT. ITEMS 52400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52410019 DC AL1(001) LENGTH OF LITERAL 52420019 DC C'*' 52430019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 52440019 DC AL1(ALT00225-LIN00091) FALSE DISP. 52450019 DC AL1(BRC00089-LIN00091) TRUE DISP. 52460019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52470019 DC AL1(001) LENGTH OF LITERAL 52480019 DC C'1' 52490019 ALT00225 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 52500019 DC AL1(ALT00226-LIN00091) FALSE DISP. 52510019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52520019 DC AL1(001) LENGTH OF LITERAL 52530019 DC C'4' 52540019 ALT00226 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 52550019 DC AL1(ALT00227-LIN00091) FALSE DISP. 52560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 52570019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 52580019 DC AL1(COD028) ERROR CODE 52590019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 52600019 DC AL1(ACT801) ACTION CODE 52610019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52620019 DC AL1(PAR00152-LIN00091) POINT TO END OF OPT. ITEMS 52630019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 52640019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 52650019 PAR00152 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52660019 ALT00227 EQU * 52670019 BRC00089 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 52680019 PAR00151 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52690019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 52700019 EJECT 52710019 *********************************************************************** 52720019 * * 52730019 *LDATA = '/' / ( K '*' / $100 ) LCONSTANT ( ',' / * 52740019 * ( K '*' / $100 ) LCONSTANT ... ) *38 '/' * 52750019 * * 52760019 * DEFINES A LIST OF LOGICAL CONSTANTS ENCLOSED IN SLASHES. * 52770019 * * 52780019 *********************************************************************** 52790019 LIN00094 EQU * START OF DEFINITION 52800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52810019 DC AL1(001) LENGTH OF LITERAL 52820019 DC C'/' 52830019 DC AL1(DEFCOMIT) LOCAL COMMIT / 52840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52850019 DC AL1(PAR00153-LIN00094) POINT TO END OF OPT. ITEMS 52860019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 52870019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52880019 DC AL1(001) LENGTH OF LITERAL 52890019 DC C'*' 52900019 DC AL1(DEFCOMIT) LOCAL COMMIT / 52910019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 52920019 DC AL1(ACT100) ACTION CODE 52930019 PAR00153 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 52940019 DC AL1(DEFSYMBL) NEST OPERATOR 52950019 DC AL2(LIN00095-IPDAGH) LCONSTANT 52960019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 52970019 DC AL1(PAR00154-LIN00094) POINT TO END OF OPT. ITEMS 52980019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52990019 DC AL1(001) LENGTH OF LITERAL 53000019 DC C',' 53010019 DC AL1(DEFCOMIT) LOCAL COMMIT / 53020019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 53030019 DC AL1(PAR00155-LIN00094) POINT TO END OF OPT. ITEMS 53040019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 53050019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53060019 DC AL1(001) LENGTH OF LITERAL 53070019 DC C'*' 53080019 DC AL1(DEFCOMIT) LOCAL COMMIT / 53090019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 53100019 DC AL1(ACT100) ACTION CODE 53110019 PAR00155 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 53120019 DC AL1(DEFSYMBL) NEST OPERATOR 53130019 DC AL2(LIN00095-IPDAGH) LCONSTANT 53140019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 53150019 PAR00154 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 53160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53170019 DC AL1(COD038) ERROR CODE 53180019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53190019 DC AL1(001) LENGTH OF LITERAL 53200019 DC C'/' 53210019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 53220019 EJECT 53230019 *********************************************************************** 53240019 * * 53250019 *LCONSTANT = *41 < '.TRUE.' ³ '.FALSE.' ³ 'T' ³ 'F' ³ * 53260019 * HCHEX > * 53270019 * * 53280019 * DEFINES THE FORMS OF CONSTANT WHICH ARE VALID IN THE * 53290019 * DATA LIST OF A LOGICAL TYPE-STATEMENT. THESE ARE: * 53300019 * LOGICAL CONSTANTS, ABBREVIATED LOGICAL CONSTANTS, BOTH * 53310019 * FORMS OF LITERAL CONSTANT, AND HEXADECIMAL CONSTANTS. * 53320019 * * 53330019 *********************************************************************** 53340019 LIN00095 EQU * START OF DEFINITION 53350019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53360019 DC AL1(COD041) ERROR CODE 53370019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 53380019 DC AL1(ALT00228-LIN00095) FALSE DISP. 53390019 DC AL1(BRC00090-LIN00095) TRUE DISP. 53400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53410019 DC AL1(006) LENGTH OF LITERAL 53420019 DC C'.TRUE.' 53430019 ALT00228 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 53440019 DC AL1(ALT00229-LIN00095) FALSE DISP. 53450019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53460019 DC AL1(007) LENGTH OF LITERAL 53470019 DC C'.FALSE.' 53480019 ALT00229 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 53490019 DC AL1(ALT00230-LIN00095) FALSE DISP. 53500019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53510019 DC AL1(001) LENGTH OF LITERAL 53520019 DC C'T' 53530019 ALT00230 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 53540019 DC AL1(ALT00231-LIN00095) FALSE DISP. 53550019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53560019 DC AL1(001) LENGTH OF LITERAL 53570019 DC C'F' 53580019 ALT00231 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 53590019 DC AL1(ALT00232-LIN00095) FALSE DISP. 53600019 DC AL1(DEFSYMBL) NEST OPERATOR 53610019 DC AL2(LIN00077-IPDAGH) HCHEX 53620019 ALT00232 EQU * 53630019 BRC00090 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 53640019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 53650019 EJECT 53660019 *********************************************************************** 53670019 * * 53680019 *NAMELIST = 'LIST' : *39 '/' *33 N *39 '/' *32 N * 53690019 * ( ',' / N ... ) ( '/' / *33 N *39 '/' * 53700019 * *32 N ( ',' / N ... ) ... ) * 53710019 * * 53720019 * DEFINES THE NAMELIST STATEMENT. * 53730019 * * 53740019 *********************************************************************** 53750019 LIN00065 EQU * START OF DEFINITION 53760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53770019 DC AL1(004) LENGTH OF LITERAL 53780019 DC C'LIST' 53790019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 53800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53810019 DC AL1(COD039) ERROR CODE 53820019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53830019 DC AL1(001) LENGTH OF LITERAL 53840019 DC C'/' 53850019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53860019 DC AL1(COD033) ERROR CODE 53870019 DC AL1(DEFNAME) NAME OPERATOR N 53880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53890019 DC AL1(COD039) ERROR CODE 53900019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53910019 DC AL1(001) LENGTH OF LITERAL 53920019 DC C'/' 53930019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53940019 DC AL1(COD032) ERROR CODE 53950019 DC AL1(DEFNAME) NAME OPERATOR N 53960019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 53970019 DC AL1(PAR00156-LIN00065) POINT TO END OF OPT. ITEMS 53980019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53990019 DC AL1(001) LENGTH OF LITERAL 54000019 DC C',' 54010019 DC AL1(DEFCOMIT) LOCAL COMMIT / 54020019 DC AL1(DEFNAME) NAME OPERATOR N 54030019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 54040019 PAR00156 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 54050019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54060019 DC AL1(PAR00157-LIN00065) POINT TO END OF OPT. ITEMS 54070019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54080019 DC AL1(001) LENGTH OF LITERAL 54090019 DC C'/' 54100019 DC AL1(DEFCOMIT) LOCAL COMMIT / 54110019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54120019 DC AL1(COD033) ERROR CODE 54130019 DC AL1(DEFNAME) NAME OPERATOR N 54140019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54150019 DC AL1(COD039) ERROR CODE 54160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54170019 DC AL1(001) LENGTH OF LITERAL 54180019 DC C'/' 54190019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54200019 DC AL1(COD032) ERROR CODE 54210019 DC AL1(DEFNAME) NAME OPERATOR N 54220019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54230019 DC AL1(PAR00158-LIN00065) POINT TO END OF OPT. ITEMS 54240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54250019 DC AL1(001) LENGTH OF LITERAL 54260019 DC C',' 54270019 DC AL1(DEFCOMIT) LOCAL COMMIT / 54280019 DC AL1(DEFNAME) NAME OPERATOR N 54290019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 54300019 PAR00158 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 54310019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 54320019 PAR00157 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 54330019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 54340019 EJECT 54350019 *********************************************************************** 54360019 * * 54370019 *REAL = < 'FUNCTION' : *33 N RLENGTH * 54380019 * FUNCTIONARGS ³ '*' ( D ... ) 'FUNCTION' : * 54390019 * *134 $801 *33 N RLENGTH FUNCTIONARGS ³ * 54400019 * : RLENGTH *32 N RLENGTH ( < ( DECLARATOR3 ) * 54410019 * RDATA ³ DECLARATOR / *125 ª'/' > ) ( ',' * 54420019 * / *32 N RLENGTH ( < ( DECLARATOR3 ) RDATA * 54430019 * ³ DECLARATOR / *125 ª'/' > ) ... ) > * 54440019 * * 54450019 * DEFINES THE REAL FUNCTION STATEMENT AND * 54460019 * THE REAL TYPE-STATEMENT. * 54470019 * * 54480019 * SINCE DECLARATOR IS TESTED AFTER DECLARATOR3, * 54490019 * DECLARATOR WILL BE SATISFIED IF AND ONLY IF * 54500019 * THE ARRAY HAS A DUMMY DIMENSION. IN SUCH A * 54510019 * CASE, NO DATA-VALUE-INITIALIZATION LIST IS * 54520019 * ALLOWED, AND THE ª'/' TESTS FOR AND DIAGNOSES * 54530019 * THE PRESENCE OF THE START OF SUCH A LIST. * 54540019 * * 54550019 *********************************************************************** 54560019 LIN00066 EQU * START OF DEFINITION 54570019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 54580019 DC AL1(ALT00233-LIN00066) FALSE DISP. 54590019 DC AL1(BRC00091-LIN00066) TRUE DISP. 54600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54610019 DC AL1(008) LENGTH OF LITERAL 54620019 DC C'FUNCTION' 54630019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 54640019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54650019 DC AL1(COD033) ERROR CODE 54660019 DC AL1(DEFNAME) NAME OPERATOR N 54670019 DC AL1(DEFSYMBL) NEST OPERATOR 54680019 DC AL2(LIN00089-IPDAGH) RLENGTH 54690019 DC AL1(DEFSYMBL) NEST OPERATOR 54700019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 54710019 ALT00233 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 54720019 DC AL1(ALT00234-LIN00066) FALSE DISP. 54730019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54740019 DC AL1(001) LENGTH OF LITERAL 54750019 DC C'*' 54760019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54770019 DC AL1(PAR00159-LIN00066) POINT TO END OF OPT. ITEMS 54780019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 54790019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 54800019 PAR00159 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 54810019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54820019 DC AL1(008) LENGTH OF LITERAL 54830019 DC C'FUNCTION' 54840019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 54850019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54860019 DC AL1(COD134) ERROR CODE 54870019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 54880019 DC AL1(ACT801) ACTION CODE 54890019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 54900019 DC AL1(COD033) ERROR CODE 54910019 DC AL1(DEFNAME) NAME OPERATOR N 54920019 DC AL1(DEFSYMBL) NEST OPERATOR 54930019 DC AL2(LIN00089-IPDAGH) RLENGTH 54940019 DC AL1(DEFSYMBL) NEST OPERATOR 54950019 DC AL2(LIN00072-IPDAGH) FUNCTIONARGS 54960019 ALT00234 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 54970019 DC AL1(ALT00235-LIN00066) FALSE DISP. 54980019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 54990019 DC AL1(DEFSYMBL) NEST OPERATOR 55000019 DC AL2(LIN00089-IPDAGH) RLENGTH 55010019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 55020019 DC AL1(COD032) ERROR CODE 55030019 DC AL1(DEFNAME) NAME OPERATOR N 55040019 DC AL1(DEFSYMBL) NEST OPERATOR 55050019 DC AL2(LIN00089-IPDAGH) RLENGTH 55060019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55070019 DC AL1(PAR00160-LIN00066) POINT TO END OF OPT. ITEMS 55080019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 55090019 DC AL1(ALT00236-LIN00066) FALSE DISP. 55100019 DC AL1(BRC00092-LIN00066) TRUE DISP. 55110019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55120019 DC AL1(PAR00161-LIN00066) POINT TO END OF OPT. ITEMS 55130019 DC AL1(DEFSYMBL) NEST OPERATOR 55140019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 55150019 PAR00161 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55160019 DC AL1(DEFSYMBL) NEST OPERATOR 55170019 DC AL2(LIN00096-IPDAGH) RDATA 55180019 ALT00236 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 55190019 DC AL1(ALT00237-LIN00066) FALSE DISP. 55200019 DC AL1(DEFSYMBL) NEST OPERATOR 55210019 DC AL2(LIN00075-IPDAGH) DECLARATOR 55220019 DC AL1(DEFCOMIT) LOCAL COMMIT / 55230019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 55240019 DC AL1(COD125) ERROR CODE 55250019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 55260019 DC AL1(001) LENGTH OF LITERAL 55270019 DC C'/' 55280019 ALT00237 EQU * 55290019 BRC00092 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 55300019 PAR00160 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55310019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55320019 DC AL1(PAR00162-LIN00066) POINT TO END OF OPT. ITEMS 55330019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55340019 DC AL1(001) LENGTH OF LITERAL 55350019 DC C',' 55360019 DC AL1(DEFCOMIT) LOCAL COMMIT / 55370019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 55380019 DC AL1(COD032) ERROR CODE 55390019 DC AL1(DEFNAME) NAME OPERATOR N 55400019 DC AL1(DEFSYMBL) NEST OPERATOR 55410019 DC AL2(LIN00089-IPDAGH) RLENGTH 55420019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55430019 DC AL1(PAR00163-LIN00066) POINT TO END OF OPT. ITEMS 55440019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 55450019 DC AL1(ALT00238-LIN00066) FALSE DISP. 55460019 DC AL1(BRC00093-LIN00066) TRUE DISP. 55470019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55480019 DC AL1(PAR00164-LIN00066) POINT TO END OF OPT. ITEMS 55490019 DC AL1(DEFSYMBL) NEST OPERATOR 55500019 DC AL2(LIN00073-IPDAGH) DECLARATOR3 55510019 PAR00164 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55520019 DC AL1(DEFSYMBL) NEST OPERATOR 55530019 DC AL2(LIN00096-IPDAGH) RDATA 55540019 ALT00238 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 55550019 DC AL1(ALT00239-LIN00066) FALSE DISP. 55560019 DC AL1(DEFSYMBL) NEST OPERATOR 55570019 DC AL2(LIN00075-IPDAGH) DECLARATOR 55580019 DC AL1(DEFCOMIT) LOCAL COMMIT / 55590019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 55600019 DC AL1(COD125) ERROR CODE 55610019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 55620019 DC AL1(001) LENGTH OF LITERAL 55630019 DC C'/' 55640019 ALT00239 EQU * 55650019 BRC00093 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 55660019 PAR00163 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55670019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 55680019 PAR00162 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55690019 ALT00235 EQU * 55700019 BRC00091 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 55710019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 55720019 EJECT 55730019 *********************************************************************** 55740019 * * 55750019 *RLENGTH = ( '*' < '8' ³ '4' ³ / *28 $801 ( D ... ) > ) * 55760019 * * 55770019 * DEFINES LENGTH SPECIFICATIONS VALID FOR REAL TYPE. * 55780019 * * 55790019 *********************************************************************** 55800019 LIN00089 EQU * START OF DEFINITION 55810019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55820019 DC AL1(PAR00165-LIN00089) POINT TO END OF OPT. ITEMS 55830019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55840019 DC AL1(001) LENGTH OF LITERAL 55850019 DC C'*' 55860019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 55870019 DC AL1(ALT00240-LIN00089) FALSE DISP. 55880019 DC AL1(BRC00094-LIN00089) TRUE DISP. 55890019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55900019 DC AL1(001) LENGTH OF LITERAL 55910019 DC C'8' 55920019 ALT00240 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 55930019 DC AL1(ALT00241-LIN00089) FALSE DISP. 55940019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55950019 DC AL1(001) LENGTH OF LITERAL 55960019 DC C'4' 55970019 ALT00241 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 55980019 DC AL1(ALT00242-LIN00089) FALSE DISP. 55990019 DC AL1(DEFCOMIT) LOCAL COMMIT / 56000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 56010019 DC AL1(COD028) ERROR CODE 56020019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 56030019 DC AL1(ACT801) ACTION CODE 56040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 56050019 DC AL1(PAR00166-LIN00089) POINT TO END OF OPT. ITEMS 56060019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 56070019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 56080019 PAR00166 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 56090019 ALT00242 EQU * 56100019 BRC00094 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 56110019 PAR00165 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 56120019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 56130019 EJECT 56140019 *********************************************************************** 56150019 * * 56160019 *RDATA = '/' / ( K '*' / $100 ) RCONSTANT ( ',' / * 56170019 * ( K '*' / $100 ) RCONSTANT ... ) *38 '/' * 56180019 * * 56190019 * DEFINES A LIST OF REAL CONSTANTS ENCLOSED IN SLASHES. * 56200019 * * 56210019 *********************************************************************** 56220019 LIN00096 EQU * START OF DEFINITION 56230019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56240019 DC AL1(001) LENGTH OF LITERAL 56250019 DC C'/' 56260019 DC AL1(DEFCOMIT) LOCAL COMMIT / 56270019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 56280019 DC AL1(PAR00167-LIN00096) POINT TO END OF OPT. ITEMS 56290019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 56300019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56310019 DC AL1(001) LENGTH OF LITERAL 56320019 DC C'*' 56330019 DC AL1(DEFCOMIT) LOCAL COMMIT / 56340019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 56350019 DC AL1(ACT100) ACTION CODE 56360019 PAR00167 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 56370019 DC AL1(DEFSYMBL) NEST OPERATOR 56380019 DC AL2(LIN00097-IPDAGH) RCONSTANT 56390019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 56400019 DC AL1(PAR00168-LIN00096) POINT TO END OF OPT. ITEMS 56410019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56420019 DC AL1(001) LENGTH OF LITERAL 56430019 DC C',' 56440019 DC AL1(DEFCOMIT) LOCAL COMMIT / 56450019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 56460019 DC AL1(PAR00169-LIN00096) POINT TO END OF OPT. ITEMS 56470019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 56480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56490019 DC AL1(001) LENGTH OF LITERAL 56500019 DC C'*' 56510019 DC AL1(DEFCOMIT) LOCAL COMMIT / 56520019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 56530019 DC AL1(ACT100) ACTION CODE 56540019 PAR00169 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 56550019 DC AL1(DEFSYMBL) NEST OPERATOR 56560019 DC AL2(LIN00097-IPDAGH) RCONSTANT 56570019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 56580019 PAR00168 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 56590019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 56600019 DC AL1(COD038) ERROR CODE 56610019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56620019 DC AL1(001) LENGTH OF LITERAL 56630019 DC C'/' 56640019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 56650019 EJECT 56660019 *********************************************************************** 56670019 * * 56680019 *RCONSTANT = *41 < HCHEX ³ ( < '-' ³ '+' > ) K / $106 > * 56690019 * * 56700019 * DEFINES THE FORMS OF CONSTANT THAT ARE VALID IN THE * 56710019 * DATA LIST OF A REAL TYPE STATEMENT. THESE ARE: REAL * 56720019 * CONSTANTS OF EITHER LENGTH, BOTH FORMS OF LITERAL * 56730019 * CONSTANT, AND HEXADECIMAL CONSTANTS. * 56740019 * * 56750019 *********************************************************************** 56760019 LIN00097 EQU * START OF DEFINITION 56770019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 56780019 DC AL1(COD041) ERROR CODE 56790019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 56800019 DC AL1(ALT00243-LIN00097) FALSE DISP. 56810019 DC AL1(BRC00095-LIN00097) TRUE DISP. 56820019 DC AL1(DEFSYMBL) NEST OPERATOR 56830019 DC AL2(LIN00077-IPDAGH) HCHEX 56840019 ALT00243 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 56850019 DC AL1(ALT00244-LIN00097) FALSE DISP. 56860019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 56870019 DC AL1(PAR00170-LIN00097) POINT TO END OF OPT. ITEMS 56880019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 56890019 DC AL1(ALT00245-LIN00097) FALSE DISP. 56900019 DC AL1(BRC00096-LIN00097) TRUE DISP. 56910019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56920019 DC AL1(001) LENGTH OF LITERAL 56930019 DC C'-' 56940019 ALT00245 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 56950019 DC AL1(ALT00246-LIN00097) FALSE DISP. 56960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 56970019 DC AL1(001) LENGTH OF LITERAL 56980019 DC C'+' 56990019 ALT00246 EQU * 57000019 BRC00096 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 57010019 PAR00170 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 57020019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 57030019 DC AL1(DEFCOMIT) LOCAL COMMIT / 57040019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 57050019 DC AL1(ACT106) ACTION CODE 57060019 ALT00244 EQU * 57070019 BRC00095 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 57080019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 57090019 EJECT 57100019 *********************************************************************** 57110019 * * 57120019 *SUBROUTINE = 'OUTINE' : SUBORENTRY * 57130019 * * 57140019 * DEFINES THE SUBROUTINE STATEMENT. THE * 57150019 * SYNTAX TO THE RIGHT OF THE KEYWORD IS THE * 57160019 * SAME AS THAT OF THE ENTRY STATEMENT. * 57170019 * * 57180019 *********************************************************************** 57190019 LIN00067 EQU * START OF DEFINITION 57200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 57210019 DC AL1(006) LENGTH OF LITERAL 57220019 DC C'OUTINE' 57230019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 57240019 DC AL1(DEFSYMBL) NEST OPERATOR 57250019 DC AL2(LIN00083-IPDAGH) SUBORENTRY 57260019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 57270019 EJECT 57280019 *********************************************************************** 57290019 * * 57300019 *TRACE = < 'EON' : $400 ³ 'EOFF' : $400 > * 57310019 * * 57320019 * DEFINES THE TRACEON AND TRACEOFF STATEMENTS. * 57330019 * THESE ARE NOT VALID STATEMENTS UNLESS THE SYNTAX * 57340019 * CHECKER IS CHECKING AGAINST FORTRAN LEVEL G. * 57350019 * ACTION CODE 400 ISSUES A "DEBUG FACILITY NOT * 57360019 * SUPPORTED" MESSAGE IF FORTRAN LEVEL H HAS * 57370019 * BEEN SPECIFIED. * 57380019 * * 57390019 *********************************************************************** 57400019 LIN00068 EQU * START OF DEFINITION 57410019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 57420019 DC AL1(ALT00247-LIN00068) FALSE DISP. 57430019 DC AL1(BRC00097-LIN00068) TRUE DISP. 57440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 57450019 DC AL1(003) LENGTH OF LITERAL 57460019 DC C'EON' 57470019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 57480019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 57490019 DC AL1(ACT400) ACTION CODE 57500019 ALT00247 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 57510019 DC AL1(ALT00248-LIN00068) FALSE DISP. 57520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 57530019 DC AL1(004) LENGTH OF LITERAL 57540019 DC C'EOFF' 57550019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 57560019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 57570019 DC AL1(ACT400) ACTION CODE 57580019 ALT00248 EQU * 57590019 BRC00097 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 57600019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 57610019 EJECT 57620019 *********************************************************************** 57630019 * * 57640019 *SYNTAX END * 57650019 * * 57660019 *********************************************************************** 57670019 DEFEXPAN EQU 5632-(*-IPDAGH) 57680019 DC (DEFEXPAN)C'G' EXPANSION SPACE 57690019 DEFLBRCE EQU X'00' < 57700019 DEFRBRCE EQU X'02' > 57710019 DEFOR EQU X'04' ³ 57720019 DEFOPTST EQU X'06' ( 57730019 DEFOPTED EQU X'08' ) 57740019 DEFCOMIT EQU X'0A' / 57750019 DEFSTCMT EQU X'0C' : 57760019 DEFITIND EQU X'0E' ... 57770019 DEFITDEF EQU X'10' .N. 57780019 DEFSYMBL EQU X'12' SYMBOL 57790019 DEFMNAME EQU X'14' M 57800019 DEFNAME EQU X'16' N 57810019 DEFLETTR EQU X'18' L 57820019 DEFDIGIT EQU X'1A' D 57830019 DEFALMER EQU X'1C' A 57840019 DEFNUMBR EQU X'1E' K 57850019 DEFSTNUM EQU X'20' S 57860019 DEFHOLLR EQU X'22' H 57870019 DEFCSTRG EQU X'24' C 57880019 DEFQUOTE EQU X'26' 'AA...A' 57890019 DEFNOTQT EQU X'28' ª'AA...A' 57900019 DEFSCAN EQU X'2A' &A 57910019 DEFSCNOT EQU X'2C' &ªA 57920019 DEFACTN EQU X'2E' $N 57930019 DEFMESSG EQU X'30' *N 57940019 DEFTABLP EQU X'32' +TABLE-NAME 57950019 DEFTABLM EQU X'34' -TABLE-NAME 57960019 DEFEND EQU X'36' END OF STMNT 57970019 DEFTABLE EQU X'40' " 57980019 ACT801 EQU 064 57990019 ACT100 EQU 000 58000019 ACT200 EQU 014 58010019 ACT202 EQU 018 58020019 ACT103 EQU 006 58030019 ACT104 EQU 008 58040019 ACT105 EQU 010 58050019 ACT800 EQU 062 58060019 ACT600 EQU 030 58070019 ACT601 EQU 032 58080019 ACT201 EQU 016 58090019 ACT602 EQU 034 58100019 ACT603 EQU 036 58110019 ACT400 EQU 026 58120019 ACT300 EQU 022 58130019 ACT301 EQU 024 58140019 ACT700 EQU 058 58150019 ACT701 EQU 060 58160019 ACT500 EQU 028 58170019 ACT102 EQU 004 58180019 ACT106 EQU 012 58190019 COD003 EQU 003 58200019 COD004 EQU 004 58210019 COD005 EQU 005 58220019 COD007 EQU 007 58230019 COD012 EQU 012 58240019 COD013 EQU 013 58250019 COD015 EQU 015 58260019 COD017 EQU 017 58270019 COD019 EQU 019 58280019 COD023 EQU 023 58290019 COD027 EQU 027 58300019 COD028 EQU 028 58310019 COD030 EQU 030 58320019 COD031 EQU 031 58330019 COD032 EQU 032 58340019 COD033 EQU 033 58350019 COD035 EQU 035 58360019 COD037 EQU 037 58370019 COD038 EQU 038 58380019 COD039 EQU 039 58390019 COD040 EQU 040 58400019 COD041 EQU 041 58410019 COD042 EQU 042 58420019 COD043 EQU 043 58430019 COD044 EQU 044 58440019 COD046 EQU 046 58450019 COD049 EQU 049 58460019 COD051 EQU 051 58470019 COD052 EQU 052 58480019 COD053 EQU 053 58490019 COD055 EQU 055 58500019 COD057 EQU 057 58510019 COD058 EQU 058 58520019 COD061 EQU 061 58530019 COD063 EQU 063 58540019 COD065 EQU 065 58550019 COD069 EQU 069 58560019 COD077 EQU 077 58570019 COD079 EQU 079 58580019 COD080 EQU 080 58590019 COD125 EQU 125 58600019 COD129 EQU 129 58610019 COD133 EQU 133 58620019 COD134 EQU 134 58630019 COD139 EQU 139 58640019 COD140 EQU 140 58650019 COD143 EQU 143 58660019 COD147 EQU 147 58670019 END IPDAGH 58680019 ./ ADD SSI=01012440,NAME=IPDER,SOURCE=0 ERR TITLE 'IPDER, MESSAGE CONSTRUCTION ROUTINE' 00100019 SPACE 2 00200019 *NAME OF ROUTINE.. 00300019 * 00400019 * IPDERERR 00500019 SPACE 2 00600019 *STATUS 00700019 * 00800019 * VERSION 1 / MODIFICATION 0 00900019 SPACE 2 01000019 *FUNCTION.., ENTRY.., INPUT.., OUTPUT.. 01100019 * 01200019 * LA 13,A SAVE AREA MESSAGE FORMATTING ROUTINE. 01300019 * L 15,=A(IPDERERR) OUTPUT IS A MESSAGE IN 01400019 * LA 1,IPDERWKA WKAERBFR IN IPDERWKA. 01500019 * BALR 14,15 THE LENGTH OF THE MESSAGE 01600019 * RETURN IS L'WKAERBFR. 01700019 * SEE IPDERWKA DSECT FOR 01800019 * DESCRIPTION OF INPUTS. 01900019 SPACE 2 02000019 *EXTERNAL REFERENCES 02100019 * 02200019 * NONE 02300019 SPACE 2 02400019 *EXITS, NORMAL 02500019 * 02600019 * OUTPUT DESCRIBED HAS BEEN CREATED. NO RETURN CODES USED. 02700019 SPACE 2 02800019 *EXITS, ERROR 02900019 * 03000019 * NONE 03100019 SPACE 2 03200019 *TABLES / WORK AREAS 03300019 * 03400019 * MSGTABLE, TABLE OF DISPLACEMENTS OF ERROR MESSAGE TEXTS 03500019 * MSG000, TABLE OF ERROR MESSAGE TEXTS 03600019 * IPDERWKA, DSECT FOR INPUT AND OUTPUT WORK AREA 03700019 SPACE 2 03800019 *ATTRIBUTES 03900019 * 04000019 * REENTERABLE, REFRESHABLE, BLOCK FORMAT 04100019 EJECT 04200019 *CHARACTER CODE DEPENDENCE 04300019 * 04400019 * THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL 04500019 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS 04600019 * EQUIVALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING 04700019 * HAS BEEN ARRANGED SO THAT REDEFINITION OF 'CHARACTER' 04800019 * CONSTANTS, BY REASSEMBLY, WILL RESULT IN A CORRECT MODULE 04900019 * FOR THE NEW DEFINITIONS. 05000019 * 05100019 * THE OPERATION OF THIS MODULE ALSO DEPENDS ON THE CREATION OF 05200019 * BINARY ZEROS IN THE HIGH ORDER BYTES OF THE RECEIVING FIELD OF 05300019 * A CVD INSTRUCTION WHEN THE HIGH ORDER DIGITS OF THE NUMBER 05400019 * BEING CONVERTED ARE ZEROS. FURTHER, THE OPERATION OF THIS 05500019 * MODULE ASSUMES THAT THE LOGICAL 'OR' OF A SIGNED DIGIT AND A 05600019 * CHARACTER ZERO PRODUCES THE ORIGINAL DIGIT ZONED INSTEAD OF 05700019 * SIGNED. 05800019 EJECT 05900019 IPDERWKA DSECT MUST MATCH DEFINITION IN IPDSNWKA. 06000019 * 06100019 DS 0D ALIGNED TO DOUBLE WORD. 06200019 WKAEROPT DS A LOC OF 4TH BYTE OF OPTION WORD. 2ND BIT 06300019 * =0 INDICATES DATA SET HAS LINE NOS. 06400019 * 06500019 *********************************************************************** 06600019 * 06700019 * NOTE FOR MAINTENANCE 06800019 * -------------------- 06900019 * 07000019 * 1. IPDERERR MODULE WILL OVERWRITE STORAGE OUTSIDE OF THE 07100019 * MESSAGE BUFFER IF L'WKAERBFR IS LESS THAN 25. 07200019 * 07300019 * 2. THE MESSAGE BUFFER MUST BE ALIGNED TO THE MIDDLE OF 07400019 * A DOUBLEWORD TO AVOID SPECIFICATION EXCEPTIONS WHEN THE 07500019 * CVD INSTRUCTIONS ARE EXECUTED. 07600019 * 07700019 *********************************************************************** 07800019 CNOP 4,8 ALIGNED TO MIDDLE OF DOUBLE WORD. 07900019 WKAERBFR DS CL72 ERROR MESSAGE BUFFER. MESSAGE IS LEFT- 08000019 * ADJUSTED IN BUFFER WITH TRAILING BLANKS. 08100019 * 08200019 WKAERRSC DS A LOC OF 6 CHARACTER ERROR STRING. WILL BE 08300019 * INCLUDED IN MSG UNLESS WKAERRSC IS ZERO. 08400019 * 08500019 WKAERPOS DS H LINE POSITION IN BUFFER, IN BINARY. 08600019 * 08700019 WKAERRCD DS XL1 ERROR CODE. SPECIFIES WHICH MSG TO FORM. 08800019 * 08900019 WKASFAIL DS XL1 NOT-OPERATIONAL ERROR BYTE. 09000019 * (NOT SET OR USED IN THIS ROUTINE-- 09100019 * SEE LISTING OF IPDSN MODULE FOR 09200019 * USAGE.) 09300019 * 09400019 *********************************************************************** 09500019 * 09600019 * NOTE FOR MAINTENANCE 09700019 * -------------------- 09800019 * 09900019 * IPDERERR WILL NOT OPERATE PROPERLY UNLESS WKAERPAD IMMEDIATELY 10000019 * FOLLOWS WKAERNUM IN STORAGE, AND UNLESS WKAERCHR IMMEDIATELY 10100019 * FOLLOWS WKAERPAD IN STORAGE, AND UNLESS THE LENGTHS OF 10200019 * WKAERNUM, WKAERPAD, AND WKAERCHR ARE 8, 1, AND 6,RESPECTIVELY. 10300019 * 10400019 *********************************************************************** 10500019 WKAERNUM DS CL8 LINE NUMBER RIGHT-ADJUSTED IN EBCDIC. 10600019 * 10700019 WKAERPAD DS CL1 SPACE FOR BLANK BETWEEN WKAERNUM AND 10800019 * WKAERCHR. 10900019 * 11000019 WKAERCHR DS CL6 6 CHARACTER ERROR STRING. 11100019 EJECT 11200019 IPDERERR CSECT 11300019 SPACE 4 11400019 *********************************************************************** 11500019 * 11600019 * LENGTH OF CSECT 11700019 * 11800019 *********************************************************************** 11900019 * 12000019 ERRLENGT EQU 2880 MUST BE INTEGRAL MULT. OF 8 12100019 * 12200019 * THIS EQU DEFINES THE LENGTH OF THIS CSECT. 12300019 * THE AMOUNT OF SPACE FOR EXPANSION IS THE 12400019 * DIFFERENCE BETWEEN THIS NUMBER AND THE 12500019 * NUMBER OF BYTES USED IN THE CODING OF THE 12600019 * CSECT. IF THE CODING OF THE CSECT IS 12700019 * EXPANDED TO A NUMBER OF BYTES LARGER THAN 12800019 * THAT SPECIFIED BY THIS EQU , THE EQU 12900019 * MUST BE CHANGED TO SPECIFY A SIZE AT LEAST 13000019 * AS LARGE AS THE CODING. 13100019 SPACE 4 13200019 *********************************************************************** 13300019 * 13400019 * REGISTER DEFINITIONS 13500019 * 13600019 *********************************************************************** 13700019 SPACE 2 13800019 R2 EQU 2 BITS 0-23 ZERO, ERROR CODE WITH RIGHTMOST 13900019 * BIT ZEROED IN BITS 24-31. 14000019 SPACE 2 14100019 R3 EQU 3 WORK REGISTER. WHEN THE MVC INSTRUCTION 14200019 * LABELED ERREXMVC IS THE SUBJECT OF AN EX 14300019 * INSTRUCTION, THIS REGISTER CONTAINS THE 14400019 * ADDRESS OF THE TRANSMITTING FIELD. 14500019 SPACE 2 14600019 R4 EQU 4 WORK REGISTER. WHEN THE MVC INSTRUCTION 14700019 * LABELED ERREXMVC IS THE SUBJECT OF AN EX 14800019 * INSTRUCTION, THIS REGISTER CONTAINS ONE LESS 14900019 * THAN THE NUMBER OF CHARACTERS TO BE MOVED. 15000019 SPACE 2 15100019 R5 EQU 5 WORK REGISTER. WHEN THE MVC INSTRUCTION 15200019 * LABELED ERREXMVC IS THE SUBJECT OF AN EX 15300019 * INSTRUCTION, THIS REGISTER CONTAINS THE 15400019 * ADDRESS OF THE RECEIVING FIELD. 15500019 SPACE 2 15600019 *********************************************************************** 15700019 * 15800019 * ESTABLISH BASE REGISTERS AND SAVE CALLER'S REGISTERS. 15900019 * 16000019 *********************************************************************** 16100019 * 16200019 USING IPDERERR,15 16300019 USING IPDERWKA,1 16400019 B ERRSTART BRANCH TO START OF PROGRAM 16500019 ERRSNAME DC CL8'IPDERERR' NAME OF CSECT 16600019 ERRSTART STM 14,12,12(13) SAVE ALL REGISTERS IN CALLING 16700019 * PROGRAM'S SAVE AREA. 16800019 * 16900019 *********************************************************************** 17000019 * 17100019 * PLACE ERROR MESSAGE CODE IN ERROR MESSAGE BUFFER. 17200019 * 17300019 *********************************************************************** 17400019 * 17500019 IC R2,WKAERRCD OBTAIN ERROR CODE AND ZERO OUT 17600019 N R2,=X'000000FE' FIRST 3 BYTES AND LAST BIT OF R2. 17700019 CVD R2,WKAERBFR+4 CONVERT, FILLING WKAERBFR+4 17800019 * THROUGH WKAERBFR+9 WITH X'00'. 17900019 UNPK WKAERBFR+3(3),WKAERBFR+10(2) UNPACK ERROR CODE. 18000019 OC WKAERBFR+5(3),=C'0 ' SET ZONE OF ERROR CODE 18100019 * AND AT SAME TIME, APPEND TWO BLANKS. 18200019 MVC WKAERBFR(3),ERRSNAME 'IPD' TO FIRST THREE 18300019 * CHARACTERS OF MESSAGE BUFFER. 18400019 * 18500019 *********************************************************************** 18600019 * 18700019 * LINE OR SEQUENCE NUMBER AND SOURCE CHARACTERS (IF PRESENT) 18800019 * 18900019 *********************************************************************** 19000019 * 19100019 LA R3,WKAERNUM FIRST CHARACTER OF LINE NUMBER. 19200019 L R4,WKAEROPT ADDRESS, 4TH BYTE OF OPTIONS WORD. 19300019 TM 0(R4),X'40' TEST 2ND BIT. IF = 0, LINE NUMBER 19400019 BZ ERRLINUM IS OK, BRANCH TO LINE NUMBER 19500019 * ROUTINE. ELSE, CONVERT RELATIVE 19600019 * LINE NUMBER. 19700019 LH R4,WKAERPOS OBTAIN RELATIVE LINE NUMBER AND 19800019 N R4,=X'0000FFFF' MAKE SURE LEFT HALF OF R4 IS ZERO TO 19900019 * REMOVE PROPOGATED BITS IF BIT 0 OF 20000019 * WKAERPOS WAS 1. 20100019 CVD R4,WKAERBFR+12 DECIMAL REPRESENTATION TO NEXT 20200019 * UNUSED DOUBLE WORD IN MESSAGE BUFFER 20300019 UNPK WKAERNUM,WKAERBFR+17(3) UNPACK TO LINE NUMBER 20400019 OI WKAERNUM+7,C'0' FIELD, AND SET ZONE OF LAST DIGIT. 20500019 LA R4,7 LENGTH-1 OF RELATIVE LINE NUMBER. 20600019 B ERRSORCE GO TO TEST FOR SOURCE CHARACTERS. 20700019 * 20800019 * LOCATE FIRST NONBLANK AND NON-ZERO CHARACTER IN LINE 20900019 * NUMBER, BUT STOP AT LAST CHARACTER, EVEN IF IT IS 21000019 * BLANK OR ZERO. 21100019 * 21200019 ERRLINUM LA R4,7(0,R3) LAST CHARACTER OF LINE NUMBER. 21300019 ERRMORB0 CLI 0(R3),C'0' IS CHARACTER ZERO 21400019 BE ERRLDZRO YES. 21500019 CLI 0(R3),C' ' NO. IS CHARACTER BLANK 21600019 BNE ERRNOBLK NO, HAVE FOUND ALL LEADING ZEROS 21700019 * AND BLANKS. 21800019 ERRLDZRO LA R3,1(0,R3) YES, R3 TO NEXT CHARACTER. 21900019 CR R3,R4 HAS LAST CHARACTER OF LINE NUMBER 22000019 * BEEN REACHED 22100019 BL ERRMORB0 NO, PROCESS FURTHER CHARACTERS. 22200019 * 22300019 * HAVE ENCOUNTERED NON-ZERO OR NONBLANK OR LAST CHARACTER 22400019 * OF LINE NUMBER. MOVE LINE NUMBER, AND SOURCE CHARACTERS IF 22500019 * PRESENT, TO MESSAGE BUFFER. 22600019 * 22700019 ERRNOBLK SR R4,R3 COMPUTE NUMBER OF SIGNIFICANT 22800019 * CHARACTERS IN LINE NUMBER MINUS 1. 22900019 ERRSORCE L R5,WKAERRSC TEST WKAERRSC TO SEE WHETHER SOURCE 23000019 LTR R5,R5 CHARACTERS ARE TO BE IN MESSAGE. 23100019 BZ ERRNOSRC NO SOURCE CHARACTERS IN MESSAGE. 23200019 MVI WKAERPAD,C' ' SOURCE CHARACTERS PRESENT. BLANK 23300019 * BETWEEN LINE NUMBER AND SOURCE. 23400019 LA R4,7(0,R4) ADD SOURCE LENGTH TO LINE NO. LENGTH 23500019 * 23600019 ERRNOSRC LA R5,WKAERBFR+8 ADDRESS TO WHICH LINE NUMBER AND 23700019 * (IF PRESENT) SOURCE CHARACTERS ARE 23800019 * TO BE MOVED. 23900019 EX R4,ERREXMVC MOVE THEM, 24000019 LA R5,1(R4,R5) AND A 24100019 MVI 0(R5),C' ' BLANK AFTER THEM, 24200019 LA R5,1(0,R5) AND SET R5 TO POINT TO PLACE WHERE 24300019 * MESSAGE TEXT WILL BE INSERTED. 24400019 * 24500019 *********************************************************************** 24600019 * 24700019 * MOVE MESSAGE TEXT TO BUFFER. IF MESSAGE IS LONGER THAN 24800019 * L'WKAERBFR-24, ONLY THE FIRST L'WKAERBFR-24 CHARACTERS OF 24900019 * THE MESSAGE TEXT ARE MOVED. 25000019 * 25100019 *********************************************************************** 25200019 * 25300019 LH R3,MSGTABLE(R2) DISPLACEMENT OF MSG TO BE ISSUED. 25400019 LH R4,MSGTABLE+2(R2) DISPLACEMENT OF NEXT MESSAGE. 25500019 SR R4,R3 LENGTH OF MESSAGE TO BE ISSUED. 25600019 BNZ ERRMSGOK GO TO MOVE MESSAGE IF LENGTH NOT 0. 25700019 SR R3,R3 LENGTH WAS ZERO. SUBSTITUTE MSG 0. 25800019 LH R4,MSGTABLE+2 ( MSG 0 DISPLACEMENT = 0, LENGTH = 25900019 * CONTENTS OF MSGTABLE+2 ) 26000019 ERRMSGOK LA R3,MSG000(R3) ACTUAL ADDRESS OF MESSAGE. 26100019 BCTR R4,0 SUBTRACT 1 FROM MESSAGE LENGTH. 26200019 CH R4,=Y(L'WKAERBFR-25) IS MESSAGE TOO LONG 26300019 BNH ERRLENOK NO, USE LENGTH ALREADY IN R4. 26400019 LH R4,=Y(L'WKAERBFR-25) YES, LOAD LONGEST LENGTH 26500019 * PERMITTED, TRUNCATING MESSAGE. 26600019 ERRLENOK EX R4,ERREXMVC MOVE MESSAGE TO BUFFER. 26700019 * 26800019 *********************************************************************** 26900019 * 27000019 * FILL REMAINDER OF BUFFER WITH BLANKS. 27100019 * 27200019 *********************************************************************** 27300019 * 27400019 LA R3,1(R5,R4) ADDRESS OF FIRST BYTE AFTER MESSAGE. 27500019 LA R4,WKAERBFR+L'WKAERBFR-1 A(LAST BYTE IN BUFFER) 27600019 CR R4,R3 DOES BUFFER HAVE SPACE FOR 1 BLANK 27700019 BL ERRRETN NO, RETURN. 27800019 MVI 0(R3),C' ' PUT A BLANK IN BYTE AFTER MSG. 27900019 LA R5,1(0,R3) ADDRESS OF SECOND BYTE AFTER MSG. 28000019 SR R4,R5 NUMBER-1 OF BLANKS TO BE PROPOGATED. 28100019 BM ERRRETN RETURN IF NO SPACE FOR MORE BLANKS. 28200019 EX R4,ERREXMVC PROPOGATE BLANKS TO FILL OUT BUFFER. 28300019 * 28400019 *********************************************************************** 28500019 * 28600019 * RETURN TO CALLING PROGRAM. 28700019 * 28800019 *********************************************************************** 28900019 * 29000019 ERRRETN LM 14,12,12(13) RESTORE ALL REGISTERS. 29100019 BR 14 BRANCH TO CALLER. 29200019 * 29300019 *********************************************************************** 29400019 * 29500019 * MVC INSTRUCTION EXECUTED TO MOVE LINE NUMBER, SOURCE 29600019 * CHARACTERS, MESSAGE TEXT, AND TRAILING BLANKS INTO 29700019 * MESSAGE BUFFER. 29800019 * 29900019 *********************************************************************** 30000019 * 30100019 ERREXMVC MVC 0(0,R5),0(R3) 30200019 * 30300019 *********************************************************************** 30400019 * 30500019 LTORG 30600019 * 30700019 *********************************************************************** 30800019 EJECT 30900019 *********************************************************************** 31000019 * 31100019 * TABLE OF MESSAGE DISPLACEMENTS. ALL DISPLACEMENTS ARE 31200019 * RELATIVE TO THE START OF MESSAGE ZERO. 31300019 * 31400019 *********************************************************************** 31500019 * 31600019 DS 0H 31700019 MSGTABLE DC AL2(MSG000-MSG000) DISPLACEMENT, MESSAGES 000 & 001 31800019 DC AL2(MSG002-MSG000) DISPLACEMENT, MESSAGES 002 & 003 31900019 DC AL2(MSG004-MSG000) DISPLACEMENT, MESSAGES 004 & 005 32000019 DC AL2(MSG006-MSG000) DISPLACEMENT, MESSAGES 006 & 007 32100019 DC AL2(MSG008-MSG000) DISPLACEMENT, MESSAGES 008 & 009 32200019 DC AL2(MSG010-MSG000) DISPLACEMENT, MESSAGES 010 & 011 32300019 DC AL2(MSG012-MSG000) DISPLACEMENT, MESSAGES 012 & 013 32400019 DC AL2(MSG014-MSG000) DISPLACEMENT, MESSAGES 014 & 015 32500019 DC AL2(MSG016-MSG000) DISPLACEMENT, MESSAGES 016 & 017 32600019 DC AL2(MSG018-MSG000) DISPLACEMENT, MESSAGES 018 & 019 32700019 DC AL2(MSG020-MSG000) DISPLACEMENT, MESSAGES 020 & 021 32800019 DC AL2(MSG022-MSG000) DISPLACEMENT, MESSAGES 022 & 023 32900019 DC AL2(MSG024-MSG000) DISPLACEMENT, MESSAGES 024 & 025 33000019 DC AL2(MSG026-MSG000) DISPLACEMENT, MESSAGES 026 & 027 33100019 DC AL2(MSG028-MSG000) DISPLACEMENT, MESSAGES 028 & 029 33200019 DC AL2(MSG030-MSG000) DISPLACEMENT, MESSAGES 030 & 031 33300019 DC AL2(MSG032-MSG000) DISPLACEMENT, MESSAGES 032 & 033 33400019 DC AL2(MSG034-MSG000) DISPLACEMENT, MESSAGES 034 & 035 33500019 DC AL2(MSG036-MSG000) DISPLACEMENT, MESSAGES 036 & 037 33600019 DC AL2(MSG038-MSG000) DISPLACEMENT, MESSAGES 038 & 039 33700019 DC AL2(MSG040-MSG000) DISPLACEMENT, MESSAGES 040 & 041 33800019 DC AL2(MSG042-MSG000) DISPLACEMENT, MESSAGES 042 & 043 33900019 DC AL2(MSG044-MSG000) DISPLACEMENT, MESSAGES 044 & 045 34000019 DC AL2(MSG046-MSG000) DISPLACEMENT, MESSAGES 046 & 047 34100019 DC AL2(MSG048-MSG000) DISPLACEMENT, MESSAGES 048 & 049 34200019 DC AL2(MSG050-MSG000) DISPLACEMENT, MESSAGES 050 & 051 34300019 DC AL2(MSG052-MSG000) DISPLACEMENT, MESSAGES 052 & 053 34400019 DC AL2(MSG054-MSG000) DISPLACEMENT, MESSAGES 054 & 055 34500019 DC AL2(MSG056-MSG000) DISPLACEMENT, MESSAGES 056 & 057 34600019 DC AL2(MSG058-MSG000) DISPLACEMENT, MESSAGES 058 & 059 34700019 DC AL2(MSG060-MSG000) DISPLACEMENT, MESSAGES 060 & 061 34800019 DC AL2(MSG062-MSG000) DISPLACEMENT, MESSAGES 062 & 063 34900019 DC AL2(MSG064-MSG000) DISPLACEMENT, MESSAGES 064 & 065 35000019 DC AL2(MSG066-MSG000) DISPLACEMENT, MESSAGES 066 & 067 35100019 DC AL2(MSG068-MSG000) DISPLACEMENT, MESSAGES 068 & 069 35200019 DC AL2(MSG070-MSG000) DISPLACEMENT, MESSAGES 070 & 071 35300019 DC AL2(MSG072-MSG000) DISPLACEMENT, MESSAGES 072 & 073 35400019 DC AL2(MSG074-MSG000) DISPLACEMENT, MESSAGES 074 & 075 35500019 DC AL2(MSG076-MSG000) DISPLACEMENT, MESSAGES 076 & 077 35600019 DC AL2(MSG078-MSG000) DISPLACEMENT, MESSAGES 078 & 079 35700019 DC AL2(MSG080-MSG000) DISPLACEMENT, MESSAGES 080 & 081 35800019 DC AL2(MSG082-MSG000) DISPLACEMENT, MESSAGES 082 & 083 35900019 DC AL2(MSG084-MSG000) DISPLACEMENT, MESSAGES 084 & 085 36000019 DC AL2(MSG086-MSG000) DISPLACEMENT, MESSAGES 086 & 087 36100019 DC AL2(MSG088-MSG000) DISPLACEMENT, MESSAGES 088 & 089 36200019 DC AL2(MSG090-MSG000) DISPLACEMENT, MESSAGES 090 & 091 36300019 DC AL2(MSG092-MSG000) DISPLACEMENT, MESSAGES 092 & 093 36400019 DC AL2(MSG094-MSG000) DISPLACEMENT, MESSAGES 094 & 095 36500019 DC AL2(MSG096-MSG000) DISPLACEMENT, MESSAGES 096 & 097 36600019 DC AL2(MSG098-MSG000) DISPLACEMENT, MESSAGES 098 & 099 36700019 DC AL2(MSG100-MSG000) DISPLACEMENT, MESSAGES 100 & 101 36800019 DC AL2(MSG102-MSG000) DISPLACEMENT, MESSAGES 102 & 103 36900019 DC AL2(MSG104-MSG000) DISPLACEMENT, MESSAGES 104 & 105 37000019 DC AL2(MSG106-MSG000) DISPLACEMENT, MESSAGES 106 & 107 37100019 DC AL2(MSG108-MSG000) DISPLACEMENT, MESSAGES 108 & 109 37200019 DC AL2(MSG110-MSG000) DISPLACEMENT, MESSAGES 110 & 111 37300019 DC AL2(MSG112-MSG000) DISPLACEMENT, MESSAGES 112 & 113 37400019 DC AL2(MSG114-MSG000) DISPLACEMENT, MESSAGES 114 & 115 37500019 DC AL2(MSG116-MSG000) DISPLACEMENT, MESSAGES 116 & 117 37600019 DC AL2(MSG118-MSG000) DISPLACEMENT, MESSAGES 118 & 119 37700019 DC AL2(MSG120-MSG000) DISPLACEMENT, MESSAGES 120 & 121 37800019 DC AL2(MSG122-MSG000) DISPLACEMENT, MESSAGES 122 & 123 37900019 DC AL2(MSG124-MSG000) DISPLACEMENT, MESSAGES 124 & 125 38000019 DC AL2(MSG126-MSG000) DISPLACEMENT, MESSAGES 126 & 127 38100019 DC AL2(MSG128-MSG000) DISPLACEMENT, MESSAGES 128 & 129 38200019 DC AL2(MSG130-MSG000) DISPLACEMENT, MESSAGES 130 & 131 38300019 DC AL2(MSG132-MSG000) DISPLACEMENT, MESSAGES 132 & 133 38400019 DC AL2(MSG134-MSG000) DISPLACEMENT, MESSAGES 134 & 135 38500019 DC AL2(MSG136-MSG000) DISPLACEMENT, MESSAGES 136 & 137 38600019 DC AL2(MSG138-MSG000) DISPLACEMENT, MESSAGES 138 & 139 38700019 DC AL2(MSG140-MSG000) DISPLACEMENT, MESSAGES 140 & 141 38800019 DC AL2(MSG142-MSG000) DISPLACEMENT, MESSAGES 142 & 143 38900019 DC AL2(MSG144-MSG000) DISPLACEMENT, MESSAGES 144 & 145 39000019 DC AL2(MSG146-MSG000) DISPLACEMENT, MESSAGES 146 & 147 39100019 DC AL2(MSG148-MSG000) DISPLACEMENT, MESSAGES 148 & 149 39200019 DC AL2(MSG150-MSG000) DISPLACEMENT, MESSAGES 150 & 151 39300019 DC AL2(MSG152-MSG000) DISPLACEMENT, MESSAGES 152 & 153 39400019 DC AL2(MSG154-MSG000) DISPLACEMENT, MESSAGES 154 & 155 39500019 DC AL2(MSG156-MSG000) DISPLACEMENT, MESSAGES 156 & 157 39600019 DC AL2(MSG158-MSG000) DISPLACEMENT, MESSAGES 158 & 159 39700019 DC AL2(MSG160-MSG000) DISPLACEMENT, MESSAGES 160 & 161 39800019 DC AL2(MSG162-MSG000) DISPLACEMENT, MESSAGES 162 & 163 39900019 DC AL2(MSG164-MSG000) DISPLACEMENT, MESSAGES 164 & 165 40000019 DC AL2(MSG166-MSG000) DISPLACEMENT, MESSAGES 166 & 167 40100019 DC AL2(MSG168-MSG000) DISPLACEMENT, MESSAGES 168 & 169 40200019 DC AL2(MSG170-MSG000) DISPLACEMENT, MESSAGES 170 & 171 40300019 DC AL2(MSG172-MSG000) DISPLACEMENT, MESSAGES 172 & 173 40400019 DC AL2(MSG174-MSG000) DISPLACEMENT, MESSAGES 174 & 175 40500019 DC AL2(MSG176-MSG000) DISPLACEMENT, MESSAGES 176 & 177 40600019 DC AL2(MSG178-MSG000) DISPLACEMENT, MESSAGES 178 & 179 40700019 DC AL2(MSG180-MSG000) DISPLACEMENT, MESSAGES 180 & 181 40800019 DC AL2(MSG182-MSG000) DISPLACEMENT, MESSAGES 182 & 183 40900019 DC AL2(MSG184-MSG000) DISPLACEMENT, MESSAGES 184 & 185 41000019 DC AL2(MSG186-MSG000) DISPLACEMENT, MESSAGES 186 & 187 41100019 DC AL2(MSG188-MSG000) DISPLACEMENT, MESSAGES 188 & 189 41200019 DC AL2(MSG190-MSG000) DISPLACEMENT, MESSAGES 190 & 191 41300019 DC AL2(MSG192-MSG000) DISPLACEMENT, MESSAGES 192 & 193 41400019 DC AL2(MSG194-MSG000) DISPLACEMENT, MESSAGES 194 & 195 41500019 DC AL2(MSG196-MSG000) DISPLACEMENT, MESSAGES 196 & 197 41600019 DC AL2(MSG198-MSG000) DISPLACEMENT, MESSAGES 198 & 199 41700019 DC AL2(MSG200-MSG000) DISPLACEMENT, MESSAGES 200 & 201 41800019 DC AL2(MSG202-MSG000) DISPLACEMENT, MESSAGES 202 & 203 41900019 DC AL2(MSG204-MSG000) DISPLACEMENT, MESSAGES 204 & 205 42000019 DC AL2(MSG206-MSG000) DISPLACEMENT, MESSAGES 206 & 207 42100019 DC AL2(MSG208-MSG000) DISPLACEMENT, MESSAGES 208 & 209 42200019 DC AL2(MSG210-MSG000) DISPLACEMENT, MESSAGES 210 & 211 42300019 DC AL2(MSG212-MSG000) DISPLACEMENT, MESSAGES 212 & 213 42400019 DC AL2(MSG214-MSG000) DISPLACEMENT, MESSAGES 214 & 215 42500019 DC AL2(MSG216-MSG000) DISPLACEMENT, MESSAGES 216 & 217 42600019 DC AL2(MSG218-MSG000) DISPLACEMENT, MESSAGES 218 & 219 42700019 DC AL2(MSG220-MSG000) DISPLACEMENT, MESSAGES 220 & 221 42800019 DC AL2(MSG222-MSG000) DISPLACEMENT, MESSAGES 222 & 223 42900019 DC AL2(MSG224-MSG000) DISPLACEMENT, MESSAGES 224 & 225 43000019 DC AL2(MSG226-MSG000) DISPLACEMENT, MESSAGES 226 & 227 43100019 DC AL2(MSG228-MSG000) DISPLACEMENT, MESSAGES 228 & 229 43200019 DC AL2(MSG230-MSG000) DISPLACEMENT, MESSAGES 230 & 231 43300019 DC AL2(MSG232-MSG000) DISPLACEMENT, MESSAGES 232 & 233 43400019 DC AL2(MSG234-MSG000) DISPLACEMENT, MESSAGES 234 & 235 43500019 DC AL2(MSG236-MSG000) DISPLACEMENT, MESSAGES 236 & 237 43600019 DC AL2(MSG238-MSG000) DISPLACEMENT, MESSAGES 238 & 239 43700019 DC AL2(MSG240-MSG000) DISPLACEMENT, MESSAGES 240 & 241 43800019 DC AL2(MSG242-MSG000) DISPLACEMENT, MESSAGES 242 & 243 43900019 DC AL2(MSG244-MSG000) DISPLACEMENT, MESSAGES 244 & 245 44000019 DC AL2(MSG246-MSG000) DISPLACEMENT, MESSAGES 246 & 247 44100019 DC AL2(MSG248-MSG000) DISPLACEMENT, MESSAGES 248 & 249 44200019 DC AL2(MSG250-MSG000) DISPLACEMENT, MESSAGES 250 & 251 44300019 DC AL2(MSG252-MSG000) DISPLACEMENT, MESSAGES 252 & 253 44400019 DC AL2(MSG254-MSG000) DISPLACEMENT, MESSAGES 254 & 255 44500019 DC AL2(MSGEND-MSG000) DISPLACEMENT, END OF MESSAGES 44600019 EJECT 44700019 *********************************************************************** 44800019 * 44900019 * DEFINITIONS OF THE MESSAGE TEXTS. IF NO TEXT IS ASSOCIATED 45000019 * WITH A MESSAGE CODE, THE MESSAGE IS SAID TO BE UNDEFINED. 45100019 * 45200019 * THE TEXT OF EACH DEFINED MESSAGE IS ENTERED AS A DC DEFINING 45300019 * THE CHARACTERS OF THE TEXT IMMEDIATELY AFTER THE EQU * 45400019 * HAVING THE LABEL ASSOCIATED WITH THE MESSAGE. PRESENCE OF A 45500019 * LABEL CORRESPONDING TO EACH POSSIBLE ERROR CODE ASSURES THAT 45600019 * THE LENGTH COMPUTED FROM MSGTABLE WILL BE ZERO FOR ANY 45700019 * MESSAGE THAT HAS NOT BEEN DEFINED. 45800019 * 45900019 *********************************************************************** 46000019 * 46100019 * NOTE FOR MAINTENANCE 46200019 * -------------------- 46300019 * 46400019 * ERROR MESSAGE ZERO MUST ALWAYS HAVE A LENGTH OF AT LEAST ONE 46500019 * BYTE, THAT IS, IT MUST BE DEFINED. IF MESSAGE ZERO WERE NOT 46600019 * DEFINED, A CALL TO THIS MODULE WITH AN ERROR CODE FOR ANY 46700019 * OTHER UNDEFINED MESSAGE WOULD CAUSE THE 256 BYTES STARTING 46800019 * WITH THE LABEL MSG000 TO BE MOVED INTO THE MESSAGE BUFFER, 46900019 * DESTROYING BYTES OUTSIDE THE MESSAGE BUFFER. 47000019 * 47100019 * ALL THE EQU * CARDS MUST REMAIN IN THIS MODULE, EVEN IF 47200019 * A DC IS TAKEN OUT TO REMOVE A MESSAGE. THE ORDER OF THE 47300019 * EQU'S MUST BE SUCH THAT THE XXX'S OF THEIR MSGXXX LABELS 47400019 * ARE IN ASCENDING NUMERICAL ORDER. 47500019 * 47600019 *********************************************************************** 47700019 * 47800019 MSG000 EQU * 47900019 DC C'SYSTEM OR SYNTAX CHECKER FAILURE' 48000019 MSG002 EQU * 48100019 DC C'UNRECOGNIZABLE STMNT OR MISSPELLED KEYWD' 48200019 MSG004 EQU * 48300019 DC C'UNSIGNED INTEGER EXPECTED' 48400019 MSG006 EQU * 48500019 DC C'EXPRESSION EXPECTED' 48600019 MSG008 EQU * 48700019 DC C'POSSIBLY TOO MANY SUBSCRIPTS PRECEDE' 48800019 MSG010 EQU * 48900019 DC C'TOO MANY SUBSCRIPTS' 49000019 MSG012 EQU * 49100019 DC C') EXPECTED' 49200019 MSG014 EQU * 49300019 DC C'ARITH IF REQUIRES STATEMENT NUMBER LIST' 49400019 MSG016 EQU * 49500019 DC C'INVALID EXPRESSION IN IF STATEMENT' 49600019 MSG018 EQU * 49700019 DC C'UNRECOGNIZABLE STMNT AFTER LOGICAL IF' 49800019 MSG020 EQU * 49900019 DC C'NON-ZERO INTEGER EXPECTED' 50000019 MSG022 EQU * 50100019 DC C'ILLEGAL STATEMENT AFTER LOGICAL IF' 50200019 MSG024 EQU * 50300019 DC C'STATEMENT FIELD MISSING' 50400019 MSG026 EQU * 50500019 DC C'DATA SET REF NUMBER EXPECTED' 50600019 MSG028 EQU * 50700019 DC C'LENGTH SPECIFICATION INVALID' 50800019 MSG030 EQU * 50900019 DC C'( EXPECTED' 51000019 MSG032 EQU * 51100019 DC C'NAME EXPECTED' 51200019 MSG034 EQU * 51300019 DC C'DUMMY ARGUMENT EXPECTED' 51400019 MSG036 EQU * 51500019 DC C'ARRAY DIMENSIONS EXPECTED' 51600019 MSG038 EQU * 51700019 DC C'/ EXPECTED' 51800019 MSG040 EQU * 51900019 DC C'INVALID DATA TYPE' 52000019 MSG042 EQU * 52100019 DC C'STATEMENT NUMBER EXPECTED' 52200019 MSG044 EQU * 52300019 DC C'''TO'' EXPECTED' 52400019 MSG046 EQU * 52500019 DC C'ARGUMENT EXPECTED' 52600019 MSG048 EQU * 52700019 DC C'DATA LIST EXPECTED' 52800019 MSG050 EQU * 52900019 DC C'RELATIONAL OPERATOR EXPECTED' 53000019 MSG052 EQU * 53100019 DC C', EXPECTED' 53200019 MSG054 EQU * 53300019 DC C'OPERAND EXPECTED IN ARITH EXPRESSION' 53400019 MSG056 EQU * 53500019 DC C'OPERAND EXPECTED IN LOGICAL EXPRESSION' 53600019 MSG058 EQU * 53700019 DC C'I/O LIST ITEM EXPECTED' 53800019 MSG060 EQU * 53900019 DC C''' EXPECTED' 54000019 MSG062 EQU * 54100019 DC C'INCORRECT PARAMETER - MUST BE E, L, OR U' 54200019 MSG064 EQU * 54300019 DC C'DEBUG PARAMETER EXPECTED' 54400019 MSG066 EQU * 54500019 DC C'SUBSCRIPT EXPECTED' 54600019 MSG068 EQU * 54700019 DC C'TOO MANY LEVELS OF PARENTHESES' 54800019 MSG070 EQU * 54900019 DC C'STATEMENT TOO LONG' 55000019 MSG072 EQU * 55100019 DC C'INTEGER EXPECTED' 55200019 MSG074 EQU * 55300019 DC C'COMPLEX NUMBER INVALID' 55400019 MSG076 EQU * 55500019 DC C'DELIMITER MISSING OR INVALID FORMAT CODE' 55600019 MSG078 EQU * 55700019 DC C'VARIABLE LIST EXPECTED' 55800019 MSG080 EQU * 55900019 DC C'. EXPECTED IN FORMAT CODE' 56000019 MSG082 EQU * 56100019 DC C'NAME TOO LONG' 56200019 MSG084 EQU * 56300019 DC C'STATEMENT NUMBER INVALID' 56400019 MSG086 EQU * 56500019 DC C'H-LITERAL INCOMPLETE' 56600019 MSG088 EQU * 56700019 DC C'FIELD WIDTH NOT IN RANGE 1-255' 56800019 MSG090 EQU * 56900019 DC C'LITERAL EXCEEDS 255 CHARACTERS' 57000019 MSG092 EQU * 57100019 DC C'STATEMENT ANALYSIS EXCEEDS TABLE LIMITS' 57200019 MSG094 EQU * 57300019 DC C'END REQUIRES BLANK LABEL && CONTIN FIELDS' 57400019 MSG096 EQU * 57500019 DC C'INVALID OR EXCESS SOURCE CHARACTERS' 57600019 MSG098 EQU * 57700019 DC C'INVALID RANGE IN IMPLICIT STATEMENT' 57800019 MSG100 EQU * 57900019 DC C'FIRST LINE IS A CONTINUATION' 58000019 MSG102 EQU * 58100019 DC C'COMMENT LINE WITHIN STATEMENT' 58200019 MSG104 EQU * 58300019 DC C'TOO MANY CONTINUATION LINES' 58400019 MSG106 EQU * 58500019 DC C'TOO MANY DECIMAL PLACES FOR FIELD WIDTH' 58600019 MSG108 EQU * 58700019 DC C'DECIMAL PLACES MUST BE SPECIFIED' 58800019 MSG110 EQU * 58900019 DC C') REQUIRED FOR IMPLIED DO' 59000019 MSG112 EQU * 59100019 DC C'DO VARIABLE CANNOT BE SUBSCRIPTED' 59200019 MSG114 EQU * 59300019 DC C'DEBUG FACILITY NOT SUPPORTED' 59400019 MSG116 EQU * 59500019 DC C'EXPONENT MISSING OR INVALID' 59600019 MSG118 EQU * 59700019 DC C'REAL CONSTANT MUST HAVE AT LEAST 1 DIGIT' 59800019 MSG120 EQU * 59900019 DC C'INTEGER TOO LARGE' 60000019 MSG122 EQU * 60100019 DC C'CLOSING '' EXPECTED' 60200019 MSG124 EQU * 60300019 DC C'DATA ILLEGAL FOR DUMMY ARRAY' 60400019 MSG126 EQU * 60500019 DC C'REAL NUMBER EXPECTED' 60600019 MSG128 EQU * 60700019 DC C'INVALID CHARACTERS AFTER STOP OR PAUSE' 60800019 MSG130 EQU * 60900019 DC C'REAL NUMBER OUTSIDE OF ALLOWABLE RANGE' 61000019 MSG132 EQU * 61100019 DC C'FORMAT STMNT NO. OR ARRAY NAME EXPECTED' 61200019 MSG134 EQU * 61300019 DC C'MISPLACED LENGTH SPECIFICATION PRECEDES' 61400019 MSG136 EQU * 61500019 DC C'FREE-FORM LIST-DIRECTED I/O ILLEGAL' 61600019 MSG138 EQU * 61700019 DC C'ARITH EXP EXPECTED AFTER RELATIONAL OP' 61800019 MSG140 EQU * 61900019 DC C'INVALID COMMA IN DO' 62000019 MSG142 EQU * 62100019 DC C'= EXPECTED' 62200019 MSG144 EQU * 62300019 DC C'LITERAL CONTAINS NO CHARACTERS' 62400019 MSG146 EQU * 62500019 DC C'INVALID IF AFTER LOGICAL IF' 62600019 MSG148 EQU * 62700019 DC C'INVALID DECIMAL POINT' 62800019 MSG150 EQU * 62900019 DC C'TOO MANY DIGITS IN STATEMENT NUMBER' 63000019 MSG152 EQU * 63100019 DC C'STMNT NO. NOT COMPLETE ON INITIAL LINE' 63200019 MSG154 EQU * 63300019 DC C'TOO MANY CONTINUED LINES' 63400019 MSG156 EQU * 63500019 DC C'INVALID CHARACTERS BEFORE STATEMENT' 63600019 MSG158 EQU * 63700019 DC C'TOO MANY SUBSCRIPTS PRECEDE' 63800019 MSG160 EQU * 63900019 MSG162 EQU * 64000019 MSG164 EQU * 64100019 MSG166 EQU * 64200019 MSG168 EQU * 64300019 MSG170 EQU * 64400019 MSG172 EQU * 64500019 MSG174 EQU * 64600019 MSG176 EQU * 64700019 MSG178 EQU * 64800019 MSG180 EQU * 64900019 MSG182 EQU * 65000019 MSG184 EQU * 65100019 MSG186 EQU * 65200019 MSG188 EQU * 65300019 MSG190 EQU * 65400019 MSG192 EQU * 65500019 MSG194 EQU * 65600019 MSG196 EQU * 65700019 MSG198 EQU * 65800019 MSG200 EQU * 65900019 MSG202 EQU * 66000019 MSG204 EQU * 66100019 MSG206 EQU * 66200019 MSG208 EQU * 66300019 MSG210 EQU * 66400019 MSG212 EQU * 66500019 MSG214 EQU * 66600019 MSG216 EQU * 66700019 MSG218 EQU * 66800019 MSG220 EQU * 66900019 MSG222 EQU * 67000019 MSG224 EQU * 67100019 MSG226 EQU * 67200019 MSG228 EQU * 67300019 MSG230 EQU * 67400019 MSG232 EQU * 67500019 MSG234 EQU * 67600019 MSG236 EQU * 67700019 MSG238 EQU * 67800019 MSG240 EQU * 67900019 MSG242 EQU * 68000019 MSG244 EQU * 68100019 MSG246 EQU * 68200019 MSG248 EQU * 68300019 MSG250 EQU * 68400019 MSG252 EQU * 68500019 MSG254 EQU * 68600019 MSGEND EQU * LOCATION AFTER LAST MESSAGE DEFINED. 68700019 * 68800019 ERRSOFAR EQU *-IPDERERR TROUBLE IF THIS EXCEEDS ERRLENGT 68900019 ERREXPAN EQU ERRLENGT-ERRSOFAR SIZE (IN BYTES) OF EXPANSION SPACE 69000019 DC (ERREXPAN)C'R' EXPANSION SPACE FILLED WITH R'S 69100019 ERRCSEND EQU * LOC SHOULD EQUAL ERRLENGT 69200019 * 69300019 END 69400019 ./ ADD SSI=01013617,NAME=IPDSN,SOURCE=0 SNCK TITLE ' FORTRAN SYNTAX CHECKER MODULE ' 00020020 * 00040020 * IPDSN, CHECKER MODULE 00060020 * 00080020 * IPDSN, THE CHECKER MODULE, VERIFIES THE SYNTAX OF 00100020 * FORTRAN STATEMENTS. IT IS COMPOSED OF TWO SEGMENTS, 00120020 * IPDSNEXC, THE EXECUTIVE, AND IPDSNCKR, THE CHECKER. 00140020 * 00160020 * ALL ENTRIES AND EXITS OF THE SYNTAX CHECKER FROM THE 00180020 * ENVIRONMENTAL SYSTEM GO THROUGH THE EXECUTIVE SEGMENT. 00200020 * 00220020 * ALL CALLS TO THE ERROR MESSAGE GENERATOR, IPDER, ARE ALSO 00240020 * MADE EXCLUSIVELY BY THE EXECUTIVE SEGMENT. 00260020 * 00280020 * THE OPERATION OF THIS MODULE DEPENDS UPON THE PROPERTIES OF 00300020 * THE INTERNAL REPRESENTATION OF THE EXTERNAL CHARACTER SET 00320020 * SPECIFIED IN THE INTRODUCTORY COMMENTS TO ITS CONTROL SECTIONS 00340020 * IPDSNEXC AND IPDSNCKR. 00360020 * 00380020 MACRO 00400020 BOMBR 00420020 ORG *-4 00440020 DC 4X'00' 00460020 MEND 00480020 MACRO 00500020 &NMTSTAM TSTAM &FAILLOC 00520020 * TEST FOR ALPHAMERIC 00540020 &NMTSTAM CLI WKASCHRS,CKRA IS IT LESS THAN A IN EBCDIC COLL SEQ 00560020 BNL A&SYSNDX NO, DO ALPHA/NUMBER TEST 00580020 CLI WKASCHRS,CKR$ YES, IS IT $ 00600020 BNE &FAILLOC NO, TEST FAILS 00620020 B E&SYSNDX YES, TEST SUCCEEDS 00640020 A&SYSNDX TRT WKASCHRS(1),CKRAMTBL 00660020 BC 7,&FAILLOC NOT ALPHAMERIC 00680020 E&SYSNDX EQU * ALPHAMERIC 00700020 MEND 00720020 * 00740020 * 00760020 MACRO 00780020 &NMTSTAL TSTAL &FAILLOC 00800020 * TEST FOR ALPHABETIC 00820020 &NMTSTAL CLI WKASCHRS,CKRZ IS IT GREATER THAN Z IN EBCDIC SEQ. 00840020 BH &FAILLOC IF SO, NOT ALPHABETIC (EVEN IF A/M) 00860020 * 00880020 TSTAM &FAILLOC 00900020 MEND 00920020 * 00940020 * 00960020 MACRO 00980020 &NMUPDSC UPDSC 01000020 &NMUPDSC L REGSRCPT,WKASRCUP UPDATE SOURCE POINTER 01020020 MEND 01040020 * 01060020 * 01080020 MACRO 01100020 &NMSVERP SVERP ®ISTR 01120020 * SET ERROR PT FROM CURR SRCE PT 01140020 AIF ('®ISTR' EQ '').NOREG 01160020 &NMSVERP L ®ISTR,WKASRCCR 01180020 ST ®ISTR,WKAERRSC 01200020 MEXIT 01220020 .NOREG ANOP 01240020 &NMSVERP MVC WKAERRSC,WKASRCCR 01260020 MEND 01280020 * 01300020 * 01320020 MACRO 01340020 &NMGTNB1 GTNB1 01360020 &NMGTNB1 BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK CHARACTER 01380020 MEND 01400020 * 01420020 * ASSEMBLY PARAMETERS FOR DEBUGGING 01440020 * 01460020 LCLC &EXCALMS,&EXCALMT EXECUTIVE VARIABLES FOR DEBUGGING 01480020 LCLC &ITNLDBG LEVEL OF INTERNAL DEBUGGING DONE BY 01500020 * IPDSNCKR 01520020 * 01540020 * THE LAST SETC TO DEFINE A SYMBOL DETERMINES 01560020 * THE SUBSEQUENT VALUE OF THE SYMBOL. HENCE, ASSEMBLY 01580020 * PARAMETERS MAY BE CHANGED FOR DEBUGGING BY 01600020 * REORDERING SETC CARDS. 01620020 * 01640020 &EXCALMT SETC '*+1' 01660020 &EXCALMS SETC '*+1' *+1 USED TO CAUSE SPECIFICATION C01680020 ERRORS WHEN DEBUGGING 01700020 &EXCALMT SETC 'EXCALMT' 01720020 &EXCALMS SETC 'EXCALMS' 01740020 * 01760020 &ITNLDBG SETC '' NO DEBUGGING 01780020 &ITNLDBG SETC 'L' LIMITED DEBUGGING 01800020 &ITNLDBG SETC 'E' EXTENDED DEBUGGING 01820020 * 01840020 * 01860020 * NUMBERS ARE REFERRED TO BEGINNING WITH ZERO, 01880020 * EXCEPT FOR CARD COLUMNS, WHICH ARE REFERRED TO 01900020 * STARTING FROM 1. E.G., BYTES 0-3 OF A FULL-WORD, 01920020 * BITS 0-7 OF A BYTE, COLUMNS 1-80 OF A CARD. 01940020 * 01960020 EJECT 01980020 * 02000020 * 02020020 *NAME OF ROUTINE.. 02040020 * IPDSNEXC 02060020 * 02080020 *FUNCTION.. 02100020 * THE EXECUTIVE SEGMENT OF THE SYNTAX CHECKER MODULE 02120020 * MANAGES WORK AREAS AND LANGUAGE DEFINITION TABLE MODULES, 02140020 * SCANS INPUT BUFFER CHAIN FOR SOURCE STATEMENTS, 02160020 * CALLS THE SYNTAX CHECKER PROPER TO DIAGNOSE SYNTAX ERRORS, 02180020 * CALLS THE ERROR PROCESSOR TO CONSTRUCT ERROR MESSAGES, AND 02200020 * SETS UP PROPER RETURNS TO THE CALLING SYSTEM. 02220020 * 02240020 * 02260020 *ENTRY.. IPDSNEXC. CALLED VIA STANDARD CALLING SEQUENCE. 02280020 * 02300020 *INPUT.. 02320020 * WHEN EXECUTIVE IS CALLED, REGISTER 1 POINTS TO 02340020 * DC A(FIRST BUFFER IN CHAIN), 02360020 * DC A(COMMUNICATIONS AREA, 4 WORDS), 02380020 * DC X'80', 02400020 * DC AL3(OPTIONS WORD). 02420020 * 02440020 * THE AMOUNT OF SPACE FOR EXPANSION IS THE 02460020 * DIFFERENCE BETWEEN THIS NUMBER AND THE 02480020 * NUMBER OF BYTES USED IN THE CODING OF THE 02500020 * 02520020 * 02540020 *COMMENTS BEGIN IN COLUMNS 35 40 45 IN EXECUTIVE 02560020 * 02580020 * PARAMETERS PASSED BY SYSTEM. 02600020 * REGPARAM USED AS DSECT REGISTER. 02620020 IPDSNSNP DSECT 02640020 SNPRMBFR DS F ADDRESS OF FIRST BUFFER IN CHAIN. 02660020 SNPRMCOM DS F ADDRESS OF 4-WORD COMMUNICATION AREA. 02680020 SNPRMOPT DS F ADDRESS OF OPTIONS WORD. 02700020 * 02720020 * 02740020 * FORMAT OF COMMUNICATIONS AREA,4 WDS. 02760020 IPDSNCOM DSECT 02780020 COMWRKAD DS 0F FULL WORD ADDRESS, FOR WORK AREA. 02800020 COMENTRY DS XL1 FIRST BYTE CONTAINS ENTRY INFORMTN., C02820020 REST OF COMM. AREA IS SET BY IPDSNEXC 02840020 COMNWBUF EQU X'80' NORMAL ENTRY. NEW BUFFER. 02860020 COMFNTRY EQU X'A0' FINAL ENTRY 02880020 COMAFRC8 EQU X'C0' ENTRY AFTER RETURN CODE 8 02900020 COMARC12 EQU X'90' ENTRY AFTER RETURN CODE 12 02920020 COMWORKA DS XL3 WORK AREA ADDRESS IN BYTES 1-3. 02940020 COMERRAD DS F ADDRESS OF ERROR MESSAGE. 02960020 DS 2F AREA FOR PORTION OF GETMAIN PARAMLIST 02980020 * 03000020 * FORMAT OF OPTIONS WORD. 03020020 IPDSNOPT DSECT 03040020 OPTLEVEL DS XL1 LEVEL OF FORTRAN WANTED, E,G, OR H, 03060020 * FOR THIS BUFFER CHAIN 03080020 * X'00' LEVEL H 03100020 * X'01' LEVEL E 03120020 * X'02' LEVEL G 03140020 * X'03' LEVEL TSO 03160020 * X'04' LEVEL G1 03180020 OPTTABS DS XL1 INTERROGATED AT INITIAL CALL ONLY. 03200020 * BIT6=1 SAYS LOAD IPDAGH SYNTAX TABLE 03220020 * BIT7=1 IPDTEE 03240020 OPTLNLNG DS XL1 LENGTH OF LINES IN BUFFER CHAIN. 03260020 OPTBYTE3 DS XL1 BITS FOR OTHER INFORMATION. 03280020 EXCNLNUM EQU X'40' BIT 1=1 SPECIFIES NO LINE NUMBERS 03300020 * BIT 1=0 FOR LINE NUMBERED DATA SET 03320020 EXCBFSPN EQU X'10' BIT 3 = 1 RC12 ALLOWED TO BE GIVEN 03340020 * BIT 3 = 0 RC12 NOT ALLOWED 03360020 EXCVRLNG EQU X'08' BIT 4=1 SPECIFIES VARIABLE LENGTH 03380020 * RECORDS 03400020 * BIT 4=0 SPECIFIES FIXED LENGTH 03420020 EXCFRFRM EQU X'04' BIT 5=1 SPECIFIES FREE-FORM SOURCE 03440020 * BIT 5=0 SPECIFIES STANDARD-FORM 03460020 * 03480020 *OUTPUT..IPDSNCOM AREA IS SET OR DESTROYED AS DESCRIBED ABOVE. FIRST 03500020 * BYTE OF IT IS UNCHANGED EXCEPT DURING INITIAL CALL, WHEN IT IS 03520020 * RESTORED AFTER POSSIBLY BEING CHANGED DURING THE 03540020 * EXECUTION OF THE CONDITIONAL GETMAIN. WHEN IPDSNEXC RETURNS 03560020 * TO ITS CALLER AFTER OTHER THAN A FINAL CALL, REGISTER 15 03580020 * CONTAINS ONE OF THE FOLLOWING RETURN CODES... 03600020 * 0 - REQUESTS A NEW BUFFER CHAIN. 03620020 * 4 - REQUESTS A NEW BUFFER CHAIN AND INDICATES THERE IS A 03640020 * MESSAGE TO BE SENT. 03660020 * 8 - INDICATES THAT CHECKING OF THE CURRENT BUFFER CHAIN 03680020 * IS NOT COMPLETE AND THERE IS A MESSAGE TO BE SENT. 03700020 * 12 - REQUESTS A NEW BUFFER WHICH WILL BE PROCESSED AS AN 03720020 * EXTENSION OF THE PREVIOUS BUFFER. 03740020 * 16 - INDICATES THE CHECKER IS NOT OPERATIONAL BECAUSE A 03760020 * CONDITIONAL GETMAIN FAILED DURING THE INITIAL CALL. 03780020 * 20 - INDICATES BUFFER CHAIN NOT CHECKED BECAUSE THE 03800020 * SYNTAX TABLE NOW REQUESTED BY THE VALUE IN OPTLEVEL 03820020 * WAS NOT REQUESTED AT INITIAL CALL. 03840020 * 03860020 *EXTERNAL REFERENCES.. 03880020 * SUPERVISOR SERVICES USED ARE GETMAIN, FREEMAIN, LOAD, AND DE- 03900020 * LETE. SUBROUTINES CALLED ARE IPDSNCKR AND IPDERERR. THE 03920020 * MESSAGE TABLE, IPDERMSG, IS PASSED TO IPDERERR. THE SYNTAX 03940020 * DEFINITION TABLES, IPDAGH AND IPDTEE, ARE LOAD'ED AND 03960020 * PASSED TO IPDSNCKR. 03980020 * 04000020 *ERROR CONDITIONS.. 04020020 * INABILITY TO LOAD A SYNTAX TABLE CAUSES ABEND. CONDITIONAL 04040020 * GETMAIN FAILURE CAUSES RETURN CODE 16. SYNTAX DEFINITION 04060020 * TABLE NOT ALREADY LOAD'ED BUT REQUESTED IN OPTLEVEL CAUSES RE- 04080020 * TURN CODE 20. A NUMBER OF PROGRAM OR MACHINE ERRORS, SUCH AS 04100020 * NO CARDS IN A BUFFER CHAIN, ARE DETECTED. THESE RESULT IN THE 04120020 * MESSAGE 'SYSTEM OR SYNTAX CHECKER FAILURE' WITH RETURN CODE 04140020 * 4 OR 8. 04160020 * 04180020 *NOTES.. IPDSNEXC DOES NOT PROVIDE A SAVE AREA FOR THE CONDITIONAL 04200020 * GETMAIN. 04220020 * REFER TO 'IBM SYSTEM/360 OPERATING SYSTEM SUPERVISOR AND DATA 04240020 * MANAGEMENT MACRO INSTRUCTIONS,' FORM C28-6647, FOR DEFINITIONS 04260020 * OF THE SYSTEM MACROS. 04280020 * THE OPERATION OF CONTROL SECTION IPDSNEXC DEPENDS ON THE 04300020 * FOLLOWING PROPERTIES OF THE INTERNAL REPRESENTATION OF THE 04320020 * EXTERNAL CHARACTER SET--- 04340020 * 04360020 * CHARACTER CODE DEPENDENCY INSTR. SEQUENCE AFFECTED 04380020 * 04400020 * 1.DECIMAL NUMBERS MUST BE 1.EXCGES ROUTINE WHICH 04420020 * CODED SO THAT THEIR COLLATING CHECKS STATEMENT LABEL 04440020 * SEQUENCE REMAINS ASCENDING FIELD. 04460020 * FROM 0 TO 9 WITH NO OTHER 04480020 * CHARACTERS INTERSPERSED. 04500020 * 04520020 * 2.THE LOADING OF MODULES 2.EXCLODTB TABLE -- 04540020 * REQUIRES THAT THE REPRE- REASSEMBLE TO REDEFINE 04560020 * SENTATION OF THE MODULE INTERNAL REPRESENTATION 04580020 * NAME IN THE LIBRARY AND OF THE MODULE NAMES. 04600020 * IN THE LOAD SEQUENCE BE 04620020 * IDENTICAL. 04640020 EJECT 04660020 IPDSNEXC CSECT 04680020 *********************************************************************** 04700020 * 04720020 * LENGTH OF CSECT 04740020 * 04760020 EXCLENGT EQU 2496 MUST BE INTEGRAL MULT OF 8 04780021 * 04800020 * THIS EQU DEFINES THE LENGTH OF THIS CSECT. 04820020 * CSECT. IF THE CODING OF THE CSECT IS 04840020 * EXPANDED TO A NUMBER OF BYTES LARGER THAN 04860020 * THAT SPECIFIED BY THIS EQU , THE EQU 04880020 * MUST BE CHANGED TO SPECIFY A SIZE AT LEAST 04900020 * AS LARGE AS THE CODING. 04920020 * 04940020 *********************************************************************** 04960020 * REGISTER CONVENTIONS. R2 IS LINKAGE REGISTER. IT MUST 04980020 * BE SAVED IN SUBROUTINES. R3 - RD 05000020 * ARE BASES OR CONTAIN GLOBAL VALUES. THEY MUST BE 05020020 * SAVED, SET, OR UPDATED IN SUBROUTINES. RE - R1 ARE 05040020 * LOCAL WORK REGS WHICH MAY BE DESTROYED IN SUBROUTINES. 05060020 R0 EQU 0 05080020 R1 EQU 1 05100020 R2 EQU 2 LINKAGE REGISTER 05120020 R3 EQU 3 05140020 R4 EQU 4 05160020 R5 EQU 5 INDEX TO WKATINU TABLE 05180020 R6 EQU 6 LOC OF COLUMN 1 OF A CARD 05200020 R7 EQU 7 05220020 R8 EQU 8 05240020 R9 EQU 9 OPTION WORD DSECT REGISTER. 05260020 REGCOMMA EQU 10 COMMUNICATIONS AREA DSECT REG. 05280020 REGPARAM EQU 11 POINTER TO PARAMETERS PASSED. 05300020 RC EQU 12 INSTRUCTION BASE 05320020 RD EQU 13 BASE FOR WORK AREA (IPDSNWKA) 05340020 RE EQU 14 05360020 RF EQU 15 05380020 * CONDITION CODES 05400020 CC0 EQU 8 05420020 CC1 EQU 4 05440020 CC2 EQU 2 05460020 CC3 EQU 1 05480020 NC0 EQU 15-8 05500020 NC1 EQU 15-4 05520020 NC2 EQU 15-2 05540020 NC3 EQU 15-1 05560020 * RETURN CODES SENT BY EXECUTIVE 05580020 RC0 EQU 0 NO ERROR MSG. REQUEST NEW BUFFER. 05600020 RC4 EQU 4 ERROR MSG. REQUEST NEW BUFFER. 05620020 RC8 EQU 8 ERROR MSG. CKR TO CONTINUE CHECKING 05640020 * SAME BUFFER ON NEXT CALL. 05660020 RC12 EQU 12 NO ERROR MSG. REQUEST NEW BUFFER. 05680020 RC16 EQU 16 CONDITIONAL GETMAIN FAILURE. 05700020 RC20 EQU 20 TABLE REQUESTED NOT LOADED. 05720020 * ERROR CODE SYMBOLS FOR IPDERERR 05740020 ERSYSBUG EQU 0 SYSTEM OR MACHINE ERROR 05760020 ERINVST EQU 25 STATEMENT EXPECTED 05780020 ERMT1320 EQU 70 MORE THAN 1320 CHARACTERS 05800020 ERSTANO EQU 84 INVALID STATEMENT NO. 05820020 ERFSTCON EQU 100 CONTINUATION ENCOUNTERED BEFORE ANY C05840020 STATEMENT IN BUFFER 05860020 ERCOMNSG EQU 102 COMMENT CARD(S) INTERSPERSED C05880020 WITHIN CONTINUATION CARDS 05900020 ERMANYLN EQU 104 TOO MANY LINES IN STMNT 05920020 ERTMYDIG EQU 150 TOO MANY DIGITS IN STMT NUMBER (F-F) 05940020 ERSTNCIL EQU 152 STMT NO.NOT COMPLETE ON INITIAL LINE C05960020 (FREE-FORM) 05980020 ERMISCNT EQU 154 LAST LINE IS CONTINUED LINE 06000020 ERCHIVPS EQU 156 INVALID CHAR.PRECEDES STATEMENT (F-F) 06020020 * OTHER EQU'S 06040020 EXCZERO EQU C'0' 06060020 EXCNINE EQU C'9' 06080020 EXCAST EQU C'*' REA 06090020 EXCBLANK EQU C' ' 06100020 EXCOMMNT EQU C'C' 06120020 EXCQUOTE EQU C'"' 06140020 EXCFRCTN EQU C'-' 06160020 EXCDOLAR EQU C'$' 06180020 EXCLTRA EQU C'A' 06200020 EXCLTRZ EQU C'Z' 06220020 EXCFOLD EQU X'40' 06240020 EXCNEGT EQU X'80' 06260020 * 06280020 * SYNTAX CHECKER FAILURE CODES ISSUED BY EXECUTIVE. 01-0F. 06300020 * ISSUED IN CONJUNCTION WITH MSG 'SYSTEM OR SYNTAX CHECKER 06320020 * FAILURE'. IPDER ADDS 255 TO NUMBER (ONE OF BELOW) SET IN 06340020 * WKASFAIL BY EXECUTIVE, THEN ABOVE MSG IS ISSUED WITH SPECIAL 06360020 * NUMBER CODE GREATER THAN 255. 06380020 * 06400020 SYERBUF1 EQU X'01' NO RECORDS IN BUFFER CHAIN 06420020 SYERBUF2 EQU X'02' ST FORM-VAR LENGTH. MEANINGLESS COMB 06440020 SYNGREG1 EQU X'03' ZERO LENGTH VARBL-LNGTH RECORD F-F 06460020 SYERITF1 EQU X'04' ILLEGAL ENTRY AFTER RETURN CODE 8 06480020 SYERREG1 EQU X'05' MISHANDLING OF RELATIVE LINE NOS. 06500020 SYEROPT1 EQU X'06' ILLEGAL CHANGE OF OPTNS WRD BY SYSTEM 06520020 * 06540020 * 06560020 * 06580020 * 06600020 USING *,15 06620020 B IPDSNFEG BR TO BEGINNING OF PROGRAM 06640020 DC CL8'IPDSNEXC' 06660020 DROP 15 06680020 IPDSNFEG STM 14,12,12(RD) SAVE REGS IN CALLER SAVE AREA 06700020 LR RC,RF RC = BASE FOR INSTRUCTIONS 06720020 USING IPDSNEXC,RC 06740020 LR REGPARAM,1 REGPARAM, REG. FOR SYSTEM PARAMETERS. 06760020 USING IPDSNSNP,REGPARAM 06780020 L REGCOMMA,SNPRMCOM REGCOMMA, REG. FOR COMMUNICTN. AREA. 06800020 USING IPDSNCOM,REGCOMMA 06820020 L R9,SNPRMOPT R9 = REG FOR OPTIONS WORD 06840020 USING IPDSNOPT,R9 06860020 LR R6,RD SAVE RD IN CASE OF INITIAL ENTRY 06880020 L RD,COMENTRY RD= LOC OF WORK AREA IF NOT 06900020 LTR RD,RD INITIAL ENTRY 06920020 BM EXCNOTFS BR IF NOT AN INITIAL ENTRY 06940020 * 06960020 * INITIAL ENTRY. GET WORK AREA. 06980020 MVC COMERRAD(12),GETM MOVE GETMAIN LIST TO COMMUNICATIONS C07000020 AREA 07020020 IC RD,COMENTRY SAVE FIRST BYTE OF COMMUNICATION AREA 07040020 LA R1,COMERRAD R1= LOC OF GETMAIN LIST 07060020 * GET STORAGE & PUT LOC OF 07080020 * IT IN FRST WORD OF COM AREA 07100020 GETMAIN A=(REGCOMMA),MF=(E,(1)) 07120020 STC RD,COMENTRY RESTORE FRST BYTE OF COM AREA 07140020 LTR RF,RF WAS STORAGE GOTTEN 07160020 LR RD,R6 RESTORE SAVE AREA PTR IN CASE OF 07180020 * GETMAIN FAILURE 07200020 LA RF,RC16 BR TO RETURN WITH CODE 16 IF 07220020 BNZ EXCEXIT NO. 07240020 L RD,COMENTRY YES. RD=LOC OF WORK AREA 07260020 USING IPDSNWKA,RD 07280020 ST RD,8(R6) STORE FORWARD CHAIN IN CALLER'S AREA 07300020 ST R6,4(RD) STORE BACK CHN IN OUR SAVE AREA 07320020 MVC WKADNAME,=CL8'IPDSNWKA' 07340020 XC WKASERTB,WKASERTB INITIALIZE TRT TABLE TO ZEROES 07360020 MVI BLDLSWH,X'00' INITIALIZE THE SWITCH FOR ISSUE BLDL 07370021 * 07380020 * 07400020 * 07420020 * 07440020 * LOAD SYNTAX TABLES REQUESTED BY BITS IN OPTTABS 07460020 SR R6,R6 R6 IS INDEX TO EXCSYNXS TABLE 07480020 LA R5,EXCLODTB R5 IS LOC OF CORRESPONDING ENTRY IN C07500020 EXCLODTB TABLE. 07520020 EXCLODNG IC R2,8(R5) R2=EXCLODTB ENTRY CONTROL BYTE 07540020 SR R0,R0 R0=0 IN CASE THIS TABLE NOT NEEDED 07560020 EX R2,EXCLODTM DOES A 1 BIT IN OPTTABS REQUEST THIS C07580020 SYNTAX DEFINITION BE LOADED 07600020 BZ EXCLODST BR IF NO. 07620020 * YES. LOAD THE ENTRY POINT WHOSE NAME 07640020 LA R0,1 WE LIST ONE ENTRY 07641021 STH R0,FF 07642021 LA R0,58 ENTRY IS 14 BYTES LONG 07643021 STH R0,LL 07644021 MVC NAME(8),0(R5) MOVE IN NAME FIELD FOR BLDL 07645021 XC TTR(50),TTR 07646021 BLDL 0,BLDLLIST 07647021 LTR RF,RF CHECK FOR IPDTEE OR IPDAGH MISSING 07648021 BZ LOADTBL 07649021 MVI BLDLSWH,X'01' TABLE MISSING, SET SWITCH 07650021 B EXCFINAL FOR BLDL ON 07651021 LOADTBL LOAD DE=NAME 07661021 EXCLODST ST R0,EXCSYNXS(R6) STORE LOC OR ZERO IN EXCSYNXS ENTRY. 07680020 LA R5,LDELT(R5) R5= LOC OF NEXT EXCLODTB ENTRY 07700020 LA R6,4(R6) INCR EXCSYNXS INDEX 07720020 CH R6,=Y(NUMTBLS*4) ANY MORE ENTRIES... 07740020 BL EXCLODNG BR IF YES. 07760020 * 07780020 * NO. INITIALIZATION DONE. 07800020 L R1,SNPRMBFR 07820020 LTR R1,R1 IS THERE A BUFFER CHAIN 07840020 BZ EXCRCO BR IF NO TO REQUEST ONE WITH RC = 0. 07860020 B EXCNEB10 YES. GO TO PROCESS IT 07880020 EXCLODTM TM OPTTABS,0 THIS INSTR. IS 'EX'ECUTED 07900020 GETM GETMAIN EC,LV=WKARLENT,SP=1,MF=L 07920020 * 07940020 * 07960020 * 07980020 * 08000020 * TABLE OF SYNTAX DEFINITION ENTRY NAMES. THE BYTE FOLLOWING 08020020 * EACH NAME INDICATES WHICH BIT IN OPTTABS REQUESTS THE LOADING 08040020 * OF THIS DEFINITION. ENTRIES ARE IN SAME ORDER AS EXCSYNXS TABL 08060020 EXCLODTB DC C'IPDTEE ' DEFINITION FOR LEVEL E 08080020 DC X'01' 08100020 LDELT EQU *-EXCLODTB LENGTH OF ENTRIES IN THIS TABLE 08120020 DC C'IPDAGH ' DEF FOR LEVELS G, G1, H, AND TSO 08140020 DC X'02' 08160020 NUMTBLS EQU (*-EXCLODTB)/LDELT NO. OF TABLE ENTRIES 08180020 * TABLE OF DISPLACEMENTS IN EXCSYNXS TABLE NEEDED BY EACH LEVEL 08200020 * IN ORDER TO PICK UP ADDR OF ASSOCIATED SYNTAX DEFINITION. 08220020 * ONE ENTRY IN EXCADRDF FOR EACH LEVEL OF FORTRAN RECOGNIZED BY 08240020 * CHECKER. ENTRIES ARE IN ORDER BY OPTLEVEL CODE ASSOCIATED 08260020 * WITH EACH LEVEL. THE TABLE EXCSYNXS EXISTS IN THE WORKAREA 08280020 * AND CONTAINS ONE FULL WORD ENTRY FOR EACH SYNTAX DEFINITION 08300020 * TABLE. 08320020 * DISPLACEMENT IN EXCSYNXS TABLE FOR 08340020 * DEFINITION USED BY 08360020 EXCADRDF DC X'04' LEVEL H 08380020 DC X'00' E 08400020 DC X'04' G 08420020 DC X'04' TSO 08440020 DC X'04' G1 08460020 * 08480020 * 08500020 * 08520020 * 08540020 * 08560020 * FINAL ENTRY. DELETE TABLES & RELEASE WORK AREA. 08580020 EXCFINAL LA R6,NUMTBLS R6 = COUNT OF ENTRIES IN EXCLODTB 08600020 LA R5,EXCLODTB R5= LOC OF NAME OF ENTRY PNT OF C08620020 SYNTAX TABLE 08640020 EXCFIN5 DELETE EPLOC=(R5) DELETE IT 08660020 LA R5,LDELT(R5) INCR R5 TO NEXT EXCLODTB ENTRY 08680020 BCT R6,EXCFIN5 BR IF THERE IS ANOTHER ENTRY 08700020 * RELEASE WORK AREA. 08720020 SR R6,R6 08726021 IC R6,BLDLSWH 08732021 LA R1,0(RD) R1= LOC OF STORAGE TO RELEASE 08740020 L RD,4(RD) SAVE LOC OF CALLERS SAVE AREA. 08760020 FREEMAIN R,A=(1),SP=1,LV=WKARLENT 08780020 LTR R6,R6 08784021 BZ EXCEXIT RETURN 08788021 LA RF,RC20 TABLE MISSING SET RETURN CODE=20 08792021 B EXCEXIT 08796021 EJECT 08820020 * NOT INITIAL ENTRY 08840020 EXCNOTFS ST RD,8(R6) STORE FRWRD CHAIN IN CLLER SAVE AREA 08860020 ST R6,4(RD) STORE BACK CHAIN IN OURS. 08880020 LM R2,R8,28+EXCSVRGS RESTORE REGS 2-8 FROM LAST TIME 08900020 TM COMENTRY,COMFNTRY TEST FOR FINAL CALL 08920020 BO EXCFINAL BR IF FINAL CALL. 08940020 TM COMENTRY,COMAFRC8 HAS BUFFER BEEN COMPLETELY CHECKED 08960020 BCR CC3,R2 NO. BR TO CONTINUE C08980020 FROM WHERE LEFT OFF LAST TIME 09000020 * 09020020 * 09040020 * 09060020 * 09080020 * INTERMEDIATE ENTRY. NEW BUFFER. 09100020 L R1,SNPRMBFR IS THERE A BUFFER OR 09120020 EXCNEB5 LTR R1,R1 ARE THERE ANY RCDS IN WHOLE BUF CHN 09140020 BNZ EXCNEB10 BR IF THERE IS AN ADDR 09160020 TM COMENTRY,COMARC12 IS THIS AN ENTRY AFTER RC12 09180020 BNO EXCNEB6 BR IF NO 09200020 XC EXCCRBUF(4),EXCCRBUF SET EXCCRBUF = 0 09220020 TM OPTBYTE3,EXCFRFRM 09240020 BNO EXCGES ST.-FRM. BR TO STMNT LBL CHECK 09260020 BAL R2,EXCALMR OUTPUT MSG INDICATING STMNT IS NOT 09280020 DC Y(RC8*256+ERMISCNT) COMPLETE WITH RETURN CODE = 8 09300020 B EXCGES BR TO SYNTAX CHECK INCOMPLETE STMNT 09320020 EXCNEB6 MVI WKASFAIL,SYERBUF1 SET UP WKASFAIL WITH FAIL CODE 09340020 BAL R2,EXCALMS BR TO ISSUE MSG 09360020 DC Y(RC4*256) WITH RETURN CODE = 4 09380020 * YES. DO NEW BUFFER INITIALIZATION. 09400020 EXCNEB10 CLI 0(R1),0 ANY RECORDS IN THIS BUFFER 09420020 BNE EXCNEB12 BR IF YES 09440020 EXCNEB11 MVC EXCNXBUF,0(R1) NO. GET LOC OF NEXT BUFFER 09460020 OI 0(R1),EXCRLSBF SET BIT TO ALLOW BUFFER RELEASE 09480020 L R1,EXCNXBUF 09500020 B EXCNEB5 BR TO CHECK NEXT BUFFER IN CHAIN 09520020 * 09540020 * 09560020 EXCNEB12 TM 0(R1),X'80' IS HIGH ORDER BIT ON 09580020 BNO EXCNEB15 NO. CONTINUE PROCESSING 09600020 NI 0(R1),X'00' YES. SET BIT OFF 09620020 B EXCNEB11 GET LOC OF NEXT BUFFER 09640020 * 09660020 * 09680020 EXCNEB15 LA R0,4(R1) STORE LOC OF COL 1 OF 1ST RECORD AND 09700020 STM R0,R1,EXCNXCRD LOC OF BUFFER CONTAINING IT 09720020 SR RF,RF 09740020 TM COMENTRY,COMARC12 IS THIS AN ENTRY AFTER RC12 09760020 BNO EXCNEB17 BR IF NO 09780020 *********************************************************************** 09800020 * THE FOLLOWING SECTION OF CODE CHECKS THE INTEGRITY OF THE OPTIONS 09820020 * WORD. R3 SHOULD CONTAIN A BR ADDR IF FREE-FORM SOURCE OPTION WAS 09840020 * SPECIFIED AT INITIAL ENTRY. R3 SHOULD CONTAIN ZERO IF 09860020 * STANDARD-FORM WAS IN EFFECT. 09880020 *********************************************************************** 09900020 TM OPTBYTE3,EXCFRFRM 09920020 BNO EXCNEB16 BR IF STANDARD-FORM 09940020 LTR R3,R3 DOES R3 CONTAIN A BR ADDR 09960020 BNZ EXCNEB16 YES. CONTINUE PROCESSING. 09980020 MVI WKASFAIL,SYEROPT1 MOVE FAIL CODE INTO WKASFAIL 10000020 BAL R2,EXCALMS SEND 'SYSTEM OR SYNTAX CHECKER 10020020 DC Y(RC4*256) FAILURE' MSG WITH RETURN CODE = 4 10040020 EXCNEB16 EQU * 10060020 *********************************************************************** 10080020 STH RF,EXCNXBRL INITIALIZE RECORDS RELATIVE POSITION 10100020 * WITHIN BUFFER TO ZERO 10120020 B EXCNNB30 BR TO CONTINUE PROCESSING 10140020 EXCNEB17 ST RF,EXCNXBRL INITIALIZE RECORDS RELATIVE POSITION 10160020 * WITHIN BUFFER CHAIN AND 10180020 * WITHIN BUFFER TO ZERO 10200020 *********************************************************************** 10220020 * IF ST. FORM-VAR. LENGTH IN EFFECT, ISSUE MSG WITH RC4. 10240020 *********************************************************************** 10260020 TM OPTBYTE3,EXCFRFRM IS SOURCE STANDARD FORM 10280020 BO EXCNEB18 BR IF NO 10300020 TM OPTBYTE3,EXCVRLNG ARE VARIABLE LENGTH RECORDS USED 10320020 BNO EXCNEB18 BR IF NO 10340020 MVI WKASFAIL,SYERBUF2 SET UP WKASFAIL WITH FAIL CODE 10360020 BAL R2,EXCALMS BR TO ISSUE 10380020 DC Y(RC4*256) MESSAGE WITH RETURN CODE = 4 10400020 * IS TABLE REQUESTED IN OPTIONS WORD PRESENT 10420020 EXCNEB18 IC RF,OPTLEVEL RF INDICATES WHICH LANGUAGE 10440020 STC RF,WKALEVEL DEFINITION TO USE, SAVE LEVEL 10460020 IC RF,EXCADRDF(RF) DISPLACEMENT TO EXCSYNXS TBL ENTRY 10480020 L RF,EXCSYNXS(RF) DEFINITION ADDR OR ZERO 10500020 LTR R0,RF IS TABLE PRESENT 10520020 LA RF,RC20 10540020 BZ &EXCALMT RETURN WITH CODE 20 IF NOT 10560020 ST R0,WKADEEF YES. SAVE LOC OF TABLE IN PARAM 10580020 * LIST FOR IPDSNCKR 10600020 BAL R2,EXCNESIT DO NEW STATEMENT INITIALIZATION 10620020 EJECT 10640020 * SKIP OVER COMMENT & CONTINUATION RECORDS TIL FIRST RECORD OF 10660020 * A STATEMENT IS FOUND. 10680020 EXCNEB30 BAL R2,EXCGETRC GET A RECORD 10700020 BZ EXCRCO BR IF NO MORE TO RETURN WITH CODE = 0 10720020 TM OPTBYTE3,EXCFRFRM 10740020 BO EXCNEB35 BR IF FREE-FORM SOURCE 10760020 * 10780020 * STANDARD-FORM SOURCE. CHECK FOR COMMENT AND 10800020 * FOR CONTINUATION LINES. 10820020 CLI 0(R6),EXCOMMNT IS THIS A COMMENT LINE 10840020 BE EXCNEB30 BR IF YES TO GET NEXT RECORD 10860020 * IS THIS A CONTINUATION LINE 10880020 CLI 5(R6),EXCBLANK 10900020 BE EXCNNB IF COL. 6 IS BLANK, NO CONTINUATION 10920020 CLI 5(R6),EXCZERO 10940020 BE EXCNNB IF COL. 6 IS ZERO, NO CONTINUATION 10960020 * YES. THIS IS A CONTINUATION RECORD 10980020 TS EXCFSCON IS IT THE FIRST 11000020 BC CC1,EXCNEB30 BR IF NO. 11020020 NC EXCNXBUF,EXCNXBUF YES. IS THERE ANOTHER RECORD 11040020 LA R2,=Y(RC4*256+ERFSTCON) IF NOT, SEND MSG WITH CODE=4 11060020 BC CC0,EXCALMR BR TO ISSUE MSG WITH RC = 4 11080020 BAL R2,EXCALMR IF YES, BR TO OUTPUT 11100020 DC Y(RC8*256+ERFSTCON) MSG WITH RC = 8 11120020 B EXCNEB30 AND GET THE NEXT RECORD. 11140020 * 11160020 * FREE-FORM SOURCE. CHECK FOR COMMENT LINES. CONTINUATION 11180020 * LINES CANNOT BE IDENTIFIED. 11200020 EXCNEB35 EQU * 11220020 LR R1,R6 R1 = LOC OF 1ST COL OF TEXT 11240020 LR R4,R6 R1 = LOC OF 1ST COL OF TEXT 11260020 AR R4,R8 R4 = ADDR OF LAST BYTE OF LINE 11280020 EXCNEB36 CLI 0(R1),EXCBLANK IS CHAR A BLANK 11300020 BNE EXCNEB38 BR IF NO 11320020 EXCNEB37 CR R1,R4 IS THIS THE LAST BYTE OF TEXT 11340020 BE EXCNEB39 BR IF YES 11360020 LA R1,1(R1) POINT TO NEXT COL 11380020 B EXCNEB36 BR TO SEE IF CHAR A BLANK 11400020 EXCNEB38 CLI 0(R1),EXCQUOTE IS THIS A COMMENT LINE 11420020 BE EXCNEB30 BR IF YES TO GET NEXT RECORD 11440020 CLI 0(R1),EXCAST ALTERNATE COMMENT REA 11446020 BE EXCNEB30 YES - GET NEXT RECORD REA 11452020 EXCNEB39 EQU * 11460020 MVI WKACNCOL,C' ' INITIALIZE CONTINUATION SWITCH 11480020 * 11500020 LA R3,EXCNNB06 INITIALIZE R3 WITH BR ADDR 11520020 * FOR LOOP CONTROL. 11540020 * 11560020 * 11580020 * 11600020 * 11620020 * FIRST RECORD OF A STATEMENT HAS BEEN EXCGETRC'ED. 11640020 EXCNNB BAL R2,EXCNESIT DO STATEMENT INITIALIZATION 11660020 MVC EXCFSCRD(INF),EXCCRCRD SAVE LOC OF FIRST RECORD 11680020 LA R7,WKACHRST INITIALIZE R7 SO THAT IT WILL POINT 11700020 * TO LAST CHAR MOVED + 1 11720020 TM OPTBYTE3,EXCFRFRM IS THIS FREE-FORM SOURCE 11740020 BO EXCNNB06 BR IF FREE-FORM 11760020 * NO. THIS IS STANDARD-FORM SOURCE. 11780020 MVC WKACHRST(5),0(R6) PUT LABEL FIELD IN CHAR STRING 11800020 LA R7,5(0,R7) END OF STRING POINTS TO LAST 11820020 * POSITION OF LABEL FIELD + 1 11840020 B EXCNNB10 BR TO PROCESS STANDARD-FORM SOURCE 11860020 * COLLECT LINES OF STATEMENT. 11880020 * STANDARD FORM. SAVE CONTENTS OF COLUMN 6. 11900020 * CHECK FOR EMBEDDED COMMENTS. 11920020 * FREE-FORM. CHECK FOR CONTINUATION INDICATOR. 11940020 * AFTER STATEMENT IS COMPLETE, GET LINE OF NEXT 11960020 * STATEMENT. 11980020 EXCNNB06 LR R4,R6 R6 = LOC OF 1ST COL. OF TEXT 12000020 AR R4,R8 R4 = ADDR. OF LAST BYTE OF LINE 12020020 * 12040020 * FREE-FORM SOURCE. CHECK FOR CONTINUATION INDICATOR. 12060020 * LAST HYPHEN OF LINE IS CONTINUATION SYMBOL. 12080020 EXCNNB07 CLI 0(R4),EXCBLANK IS CHAR A BLANK 12100020 BNE EXCNNB08 NO. BR IF FOUND NONBLANK 12120020 SH R8,EXCH1 ADJUST LENGTH 12140020 CR R4,R6 YES. IS IT IN COL 1 12160020 BE EXCNNB08 BR IF YES 12180020 BCT R4,EXCNNB07 GO SEE IF PRECEDDING CHAR A BLANK 12200020 EXCNNB08 EQU * 12220020 CLI 0(R4),EXCFRCTN IS CONTINUATION SYMBOL PRESENT 12240020 BNE EXCNNB15 NO. BR TO PREPARE FOR CHECKER CALL 12260020 MVI WKACNCOL,EXCFRCTN SET CONTINUATION SWITCH 12280020 SH R8,EXCH1 ADJUST LENGTH 12300020 SH R4,EXCH1 ADJUST LOC OF LAST BYTE OF TEXT 12320020 B EXCNNB20 BR TO UPDATE WKATINU TBL 12340020 * 12360020 * STANDARD-FORM SOURCE. SAVE CONTENTS OF COLUMN 6 FOR LATER 12380020 * USE BY CHECKER. 12400020 EXCNNB10 MVC WKACNCOL(1),5(R6) SAVE CONTENTS OF CONTINATION COL. 12420020 * FOR USE BY CHECKER, $300. 12440020 LA R6,6(0,R6) R6 = PNTR TO COL. 7 OF FORTRAN 12460020 * SOURCE LINE 12480020 SH R8,EXCH6 R8 = LENGTH-1 OF LINE (WITHOUT 12500020 * LABEL FIELD OR CONTINUATION 12520020 * COLUMN) 12540020 B EXCNNB20 BR TO UPDATE WKATINU TBL 12560020 * FREE-FORM SOURCE. LAST LINE OF STATEMENT REACHED. MUST 12580020 * READ IN ONE MORE CARD IN PREPARATION FOR NEXT CALL 12600020 EXCNNB15 LA R3,EXCGES BR REG. CONTAINS EXIT ADDR 12620020 * 12640020 *********UPDATE WKATINU TBL******************************************** 12660020 * STORE DISPLACEMENT. STORE DATA SET OR RELATIVE LINE NUMBER. 12680020 * ISSUE ERROR MESSAGES FOR LINE TOO LONG OR TOO MANY LINES 12700020 * IN STATEMENT. 12720020 EXCNNB20 CH R5,EXCH200 IS THIS ENTRY PAST END OF TBL 12740020 BL EXCNNB22 NO. CONTINUE CHECKING 12760020 TS EXCEXSLN WERE THERE EXTRA STMNT LINES BEFORE 12780020 BC CC1,EXCNNB30 YES. FLUSH LINE. GET NEXT RECORD. 12800020 BAL R2,EXCALMR SEND TOO MANY STMNT LINES MSG 12820020 DC Y(RC8*256+ERMANYLN) WITH RETURN CODE = 8 12840020 B EXCNNB30 GET THE NEXT RECORD 12860020 EXCNNB22 LTR R8,R8 IS THIS A ZERO LENGTH LINE 12880020 BM EXCNNB24 YES. UPDATE WKATINU TABLE 12900020 LR R1,R8 R1 = LENGTH - 1 12920020 AH R1,WKATINU(R5) R1 = DISPL-1 OF LAST CHAR OF 12940020 * LINE FROM BEGNG OF CHAR STRING 12960020 CH R1,EXCH1325 WILL IT GO PAST END OF CHAR STRING 12980020 BL EXCNNB23 NO. CONTINUE PROCESSING 13000020 TS EXCEXSLN WERE THERE EXTRA STMNT LINES BEFORE 13020020 BC CC1,EXCNNB30 YES. FLUSH LINE. GET NEXT RECORD 13040020 SH R1,EXCH1325 SET UP LENGTH-1 FOR 13060020 BCTR R1,0 PARTIAL MOVE 13080020 SR R8,R1 R8 = ENOUGH CHARS TO FILL UP 13100020 * CHAR STRING - 1 13120020 BAL R2,EXCALMF SEND LINE TOO LONG MSG 13140020 DC Y(RC8*256+ERMT1320) WITH RETURN CODE = 8 13160020 B EXCNNB30 GET THE NEXT RECORD 13180020 EXCNNB23 EX R8,EXCEXMOV EXECUTE MOVE CHARACTER STRING REA 13200020 EXCNNB24 LNR R4,RC R4 WILL REMAIN NEGATIVE IF DATA SET 13220020 * LINE NOS. ARE USED REA 13240020 LA R8,1(0,R8) R8=LENGTH REA 13260020 LA R7,0(R7,R8) UPDATE PNTR TO CHAR STRING 13280020 TM OPTBYTE3,EXCNLNUM ARE THERE LINE NUMBERS 13300020 BNO EXCNNB25 BR IF YES 13320020 LH R4,EXCCRREL R4 = RELATIVE LINE NUMBER 13340020 B EXCNNB27 UPDATE WKATINU TABLE 13360020 EXCEXMOV MVC 0(0,R7),0(R6) 13380020 EXCNNB25 TM OPTBYTE3,EXCFRFRM IS SOURCE FREE-FORM 13400020 BO EXCNNB26 YES. 13420020 * SOURCE IS STANDARD FORM. 13440020 SH R6,EXCH6 R6 = PNTR TO COL. 1 OF FORTRAN TEXT 13460020 EXCNNB26 BAL RF,EXCLNRTN GET DATA SET LINE NUMBER 13480020 EXCNNB27 AH R8,WKATINU(R5) STORE DISPL FROM BEGNG OF CHAR STRING 13500020 STH R8,WKATINU(R5) IN WKATINU TBL 13520020 LA RF,WKATINU(R5) RF = ADDR OF DISPL IN WKATINU TBL 13540020 LH R0,WKATINU(R5) R0 = DISPL 13560020 STH R0,10(RF) PUT CURNT DISPL INTO NEXT DISPL SLOT 13580020 LA R5,2(R5) R5 POINTS TO LINE NO. SLOT IN 13600020 * WKATINU TBL 13620020 LTR R4,R4 IS THIS A DATA SET LINE NUMBER 13640020 BM EXCDSLN BR IF YES 13660020 STH R4,WKATINU(R5) NO. THEN PUT RELATIVE LINE 13680020 * NUMBER IN TBL 13700020 B EXCNNB29 BR TO UPDATE TABLE INDEX 13720020 EXCDSLN LA RF,WKATINU(R5) RF=ADDR OF WKATINU TABLE 13740020 * PLUS DISPLACEMENT 13760020 MVC 0(8,RF),WKAERNUM MOVE DATA SET LINE NO. TO 13780020 * WKATINU TBL 13800020 EXCNNB29 LA R5,8(R5) UPDATE TBL INDEX TO NEXT ENTRY 13820020 * 13840020 * GET NEXT RECORD 13860020 * 13880020 EXCNNB30 BAL R2,EXCGETRC GET NEXT RECORD. 13900020 BZ EXCNNB60 BR IF NO MORE RECORDS IN CHAIN 13920020 TM OPTBYTE3,EXCFRFRM IS SOURCE FREE-FORM 13940020 BCR CC3,R3 YES. USE BRANCH REGISTER ADDRESS 13960020 * 13980020 * STANDARD FORM. CHECK FOR EMBEDDED COMMENT LINES. 14000020 * 14020020 CLI 0(R6),EXCOMMNT IS THIS A COMMENT LINE 14040020 BNE EXCNNB40 NO. BR TO CHK FOR CONTINUATION 14060020 TS EXCFSCOM YES. FIRST SINCE THE BEGINNING OF THIS 14080020 BC CC1,EXCNNB30 STMNT... BR IF NO. 14100020 MVC EXCSVCRD(INF),EXCCRCRD YES, SAVE ITS LOC IN CASE OF ERR 14120020 BAL RF,EXCLNRTN GET DATA SET LINE NUMBER 14140020 MVC EXCSVLNN,WKAERNUM SAVE DATA SET LINE NUMBER 14160020 B EXCNNB30 GET NEXT RECORD 14180020 EXCNNB40 CLI 5(R6),EXCBLANK BR TO STMNT LABEL ROUTINE 14200020 BE EXCGES IF NOT CONTINUATION LINE. 14220020 CLI 5(R6),EXCZERO ZERO OR BLANK IN COL. 6 14240020 BE EXCGES INDICATES NO CONTINUATION 14260020 * GOT ANOTHER CONTINUATION LINE. HAS A COMMENT LINE BEEN 14280020 CLC EXCFSCOM,EXCOMSG ENCOUNTERED AND NO MESSAGE SENT. 14300020 BE EXCNNB10 BR IF NOT THE CASE. 14320020 MVI EXCOMSG,255 YES. SET COMMENT MSG SENT SWTCH ON 14340020 BAL R2,EXCALMP SEND MSG RE COMMENT LINE INTERSPERSED 14360020 DC Y(RC8*256+ERCOMNSG) AMONG CONTINUATIONS WITH RC = 8 14380020 B EXCNNB10 CONTINUE PROCESSING 14400020 EXCNNB60 TM OPTBYTE3,EXCFRFRM 14420020 BO EXCNNB62 BR IF FREE-FORM 14440020 TM OPTBYTE3,EXCBFSPN IS RETURN CODE 12 ALLOWED 14460020 BNO EXCGES BR IF NO 14480020 SR R3,R3 IF ST-FORM, R3 SET TO ZERO. AID IN 14500020 * CHECKING INTEGRITY OF OPTNS WRD 14520020 EXCNNB61 LA RF,RC12 R15 CONTAINS RC12 14540020 B EXCALMT BR TO ISSUE RETURN CODE 12 14560020 EXCNNB62 C R3,=A(EXCGES) IF FR-FRM STMNT COMPLETE,R3=A(EXCGES) 14580020 BCR CC0,R3 BR IF STMNT COMPLETE 14600020 TM OPTBYTE3,EXCBFSPN IS RETURN CODE 12 ALLOWED 14620020 BO EXCNNB61 BR IF YES 14640020 BAL R2,EXCALMR OUTPUT MSG INDICATING STMNT IS NOT 14660020 DC Y(RC8*256+ERMISCNT) COMPLETE WITH RETURN CODE = 8 14680020 B EXCGES BR TO SYNTAX CHECK INCOMPLETE STMNT 14700020 * 14720020 * ALL LINES OF STATEMENT HAVE BEEN GATHERED. WKATINU TABLE 14740020 * IS COMPLETE. CHECK FOR ERRORS IN STMNT LABEL. 14760020 * 14780020 EXCGES MVC EXCSVCRD(INF),EXCCRCRD SAVE LOC OF FRST RECORD OF NEXT 14800020 * STATEMENT 14820020 LA RF,WKATINU(R5) RF=ADDR OF WKATINU TABLE 14840020 * PLUS DISPLACEMENT 14860020 OI 0(RF),X'80' STORE NEGATIVE VALUE AT END OF 14880020 * WKATINU TBL 14900020 * INITIALIZE FOR STMNT LABEL CHECK 14920020 LA R1,WKACHRST R1 CONTAINS BEGNG ADDR OF CHAR STRING 14940020 BCTR R7,0 STORE ADDR OF LAST CHAR IN 14960020 ST R7,WKAENDST CHAR STRING IN WKAENDST 14980020 LA RE,1 INCREMENT VALUE FOR LOOP CONTROL 15000020 SR R6,R6 R6 = COUNT OF NO. OF DIGITS IN LBL 15020020 TM OPTBYTE3,EXCFRFRM 15040020 BO EXCGES02 BR IF FREE-FORM TO COMPLETE INITLZTN 15060020 LA R0,WKACHRST+5 ADDR TO BEGIN PROCESSING WITH 15080020 * (BEGNG OF CHAR STRING) 15100020 ST R0,WKABEGST INITIALIZE WKABEGST TO THE BEGNG 15120020 * OF THE CHAR STRING 15140020 LA RF,WKACHRST+4 ST. FORM. RF=COMPARAND FOR LOOP CNTRL 15160020 * RF = ADDR OF COL. 5 OF INITIAL LINE 15180020 B EXCGES05 BR TO CHK LBL 15200020 * FOR FREE-FORM ONLY 15220020 EXCGES02 CR R7,R1 IS THIS A ZERO LENGTH STMNT 15240020 BL EXCGES66 YES. PUT OUT MSG. 15260020 L RF,WKAENDST RF = COMPARAND FOR LOOP CONTROL 15280020 * = ADDR OF END OF CHAR STRING 15300020 * 15320020 * STATEMENT LABEL CHECK 15340020 * 15360020 EXCGES05 CLI 0(R1),EXCBLANK IS CHARACTER SCANNED A BLANK 15380020 BE EXCGES20 YES. BR TO CONTINUE 15400020 **********************CHARACTER DEPENDENT CODE FOLLOWS***************** 15420020 CLI 0(R1),EXCZERO IS CHARACTER A ZERO 15440020 BE EXCGES18 YES. BR TO SET SWITCH. 15460020 BH EXCGES10 NO. BR IF HIGH TO CHK FOR DIGIT 15480020 **********************END OF CHARACTER DEPENDENT CODE****************** 15500020 * 15520020 TM OPTBYTE3,EXCFRFRM IF STANDARD-FORM, STMNT LABEL ERROR 15540020 BNO EXCGES22 HAS BEEN FOUND. BR TO ISSUE ERR MSG 15560020 * 15580020 CLI 0(R1),EXCDOLAR FREE-FORM. CHK FOR $ AS ALPHABETIC 15600020 BE EXCGES08 BR IF $ FOUND 15620020 **********************CHARACTER DEPENDENT CODE FOLLOWS***************** 15640020 MVC EXCFCHAR,0(R1) FOLD ANY LOWER CASE ALPHABETIC 15660020 OI EXCFCHAR,EXCFOLD TO UPPER CASE 15680020 CLI EXCFCHAR,EXCLTRA IF CHARACTER IS BELOW A IN COLLATING 15700020 BL EXCGES15 SEQUENCE, BRANCH. 15720020 CLI EXCFCHAR,EXCLTRZ IF CHAR IS ABOVE Z IN COLLATING 15740020 BH EXCGES15 SEQUENCE, BR. 15760020 **********************END OF CHARACTER DEPENDENT CODE****************** 15780020 * 15800020 * FIRST CHAR OF STMNT PORTION (FREE-FORM) HAS BEEN FOUND 15820020 EXCGES08 ST R1,WKABEGST STORE START ADDR NEEDED BY CHECKER 15840020 B EXCGES25 BR TO CHK FOR ANY ERRORS DETECTED 15860020 * IN STMNT LBL 15880020 * CHECK FOR DIGIT OF STMNT LABEL 15900020 **********************CHARACTER DEPENDENT CODE FOLLOWS***************** 15920020 EXCGES10 CLI 0(R1),EXCNINE CHK IF CHAR IS GT 9 IN COLLATING 15940020 BH EXCGES15 SEQUENCE. BR IF YES. 15960020 **********************END OF CHARACTER DEPENDENT CODE****************** 15980020 OI EXCSLERR,EXCDGLBL SET BIT INDICATING LBL CONTAINS DIGIT 16000020 TM OPTBYTE3,EXCFRFRM 16020020 BNO EXCGES20 BR IF STANDARD-FORM TO CONT SCAN 16040020 * ON INITIAL LINE 16060020 EXCGES12 TM EXCSLERR,EXCSLER2+EXCEXTCH TEST INVAL STMNT AND EXTRAN. 16080020 * CHARS SWITCHS 16100020 BC CC0+CC3,EXCGES19 BR IF BOTH ZERO OR BOTH ONE 16120020 OI EXCSLERR,EXCSLER2 SET INVAL STMNT SW BECAUSE EXTRANEOUS 16140020 B EXCGES19 SWITCH WAS ALREADY SET 16160020 * 16180020 * EXTRANEOUS CHARACTER FOUND 16200020 EXCGES15 TM EXCSLERR,EXCEXTCH TEST IF SW HAS ALREADY BEEN SET 16220020 BO EXCGES20 BR IF YES TO CONTINUE SCAN 16240020 ST R1,WKAERRSC STORE POINTER TO CHARACTER IN ERROR 16260020 OI EXCSLERR,EXCEXTCH INDICATE EXTRANEOUS CHAR FOUND 16280020 B EXCGES20 BR TO CONTINUE SCAN 16300020 * 16320020 * ZERO FOUND IN STMNT LABEL 16340020 EXCGES18 TM EXCSLERR,EXCSLZRO HAS ZERO ALREADY BEEN FOUND 16360020 BO EXCGES19 YES. BR. 16380020 ST R1,WKATERSC ST SOURCE POINTER IN CASE 0 STMNT LBL 16400020 OI EXCSLERR,EXCSLZRO SET ZERO FOUND SWITCH 16420020 EXCGES19 LA R6,1(R6) INCR DIGIT CNT 16440020 ST R1,EXCSVLBL SAVE LOC OF LAST LABEL DIGIT 16460020 EXCGES20 BXLE R1,RE,EXCGES05 UPDATE SOURCE PT. BR TO CONT SCAN 16480020 * 16500020 *********IF STANDARD FORM, END OF LABEL FIELD REACHED.***************** 16520020 *********FREE-FORM. END OF CHAR STR REACHED BUT NO STMNT FOUND. 16540020 OI EXCSLERR,EXCSLER1 SET SW FOR STMNT FIELD MISSING 16560020 B EXCGES25 BR TO CHECK FOR DETECTED ERRORS 16580020 * 16600020 * NON-DIGIT FOUND IN STMNT LABEL OF STANDARD-FORM SOURCE 16620020 * OR ZERO LABEL FOUND IN STANDARD-FORM SOURCE 16640020 EXCGES22 LA R1,WKACHRST R1 = BEGNG ADDR OF CHAR STRING 16660020 ST R1,WKAERRSC WKAERRSC = BEGNG ADDR OF CHAR STRING 16680020 BAL R2,EXCALMYA BR TO ISSUE MSG 16700020 DC Y(RC8*256+ERSTANO) WITH RETURN CODE = 8 16720020 B EXCGES29 BR TO TURN ON SW 16740020 * 16760020 * ISSUE MSGS RELATED TO STATEMENT LABEL ERRORS FOUND. 16780020 * DEPENDS UPON SETTING OF EXCSLERR. 16800020 * 16820020 EXCGES25 TM EXCSLERR,EXCDGLBL HAS A DIGIT 1-9 BEEN FOUND 16840020 BO EXCGES30 YES. STMNT LBL PRESENT. BR. 16860020 TM EXCSLERR,EXCSLZRO HAS A ZERO BEEN FOUND. 16880020 BNO EXCGES60 NO. NO STMNT LBL FOUND. BR. 16900020 TM OPTBYTE3,EXCFRFRM IF STANDARD-FORM 16920020 BNO EXCGES22 BR TO ISSUE MSG 16940020 MVC WKAERRSC,WKATERSC MOVE ADDR OF ERR CHARS AND TEXT 16960020 EXCGES28 BAL R2,EXCALMQ BR TO OUTPUT MSG 'INVALID ST.NO.' 16980020 DC Y(RC8*256+ERSTANO) WITH RETURN CODE = 8 17000020 EXCGES29 OI EXCSLERR,EXCLBMSG TURN ON SW INDICATING MSG ALREADY 17020020 * SENT FOR ZERO AS INVAL STMNT LBL 17040020 EXCGES30 MVI WKASNOSW,1 SET STMNT LBL SWITCH FOR CHECKER 17060020 TM OPTBYTE3,EXCFRFRM IF STANDARD-FORM, 17080020 BNO EXCLCR BR TO CALL CHECKER 17100020 EXCGES40 TM EXCSLERR,EXCSLER2 HAS AN INVAL STMNT NO. BEEN FOUND DUE 17120020 BNO EXCGES50 TO EXTRANEOUS CHARS. BR IF NO. 17140020 TM EXCSLERR,EXCLBMSG IF MSG FOR INVAL STMNT LBL (ZERO) HAS 17160020 BO EXCGES50 BEEN SENT, DON'T SEND AGAIN. BR. 17180020 BAL R2,EXCALMQ OUTPUT MSG WITH CHARS IN ERROR 17200020 DC Y(RC8*256+ERSTANO) WITH RETURN CODE = 8 17220020 EXCGES50 CH R6,EXCH5 HOW MANY DIGITS WERE FOUND IN LABEL 17240020 BNH EXCGES55 BR IF FEWER THAN SIX 17260020 BAL R2,EXCALMF ISSUE ERR MSG WITH NO SOURCE CHARS 17280020 DC Y(RC8*256+ERTMYDIG) IN ERROR WITH RETURN CODE = 8 17300020 EXCGES55 LA R0,WKACHRST R0 = ADDR OF CHAR STRING 17320020 AH R0,WKATINU PLUS 1ST DISPL 17340020 * = ADDR OF 1ST CHAR ON 2ND LINE 17360020 C R0,EXCSVLBL WAS STMNT LBL CONTINUED PAST 1ST LINE 17380020 BH EXCGES60 BR IF NO 17400020 BAL R2,EXCALMF OUTPUT ERR MSG WITH NO SOURCE CHARS. 17420020 DC Y(RC8*256+ERSTNCIL) WITH RETURN CODE = 8 17440020 EXCGES60 TM OPTBYTE3,EXCFRFRM REMAINING ERRORS RELATED TO FREE-FORM 17460020 BNO EXCLCR BR TO CALL CHECKER IF ST. FORM 17480020 TM EXCSLERR,EXCSLER2+EXCLBMSG IF EXTRAN CHARS OCCURRED IN 17500020 BC CC1+CC3,EXCGES61 LBL OR MSG ALREADY SENT, BR. 17520020 TM EXCSLERR,EXCEXTCH HAVE EXTRANEOUS CHARS BEEN FOUND 17540020 BNO EXCGES61 NO. DO NOT ISSUE MSG. BR. 17560020 BAL R2,EXCALMQ ISSUE ERR MSG 'EXTRANEOUS CHARS 17580020 DC Y(RC8*256+ERCHIVPS) PRECEDE STATEMENT' WITH RC = 8 17600020 EXCGES61 TM EXCSLERR,EXCSLER1 WAS STMNT FIELD MISSING 17620020 BO EXCGES66 YES. GO TO ISSUE MSG 17640020 TM EXCEXSLN,X'80' WAS THERE A MSG SENT ALREADY 17660020 BO EXCLCR BR IF YES TO CALL CHECKER 17680020 CH R6,EXCH5 HOW MANY DIGITS WERE FOUND IN THE LBL 17700020 BNL EXCLCR IF 5 OR GREATER, AMOUNT OF CHARACTERS 17720020 * IN STRING ALREADY CHECKED 17740020 LA R0,5 R0 = MAXIMUM NO. OF DIGITS ALLOWED IN 17760020 SR R0,R6 LABEL - ACTUAL NO. OF DIGITS IN LABEL 17780020 AH R6,EXCH1320 R6 = 17800020 LA R0,WKACHRST (WKACHRST-1) + 17820020 AR R6,R0 1320 + 17840020 BCTR R6,0 NO. OF DIGITS IN LBL 17860020 CR R7,R6 IF WKAENDST IS LESS THAN OR EQUAL 17880020 * TO 1320 + NO. OF DIGITS IN LABEL + 17900020 BNH EXCLCR (WKACHRST-1), THEN CALL CHECKER 17920020 * 17940020 BAL R2,EXCALMF SEND LINE TOO LONG MSG 17960020 DC Y(RC8*256+ERMT1320) WITH RETURN CODE = 8 17980020 OI EXCEXSLN,X'80' SET SW TO INDICATE MSG SENT 18000020 EXCGES65 B EXCLCR BR TO CALL CHECKER 18020020 EXCGES66 EQU * 18040020 MVI WKAERRCD,ERINVST MOVE ERR CODE INTO WKAERRCD 18060020 XC WKAERRSC,WKAERRSC INDICATE NO CHAR STRING IN MSG 18080020 B EXCLCR10 BR TO SEE IF THERE IS ANOTHER STMNT 18100020 * 18120020 * FRST CARD OF NEXT STATEMENT HAS BEEN FOUND. CALL CHECKER 18140020 EXCLCR MVI WKASFAIL,0 INITIALIZE RESULT BYTE = OK 18160020 L RF,=V(IPDSNCKR) RF= SYNTAX-CHECKER-PROPER ENTRY POINT 18180020 ST R9,WKAOPTPT SET UP LOC OF WORK AREA AND OF 18200020 ST RD,WKAWADDR OPTIONS WORD IN IPDSNCKR PARAM LIST 18220020 LA R1,WKACKPRM R1= LOC OF PARAM LIST 18240020 * 18260020 BALR RE,RF CALL IPDSNCKER 18280020 CLI WKASFAIL,0 WAS SYSBUG DETECTED 18300020 BNE EXCLCR8 BR IF YES. 18320020 TM WKACERSW,EXCNCKER NO. WAS SNYTAX ERROR IN STMNT 18340020 BO EXCLCR5 DETECTED... BR IF YES. 18360020 EXCLCR4 NC EXCSVBUF,EXCSVBUF NO. IS THERE ANOTHER STMNT IN CHAIN 18380020 BC NC0,EXCLCR20 BR IF YES TO GET IT. 18400020 EXCRCO SR RF,RF RETURN TO INTERFACE WITH CODE=0 TO 18420020 B EXCALMT GET ANOTHER BUFFER CHAIN. 18440020 * 18460020 * 18480020 * 18500020 * SYNTAX ERROR DETECTED. 18520020 EXCLCR5 TM WKAERRCD,1 IS THIS A TERMINAL MSG FOR STMNT 18540020 BO EXCLCR10 BR IF YES. 18560020 BAL R2,EXCALMY NO. WRITE MESSAGE 18580020 DC Y(RC8*256) WITH RETURN CODE 8 18600020 B EXCLCR RECALL IPDSNCKR TO CHECK REMAINDER 18620020 * 18640020 * 18660020 * 18680020 * TERMINATING ERROR FOR THIS STATEMENT DETECTED 18700020 EXCLCR8 MVI WKAERRCD,ERSYSBUG IF SYSBUG, SET ERROR CODE. 18720020 EX 0,EXCALMS2 SET WKAERRSC TO INDICATE NO ERROR C18740020 STRING AND USE LINE NO OF FRST CARD C18760020 IN STATEMENT. 18780020 EXCLCR10 EX 0,EXCLCR4 IS THERE A NEXT STMNT IN CHAIN 18800020 LA R2,=Y(RC4*256) IF NO SEND MSG WITH RETURN CODE 4 18820020 BC CC0,EXCALMY TO GET A NEW BUFFER. 18840020 BAL R2,EXCALMY IF YES, SEND MSG 18860020 DC Y(RC8*256) WITH RETURN CODE = 8 18880020 EXCLCR20 MVC EXCNXCRD(INF),EXCSVCRD INITIALIZE GET CARD ROUTINE TO 18900020 BAL R2,EXCGETRC PICK UP FRST CARD OF NEXT STMNT. 18920020 TM OPTBYTE3,EXCFRFRM IF FREE-FORM, 18940020 BO EXCNEB35 BR TO SKIP OVER COMMENT LINES. 18960020 B EXCNNB STANDARD-FORM. BR TO PROCESS STMNT. 18980020 EJECT 19000020 * ENTRY WITH LOC OF RETURN CODE & ERROR CODE IN R2 AND NOT 19020020 * YET HAVING FOUND A RECORD. NO ERROR CHAR STRING. 19040020 EXCALMS MVI WKAERNUM,C' ' LINE NUMBER = BLANKS 19060020 MVC WKAERNUM+1(7),WKAERNUM 19080020 SR RF,RF AND 19100020 STH RF,WKAERPOS RELATIVE POSITION IN CHAIN = 0 19120020 LA RF,EXCALM25 BAL RF,EXCALMS2 B EXCALM25 19140020 EXCALMS2 XC WKAERRSC,WKAERRSC INDICATE NO CHAR STRING IN MSG 19160020 EXCALMS5 MVC WKAERRCD,1(R2) WKAERRCD=ERROR CODE 19180020 BR RF RETURN 19200020 * 19220020 * 19240020 * 19260020 * ENTRY WITH LOC OF RETURN AND ERROR CODES IN R2 AND RECORD 19280020 * SPECIFIED IN EXCCRRCRD INF AREA. NO ERROR CHAR STRING. 19300020 EXCALMR EX 0,EXCALMS2 INDICATE NO CHAR STRING IN MSG 19320020 * ENTRY WHEN LOC OF CHAR STRING IS IN WKAERRSC. 19340020 EXCALMR2 EX 0,EXCALMS5 WKAERRCD = ERROR CODE 19360020 MVC WKAERPOS,EXCCRREL SET UP REL LINE NO. FROM EXCCR INFO 19380020 TM OPTBYTE3,EXCNLNUM IF DATA SET IS NOT LINE NUMBERED 19400020 BO EXCALM25 DO NOT SET UP WKAERNUM 19420020 L R6,EXCCRCRD PREPARE TO GET LINE NO. FROM RECORD 19440020 TM OPTBYTE3,EXCVRLNG IS SOURCE VARIABLE LENGTH 19460020 BNO EXCALMR3 BR IF NO. 19480020 LA R6,12(R6) YES. R6 POINTS TO COL 1 OF TEXT 19500020 EXCALMR3 EQU * 19520020 BAL RF,EXCLNRTN BR TO ROUTINE TO GET LINE NUMBER 19540020 B EXCALM25 BR TO CALL IPDER 19560020 * 19580020 * 19600020 * 19620020 * ENTRY WITH LOC OF RETURN AND ERROR CODES IN R2 AND RECORD 19640020 * SPECIFIED IN EXCFSCRD INF AREA. NO ERROR CHAR. STRING 19660020 EXCALMF MVC WKAERNUM,WKATINU+2 IF DATA SET IS LINE NUMBERED, LINE 19680020 * NO. IS FOUND IN FIRST ENTRY OF 19700020 * WKATINU TABLE. 19720020 MVC WKAERPOS,EXCFSREL WKAERPOS=REL POSIT IN 'FS' AREA 19740020 B EXCALMP2 BR TO CONTINUE 19760020 * 19780020 * 19800020 * 19820020 * ENTRY WITH LOC OF RETURN AND ERROR CODES IN R2 AND RECORD 19840020 * SPECIFIED IN EXCSVCRD INF AREA. NO ERROR CHAR STRING. 19860020 EXCALMP MVC WKAERNUM,EXCSVLNN DATA SET LINE NUMBER HAS BEEN SAVED 19880020 MVC WKAERPOS,EXCSVREL WKAERPOS= REL POSIT NO IN 'SV' AREA 19900020 EXCALMP2 BAL RF,EXCALMS2 SET WKAERRSC AND WKAERRCD 19920020 B EXCALM25 BR TO CALL IPDER 19940020 * 19960020 * 19980020 * 20000020 * ENTRY WITH RETURN AND ERROR CODES IN R2, LOCATION OF 20020020 * CHARS IN ERROR SPECIFIED IN WKAERRSC. 20040020 EXCALMQ EX 0,EXCALMS5 WKAERRCD = ERROR CODE 20060020 * 20080020 * 20100020 * 20120020 * ENTRY WITH ERROR CODE IN WKAERRCD, LOC OF RETURN CODE IN R2, 20140020 * AND LOCATION OF CHARS IN ERROR SPECIFIED IN WKAERRSC. 20160020 EXCALMY L R0,WKAERRSC R0 CONTAINS ADDR OF CHARS IN ERR 20180020 LTR R0,R0 IS ADDR RETURNED FROM CKR NEGATIVE 20200020 BNP EXCALMY7 YES, BR. NO SOURCE ERR CHARS. 20220020 LA R1,WKACHRST-1 R1 HAS ADDR OF BEGINNING OF CHAR 20240020 * STRING MINUS ONE 20260020 * WKATINU CONTAINS DISPL OF SOURCE 20280020 * CHARS FROM WKACHRST-1 20300020 SR R0,R1 DIFFERENCE = DISPL OF CHARS IN ERR 20320020 SR R1,R1 R1 IS INDEXING REG FOR TINU TBL 20340020 EXCALMY2 LH RE,WKATINU(R1) GET DISPL FROM TINU TBL ENTRY 20360020 LTR RE,RE 20380020 BM EXCALMY7 IF ENTRY NEG, END OF TBL. BR. 20400020 CR R0,RE ARE ERR CHARS WITHIN THIS LINE 20420020 BNH EXCALMY3 YES. BR TO SET UP ERROR INFO. 20440020 LA R1,10(R1) INCREMENT INDEX REGISTER 20460020 B EXCALMY2 BR TO CONTINUE TBL COMPARE 20480020 EXCALMY3 SR RE,R0 DETERMINE NO. CHARS IN ERR MSG MINUS 20500020 * ONE, I.E. NO. CHARS ON LINE 20520020 * BEYOND THE ONE POINTED TO. 20540020 CH RE,EXCH5 MORE THAN FIVE CHARS TO END OF LINE 20560020 BNL EXCALMY4 YES. BR TO MOVE SIX CHARS. 20580020 MVI WKAERCHR,C' ' BLANK OUT AREA WHERE SOURCE 20600020 MVC WKAERCHR+1(5),WKAERCHR CHARS ARE TO BE MOVED 20620020 B EXCALMY5 BR TO MOVE CHARS 20640020 EXCALMY4 LA RE,5 SET UP RE FOR MOVE OF SIX CHARS 20660020 EXCALMY5 L RF,WKAERRSC RF CONTAINS ADDR OF CHARS IN ERR 20680020 EX RE,EXCALMYY MOVE ERR CHARS TO MSG AREA 20700020 EXCALMY6 LA RF,WKATINU+2 RF HAS ADDR OF WKATINU ENTRY WITH 20720020 LA RF,0(RF,R1) REL LINE NO. OR DATA SET LINE NO 20740020 MVC WKAERPOS,0(RF) MOVE REL LINE NO. OR DATA SET LINE 20760020 MVC WKAERNUM,0(RF) NO. TO IPDERWKA 20780020 B EXCALM25 BR TO CALL IPDER 20800020 EXCALMY7 SR R1,R1 INITIALIZE R1 FOR SCAN THRU TINU TBL 20820020 EXCALMY8 LH RE,WKATINU(R1) SCAN TINU FOR NEGATIVE DISPL (END 20840020 LTR RE,RE OF TABLE) 20860020 BM EXCALMY9 BR IF NEGATIVE 20880020 LA R1,10(R1) INCR INDEX REG 20900020 B EXCALMY8 CONTINUE TO SCAN 20920020 EXCALMY9 SH R1,EXCH10 BACK UP PTR TO LAST VALID ENTRY OF 20940020 EX 0,EXCALMS2 ERROR PAST END OF STMNT 20960020 B EXCALMY6 TINU TABLE 20980020 * 21000020 * 21020020 * AN ERROR HAS BEEN FOUND IN THE LABEL OF A STANDARD-FORM STMNT 21040020 EXCALMYA MVC WKAERRCD,1(R2) WKAERRCD=ERROR CODE 21060020 MVI WKAERCHR,C' ' BLANK OUT AREA WHERE SOURCE 21080020 MVC WKAERCHR+1(5),WKAERCHR CHARS ARE TO BE MOVED 21100020 L RF,WKAERRSC RF CONTAINS ADDR OF CHARS IN ERROR 21120020 MVC WKAERCHR(5),0(RF) MOVE ERROR CHARS 21140020 SR R1,R1 WKATINU INDEX SHOULD POINT TO 21160020 * FIRST LINE ENTRY 21180020 B EXCALMY6 BR FOR LINE NO. HANDLING 21200020 EXCALMYY MVC WKAERCHR(0),0(RF) MVC FOR MOVE OF ERROR CHARS 21220020 * 21240020 * 21260020 * 21280020 * WKAERRCD,WKAERNUM,WKAERPOS,WKAERRSC HAVE NOW BEEN SET UP. 21300020 * SET UP REST OF CALLING SEQUENCE TO IPDERERR. 21320020 EXCALM25 LA R1,OPTBYTE3 21340020 ST R1,WKAEROPT LOC. OF 4TH BYTE OF OPTION WORD 21360020 LA R1,IPDERWKA R1=LOC. OF WORK AREA FOR IPDERERR 21380020 L RF,=A(IPDERERR) 21400020 MVI WKASFAIL,0 PRESET RESULT BYTE OK 21420020 * 21440020 BALR RE,RF CALL IPDERRERR 21460020 CLI WKASFAIL,0 DID SYSBUG OCCUR 21480020 BE EXCALM30 BR IF NO 21500020 EXCALM27 MVI WKAERRCD,ERSYSBUG YES. WKAERRCD= SYSBUG CODE 21520020 B EXCALM25 RE-CALL IPDERERR FOR SYSBUG MSG 21540020 EXCALM30 LA R1,WKAERBFR PUT LOC OF MSG IN WORD 2 OF 21560020 ST R1,COMERRAD COMMUNICATION AREA FOR INTERFACE 21580020 SR RF,RF GET RETURN CODE 21600020 IC RF,0(R2) 21620020 LA R2,2(R2) INCR RETURN REG OVER HALFWORD PARAM 21640020 * 21660020 * 21680020 * 21700020 * ENTRY WITH RETURN CODE IN RF AND NO MSG TO BE SENT. 21720020 EXCALMT CH RF,EXCH8 IS CODE = 8 21740020 BE EXCALM40 YES. RETURN. 21760020 LA R2,EXCALM77 NO. SET RETURN REG TO ISSUE MSG IF 21780020 * INTERFACE TRIES TO CONTINUE CHECKING 21800020 * SAME BUFFER. 21820020 EXCALM40 STM R2,R8,28+EXCSVRGS SAVE REGS IN CASE OF RETURN CODE 8. 21840020 L RD,EXCSVRGS+4 R13 = LOC OF CALLER SAVE AREA 21860020 EXCEXIT L RE,12(RD) RESTORE 14 & 2-12. 21880020 LM R2,RC,28(RD) 21900020 MVI 12(RD),X'FF' SET RETURN INDICATION 21920020 BR RE RETURN 21940020 * 21960020 * 21980020 * 22000020 * UNSOLICITED REQUEST BY INTERFACE TO CONTINUE CHECKING BUFFER. 22020020 EXCALM77 MVI WKASFAIL,SYERITF1 SET UP WKASFAIL WITH FAIL CODE 22040020 BAL R2,EXCALMS SEND SYSBUF MSG 22060020 DC Y(RC4*256+ERSYSBUG) WITH RETURN CODE = 4 22080020 * 22100020 EJECT 22120020 * 22140020 * SET UP EXCNXCRD LOCATION INFO AREA. 22160020 * BAL R2,EXCGETRC GET A RECORD & SET R6= LOC OF COL. 1 22180020 * RETURN R8= LENGTH OF TEXT 22200020 * MINUS ONE 22220020 * AND PUT LOCATION INFO IN EXCCRCRD 22240020 * AREA. SETS EXCNXCRD AREA TO LOCATION 22260020 * INFO FOR NEXT RECORD. OPERATES INDEPENDENTLY OF EXCNESIT 22280020 * INITIALIZATION. CON CODE=0 INDICATES NO MORE RECORDS. 22300020 * WHEN THE ONE GOTTEN IS THE LAST ONE, EXCNXBUF IS ZERO. 22320020 * 22340020 EXCGETRC LM R0,R1,EXCNXCRD GET LOCS OF NEXT RECORD & ITS BUFFER 22360020 STM R0,R1,EXCCRCRD STORE AS LOC OF CURRENT RECORD 22380020 LTR R1,R1 IS THERE ONE... 22400020 BCR CC0,R2 RETURN WITH ZERO CON CODE IF NO 22420020 * BUFFER. 22440020 LR R6,R0 SET R6= COL 1 OF CURRENT RECORD 22460020 L RF,EXCNXBRL STORE REL LINE NO. IN BUFFER AND 22480020 ST RF,EXCCRBRL IN BUFFER CHAIN OF CURRENT RECORD 22500020 LA RF,1(RF) 22520020 STH RF,EXCNXREL AND OF NEW NEXT RECORD. 22540020 SRA RF,16 22560020 BM EXCGRCE1 SYSTEM ERROR. BR TO SET WKASFAIL. 22580020 LA RF,1(RF) 22600020 STH RF,EXCNXBRL 22620020 * 22640020 * 22660020 * 22680020 * DETERMINE LOCATION OF NEXT RECORD IN BUFFER. DEPENDS ON 22700020 * WHETHER RECORDS ARE FIXED LENGTH OR VARIABLE LENGTH. 22720020 * FIRST, DETERMINE IF NEXT RECORD IS IN CURRENT BUFFER. 22740020 IC RE,0(R1) RE = NO. RECS IN BUFFER 22760020 N RE,=F'127' ZERO OUT BITS 0 THROUGH 24 22780020 CR RE,RF IS NEXT RECORD BEYOND BUFFER 22800020 BNH EXCGRC5 BR IF YES 22820020 * 22840020 TM OPTBYTE3,EXCVRLNG 22860020 BO EXCGRC3 BR IF VARIABLE LENGTH 22880020 * 22900020 * FIXED LENGTH. GET LINE LENGTH FROM OPTIONS WORD. 22920020 SR R0,R0 22940020 IC R0,OPTLNLNG OPTIONS WORD PROVIDES LINE LENGTH 22960020 AR R0,R6 R0 = ADDR. OF NEXT RECORD. 22980020 ST R0,EXCNXCRD STORE ADDR. OF NEXT RECORD 23000020 EXCGRC2 LH R8,EXCH71 INITIALIZE R8 = LENGTH OF TEXT - 1 23020020 B EXCGRC4 BR TO CONTINUE 23040020 * 23060020 * VARIABLE LENGTH. GET LINE LENGTH FROM BUFFER. 23080020 EXCGRC3 MVC WKATEMPH,0(R6) LINE LENGTH IS FIRST TWO BYTES OF 23100020 LH R0,WKATEMPH CURRENT RECORD 23120020 AR R0,R6 R0 = ADDR. OF NEXT RECORD 23140020 ST R0,EXCNXCRD STORE ADDR. OF NEXT RECORD 23160020 EXCGRC35 LH R8,WKATEMPH R8 SET TO TOTAL LINE LENGTH 23180020 SH R8,EXCH4 SUBTRACT 4 FOR FULL WORD OF BINARY 0'S 23200020 LA R6,4(R6) ADDR. OF TEXT PORTION IS PAST BIN 0'S 23220020 SH R8,EXCH1 SUB 1 TO INDICATE TEXT LNG MINUS 1 23240020 BM EXCGRCE2 SYSTEM ERROR. BR TO SET WKASFAIL. 23260020 TM OPTBYTE3,EXCNLNUM 23280020 BO EXCGRC4 BR IF NOT A LINE NUMBERED DATA SET 23300020 LA R6,8(R6) ADDR. OF TEXT PORTION IS PAST LINE NO. 23320020 SH R8,EXCH8 SUBTRACT DOUBLE WORD LINE NO FROM LINE 23340020 * LENGTH. 23360020 * 23380020 EXCGRC4 LTR R0,R6 SET CON CODE NON-ZERO. 23400020 BR R2 RETURN WITH CON CODE NON-ZERO 23420020 * NO MORE RECORDS IN CURRENT BUFFER 23440020 EXCGRC5 EQU * 23460020 OI 0(R1),EXCRLSBF SET BIT TO ALLOW BUFFER RELEASE 23480020 MVC EXCNXBUF+1(3),1(R1) GET LOC OF NEXT BUF FROM 23500020 L R1,EXCNXBUF POINTER IN CURRENT BUF 23520020 LTR R1,R1 23540020 BZ EXCGRC15 BR IF NO NEXT BUFFER 23560020 CLI 0(R1),0 ANY RECORDS IN NEXT BUFFER 23580020 BE EXCGRC5 BR IF NO TO CONTINUE CHAINING 23600020 EXCGRC10 XC EXCNXBRL,EXCNXBRL ZERO REL. POSITION IN BUFFER 23620020 LA R0,4(R1) LOC OF NEXT RECORD = LOC. OF NEXT 23640020 * BUFFER + 4. 23660020 ST R0,EXCNXCRD STORE ADDR. OF NEXT RECORD 23680020 EXCGRC15 TM OPTBYTE3,EXCVRLNG 23700020 BNO EXCGRC2 BR IF FIXED LENGTH 23720020 MVC WKATEMPH,0(R6) VARIABLE-LENGTH. COMPLETE INITIAL- 23740020 B EXCGRC35 IZATION FOR CURRENT RECORD. 23760020 EXCGRCE1 MVI WKASFAIL,SYERREG1 SET WKASFAIL NON-ZERO 23780020 B EXCGRCE3 BR. 23800020 EXCGRCE2 MVI WKASFAIL,SYNGREG1 SET UP WKASFAIL WITH FAIL CODE 23820020 EXCGRCE3 BAL R2,EXCALMS BR TO ISSUE MSG 23840020 DC Y(RC4*256) WITH RETURN CODE = 4 23860020 * 23880020 * 23900020 * 23920020 * BAL R2,EXCNESIT NEW STATEMENT INITIALIZATION ROUTINE 23940020 EXCNESIT XC WKACERSW(EXCSLERR+1-WKACERSW),WKACERSW ZERO SOME SWITCHS 23960020 MVI WKASFAIL,0 INITIALIZE WKASFAIL TO ZERO 23980020 SR R5,R5 START WKATINU INDEX AT ZERO 24000020 TM OPTBYTE3,EXCFRFRM 24020020 BNO EXCNES10 BR IF STANDARD-FORM 24040020 STH R5,WKATINU INITIALIZE 1ST DISPL TO ZERO 24060020 BR R2 RETURN 24080020 EXCNES10 LA R0,5 IN ST-FORM, DISPL SHOULD INCLUDE 24100020 STH R0,WKATINU THE LABEL FIELD 24120020 BR R2 RETURN 24140020 * 24160020 * ROUTINE TO OBTAIN DATA SET LINE NUMBER FROM RECORD IN BUFFER. 24180020 * R6 IS LOCATION OF COL. 1 OF RECORD. 24200020 * EXCLNRTN WILL PUT LINE NUMBER IN WKAERNUM. 24220020 * 24240020 * ROUTINE SHOULD NOT BE CALLED IF DATA SET IS NOT LINE NUMBERED. 24260020 * 24280020 * CALLED BY BAL RF,EXCLNRTN 24300020 * 24320020 EXCLNRTN LA R0,8 24340020 LR R1,R6 R1 CONTAINS LOC. OF COL. 1 24360020 SR R1,R0 SUBTRACT 8 FROM ADDR. 24380020 TM OPTBYTE3,EXCVRLNG IF VARIABLE-LENGTH, R1 NOW 24400020 BO EXCLNRT1 POINTS TO LINE NO., BR. 24420020 IC R0,OPTLNLNG IF FIXED-LENGTH, ADD LINE LENGTH 24440020 AR R1,R0 TO R1 TO GET ADDR OF LINE NO. 24460020 EXCLNRT1 MVC WKAERNUM,0(R1) MOVE LINE NO. TO WKAERNUM 24480020 BR RF RETURN 24500020 * 24520020 * CONSTANTS USED BY EXECUTIVE 24540020 * 24560020 EXCH1 DC H'1' 24580020 EXCH4 DC H'4' 24600020 EXCH5 DC H'5' 24620020 EXCH6 DC H'6' 24640020 EXCH8 DC H'8' 24660020 EXCH10 DC H'10' 24680020 EXCH71 DC H'71' 24700020 EXCH200 DC H'200' 24720020 EXCH1320 DC H'1320' 24740020 EXCH1325 DC H'1325' 24760020 LTORG 24780020 EXCSOFAR EQU *-IPDSNEXC TROUBLE IF THIS EXCEEDS EXCLENGT 24800020 EXCEXPAN EQU EXCLENGT-EXCSOFAR 24820020 DC (EXCEXPAN)C'X' EXPANSION SPACE FILLED WITH X'S 24840020 EXCCSEND EQU * 24860020 EXTRN IPDERERR 24880020 EJECT 24900020 * 24920020 * 24940020 *NAME OF ROUTINE.. 24960020 * IPDSNCKR, THE CHECKER ROUTINE. 24980020 * 25000020 *STATUS.. 25020020 * VERSION 1 / MODIFICATION 0 25040020 * 25044021 * CHANGE LEVEL 02 OCT 71 RELEASE 21 25048021 * D417400-418000,418600-419600 A43116 25052021 * D 25052821 * C047800,A073700-076510,C076610,A087260-087320 25053621 * A087840-08796,D088000,A798820-798960 PTM2013 25054421 * 25055221 * 25056021 * 25060020 *FUNCTION.. 25080020 * THE FUNCTION OF THE CHECKER IS TO EDIT A 25100020 * SINGLE FORTRAN STATEMENT FOR SYNTACTIC 25120020 * ERRORS BY MATCHING THE SOURCE STATEMENT 25140020 * AGAINST A TABLE THAT DEFINES THE SYNTAX 25160020 * FOR FORTRAN IV SYNTAX. 25180020 * 25200020 *ENTRY.. 25220020 * IPDSNCKR 25240020 * THE CHECKER IS CALLED AT ITS SINGLE ENTRY POINT, IPDSNCKR, 25260020 * BY THE EXECUTIVE, IPDSNEXC, VIA A STANDARD CALLING SEQUENCE. 25280020 * REGISTER 1 POINTS TO A PARAMETER LIST. 25300020 * 25320020 *INPUT.. 25340020 * WHEN THE CHECKER IS CALLED, REGISTER 1 POINTS TO A PARAMETER 25360020 * LIST OF THE FORM-- 25380020 * DS F INITIAL SUPPLIED SOURCE POINTER 25400020 * DS A ADDR OF DEFINITION TABLE, EG, IPDAGH 25420020 * DS A ADDR OF WORK AREA OF FORMAT IPDSNWKA 25440020 * DS A ADDR OF OPTIONS WORD OF FORMAT IPDSNOPT 25460020 * 25480020 * ONCE POINTED TO THE WORK AREA, THE CHECKER CAN REFERENCE ALL 25500020 * FIELDS DEFINED IN THE DSECT IPDSNWKA, INCLUDING THE PARAMETER 25520020 * LIST ITSELF, WHICH MUST BE WITHIN THE WORK AREA. 25540020 * 25560020 * THE INITIAL SUPPLIED SOURCE POINTER GIVES THE CHECKER 25580020 * THE BEGINNING CHARACTER OF THE STATEMENT TO BE CHECKED. 25600020 * 25620020 * THE DEFINITION TABLE ADDRESS GIVES THE CHECKER THE LOCATION 25640020 * OF THE FORTRAN LANGUAGE DEFINITION TABLE THAT DIRECTS THE 25660020 * SYNTAX CHECKING. 25680020 * 25700020 * WKACERSW AND WKASFAIL ARE PRESET TO ZERO WHEN THE CHECKER 25720020 * IS CALLED FOR A NEW STATEMENT. 25740020 * 25760020 *OUTPUT.. 25780020 * THE CHECKER'S OUTPUT CONSISTS OF INFORMATION RETURNED TO 25800020 * THE EXECUTIVE IN THEIR MUTUAL WORK AREA (IPDSNWKA). 25820020 * 25840020 * THE CHECKER RETURNS IN ONE OF THREE WAYS-- 25860020 * 1.AT SATISFACTORY COMPLETION OF CHECKING A STATEMENT, 25880020 * WKACERSW SWITCH BYTE IS ZERO(OFF),WKASFAIL IS ZERO, 25900020 * 2.ON ENCOUNTERING AN ERROR IN STATEMENT CHECKING-- 25920020 * WKACERSW SWITCH BYTE IS 01 (ON), WKASFAIL IS ZERO, 25940020 * WKAERRSC CONTAINS A POINTER TO THE SOURCE CHARACTER 25960020 * SUSPECTED TO BE IN ERROR, 25980020 * WKAERRCD CONTAINS THE ERROR MESSAGE CODE NUMBER IN BITS 0-6, 26000020 * WKAERRTM, BIT 7 OF WKAERRCD, IS ON (1) IF NO FURTHER 26020020 * CHECKING IS TO BE DONE ON THE CURRENT STATEMENT, IE, THE 26040020 * ERROR IS TERMINAL. IF WKAERRTM IS OFF (0), THE CHECKER 26060020 * EXPECTS TO BE RECALLED TO CONTINUE CHECKING THE SAME 26080020 * STATEMENT. 26100020 * 3.ON ENCOUNTERING AN INVALID CONDITION THAT INDICATES A 26120020 * PROGRAM FAILURE IN SOME PART OF THE SYNTAX CHECKER-- 26140020 * WKACERSW IS ON,(X'01'), WKASFAIL IS NON-ZERO (FAILURE CODE 26160020 * X'11' TO X'1F') 26180020 * 26200020 *EXTERNAL REFERENCES.. 26220020 * NONE. 26240020 * SINCE THE CHECKER HAS NO STANDARD LINKAGES TO SUBROUTINES 26260020 * IT DOES NOT NEED,AND THEREFORE DOES NOT HAVE, A SAVE AREA 26280020 * POINTED TO BY REGISTER 13. 26300020 * 26320020 *ERROR CONDITIONS.. 26340020 * THE ERROR CONDITIONS INDICATED WITH AN ASTERISK (*) ARE 26360020 * TESTED FOR ONLY WHEN THE CONDITIONAL ASSEMBLY PARAMETER 26380020 * &ITNLDBG IS SET FOR DEBUGGING. 26400020 * * INVALID OP-CODE IN DEFINITION TABLE 26420020 * * TOO MANY RIGHT BRACES, OR TOO MANY )S IN DEFINITION 26440020 * * INVALID LITERAL LENGTH IN DEFINITION TABLE 26460020 * * ILLEGAL TABLE FUNCTION OPCODE IN DEFINITION TABLE 26480020 * * ERROR IN HANDLING LINE NEST STACK 26500020 * * INVALID ACTION CODE IN DEFINITION TABLE 26520020 * WKASFAIL WILL CONTAIN AN ERROR CODE. 26540020 * 26560020 *EXITS,NORMAL.. 26580020 * CONTROL IS RETURNED TO THE CALLER WITH INFORMATION LEFT AS 26600020 * DESCRIBED UNDER OUTPUT, CONDITIONS 1. AND 2. 26620020 * 26640020 *EXITS,ERROR.. 26660020 * CONTROL IS RETURNED TO THE CALLER WITH INFORMATION LEFT AS 26680020 * DESCRIBED UNDER OUTPUT, CONDITION 3. 26700020 * 26720020 *TABLES/WORK AREAS.. 26740020 * CKROPNDX,TABLE OF DISPLACEMENTS TO OPERATOR ROUTINES. 26760020 * CKRACNDX, TABLE OF DISPLACEMENTS TO ACTION CODE ROUTINES. 26780020 * CKRAMTBL, TRT TABLE FOR A THROUGH Z AND 0 THROUGH 9. 26800020 * IPDSNWKA, WORK AREA DSECT. 26820020 * WKATINUE, TABLE FOUND IN WORK AREA FOR LOCATING THE LINES OF 26840020 * A STATEMENT. 26860020 * WKASERTB, TRT TABLE BUILT IN WORK AREA FOR CHARACTER SCAN. 26880020 * 26900020 *ATTRIBUTES.. 26920020 * REENTRABLE,REFRESHABLE 26940020 * 26960020 *NOTES.. 26980020 * THE CHECKER DOES NOT HAVE A SAVE AREA. IT DOES NOT NEED 27000020 * A SAVE AREA BECAUSE IT DOES NOT PERFORM ANY STANDARD 27020020 * LINKAGES. IT SAVES REGISTER 13 IN THE WORK AREA AND RESTORES 27040020 * IT PRIOR TO RETURNING TO ITS CALLER. 27060020 * 27080020 * THE CHECKER USES THE 16-WORD AREA WKACKRGS TO SAVE ITS OWN 27100020 * REGISTERS BETWEEN CALLS FROM THE EXECUTIVE. BY RELOADING 27120020 * ITS REGISTERS, ONE OF WHICH SPECIFIES A BRANCH ADDRESS, 27140020 * THE CHECKER CAN CONTINUE CHECKING A STATEMENT BEYOND AN ERROR 27160020 * AFTER RETURNING CONTROL TO, AND BEING RECALLED BY, THE 27180020 * EXECUTIVE. 27200020 * 27220020 * WKANLIST, THE LINE NEST LIST, AND WKAQLIST, THE QUALIFICATION 27240020 * LIST, ARE ARRANGED AS PUSH DOWN STACKS GROWING TOWARDS 27260020 * ONE ANOTHER (WKALIST LOWER-TO-HIGHER-NUMBERED LOCATIONS, 27280020 * WKAQLIST, HIGHER-TO LOWER LOCATIONS). 27300020 * 27320020 * THE OPERATION OF CONTROL SECTION IPDSNCKR DEPENDS ON THE 27340020 * FOLLOWING PROPERTIES OF THE INTERNAL REPRESENTATION OF THE 27360020 * EXTERNAL CHARACTER SET-- 27380020 * 27400020 * CHARACTER CODE DEPENDENCY INSTR. SEQUENCE AFFECTED 27420020 * 27440020 * 1.DECIMAL NUMBERS MUST BE 1.ROUTINES USING CKR9-- 27460020 * CODED SO THAT THEIR COLLATING CKRDIGIT, 27480020 * SEQUENCE REMAINS ASCENDING CKRNUMBR(6 PLACES) 27500020 * FROM 0 TO 9 WITH NO OTHER CKRSTATM(2 PLACES) 27520020 * CHARACTERS INTERSPERSED. CKRHOLLR,CKRAR700, 27540020 * CKRAR701,CKREVALU 27560020 * 27580020 * 2.DECIMAL NUMBERS MUST BE 2.CKREVALU SUBROUTINE 27600020 * CODED SO THAT THE LOW 27620020 * ORDER 4 BITS, WHEN CONSIDERED 27640020 * AS A BINARY INTEGER, IDENTIFY 27660020 * THE VALUE OF THE DIGIT. 27680020 * 27700020 * 3.COMPARISON OF CHARACTERS 3.REASSEMBLE ENTIRELY (TO 27720020 * TO CHARACTER CONSTANTS 'REDEFINE' INTERNAL 27740020 * DEPENDS UPON AN INTERNAL REPRESENTATION OF 27760020 * REPRESENTATION EQUIVALENT TO CHARACTER CONSTANTS) 27780020 * THE ONE USED AT ASSEMBLY TIME. 27800020 * 27820020 * 4.THE END-OF-SOURCE SPECIAL 4.WKASPCHR EQU --- 27840020 * CHARACTER MUST NOT MATCH THE 27860020 * INTERNAL REPRESENTATION OF 27880020 * ANY CHARACTER IN THE FORTRAN 27900020 * CHARACTER SET. 27920020 * 27940020 * 5.TESTS FOR FORTRAN ALPHABETICS 5.ALL THE PLACES WHICH 27960020 * AND ALPHAMERICS ARE DEPENDENT REFER TO CKR$, CKRA, OR 27980020 * UPON THE EBCDIC 8-BIT CODES CKRZ-- 28000020 * OF THOSE 37 CHARACTERS. TSTAM AND TSTAL MACRO 28020020 * DEFINITIONS, CKRLETTR 28040020 * AND CKRAR500 ROUTINES 28060020 * THE TRANSLATE-AND-TEST 28080020 * TABLE, CKRAMTBL, USED BY 28100020 * THE TSTAM AND TSTAL 28120020 * MACROS. 28140020 * 28160020 * 28180020 EJECT 28200020 IPDSNCKR CSECT CHECKER 28220020 SPACE 2 28240020 *********************************************************************** 28260020 * 28280020 * LENGTH OF CSECT 28300020 * 28320020 CKRLENGT EQU 4960 MUST BE INTEGRAL MULT. OF 8 28340020 * 28360020 * THIS EQU DEFINES THE LENGTH OF THIS CSECT. 28380020 * THE AMOUNT OF SPACE FOR EXPANSION IS THE 28400020 * DIFFERENCE BETWEEN THIS NUMBER AND THE 28420020 * NUMBER OF BYTES USED IN THE CODING OF THE 28440020 * CSECT. IF THE CODING OF THE CSECT IS 28460020 * EXPANDED TO A NUMBER OF BYTES LARGER THAN 28480020 * THAT SPECIFIED BY THIS EQU , THE EQU 28500020 * MUST BE CHANGED TO SPECIFY A SIZE AT LEAST 28520020 * AS LARGE AS THE CODING. 28540020 * 28560020 *********************************************************************** 28580020 * 28600020 * 28620020 * 28640020 * REGISTER ASSIGNMENT 28660020 * 28680020 REGZEROW EQU 0 28700020 REGWORKA EQU 1 * WORK REGISTERS * 28720020 REGWORKB EQU 2 * NOT PRESERVED BY * 28740020 REGWORKC EQU 3 * LOCAL SUBROUTINES * 28760020 REGNSTPT EQU 4 LINE NEST LIST POINTER 28780020 REGWORKN EQU REGNSTPT 28800020 REGQALPT EQU 5 QUALIFICATION LIST POINTER 28820020 REGWORKQ EQU REGQALPT 28840020 REGSRCPT EQU 6 SOURCE POINTER 28860020 REGDEFBS EQU 7 DEFINITION TABLE BASE 28880020 REGOPCDE EQU 8 OPCODE REGISTER,HIGH-ORDER 3 BYTES ZERO 28900020 REGDEFPT EQU 9 DEFINITION TABLE POINTER 28920020 REGTDFPT EQU 10 DEFINITION TABLE REFERNC FOR TABLE FUNCT. 28940020 REGCHRCT EQU REGTDFPT WKAVALUE,CHAR CTR USED AROUND EXCGTCHR'S. 28960020 REGXTRBS EQU 11 2ND BASE FOR CHECKER PROGRAM 28980020 REGCKRBS EQU 12 CHECKER PROGRAM BASE 29000020 REGWKABS EQU 13 WORK AREA BASE 29020020 REGLRETN EQU 14 SUBROUTINE RETURN REGISTER 29040020 REGLCALL EQU 15 SUBROUTINE ENTRY POINT REGISTER 29060020 REG0 EQU 0 29080020 REG1 EQU 1 29100020 REG13 EQU 13 29120020 REG15 EQU 15 29140020 REGOPNDX EQU 15 CONTAINS DISPL. FROM INTRP TO OPER. RTNE. 29160020 * 29180020 EJECT 29200020 USING *,15 29220020 B CKRNWOLD BR TO 1ST INSTRUCTION 29240020 DC CL8'IPDSNCKR' NAME OF CSECT 29260020 DROP 9,10,11,12,13,15 29280020 *********************************************************************** 29300020 * * 29320020 * THIS ROUTINE DETERMINES WHETHER THE CHECKER HAS BEEN * 29340020 * CALLED TO START CHECKING A NEW STATEMENT OR TO CONTINUE * 29360020 * CHECKING A STATEMENT IN PROGRESS. * 29380020 * * 29400020 * * 29420020 *********************************************************************** 29440020 * 29460020 CKRNWOLD EQU * 29480020 SAVE (14,12) 29500020 LR REGCKRBS,REG15 ESTABLISH BASE FOR PROGRAM 29520020 USING IPDSNCKR,REGCKRBS 29540020 LA REGXTRBS,4095(REGCKRBS) 29560020 USING IPDSNCKR+4095,REGXTRBS 29580020 L REG15,12(REG1) GET LOC. OF WKA FROM PARAM LIST 29600020 USING IPDSNWKA,REG15 29620020 ST REG13,WKASVR13 29640020 DROP REG15 29660020 LR REGWKABS,REG15 ESTABLISH BASE FOR WORK AREA 29680020 USING IPDSNWKA,REGWKABS 29700020 * 29720020 * 29740020 * 29760020 * REGISTER 13 IS USED AS THE WKA BASE 29780020 * 29800020 * IPDSNCKR DOES NOT NEED,AND THEREFORE 29820020 * DOES NOT HAVE A SAVE AREA 29840020 * 29860020 * 29880020 * 29900020 TM WKACERSW,EXCNCKER IS THIS A NEW SOURCE STATEMENT 29920020 * 29940020 BO CKRCONTN NO, GO CONTINUE CHECKING OLD 29960020 * STATEMENT 29980020 * YES 30000020 *********************************************************************** 30020020 * * 30040020 * THIS ROUTINE PERFORMS INITIALIZATION FOR A NEW STATEMENT * 30060020 * * 30080020 *********************************************************************** 30100020 * 30120020 CKRINTLZ EQU * 30140020 * 30160020 L REGDEFBS,8(REG1) ESTABLISH BASE FOR DEFINITION TABLE 30180020 USING DEFTABLE,REGDEFBS 30200020 L REGSRCPT,0(REG1) GET INITL. SOURCE PT FROM PARAM.LIST 30220020 * 30240020 * 30260020 * 30280020 * 30300020 * 30320020 * INITIALIZE SWITCH SETTINGS 30340020 * 30360020 NI WKAFALSW,255-CKRFALSW SET OFF FAILURE SWITCH 30380020 NI WKAGLCMT,255-CKRGLCMT SET OFF GLOBAL (STMT) COMMIT SW 30400020 AIF ('&ITNLDBG' EQ '').NOKINIT 30420020 OI WKAKSWCH,CKRKFAIL SET ON K SWITCHES 30440020 .NOKINIT ANOP 30460020 * 30480020 * INITIALIZE NEST AND QUALIFICATION LIST POINTERS, 30500020 * ZERO NEST AND QUALIFICATION INFORMATION,BUT SET ON 30520020 * QUALIFICATION COMMIT SWITCH TO COMMIT TOP LINE 30540020 * INITIALIZE MESSAGE TABLE ENTRY ADDRESS 30560020 * 30580020 LA REGNSTPT,WKANLIST ESTABLISH BASE FOR NEST LIST ENTRIES 30600020 USING NLSLNEST,REGNSTPT 30620020 ST REGNSTPT,WKAADNLS 30640020 * 30660020 LA REGQALPT,WKAQLIST ESTABLISH BASE FOR QUAL.LIST ENTRIES 30680020 USING QLSQUALF,REGQALPT 30700020 ST REGQALPT,WKATPQLS AND SAVE TOP LOC OF QUAL LIST 30720020 * 30740020 XC WKALNEST,WKALNEST ZERO NEST INFO (LEVEL = 0) 30760020 MVI WKANFMSG,CKRSBUGT BUT DEFAULT ERR MSG TO SYSTEM OR 30780020 * SYNTAX CHECER FAILURE 30800020 * 30820020 * 30840020 XC WKAQUALF,WKAQUALF ZERO QUAL INFO (LEVEL = 0) 30860020 * 30880020 OI WKAQSWCH,CKRCMTSW BUT COMMIT TOP LINE 30900020 * 30920020 LA REGWORKA,WKAMSGTB INITIALIZE MESSAGE ENTRY ADDRESS 30940020 ST REGWORKA,WKAMSGAD TO TOP OF MSG. TABLE 30960020 * 30980020 * 31000020 * INITIALIZE DEFINITION TABLE POINTER AND 31020020 * NEST TO FIRST LINE IN LANGUAGE DEFINITION 31040020 * 31060020 LA REGDEFPT,0 ZERO INITL DEFN TBL DISPL IN POINTER 31080020 * 31100020 GTNB1 31120020 L REGSRCPT,WKASRCCR THEN POINT TO 1ST NON-BLANK CHARACT. 31140020 ST REGSRCPT,WKABEGSC IN STATEMENT 31160020 * SET UP OP-CODE REGISTER, IT WILL 31180020 LA REGOPCDE,0 ALWAYS HAVE HI-ORDER 3BYTES 0 31200020 B CKRSYNS AND NEST FOR FIRST DEFN LINE 31220020 * 31240020 *********************************************************************** 31260020 * * 31280020 * THE FOLLOWING ROUTINE, WHICH IS THE INTERPRETER, * 31300020 * USES THE SYNTACTIC OP-CODE FROM THE DEFINITION TABLE * 31320020 * IN CONJUCTION WITH THE OPERATOR ROUTINES BRANCH TABLE * 31340020 * TO LOCATE AND BRANCH TO THE APPROPRIATE OPERATOR ROUTINE * 31360020 * * 31380020 *********************************************************************** 31400020 * 31420020 CKRINTRP EQU * 31440020 IC REGOPCDE,DEFOPCDE(REGDEFPT) INSERTION OF SYN. OP-CODE 31460020 * 31480020 AIF ('&ITNLDBG' EQ '').NOOPCHK 31500020 C REGOPCDE,CKRINVOP IS OP-CODE VALID 31520020 BNL CKROPFAL INDICATE AN INVALID OP-CODE 31540020 .NOOPCHK ANOP 31560020 * 31580020 LA REGDEFPT,1(0,REGDEFPT) DEF.PT USED, MAY BE INCR'D 31600020 * WILL HALT ON LH IF NOT AN EVEN NO. 31620020 LH REGOPNDX,CKROPNDX(REGOPCDE) OP-CODE INDEXES BRANCH TBL 31640020 * TO PROVIDE OPER RTNE INDX 31660020 B CKRINTRP(REGOPNDX) BRANCH TO APPROP OPER RTNE 31680020 * 31700020 * 31720020 * 31740020 *********************************************************************** 31760020 * * 31780020 * THE FOLLOWING ROUTINES, CKRLBRCE AND CKRLPARN, PUSH DOWN * 31800020 * THE CURRENT QUALIFICATION INFO AS AN ENTRY ON THE END OF THE * 31820020 * QUALIFICATION LIST AND BUILD A NEW QUALIFICATION * 31840020 * * 31860020 * CKRLBRCE--ALTERNATIVE QUALIFICATION (LEFT BRACE) * 31880020 * CKRLPARN--OPTIONAL QUALIFICATION (LEFT PARENTHESIS) * 31900020 * * 31920020 *********************************************************************** 31940020 * 31960020 CKRLBRCE LA REGWORKB,DEFFIELD(REGDEFPT) PT WORK REG TO FALSE,TRUE 31980020 * DISPLACEMENTS IN TABLE 32000020 LA REGDEFPT,2(0,REGDEFPT) INCR DEF POINTER PAST F,T 32020020 B CKRLQUAL GO DO COMMON BEGIN QUAL PROC'NG 32040020 * 32060020 CKRLPARN LA REGWORKB,DEFFIELD(REGDEFPT) POINT WORK REG TO FALSE 32080020 * DISPLACEMENT IN TABLE 32100020 LA REGDEFPT,1(0,REGDEFPT) INCR DEF POINTER PAST F 32120020 * 32140020 * COMMON BEGIN QUALIFICATION PROCESSING 32160020 * 32180020 CKRLQUAL S REGQALPT,CKRLNQLK GET LOC FOR QUALLIST ENTRY 32200020 * 32220020 CR REGQALPT,REGNSTPT BE SURE THERE IS SPACE FOR Q ENTRY 32240020 BL CKRQOFLO (IF NOT, GO PROC.LIST OVERFLOW) 32260020 * 32280020 MVC QLSQUALF,WKAQUALF MOVE QUALIFICATION INFO TO LIST 32300020 * 32320020 * BUILD NEW QUALIFICATION INFORMATION 32340020 * 32360020 MVC WKAQFALS(2),0(REGWORKB) SAVE FALSE(, TRUE) DISPL'S IN Q 32380020 * 32400020 GTNB1 32420020 L REGSRCPT,WKASRCCR SPACE PAST ANY BLANK CHARS. 32440020 ST REGSRCPT,WKAQSCPT SAVE CURRENT VALUE OF SOURCE PT IN Q 32460020 * 32480020 STH REGDEFPT,WKAQDFBK SAVE CURR VALUE OF DEFN PT IN QUAL 32500020 IC REGWORKA,WKANLVLN 32520020 STC REGWORKA,WKAQNLVL SET LEVEL OF NESTING FROM LINE NEST 32540020 * 32560020 MVI WKAQICNT,0 ZERO ITERATION COUNT IN QUALIFICAT'N 32580020 * 32600020 NI WKAQSWCH,255-CKRCMTSW SET OFF COMMIT SWITCH 32620020 * 32640020 B CKRINTRP GO INTERPRET NEXT OPERATOR 32660020 * 32680020 * 32700020 * 32720020 *********************************************************************** 32740020 * * 32760020 * THE FOLLOWING ROUTINE, CKRRBRCE, PERFORMS PROCESSING TO * 32780020 * TERMINATE THE CHECKING OF A LIST OF ALTERNATIVES. IT * 32800020 * RECEIVES CONTROL AFTER ANY ALTERNATIVE SUCCEEDS OR * 32820020 * AFTER THE LAST ALTERNATIVE FAILS. * 32840020 * * 32860020 *********************************************************************** 32880020 * 32900020 CKRRBRCE EQU * 32920020 * 32940020 L REGWORKA,WKAQSCPT PICK UP SOURCE PT FOR POSSBL BACKUP 32960020 * 32980020 MVC WKAQUALF,QLSQUALF POP UP QUALIFICATION LIST AND 33000020 LA REGQALPT,CKRQUALL(0,REGQALPT) ADJ QUAL LIST POINTER 33020020 AIF ('&ITNLDBG' NE 'E').NOERBCK 33040020 * 33060020 C REGQALPT,WKATPQLS CHECK FOR 33080020 BH CKREXCRB TOO MANY RIGHT BRACES 33100020 .NOERBCK ANOP 33120020 * 33140020 TM WKAFALSW,CKRFALSW DID LAST TEST FAIL 33160020 BZ CKRINTRP NO, GO INTERPRET NEXT OPERATOR 33180020 LR REGSRCPT,REGWORKA YES,BACK UP CURRENT SOURCE PT 33200020 ST REGSRCPT,WKASRCCR 33220020 B CKRFAIL AND GO PROCESS FAILURE 33240020 * 33260020 *********************************************************************** 33280020 * * 33300020 * THE FOLLOWING ROUTINE, CKRRPARN, PERFORMS PROCESSING TO * 33320020 * TERMINATE THE CHECKING OF AN OPTIONAL ITEM IN THE * 33340020 * SYNTACTIC DEFINITION. IT RECEIVES CONTROL WHETHER THE * 33360020 * OPTIONAL DEFINITION WAS SATISFIED OR NOT. * 33380020 * * 33400020 * * 33420020 *********************************************************************** 33440020 * 33460020 CKRRPARN TM WKAFALSW,CKRFALSW DID LAST TEST FAIL 33480020 BZ CKRSVCTR NO 33500020 NI WKAFALSW,255-CKRFALSW YES,SET OFF FAILURE SWITCH 33520020 L REGSRCPT,WKAQSCPT AND BACK UP TO RETEST SOURCE 33540020 * 33560020 CKRSVCTR MVC WKASVICT,WKAQICNT SAVE ITER CT (MAY BE 0) FOR ACT 33580020 * 33600020 MVC WKAQUALF,QLSQUALF POP UP QUALIFICATION LIST 33620020 LA REGQALPT,CKRQUALL(0,REGQALPT) (ADJ. QUAL LIST POINTER) 33640020 AIF ('&ITNLDBG' NE 'E').NOERPCK 33660020 * 33680020 C REGQALPT,WKATPQLS CHECK FOR 33700020 BH CKREXCRP TOO MANY RIGHT PARENTHESES 33720020 * 33740020 .NOERPCK ANOP 33760020 * 33780020 B CKRINTRP GO INTERPRET NEXT OPERATOR 33800020 * 33820020 *********************************************************************** 33840020 * * 33860020 * THE FOLLOWING ROUTINE DETERMINES THE NEXT OPERATOR TO BE * 33880020 * EXAMINED AFTER ONE OF SEVERAL ALTERNATIVES HAS BEEN TESTED. * 33900020 * IT RECEIVES CONTROL WHETHER THE TEST ON THE PRECEDING * 33920020 * ALTERNATIVE WAS SUCCESSFUL OR NOT * 33940020 * * 33960020 * * 33980020 *********************************************************************** 34000020 * 34020020 CKROR TM WKAFALSW,CKRFALSW DID PRECEDING TEST FAIL 34040020 BZ CKRALTOK NO 34060020 NI WKAFALSW,255-CKRFALSW YES, SET OFF FAILURE SWITCH 34080020 L REGSRCPT,WKAQSCPT AND BACK UP SOURCE POINTER 34100020 * TO RETEST SOURCE AGAINT NEXT 34120020 * ALTERNATIVE 34140020 IC REGWORKB,DEFFIELD(REGDEFPT) SAVE DISP TO 'OR' OR RT BRCE 34160020 STC REGWORKB,WKAQFALS PAST NEXT ALTERNATIVE 34180020 * 34200020 LA REGDEFPT,1(0,REGDEFPT) INCREMENT DEFINITION POINTER 34220020 * TO NEXT OPERATOR 34240020 B CKRINTRP AND GO INTERPRET IT 34260020 * 34280020 CKRALTOK SR REGDEFPT,REGDEFPT PRECEDING ALTERNATIVE WAS 34300020 IC REGDEFPT,WKAQTRUE SATISFIED, UPDATE DEF'N POINTR 34320020 AH REGDEFPT,WKANDFPT TO RIGHT BRACE(DEFN+TRU DISP) 34340020 * 34360020 B CKRINTRP AND GO INTERPRET THAT OPCODE 34380020 * 34400020 * 34420020 *********************************************************************** 34440020 * * 34460020 * THE FOLLOWING ROUTINE COMMITS THE DEFINITION TO A * 34480020 * PARTICULAR ALTERNATIVE OR OPTION * 34500020 * * 34520020 * * 34540020 *********************************************************************** 34560020 * 34580020 CKRCOMIT OI WKAQSWCH,CKRCMTSW SET ON QUALIFICATION COMMIT SW 34600020 * 34620020 B CKRINTRP GO INTERPRET NEXT OPERATOR 34640020 * 34660020 * 34680020 *********************************************************************** 34700020 * * 34720020 * THE FOLLOWING ROUTINE COMMITS THE DEFINITION TO A * 34740020 * PARTICULAR STATEMENT * 34760020 * * 34780020 * * 34800020 *********************************************************************** 34820020 * 34840020 CKRSTCMT EQU * 34860020 OI WKAGLCMT,CKRGLCMT SET ON GLOBAL (STATEMENT) COMMIT SW 34880020 CLC WKANLVLN,WKAQNLVL ANY QUALIF AT CURRNT NEST LEVEL 34900020 BNE CKRTOPQL NO 34920020 LR REGWORKB,REGQALPT YES,INITLZ PT TO COMMIT QUAL'S 34940020 CKRCMTQE OI QLSQSWCH-QLSQUALF(REGWORKB),CKRCMTSW COMMIT Q ENTRY 34960020 * IS LIST QUAL ENTRY 34980020 CLC WKANLVLN,QLSQNLVL-QLSQUALF(REGWORKB) AT NEST LEVEL 35000020 BNE CKRTPQEN NO 35020020 MVI QLSQNLVL-QLSQUALF(REGWORKB),1 YES,SET Q ENTRY LEVEL=1 35040020 * 35060020 LA REGWORKB,CKRQUALL(0,REGWORKB) ADJUST PT TO NEXT ENT 35080020 B CKRCMTQE AND GO TEST ITS LVL 35100020 * 35120020 CKRTPQEN EQU * QUAL ENTRY IS ABOVE CURR N LVL 35140020 MVI QLSQNLVL-QLSQUALF(REGWORKB),0 SET Q ENTRY LEVEL=0 35160020 LA REGWORKB,CKRQUALL(0,REGWORKB) AND SAVE NEW TOP OF Q 35180020 ST REGWORKB,WKATPQLS LIST IN CASE MORE SPACE NEEDED 35200020 * 35220020 MVI WKAQNLVL,1 SET QUALIF LEVEL=1 TO MATCH NST 35240020 * 35260020 CKRNSTL1 OI WKAQSWCH,CKRCMTSW COMMIT CURRENT QUALIFICATION 35280020 * 35300020 MVI WKANLVLN,1 SET CURR LEVEL OF NESTING = 1 35320020 * 35340020 LA REGNSTPT,WKANLIST AND BEGIN AT TOP OF NEST LIST 35360020 * AGAIN (NEST LIST STRIPPED) 35380020 B CKRINTRP NOW,GO INTERPRET NEXT OPERATOR 35400020 * 35420020 * 35440020 CKRTOPQL MVI WKAQNLVL,0 SET QUALIF LEVEL=0, TO IGNORE 35460020 * ALL PREVIOUS ALTERNATIVES 35480020 LA REGQALPT,WKAQLIST AND BEGIN AT TOP OF QUAL LIST 35500020 ST REGQALPT,WKATPQLS AGAIN (QUAL LIST STRIPPED) 35520020 B CKRNSTL1 GO COMMIT THE QUAL AND STRIP 35540020 * THE NEST LIST 35560020 * 35580020 * 35600020 *********************************************************************** 35620020 * * 35640020 * THE FOLLOWING ROUTINES, CKRITIND AND CKRITDEF,PROCESS THE RE-* 35660020 * ITERATION,OR ATTEMPTED REPETITION,OF AN OPTIONAL DEFINITION * 35680020 * ON SUBSEQUENT CHARACTERS OF THE SOURCE. THE DEFINITE * 35700020 * ITERATION (CKRITDEF) IS LIMITED BY A MAXIMUM NUMBER OF * 35720020 * TIMES THE DEFINITION MAY BE MATCHED AGAINST SOURCE. THESE * 35740020 * ROUTINES ARE ENTERED ONLY AFTER SATISFACTION OF THE * 35760020 * PRECEDING OPTIONAL DEFINITION(IE,AFTER SUCCESSFUL ITERATION) * 35780020 * * 35800020 * * 35820020 *********************************************************************** 35840020 * 35860020 CKRITIND IC REGWORKB,WKAQICNT 35880020 LA REGWORKB,1(0,REGWORKB) INCREMENT THE ITERATION COUNT 35900020 STC REGWORKB,WKAQICNT (FOR POSSIBLE ACTION RTNE USE) 35920020 * 35940020 CKRREPET ST REGSRCPT,WKAQSCPT SAVE NEWLY UPDATED VALUE OF 35960020 * SOURCE POINTER IN QUALIFICAT'N 35980020 * FOR BACKUP IF ITERATION FAILS 36000020 * 36020020 NI WKAQSWCH,255-CKRCMTSW REINITLZ COMMIT SWITCH OFF 36040020 * 36060020 LH REGDEFPT,WKAQDFBK BACK UP THE DEFINITION TABLE 36080020 * POINTER IMMED BEYOND THE ( 36100020 B CKRINTRP AND GO INTERPRET THE FIRST OP- 36120020 * CODE IN THE ITER'N PARENTHESES 36140020 * 36160020 * 36180020 CKRITDEF EQU * 36200020 LA REGWORKA,DEFFIELD(REGDEFPT) GET LOC OF ITER'N LIMIT, N 36220020 * 36240020 LA REGDEFPT,1(0,REGDEFPT) (AND UPDATE DEF'N PT BEYOND IT) 36260020 * 36280020 IC REGWORKB,WKAQICNT INCREMENT ITERATION COUNT BY 1 36300020 LA REGWORKB,1(0,REGWORKB) 36320020 STC REGWORKB,WKAQICNT 36340020 * 36360020 CLC WKAQICNT,0(REGWORKA) IS ITERATION COUNT UP TO LIMIT 36380020 * 36400020 BNL CKRINTRP IF SO, GO INTERPRET NEXT OPCDE 36420020 * 36440020 B CKRREPET OTHERWISE, GO REPEAT THE 36460020 * 36480020 * 36500020 *********************************************************************** 36520020 * * 36540020 * THE FOLLOWING ROUTINE PROCESSES NESTING TO A SYNTACTIC * 36560020 * LINE IN THE DEFINITION. IT RECEIVES CONTROL WHEN A * 36580020 * SYMBOLIC-NAME CORRESPONDING TO A DEFINITION LINE IS * 36600020 * ENCOUNTERED IN THE DEFINITION. THE CURRENT NEST INFORMATION * 36620020 * IS PUSHED DOWN INTO THE NEST LIST, AND A NEW NEST IS BUILT * 36640020 * FOR THE NEW LINE. * 36660020 * * 36680020 * * 36700020 *********************************************************************** 36720020 * 36740020 CKRSYNS LA REGTDFPT,DEFFIELD(REGDEFPT) OBTAIN LOC IN DEFN TBL 36760020 CKRSYNST EQU * 36780020 CKRADDNS EQU * 36800020 LA REGWORKB,CKRNESTL(0,REGNSTPT) BE SURE THERE IS SPACE 36820020 CR REGWORKB,REGQALPT FOR ANOTHER NEST 36840020 BH CKRNOFLO IN THE NEST LIST 36860020 * 36880020 MVC NLSLNEST,WKALNEST PLACE CURR. NEST AT END OF LIST 36900020 LR REGNSTPT,REGWORKB AND INCREMENT NEST LIST POINTR 36920020 * 36940020 * 36960020 LA REGDEFPT,2(0,REGDEFPT) INCR. DEFN PT ON CURR LINE 36980020 STH REGDEFPT,WKANDFBK AND SAVE IN NEST TO GO BACK 37000020 * 37020020 MVC WKANDFPT,0(REGTDFPT) SAVE DISPL TO DEFN LINE IN 37040020 LH REGDEFPT,WKANDFPT NEST AND AS NEW DEFN PT 37060020 * 37080020 IC REGWORKB,WKANLVLN INCREMENT LEVEL OF NESTING 37100020 LA REGWORKB,1(0,REGWORKB) BY 1 37120020 STC REGWORKB,WKANLVLN 37140020 * 37160020 B CKRINTRP INTERPRET OPERATOR ON NEW LINE 37180020 * 37200020 * 37220020 *********************************************************************** 37240020 * * 37260020 * THE FOLLOWING ROUTINES, M AND N, TEST THE SOURCE FOR A * 37280020 * FORTRAN NAME. THE TEST FAILS IF THE FIRST CHARACTER * 37300020 * EXAMINED IS NOT ALPHABETIC (A THROUGH Z OR $). IF MORE * 37320020 * THAN FIVE ALPHAMERIC CHARACTERS FOLLOW THE FIRST CHARACTER, * 37340020 * CKRMNAME (M) FAILS, BUT CKRNAME (N) ISSUES A 'NAME TOO * 37360020 * LONG' MESSAGE AND SUCCEEDS AFTER ABSORBING THE LAST * 37380020 * ALPHAMERIC CHARACTER. * 37400020 * * 37420020 * * 37440020 *********************************************************************** 37460020 * 37480020 CKRMNAME EQU * 37500020 NI WKASWTCH,255-CKRLGNMA INDICATE LONG NAME NOT ALLOWED 37520020 B CKRNAMES BR TO COMMON PT IN NAME PROC'G 37540020 * 37560020 CKRNAME EQU * 37580020 OI WKASWTCH,CKRLGNMA INDICATE LONG NAME ALLOWED 37600020 * 37620020 CKRNAMES EQU * 37640020 BAL REGLRETN,CKRGTNB1 GO GET NEXT NON-BLANK SRCE CHAR 37660020 * 37680020 TSTAL CKRFAIL IF NOT ALPHABETIC, FAIL 37700020 * IN CASE OF SUBSEQ ERROR, SAVE 37720020 * POINTER TO 1ST CHAR OF NAME 37740020 SVERP REGWORKA 37760020 * 37780020 LA REGCHRCT,0 INITIALIZE COUNT OF SUBSEQ CHRS 37800020 * IN NAME 37820020 * 37840020 CKRNAMUP UPDSC UPDATE SOURCE POINTER 37860020 * 37880020 * 37900020 BAL REGLRETN,CKRGTNB1 GO GET NEXT NON-BLANK SRCE CHAR 37920020 * 37940020 TSTAM CKRNAMNM IF NOT ALPHAMERIC, END NAME 37960020 * 37980020 LA REGCHRCT,1(0,REGCHRCT) INCR. COUNT OF A/M CHARS AFTER 38000020 * 1ST LETTER OF NAME 38020020 * 38040020 C REGCHRCT,CKRFULL6 IS NAME TOO LONG 38060020 BL CKRNAMUP NO, GO LOOK AT NEXT CHARACTER 38080020 * 38100020 TM WKASWTCH,CKRLGNMA YES, IS A LONG NAME ALLOWED 38120020 BO CKRNAMUP YES, GO LOOK AT NEXT CHAR 38140020 B CKRFAIL NO, FAIL ON M OPERATOR 38160020 * 38180020 CKRNAMNM EQU * END OF NAME 38200020 C REGCHRCT,CKRFULL6 IS NAME TOO LONG 38220020 BL CKRINTRP NO, GO INTERPRET NEXT OPERATOR 38240020 MVI WKAERRCD,CKRLGNMC YES, SET UP ERROR MESSAGE 38260020 B CKRREINT AND GO ISSUE IT BEFORE INTERPRETNG 38280020 * NUMERIC CONSTANT IN REAL OR INTEGER FORM. THE K OPERATOR * 38300020 * SWITCHES, TYPE (INTEGER,ON OR REAL,OFF), LENGTH (D OR E), * 38320020 * AND VALUE (NON-ZERO OR ZERO) DESCRIBE THE NUMBER FOUND OR * 38340020 * INDICATE (BY INTEGER, D) THAT THE SOURCE IS NOT A NUMBER. * 38360020 * * 38380020 * * 38400020 *********************************************************************** 38420020 * 38440020 CKRNUMBR EQU * 38460020 SR REGWORKB,REGWORKB COUNT INITIALIZATION, 38480020 ST REGWORKB,WKALDZCT ZERO LEADING-ZEROES COUNT, 38500020 ST REGWORKB,WKADGTCT DIGIT COUNT, AND 38520020 ST REGWORKB,WKAZROCT ZERO COUNT 38540020 * 38560020 BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 38580020 * 38600020 * IN CASE OF SUBSEQUENT ERROR, SAVE 38620020 * POINTER TO BEG. OF EXPECTED NUMBER 38640020 SVERP REGWORKA 38660020 MVI WKAEXPSN,WKAEXINT INITIALIZE WKAEXPSN. USED AS SWCH TO 38680020 * DIAGNOSE EXTRANEOUS EXPONENTS. 38700020 * 38720020 * TEST FOR THE BEGINNING OF A NUMBER 38740020 * 38760020 CLI WKASCHRS,CKR0 COMPARE 1ST CHAR TO ZERO 38780020 BL CKRTFRAC LOWER,GO TRY DEC.PT,MAY BE FRACTION 38800020 BE CKRJZROS ZERO, GO COUNT IT AS LEADING-ZERO 38820020 CLI WKASCHRS,CKR9 GT 0, IS IT GREATER THAN 9 38840020 BNH CKRCTDGT NO, GO COUNT IT AS A DIGIT 38860020 * NOT A DIGIT 38880020 CKRTFRAC CLI WKASCHRS,CKRDOT IS IT A (DECIMAL) POINT 38900020 BE CKRDECPT YES, GO PERFORM DEC. PT PROCESSG 38920020 * NO 38940020 CKRNOTNO OI WKAKSWCH,CKRKFAIL SOURCE IS NOT A NUMBER 38960020 B CKRFAIL BR TO OPERATOR FAILURE ROUTINE 38980020 * 39000020 * 39020020 CKRJZROS L REGWORKA,WKALDZCT INCR.COUNT OF LEADING ZEROES 39040020 LA REGWORKA,1(0,REGWORKA) BY 1 39060020 ST REGWORKA,WKALDZCT 39080020 * 39100020 CKRUPBYD UPDSC UPDATE SOURCE POINTER 39120020 * 39140020 BAL REGLRETN,CKRGTNB1 AND REQUEST NEXT NON-BLANK CHARACTR 39160020 * 39180020 CLI WKASCHRS,CKR0 COMPARE CHAR TO ZERO 39200020 BL CKRTMIXD LOWER, GO TRY DEC.PT,MAY BE X.X 39220020 BE CKRTDGCT ZERO, CHECK WHETHER STILL LEADING 0 39240020 CLI WKASCHRS,CKR9 GREATER THAN 0, IS IT GT 9 39260020 BNH CKRCTDGT NO, GO COUNT IT AS A DIGIT 39280020 CKRTMIXD CLI WKASCHRS,CKRDOT NOT A DIGIT, IS IT A (DECML) POINT 39300020 BE CKRDECPT YES, GO PERFORM DEC. PT PROCESSG 39320020 * 39340020 CLI WKASCHRS,CKRE NO, IS IT E FOR EXPONENT FORM 39360020 BNE CKRTINTD NO, GO TRY DOUBLE-PRECISION 39380020 L REGWORKA,WKADGTCT YES, SAVE DIGIT COUNT 39400020 ST REGWORKA,WKATENPW AS POWER OF TEN 39420020 CKREXPNE NI WKAKSWCH,255-CKRKLEND YES, SET LENGTH SW OFF FOR LEN 4 39440020 B CKREXPON AND GO DO EXPONENT PROCESSING 39460020 * 39480020 CKRTINTD CLI WKASCHRS,CKRD IS IT D FOR DBL-PRECISN EXP. FORM 39500020 BNE CKRINTEG NO, GO PROC.NUMBER AS AN INTEGER 39520020 L REGWORKA,WKADGTCT YES, SAVE DIGIT COUNT 39540020 ST REGWORKA,WKATENPW AS POWER OF TEN 39560020 CKREXPND OI WKAKSWCH,CKRKLEND YES, SET LENGTH SW ON FOR LEN 8 39580020 B CKREXPON AND GO DO EXPONENT PROCESSING 39600020 * 39620020 CKRTDGCT L REGWORKB,WKADGTCT DIGIT IS ZERO, 39640020 LTR REGWORKB,REGWORKB IS IT A LEADING-ZERO 39660020 BZ CKRJZROS YES, GO COUNT IT AS SUCH 39680020 CKRCTDGT L REGWORKB,WKADGTCT NO, 39700020 LA REGWORKB,1(0,REGWORKB) INCREMENT DIGIT COUNT BY 1 39720020 ST REGWORKB,WKADGTCT 39740020 B CKRUPBYD AND GO UPDATE SOURCE POINTER 39760020 * 39780020 CKRINTEG L REGWORKB,WKADGTCT IS INTEGER TOO LARGE 39800020 C REGWORKB,CKRINTMX (MORE THAN 10 DIGITS LONG) 39820020 BL CKRINTOK NO 39840020 BH CKRINTLG YES,GREATER THAN 10 DIGITS 39860020 * EXACTLY 10 DIGITS, CHECK FURTHER 39880020 L REGSRCPT,WKAERRSC BACK UP SOURCE PT TO BEGINNING OF NO 39900020 STH REGWORKB,WKASRCNT AND ASK FOR THE 10-CHARACTERS AGAIN 39920020 * 39940020 BAL REGLRETN,CKRGTNBS GET 10 NON BLANK CHARS. 39960020 UPDSC 39980020 CLC WKASCHRS(L'CKRMAXIG),CKRMAXIG IS INTEG GT MAX ALLOWED 40000020 BNH CKRINTOK IF NOT, INTEGER OK 40020020 CKRINTLG EQU * 40040020 * 40060020 MVI WKAERRCD,CKRLGINC YES, SET UP ERROR MESSAGE 40080020 * AND RETURN POINT AS IF INTEGER OK 40100020 BAL REGLRETN,CKRTSTML AND GO ISSUE ERROR MESSAGE 40120020 * 40140020 CKRINTOK EQU * SET SWITCHES FOR A VALID INTEGER 40160020 CLI WKASCHRS,CKRH UNLESS FOLLOWED BY H FOR 40180020 BE CKRNOTNO HOLLERITH CONSTANT 40200020 OI WKAKSWCH,CKRKTYPI TYPE = INTEGER 40220020 NI WKAKSWCH,255-CKRKLEND LENGTH = 4 40240020 * 40260020 CKRTVALU L REGWORKB,WKADGTCT IS VALUE ZERO 40280020 C REGWORKB,WKAZROCT (DIGIT COUNT = ZERO COUNT) 40300020 BH CKRNTZRO NO 40320020 NI WKAKSWCH,255-CKRKVALU YES, VALUE = ZERO 40340020 B CKRINTRP INTERPRET NEXT OPERATOR 40360020 * 40380020 CKRNTZRO OI WKAKSWCH,CKRKVALU VALUE NOT ZERO 40400020 B CKRINTRP 40420020 * 40440020 * 40460020 CKRDECPT EQU * 40480020 L REGWORKA,WKADGTCT SAVE COUNT OF SIGNIF DIGITS LEFT OF 40500020 ST REGWORKA,WKATENPW DECIMAL POINT AS POWER OF TEN 40520020 STC REGWORKA,WKANONZS AND AS SWITCH BYTE 40540020 * 40560020 L REGWORKA,WKASRCCR SAVE CURR SOURCE LOC. FOR BACKUP 40580020 ST REGWORKA,WKACSVSC IN CASE POINT NOT PART OF NUMBER 40600020 * 40620020 UPDSC UPDATE SOURCE POINTER BEYOND DEC.PT. 40640020 * CHECK FOR RELATIONAL OR LOGICAL 40660020 * OPERATOR 40680020 BAL REGLRETN,CKRKLOGL BR TO COMPARE ROUTINE 40700020 * 40720020 * 40740020 BC CC2,CKRMONUM CC2 INDICATES NO LOGL OP FOLLOWS 40760020 * DECIMAL POINT 40780020 BC CC1,CKRNOMOR CC1 INDICATES END OF SOURCE 40800020 * REACHED 40820020 CKRBAKUP L REGSRCPT,WKACSVSC RESTORE SOURCE POINTER TO . OF OP 40840020 * 40860020 L REGWORKB,WKADGTCT DID ANY DIGITS PRECEDE THE . 40880020 A REGWORKB,WKALDZCT (ZERO OR NOT) 40900020 BNZ CKRINTEG SOME DIGIT(S), SOURCE IS AN INTEGER 40920020 * ITERATION 40940020 B CKRNOTNO OTHERWISE, NOT A NUMBER 40960020 * 40980020 * SOURCE POINTER IS STILL IMMEDIATELY 41000020 * BEYOND DECIMAL POINT 41020020 CKRMONUM BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 41040020 * 41060020 CLI WKASCHRS,CKR0 IS DECIMAL POINT FOLLOWED BY A DIGIT 41080020 BL CKRNOMOR NO 41100020 CLI WKASCHRS,CKR9 41120020 BH CKRNOMOR NO 41140020 L REGWORKB,WKADGTCT YES,ADD 1 TO DIGIT COUNT 41160020 LA REGWORKB,1(0,REGWORKB) 41180020 ST REGWORKB,WKADGTCT 41200020 CLI WKASCHRS,CKR0 IF DIGIT ZERO, 41220020 BNE CKRNZDIG BR IF NON-ZERO 41240020 L REGWORKA,WKAZROCT ADD 1 TO ZERO COUNT 41260020 LA REGWORKA,1(0,REGWORKA) 41280020 ST REGWORKA,WKAZROCT 41300020 CLI WKANONZS,0 ANY NONZERO DIGITS ENCOUNTERED, 41320020 BNE CKRUPMON YES 41340020 L REGWORKA,WKATENPW NO, REDUCE POWER OF 10 FOR DECIMAL 41360020 S REGWORKA,=F'1' PLACE INDICATED BY THIS 0 41380020 ST REGWORKA,WKATENPW 41400020 B CKRUPMON UPDATE SOURCE POINTER 41420020 CKRNZDIG MVI WKANONZS,255 INDICATE NON-ZERO DIGIT ENCOUNTERED 41440020 * 41460020 CKRUPMON UPDSC UPDATE SOURCE POINTER 41480020 * 41500020 B CKRMONUM AND GO LOOK FOR ANOTHER DIGIT 41520020 * 41540020 CKRNOMOR EQU * NO MORE DIGITS 41560020 L REGWORKB,WKADGTCT WERE THERE ANY DIGITS (ZERO OR NOT) 41580020 A REGWORKB,WKALDZCT BEFORE OR AFTER THE . 41600020 BZ CKRTKCMT IF NO DIGITS, NOT A NUMBER 41620020 * 41640020 CKRRDORE CLI WKASCHRS,CKRE IS CHARACTER EXPONENTIAL E OR D 41660020 BE CKREXPNE E 41680020 CLI WKASCHRS,CKRD 41700020 BE CKREXPND D 41720020 NI WKAKSWCH,255-CKRKLEND LENGTH 4 (E) 41820020 B CKRREAL BR TO SET SW FOR REAL NUMBER 41840020 * 41980020 CKRREAL NI WKAKSWCH,255-CKRKTYPI REAL NUMBER 42000020 * 42020020 * IF NO. IS NOT YET ENDED,DIAGNOSE 42040020 * ERROR AND BYPASS REMAINING .DIGITS 42060020 * 42080020 CLI WKASCHRS,WKASPCHR WAS END OF SOURCE REACHED 42100020 BE CKRTVALU IF SO, NO MORE CHARS. TO EXAMINE 42120020 GTNB1 NO 42140020 CLI WKASCHRS,CKRDOT IS THERE A DOT AFTER THE NUMBER 42160020 BNE CKRTVALU NO 42180020 * YES, 42200020 CKRNXDOT SVERP REGWORKA SAVE POSSIBLE ERROR POINTER TO . 42220020 * 42240020 L REGWORKA,WKASRCCR THEN SAVE LOCATION OF . FOR BACKUP 42260020 ST REGWORKA,WKACSVSC IN CASE PART OF REL. OR LGL OP 42280020 * 42300020 UPDSC UPDATE SOURCE POINTER BEYOND DOT 42320020 * 42340020 * CHECK FOR RELATIONAL OR LOGICAL 42360020 * OPERATOR 42380020 BAL REGLRETN,CKRKLOGL BR TO COMPARE ROUTINE 42400020 * 42420020 * 42440020 BC CC2+CC1,CKRBDECL CC2 OR CC1 INDICATES NO LOGL OP 42460020 * FOLLOWED DECIMAL POINT 42480020 CKRRBAKP L REGSRCPT,WKACSVSC REL.OR LGL OP,RESTORE SOURCE PT TO . 42500020 B CKRTVALU AND GO TEST VALUE OF NO. FOR 0 42520020 * 42540020 * NOT RELATIONAL OR LOGICAL OPERATOR, 42560020 CKRBDECL MVI WKAERRCD,CKRINVDC DIAGNOSE INVALID DECIMAL POINT 42580020 TM WKAGLCMT,CKRGLCMT (UNLESS STATEMENT NOT COMMITED, IN 42600020 BZ CKRNOTNO WHICH CASE FAIL NUMBER TEST) 42620020 LA REGLRETN,CKRLKDGT AND THEN CONTINUE TO LOOK FOR MORE 42640020 B CKRTSTML DIGITS AND/OR DECIMAL POINTS 42660020 * 42680020 CKRPSDGT UPDSC 42700020 * 42720020 CKRLKDGT CLI WKASCHRS,WKASPCHR WAS END OF SOURCE REACHED 42740020 BE CKRTVALU YES. BR TO EVALUATE NUMBER. 42760020 GTNB1 GET NEXT NON-BLANK CHAR 42780020 CLI WKASCHRS,CKR0 42800020 BL CKRTRYEX BR IF NOT A DIGIT 42820020 CLI WKASCHRS,CKR9 42840020 BNH CKRPSDGT DIGIT, SPACE PAST IT 42860020 * 42880020 CKRTRYEX CLI WKASCHRS,CKRD IF NOT DIGIT, IS IT AN EXPONENT 42900020 BNE CKRTRYX1 NO. BR. 42920020 CLI WKAEXPSN,WKAEXINT YES. IS IT THE FIRST EXPONENT 42940020 BE CKREXPND YES. BR TO SET WKAKSWCH 42960020 B CKRBMRX1 NO. INDICATE INVALID EXPONENT. 42980020 CKRTRYX1 CLI WKASCHRS,CKRE IF NOT A D, IS IT AN E 43000020 BNE CKRTRYDT NO. BR. 43020020 CLI WKAEXPSN,WKAEXINT YES. IS IT THE FIRST EXPONENT 43040020 BE CKREXPNE YES. BR TO SET WKAKSWCH 43060020 CKRBMRX1 SVERP REGWORKA NO. INDICATE INVALID EXPONENT 43080020 MVI WKAERRCD,CKRXPNGC INVALID EXP., DIAGNOSE. 43100020 BAL REGLRETN,CKRBMRLX BR TO ISSUE MSG 43120020 * BYPASS REMAINDER OF EXPONENT 43140020 CKRBMRX2 UPDSC UPDATE SOURCE POINTER 43160020 GTNB1 GET NEXT NON-BLANK CHARACTER 43180020 CLI WKASCHRS,CKRMINUS SPECIAL CHECK FOR SIGN 43200020 BE CKRBMRX2 AFTER D OR E 43220020 CLI WKASCHRS,CKRPLUS 43240020 BE CKRBMRX2 BR TO BYPASS SIGN 43260020 B CKRLKDGT CHECK FOR SUBSEQUENT DIGITS 43280020 * 43300020 CKRTRYDT CLI WKASCHRS,CKRDOT NOT A DIGIT, IS IT A DOT 43320020 BNE CKRTVALU NO,NUMBER EXHAUSTED 43340020 B CKRNXDOT ANOTHER DOT 43360020 * 43380020 CKRTKCMT EQU * . WITHOUT DIGITS, 43400020 TM WKAQSWCH,CKRCMTSW ARE WE COMMITTED TO FINDING A NUMBR 43420020 BZ CKRNOTNO IF NOT,FAIL 43440020 MVI WKAERRCD,CKRKWODC IF SO, SET UP ERROR MESSAGE (REAL 43460020 * NUMBER MUST HAVE AT LEAST 1 DIGIT) 43480020 LA REGLRETN,CKRRDORE AND RETURN POINTER AS IF THERE 43500020 * WERE DIGITS 43520020 B CKRTSTML AND GO ISSUE ERROR MESSAGE 43540020 * 43560020 * 43580020 CKREXPON EQU * DIAGNOSE FORM OF EXPONENT 43600020 NI WKAKSWCH,255-CKRKTYPI REAL NUMBER 43620020 * SAVE POINTER TO E OR D IN CASE 43640020 SVERP REGWORKA OF EXPONENT ERROR 43660020 * 43680020 UPDSC UPDATE SOURCE POINTER BEYOND E OR D 43700020 * 43720020 BAL REGLRETN,CKRGTNB1 GET 1ST CHAR OF EXPONENT FROM SOURC 43740020 * 43760020 MVI WKAEXPSN,CKRPLUS INITLZ FOR NO SIGN, MEANING POSITIVE 43780020 * 43800020 CLI WKASCHRS,CKRMINUS SKIP SIGN, IF ANY 43820020 BE CKRUPBYS - 43840020 CLI WKASCHRS,CKRPLUS 43860020 BNE CKRTXDGT BR IF NEITHER - NOR + 43880020 * 43900020 CKRUPBYS IC REGWORKA,WKASCHRS SAVE ACTUAL SIGN 43920020 STC REGWORKA,WKAEXPSN 43940020 UPDSC 43960020 * 43980020 GTNB1 44000020 * 44020020 CKRTXDGT CLI WKASCHRS,CKR9 TEST FOR A DIGIT IN EXPONENT 44040020 BH CKRINVEX INVALID, IF NO DIGITS 44060020 CLI WKASCHRS,CKR0 44080020 BL CKRINVEX INVALID, IF NO DIGITS 44100020 BAL REGLRETN,CKREVALU EVALUATE THE EXPONENT 44120020 LA REGWORKB,3 BE SURE EXPONENT HAS FEWER THAN 3 44140020 CH REGWORKB,WKACNTDG DIGITS (INCLUDING LEADING ZEROES) 44160020 BNH CKRINVEX OTHERWISE, INVALID 44180020 CLI WKAEXPSN,CKRMINUS IS EXPONENT NEGATIVE 44200020 BNE CKRTSZRO NO 44220020 LNR REGCHRCT,REGCHRCT SIGN THE EXPONENT 44240020 CKRTSZRO L REGWORKB,WKADGTCT IS NUMBER ZERO 44260020 C REGWORKB,WKAZROCT 44280020 BE CKRCKSIZ IF SO, EXPONENT ALONE IS ORD.OF MAG. 44300020 A REGCHRCT,WKATENPW NO,COMBINE ORDER OF MAG OF NUMBER 44320020 * W/O EXPON WITH VALUE OF EXPONENT 44340020 * FOR RANGE TEST 44360020 CKRCKSIZ C REGCHRCT,CKRF0076 IS MAGNITUDE BETWEEN 10**(-78) 44380020 BH CKRBDSIZ AND 10**76 44400020 C REGCHRCT,CKRFM078 44420020 BNL CKRTRYEX YES, SIZE ACCEPTABLE 44440020 CKRBDSIZ L REGWORKB,WKADGTCT NO, 44460020 C REGWORKB,WKAZROCT IF NUMBER IS ZERO, 44480020 BE CKRINVEX DIAGNOSE INVALID EXPONENT, 44500020 MVI WKAERRCD,CKRINVRC NONZERO, DIAGNOSE OUT OF LIMITS 44520020 B CKRCREAL AND SET RETURN TO CONTINUE 44540020 * 44560020 CKRINVEX MVI WKAERRCD,CKRXPNGC INVALID EXP.,DIAGNOSE AND THEN 44580020 CKRCREAL LA REGLRETN,CKRTRYEX CONTINUE TO SCAN FOR EXTRANEOUS EXP. 44600020 CKRBMRLX TM WKAGLCMT,CKRGLCMT (UNLESS STATEMENT NOT COMMITTED, IN 44620020 BZ CKRNOTNO WHICH CASE FAIL NUMBER TEST) 44640020 B CKRTSTML GO REPORT ERROR 44660020 * 44680020 * ROUTINE FOR K OPERATOR TO COMPARE SOURCE CHARS FOR 44700020 * POSSIBLE LOGICAL OR RELATIONAL OPERATOR. 44720020 * EXIT WITH ONE OF THREE CONDITION CODES... 44740020 * CC 0 LOGL OR RELATIONAL OPERATOR FOUND 44760020 * CC 1 END OF SOURCE FOUND 44780020 * CC 2 NUMBER OR EXPONENT FOUND 44800020 * OR NON-NUMERIC 44820020 * 44840020 * CALLED BY BAL REGLRETN,CKRKLOGL 44860020 * 44880020 CKRKLOGL ST REGLRETN,WKASVRTN 44900020 L REGWORKA,CKRFULL2 44920020 STH REGWORKA,WKASRCNT REQUEST NEXT TWO 44940020 BAL REGLRETN,CKRGTNBS NON-BLANK CHARS FROM SOURCE 44960020 * 44980020 CLI WKASCHRS,CKR0 IF THE NEXT CHAR IS A DIGIT 45000020 BL CKRKLOG1 SET CONDITION CODE = 2 45020020 CLI WKASCHRS,CKR9 AND EXIT 45040020 BNH CKRKLNM FROM ROUTINE 45060020 CKRKLOG1 CLI WKAMVCNT+1,0 WAS END OF SOURCE REACHED 45080020 BE CKRKLND YES. EXIT WITH CC 1. 45100020 LH REGWORKA,WKASCHRS NO. TEST FOR RELATIONAL OP EQ 45120020 CH REGWORKA,CKREQ 45140020 BE CKRKLBCK BR TO EXIT WITH CC 0 45160020 CLI WKASCHRS,CKRE NO EQ, IS IT EXPONENTIAL E OR D 45180020 BE CKRKLNM IF E, EXIT WITH CC 2 45200020 CLI WKASCHRS,CKRD 45220020 BE CKRKLNM IF D, EXIT WITH CC 2 45240020 CH REGWORKA,CKRGT TEST FOR GT 45260020 BE CKRKLBCK YES, CC 0 45280020 CH REGWORKA,CKRLT LT 45300020 BE CKRKLBCK YES, CC 0 45320020 CH REGWORKA,CKRGE GE 45340020 BE CKRKLBCK YES, CC 0 45360020 CH REGWORKA,CKRLE LE 45380020 BE CKRKLBCK YES, CC 0 45400020 CH REGWORKA,CKRNE NE 45420020 BE CKRKLBCK YES, CC 0 45440020 CH REGWORKA,CKRORE CHK FOR LOGICAL OP OR 45460020 BE CKRKLBCK YES, CC 0 45480020 CH REGWORKA,CKRAN AN(D) 45500020 BE CKRKLBCK YES, CC 0 45520020 CKRKLNM LPR R0,REGLRETN SET CONDITION CODE = 2 45540020 B CKRKLRTN EXIT 45560020 CKRKLND LNR R0,REGLRETN SET CC = 1 45580020 B CKRKLRTN EXIT 45600020 CKRKLBCK SR R0,R0 SET CC = 0 45620020 CKRKLRTN L REGLRETN,WKASVRTN RESTORE RETURN REG 45640020 BR REGLRETN RETURN 45660020 * 45680020 * 45700020 * 45720020 *********************************************************************** 45740020 * * 45760020 * THE FOLLOWING ROUTINE TESTS THE SOURCE FOR A STATEMENT * 45780020 * NUMBER, 1 TO 5 SIGNIFICANT DIGITS, VALUE OF NUMBER * 45800020 * GREATER THAN ZERO. * 45820020 * * 45840020 * * 45860020 *********************************************************************** 45880020 * 45900020 CKRSTATM EQU * TEST FOR A STATEMENT NUMBER 45920020 * 45940020 BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK SOURCE CHAR 45960020 * 45980020 SVERP REGWORKB SAVE POSSIBLE ERROR POINTER 46000020 LA REGCHRCT,0 INITLZ NO. OF SIGNIF. DIGITS TO 0 46020020 * 46040020 CLI WKASCHRS,CKRPLUS TEST FOR SIGN (INVALID IF PRESENT) 46060020 BE CKRSSGND + 46080020 CLI WKASCHRS,CKRMINUS - 46100020 BNE CKRTSDGT IF NO SIGN,BR TO SEEK DIGITS 46120020 CKRSSGND LA REGCHRCT,2048(0,REGCHRCT) SIGNED, INVALIDATE DIGIT CT 46140020 UPDSC BUT BYPASS SIGN AND EXAMINE DIGITS 46160020 GTNB1 46180020 * 46200020 CKRTSDGT EQU * 46220020 CLI WKASCHRS,CKR0 IF NOT A DIGIT, FAIL, 46240020 BL CKRFAIL NOT A STATEMENT NUMBER 46260020 CLI WKASCHRS,CKR9 46280020 BH CKRFAIL NOT A STATEMENT NUMBER 46300020 CKRTLDG0 CLI WKASCHRS,CKR0 IS CHARACTER A LEADING ZERO 46320020 BNE CKRPAST0 NO 46340020 UPDSC YES, UPDATE SOURCE POINTER 46360020 * 46380020 BAL REGLRETN,CKRGTNB1 AND REQUEST ANOTHER CHARACTER 46400020 * 46420020 B CKRTLDG0 LOOK FOR ANOTHER LEADING ZERO 46440020 * 46460020 CKRPAST0 EQU * 46480020 * 46500020 CKRTSNOD CLI WKASCHRS,CKR0 IS CHARACTER A DIGIT 46520020 BL CKRTSNOL NO 46540020 CLI WKASCHRS,CKR9 46560020 BH CKRTSNOL NO 46580020 LA REGCHRCT,1(0,REGCHRCT) YES, INCR. DIGIT COUNT BY 1 46600020 * 46620020 UPDSC UPDATE SOURCE POINTER 46640020 * 46660020 GTNB1 46680020 * 46700020 B CKRTSNOD AND TEST FOR ANOTHER SIGNIF.DGT 46720020 * 46740020 CKRTSNOL C REGCHRCT,CKRFULL6 IS STATEMENT NO 1-5 SIGNIFICANT 46760020 BNL CKRBDSNO DIGITS IN LENGTH 46780020 LTR REGCHRCT,REGCHRCT 46800020 BNZ CKRINTRP YES, GOOD STATEMENT NUMBER 46820020 CKRBDSNO EQU * NO, 46840020 MVI WKAERRCD,CKRINVSC SET UP ERROR MESSAGE AND GO ISSUE IT 46860020 B CKRREINT THEN ACCEPT SOURCE AS STATEMENT NO. 46880020 * 46900020 * 46920020 * 46940020 *********************************************************************** 46960020 * * 46980020 * THE FOLLOWING ROUTINE TESTS THE SOURCE FOR A HOLLERITH FIELD * 47000020 * DESCRIPTOR OR A HOLLERITH CONSTANT. THE TEST FAILS UNLESS * 47020020 * A WIDTH VALUE FOLLOWED BY H IS FOUND IN THE SOURCE. * 47040020 * * 47060020 * * 47080020 *********************************************************************** 47100020 * 47120020 CKRHOLLR EQU * 47140020 BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK CHAR.FROM SOURCE 47160020 * 47180020 CLI WKASCHRS,CKR0 FAIL IMMEDIATELY IF 1ST CHARACTER 47200020 BL CKRFAIL IS NOT A DIGIT 47220020 CLI WKASCHRS,CKR9 47240020 BH CKRFAIL IS NOT A DIGIT 47260020 * SOURCE BEGINS WITH A DIGIT,EVALUATE 47280020 BAL REGLRETN,CKREVALU THIS AND CONSECUTIVE DIGITS TO 47300020 * COMPUTE A WIDTH VALUE (SET UP ERROR 47320020 * POINTER TO 1ST DIGIT) 47340020 * (VALUE RET'D IN WKAVALUE & REGCHRCT) 47360020 ST REGCHRCT,WKAWIDTH SAVE VALUE AS WIDTH 47380020 * 47400020 CLI WKASCHRS,C'H' IS CHAR AFTER WIDTH AN H 47420020 BNE CKRFAIL NO, FAIL 47440020 UPDSC UPDATE THE SOURCE POINTER BEYOND H 47460020 LTR REGCHRCT,REGCHRCT IF WIDTH = 0, 47480020 BZ CKRINVLW DIAGNOSE AND ACCEPT, OTHERWISE, 47500020 C REGCHRCT,CKRF255 CHECK FOR WIDTH GREATER THAN 255 47520020 BH CKRWHIGH DIAGNOSE IF TOO BIG 47540020 CKRSKIPH EQU * 47560020 STH REGCHRCT,WKASRCNT SKIP OVER THE WIDTH 47580020 BAL REGLRETN,CKRSKANY OF CHARACTERS 47600020 * 47620020 TM WKASNDSW,EXCNSEND WAS END OF SOURCE ENCOUNTERED 47640020 BO CKRINCPH IF SO, GO INDICATE INCOMPL.H ERROR 47660020 * NO, 47680020 UPDSC UPDATE SOURCE PT BEYOND CHARS SKIPPD 47700020 B CKRINTRP GO INTERPRET NEXT OPERATOR 47720020 * 47740020 CKRINVLW MVI WKAERRCD,CKRINVWC SET UP ERROR MESSAGE FOR INVALID W 47760020 B CKRREINT AND ISSUE IT BEFORE ACCEPTING H FLD 47780020 * 47800020 CKRWHIGH MVI WKAERRCD,CKRINVWC SET UP ERROR MSG FOR INVALID W 47820020 LA REGLRETN,CKRSKIPH AND ISSUE IT BEFORE RTNING TO SPACE 47840020 B CKRTSTML PAST H FIELD 47860020 * 47880020 CKRINCPH MVI WKAERRCD,CKRINCHT SET UP TERMINAL ERROR MESSAGE FOR 47900020 * INCOMPLETE H FIELD AND 47920020 B CKRTMRET STOP CHECKING STATEMENT 47940020 * 47960020 * 47980020 * 48000020 *********************************************************************** 48020020 * * 48040020 * THE FOLLOWING ROUTINE TESTS THE SOURCE FOR A CHARACTER * 48060020 * STRING (MAXIMUM LENGTH 255 CHARACTERS) ENCLOSED IN SINGLE * 48080020 * QUOTES. * 48100020 * * 48120020 * * 48140020 *********************************************************************** 48160020 * 48180020 CKRCSTRG EQU * TEST FOR CHARACTER STRING IN QUOTES 48200020 * 48220020 BAL REGLRETN,CKRGTNB1 GET NEXT NON-BLANK CHARACTER 48240020 * 48260020 CLI WKASCHRS,CKRSGLQT IF FIRST CHARACTER IS NOT ' 48280020 BNE CKRFAIL FAIL IMMEDIATELY, OTHERWISE, 48300020 * COMMITTED TO CHARACTER STRING 48320020 * SAVE POSSIBLE ERROR POINTER 48340020 SVERP REGWORKA 48360020 LA REGCHRCT,0 INITLZ STRING LENGTH TO ZERO 48380020 LA REGWORKA,1 SET UP TO REQUEST 1 CHARACTER 48400020 STH REGWORKA,WKASRCNT AT A TIME 48420020 * 48440020 CKRUPDCS UPDSC UPDATE SOURCE POINTER 48460020 * AND REQUEST NEXT CHAR.(MAY BE BLANK) 48480020 BAL REGLRETN,CKRGTANY FROM SOURCE 48500020 * 48520020 CLI WKASCHRS,CKRSGLQT IS CHARACTER A SINGLE QUOTE 48540020 BE CKRFDQTE YES 48560020 TM WKASNDSW,EXCNSEND NO, IS SOURCE EXHAUSTED 48580020 BO CKRQTMIS IF SO,ERROR--CLOSING QUOTE MISSING 48600020 CKRCTSTR C REGCHRCT,CKRF255 NO, IS COUNT ALREADY UP TO 255 48620020 BNL CKRLNGCS IF SO,ERROR-CHAR.STRING TOO LONG 48640020 LA REGCHRCT,1(0,REGCHRCT) NO, INCREMENT STRING COUNT BY 1 48660020 B CKRUPDCS AND REQUEST NEXT CHARACTER 48680020 * 48700020 CKRFDQTE UPDSC UPDATE SOURCE POINTER 48720020 * AND REQUEST NEXT CHARACTER 48740020 BAL REGLRETN,CKRGTANY (MAY BE BLANK) FROM SOURCE 48760020 * 48780020 CLI WKASCHRS,CKRSGLQT IS IT ANOTHER SINGLE QUOTE 48800020 BE CKRCTSTR YES, GO COUNT 2 QUOTES AS 1 CHAR(') 48820020 * 48840020 LTR REGCHRCT,REGCHRCT NO,END OF STRING, ANY CHARS. 48860020 BNZ CKRINTRP YES, GO INTERPRET NEXT OPERATOR 48880020 * 48900020 MVI WKAERRCD,CKREMTCC NO, DIAGNOSE LITERAL WITHOUT CHARS 48920020 B CKRREINT BEFORE INTERPRETING NEXT OP-CODE 48940020 * 48960020 CKRQTMIS MVI WKAERRCD,CKRQTMST SET UP ERROR MSG FOR CLOSING ' MISSG 48980020 B CKRTMRET AND ISSUE TERMINAL ERROR MESSAGE 49000020 * 49020020 CKRLNGCS MVI WKAERRCD,CKRLGCST SET UP ERROR MSG FOR LONG CHAR. STRG 49040020 B CKRTMRET AND ISSUE TERMINAL ERROR MESSAGE 49060020 * 49080020 * 49100020 * 49120020 *********************************************************************** 49140020 * * 49160020 * THE FOLLOWING ROUTINES, CKRQUOTE AND CKRNOTQT, TEST THE * 49180020 * SOURCE FOR THE PRESENCE OR ABSENCE, RESPECTIVELY, OF THE * 49200020 * LITERAL CITED. * 49220020 * IN EITHER TEST, HOWEVER, IF THE LITERAL IS MATCHED, THE * 49240020 * SOURCE POINTER IS UPDATED BEYOND IT. * 49260020 * * 49280020 * * 49300020 *********************************************************************** 49320020 * 49340020 CKRQUOTE OI WKASWTCH,CKRMATCH INDICATE LITERAL MATCH REQUIRED 49360020 B CKRQTCOM AND BR TO COMMON PROCESSING 49380020 CKRNOTQT NI WKASWTCH,255-CKRMATCH INDICATE NON-MATCH REQUIRED 49400020 * 49420020 CKRQTCOM LA REGCHRCT,0 49440020 IC REGCHRCT,DEFFIELD(REGDEFPT) GET LENGTH OF LITERAL 49460020 STH REGCHRCT,WKASRCNT AND USE AS LENGTH OF REQUEST 49480020 AIF ('&ITNLDBG' EQ '').NOSZCK 49500020 LTR REGCHRCT,REGCHRCT (BE SURE LENGTH 49520020 BZ CKRBDLTS IS IN ALLOWABLE RANGE) 49540020 CLI WKASRCNT+1,WKASCMAX 49560020 BH CKRBDLTS (OTHERWISE INDICATE MALFUNCTN) 49580020 .NOSZCK ANOP 49600020 BAL REGLRETN,CKRGTNBS FOR NON-BLANK SOURCE CHARS 49620020 LA REGWORKB,DEFARGUM(REGDEFPT) GET POINTER TO LITERAL 49640020 LA REGDEFPT,1(REGCHRCT,REGDEFPT) UD DEFN POINTER PAST LITRL 49660020 BCTR REGCHRCT,0 DECR. LENGTH BY 1 FOR EX INSTRUCTION 49680020 EX REGCHRCT,CKRCOMPR COMARE LITERAL TO SOURCE CHARS OBTND 49700020 BNE CKRNOMAT NOT A MATCH 49720020 * 49740020 UPDSC MATCH, UPDATE SOURCE POINTER 49760020 * 49780020 TM WKASWTCH,CKRMATCH IS A MATCH WHAT IS REQUIRED 49800020 BO CKRINTRP YES, TEST IS SUCCESSFUL 49820020 B CKRFAIL NO, FAIL 49840020 * 49860020 CKRNOMAT TM WKASWTCH,CKRMATCH NOT MATCHED, IS A MATCH REQUIRED 49880020 BZ CKRINTRP NO, TEST IS SUCCESSFUL 49900020 B CKRFAIL YES, FAIL 49920020 * 49940020 * 49960020 * 49980020 *********************************************************************** 50000020 * * 50020020 * THE FOLLOWING ROUTINES, CKRSCAN AND CKRSCANF, SCAN THE * 50040020 * REMAINDER OF THE SOURCE FOR THE PRESENCE OR ABSENCE, * 50060020 * RESPECTIVELY, OF THE GIVEN CHARACTER. * 50080020 * * 50100020 * * 50120020 CKRLNQLK DC A(CKRQUALL) LENGTH OF QUALIFICATION 50140020 *********************************************************************** 50160020 * 50180020 CKRSCAN OI WKASWTCH,CKRMATCH INDICATE THAT FIND IS REQUIRED 50200020 B CKRSCANB AND BR TO COMMON PROCESSING 50220020 * 50240020 CKRSCANF NI WKASWTCH,255-CKRMATCH FIND NOT REQUIRED 50260020 CKRSCANB IC REGWORKA,DEFFIELD(REGDEFPT) OBTAIN GIVEN CHAR. 50280020 STC REGWORKA,WKASRCHX 50300020 BAL REGLRETN,CKRSERCH SEARCH REMAINDER OF SOURCE FOR MATCH 50320020 LA REGDEFPT,1(0,REGDEFPT) TO IT, THEN UPDATE DEF'N PT 50340020 TM WKASNDSW,EXCNSEND WAS MATCH FOUND BEFORE END OF SOURCE 50360020 BO CKRNOMAT NO 50380020 TM WKASWTCH,CKRMATCH YES, IS FIND REQUIRED 50400020 BO CKRINTRP YES, TEST IS SUCCESSFUL 50420020 B CKRFAIL NO, FAIL 50440020 * 50460020 * 50480020 *********************************************************************** 50500020 * 50520020 * * 50540020 * THE FOLLOWING ROUTINE INVOKES SOME ACTION CODE SUBROUTINE * 50560020 * TO PERFORM A SPECIAL-PURPOSE TEST OR OTHER TASK. * 50580020 * * 50600020 * * 50620020 *********************************************************************** 50640020 * 50660020 CKRACTN LA REGTDFPT,DEFFIELD(REGDEFPT) OBTAIN LOC IN DEFN TBL 50680020 LA REGDEFPT,1(0,REGDEFPT) INCR DEFN. PT PAST ACTION CODE 50700020 B CKRACTNB AND BR TO COMMON PROCESSING 50720020 CKRACTNT EQU * 50740020 LA REGDEFPT,2(0,REGDEFPT) INCR. DEFN. PT PAST TABLE REF 50760020 * TO POINT TO NEXT OPERATOR 50780020 CKRACTNB EQU * 50800020 MVI WKAERRCD,0 ZERO ERROR CODE 50820020 * 50840020 * 50860020 *********************************************************************** 50880020 * * 50900020 * THE FOLLOWING SECTION DETERMINES THE ROUTINE ASSOCIATED * 50920020 * WITH THE GIVEN ACTION CODE. * 50940020 * * 50960020 * AN INVALID ACTION CODE IS DETECTED. * 50980020 * * 51000020 * * 51020020 *********************************************************************** 51040020 IC REGOPCDE,0(REGTDFPT) OBTAIN ACTION CODE 51060020 AIF ('&ITNLDBG' EQ '').NOACCHK 51080020 CH REGOPCDE,CKRINVAC IS ACTION CODE VALID 51100020 BNL CKRACFAL INDICATE AN INVALID ACTION CODE 51120020 .NOACCHK ANOP 51140020 * WILL HALT ON LH IF NOT AN EVEN NO. 51160020 LH REGOPNDX,CKRACNDX(REGOPCDE) ACTION CODE INDEXES B TBL 51180020 B CKRACTN(REGOPNDX) BRANCH TO APPROP. ACTION RTNE 51200020 * 51220020 * 51240020 * 51260020 *********************************************************************** 51280020 * * 51300020 * THE FOLLOWING ROUTINES, 100 SERIES, PERFORM TESTS * 51320020 * ASSOCIATED WITH THE OUTCOME OF A PRIOR K OPERATOR * 51340020 * CHECK TO DETERMINE THE CHARACTERISTICS OF A NUMBER. * 51360020 * * 51380020 * * 51400020 *********************************************************************** 51420020 * 51440020 * 100 100, TEST FOR NON-ZERO INTEGER 51460020 CKRAR100 TM WKAKSWCH,CKRKFAIL 51480020 BO CKRACTRT IF SW SETTINGS INVALID,RETURN IMMED 51500020 * 51520020 TM WKAKSWCH,CKRKTYPI+CKRKVALU IF TYPE=INTEG,VALUE NONZRO 51540020 BO CKRACTRT OK 51560020 * 51580020 MVI WKAERRCD,CKRNZIRC OTHERWISE,SET ERR.MSG CODE 51600020 B CKRACTRT BEFORE RETURNING 51620020 * 51640020 * 51660020 * 51680020 * 101 101, TEST FOR NON-ZERO 51700020 CKRAR101 TM WKAKSWCH,CKRKFAIL 51720020 BO CKRACTRT IF SW SETTINGS INVALID,RETURN IMMED 51740020 TM WKAKSWCH,CKRKVALU 51760020 BO CKRACTRT IF NON-ZERO, OK 51780020 MVI WKAERRCD,CKRNZRQC OTHERWISE, SET ERROR MESSAGE CODE 51800020 B CKRACTRT BEFORE RETURNING 51820020 * 51840020 * 51860020 * 51880020 * 102 51900020 CKRAR102 TM WKAKSWCH,CKRKTYPI 102, TEST FOR INTEGER 51920020 BO CKRACTRT OK (IF A NUMBER) 51940020 MVI WKAERRCD,CKRINTRC NUMBER NOT INTEGER,SET ERR MSG CODE 51960020 B CKRACTRT BEFORE RETURNING 51980020 * 52000020 * 52020020 * 52040020 * 103 103, 52060020 CKRAR103 EQU * 52080020 MVC WKASVKSW,WKAKSWCH SAVE K OPERATOR SWITCHES 52100020 B CKRACTRT (OF REAL PORTION OF COMPLEX NUMBER) 52120020 * 52140020 * 52160020 * 52180020 * 104 104, 52200020 CKRAR104 TM WKAKSWCH,CKRKFAIL COMPLEX NUMBER TEST 52220020 BO CKRACTRT RETURN IMMED.IF NOT A NUMBER 52240020 * 52260020 TM WKAKSWCH,CKRKTYPI BE SURE BOTH PORTIONS ARE REAL, 52280020 BO CKRABDCX RATHER THAN INTEGERS 52300020 TM WKASVKSW,CKRKTYPI 52320020 BO CKRABDCX (OTHERWISE DIAGNOSE) 52340020 * 52360020 TM WKAKSWCH,CKRKLEND BE SURE BOTH PORTIONS HAVE THE SAME 52380020 BO CKRATLND LENGTH ATTRIBUTE 52400020 TM WKASVKSW,CKRKLEND 52420020 BZ CKRACTRT BOTH REAL, LENGTH 4, OK 52440020 CKRABDCX MVI WKAERRCD,CKRICPXC LENGTHS INCOMPATIBLE,SET ERR MSG CD 52460020 B CKRACTRT BEFORE RETURNING 52480020 * 52500020 CKRATLND TM WKASVKSW,CKRKLEND 52520020 BO CKRACTRT BOTH REAL, LENGTH 8, OK 52540020 B CKRABDCX LENGTHS INCOMPATIBLE 52560020 * 52580020 * 52600020 * 52620020 * 105 105, 52640020 CKRAR105 TM WKAKSWCH,CKRKFAIL TEST FOR DATA SET REFERENCE NO. FORM 52660020 BO CKRACTRT IF NOT A NUMBER, RETURN IMMEDIATELY 52680020 * 52700020 TM WKAKSWCH,CKRKTYPI+CKRKVALU MUST BE A NONZERO INTEGER, 52720020 BNO CKRABDSN 52740020 LA REGWORKB,2 52760020 C REGWORKB,WKADGTCT 52780020 BNL CKRACTRT NO MORE THAN 2 DIGITS LONG 52800020 * 52820020 CKRABDSN MVI WKAERRCD,CKRIDSNC OTHERWISE,SET ERR MSG CODE 52840020 B CKRACTRT BEFORE RETURNING 52860020 * 52880020 * 52900020 * 52920020 * 106 106, TEST FOR REAL NUMBER 52940020 CKRAR106 EQU * 52960020 TM WKAKSWCH,CKRKFAIL IF NOT A NUMBER, 52980020 BO CKRACTRT RETURN IMMEDIATELY 53000020 * 53020020 TM WKAKSWCH,CKRKTYPI 53040020 BZ CKRACTRT IF REAL RATHER THAN INTEGER, OK 53060020 MVI WKAERRCD,CKRRLRQC OTHERWISE, SET ERROR MESSAGE CODE 53080020 B CKRACTRT BEFORE RETURNING 53100020 * 53120020 * 53140020 * 53160020 *********************************************************************** 53180020 * * 53200020 * THE FOLLOWING ROUTINES, 200 SERIES, TEST THE ITERATION * 53220020 * COUNT TO DETERMINE WHETHER TOO MANY SUBSCRIPTS MAY HAVE * 53240020 * BEEN WRITTEN. * 53260020 * * 53280020 * * 53300020 *********************************************************************** 53320020 * 53340020 * 200 53360020 CKRAR200 EQU * 53380020 * 200,CHECK FOR POSS.TOO MANY PRECEDG 53400020 CLI WKALEVEL,WKALEVLE TEST LEVEL 53420020 BE CKRAEPSM BR IF LEVEL E 53440020 CLI WKASVICT,6 IS ITER. COUNT GREATER THAN 6 53460020 CKRATPXS BNH CKRACTRT NO, OK 53480020 CKRAPXSB MVI WKAERRCD,CKRPXSBC POSSIBLY TOO MANY, SET ERR MSG CODE 53500020 CKRASERP SVERP , AND ERROR POINTER 53520020 B CKRACTRT BEFORE RETURNING 53540020 * 53560020 CKRAEPSM CLI WKASVICT,2 E, IS ITER. COUNT GREATER THAN 2 53580020 B CKRATPXS BR TO TEST 53600020 * 53620020 * 53640020 * 53660020 * 201 53680020 CKRAR201 EQU * 201, CHECK FOR TOO MANY SUBS. NOW 53700020 CLI WKALEVEL,WKALEVLE TEST LEVEL 53720020 BE CKRAENWM BR IF LEVEL E 53740020 CLI WKAQICNT,6 WERE THERE EXACTLY 6 ITER'NS ALREADY 53760020 CKRATXSN BNE CKRACTRT NO, DON'T ISSUE A DIAGNOSTIC 53780020 CKRAEXSB MVI WKAERRCD,CKREXSBC TOO MANY, SET ERROR MESSAGE CODE 53800020 B CKRASERP AND POINTER 53820020 * 53840020 CKRAENWM CLI WKAQICNT,2 WERE THERE EXACTLY 2 ITER'NS ALREADY 53860020 B CKRATXSN BR TO TEST 53880020 * 53900020 * 53920020 * 53940020 * 202 53960020 CKRAR202 EQU * 53980020 * 202, CHECK FOR TOO MANY SUBS PRECEDG 54000020 CLI WKALEVEL,WKALEVLE TEST LEVEL 54020020 BE CKRAEMPR BR IF LEVEL E 54040020 CLI WKASVICT,6 IS ITER. COUNT GREATER THAN 6 54060020 CKRATXSP BNH CKRACTRT NO, OK 54080020 MVI WKAERRCD,CKRXSBPC TOO MANY PRECEDING,SET ERR.MSG CODE 54100020 B CKRASERP AND POINTER 54120020 * 54140020 CKRAEMPR CLI WKASVICT,2 E, IS ITER. COUNT GREATER THAN 2 54160020 B CKRATXSP BR TO TEST 54180020 CKRAR203 EQU * 54200020 * 54220020 * 54240020 * 54260020 *********************************************************************** 54280020 * * 54300020 * THE FOLLOWING TWO ROUTINES TEST THE LABEL FIELD OF * 54320020 * END AND FORMAT STATEMENTS. * 54340020 * * 54360020 * * 54380020 *********************************************************************** 54400020 * 54420020 * 300 300,BE SURE ONLY 'END' APPEARS ON CD 54440020 CKRAR300 EQU * 54460020 CKRATLDC TM WKASNOSW,EXCNSTNO TEST FOR STATEMENT NUMBER 54480020 BO CKRAIEND ILLEGALLY ON 'END' CARD 54500020 * NO STATEMENT NUMBER 54520020 CLI WKACNCOL,C' ' BE SURE THAT CONTINUATION COLUMN IS 54540020 BE CKRAFEND BLANK (END MAY NOT EXCEED 1 CARD) 54560020 * 54580020 CKRAIEND MVI WKAERRCD,CKRIENDT SET ERROR MSG CODE FOR END STATEMENT 54600020 B CKRABGEP ERROR APPLIES TO ENTIRE STMNT 54601020 CKRAFEND EQU * 54602020 L R3,WKAOPTPT 54603020 USING IPDSNOPT,R3 54604020 TM OPTBYTE3,EXCFRFRM IS SOURCE FREE-FORM 54605020 DROP R3 54606020 BNO CKRACTRT NO. RETURN 54607020 L R3,WKAENDST R3 = ADDR OF D OF END 54608020 LA R2,WKACHRST R2 = ADDR OF BEGNG OF CHAR STRING 54609020 SR R3,R2 R3 = COLUMN NO. - 1 54610020 C R3,CKRF66 IS D OF END PAST COL 66 54611020 BL CKRACTRT NO. RETURN 54612020 MVI WKAERRCD,CKRIENDF SET ERROR MSG CODE FOR END STMNT 54613020 * SINCE ERROR APPLIES TO ENTIRE STATM, 54620020 CKRABGEP L REGWORKA,WKABEGSC SET ERROR SOURCE POINTER 54640020 ST REGWORKA,WKAERRSC TO BEGINNING OF STATEMENT 54660020 B CKRACTRT RETURN 54680020 * 54700020 * 54720020 * 54740020 * 301 301, 54760020 CKRAR301 TM WKASNOSW,EXCNSTNO CHECK THAT FORMAT STATM. IS LABELLED 54780020 BO CKRACTRT WITH A STATEMENT NUMBER 54800020 MVI WKAERRCD,CKRMSNOC OTHERWISE,SET ERROR MESSAGE CODE 54820020 B CKRABGEP (AND ERROR SOURCE PT) BEFORE RETN 54840020 * 54860020 * 54880020 * 54900020 *********************************************************************** 54920020 * * 54940020 * THE FOLLOWING ROUTINES, 400 SERIES, CHECK LEVEL OF FORTRAN-- * 54960020 * 400. DEBUG SUPPORTED BY G, G1, AND CODE-AND-GO. * 54980020 * 401. LIST-DIRECTED I/O SUPPORTED BY G1 AND CODE-AND-GO. * 55000020 * * 55020020 * * 55040020 *********************************************************************** 55060020 * 55080020 CKRAR400 EQU * CHECK FOR DEBUG SUPPORT 55100020 * 55120020 CLI WKALEVEL,WKALEVLG DEBUG SUPPORTED IF LEVEL IS 55140020 BNL CKRACTRT G, G1, OR CODE-AND-GO 55160020 * 55180020 MVI WKAERRCD,CKRNODBT NO,SET ERROR MSG CODE--DEBUG NOT 55200020 * SUPPORTED 55220020 B CKRABGEP AND POINT TO BEGIN. OF STATEMENT 55240020 * 55260020 * 55280020 * 55300020 * 401 401, 55320020 CKRAR401 EQU * CHECK FOR LIST-DIRECTED I/O SUPPORT 55340020 * 55360020 CLI WKALEVEL,WKALEVLG LIST-DIRECTED I/O SUPPORTED IF 55380020 BH CKRACTRT LEVEL IS G1 OR CODE-AND-GO 55400020 * NO, 55420020 SVERP 55440020 MVI WKAERRCD,CKRLDILC SET ERROR MSG CODE--LIST-DIRECTED NG 55460020 B CKRACTRT 55480020 * 55500020 * 55520020 * 55540020 *********************************************************************** 55560020 * * 55580020 * THE FOLLOWING ROUTINE CHECKS THE IMPLICIT RANGE * 55600020 * SPECIFICATION FOR L ( '-' / HIGHER L ), I.E.,LETTER(ALPHA- * 55620020 * BETIC) OPTIONALLY FOLLOWED BY HYPHEN HIGHER LETTER. * 55640020 * * 55660020 * * 55680020 *********************************************************************** 55700020 * 55720020 * 500 500, 55740020 CKRAR500 EQU * TEST RANGE OF IMPLICIT STATEMENT 55760020 * 55780020 GTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 55800020 SVERP REGWORKA SET POSSIBLE ERROR POINTER 55820020 * IS FIRST RANGE CHARACTER ALPHABETIC 55840020 TSTAL CKRABDIM IF NOT, GO ISSUE AN ERROR MESSAGE 55860020 IC REGWORKA,WKASCHRS 55880020 STC REGWORKA,WKAIMPL1 SAVE LETTER, THEN 55900020 UPDSC UPDATE SOURCE POINTER BEYOND IT 55920020 * 55940020 GTNB1 GET POSSIBLE HYPHEN 55960020 CLI WKASCHRS,CKRHYPHN 55980020 BNE CKRACTRT IF LETTER NOT FOLLOWED BY HYPHEN, OK 56000020 * OTHERWISE, HYPHEN MUST BE FOLLOWED 56020020 * BY A HIGHER LETTER 56040020 * 56060020 CLI WKAIMPL1,CKR$ IS L1 THE HIGHEST FORTRAN ALPHABETIC 56080020 BE CKRABDIM IF SO, GO ISSUE ERROR MESSAGE 56100020 * NO, 56120020 UPDSC UPDATE SOURCE POINTER 56140020 GTNB1 AND GET NEXT NON-BLANK SOURCE CHAR 56160020 CLC WKASCHRS(1),WKAIMPL1 IS L2 HIGHER THAN L1 56180020 BH CKRATLTR SHOULD BE A HIGHER LETTER 56200020 * (WHERE Z IS HIGHER THAN A) 56220020 CLI WKASCHRS,CKR$ 56240020 BE CKRAGDL2 OR $, DEFINED TO BE HIGHEST LETTER 56260020 * NO, 56280020 CKRABDIM MVI WKAERRCD,CKRINIMT SET ERROR CODE FOR INVALID RANGE 56300020 B CKRACTRT AND RETURN 56320020 * 56340020 CKRATLTR TSTAL CKRABDIM BE SURE L2 IS A LETTER 56360020 * OK, 56380020 CKRAGDL2 UPDSC UPDATE SOURCE POINTER BEYOND L2 56400020 B CKRACTRT AND RETURN 56420020 * 56440020 * 56460020 * 56480020 *********************************************************************** 56500020 * * 56520020 * THE FOLLOWING ROUTINES ARE USED IN THE CHECKING OF * 56540020 * I/O LISTS. * 56560020 * * 56580020 * 600-602 TO VERIFY THAT THE INDEX VARIABLE OF AN * 56600020 * IMPLIED DO IS NOT SUBSCRIPTED * 56620020 * * 56640020 * 603 TO LOOK AHEAD TO VERIFY THAT A ) CLOSES AN * 56660020 * IMPLIED DO. * 56680020 * * 56700020 * * 56720020 *********************************************************************** 56740020 * 56760020 * 600 600, INITIALIZE SUBSCRIPTING SWITCH OFF 56780020 CKRAR600 EQU * 56800020 NI WKASWTCH,255-CKRSUBSC 56820020 B CKRACTRT RETURN 56840020 * 56860020 * 56880020 * 56900020 * 601 601, SET SUBSCRIPTING SWITCH ON 56920020 CKRAR601 EQU * 56940020 OI WKASWTCH,CKRSUBSC 56960020 B CKRACTRT RETURN 56980020 * 57000020 * 57020020 * 57040020 * 602 602,ISSUE ERR MSG IF SUBSCR'G INDICD 57060020 CKRAR602 TM WKASWTCH,CKRSUBSC IS SUBSCRIPTING SW ON 57080020 BZ CKRACTRT NO,RETURN 57100020 * VARIABLE IS SUBSCRIPTED, 57120020 MVI WKAERRCD,CKRVRSBC SET UP ERROR MESSAGE AND 57140020 SVERP REGWORKA ERROR SOURCE POINTER 57160020 B CKRACTRT RETURN 57180020 * 57200020 * 57220020 * 57240020 * 603 603,LOOK AHEAD FOR RIGHT PARENTHESIS 57260020 CKRAR603 EQU * 57280020 GTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 57300020 CLI WKASCHRS,C')' IS IT A RIGHT PARENTHESIS 57320020 BE CKRACTRT YES,RETURN WITHOUT UP'ING SOURCE PT 57340020 * 57360020 MVI WKAERRCD,CKRRPRQT NO, SET ERROR MESSAGE CODE 57380020 SVERP REGWORKA AND POINTER TO SOURCE IN ERROR 57400020 B CKRACTRT RETURN 57420020 CKRAR604 EQU * 57440020 CKRAR605 EQU * 57460020 CKRAR606 EQU * 57480020 CKRAR607 EQU * 57500020 CKRAR608 EQU * 57520020 CKRAR609 EQU * 57540020 CKRAR610 EQU * 57560020 CKRAR611 EQU * 57580020 CKRAR612 EQU * 57600020 CKRAR613 EQU * 57620020 * 57640020 * 57660020 * 57680020 *********************************************************************** 57700020 * * 57720020 * THE FOLLOWING ROUTINES (700 SERIES) CHECK WIDTH AND * 57740020 * DECIMAL PLACES SPECIFICATIONS. * 57760020 * * 57780020 * * 57800020 *********************************************************************** 57820020 * 57840020 * 700 700, CHECK WIDTH SPECIFICATION 57860020 CKRAR700 EQU * 57880020 GTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 57900020 CLI WKASCHRS,CKR0 57920020 BL CKRAFALS IF NOT A DIGIT, FAIL 57940020 CLI WKASCHRS,CKR9 57960020 BH CKRAFALS IF NOT A DIGIT, FAIL 57980020 * DIGIT, EVALUATE THE WIDTH 58000020 BAL REGLRETN,CKREVALU RETURNED IN WKAVALUE & REGCHRCT 58020020 C REGCHRCT,CKRF255 58040020 BH CKRAHIWD BR IF WIDTH GREATER THAN 255 58060020 ST REGCHRCT,WKAWIDTH SAVE THE WIDTH SPECIFICATION 58080020 LTR REGCHRCT,REGCHRCT 58100020 BNZ CKRACTRT GOOD WIDTH 58120020 B CKRABDWD 0 WIDTH, INVALID 58140020 * 58160020 CKRAHIWD MVC WKAWIDTH,CKRF255 WIDTH GREATER THAN 255,SET IT TO 255 58180020 * AND 58200020 CKRABDWD MVI WKAERRCD,CKRINVWC SET ERROR MESSAGE CODE (ERROR.PT 58220020 * SET BY CKREVALU) 58240020 B CKRACTRT BEFORE RETURNING 58260020 * 58280020 * 58300020 * 58320020 * 701 701,CHECK DECIMAL PLACES SPECIFICATN 58340020 CKRAR701 GTNB1 GET NEXT NON-BLANK SOURCE CHARACTER 58360020 CLI WKASCHRS,CKR0 58380020 BL CKRADCPU IF 1ST CHAR. IS NOT A DIGIT, 58400020 CLI WKASCHRS,CKR9 GO ISSUE 58420020 BH CKRADCPU AN ERROR MESSAGE 58440020 * DIGIT, EVALUATE THE DEC.PLACES SPECN 58460020 BAL REGLRETN,CKREVALU (VALUE RETD IN WKAVALUE & REGCHRCT) 58480020 C REGCHRCT,WKAWIDTH 58500020 BNH CKRACTRT BE SURE DEC.PLACES LT OR EQ WIDTH 58520020 MVI WKAERRCD,CKRDCXWC OTHERWISE, SET ERROR CODE (PT TO D) 58540020 B CKRACTRT BEFORE RETURNING 58560020 * 58580020 CKRADCPU MVI WKAERRCD,CKRDCPUC ERROR CODE--DEC.PLACES MUST BE SPECD 58600020 SVERP REGWORKA SET ERROR POINTER TO CURR SOURCE LOC 58620020 B CKRACTRT THEN RETURN 58640020 * 58660020 * 58680020 * 58700020 *********************************************************************** 58720020 * * 58740020 * THE FOLLOWING SUBROUTINE EVALUATES CONTINUOUS DIGITS IN * 58760020 * THE SOURCE TO COMPUTE A VALUE IN WKAVALUE AND REGCHRCT. * 58780020 * THE NUMBER OF CONTINUOUS DIGITS IS LEFT IN WKACNTDG. * 58800020 * * 58820020 * THE LEFTMOST DIGIT IS IN WKASCHRS (FOLLOWING GTNB1) * 58840020 * WHEN THIS ROUTINE IS CALLED. * 58860020 * * 58880020 * * 58900020 *********************************************************************** 58920020 * 58940020 CKREVALU ST REGLRETN,WKASVRTN SAVE RETURN REGISTER 58960020 * 58980020 SVERP REGWORKA SAVE POSSIBLE ERROR POINTER 59000020 * 59020020 IC REGCHRCT,WKASCHRS INITLZ, VALUE= VALUE OF SOURCE DIGIT 59040020 N REGCHRCT,=F'15' 59060020 * 59080020 LA REGWORKB,1 INITIALIZE NO. OF CONTIN. DIGITS = 1 59100020 CKRNXTDG STH REGWORKB,WKACNTDG (INCLUDE LEADING ZEROES) 59120020 * 59140020 UPDSC UPDATE SOURCE POINTER 59160020 * 59180020 GTNB1 REQUEST NEXT NON-BLANK CHARACTER 59200020 * 59220020 CLI WKASCHRS,CKR0 IS NEW CHARACTER A DIGIT 59240020 BL CKRVALRT IF NOT, VALUE HAS BEEN COMPUTED 59260020 CLI WKASCHRS,CKR9 59280020 BH CKRVALRT 59300020 * 59320020 C REGCHRCT,CKRF100M IF VALUE EXCEEDS 100,000,000 59340020 BH CKRUPDCT STOP COMPUTING TO AVOID OVERFLOW 59360020 * (MAX.VALUE COMPUTED=1,000,000,009) 59380020 * 59400020 LA REG1,10 10 TIMES VALUE 59420020 MR REG0,REGCHRCT INTO REG 1 59440020 * 59460020 IC REGCHRCT,WKASCHRS NEW DIGIT 59480020 N REGCHRCT,=F'15' PLUS 59500020 AR REGCHRCT,REG1 REG 1,YIELDS NEW VALUE 59520020 * 59540020 CKRUPDCT LH REGWORKB,WKACNTDG 59560020 LA REGWORKB,1(0,REGWORKB) INCREMENT NO. OF DIGITS BY 1 59580020 * 59600020 B CKRNXTDG GO LOOK FOR ANOTHER DIGIT 59620020 * 59640020 CKRVALRT EQU * 59660020 ST REGCHRCT,WKAVALUE SAVE VALUE 59680020 L REGLRETN,WKASVRTN RESTORE RETURN REGISTER 59700020 BR REGLRETN AND GO BACK TO CALLER 59720020 * 59740020 * 59760020 * 59780020 *********************************************************************** 59800020 * * 59820020 * THE FOLLOWING ROUTINE CHECKS FOR END OF SOURCE, IE, * 59840020 * NO REMAINING NON-BLANK CHARACTERS IN SOURCE. * 59860020 * * 59880020 * * 59900020 *********************************************************************** 59920020 * 59940020 * 800 800, CHECK FOR END OF SOURCE 59960020 CKRAR800 EQU * 59980020 CLI WKASCHRS,WKASPCHR 60000020 BE CKRACTRT IF 60020020 GTNB1 60040020 TM WKASNDSW,EXCNSEND 60060020 BO CKRACTRT NO REMAINING NON-BLANK CHARS, GOOD 60080020 B CKRAFALS OTHERWISE, INDICATE FAILURE 60100020 * 60120020 * 60140020 * 60160020 *********************************************************************** 60180020 * * 60200020 * * 60220020 * THE FOLLOWING ROUTINE UNCONDITIONALLY FAILS * 60240020 * * 60260020 * * 60280020 *********************************************************************** 60300020 * 60320020 * 60340020 * 801 801, FAIL 60360020 CKRAR801 EQU * 60380020 CKRAFALS OI WKAFALSW,CKRFALSW INDICATE FAILURE 60400020 * 60420020 * 60440020 * 60460020 CKRACTRT EQU * 60480020 * 60500020 TM WKAFALSW,CKRFALSW DID ACTION ROUTINE TEST FAIL 60520020 BO CKRFAIL YES, FAIL 60540020 CLI WKAERRCD,0 NO, ANY (ERROR) MSG TO ISSUE 60560020 BE CKRTSNOP NO 60580020 TM WKAQSWCH,CKRCMTSW YES, IS THIS OPTION COMMITTED 60600020 BO CKRREINT YES, GO ISSUE ERROR MESSAGE 60620020 B CKRFAIL NO, JUST FAIL 60640020 CKRTSNOP CLI WKASFAIL,0 WAS ACTION RTNE OPERATIONAL 60660020 BE CKRINTRP YES, ACTION RTNE SUCCEEDED 60680020 B CKRERRET NO, SAVE REGS TO DEBUG 60700020 * 60720020 * * 60740020 *********************************************************************** 60760020 * * 60780020 * THE FOLLOWING ROUTINE PLACES AN ERROR MESSAGE CODE FROM * 60800020 * THE DEFINITION INTO THE CURRENT LINE NEST. * 60820020 * * 60840020 * * 60860020 *********************************************************************** 60880020 * 60900020 CKRMESSG EQU * 60920020 IC REGWORKB,DEFFIELD(REGDEFPT) MOVE MESSAGE CODE 60940020 STC REGWORKB,WKANFMSG TO CURRENT LINE NEST 60960020 * 60980020 LA REGDEFPT,1(0,REGDEFPT) UPDATE DEF'N TABLE POINTER 61000020 * 61020020 B CKRINTRP AND GO INTERPRET NEXT OP. 61040020 * 61060020 * 61080020 * 61100020 *********************************************************************** 61120020 * * 61140020 * THE FOLLOWING ROUTINE LOOKS UP THE SOURCE IN A TABLE OF * 61160020 * LITERALS. * 61180020 * * 61200020 * IF THE OPERATOR IS +TABLENAME, AND A TABLE ARGUMENT IS * 61220020 * MATCHED, THE OPERATOR FUNCTION OF THAT ARGUMENT IS * 61240020 * LINKED TO. * 61260020 * * 61280020 * IF THE OPERATOR IS -TABLENAME, THE TEST FAILS IF A MATCHING * 61300020 * ARGUMENT IS FOUND. * 61320020 * * 61340020 * * 61360020 *********************************************************************** 61380020 * 61400020 CKRTABL LA REGTDFPT,DEFFIELD(REGDEFPT) OBTAIN LOC IN DEFN TBL 61420020 CKRTABLT BCTR REGTDFPT,0 GET TABLE OP-CODE 61440020 IC REGWORKA,0(REGTDFPT) (+ OR -) 61460020 STC REGWORKA,WKATBLOP AND SAVE IT FOR LATER TESTING 61480020 * 61500020 MVC WKATEMPH(2),1(REGTDFPT) POINT TO ACTUAL 61520020 LH REGTDFPT,WKATEMPH TABLE OF LITERALS 61540020 LA REGTDFPT,DEFFIELD(REGTDFPT) 61560020 * 61580020 STM REGNSTPT,REGQALPT,WKASAVNQ (SAVE REGS N AND Q) 61600020 * 61620020 LR REGWORKQ,REGTDFPT OBTAIN POINTER Q 61640020 MVC WKATEMPH,1(REGWORKQ) BEYOND LAST TABLE ENTRY 61660020 AH REGWORKQ,WKATEMPH FOR TABLE END TESTING 61680020 * 61700020 LA REGWORKN,0 AND USE IT TO GET LENGTH N 61720020 IC REGWORKN,0(REGWORKQ) OF LONGEST LITERAL 61740020 AIF ('&ITNLDBG' EQ '').NOMXATS 61760020 CLI 0(REGWORKQ),WKASCMAX BE SURE THAT LENGTH NOT 61780020 BH CKRLGLLS GT MAX.ALLOWABLE CHAR REQUEST 61800020 CLI 0(REGWORKQ),0 OR ZERO 61820020 BE CKRLGLLS (OTHERWISE INDIC. MALFUNCTION) 61840020 .NOMXATS ANOP 61860020 LA REGTDFPT,3(0,REGTDFPT) POINT TO FIRST TABLE ENTRY 61880020 * 61900020 STH REGWORKN,WKASRCNT REQUEST N (LONGEST-LIT'RL-SIZE) 61920020 BAL REGLRETN,CKRGTNBS NON-BLANK CHARS. FROM SOURCE 61940020 * 61960020 CKRTTBND CR REGTDFPT,REGWORKQ IS TABLE OF LITERALS EXHAUSTED 61980020 BNL CKRTBEND YES 62000020 * 62020020 * NO, 62040020 IC REGWORKN,0(0,REGTDFPT) OBTAIN ACTUAL SIZE OF ARGUM 62060020 BCTR REGWORKN,0 (DECR. IT BY 1 FOR EX INSTR.) 62080020 EX REGWORKN,CKRTCMPR COMPAR.ARGUMENT TO SOURCE CHARS 62100020 * DO THEY MATCH 62120020 BE CKRTBMAT YES 62140020 LA REGTDFPT,5(REGWORKN,REGTDFPT) NO, INCR. TABLE POINTER 62160020 B CKRTTBND AND GO COMPARE NEXT ARG 62180020 * 62200020 CKRTBMAT EQU * SOURCE MATCH TO TABLE ARGUMENT 62220020 LA REGWORKN,1(REGWORKN) RESTORE ARGUMENT SIZE 62240020 CH REGWORKN,WKAMVCNT IF ARGUMENT MATCHED WAS SHORTER THAN 62260020 BNL CKRTBUPS LENGTH OF SOURCE OBTAINED, 62280020 STH REGWORKN,WKASRCNT RE-OBTAIN LENGTH-OF-ARG CHARACTERS 62300020 BAL REGLRETN,CKRGTNBS FROM SOURCE AND THEN 62320020 * 62340020 CKRTBUPS UPDSC UPDATE SOURCE POINTER 62360020 LA REGWORKB,1(REGWORKN,REGTDFPT) OBTAIN LOC OF ARG FUNC OP 62380020 LA REGTDFPT,2(REGWORKN,REGTDFPT) SET SPEC.DEF.PT IMM BYD OP 62400020 LM REGNSTPT,REGQALPT,WKASAVNQ (RESTORE REGS N AND Q) 62420020 CLI WKATBLOP,CKRPLTBL IS OPERATOR +TABLENAME 62440020 BE CKRTFUNC YES, EXAMINE THE FUNCTION OP-CODE 62460020 * NO, 62480020 LA REGDEFPT,2(REGDEFPT) INCR DEFN TBL POINTER TO NEXT OPER. 62500020 B CKRFAIL AND FAIL ON ARGUMENT MATCH 62520020 * 62540020 CKRTFUNC EQU * 62560020 CLI 0(REGWORKB),CKRSYMLN 62580020 BE CKRSYNST NEST TO SYMBOLIC LINE 62600020 * 62620020 CLI 0(REGWORKB),CKRPLTBL 62640020 BE CKRTABLT SEARCH ANOTHER TABLE IF +TABLE 62660020 CLI 0(REGWORKB),CKRMITBL 62680020 BE CKRTABLT OR -TABLE 62700020 * 62720020 AIF ('&ITNLDBG' EQ '').NOTOPTS 62740020 CLI 0(REGWORKB),CKRACTON IS IT ACTION RTNE OP-CODE 62760020 BNE CKRTOPFL (INDICATE MALFUNC. IF NONE OF ABOVE) 62780020 .NOTOPTS ANOP 62800020 CLI 1(REGWORKB),X'FF' IS IT NULL 62820020 BNE CKRACTNT NO, INVOKE ACTION CODE ROUTINE 62840020 * 62860020 * NULL, 62880020 LA REGDEFPT,2(REGDEFPT) INCR DEFN TBL POINTER TO NEXT OPER. 62900020 B CKRINTRP AND GO INTERPRET NEXT OPERATOR 62920020 * 62940020 CKRTBEND EQU * EXHAUSTED TABLE WITHOUT FINDING A 62960020 LM REGNSTPT,REGQALPT,WKASAVNQ MATCH (RESTORE REGS N & Q) 62980020 LA REGDEFPT,2(REGDEFPT) INCR DEFN TBL POINTER TO NEXT OPER. 63000020 * 63020020 CLI WKATBLOP,CKRMITBL IS OPERATOR -TABLENAME 63040020 BE CKRINTRP IF SO, TEST IS SUCCESSFUL 63060020 B CKRFAIL NO, FAIL 63080020 * 63100020 * 63120020 * 63140020 *********************************************************************** 63160020 * * 63180020 * THE FOLLOWING ROUTINE PROCESSES THE END-OF-DEFINITION-LINE * 63200020 * OPERATOR. IF THE CURRENT LINE IS AT LEVEL 1, THE CHECKING * 63220020 * OF THE CURRENT STATEMENT IS TERMINATED NORMALLY. OTHERWISE, * 63240020 * THE LINE NEST LIST IS POPPED UP, AND CHECKING CONTINUES * 63260020 * AT THE POINT IN THE DEFINITION IMMEDIATELY FOLLOWING THE * 63280020 * SYMBOLIC-NAME OF THE LINE JUST ENDED. * 63300020 * * 63320020 * * 63340020 *********************************************************************** 63360020 * 63380020 CKRSYUNS EQU * UNNEST CURRENT LINE 63400020 * 63420020 CLI WKANLVLN,1 IS CURRENT LINE LEVEL 1 (TOP) 63440020 * 63460020 BNH CKRNMLND IF SO, NORMAL END OF STATMT CHECKNG 63480020 * 63500020 BAL REGLRETN,CKRUNEST NO, UNNEST THIS LINE TO CONTINUE 63520020 * CHECKING ON PREVIOUS LINE 63540020 B CKRINTRP AND GO INTERPRET THE NEXT OPERATOR 63560020 * 63580020 * 63600020 CKRNMLND EQU * 63620020 CLI WKACERSW,0 UNLESS PRIOR CKR-DETECTED ERROR 63640020 BE CKRTSEXS 63660020 * 400 400, 63680020 CKRNOMSG MVI WKACERSW,0 (IN WHICH CASE, TURN OFF SWITCH 63700020 B CKRNMLRT BEFORE NORMAL RETURN) 63720020 * CHECK THAT NO SOURCE FOLLOWS STATEM. 63740020 CKRTSEXS CLI WKASCHRS,WKASPCHR 63760020 BE CKRNMLRT IF SOURCE-END, NORMAL RETURN 63780020 GTNB1 63800020 TM WKASNDSW,EXCNSEND 63820020 BO CKRNMLRT IF SOURCE-END SW ON, NORMAL RETURN 63840020 * OTHERWISE, ISSUE EXCESS SOURCE 63860020 SVERP REGWORKA TERMINAL ERROR MESSAGE 63880020 MVI WKAERRCD,CKREXSCT 63900020 B CKRTMRET GO ISSUE ERROR MESSAGE 63920020 * 63940020 * 63960020 * 63980020 CKRUNEST EQU * POP UP NEST LIST 64000020 LH REGDEFPT,WKANDFBK RELOAD SYN DEFN POINTER TO NEXT 64020020 * ENTRY ON PREVIOUS LINE 64040020 * 64060020 S REGNSTPT,CKRLNNSK DECREMENT NEST LIST POINTER 64080020 * 64100020 AIF ('&ITNLDBG' NE 'E').NOUNSTS 64120020 C REGNSTPT,WKAADNLS (BE SURE POINTER IS STILL WITHIN 64140020 BL CKREXCUN BOUNDS OF NEST LIST) 64160020 * 64180020 .NOUNSTS ANOP 64200020 MVC WKALNEST,NLSLNEST AND POP UP NEST FROM LIST 64220020 * 64240020 BR REGLRETN THEN RETURN 64260020 * 64280020 * 64300020 * 64320020 *********************************************************************** 64340020 * * 64360020 * THE FOLLOWING ROUTINE RECEIVES CONTROL WHEN AN OPERATOR * 64380020 * ROUTINE DETECTS FAILURE. * 64400020 * 64420020 * IF THE DEFINITION IS COMMITTED TO THE FAILING PATH, ERROR * 64440020 * MESSAGE INFORMATION IS SET, REGISTERS ARE SAVED FOR * 64460020 * POSSIBLE RECALL, AND CONTROL IS RETURNED TO THE EXECUTIVE * 64480020 * FOR ISSUANCE OF THE ERROR MESSAGE. * 64500020 * * 64520020 * IF THE DEFINITION IS NOT COMMITTED AT THIS POINT, ANY * 64540020 * UNNESTING REQUIRED TO BRING THE LEVEL OF NESTING UP TO * 64560020 * THE QUALIFICATION LEVEL IS PERFORMED,AND CHECKING CONTINUES * 64580020 * BEYOND THE CURRENT ALTERNATIVE OR OPTION. * 64600020 * * 64620020 * * 64640020 *********************************************************************** 64660020 * 64680020 CKRFAIL EQU * OPERATOR FAILURE ROUTINE 64700020 * 64720020 OI WKAFALSW,CKRFALSW SET ON FAILURE INDICATOR (SWITCH) 64740020 * 64760020 TM WKAQSWCH,CKRCMTSW IS DEF'N COMMITTED TO THIS PATH 64780020 BZ CKRTRYNX NO 64800020 * YES, SET UP ERROR MESSAGE INFO 64820020 IC REGWORKB,WKANFMSG 64840020 STC REGWORKB,WKAERRCD GET ERROR MSG CODE FROM LINE NEST 64860020 L REGWORKB,WKASRCCR 64880020 ST REGWORKB,WKAERRSC SET ERROR POINTER TO LOC OF CURR SRC 64900020 * 64920020 CKRREINT LA REGLRETN,CKRINTRP IF RECALLED, WILL INTERP NEXT OPCODE 64940020 * 64960020 CKRTSTML CLI WKASCHRS,WKASPCHR IS RESTART CHAR. BEYOND SOURCE END 64980020 BNE CKRTSMSG NO,MAY BE ABLE TO CONTINUE CHECKING 65000020 OI WKAERRCD,WKAERRTM YES INDICATE THAT ERROR IS TERMINAL 65020020 CKRTSMSG EQU * 65040020 * 65060020 * IF MESSAGE INFORMATION IS UNIQUE,SAVE AND ISSUE ERR 65080020 * MESSAGE, OTHERWISE, DO NOT ISSUE MESSAGE AND 65100020 * CONTINUE UNLESS ERROR WAS TERMINAL 65120020 * 65140020 LA REGWORKA,WKAMSGTB BEGINNING OF MESSAGE TABLE 65160020 L REGWORKB,WKAMSGAD LOCATION FOR NEXT MESSAGE 65180020 MVC 0(1,REGWORKB),WKAERRCD SAVE MESSAGE INFO--ERROR CODE 65200020 NI 0(REGWORKB),255-WKAERRTM AS EVEN NO., FOLLOWED BY 65220020 MVC 1(3,REGWORKB),WKAERRSC+1 FAILING CHARACTER ADDRESS 65240020 CKRNXMSG CR REGWORKA,REGWORKB ANY (MORE) MESSAGES FOR COMPARISON 65260020 BNL CKRSVUPT (IF NOT,GO ISSUE UNIQUE MSG) 65280020 CLC 0(4,REGWORKB),0(REGWORKA) YES,IF IDENTICAL MESSAGE WAS 65300020 * ALREADY ISSUED 65320020 LA REGWORKA,4(0,REGWORKA) 65340020 BNE CKRNXMSG NO, SEE IF MORE MSGS FOR COMPARISON 65360020 TM WKAERRCD,WKAERRTM 65380020 BO CKRNOMSG QUIT IF ERROR WAS TERMINAL 65400020 * 65420020 NI WKAFALSW,255-CKRFALSW NON-TERMINAL, CONTINUE CHECKING 65440020 BR REGLRETN STATEMENT W/O RECORDING ERROR 65460020 * (SEE CKRCONTN) 65480020 * 65500020 CKRSVUPT LA REGWORKA,4(0,REGWORKA) 65520020 ST REGWORKA,WKAMSGAD UNIQUE MESSAGE, ISSUE IT 65540020 LA REGWORKC,WKAMGTND 65560020 CR REGWORKA,REGWORKC (IF MESSAGE TABLE IS FILLED, 65580020 BL CKRERRET BR IF TABLE NOT FILLED 65600020 OI WKAERRCD,WKAERRTM MESSAGE IS TERMINAL) 65620020 * 65640020 CKRTMRET EQU * 65660020 CKRERRET STM REG0,REG15,WKACKRGS SAVE REGISTERS IN CASE OF RECALL 65680020 * (OR FOR DEBUGGING) 65700020 OI WKACERSW,EXCNCKER SET ON CHECKER-DETECTED-ERROR SWITCH 65720020 * 65740020 CKRNMLRT L REG13,WKASVR13 RESTORE CALLER'S SAVE AREA REGISTER 65760020 RETURN (14,12),T AND REST OF CALLERS REGISTERS 65780020 * 65800020 * AND RETURN CONTROL TO CALLING 65820020 * PROGRAM (EXECUTIVE) 65840020 * 65860020 CKRTRYNX EQU * TRY NEXT ALTERNATIVE 65880020 CLC WKANLVLN,WKAQNLVL IS NEST AT LEVEL OF CURRENT QUAL 65900020 BNH CKRNXALT YES, GO TRY NEXT OPTION 65920020 BAL REGLRETN,CKRUNEST IF NOT, UNNEST A LEVEL 65940020 B CKRTRYNX AND TRY AGAIN 65960020 * 65980020 CKRNXALT LA REGDEFPT,0 SET DEFINITION POINTER FROM QUAL 66000020 IC REGDEFPT,WKAQFALS FALSE DISPL TO NEXT 'OR' 66020020 * OR RIGHT BRACE OR ) 66040020 AH REGDEFPT,WKANDFPT 66060020 * 66080020 B CKRINTRP AND GO INTERPRET THAT OPERATOR 66100020 * 66120020 * 66140020 *********************************************************************** 66160020 * * 66180020 * THE FOLLOWING ROUTINE RECEIVES CONTROL WHEN THE CHECKER * 66200020 * IS RECALLED AFTER AN ERROR MESSAGE HAS BEEN ISSUED. * 66220020 * * 66240020 * ERROR SWITCHES ARE RESET, REGISTERS ARE RESTORED * 66260020 * (DEFINITION, SOURCE, AND LIST POINTERS ARE ALL * 66280020 * IN REGISTERS), AND CONTROL IS TRANSFERRED AS DETERMINED * 66300020 * PRIOR TO THE RETURN-AND-RECALL--OFTEN TO CKRINTRP TO * 66320020 * EXAMINE THE NEXT OPERATOR. * 66340020 * * 66360020 * * 66380020 *********************************************************************** 66400020 * 66420020 CKRCONTN EQU * 66440020 NI WKAFALSW,255-CKRFALSW SET OFF FAILURE INDICATOR 66460020 * 66480020 LM REG0,REG15,WKACKRGS RESTORE CHECKER'S REGISTERS 66500020 * 66520020 * 66540020 BR REGLRETN AND BRANCH AS DETERMINED PRIOR 66560020 * TO ISSUANCE OF ERROR MESSAGE 66580020 * TO CONTINUE CHECKING THE 66600020 * STATEMENT. 66620020 * 66640020 * 66660020 * 66680020 *********************************************************************** 66700020 * * 66720020 * THE FOLLOWING ROUTINES PROCESS IMPENDING OVERFLOW OF THE * 66740020 * NEST/QUALIFICATION LISTS. * 66760020 * * 66780020 * ANY QUALIFICATION ENTRIES THAT HAVE LOGICALLY BEEN * 66800020 * ELIMINATED BY A STATEMENT COMMIT ARE PHYSICALLY ELIMINATED * 66820020 * TO CREATE MORE LIST SPACE. * 66840020 * * 66860020 * IF NO SPACE CAN BE OBTAINED FOR EXPANSION, A MESSAGE * 66880020 * IS RETURNED TO THE EXECUTIVE INDICATING THAT CHECKING OF * 66900020 * THE CURRENT STATEMENT MUST BE TERMINATED BECAUSE OF THE * 66920020 * CHECKER'S TABLE SIZE LIMITATIONS. * 66940020 * * 66960020 * * 66980020 *********************************************************************** 67000020 * 67020020 CKRNOFLO EQU * 67040020 BAL REGLRETN,CKRLOFLO GET SOME MORE LIST SPACE IF POSSIBLE 67060020 B CKRADDNS ADD A NEST IN THE SPACE PROVIDED 67080020 * 67100020 * 67120020 CKRQOFLO EQU * 67140020 BAL REGLRETN,CKRLOFLO GET MORE LIST SPACE, IF POSSIBLE 67160020 B CKRLQUAL ADD A QUAL IF ENOUGH SPACE PROVIDED 67180020 * 67200020 * 67220020 CKRLOFLO EQU * 67240020 LA REGWORKA,WKAQLIST 67260020 C REGWORKA,WKATPQLS ANY EXTRANEOUS QUALIFICATION ENTRIES 67280020 BNH CKROFLOW NO 67300020 L REGWORKB,WKATPQLS YES,INITIALIZE TO FILL UP GAP 67320020 ST REGWORKA,WKATPQLS 67340020 CKRSFQLS S REGWORKB,CKRLNQLK 67360020 S REGWORKA,CKRLNQLK 67380020 MVC 0(CKRQUALL,REGWORKA),0(REGWORKB) MOVE TOP Q ENTRY 1ST, 67400020 CR REGWORKB,REGQALPT CONTINUE UNTIL ALL Q ENTRIES 67420020 BH CKRSFQLS MOVED 67440020 * 67460020 LR REGQALPT,REGWORKA ADJUST QUAL PT TO SPACE VACATED IN 67480020 S REGWORKA,CKRLNQLK LIST 67500020 BR REGLRETN AND RETURN 67520020 * 67540020 CKROFLOW SVERP REGWORKA SET ERROR POINTER TO CURR SOURCE LOC 67560020 MVI WKAERRCD,CKROFLOT SET TML MSG CODE FOR LIST OVERFLOW 67580020 B CKRTMRET AND GO ISSUE THE MESSAGE 67600020 * 67620020 * 67640020 * 67660020 AIF ('&ITNLDBG' EQ '').NOCKRDB 67680020 *********************************************************************** 67700020 * * 67720020 * THE FOLLOWING ROUTINES NOTIFY THE EXECUTIVE THAT THE * 67740020 * SYNTAX CHECKER IS NOT OPERATIONAL BECAUSE OF AN ERROR * 67760020 * IN THE DEFINITION OR A PROGRAMMING ERROR IN IPDSNCKR. * 67780020 * * 67800020 * A PARTICULAR FAILURE CODE IS ASSOCIATED WITH EACH TYPE * 67820020 * OF ERROR. REGISTERS WILL BE SAVED IN WKACKRGS--THE COMMENTS * 67840020 * PROVIDE AN AID TO DEBUGGING. * 67860020 * * 67880020 * * 67900020 *********************************************************************** 67920020 * 67940020 CKROPFAL EQU * 67960020 MVI WKASFAIL,X'11' INVALID (UNDEFINED) OP-CODE 67980020 B CKRERRET (OPCODE RT-ADJUSTED IN REGOPCDE, 68000020 * DEFFIELD+REGDEFPT IS LOC OF OPCODE) 68020020 CKREXCRB EQU * 68040020 MVI WKASFAIL,X'12' TOO MANY RIGHT BRACES 68060020 B CKRERRET (DEFFIELD-1+REGDEFPT IS LOC OF RTBRC 68080020 * 68100020 CKREXCRP MVI WKASFAIL,X'13' TOO MANY RIGHT PARENTHESES 68120020 B CKRERRET (DEFFIELD-1+REGDEFPT IS LOC OF )) 68140020 * 68160020 CKRLGLLS MVI WKASFAIL,X'14' LONGEST TABLE ARG.0 OR TOO LONG 68180020 * (LENGTH IN REGWORKN, POINTED TO IN 68200020 B CKRERRET DEFN TABLE BY REGWORKQ) 68220020 * 68240020 CKRTOPFL MVI WKASFAIL,X'15' ILLEGAL OR INVALID TABLE FUNCT.OPCDE 68260020 * (REGWORKB POINTS TO OPCODE IN DEF) 68280020 B CKRERRET BR TO SAVE REGS 68300020 * 68320020 CKREXCUN MVI WKASFAIL,X'16' TOO MANY UNNESTINGS 68340020 * (DEFFIELD-1+REGDEFPT IS LOC OF END- 68360020 B CKRERRET OF-DEFN-LINE OPCODE) 68380020 * 68400020 CKRACFAL MVI WKASFAIL,X'17' INVALID (UNDEFINED) ACTION CODE 68420020 * ACTION CODE RT-ADJUSTED IN REGOPCDE 68440020 * (POINTED TO IN DEFN TABLE BY 68460020 * REGTDFPT) 68480020 B CKRACTRT RETURN TO ACTION CODE PROCESSR 68500020 * 68520020 CKRBDLTS MVI WKASFAIL,X'18' INVALID LITERAL LENGTH (IN REGCHRCT 68540020 * AND WKASRCNT). DEFFIELD+REGDEFPT 68560020 B CKRERRET IS LOC OF LENGTH BYTE 68580020 * 68600020 * 68620020 .NOCKRDB ANOP 68640020 EJECT 68660020 * 68680020 * CHARACTER GETTING ROUTINES 68700020 * 68720020 * CALLING SEQUENCE-- 68740020 * SET R6, I.E., REGSRCPT = SUPPLIED SOURCE POINTER 68760020 * BAL RE,GET CHARACTER ROUTINE 68780020 * RETURN THESE ROUTINES DESTROY REGISTERS 15 TO 3. 68800020 * 68820020 * WKAENDST AND R6 ARE INPUTS TO ALL OF THE 68840020 * ROUTINES. 68860020 * 68880020 * THE SUPPLIED SOURCE POINTER CONTAINS THE 68900020 * ADDRESS IN THE CHARACTER STRING AT WHICH 68920020 * TO START PROCESSING. IF THERE ARE NO MORE 68940020 * SOURCE CHARACTERS BIT 0 IS SET TO ONE 68960020 * BEFORE THESE ROUTINES ARE ENTERED. 68980020 * 69000020 * ALL ROUTINES EXCEPT CKRSERCH SET WKASRCUP 69020020 * (UPDATE SOURCE POINTER) TO THE NEXT 69040020 * CHARACTER FOLLOWING THE LAST ONE GOTTEN OR 69060020 * SKIPPED, OR NEGATIVE IF THERE IS NO NEXT 69080020 * ONE. 69100020 * 69120020 * ALL OF THE ROUTINES SET WKASNDSW BIT 7=1 69140020 * (SOURCE END SWITCH) IF THE REQUEST IS NOT 69160020 * SATISFIED. IF THE REQUEST IS SATISFIED 69180020 * BIT 7=0. 69200020 * 69220020 * ALL ROUTINES EXCEPT CKRSERCH SET WKASRCCR 69240020 * (CURRENT SOURCE POINTER) NEGATIVE IF 69260020 * ROUTINE IS ENTERED WITH NO CHARACTERS LEFT 69280020 * TO CHECK. 69300020 * 69320020 EJECT 69340020 *********************************************************************** 69360020 * 69380020 * BAL RE,CKRGTNB1 GET ONE NON BLANK CHARACTER. 69400020 * RETURN THIS HAS THE SAME SPEC AS CKRGTNBS 69420020 * EXCEPT THAT WKASRCNT IS NOT AN INPUT, 69440020 * WKAMVCNT IS NOT AN OUTPUT, AND IT IS 69460020 * ASSUMED THE REQUEST IS FOR ONE NON-BLANK 69480020 * CHARACTER. 69500020 * 69520020 *********************************************************************** 69540020 CKRGTNB1 LTR R2,REGSRCPT R2 = LOC OF CHAR TO START AT 69560020 BM CKRNONB BR IF ALREADY OUT OF CHARS 69580020 L R1,WKAENDST R1 = LOC OF LAST COL OF CHAR STR 69600020 LA R0,1 R0 = 1 FOR BXLE 69620020 CKRLOOK CLI 0(R2),C' ' IS CURRENT CHAR A BLANK 69640020 BC NC0,CKRGOTNB BR IF FOUND NON BLANK 69660020 BXLE R2,R0,CKRLOOK YES. LOOP UNLESS JUST DID LAST COL 69680020 * OF CHAR STRING 69700020 CKRNONB OI WKASRCCR,WKANOMOR SET CURRENT S. P. NEGATIVE 69720020 ST REGSRCPT,WKASRCUP UPDATE S.P. = SUPPLIED S.P. 69740020 MVI WKASCHRS,WKASPCHR MOVE END OF SOURCE CHAR TO BUFFER 69760020 CKRNONB1 OI WKASNDSW,EXCNSEND SET ON SOURCE END SWITCH 69780020 CKRNONB2 OI WKASRCUP,WKANOMOR SET UPDATE S. P. NEGATIVE 69800020 BR RE RETURN 69820020 CKRGOTNB NI WKASNDSW,255-EXCNSEND SET SOURCE END SW OFF 69840020 MVC WKASCHRS(1),0(R2) MOVE NON BLANK CHAR TO BUFFER 69860020 L RF,WKAOPTPT 69880020 USING IPDSNOPT,RF 69900020 TM OPTBYTE3,EXCFRFRM IS SOURCE STANDARD FORM 69920020 DROP RF 69940020 BNO CKRNOTCG YES. BR AROUND CHAR DEPENDENT CODE 69960020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 69980020 CLI WKASCHRS,CKRLZ 70000020 BH CKRNOTCG BR IF HIGH 70020020 CLI WKASCHRS,CKRLA 70040020 BL CKRNOTCG BR IF LOW 70060020 OI WKASCHRS,CKRFOLD FOLD LOWER CASE TO UPPER CASE 70080020 CKRNOTCG EQU * 70100020 *******************CHARACTER DEPENDENT CODE*************************** 70120020 ST R2,WKASRCCR SET CURRENT S.P. = LOC OF NON BLANK 70140020 CKRGONB4 LA R2,1(R2) SET UPDATE S.P. = NEXT 70160020 ST R2,WKASRCUP CHAR IN STRING 70180020 CKRGONB5 CLR R2,R1 IS IT BEYOND END OF STRING 70200020 BH CKRNONB2 YES. BR TO SET UPDATE S.P. NEG. 70220020 BR RE NO. RETURN 70240020 EJECT 70260020 *********************************************************************** 70280020 * 70300020 * ENTRY TO SKIP THE NEXT X SOURCE CHARACTERS. 70320020 * 70340020 * BAL RE,CKRSKANY THIS HAS SAME SPEC AS CKRGTANY EXCEPT THAT 70360020 * RETURN THE CONTENT OF WKASCHRS IS UNPREDICTABLE 70380020 * AND WKASRCNT MAY SPECIFY A LARGER NUMBER 70400020 * THAN THE SIZE OF WKASCHRS. 70420020 * 70440020 *********************************************************************** 70460020 CKRSKANY LA RF,CKRSKIP SET SW TO INDICATE SKANY 70480020 B CKRSKOGT GO TO COMMON ROUTINE 70500020 *********************************************************************** 70520020 * 70540020 * ENTRY TO GET THE NEXT X SOURCE CHARS. 70560020 * 70580020 * SET WKASRCNT= NO OF CHARS WANTED, BUT NOT MORE THAN WILL 70600020 * FIT IN WKASCHRS. 70620020 * BAL RE,CKRGTANY THE CHARS ARE MOVED TO WKASCHRS. IF 70640020 * RETURN THERE IS NOT ENOUGH SOURCE AN END OF 70660020 * SOURCE CHARACTER IS APPENDED TO THE LAST 70680020 * ONE MOVED IN THE BUFFER. WKAMVCNT IS SET 70700020 * TO THE NUMBER OF CHARACTERS FOUND. 70720020 * WKASRCCR IS SET NEGATIVE 70740020 *********************************************************************** 70760020 CKRGTANY LA RF,CKRGET SET SW TO INDICATE GTANY 70780020 * 70800020 CKRSKOGT XC WKAMVCNT(2),WKAMVCNT SET MVCNT = 0 70820020 LTR R2,REGSRCPT REGSRCPT = LOC OF CHAR TO START AT 70840020 BM CKRNONB BR IF ALREADY OUT OF CHARS 70860020 ST R2,WKASRCCR CURRENT S.P. = SUPPLIED S.P. 70880020 LA R3,WKASCHRS R3 = RESULT BUFFER PNTR 70900020 NI WKASNDSW,255-EXCNSEND SET END SW OFF 70920020 CKRSKGT1 BR RF BR ACCORDING TO REG 15 70940020 CKRGET IC RF,0(0,R2) 70960020 L R1,WKAOPTPT 70980020 USING IPDSNOPT,R1 71000020 TM OPTBYTE3,EXCFRFRM IS SOURCE STANDARD FORM 71020020 DROP R1 71040020 BNO CKRNCHNG YES. BR AROUND CHAR DEPENDENT CODE 71060020 ***** CHARACTER DEPENDENT CODE ***** 71080020 CLI 0(R2),CKRLZ 71100020 BH CKRNCHNG BR IF HIGH 71120020 CLI 0(R2),CKRLA 71140020 BL CKRNCHNG BR IF LOW 71160020 O RF,CKRCAPCN FOLD LOWER CASE TO UPPER CASE 71180020 ***** CHARACTER DEPENDENT CODE ***** 71200020 CKRNCHNG STC RF,0(0,R3) 71220020 LH RF,WKAMVCNT INCREMENT 71240020 LA RF,1(0,RF) MVCNT 71260020 STH RF,WKAMVCNT BY ONE 71280020 LA R3,1(0,R3) UPDATE RESULT BUFFER PNTR TO POINT 71300020 * TO NEXT POSITION 71320020 CH RF,WKASRCNT IS MVCNT LESS THAN SRCNT 71340020 L R1,WKAENDST R1 = LOC OF LAST COL OF CHAR STR 71360020 BNL CKRGONB4 BR IF NO 71380020 LA R2,1(0,R2) YES. R2 = LOC OF NEXT CHAR POSITION 71400020 CR R2,R1 IS R2 BEYOND END OF SOURCE 71420020 BH CKRGTNB4 YES. 71440020 B CKRGET NO. 71460020 CKRSKIP L RF,WKASRCCR IS SRCNT 71480020 AH RF,WKASRCNT PLUS SUPPLIED SOURCE POINTER 71500020 C RF,WKAENDST GREATER THAN ADDR OF END OF STR 71520020 BNH CKRSKIP1 NO. 71540020 B CKRNONB1 BR IF OUT OF CHARS 71560020 CKRSKIP1 ST RF,WKASRCUP SET WKASRCUP = SUPPLIED S.P. + SRCNT 71580020 LH RF,WKASRCNT MVCNT = SRCNT 71600020 STH RF,WKAMVCNT 71620020 BR RE RETURN 71640020 EJECT 71660020 *********************************************************************** 71680020 * 71700020 * ENTRY TO SEARCH FOR A SPECIFIED CHARACTER 71720020 * 71740020 * SET WKASRCHX= CHARACTER TO BE SEARCHED FOR 71760020 * BAL RE,CRRSERCH SEARCH SOURCE FOR SPECIFIED CHARACTER. 71780020 * RETURN WKASRCUP IS SET TO POINT TO IT IF FOUND. 71800020 * IF NOT FOUND, WKASRCUP IS SET NEGATIVE 71820020 * (AND SOURCE END SWITCH IS SET ON). 71840020 * 71860020 *********************************************************************** 71880020 CKRSERCH LTR R1,REGSRCPT R1 = LOC OF CHAR TO START AT 71900020 BM CKRNONB1 BR IF ALREADY OUT OF CHARS 71920020 * CKRNONB1... END OF SOURCE SW SET ON 71940020 * UPDATE PNTR SET NEGATIVE 71960020 * RETURN 71980020 SR RF,RF 72000020 IC RF,WKASRCHX RF = CHAR TO SEARCH FOR 72020020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 72040020 LA R0,CKRFOLD 72060020 STC R0,WKASERTB(RF) SET BYTE IN TRT TABLE FOR CHAR TO NON-0. 72080020 L R2,WKAOPTPT 72100020 USING IPDSNOPT,R2 72120020 TM OPTBYTE3,EXCFRFRM IS SOURCE STANDARD FORM 72140020 DROP R2 72160020 BNO CKR22 YES. BR AROUND CHAR DEPENDENT CODE 72180020 CLI WKASRCHX,CKRA 72200020 BL CKR22 BR IF LOW 72220020 CLI WKASRCHX,CKRZ 72240020 BH CKR22 BR IF HIGH 72260020 SR RF,R0 CAPITAL LETTER,SET TRT TABLE TO 72280020 STC R0,WKASERTB(RF) TEST FOR CORR.LOWER CASE LETTER TOO 72300020 *******************CHARACTER DEPENDENT CODE*************************** 72320020 CKR22 L R2,WKAENDST R2 = LOC OF LAST COL OF CHAR STR 72340020 SR R2,R1 R2 = NUM-1 OF CHARS LEFT IN STRING 72360020 BM CKRNOMR BR IF STRING LENGTH LESS THAN ZERO 72380020 CL R2,CKRF255 IS STRING LENGTH GRTR THAN 255 72400020 BNH CKR23 BR IF NO 72420020 L R2,CKRF255 R2 = SCAN LENGTH (255) 72440020 CKR23 EX R2,CKRSERT SCAN FOR CHAR 72460020 BC NC0,CKRSMTCH BR IF CHAR FOUND 72480020 LA R1,1(R1,R2) UPDATE R1 TO START AT NEXT CHAR 72500020 B CKR22 ADDR AFTER LAST SCAN 72520020 CKRNOMR EQU * 72540020 ST R1,WKASRCUP 72560020 OI WKASRCUP,WKANOMOR SET WKASRCUP NEGATIVE 72580020 OI WKASNDSW,EXCNSEND INDICATE END OF SOURCE REACHED 72600020 B CKR24 BR TO RESET TRT TABLE 72620020 CKRSMTCH ST R1,WKASRCUP LOWER 3 BYTES OF WKASRCUP = 72640020 * LOC OF CHAR FOUND 72660020 NI WKASNDSW,255-EXCNSEND SET SOURCE END SW OFF 72680020 CKR24 SR R2,R2 RESTORE BYTE IN TRT TABLE 72700020 STC R2,WKASERTB(RF) TO ZERO 72720020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 72740020 OR RF,R0 'OR' IN FOLDING CONSTANT,POSSIBLY 72760020 * RE-ZEROING A ZERO BYTE,BUT ASSURING 72780020 STC R2,WKASERTB(RF) THAT BYTE CORR.TO CAP.LETTER IS 0 72800020 *******************CHARACTER DEPENDENT CODE*************************** 72820020 CKR25 BR RE RETURN 72840020 EJECT 72860020 *********************************************************************** 72880020 * 72900020 * ENTRY TO GET THE NEXT X NON BLANK SOURCE CHARS. 72920020 * 72940020 * SET WKASRCNT AS IN CKRGTANY. 72960020 * BAL RE,CKRGTNBS SAME AS CKRGTANY, EXCEPT THAT ONLY NON- 72980020 * RETURN BLANK CHARACTERS ARE MOVED, AND THAT 73000020 * WKASRCCR SPECIFIES FIRST NON-BLANK 73020020 * CHARACTER FOUND. 73040020 * IF NONE ARE FOUND, WKASRCCR IS SET 73060020 * NEGATIVE 73080020 * 73100020 *********************************************************************** 73120020 CKRGTNBS XC WKAMVCNT(2),WKAMVCNT SET MVCNT = 0 73140020 LTR R2,REGSRCPT R2 = LOC OF CHAR TO START AT 73160020 BM CKRNONB BR IF ALREADY OUT OF CHARS 73180020 L R1,WKAENDST R1 = LOC OF LAST COL OF CHAR STR 73200020 NI WKASNDSW,255-EXCNSEND SET SOURCE END SW OFF 73220020 * 'FIRST TIME THRU' SWITCH 73240020 OI WKASRCCR,WKANOMOR SET CURRENT S. P. NEGATIVE 73260020 * 73280020 LA R3,WKASCHRS R3 = RESULT BUFFER PNTR 73300020 LA R0,1 R0 = 1 FOR BXLE 73320020 CKRGTNBL CLI 0(R2),C' ' IS CURRENT CHAR A BLANK 73340020 BNE CKRGTNB2 BR IF FOUND NON BLANK 73360020 CKRGTNBE BXLE R2,R0,CKRGTNBL YES. LOOP UNLESS JUST DID LAST 73380020 * COL OF CHAR STR 73400020 CKRGTNB4 MVI 0(R3),WKASPCHR MOVE END OF SOURCE CHAR TO BUFFER 73420020 B CKRNONB1 BR 73440020 * CKRNONB1 ... END OF SOURCE SW SET ON 73460020 * UPDATE PNTR SET NEGATIVE 73480020 * RETURN 73500020 CKRGTNB2 TM WKASRCCR,WKANOMOR IS CURRENT S. P. NEGATIVE 73520020 BNO CKRGTNB3 BR IF NO 73540020 ST R2,WKASRCCR YES. SET CURRENT S.P. = LOC OF NON 73560020 * BLANK 73580020 CKRGTNB3 IC R0,0(R2) 73600020 L RF,WKAOPTPT 73620020 USING IPDSNOPT,RF 73640020 TM OPTBYTE3,EXCFRFRM IS SOURCE STANDARD FORM 73660020 DROP RF 73680020 BNO CKRNOCHG YES. BR AROUND CHAR DEPENDENT CODE 73700020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 73720020 CLI 0(R2),CKRLZ 73740020 BH CKRNOCHG BR IF HIGH 73760020 CLI 0(R2),CKRLA 73780020 BL CKRNOCHG BR IF LOW 73800020 O R0,CKRCAPCN 73820020 CKRNOCHG EQU * 73840020 *******************CHARACTER DEPENDENT CODE*************************** 73860020 STC R0,0(0,R3) STORE CHAR IN RESULT BUFFER 73880020 LA R0,1 RESET R0=1 FOR BXLE 73900020 LH RF,WKAMVCNT INCREMENT 73920020 LA RF,1(0,RF) MVCNT 73940020 STH RF,WKAMVCNT BY ONE 73960020 LA R3,1(0,R3) UPDATE RESULT BUFFER TO POINT TO 73980020 * NEXT POSITION 74000020 CH RF,WKASRCNT IS MVCNT LESS THAN SRCNT 74020020 BL CKRGTNBE YES. 74040020 B CKRGONB4 NO. 74060020 EJECT 74080020 * 74100020 * 74120020 * SYNTAX OPERATOR ROUTINES BRANCH TABLE 74140020 * 74160020 * INDEX OPERATOR CODE 74180020 CKRSYNOP DS 0H 74200020 * 74220020 CKROPNDX DC Y(CKRLBRCE-CKRINTRP) LEFT BRACE 00 74240020 DC Y(CKRRBRCE-CKRINTRP) RIGHT BRACE 02 74260020 DC Y(CKROR-CKRINTRP) OR 04 74280020 DC Y(CKRLPARN-CKRINTRP) ( 06 74300020 DC Y(CKRRPARN-CKRINTRP) ) 08 74320020 DC Y(CKRCOMIT-CKRINTRP) / 0A 74340020 DC Y(CKRSTCMT-CKRINTRP) COLON STATM COMMIT 0C 74360020 DC Y(CKRITIND-CKRINTRP) ... 0E 74380020 DC Y(CKRITDEF-CKRINTRP) .N. 10 74400020 DC Y(CKRSYNS-CKRINTRP) SYMBOL 12 74420020 DC Y(CKRMNAME-CKRINTRP) M 14 74440020 DC Y(CKRNAME-CKRINTRP) N 16 74460020 DC Y(CKRLETTR-CKRINTRP) L 18 74480020 DC Y(CKRDIGIT-CKRINTRP) D 1A 74500020 DC Y(CKRALMER-CKRINTRP) A 1C 74520020 DC Y(CKRNUMBR-CKRINTRP) K 1E 74540020 DC Y(CKRSTATM-CKRINTRP) S 20 74560020 DC Y(CKRHOLLR-CKRINTRP) H 22 74580020 DC Y(CKRCSTRG-CKRINTRP) C 24 74600020 DC Y(CKRQUOTE-CKRINTRP) 'AA...A' 26 74620020 DC Y(CKRNOTQT-CKRINTRP) NOT'AA...A' 28 74640020 DC Y(CKRSCAN-CKRINTRP) &A 2A 74660020 DC Y(CKRSCANF-CKRINTRP) &NOTA 2C 74680020 DC Y(CKRACTN-CKRINTRP) $N 2E 74700020 DC Y(CKRMESSG-CKRINTRP) *N 30 74720020 DC Y(CKRTABL-CKRINTRP) +TBLNAME 32 74740020 DC Y(CKRTABL-CKRINTRP) -TBLNAME 34 74760020 DC Y(CKRSYUNS-CKRINTRP) END-OF-LN 36 74780020 CKRINVOP DC A(*-CKROPNDX) EXCEED HIGHEST OP-CODE 74800020 * 74820020 * ACTION CODE ROUTINES BRANCH TABLE 74840020 * 74860020 CKRACNDX DC Y(CKRAR100-CKRACTN) DISPL. TO ACTION CODE 100 RTNE 74880020 DC Y(CKRAR101-CKRACTN) 101 74900020 DC Y(CKRAR102-CKRACTN) ETC 74920020 DC Y(CKRAR103-CKRACTN) 74940020 DC Y(CKRAR104-CKRACTN) 74960020 DC Y(CKRAR105-CKRACTN) 74980020 DC Y(CKRAR106-CKRACTN) 75000020 DC Y(CKRAR200-CKRACTN) 75020020 DC Y(CKRAR201-CKRACTN) 75040020 DC Y(CKRAR202-CKRACTN) 75060020 DC Y(CKRAR203-CKRACTN) 75080020 DC Y(CKRAR300-CKRACTN) 75100020 DC Y(CKRAR301-CKRACTN) 75120020 DC Y(CKRAR400-CKRACTN) 75140020 DC Y(CKRAR401-CKRACTN) 75160020 DC Y(CKRAR500-CKRACTN) 75180020 DC Y(CKRAR600-CKRACTN) 75200020 DC Y(CKRAR601-CKRACTN) 75220020 DC Y(CKRAR602-CKRACTN) 75240020 DC Y(CKRAR603-CKRACTN) 75260020 DC Y(CKRAR604-CKRACTN) 75280020 DC Y(CKRAR605-CKRACTN) 75300020 DC Y(CKRAR606-CKRACTN) 75320020 DC Y(CKRAR607-CKRACTN) 75340020 DC Y(CKRAR608-CKRACTN) 75360020 DC Y(CKRAR609-CKRACTN) 75380020 DC Y(CKRAR610-CKRACTN) 75400020 DC Y(CKRAR611-CKRACTN) 75420020 DC Y(CKRAR612-CKRACTN) 75440020 DC Y(CKRAR613-CKRACTN) 75460020 DC Y(CKRAR700-CKRACTN) 75480020 DC Y(CKRAR701-CKRACTN) 75500020 DC Y(CKRAR800-CKRACTN) 75520020 DC Y(CKRAR801-CKRACTN) 75540020 CKRINVAC DC Y(*-CKRACNDX) EXCEEDS HIGHEST ACTION CODE 75560020 * 75580020 * 75600020 * 75620020 CKRLNNSK DC A(CKRNESTL) LENGTH OF NEST. 75640020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 75660020 CKRCAPCN DC A(CKRFOLD) 'OR' TO FOLD LETTER IN F WORD RTADJ 75680020 *******************CHARACTER DEPENDENT CODE*************************** 75700020 CKRINTMX DC F'10' MAXIMUM ALLOWABLE DIGITS IN INTEGER 75720020 * 75740020 CKRMAXIG DC C'2147483647' MAXIMUM ALLOWABLE INTEGRAL VALUE 75760020 * 75780020 CKRFULL6 DC F'6' MAX NAME LENGTH, GT MAX STAT.NO.LENG 75800020 CKRFULL8 DC F'8' MAX. LENGTH IN DIGITS OF LEN 4 NOS. 75820020 CKRFULL2 DC F'2' MAX. EXPONENT LENGTH IN SIGNF.DIGITS 75840020 CKRF255 DC F'255' MAXIMUM SIZE FOR WIDTH 75860020 CKRF66 DC F'66' COL 66 IS UPPER BOUND ON F-F END STMT 75870020 CKRF0076 DC F'76' UPPER BOUND ON LOG OF K NUMBER 75880020 CKRFM078 DC F'-78' LOWER BOUND ON LOG OF K NUMBER 75900020 CKRF100M DC F'100000000' 100,000,000 TO PREV.CKREVALU O'FLOW 75920020 CKRRLGOP DS 0H 75940020 CKREQ DC C'EQ' 75960020 CKRGT DC C'GT' 75980020 CKRLT DC C'LT' 76000020 CKRGE DC C'GE' 76020020 CKRLE DC C'LE' 76040020 CKRNE DC C'NE' 76060020 CKRORE DC C'OR' 76080020 CKRAN DC C'AN' 76100020 * 76120020 * STATEMENTS EXECUTED BY THE EXECUTE INSTRUCTION 76140020 * 76160020 CKRCOMPR CLC 0(1,REGWORKB),WKASCHRS COMPARE LITERAL TO SOURCE 76180020 CKRTCMPR CLC 1(1,REGTDFPT),WKASCHRS COMPARE TBL LITERAL TO SOURCE 76200020 CKRSERT TRT 0(0,R1),WKASERTB 76220020 EJECT 76240020 * 76260020 * TRANSLATE AND TEST TABLE FOR A THROUGH Z AND 0 THROUGH 9 76280020 * 76300020 CKRLETRA DC 9X'00' A-I 76320020 DC 7X'01' 76340020 DC 9X'00' J-R 76360020 DC 8X'01' 76380020 DC 8X'00' S-Z 76400020 DC 6X'01' 76420020 DC 10X'00' 0-9 76440020 DC 6X'01' 76460020 CKRAMTBL EQU CKRLETRA-193 76480020 * 76500020 * 76520020 * 76540020 * EQUATES 76560020 * 76580020 CKRH EQU C'H' 76600020 CKRA EQU C'A' 76620020 CKRZ EQU C'Z' 76640020 CKR$ EQU C'$' 76660020 CKR0 EQU C'0' 76680020 CKR9 EQU C'9' 76700020 CKRDOT EQU C'.' 76720020 CKRE EQU C'E' 76740020 CKRD EQU C'D' 76760020 CKRSGLQT EQU C'''' SINGLE QUOTE 76780020 CKRPLUS EQU C'+' PLUS 76800020 CKRMINUS EQU C'-' MINUS 76820020 CKRHYPHN EQU C'-' HYPHEN 76840020 *******************CHARACTER DEPENDENT CODE FOLLOWS******************* 76860020 CKRLZ EQU X'A9' LOWER CASE Z 76880020 CKRLA EQU X'81' LOWER CASE A 76900020 CKRFOLD EQU X'40' 'OR' TO FOLD LOWER CASE TO UPPER 76920020 *******************CHARACTER DEPENDENT CODE*************************** 76940020 * 76960020 * OP-CODES REFERENCED DIRECTLY 76980020 CKRPLTBL EQU X'32' +TABLENAME 77000020 CKRMITBL EQU X'34' -TABLENAME 77020020 CKRACTON EQU X'2E' ACTION OR NULL (N =X'FFFF' FOR NULL) 77040020 CKRSYMLN EQU X'12' SYMBOLIC-LINE 77060020 * 77080020 * ERROR CODES 77100020 * 77120020 CKRSBUGT EQU 01 SYSTEM OR SYNTAX CHECKER FAILURE 77140020 CKRLGNMC EQU 82 NAME TOO LONG 77160020 CKRINVSC EQU 84 INVALID STATEMENT NUMBER 77180020 CKRINCHT EQU 87 LITERAL IN WH FORMAT INCOMPLETE 77200020 CKRINVWC EQU 88 FIELD WIDTH NOT IN RANGE 1-255 77220020 CKRLGCST EQU 91 LITERAL EXCEEDS 255 CHARACTERS 77240020 CKROFLOT EQU 93 NEST/QUAL LIST OVERFLOW 77260020 CKREXSCT EQU 97 EXCESS SOURCE DATA 77280020 CKRXPNGC EQU 116 EXPONENT MISSING OR INVALID 77300020 CKRKWODC EQU 118 REAL NUMBER MUST HAVE SOME DIGIT(S) 77320020 CKRLGINC EQU 120 INTEGER TOO LARGE 77340020 CKRQTMST EQU 123 CLOSING ' MISSING 77360020 CKRINVRC EQU 130 REAL NO. OUTSIDE ALLOWABLE RANGE 77380020 CKREMTCC EQU 144 '' LITERAL CONTAINS NO CHARS. 77400020 CKRINVDC EQU 148 INVALID DECIMAL POINT 77420020 * ACTION ROUTINE ERROR MESSAGE CODES 77440020 CKRPXSBC EQU 8 POSSIBLY TOO MANY SUBSCRIPTS 77460020 CKREXSBC EQU 10 TOO MANY SUBSCRIPTS 77480020 * NEXT OPERATOR 77500020 * 77520020 * 77540020 *********************************************************************** 77560020 * * 77580020 * THE FOLLOWING ROUTINES, CKRLETTR (L), CKRDIGIT (D), AND * 77600020 * CHRALMER (A), TEST THE SOURCE FOR FORTRAN ALPHABETIC, * 77620020 * DIGIT, AND FORTRAN ALPHAMERIC ($, A THROUGH Z, 0 THROUGH 9), * 77640020 * RESPECTIVELY. * 77660020 * * 77680020 * * 77700020 *********************************************************************** 77720020 * 77740020 CKRLETTR EQU * TEST FOR A LETTER, FORTRAN ALPHABET 77760020 * 77780020 BAL REGLRETN,CKRGTNB1 GO GET NEXT NON-BLANK SOURCE CHAR 77800020 CLI WKASCHRS,CKRZ IS SOURCE CHAR HIGHER THAN Z 77820020 BH CKRFAIL YES, FAIL 77840020 CKRALPHA TSTAM CKRFAIL NO, TEST FOR ALPHAMERIC,FAIL IF NOT 77860020 * 77880020 UPDSC UPDATE SOURCE PT BEYOND CHAR OBTAIND 77900020 * 77920020 B CKRINTRP AND GO INTERPRET NEXT OPERATOR 77940020 * 77960020 * 77980020 CKRDIGIT EQU * TEST FOR DIGIT 78000020 * 78020020 BAL REGLRETN,CKRGTNB1 GO GET NEXT NON-BLANK SOURCE CHAR 78040020 * 78060020 CLI WKASCHRS,CKR0 IS IT LOWER THAN ZERO IN EBCDIC SEQ 78080020 BL CKRFAIL YES, FAIL 78100020 CLI WKASCHRS,CKR9 NO, IS IT GREATER THAN 9 78120020 BH CKRFAIL YES, FAIL 78140020 * NO, GOOD DIGIT 78160020 UPDSC UPDATE SOURCE POINTER BEYOND DIGIT 78180020 * 78200020 B CKRINTRP AND GO INTERPRET NEXT OPERATOR 78220020 * 78240020 * 78260020 CKRALMER EQU * TEST FOR ALPHAMERIC 78280020 * 78300020 BAL REGLRETN,CKRGTNB1 GO GET NEXT NON-BLANK SOURCE CHAR 78320020 * 78340020 B CKRALPHA AND GO TEST IT FOR ALPHAMERIC 78360020 * 78380020 * 78400020 * 78420020 *********************************************************************** 78440020 * * 78460020 * THE FOLLOWING ROUTINE TESTS THE SOURCE FOR A FORTRAN * 78480020 CKRNZIRC EQU 20 NON-ZERO INTEGER REQUIRED 78500020 CKRIDSNC EQU 26 INVALID DATASET REF. NUMBER 78520020 CKRMSNOC EQU 42 STATEMENT NO. MISSING (FROM FORMAT) 78540020 CKRNZRQC EQU 00 NON-0 NO. REQ'D--NOT CURRENTLY USED 78560020 CKRINTRC EQU 72 INTEGER REQUIRED 78580020 CKRICPXC EQU 74 INVALID COMPLEX NUMBER 78600020 CKRIENDT EQU 95 BLANKS REQD IN COLUMNS 1-6 (OF END) 78620020 CKRINIMT EQU 99 INVALID IMPLICIT RANGE 78640020 CKRDCXWC EQU 106 DEC PLACES NOT LESS THAN FIELD WIDTH 78660020 CKRDCPUC EQU 108 DECIMAL PLACES MUST BE SPECIFIED 78680020 CKRRPRQT EQU 111 RIGHT PARENTHESIS REQD FOR IMPL'D DO 78700020 CKRVRSBC EQU 112 VARIABLE MAY NOT BE SUBSCRIPTED 78720020 CKRNODBT EQU 115 DEBUG NOT SUPPORTED 78740020 CKRRLRQC EQU 126 REAL NO. REQUIRED 78760020 CKRLDILC EQU 136 LIST-DIRECTED I/O ILLEGAL 78780020 CKRXSBPC EQU 158 TOO MANY SUBSCRIPTS PRECEDING 78800020 CKRIENDF EQU 161 F-F END STMNT PAST COL 66 78810020 * 78820020 LTORG 78840020 CKRSOFAR EQU *-IPDSNCKR TROUBLE IF THIS EXCEEDS CKRLENGT 78860020 CKREXPAN EQU CKRLENGT-CKRSOFAR 78880020 DC (CKREXPAN)C'C' EXPANSION SPACE FILLED WITH C'S 78900020 CKRCSEND EQU * 78920020 EJECT 78940020 IPDSNWKA DSECT 78960020 * AREA OBTAINED FROM GETMAIN 78980020 * AND PASSED TO CHECKER. 79000020 * 79020020 WKARLENT EQU 4096 LENGTH OF WORK AREA IN BYTES 79040020 * MUST BE INTEGRAL MULTIPLE OF 8 79060020 * 79080020 EXCSVRGS DS 18F EXECUTIVE'S REG. SAVE AREA. 79100020 * 79120020 * PARAMETERS PASSED TO CHECKER. C79140020 ALSO, IPDSNCKR EXPECTS THIS LIST TO C79160020 BE IN IPDSNWKA 79180020 WKACKPRM DS 0F PARAMETER LIST FOR IPDSNCKR 79200020 WKABEGST DS A PNTR TO STMNT FIELD PORTION OF STMNT 79220020 WKAENDST DS A ADDR OF LAST COL OF CHAR STRING 79240020 WKADEEF DS A ADDR. OF TABLE MODULE. 79260020 WKAWADDR DS A ADDR. OF WORK AREA. 79280020 WKAOPTPT DS A ADDR. OF OPTIONS WORD. 79300020 SPACE 1 79320020 * 79340020 * ZERO IN THE EXCSYNXS TABLE INDICATES THAT THE TABLE 79360020 * WAS NOT REQUESTED BY A 1 BIT IN THE 2ND BYTE OF THE 79380020 * OPTIONS WORD AT INITIAL CALL, AND THAT THE TABLE WAS 79400020 * NOT LOADED. 79420020 EXCSYNXS DS A ZERO OR LOCATION OF IPDTEE 79440020 DS A ZERO OR LOCATION OF IPDAGH 79460020 * CURRENT CARD LOCATION INFORMATION SET BY EXCGETRC 79480020 EXCCRCRD DS A LOC OF CURRENT CARD. 79500020 EXCCRBUF DS A LOC OF BUFFER CONTAINING CURRENT CARD 79520020 EXCCRBRL DS H REL POSIT OF CUR REC IN BUFFER 79540020 EXCCRREL DS H REL POSIT OF CUR CARD IN BUF CHAIN 79560020 INF EQU *-EXCCRCRD 79580020 * SAME AS EXCCRCRD INFO BUT FOR NEXT CARD. INPUT TO AND 79600020 EXCNXCRD DS A ALSO SET BY EXCGETRC 79620020 EXCNXBUF DS A 79640020 EXCNXBRL DS H 79660020 EXCNXREL DS H 79680020 * EXCCRCRD INFO FOR FRST CARD OF A STATEMENT 79700020 EXCFSCRD DS A 79720020 DS A 79740020 DS H 79760020 EXCFSREL DS H 79780020 * EXCCRCRD INFO IS SAVED HERE FOR FRST CARD OF NEXT 79800020 EXCSVCRD DS A STATEMENT AND FOR FRST COMMENT 79820020 EXCSVBUF DS A CARD ENCOUNTERED WITHIN A STATEMENT. 79840020 EXCSVBRL DS H 79860020 EXCSVREL DS H 79880020 BLDLLIST DS 0H 79882021 FF DS H LIST FOR BLDL 79884021 LL DS H 79886021 NAME DS 8C 79888021 TTR DS 50C 79890021 * 79892021 BLDLSWH DS X 79894021 DS 1C 79896021 SPACE 2 79900020 WKALEVEL DS XL1 OPTLEVEL SAVED--FTN DEF'N FOR SCAN 79920020 WKALEVLE EQU X'01' LEVEL E 79940020 WKALEVLG EQU X'02' LEVEL G 79960020 WKALEVLH EQU X'00' LEVEL H 79980020 WKALEVLT EQU X'03' LEVEL TSO 80000020 WKALEVG1 EQU X'04' LEVEL G1 80020020 * 80040020 WKACNCOL DS CL1 ST-FORM, CONTENTS OF COL. 6 OF LAST 80060020 * LINE OF STMNT. 80080020 * FR-FORM, NON-BLANK FOR STMNT OF MORE 80100020 * THAN ONE LINE, ELSE BLANK. 80120020 * 80140020 *********************************************************************** 80160020 IPDERWKA DS 0D PORTION OF WORK AREA ACCESSIBLE TO 80180020 * IPDERERR--MUST MATCH IPDERWKA DSECT 80200020 * IN IPDER MODULE 80220020 WKAEROPT DS A LOC OF 4TH BYTE OF OPTION WORD. 2ND BIT 80240020 * =0 INDICATES DATA SET HAS LINE NOS. 80260020 CNOP 4,8 ALIGNED TO MIDDLE OF DOUBLE WORD 80280020 WKAERBFR DS CL72 ERROR MESSAGE BUFFER. MESSAGE IS LEFT- 80300020 * ADJUSTED IN BUFFER WITH TRAILING BLANKS. 80320020 WKAERRSC DS A LOC OF 6 CHARACTER ERROR STRING. WILL BE 80340020 * INCLUDED IN MSG UNLESS WKAERRSC IS ZERO. 80360020 WKAERPOS DS H LINE POSITION IN BUFFER, IN BINARY. 80380020 WKAERRCD DS XL1 ERROR CODE. SPECIFIES WHICH MSG TO FORM. 80400020 WKAERRTM EQU X'01' TEST RIGHT-MOST BIT OF ERROR CODE. 80420020 * 1=ON FOR TERMINATING ERROR 80440020 WKASFAIL DS XL1 NOT-OPERATIONAL ERROR BYTE 80460020 * 00, NO ERRORS 80480020 * 01-0F, EXC NOT OPERATIONAL 80500020 * 11-1F, CKR NOT OPERATIONAL 80520020 * 21-2F, ERR NOT OPERATIONAL 80540020 WKAERNUM DS CL8 LINE NUMBER RIGHT-ADJUSTED IN EBCDIC. 80560020 WKAERPAD DS CL1 SPACE FOR BLANK BETWEEN WKAERNUM AND 80580020 * WKAERCHR. 80600020 WKAERCHR DS CL6 6 CHARACTER ERROR STRING 80620020 * 80640020 * 80660020 *********************************************************************** 80680020 * 80700020 SPACE 3 80720020 * 80740020 * 80760020 * THE AREA FROM WKACERSW TO EXCSLERR IS ZEROED WHENEVER A NEW 80780020 * STATEMENT IS ENCOUNTERED. 80800020 * 80820020 WKACERSW DS XL1 ERROR FOUND BY CHECKER. 80840020 * FULL BYTE SWITCH -- '01' = ON, X'00' = OFF 80860020 EXCNCKER EQU X'01' 1=ON WHEN CHECKER DETECTS ERROR IN 80880020 * CURRENT STATEMENT 80900020 * 80920020 * 80940020 WKASNOSW DS XL1 STATEMENT-NUMBER SWITCH BYTE. 80960020 * FULL BYTE SWITCH -- '01' = ON, X'00' = OFF 80980020 * 1 - INITIAL LINE HAS STMNT-NO. 81000020 * 0 - INITIAL LINE HAS NO STMNT-NO. 81020020 EXCNSTNO EQU X'01' 1=ON WHEN STATEMENT IS LABELLED 81040020 * 81060020 * 81080020 * 81100020 EXCFSCOM DS X 0 - NO COMMENT CARD SINCE BEGINNING OF STMNT C81120020 255 - HAVE ENCOUNTERED A COMMENT CARD 81140020 EXCOMSG DS X 0 - INTERVENING COMMENT CARD MSG HAS NOT C81160020 BEEN SENT. C81180020 255 - IT HAS TOO BEEN SENT 81200020 EXCFSCON DS X 0 - NO CONTINUATION HAS PRECEDED FRST STMNT C81220020 IN BUFFER CHAIN C81240020 255 -CONTINUATION ENCOUNTERED FIRST 81260020 EXCEXSLN DS X 0 -NO EXTRA STMNT LINES ENCOUNTERED 81280020 * BEFORE THIS LINE 81300020 * 255 -HAVE ENCOUNTERED EXTRA STMNT LINE 81320020 * STATEMENT LABEL ERROR SWITCH. SETTINGS INDICATE ERRORS 81340020 * OR POTENTIAL ERRORS TO BE FOUND WHILE PROCESSING FREE-FORM 81360020 * STATEMENT LABEL FIELD. 81380020 * 81400020 EXCSLERR DS XL1 ONE BYTE SWITCH 81420020 EXCDGLBL EQU X'80' LBL CONTAINS DIGIT 1-9 81440020 EXCSLZRO EQU X'40' ZERO FOUND IN LBL 81460020 EXCSLER2 EQU X'20' INVAL STMNT LBL (EXTRAN. CHARS) 81480020 EXCEXTCH EQU X'10' EXTRANEOUS CHAR FOUND 81500020 EXCSLER1 EQU X'04' STMNT FIELD MISSING 81520020 EXCLBMSG EQU X'02' MSG FOR INVAL LBL ALREADY SENT 81540020 * 81560020 EXCRLSBF EQU X'80' ALLOW BUFFER RELEASE 81580020 * 81600020 IPDEXCWK DS 0C MISCELLANEOUS EXECUTIVE (IPDSNEXC) 81620020 * WORK AREA 81640020 EXCSVLNN DS CL8 TEMP. STORAGE FOR LINE NO. OF RECORD 81660020 * POINTED TO BY EXCSVCRD 81680020 WKATECHR DS CL6 TEMP. STORAGE FOR 6-CHAR. ERROR STRING 81700020 EXCSVLBL DS A SAVE AREA FOR CURRENT DIGIT ADDR 81720020 * IN STMNT LABEL 81740020 WKATERSC DS A TEMP. STORAGE FOR LOC. OF ERROR STRING 81760020 EXCFCHAR DS XL1 FOR FOLDING OF ALPHABETICS 81780020 SPACE 3 81800020 * WKATINU TABLE. CONTAINS 20 ENTRIES TO ALLOW FOR UP TO 81820020 * 20 LINES PER STATEMENT. EACH ENTRY ALLOWS SPACE FOR THE 81840020 * DISPLACEMENT OF THE LAST BYTE OF LINE TEXT (2 BYTES) 81860020 * FROM THE BEGINNING OF THE CHARACTER STRING AND THE DATA 81880020 * SET OR RELATIVE LINE NUMBER (8 BYTES) ASSOCIATED WITH 81900020 * THE LINE. BIT 0 OF THE NTH ENTRY IS SET=1 WHEN THE 81920020 * (N-1)TH ENTRY POINTS TO THE LAST LINE OF THE STATEMENT. 81940020 SPACE 3 81960020 WKATINU DS 0H WKATINU TABLE 81980020 DS 20CL10 82000020 DS CL2 82020020 SPACE 3 82040020 SPACE 1 82060020 WKACHRST DS CL1325 CHARACTER STRING WORK AREA 82080020 * CONTAINS FORTRAN SOURCE MOVED FROM 82100020 * THE INPUT BUFFER BY IPDSNEXC. 82120020 SPACE 3 82140020 WKASERTB DS CL256 TRT TABLE USED BY CKRSERCH ROUTINE 82160020 SPACE 3 82180020 WKAGTCHR DS 0F AREAS FOR COMMUNIC. WITH GET CHAR. RTNES 82200020 * 82220020 WKASRCCR DS F CURRENT SOURCE POINTER 82240020 WKASRCUP DS F UPDATE SOURCE POINTER. 82260020 WKANOMOR EQU X'80' IN HIGH-ORDER BYTE OF PT (PT NEG.) 82280020 * INDICATES NO MORE SOURCE CHARS) 82300020 SPACE 3 82320020 DS 0H HALF-WORD ALIGNMENT FOR WKASCHRS 82340020 WKASCHRS DS 20CL1 CHAR.RESULT AREA OF GET CHAR. RTNES 82360020 WKASCMAX EQU *-WKASCHRS LENGTH OF CHAR.AREA, FOLLOW WKASCHRS. 82380020 * 82400020 WKASRCNT DS H NO. CHARS. TO BE MOVED 82420020 WKAMVCNT DS H NO. CHARS. MOVED 82440020 * TO WKASCHRS BY GET CHAR. RTNES 82460020 * 82480020 WKASRCHX DS XL1 SERCH CHARACTER 82500020 * 82520020 WKASNDSW DS XL1 SOURCE-END SWITCH. 82540020 * FULL BYTE SWITCH -- '01' = ON, X'00' = OFF 82560020 EXCNSEND EQU X'01' 1=ON WHEN END OF SOURCE ENCOUNTERED 82580020 * 82600020 WKASPCHR EQU X'30' SPECIAL CHAR. FOR NO-MORE-SOURCE, 82620020 * 82640020 * 82660020 * 82680020 IPDCKWRK DS 0F MISCELLANEOUS CHECKER WORK AREAS 82700020 * 82720020 WKASVR13 DS F CALLERS REGISTER 13 SAVED BY CKR 82740020 WKABEGSC DS F PTR TO 1ST NONBLANK CHAR IN STAT. 82760020 WKALDZCT DS F K OPERATOR LEADING-ZEROES COUNT 82780020 WKADGTCT DS F K OPERATOR DIGIT COUNT 82800020 WKAZROCT DS F K OPERATOR ZERO COUNT 82820020 WKATENPW DS F POWER OF TEN .D=0, DD=2, .000D=-3 82840020 * (USED IN K-OPERATOR, WITH EXPONENT, 82860020 * TO TEST SIZE OF A REAL NUMBER) 82880020 * 82900020 WKAADNLS DS F A(WKANLIST) 82920020 WKATPQLS DS F TOP OF Q LIST--CAN SHIFT TO WKAQLIST 82940020 WKAVALUE DS F COMPUTED BY CKREVALU SUBR. 82960020 WKAWIDTH DS F W OF FIELD DESCRIPTOR FORMS 82980020 WKACKRGS DS 16F CHECKER REGS 0-15 83000020 WKASAVNQ DS F NEST POINTER SAVED 83020020 DS F QUAL POINTER SAVED 83040020 WKACSVSC DS F SAVED SOURCE POINTER 83060020 WKASVRTN DS F RETURN REG SAVE AREA FOR CKREVALU 83080020 WKAGTSV DS 4F REG. SAVE AREA FOR GET CHAR. SUBRS. 83100020 * 83120020 * MESSAGES-ISSUED TABLE 83140020 * 83160020 WKAMSGAD DS A(WKAMSGTB) LOC. FOR NEXT MSG IN TABLE 83180020 WKAMSGTB DS 0F TABLE OF MSG'S ISSUED THIS STATEMENT 83200020 DS X CODE AS EVEN NUMBR 83220020 DS AL3 FAILING CHARACTER ADDRESS 83240020 DS 4F SPACE FOR 5 IN ALL 83260020 WKAMGTND EQU * LOC. PAST END OF TABLE 83280020 WKATEMPH DS H HALFWORD FOR REG LOADING 83300020 WKACNTDG DS H NO. OF CONTINUOUS DIGITS EVALUATED 83320020 WKACKRSW DS XL1 IPDSNCKR SWITCHES 83340020 WKAFALSW EQU WKACKRSW FALSE SWITCH 83360020 WKAGLCMT EQU WKACKRSW GLOBAL (STATEMENT) COMMIT SWITCH 83380020 CKRGLCMT EQU X'40' BIT DEFN 1=GLOBAL COMMIT IN EFFECT 83400020 * FOR STATEMENT 83420020 CKRFALSW EQU X'80' BIT DEFINED 1= FAILURE 83440020 * 83460020 WKAKSWCH DS XL1 K OPERATOR SWITCHES 83480020 CKRKTYPI EQU X'01' TYPE BIT 1=INTEGER, 0 = REAL 83500020 CKRKLEND EQU X'02' LENGTH BIT 1 = D , 0 = E 83520020 CKRKVALU EQU X'04' VALUE BIT 1=NONZERO, 0 = ZERO 83540020 CKRKFAIL EQU CKRKTYPI+CKRKLEND+CKRKVALU 1,1,1 IS FAILURE 83560020 WKASVKSW DS XL1 SAVED K SWITCHES FOR REAL PART OF CMPX NO 83580020 WKANONZS DS XL1 SWITCH--0 IF NO.NON-ZERO DIGITS WERE 83600020 * ENCOUNTERED (IN K OPER.) 83620020 * OTHERWIZE, NOT 0 83640020 * 83660020 WKAEXPSN DS CL1 SIGN OF EXPONENT (USED IN K OPER.) 83680020 WKAEXINT EQU X'FF' INITIAL VALUE FOR K OPERATOR. TURNED 83700020 * OFF ON RECOGNITION OF 1ST EXP. 83720020 WKASWTCH DS XL1 TEMPORARY PROCESSING SWITCHES 83740020 CKRLGNMA EQU X'01' NAME OPERATOR SW ,1=LONG NAME ALLOWD 83760020 CKRMATCH EQU X'02' QUOTED LITERAL OP SW, 1=MATCH REQD 83780020 CKRSUBSC EQU X'04' SUBSCRIPTING SW, 1= VARIABLE IS SUBD 83800020 WKAIMPL1 DS CL1 IMPLICIT RANGE L1 (OR JUST L) 83820020 WKASVICT DS XL1 SAVED ITERATION COUNT 83840020 WKATBLOP DS XL1 CODE FOR + OR - TABLE OPERATOR 83860020 * 83880020 DS 0H 83900020 WKALNEST DS 0CL6 LINE NEST 83920020 WKANDFPT DS H POINTER TO CURRENT DEFINITION LINE 83940020 WKANDFBK DS H POINTER BACK TO EARLIER DEFINITION 83960020 WKANLVLN DS XL1 LEVEL OF NESTING (= 1 FOR TOP LINE) 83980020 WKANFMSG DS XL1 MESSAGE CODE IN EFFECT 84000020 CKRNESTL EQU *-WKALNEST LENGTH OF LINE NEST 84020020 * 84040020 WKANLIST EQU * NEST LIST FOLLOWS LINE NEST 84060020 * 84080020 * 84100020 DS XL1616 NEST/QUALIFICATION STACK 84120020 * 84140020 * 84160020 DS 0F 84180020 WKAQLIST EQU * QUALIFICATION LIST PRECEDES QUALIFICATION 84200020 DS 0F 84220020 WKAQUALF DS 0CL12 QUALIFICATION 84240020 WKAQSCPT DS F POINTER TO SOURCE FOR RETRY 84260020 WKAQDFBK DS H POINTER TO DEFINITION FOR ITERATION 84280020 WKAQNLVL DS XL1 LEVEL OF CORRESPONDING LINE NEST 84300020 WKAQFALS DS XL1 DISPLACEMENT TO ALTERNATIVE DEFIN'N 84320020 WKAQTRUE DS XL1 DISPLACEMENT TO RIGHT BRACE 84340020 WKAQICNT DS XL1 ITERATION COUNT 84360020 WKAQSWCH DS XL1 SWITCH FIELD 84380020 CKRCMTSW EQU X'80' COMMIT SWITCH 84400020 DS XL1 FILLER 84420020 CKRQUALL EQU *-WKAQUALF LENGTH OF QUALIFICATION 84440020 * 84460020 * 84480020 * 84500020 WKASPACE EQU *-IPDSNWKA+8 TROUBLE IF THIS EXCEEDS WKARLENT 84520020 WKAEXPAN EQU WKARLENT-WKASPACE 84540020 DS (WKAEXPAN)C EXPANSION SPACE 84560020 * 84580020 * 84600020 * 84620020 WKADNAME DS CL8'IPDSNWKA' NAME OF DSECT FOR RECOG. IN DUMPS 84640020 WKAREAND EQU * ASSEMBLY VALUE SHOULD MATCH WKARLENT 84660020 * 84680020 * 84700020 * 84720020 * 84740020 NLSDSECT DSECT 84760020 NLSLNEST DS 0CL6 LINE NEST LIST ENTRY 84780020 * FIELDS CORRESPOND TO WKALNEST FIELDS 84800020 NLSNDFPT DS H 84820020 NLSNDFBK DS H 84840020 NLSNLEVL DS XL1 84860020 NLSNFMSG DS XL1 84880020 * 84900020 * 84920020 * 84940020 * 84960020 QLSDSECT DSECT 84980020 QLSQUALF DS 0CL12 QUALIFICATION LIST ENTRY 85000020 * FIELDS CORRESPOND TO WKAQUALF FIELDS 85020020 QLSQSCPT DS F 85040020 QLSQDFBK DS H 85060020 QLSQNLVL DS XL1 85080020 QLSQFALS DS XL1 85100020 QLSQTRUE DS XL1 85120020 QLSQICNT DS XL1 85140020 QLSQSWCH DS XL1 85160020 DS XL1 85180020 * 85200020 * 85220020 * 85240020 * 85260020 DEFTABLE DSECT LANGUAGE SYNTAX DEFINITION TABLE 85280020 DEFFIELD DS 0XL1 85300020 DEFOPCDE DS XL1 OPERATION 85320020 DEFARGUM DS XL1 OPERATION'S ARGUMENT, IF ANY 85340020 END IPDSNEXC 92340020 ./ ADD SSI=01012126,NAME=IPDTEE,SOURCE=0 TEE TITLE 'IPDTEE, FORTRAN IV LEVEL E DEFINITION ' 00040019 EJECT 00080019 *********************************************************************** 00120019 * * 00160019 *SYNTAX IPDTEE * 00200019 * * 00240019 *********************************************************************** 00280019 IPDTEE CSECT 00320019 DC AL2(LIN00001-IPDTEE) POINT TO FIRST STMNT. DEF. 00360019 EJECT 00400019 *********************************************************************** 00440019 * * 00480019 *IPDTEE = *3 < 'DO' DO ³ M ASSIGNMENT ³ +KEYWORD ³ N ASSIGNMENT >* 00520019 * * 00560019 * THIS LINE DETERMINES THE OVERALL STRATEGY * 00600019 * IN SCANNING STATEMENTS. ERROR MESSAGE * 00640019 * 3 IS ISSUED IF THE STATEMENT IS NONE OF * 00680019 * THE ALTERNATIVES, SINCE THIS IS THE FIRST * 00720019 * LINE OF THE SYNTAX AND IS THEREFORE AUTOMATIC- * 00760019 * ALLY COMMITTED. ERROR MESSAGE 3 IS * 00800019 * "UNRECOGNIZABLE STMNT OR MISSPELLED KEYWORD". * 00840019 * * 00880019 * AS THIS LINE INDICATES, EACH * 00920019 * STATEMENT IS FIRST EXAMINED TO SEE WHETHER * 00960019 * IT IS A DO STATEMENT. IF IT IS NOT, * 01000019 * IT IS EXAMINED TO SEE WHETHER IT IS AN * 01040019 * ASSIGNMENT STATEMENT, THEN A KEYWORD * 01080019 * STATEMENT, AND FINALLY, IF IT IS NONE * 01120019 * OF THESE, ASSIGNMENT STATEMENT IS ATTEMPTED * 01160019 * ONCE MORE USING A SLIGHTLY DIFFERENT * 01200019 * SYNTAX WHICH ALLOWS THE ASSIGNMENT * 01240019 * STATEMENT TO BEGIN WITH A NAME THAT * 01280019 * IS LONGER THAN SIX CHARACTERS. * 01320019 * IF THE N ASSIGNMENT FORM IS TRIED, THE N * 01360019 * OPERATOR WILL ISSUE A "NAME TOO LONG" MESSAGE * 01400019 * FOR INITIAL NAMES OF MORE THAN SIX CHARACTERS * 01440019 * EVEN THOUGH ASSIGNMENT MAY NEVER BECOME COMMITTED. * 01480019 * * 01520019 *********************************************************************** 01560019 LIN00001 EQU * START OF DEFINITION 01600019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 01640019 DC AL1(COD003) ERROR CODE 01680019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 01720019 DC AL1(ALT00001-LIN00001) FALSE DISP. 01760019 DC AL1(BRC00001-LIN00001) TRUE DISP. 01800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 01840019 DC AL1(002) LENGTH OF LITERAL 01880019 DC C'DO' 01920019 DC AL1(DEFSYMBL) NEST OPERATOR 01960019 DC AL2(LIN00002-IPDTEE) DO 02000019 ALT00001 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 02040019 DC AL1(ALT00002-LIN00001) FALSE DISP. 02080019 DC AL1(DEFMNAME) M NAME OPERATOR M 02120019 DC AL1(DEFSYMBL) NEST OPERATOR 02160019 DC AL2(LIN00003-IPDTEE) ASSIGNMENT 02200019 ALT00002 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 02240019 DC AL1(ALT00003-LIN00001) FALSE DISP. 02280019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 02320019 DC AL2(LIN00004-IPDTEE) KEYWORD 02360019 ALT00003 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 02400019 DC AL1(ALT00004-LIN00001) FALSE DISP. 02440019 DC AL1(DEFNAME) NAME OPERATOR N 02480019 DC AL1(DEFSYMBL) NEST OPERATOR 02520019 DC AL2(LIN00003-IPDTEE) ASSIGNMENT 02560019 ALT00004 EQU * 02600019 BRC00001 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 02640019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 02680019 EJECT 02720019 *********************************************************************** 02760019 * * 02800019 *DO = ( '0' ... ) D ( D .4. ) * 02840019 * ( ',' : *140 $801 *33 ) N *143 '=' *5 * 02880019 * < N ³ USNZINT > *53 ',' : < N ³ / USNZINT > * 02920019 * ( ',' < N ³ / USNZINT > ) * 02960019 * * 03000019 * DEFINES THE SYNTAX OF A DO STATEMENT. * 03040019 * THE N-OPERATOR IS USED HERE INSTEAD OF * 03080019 * THE M-OPERATOR EVEN THOUGH N WILL REQUIRE * 03120019 * AT LEAST ONE VALID NAME BEFORE THE STATEMENT IS * 03160019 * COMMITTED TO BEING A DO STATEMENT. THIS * 03200019 * IS PERMISSIBLE BECAUSE THE INITIAL DIGITS REQUIRED * 03240019 * BY THIS DEFINITION RULE OUT THE POSSIBILITY THAT * 03280019 * A KEYWORD STATEMENT WILL SATISFY THIS DEFINITION. * 03320019 * EACH PARAMETER OF THE DO IS A NAME OR AN * 03360019 * UNSIGNED, NON-ZERO INTEGER. * 03400019 * * 03440019 * THIS DEFINITION WILL ALMOST ALWAYS FAIL * 03480019 * AT THE INITIAL DIGITS, FOR STATEMENTS THAT * 03520019 * ARE NOT DO STATEMENTS. HOWEVER, UNTIL * 03560019 * THE FIRST COMMA IN THE PARAMETER LIST IS * 03600019 * FOUND, IT COULD BE AN ASSIGNMENT STATEMENT * 03640019 * SUCH AS "DO3I=N**2". THEREFORE * 03680019 * THE STATEMENT CANNOT BE COMMITTED TO BEING * 03720019 * A DO STATEMENT UNTIL THE COMMA IS * 03760019 * ENCOUNTERED. * 03800019 * * 03840019 * SHOULD THERE BE A COMMA AFTER THE STATEMENT NUMBER, * 03880019 * ACTION CODE 801 CAUSES MESSAGE 140 TO BE ISSUED, * 03920019 * AND THE STATEMENT IS COMMITTED TO THIS LINE. * 03960019 * * 04000019 *********************************************************************** 04040019 LIN00002 EQU * START OF DEFINITION 04080019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 04120019 DC AL1(PAR00001-LIN00002) POINT TO END OF OPT. ITEMS 04160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04200019 DC AL1(001) LENGTH OF LITERAL 04240019 DC C'0' 04280019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 04320019 PAR00001 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 04360019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 04400019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 04440019 DC AL1(PAR00002-LIN00002) POINT TO END OF OPT. ITEMS 04480019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 04520019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 04560019 DC AL1(004) ITERATION COUNT 04600019 PAR00002 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 04640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 04680019 DC AL1(PAR00003-LIN00002) POINT TO END OF OPT. ITEMS 04720019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 04760019 DC AL1(001) LENGTH OF LITERAL 04800019 DC C',' 04840019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 04880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 04920019 DC AL1(COD140) ERROR CODE 04960019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 05000019 DC AL1(ACT801) ACTION CODE 05040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 05080019 DC AL1(COD033) ERROR CODE 05120019 PAR00003 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 05160019 DC AL1(DEFNAME) NAME OPERATOR N 05200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 05240019 DC AL1(COD143) ERROR CODE 05280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 05320019 DC AL1(001) LENGTH OF LITERAL 05360019 DC C'=' 05400019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 05440019 DC AL1(COD005) ERROR CODE 05480019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 05520019 DC AL1(ALT00005-LIN00002) FALSE DISP. 05560019 DC AL1(BRC00002-LIN00002) TRUE DISP. 05600019 DC AL1(DEFNAME) NAME OPERATOR N 05640019 ALT00005 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 05680019 DC AL1(ALT00006-LIN00002) FALSE DISP. 05720019 DC AL1(DEFSYMBL) NEST OPERATOR 05760019 DC AL2(LIN00005-IPDTEE) USNZINT 05800019 ALT00006 EQU * 05840019 BRC00002 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 05880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 05920019 DC AL1(COD053) ERROR CODE 05960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06000019 DC AL1(001) LENGTH OF LITERAL 06040019 DC C',' 06080019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 06120019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 06160019 DC AL1(ALT00007-LIN00002) FALSE DISP. 06200019 DC AL1(BRC00003-LIN00002) TRUE DISP. 06240019 DC AL1(DEFNAME) NAME OPERATOR N 06280019 ALT00007 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 06320019 DC AL1(ALT00008-LIN00002) FALSE DISP. 06360019 DC AL1(DEFCOMIT) LOCAL COMMIT / 06400019 DC AL1(DEFSYMBL) NEST OPERATOR 06440019 DC AL2(LIN00005-IPDTEE) USNZINT 06480019 ALT00008 EQU * 06520019 BRC00003 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 06560019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 06600019 DC AL1(PAR00004-LIN00002) POINT TO END OF OPT. ITEMS 06640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 06680019 DC AL1(001) LENGTH OF LITERAL 06720019 DC C',' 06760019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 06800019 DC AL1(ALT00009-LIN00002) FALSE DISP. 06840019 DC AL1(BRC00004-LIN00002) TRUE DISP. 06880019 DC AL1(DEFNAME) NAME OPERATOR N 06920019 ALT00009 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 06960019 DC AL1(ALT00010-LIN00002) FALSE DISP. 07000019 DC AL1(DEFCOMIT) LOCAL COMMIT / 07040019 DC AL1(DEFSYMBL) NEST OPERATOR 07080019 DC AL2(LIN00005-IPDTEE) USNZINT 07120019 ALT00010 EQU * 07160019 BRC00004 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 07200019 PAR00004 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 07240019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 07280019 EJECT 07320019 *********************************************************************** 07360019 * * 07400019 *USNZINT = *4 ª'+' ª'-' K $100 * 07440019 * * 07480019 * DEFINES UNSIGNED, NONZERO INTEGER. ACTION CODE * 07520019 * 100 AFTER THE K OPERATOR CHECKS TO SEE THAT * 07560019 * THE NUMERIC CONSTANT FOUND BY THE K OPERATOR * 07600019 * WAS A NON-ZERO INTEGER. * 07640019 * * 07680019 *********************************************************************** 07720019 LIN00005 EQU * START OF DEFINITION 07760019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 07800019 DC AL1(COD004) ERROR CODE 07840019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 07880019 DC AL1(001) LENGTH OF LITERAL 07920019 DC C'+' 07960019 DC AL1(DEFNOTQT) NOT LITERAL OPERATOR ª' 08000019 DC AL1(001) LENGTH OF LITERAL 08040019 DC C'-' 08080019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 08120019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 08160019 DC AL1(ACT100) ACTION CODE 08200019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 08240019 EJECT 08280019 *********************************************************************** 08320019 * * 08360019 *ASSIGNMENT = < '=' : ³ '(' &= < N ( ',' N ... ) ')=' : * 08400019 * $200 ³ SUB ( ',' SUB ... ) ')=' : $202 > > * 08440019 * *7 EXP * 08480019 * * 08520019 * DEFINES TWO CLASSES OF STATEMENTS * 08560019 * * 08600019 * A. ARITHMETIC ASSIGNMENT STATEMENTS * 08640019 * * 08680019 * B. ARITHMETIC STATEMENT FUNCTION DEFINITIONS * 08720019 * * 08760019 * A VALID SYMBOLIC NAME HAS BEEN FOUND BEFORE * 08800019 * THIS LINE IS INVOKED, SO THE SYNTAX OF THE * 08840019 * PART OF THE ASSIGNMENT BEFORE THE EQUALS * 08880019 * SIGN IS ONE OF: * 08920019 * * 08960019 * 1. A NAME * 09000019 * * 09040019 * 2. A NAME FOLLOWED BY A PARENTHESIZED LIST OF NAMES * 09080019 * * 09120019 * 3. A NAME FOLLOWED BY A PARENTHESIZED LIST OF * 09160019 * EXPRESSIONS, AT LEAST ONE OF WHICH IS NOT * 09200019 * SIMPLY A NAME * 09240019 * * 09280019 * IN CASES 1 AND 3, THE STATEMENT IS IN * 09320019 * CLASS A, SINCE CLASS B STATEMENTS MUST * 09360019 * HAVE AT LEAST ONE NAME IN PARENTHESES * 09400019 * BEFORE THE EQUALS SIGN, AND NO EXPRESSION * 09440019 * EXCEPT A NAME IS PERMITTED IN THE PARENTHESES * 09480019 * IN CLASS B STATEMENTS. THEREFORE, IN * 09520019 * CASE 3, ACTION CODE 202 IS USED TO CHECK * 09560019 * FOR MORE THAN THREE SUBSCRIPTS. ACTION * 09600019 * CODE 202 ISSUES A "TOO MANY SUBSCRIPTS PRECEDE" * 09640019 * MESSAGE IF THERE WERE MORE THAN THREE * 09680019 * SUBSCRIPT EXPRESSIONS. * 09720019 * * 09760019 * IN CASE 2, THE STATEMENT COULD BE IN * 09800019 * EITHER CLASS A OR CLASS B, AND SO, IF * 09840019 * MORE THAN THREE NAMES ARE PRESENT, * 09880019 * A "POSSIBLY TOO MANY SUBSCRIPTS PRECEDE" MESSAGE * 09920019 * IS ISSUED BY ACTION CODE 200. * 09960019 * * 10000019 * IF THE STATEMENT IS NOT CASE 1, IT * 10040019 * IS SCANNED TO SEE WHETHER IT CONTAINS * 10080019 * AN EQUALS SIGN SOMEWHERE TO THE RIGHT * 10120019 * OF THE INITIAL NAME. ASSIGNMENT * 10160019 * FAILS IF AN EQUAL SIGN IS NOT FOUND. * 10200019 * UNLESS A HOLLERITH FIELD CONTAINS THE * 10240019 * EQUAL SIGN THAT SATISFIES THE SCANNING * 10280019 * OPERATION, THIS TEST AVOIDS ANALYSIS * 10320019 * OF A PARENTHESIZED FORM ( IN SUCH * 10360019 * STATEMENTS AS FORMAT AND READ ) BY THE * 10400019 * ASSIGNMENT SYNTACTIC LINE, WHEN THERE IS * 10440019 * NO POSSIBITITY THAT THE STATEMENT IS AN ASSIGNMENT. * 10480019 * WHEN AN EQUALS SIGN IS FOUND IN THE * 10520019 * PROPER PLACE, THE STATEMENT IS COMMITTED. * 10560019 * * 10600019 * THE SYNTAX TO THE RIGHT OF THE EQUALS * 10640019 * IS THE SAME FOR CLASSES A AND B, EVEN * 10680019 * THOUGH CLASS B DOES NOT ALLOW REFERENCES * 10720019 * TO SUBSCRIPTED VARIABLES IN THE EXPRESSION. * 10760019 * THIS IS BECAUSE THE SYNTAX CHECKER DOES NOT * 10800019 * HAVE THE INFORMATION THAT WOULD ENABLE IT TO * 10840019 * DETERMINE THAT A NAME FOLLOWED BY A * 10880019 * PARENTHESIZED LIST OF EXPRESSIONS * 10920019 * WAS AN ARRAY ELEMENT REFERENCE AND * 10960019 * NOT A FUNCTION REFERENCE. THE * 11000019 * SYNTAX CHECKER WOULD HAVE TO SAVE * 11040019 * INFORMATION FROM DIMENSION AND OTHER * 11080019 * ARRAY-DECLARING STATEMENTS TO MAKE * 11120019 * THE DISTINCTION, AND THE SYNTAX CHECKER * 11160019 * DOES NOT SAVE SUCH INFORMATION. * 11200019 * * 11240019 *********************************************************************** 11280019 LIN00003 EQU * START OF DEFINITION 11320019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 11360019 DC AL1(ALT00011-LIN00003) FALSE DISP. 11400019 DC AL1(BRC00005-LIN00003) TRUE DISP. 11440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11480019 DC AL1(001) LENGTH OF LITERAL 11520019 DC C'=' 11560019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 11600019 ALT00011 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 11640019 DC AL1(ALT00012-LIN00003) FALSE DISP. 11680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 11720019 DC AL1(001) LENGTH OF LITERAL 11760019 DC C'(' 11800019 DC AL1(DEFSCAN) SEARCH OPERATOR & 11840019 DC C'=' 11880019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 11920019 DC AL1(ALT00013-LIN00003) FALSE DISP. 11960019 DC AL1(BRC00006-LIN00003) TRUE DISP. 12000019 DC AL1(DEFNAME) NAME OPERATOR N 12040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 12080019 DC AL1(PAR00005-LIN00003) POINT TO END OF OPT. ITEMS 12120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12160019 DC AL1(001) LENGTH OF LITERAL 12200019 DC C',' 12240019 DC AL1(DEFNAME) NAME OPERATOR N 12280019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 12320019 PAR00005 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 12360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12400019 DC AL1(002) LENGTH OF LITERAL 12440019 DC C')=' 12480019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 12520019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 12560019 DC AL1(ACT200) ACTION CODE 12600019 ALT00013 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 12640019 DC AL1(ALT00014-LIN00003) FALSE DISP. 12680019 DC AL1(DEFSYMBL) NEST OPERATOR 12720019 DC AL2(LIN00006-IPDTEE) SUB 12760019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 12800019 DC AL1(PAR00006-LIN00003) POINT TO END OF OPT. ITEMS 12840019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 12880019 DC AL1(001) LENGTH OF LITERAL 12920019 DC C',' 12960019 DC AL1(DEFSYMBL) NEST OPERATOR 13000019 DC AL2(LIN00006-IPDTEE) SUB 13040019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 13080019 PAR00006 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 13120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 13160019 DC AL1(002) LENGTH OF LITERAL 13200019 DC C')=' 13240019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 13280019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 13320019 DC AL1(ACT202) ACTION CODE 13360019 ALT00014 EQU * 13400019 BRC00006 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 13440019 ALT00012 EQU * 13480019 BRC00005 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 13520019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 13560019 DC AL1(COD007) ERROR CODE 13600019 DC AL1(DEFSYMBL) NEST OPERATOR 13640019 DC AL2(LIN00007-IPDTEE) EXP 13680019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 13720019 EJECT 13760019 *********************************************************************** 13800019 * * 13840019 *SUB = *67 < ( USNZINT '*' ) N ( < '+' ³ '-' > / * 13880019 * USNZINT ) ³ USNZINT > * 13920019 * * 13960019 * DEFINES SUBSCRIPT EXPRESSION. THIS FORM IS * 14000019 * USED FOR THE EXPRESSIONS WHEREVER IT IS * 14040019 * CERTAIN THAT A NAME FOLLOWED BY A PARENTHESIZED * 14080019 * LIST OF EXPRESSIONS IS AN ARRAY ELEMENT REFERENCE * 14120019 * AND NOT A FUNCTION REFERENCE, AS IN * 14160019 * INPUT/OUTPUT LISTS. * 14200019 * * 14240019 *********************************************************************** 14280019 LIN00006 EQU * START OF DEFINITION 14320019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 14360019 DC AL1(COD067) ERROR CODE 14400019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 14440019 DC AL1(ALT00015-LIN00006) FALSE DISP. 14480019 DC AL1(BRC00007-LIN00006) TRUE DISP. 14520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 14560019 DC AL1(PAR00007-LIN00006) POINT TO END OF OPT. ITEMS 14600019 DC AL1(DEFSYMBL) NEST OPERATOR 14640019 DC AL2(LIN00005-IPDTEE) USNZINT 14680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 14720019 DC AL1(001) LENGTH OF LITERAL 14760019 DC C'*' 14800019 PAR00007 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 14840019 DC AL1(DEFNAME) NAME OPERATOR N 14880019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 14920019 DC AL1(PAR00008-LIN00006) POINT TO END OF OPT. ITEMS 14960019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 15000019 DC AL1(ALT00016-LIN00006) FALSE DISP. 15040019 DC AL1(BRC00008-LIN00006) TRUE DISP. 15080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 15120019 DC AL1(001) LENGTH OF LITERAL 15160019 DC C'+' 15200019 ALT00016 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 15240019 DC AL1(ALT00017-LIN00006) FALSE DISP. 15280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 15320019 DC AL1(001) LENGTH OF LITERAL 15360019 DC C'-' 15400019 ALT00017 EQU * 15440019 BRC00008 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 15480019 DC AL1(DEFCOMIT) LOCAL COMMIT / 15520019 DC AL1(DEFSYMBL) NEST OPERATOR 15560019 DC AL2(LIN00005-IPDTEE) USNZINT 15600019 PAR00008 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 15640019 ALT00015 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 15680019 DC AL1(ALT00018-LIN00006) FALSE DISP. 15720019 DC AL1(DEFSYMBL) NEST OPERATOR 15760019 DC AL2(LIN00005-IPDTEE) USNZINT 15800019 ALT00018 EQU * 15840019 BRC00007 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 15880019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 15920019 EJECT 15960019 *********************************************************************** 16000019 * * 16040019 *EXP = ( < '+' ³ '-' > ) OPERAND *55 ( +ARITHOP / * 16080019 * OPERAND ... ) * 16120019 * * 16160019 * DEFINES ARITHMETIC EXPRESSION. * 16200019 * * 16240019 *********************************************************************** 16280019 LIN00007 EQU * START OF DEFINITION 16320019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 16360019 DC AL1(PAR00009-LIN00007) POINT TO END OF OPT. ITEMS 16400019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 16440019 DC AL1(ALT00019-LIN00007) FALSE DISP. 16480019 DC AL1(BRC00009-LIN00007) TRUE DISP. 16520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16560019 DC AL1(001) LENGTH OF LITERAL 16600019 DC C'+' 16640019 ALT00019 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 16680019 DC AL1(ALT00020-LIN00007) FALSE DISP. 16720019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 16760019 DC AL1(001) LENGTH OF LITERAL 16800019 DC C'-' 16840019 ALT00020 EQU * 16880019 BRC00009 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 16920019 PAR00009 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 16960019 DC AL1(DEFSYMBL) NEST OPERATOR 17000019 DC AL2(LIN00008-IPDTEE) OPERAND 17040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 17080019 DC AL1(COD055) ERROR CODE 17120019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 17160019 DC AL1(PAR00010-LIN00007) POINT TO END OF OPT. ITEMS 17200019 DC AL1(DEFTABLP) +TABLE-NAME OPERATOR + 17240019 DC AL2(LIN00009-IPDTEE) ARITHOP 17280019 DC AL1(DEFCOMIT) LOCAL COMMIT / 17320019 DC AL1(DEFSYMBL) NEST OPERATOR 17360019 DC AL2(LIN00008-IPDTEE) OPERAND 17400019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 17440019 PAR00010 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 17480019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 17520019 EJECT 17560019 *********************************************************************** 17600019 * * 17640019 *ARITHOP = " '+' 0 '-' 0 '/' 0 '**' 0 '*' 0 " * 17680019 * * 17720019 * TABLE OF THE ARITHMETIC OPERATORS. THE * 17760019 * DOUBLE ASTERISK MUST PRECEDE THE SINGLE * 17800019 * ASTERISK SO THAT A SPURIOUS MATCH ON * 17840019 * "SINGLE ASTERISK" WILL NOT OCCUR WHEN THE * 17880019 * SOURCE STATEMENT CONTAINS A DOUBLE * 17920019 * ASTERISK. * 17960019 * * 18000019 *********************************************************************** 18040019 LIN00009 EQU * START OF DEFINITION 18080019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 18120019 DC AL2(TAB00001-*+1) LENGTH OF TABLE 18160019 DC AL1(001) LENGTH OF LITERAL 18200019 DC C'+' 18240019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 18280019 DC X'FF' NULL ACTION CODE 18320019 DC C'T' TABLE FUNCTION PAD CHARACTER 18360019 DC AL1(001) LENGTH OF LITERAL 18400019 DC C'-' 18440019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 18480019 DC X'FF' NULL ACTION CODE 18520019 DC C'T' TABLE FUNCTION PAD CHARACTER 18560019 DC AL1(001) LENGTH OF LITERAL 18600019 DC C'/' 18640019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 18680019 DC X'FF' NULL ACTION CODE 18720019 DC C'T' TABLE FUNCTION PAD CHARACTER 18760019 DC AL1(002) LENGTH OF LITERAL 18800019 DC C'**' 18840019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 18880019 DC X'FF' NULL ACTION CODE 18920019 DC C'T' TABLE FUNCTION PAD CHARACTER 18960019 DC AL1(001) LENGTH OF LITERAL 19000019 DC C'*' 19040019 DC AL1(DEFACTN) ACTION CODE OPERATOR 0 19080019 DC X'FF' NULL ACTION CODE 19120019 DC C'T' TABLE FUNCTION PAD CHARACTER 19160019 TAB00001 DC AL1(002) LENGTH OF LONGEST TABLE ARG 19200019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 19240019 EJECT 19280019 *********************************************************************** 19320019 * * 19360019 *OPERAND = < K ³ N ( '(' / *7 EXP ( ',' / EXP* 19400019 * ... ) $200 *12 ')' ) ³ '(' / *7 EXP *12 ')' >* 19440019 * * 19480019 * DEFINES ARITHMETIC OPERANDS FOR USE IN * 19520019 * ARITHMETIC EXPRESSIONS. * 19560019 * * 19600019 *********************************************************************** 19640019 LIN00008 EQU * START OF DEFINITION 19680019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 19720019 DC AL1(ALT00021-LIN00008) FALSE DISP. 19760019 DC AL1(BRC00010-LIN00008) TRUE DISP. 19800019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 19840019 ALT00021 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 19880019 DC AL1(ALT00022-LIN00008) FALSE DISP. 19920019 DC AL1(DEFNAME) NAME OPERATOR N 19960019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 20000019 DC AL1(PAR00011-LIN00008) POINT TO END OF OPT. ITEMS 20040019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20080019 DC AL1(001) LENGTH OF LITERAL 20120019 DC C'(' 20160019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 20240019 DC AL1(COD007) ERROR CODE 20280019 DC AL1(DEFSYMBL) NEST OPERATOR 20320019 DC AL2(LIN00007-IPDTEE) EXP 20360019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 20400019 DC AL1(PAR00012-LIN00008) POINT TO END OF OPT. ITEMS 20440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20480019 DC AL1(001) LENGTH OF LITERAL 20520019 DC C',' 20560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 20600019 DC AL1(DEFSYMBL) NEST OPERATOR 20640019 DC AL2(LIN00007-IPDTEE) EXP 20680019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 20720019 PAR00012 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 20760019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 20800019 DC AL1(ACT200) ACTION CODE 20840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 20880019 DC AL1(COD012) ERROR CODE 20920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 20960019 DC AL1(001) LENGTH OF LITERAL 21000019 DC C')' 21040019 PAR00011 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 21080019 ALT00022 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 21120019 DC AL1(ALT00023-LIN00008) FALSE DISP. 21160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21200019 DC AL1(001) LENGTH OF LITERAL 21240019 DC C'(' 21280019 DC AL1(DEFCOMIT) LOCAL COMMIT / 21320019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 21360019 DC AL1(COD007) ERROR CODE 21400019 DC AL1(DEFSYMBL) NEST OPERATOR 21440019 DC AL2(LIN00007-IPDTEE) EXP 21480019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 21520019 DC AL1(COD012) ERROR CODE 21560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 21600019 DC AL1(001) LENGTH OF LITERAL 21640019 DC C')' 21680019 ALT00023 EQU * 21720019 BRC00010 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 21760019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 21800019 EJECT 21840019 *********************************************************************** 21880019 * * 21920019 *KEYWORD = " 'BACK' BACKSPACE 'CALL' CALL 'COMM' COMMON * 21960019 * 'CONT' CONTINUE 'DEFI' DEFINEFILE 'DIME' DIMENSION * 22000019 * 'DOUB' DOUBLE 'ENDF' ENDFILE 'END' END * 22040019 * 'EQUI' EQUIVALENCE 'EXTE' EXTERNAL 'FIND' FIND * 22080019 * 'FORM' FORMAT 'FUNC' FUNCTION 'GOTO' GOTO * 22120019 * 'IF' IF 'INTE' INTEGER 'PAUS' PAUSE * 22160019 * 'READ' READ 'REAL' REAL 'RETU' RETURN * 22200019 * 'REWI' REWIND 'SUBR' SUBROUTINE 'STOP' STOP * 22240019 * 'WRIT' WRITE " * 22280019 * * 22320019 * TABLE OF ALL THE KEYWORDS THAT MAY APPEAR * 22360019 * AT THE BEGINNING OF A STATEMENT. FOR EACH OF THE ENTRIES * 22400019 * A MATCH WITH THE LITERAL RESULTS IN A * 22440019 * TRANSFER TO THE APPROPRIATE SYNTACTIC LINE. * 22480019 * * 22520019 *********************************************************************** 22560019 LIN00004 EQU * START OF DEFINITION 22600019 DC AL1(DEFTABLE) START OF TABLE ENTRIES " 22640019 DC AL2(TAB00002-*+1) LENGTH OF TABLE 22680019 DC AL1(004) LENGTH OF LITERAL 22720019 DC C'BACK' 22760019 DC AL1(DEFSYMBL) NEST OPERATOR 22800019 DC AL2(LIN00010-IPDTEE) BACKSPACE 22840019 DC AL1(004) LENGTH OF LITERAL 22880019 DC C'CALL' 22920019 DC AL1(DEFSYMBL) NEST OPERATOR 22960019 DC AL2(LIN00011-IPDTEE) CALL 23000019 DC AL1(004) LENGTH OF LITERAL 23040019 DC C'COMM' 23080019 DC AL1(DEFSYMBL) NEST OPERATOR 23120019 DC AL2(LIN00012-IPDTEE) COMMON 23160019 DC AL1(004) LENGTH OF LITERAL 23200019 DC C'CONT' 23240019 DC AL1(DEFSYMBL) NEST OPERATOR 23280019 DC AL2(LIN00013-IPDTEE) CONTINUE 23320019 DC AL1(004) LENGTH OF LITERAL 23360019 DC C'DEFI' 23400019 DC AL1(DEFSYMBL) NEST OPERATOR 23440019 DC AL2(LIN00014-IPDTEE) DEFINEFILE 23480019 DC AL1(004) LENGTH OF LITERAL 23520019 DC C'DIME' 23560019 DC AL1(DEFSYMBL) NEST OPERATOR 23600019 DC AL2(LIN00015-IPDTEE) DIMENSION 23640019 DC AL1(004) LENGTH OF LITERAL 23680019 DC C'DOUB' 23720019 DC AL1(DEFSYMBL) NEST OPERATOR 23760019 DC AL2(LIN00016-IPDTEE) DOUBLE 23800019 DC AL1(004) LENGTH OF LITERAL 23840019 DC C'ENDF' 23880019 DC AL1(DEFSYMBL) NEST OPERATOR 23920019 DC AL2(LIN00017-IPDTEE) ENDFILE 23960019 DC AL1(003) LENGTH OF LITERAL 24000019 DC C'END' 24040019 DC AL1(DEFSYMBL) NEST OPERATOR 24080019 DC AL2(LIN00018-IPDTEE) END 24120019 DC AL1(004) LENGTH OF LITERAL 24160019 DC C'EQUI' 24200019 DC AL1(DEFSYMBL) NEST OPERATOR 24240019 DC AL2(LIN00019-IPDTEE) EQUIVALENCE 24280019 DC AL1(004) LENGTH OF LITERAL 24320019 DC C'EXTE' 24360019 DC AL1(DEFSYMBL) NEST OPERATOR 24400019 DC AL2(LIN00020-IPDTEE) EXTERNAL 24440019 DC AL1(004) LENGTH OF LITERAL 24480019 DC C'FIND' 24520019 DC AL1(DEFSYMBL) NEST OPERATOR 24560019 DC AL2(LIN00021-IPDTEE) FIND 24600019 DC AL1(004) LENGTH OF LITERAL 24640019 DC C'FORM' 24680019 DC AL1(DEFSYMBL) NEST OPERATOR 24720019 DC AL2(LIN00022-IPDTEE) FORMAT 24760019 DC AL1(004) LENGTH OF LITERAL 24800019 DC C'FUNC' 24840019 DC AL1(DEFSYMBL) NEST OPERATOR 24880019 DC AL2(LIN00023-IPDTEE) FUNCTION 24920019 DC AL1(004) LENGTH OF LITERAL 24960019 DC C'GOTO' 25000019 DC AL1(DEFSYMBL) NEST OPERATOR 25040019 DC AL2(LIN00024-IPDTEE) GOTO 25080019 DC AL1(002) LENGTH OF LITERAL 25120019 DC C'IF' 25160019 DC AL1(DEFSYMBL) NEST OPERATOR 25200019 DC AL2(LIN00025-IPDTEE) IF 25240019 DC AL1(004) LENGTH OF LITERAL 25280019 DC C'INTE' 25320019 DC AL1(DEFSYMBL) NEST OPERATOR 25360019 DC AL2(LIN00026-IPDTEE) INTEGER 25400019 DC AL1(004) LENGTH OF LITERAL 25440019 DC C'PAUS' 25480019 DC AL1(DEFSYMBL) NEST OPERATOR 25520019 DC AL2(LIN00027-IPDTEE) PAUSE 25560019 DC AL1(004) LENGTH OF LITERAL 25600019 DC C'READ' 25640019 DC AL1(DEFSYMBL) NEST OPERATOR 25680019 DC AL2(LIN00028-IPDTEE) READ 25720019 DC AL1(004) LENGTH OF LITERAL 25760019 DC C'REAL' 25800019 DC AL1(DEFSYMBL) NEST OPERATOR 25840019 DC AL2(LIN00029-IPDTEE) REAL 25880019 DC AL1(004) LENGTH OF LITERAL 25920019 DC C'RETU' 25960019 DC AL1(DEFSYMBL) NEST OPERATOR 26000019 DC AL2(LIN00030-IPDTEE) RETURN 26040019 DC AL1(004) LENGTH OF LITERAL 26080019 DC C'REWI' 26120019 DC AL1(DEFSYMBL) NEST OPERATOR 26160019 DC AL2(LIN00031-IPDTEE) REWIND 26200019 DC AL1(004) LENGTH OF LITERAL 26240019 DC C'SUBR' 26280019 DC AL1(DEFSYMBL) NEST OPERATOR 26320019 DC AL2(LIN00032-IPDTEE) SUBROUTINE 26360019 DC AL1(004) LENGTH OF LITERAL 26400019 DC C'STOP' 26440019 DC AL1(DEFSYMBL) NEST OPERATOR 26480019 DC AL2(LIN00033-IPDTEE) STOP 26520019 DC AL1(004) LENGTH OF LITERAL 26560019 DC C'WRIT' 26600019 DC AL1(DEFSYMBL) NEST OPERATOR 26640019 DC AL2(LIN00034-IPDTEE) WRITE 26680019 TAB00002 DC AL1(004) LENGTH OF LONGEST TABLE ARG 26720019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 26760019 EJECT 26800019 *********************************************************************** 26840019 * * 26880019 *BACKSPACE = 'SPACE' : DSREFNO * 26920019 * * 26960019 * DEFINES THE BACKSPACE STATEMENT. * 27000019 * * 27040019 *********************************************************************** 27080019 LIN00010 EQU * START OF DEFINITION 27120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 27160019 DC AL1(005) LENGTH OF LITERAL 27200019 DC C'SPACE' 27240019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 27280019 DC AL1(DEFSYMBL) NEST OPERATOR 27320019 DC AL2(LIN00035-IPDTEE) DSREFNO 27360019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 27400019 EJECT 27440019 *********************************************************************** 27480019 * * 27520019 *DSREFNO = *27 < N ³ K / $105 > * 27560019 * * 27600019 * DEFINES DATA SET REFERENCE NUMBER. * 27640019 * ACTION CODE 105 ISSUES AN APPROPRIATE * 27680019 * MESSAGE IF THE K ALTERNATIVE ENCOUNTERS * 27720019 * ANY NUMERIC CONSTANT OTHER THAN A NON-ZERO * 27760019 * INTEGER LESS THAN OR EQUAL TO 99. * 27800019 * * 27840019 *********************************************************************** 27880019 LIN00035 EQU * START OF DEFINITION 27920019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 27960019 DC AL1(COD027) ERROR CODE 28000019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 28040019 DC AL1(ALT00024-LIN00035) FALSE DISP. 28080019 DC AL1(BRC00011-LIN00035) TRUE DISP. 28120019 DC AL1(DEFNAME) NAME OPERATOR N 28160019 ALT00024 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 28200019 DC AL1(ALT00025-LIN00035) FALSE DISP. 28240019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 28280019 DC AL1(DEFCOMIT) LOCAL COMMIT / 28320019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 28360019 DC AL1(ACT105) ACTION CODE 28400019 ALT00025 EQU * 28440019 BRC00011 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 28480019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 28520019 EJECT 28560019 *********************************************************************** 28600019 * * 28640019 *CALL = : *33 N ( '(' / *46 EXP ( ',' / * 28680019 * EXP ... ) *13 ')' ) * 28720019 * * 28760019 * DEFINES THE CALL STATEMENT. * 28800019 * * 28840019 *********************************************************************** 28880019 LIN00011 EQU * START OF DEFINITION 28920019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 28960019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29000019 DC AL1(COD033) ERROR CODE 29040019 DC AL1(DEFNAME) NAME OPERATOR N 29080019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29120019 DC AL1(PAR00013-LIN00011) POINT TO END OF OPT. ITEMS 29160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29200019 DC AL1(001) LENGTH OF LITERAL 29240019 DC C'(' 29280019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29320019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29360019 DC AL1(COD046) ERROR CODE 29400019 DC AL1(DEFSYMBL) NEST OPERATOR 29440019 DC AL2(LIN00007-IPDTEE) EXP 29480019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 29520019 DC AL1(PAR00014-LIN00011) POINT TO END OF OPT. ITEMS 29560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 29600019 DC AL1(001) LENGTH OF LITERAL 29640019 DC C',' 29680019 DC AL1(DEFCOMIT) LOCAL COMMIT / 29720019 DC AL1(DEFSYMBL) NEST OPERATOR 29760019 DC AL2(LIN00007-IPDTEE) EXP 29800019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 29840019 PAR00014 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 29880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 29920019 DC AL1(COD013) ERROR CODE 29960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30000019 DC AL1(001) LENGTH OF LITERAL 30040019 DC C')' 30080019 PAR00013 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 30120019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 30160019 EJECT 30200019 *********************************************************************** 30240019 * * 30280019 *COMMON = 'ON' : *33 N ( DECLARATOR ) ( ',' / N * 30320019 * ( DECLARATOR ) ... ) * 30360019 * * 30400019 * DEFINES THE COMMON STATEMENT. * 30440019 * * 30480019 *********************************************************************** 30520019 LIN00012 EQU * START OF DEFINITION 30560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 30600019 DC AL1(002) LENGTH OF LITERAL 30640019 DC C'ON' 30680019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 30720019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 30760019 DC AL1(COD033) ERROR CODE 30800019 DC AL1(DEFNAME) NAME OPERATOR N 30840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 30880019 DC AL1(PAR00015-LIN00012) POINT TO END OF OPT. ITEMS 30920019 DC AL1(DEFSYMBL) NEST OPERATOR 30960019 DC AL2(LIN00036-IPDTEE) DECLARATOR 31000019 PAR00015 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31040019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31080019 DC AL1(PAR00016-LIN00012) POINT TO END OF OPT. ITEMS 31120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 31160019 DC AL1(001) LENGTH OF LITERAL 31200019 DC C',' 31240019 DC AL1(DEFCOMIT) LOCAL COMMIT / 31280019 DC AL1(DEFNAME) NAME OPERATOR N 31320019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 31360019 DC AL1(PAR00017-LIN00012) POINT TO END OF OPT. ITEMS 31400019 DC AL1(DEFSYMBL) NEST OPERATOR 31440019 DC AL2(LIN00036-IPDTEE) DECLARATOR 31480019 PAR00017 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31520019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 31560019 PAR00016 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 31600019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 31640019 EJECT 31680019 *********************************************************************** 31720019 * * 31760019 *DECLARATOR = *37 '(' / USNZINT ( ',' / $201 USNZINT ... ) *12 ')' * 31800019 * * 31840019 * DEFINES ARRAY DECLARATORS WITH CONSTANT * 31880019 * DECLARATORS. * 31920019 * * 31960019 *********************************************************************** 32000019 LIN00036 EQU * START OF DEFINITION 32040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 32080019 DC AL1(COD037) ERROR CODE 32120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32160019 DC AL1(001) LENGTH OF LITERAL 32200019 DC C'(' 32240019 DC AL1(DEFCOMIT) LOCAL COMMIT / 32280019 DC AL1(DEFSYMBL) NEST OPERATOR 32320019 DC AL2(LIN00005-IPDTEE) USNZINT 32360019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 32400019 DC AL1(PAR00018-LIN00036) POINT TO END OF OPT. ITEMS 32440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32480019 DC AL1(001) LENGTH OF LITERAL 32520019 DC C',' 32560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 32600019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 32640019 DC AL1(ACT201) ACTION CODE 32680019 DC AL1(DEFSYMBL) NEST OPERATOR 32720019 DC AL2(LIN00005-IPDTEE) USNZINT 32760019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 32800019 PAR00018 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 32840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 32880019 DC AL1(COD012) ERROR CODE 32920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 32960019 DC AL1(001) LENGTH OF LITERAL 33000019 DC C')' 33040019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 33080019 EJECT 33120019 *********************************************************************** 33160019 * * 33200019 *CONTINUE = 'INUE' : * 33240019 * * 33280019 * DEFINES THE CONTINUE STATEMENT * 33320019 * * 33360019 *********************************************************************** 33400019 LIN00013 EQU * START OF DEFINITION 33440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 33480019 DC AL1(004) LENGTH OF LITERAL 33520019 DC C'INUE' 33560019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 33600019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 33640019 EJECT 33680019 *********************************************************************** 33720019 * * 33760019 *DEFINEFILE = 'NEFILE' : *27 K $105 *31 '(' USNZINT * 33800019 * *53 ',' USNZINT ',' *63 < 'L' ³ 'E' ³ 'U' > * 33840019 * *53 ',' *33 N *13 ')' ( ',' / *27 K $105 *31 * 33880019 * '(' USNZINT *53 ',' USNZINT ',' *63 * 33920019 * < 'L' ³ 'E' ³ 'U' > *53 ',' *33 N *13 ')' ... ) * 33960019 * * 34000019 * DEFINES THE DEFINE FILE STATEMENT. IN * 34040019 * THIS STATEMENT, THE DATA SET REFERENCE * 34080019 * NUMBER CANNOT BE A SYMBOLIC NAME, SO * 34120019 * THE K OPERATOR FOLLOWED BY ACTION CODE 105 * 34160019 * IS USED WHERE DATA SET REFERENCE NUMBERS ARE * 34200019 * REQUIRED. THE FORM OF THE BASIC ELEMENT * 34240019 * OF THIS STATEMENT IS GIVEN ON THE FIRST * 34280019 * TWO AND-A-HALF LINES. THE LAST TWO * 34320019 * AND-A-HALF LINES DESCRIBE THE OPTIONAL * 34360019 * REPETITION OF THIS ELEMENT FOLLOWING A COMMA. * 34400019 * * 34440019 *********************************************************************** 34480019 LIN00014 EQU * START OF DEFINITION 34520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 34560019 DC AL1(006) LENGTH OF LITERAL 34600019 DC C'NEFILE' 34640019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 34680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34720019 DC AL1(COD027) ERROR CODE 34760019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 34800019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 34840019 DC AL1(ACT105) ACTION CODE 34880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 34920019 DC AL1(COD031) ERROR CODE 34960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35000019 DC AL1(001) LENGTH OF LITERAL 35040019 DC C'(' 35080019 DC AL1(DEFSYMBL) NEST OPERATOR 35120019 DC AL2(LIN00005-IPDTEE) USNZINT 35160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35200019 DC AL1(COD053) ERROR CODE 35240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35280019 DC AL1(001) LENGTH OF LITERAL 35320019 DC C',' 35360019 DC AL1(DEFSYMBL) NEST OPERATOR 35400019 DC AL2(LIN00005-IPDTEE) USNZINT 35440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35480019 DC AL1(001) LENGTH OF LITERAL 35520019 DC C',' 35560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 35600019 DC AL1(COD063) ERROR CODE 35640019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 35680019 DC AL1(ALT00026-LIN00014) FALSE DISP. 35720019 DC AL1(BRC00012-LIN00014) TRUE DISP. 35760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 35800019 DC AL1(001) LENGTH OF LITERAL 35840019 DC C'L' 35880019 ALT00026 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 35920019 DC AL1(ALT00027-LIN00014) FALSE DISP. 35960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36000019 DC AL1(001) LENGTH OF LITERAL 36040019 DC C'E' 36080019 ALT00027 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 36120019 DC AL1(ALT00028-LIN00014) FALSE DISP. 36160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36200019 DC AL1(001) LENGTH OF LITERAL 36240019 DC C'U' 36280019 ALT00028 EQU * 36320019 BRC00012 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 36360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36400019 DC AL1(COD053) ERROR CODE 36440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36480019 DC AL1(001) LENGTH OF LITERAL 36520019 DC C',' 36560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36600019 DC AL1(COD033) ERROR CODE 36640019 DC AL1(DEFNAME) NAME OPERATOR N 36680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 36720019 DC AL1(COD013) ERROR CODE 36760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 36800019 DC AL1(001) LENGTH OF LITERAL 36840019 DC C')' 36880019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 36920019 DC AL1(PAR00019-LIN00014) POINT TO END OF OPT. ITEMS 36960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37000019 DC AL1(001) LENGTH OF LITERAL 37040019 DC C',' 37080019 DC AL1(DEFCOMIT) LOCAL COMMIT / 37120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37160019 DC AL1(COD027) ERROR CODE 37200019 DC AL1(DEFNUMBR) NUMERIC CONSTANT OPERATOR K 37240019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 37280019 DC AL1(ACT105) ACTION CODE 37320019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37360019 DC AL1(COD031) ERROR CODE 37400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37440019 DC AL1(001) LENGTH OF LITERAL 37480019 DC C'(' 37520019 DC AL1(DEFSYMBL) NEST OPERATOR 37560019 DC AL2(LIN00005-IPDTEE) USNZINT 37600019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 37640019 DC AL1(COD053) ERROR CODE 37680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37720019 DC AL1(001) LENGTH OF LITERAL 37760019 DC C',' 37800019 DC AL1(DEFSYMBL) NEST OPERATOR 37840019 DC AL2(LIN00005-IPDTEE) USNZINT 37880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 37920019 DC AL1(001) LENGTH OF LITERAL 37960019 DC C',' 38000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 38040019 DC AL1(COD063) ERROR CODE 38080019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 38120019 DC AL1(ALT00029-LIN00014) FALSE DISP. 38160019 DC AL1(BRC00013-LIN00014) TRUE DISP. 38200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38240019 DC AL1(001) LENGTH OF LITERAL 38280019 DC C'L' 38320019 ALT00029 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 38360019 DC AL1(ALT00030-LIN00014) FALSE DISP. 38400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38440019 DC AL1(001) LENGTH OF LITERAL 38480019 DC C'E' 38520019 ALT00030 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 38560019 DC AL1(ALT00031-LIN00014) FALSE DISP. 38600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38640019 DC AL1(001) LENGTH OF LITERAL 38680019 DC C'U' 38720019 ALT00031 EQU * 38760019 BRC00013 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 38800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 38840019 DC AL1(COD053) ERROR CODE 38880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 38920019 DC AL1(001) LENGTH OF LITERAL 38960019 DC C',' 39000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39040019 DC AL1(COD033) ERROR CODE 39080019 DC AL1(DEFNAME) NAME OPERATOR N 39120019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 39160019 DC AL1(COD013) ERROR CODE 39200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 39240019 DC AL1(001) LENGTH OF LITERAL 39280019 DC C')' 39320019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 39360019 PAR00019 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 39400019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 39440019 EJECT 39480019 *********************************************************************** 39520019 * * 39560019 *DIMENSION = 'NSION' : *33 N DECLARATOR ( ',' / N DECLARATOR * 39600019 * ... ) * 39640019 * * 39680019 * DEFINES THE DIMENSION STATEMENT. SINCE * 39720019 * THE LINE IS COMMITTED AFTER THE LITERAL IS * 39760019 * MATCHED, THE "ARRAY DIMENSIONS EXPECTED" MESSAGE * 39800019 * ON THE DECLARATOR LINE WILL BE ISSUED IF * 39840019 * A DECLARATOR IS MISSING. THE "NAME EXPECTED" * 39880019 * MESSAGE ON THIS LINE THEREFORE APPLIES TO THE * 39920019 * ENTIRE LINE. * 39960019 * * 40000019 *********************************************************************** 40040019 LIN00015 EQU * START OF DEFINITION 40080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40120019 DC AL1(005) LENGTH OF LITERAL 40160019 DC C'NSION' 40200019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 40240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 40280019 DC AL1(COD033) ERROR CODE 40320019 DC AL1(DEFNAME) NAME OPERATOR N 40360019 DC AL1(DEFSYMBL) NEST OPERATOR 40400019 DC AL2(LIN00036-IPDTEE) DECLARATOR 40440019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 40480019 DC AL1(PAR00020-LIN00015) POINT TO END OF OPT. ITEMS 40520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 40560019 DC AL1(001) LENGTH OF LITERAL 40600019 DC C',' 40640019 DC AL1(DEFCOMIT) LOCAL COMMIT / 40680019 DC AL1(DEFNAME) NAME OPERATOR N 40720019 DC AL1(DEFSYMBL) NEST OPERATOR 40760019 DC AL2(LIN00036-IPDTEE) DECLARATOR 40800019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 40840019 PAR00020 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 40880019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 40920019 EJECT 40960019 *********************************************************************** 41000019 * * 41040019 *DOUBLE = 'LEPRECISION' < 'FUNC' FUNCTION ³ TYPE > * 41080019 * * 41120019 * TABLE OF TRANSFERS FOR STATEMENTS BEGINNING * 41160019 * WITH 'DOUBLE PRECISION'. * 41200019 * * 41240019 *********************************************************************** 41280019 LIN00016 EQU * START OF DEFINITION 41320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41360019 DC AL1(011) LENGTH OF LITERAL 41400019 DC C'LEPRECISION' 41440019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 41480019 DC AL1(ALT00032-LIN00016) FALSE DISP. 41520019 DC AL1(BRC00014-LIN00016) TRUE DISP. 41560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 41600019 DC AL1(004) LENGTH OF LITERAL 41640019 DC C'FUNC' 41680019 DC AL1(DEFSYMBL) NEST OPERATOR 41720019 DC AL2(LIN00023-IPDTEE) FUNCTION 41760019 ALT00032 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 41800019 DC AL1(ALT00033-LIN00016) FALSE DISP. 41840019 DC AL1(DEFSYMBL) NEST OPERATOR 41880019 DC AL2(LIN00037-IPDTEE) TYPE 41920019 ALT00033 EQU * 41960019 BRC00014 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 42000019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 42040019 EJECT 42080019 *********************************************************************** 42120019 * * 42160019 *TYPE = : *33 N ( DECLARATOR ) ( ',' / N * 42200019 * ( DECLARATOR ) ... ) * 42240019 * * 42280019 * DEFINES ALL THE TYPE-STATEMENTS. THIS * 42320019 * DEFINITION IS USED AFTER THE KEYWORD AT * 42360019 * THE BEGINNING OF THE TYPE-STATEMENT HAS * 42400019 * BEEN MATCHED IN THE APPROPRIATE TABLE. * 42440019 * * 42480019 *********************************************************************** 42520019 LIN00037 EQU * START OF DEFINITION 42560019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 42600019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 42640019 DC AL1(COD033) ERROR CODE 42680019 DC AL1(DEFNAME) NAME OPERATOR N 42720019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42760019 DC AL1(PAR00021-LIN00037) POINT TO END OF OPT. ITEMS 42800019 DC AL1(DEFSYMBL) NEST OPERATOR 42840019 DC AL2(LIN00036-IPDTEE) DECLARATOR 42880019 PAR00021 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 42920019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 42960019 DC AL1(PAR00022-LIN00037) POINT TO END OF OPT. ITEMS 43000019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43040019 DC AL1(001) LENGTH OF LITERAL 43080019 DC C',' 43120019 DC AL1(DEFCOMIT) LOCAL COMMIT / 43160019 DC AL1(DEFNAME) NAME OPERATOR N 43200019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 43240019 DC AL1(PAR00023-LIN00037) POINT TO END OF OPT. ITEMS 43280019 DC AL1(DEFSYMBL) NEST OPERATOR 43320019 DC AL2(LIN00036-IPDTEE) DECLARATOR 43360019 PAR00023 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43400019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 43440019 PAR00022 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 43480019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 43520019 EJECT 43560019 *********************************************************************** 43600019 * * 43640019 *ENDFILE = 'ILE' : DSREFNO * 43680019 * * 43720019 * DEFINES THE ENDFILE STATEMENT. * 43760019 * * 43800019 *********************************************************************** 43840019 LIN00017 EQU * START OF DEFINITION 43880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 43920019 DC AL1(003) LENGTH OF LITERAL 43960019 DC C'ILE' 44000019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 44040019 DC AL1(DEFSYMBL) NEST OPERATOR 44080019 DC AL2(LIN00035-IPDTEE) DSREFNO 44120019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 44160019 EJECT 44200019 *********************************************************************** 44240019 * * 44280019 *END = $800 : $300 * 44320019 * * 44360019 * DEFINES THE END LINE. ACTION CODE 800 PRODUCES AN F * 44400019 * IF THERE ARE ANY CHARACTERS OTHER THAN BLANKS AFTER THE * 44440019 * CHARACTERS 'END' WHICH CAUSED NESTING TO THIS LINE. * 44480019 * IF THERE WERE NO NON-BLANK CHARACTERS AFTER 'END', ACTION * 44520019 * CODE 800 PRODUCES A T, CAUSING ACTION CODE 300 TO DETECT AND * 44560019 * DIAGNOSE ANY STATEMENT LABEL OR CONTINUATION FIELD ERRORS. * 44600019 * * 44640019 *********************************************************************** 44680019 LIN00018 EQU * START OF DEFINITION 44720019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44760019 DC AL1(ACT800) ACTION CODE 44800019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 44840019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 44880019 DC AL1(ACT300) ACTION CODE 44920019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 44960019 EJECT 45000019 *********************************************************************** 45040019 * * 45080019 *EQUIVALENCE = 'VALENCE' : *30 '(' *33 N ( DECLARATOR ) * 45120019 * *53 ',' *33 N ( DECLARATOR ) ( ',' / N * 45160019 * ( DECLARATOR ) ... ) *12 ')' ( ',' / *30 '(' *33 N * 45200019 * ( DECLARATOR ) *53 ',' *33 N ( DECLARATOR ) ( ',' * 45240019 * / N ( DECLARATOR ) ... ) *13 ')' ... ) * 45280019 * * 45320019 * DEFINES THE EQUIVALENCE STATEMENT. * 45360019 * AS IN THE DEFINEFILE DEFINITION, THE FIRST * 45400019 * TWO AND-A-HALF LINES OF THIS DEFINITION * 45440019 * DESCRIBE THE BASIC FORM. * 45480019 * * 45520019 *********************************************************************** 45560019 LIN00019 EQU * START OF DEFINITION 45600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45640019 DC AL1(007) LENGTH OF LITERAL 45680019 DC C'VALENCE' 45720019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 45760019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 45800019 DC AL1(COD030) ERROR CODE 45840019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 45880019 DC AL1(001) LENGTH OF LITERAL 45920019 DC C'(' 45960019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46000019 DC AL1(COD033) ERROR CODE 46040019 DC AL1(DEFNAME) NAME OPERATOR N 46080019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 46120019 DC AL1(PAR00024-LIN00019) POINT TO END OF OPT. ITEMS 46160019 DC AL1(DEFSYMBL) NEST OPERATOR 46200019 DC AL2(LIN00036-IPDTEE) DECLARATOR 46240019 PAR00024 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 46280019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46320019 DC AL1(COD053) ERROR CODE 46360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46400019 DC AL1(001) LENGTH OF LITERAL 46440019 DC C',' 46480019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 46520019 DC AL1(COD033) ERROR CODE 46560019 DC AL1(DEFNAME) NAME OPERATOR N 46600019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 46640019 DC AL1(PAR00025-LIN00019) POINT TO END OF OPT. ITEMS 46680019 DC AL1(DEFSYMBL) NEST OPERATOR 46720019 DC AL2(LIN00036-IPDTEE) DECLARATOR 46760019 PAR00025 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 46800019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 46840019 DC AL1(PAR00026-LIN00019) POINT TO END OF OPT. ITEMS 46880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 46920019 DC AL1(001) LENGTH OF LITERAL 46960019 DC C',' 47000019 DC AL1(DEFCOMIT) LOCAL COMMIT / 47040019 DC AL1(DEFNAME) NAME OPERATOR N 47080019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 47120019 DC AL1(PAR00027-LIN00019) POINT TO END OF OPT. ITEMS 47160019 DC AL1(DEFSYMBL) NEST OPERATOR 47200019 DC AL2(LIN00036-IPDTEE) DECLARATOR 47240019 PAR00027 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 47280019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 47320019 PAR00026 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 47360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47400019 DC AL1(COD012) ERROR CODE 47440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47480019 DC AL1(001) LENGTH OF LITERAL 47520019 DC C')' 47560019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 47600019 DC AL1(PAR00028-LIN00019) POINT TO END OF OPT. ITEMS 47640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47680019 DC AL1(001) LENGTH OF LITERAL 47720019 DC C',' 47760019 DC AL1(DEFCOMIT) LOCAL COMMIT / 47800019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 47840019 DC AL1(COD030) ERROR CODE 47880019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 47920019 DC AL1(001) LENGTH OF LITERAL 47960019 DC C'(' 48000019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48040019 DC AL1(COD033) ERROR CODE 48080019 DC AL1(DEFNAME) NAME OPERATOR N 48120019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48160019 DC AL1(PAR00029-LIN00019) POINT TO END OF OPT. ITEMS 48200019 DC AL1(DEFSYMBL) NEST OPERATOR 48240019 DC AL2(LIN00036-IPDTEE) DECLARATOR 48280019 PAR00029 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 48320019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48360019 DC AL1(COD053) ERROR CODE 48400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48440019 DC AL1(001) LENGTH OF LITERAL 48480019 DC C',' 48520019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 48560019 DC AL1(COD033) ERROR CODE 48600019 DC AL1(DEFNAME) NAME OPERATOR N 48640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48680019 DC AL1(PAR00030-LIN00019) POINT TO END OF OPT. ITEMS 48720019 DC AL1(DEFSYMBL) NEST OPERATOR 48760019 DC AL2(LIN00036-IPDTEE) DECLARATOR 48800019 PAR00030 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 48840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 48880019 DC AL1(PAR00031-LIN00019) POINT TO END OF OPT. ITEMS 48920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 48960019 DC AL1(001) LENGTH OF LITERAL 49000019 DC C',' 49040019 DC AL1(DEFCOMIT) LOCAL COMMIT / 49080019 DC AL1(DEFNAME) NAME OPERATOR N 49120019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 49160019 DC AL1(PAR00032-LIN00019) POINT TO END OF OPT. ITEMS 49200019 DC AL1(DEFSYMBL) NEST OPERATOR 49240019 DC AL2(LIN00036-IPDTEE) DECLARATOR 49280019 PAR00032 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49320019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 49360019 PAR00031 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49400019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 49440019 DC AL1(COD013) ERROR CODE 49480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 49520019 DC AL1(001) LENGTH OF LITERAL 49560019 DC C')' 49600019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 49640019 PAR00028 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 49680019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 49720019 EJECT 49760019 *********************************************************************** 49800019 * * 49840019 *EXTERNAL = 'RNAL' : *33 N ( ',' / N ... ) * 49880019 * * 49920019 * DEFINES THE EXTERNAL STATEMENT. * 49960019 * * 50000019 *********************************************************************** 50040019 LIN00020 EQU * START OF DEFINITION 50080019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50120019 DC AL1(004) LENGTH OF LITERAL 50160019 DC C'RNAL' 50200019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 50240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 50280019 DC AL1(COD033) ERROR CODE 50320019 DC AL1(DEFNAME) NAME OPERATOR N 50360019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 50400019 DC AL1(PAR00033-LIN00020) POINT TO END OF OPT. ITEMS 50440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 50480019 DC AL1(001) LENGTH OF LITERAL 50520019 DC C',' 50560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 50600019 DC AL1(DEFNAME) NAME OPERATOR N 50640019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 50680019 PAR00033 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 50720019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 50760019 EJECT 50800019 *********************************************************************** 50840019 * * 50880019 *FIND = : *30 '(' DSREFNO *61 '''' *7 EXP *13 ')' * 50920019 * * 50960019 * DEFINES THE FIND STATEMENT. THE FOUR * 51000019 * QUOTATION MARKS REPRESENT A LITERAL CONSISTING * 51040019 * OF ONE QUOTE IN THE SOURCE. * 51080019 * * 51120019 *********************************************************************** 51160019 LIN00021 EQU * START OF DEFINITION 51200019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 51240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51280019 DC AL1(COD030) ERROR CODE 51320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51360019 DC AL1(001) LENGTH OF LITERAL 51400019 DC C'(' 51440019 DC AL1(DEFSYMBL) NEST OPERATOR 51480019 DC AL2(LIN00035-IPDTEE) DSREFNO 51520019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51560019 DC AL1(COD061) ERROR CODE 51600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 51640019 DC AL1(001) LENGTH OF LITERAL 51680019 DC C'''' 51720019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51760019 DC AL1(COD007) ERROR CODE 51800019 DC AL1(DEFSYMBL) NEST OPERATOR 51840019 DC AL2(LIN00007-IPDTEE) EXP 51880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 51920019 DC AL1(COD013) ERROR CODE 51960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 52000019 DC AL1(001) LENGTH OF LITERAL 52040019 DC C')' 52080019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 52120019 EJECT 52160019 *********************************************************************** 52200019 * * 52240019 *FORMAT = 'AT' : $301 *30 '(' *77 ( '/' ... ) ( GROUP * 52280019 * ( < ',' / GROUP ³ '/' ( '/' ... ) GROUP > * 52320019 * ... ) ( '/' ... ) ) ')' * 52360019 * * 52400019 * DEFINES THE FORMAT STATEMENT. ESSENTIALLY, * 52440019 * THE DEFINITION IS A PARENTHESIZED LIST OF * 52480019 * GROUPS. (GROUP IS DEFINED ON ANOTHER LINE) * 52520019 * EACH DELIMITER IN THE LIST IS EITHER A COMMA * 52560019 * OR ANY NUMBER OF SLASHES. OPTIONALLY, THERE * 52600019 * MAY BE ANY NUMBER OF SLASHES BEFORE THE * 52640019 * FIRST GROUP IN THE LIST, OR AFTER THE LAST * 52680019 * GROUP IN THE LIST, OR BOTH. THERE * 52720019 * NEED NOT BE ANY GROUPS AT ALL. THE * 52760019 * LAST SET OF OPTIONAL SLASHES IS INCLUDED IN * 52800019 * THE OPTIONAL PARENTHESES FOR THE LIST * 52840019 * OF GROUPS BECAUSE, IF THERE ARE NO * 52880019 * GROUPS, THE FIRST SET OF OPTIONAL SLASHES * 52920019 * WILL HAVE MATCHED ALL THE VALID CHARACTERS * 52960019 * WITHIN THE SOURCE'S PARENTHESES. THE * 53000019 * MESSAGE ISSUED WHEN A RIGHT PARENTHESIS IS * 53040019 * NOT FOUND IS "DELIMITER MISSING OR INVALID * 53080019 * FORMAT CODE" SINCE ANY FAILURE TO MATCH * 53120019 * THE RIGHT PARENTHESIS LITERAL IS PROBABLY * 53160019 * DUE TO ONE OF THESE CAUSES. * 53200019 * * 53240019 *********************************************************************** 53280019 LIN00022 EQU * START OF DEFINITION 53320019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53360019 DC AL1(002) LENGTH OF LITERAL 53400019 DC C'AT' 53440019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 53480019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 53520019 DC AL1(ACT301) ACTION CODE 53560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53600019 DC AL1(COD030) ERROR CODE 53640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53680019 DC AL1(001) LENGTH OF LITERAL 53720019 DC C'(' 53760019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 53800019 DC AL1(COD077) ERROR CODE 53840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 53880019 DC AL1(PAR00034-LIN00022) POINT TO END OF OPT. ITEMS 53920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 53960019 DC AL1(001) LENGTH OF LITERAL 54000019 DC C'/' 54040019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 54080019 PAR00034 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 54120019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54160019 DC AL1(PAR00035-LIN00022) POINT TO END OF OPT. ITEMS 54200019 DC AL1(DEFSYMBL) NEST OPERATOR 54240019 DC AL2(LIN00038-IPDTEE) GROUP 54280019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54320019 DC AL1(PAR00036-LIN00022) POINT TO END OF OPT. ITEMS 54360019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 54400019 DC AL1(ALT00034-LIN00022) FALSE DISP. 54440019 DC AL1(BRC00015-LIN00022) TRUE DISP. 54480019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54520019 DC AL1(001) LENGTH OF LITERAL 54560019 DC C',' 54600019 DC AL1(DEFCOMIT) LOCAL COMMIT / 54640019 DC AL1(DEFSYMBL) NEST OPERATOR 54680019 DC AL2(LIN00038-IPDTEE) GROUP 54720019 ALT00034 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 54760019 DC AL1(ALT00035-LIN00022) FALSE DISP. 54800019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 54840019 DC AL1(001) LENGTH OF LITERAL 54880019 DC C'/' 54920019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 54960019 DC AL1(PAR00037-LIN00022) POINT TO END OF OPT. ITEMS 55000019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55040019 DC AL1(001) LENGTH OF LITERAL 55080019 DC C'/' 55120019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 55160019 PAR00037 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55200019 DC AL1(DEFSYMBL) NEST OPERATOR 55240019 DC AL2(LIN00038-IPDTEE) GROUP 55280019 ALT00035 EQU * 55320019 BRC00015 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 55360019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 55400019 PAR00036 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55440019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 55480019 DC AL1(PAR00038-LIN00022) POINT TO END OF OPT. ITEMS 55520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55560019 DC AL1(001) LENGTH OF LITERAL 55600019 DC C'/' 55640019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 55680019 PAR00038 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55720019 PAR00035 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 55760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 55800019 DC AL1(001) LENGTH OF LITERAL 55840019 DC C')' 55880019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 55920019 EJECT 55960019 *********************************************************************** 56000019 * * 56040019 *GROUP = < FIELDESCR ³ ( $700 ) '(' / ( < '/' ³ * 56080019 * ( $700 ) '(' / *69 $801 > ... ) * 56120019 * ( FIELDESCR ( < ',' / FIELDESCR ³ '/' ( * 56160019 * < '/' ³ ( $700 ) '(' / *69 $801 > ... ) * 56200019 * FIELDESCR > ... ) ( '/' ... ) ) ')' > * 56240019 * * 56280019 * DEFINES GROUP FOR USE IN THE FORMAT DEFINITION. * 56320019 * A GROUP IS EITHER A FIELD DESCRIPTOR OR * 56360019 * ANOTHER FORM THAT IS ESSENTIALLY THE SAME AS A * 56400019 * FORMAT. THE DIFFERENCES BETWEEN FORMAT AND * 56440019 * THE SECOND FORM ARE 1) THE SECOND FORM OF * 56480019 * GROUP MAY HAVE A REPEAT COUNT BEFORE THE * 56520019 * INITIAL LEFT PARENTHESIS, AND 2) THE ITEMS * 56560019 * IN THE PARENTHESIZED LIST ARE EACH FIELDESCR * 56600019 * INSTEAD OF GROUP. THE SECOND DIFFERENCE * 56640019 * IS NECESSARY TO AVOID ALLOWING AN INDEFINITE NUMBER * 56680019 * OF LEVELS OF NESTING OF PARENTHESES IN FORMAT * 56720019 * STATEMENTS. FORTRAN ALLOWS ONLY ONE LEVEL * 56760019 * OF NESTING INSIDE THE PARENTHESES WHICH ENCLOSE * 56800019 * THE ENTIRE FORMAT SPECIFICATION. * 56840019 * * 56880019 * ACTION CODE 700 ADVANCES THE SOURCE POINTER PAST * 56920019 * THE GROUP REPEAT COUNT WHEN ONE IS PRESENT. * 56960019 * * 57000019 * ACTION CODE 801 IS USED TO ISSUE A MESSAGE * 57040019 * DIAGNOSING TOO MANY LEVELS OF PARENTHESES IF ANY * 57080019 * LEFT PARENTHESIS IS FOUND WITHIN THE PARENTHESES * 57120019 * WHICH ENCLOSE THE REST OF THE SECOND ALTERNATIVE. * 57160019 * * 57200019 *********************************************************************** 57240019 LIN00038 EQU * START OF DEFINITION 57280019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 57320019 DC AL1(ALT00036-LIN00038) FALSE DISP. 57360019 DC AL1(BRC00016-LIN00038) TRUE DISP. 57400019 DC AL1(DEFSYMBL) NEST OPERATOR 57440019 DC AL2(LIN00039-IPDTEE) FIELDESCR 57480019 ALT00036 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 57520019 DC AL1(ALT00037-LIN00038) FALSE DISP. 57560019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 57600019 DC AL1(PAR00039-LIN00038) POINT TO END OF OPT. ITEMS 57640019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 57680019 DC AL1(ACT700) ACTION CODE 57720019 PAR00039 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 57760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 57800019 DC AL1(001) LENGTH OF LITERAL 57840019 DC C'(' 57880019 DC AL1(DEFCOMIT) LOCAL COMMIT / 57920019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 57960019 DC AL1(PAR00040-LIN00038) POINT TO END OF OPT. ITEMS 58000019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 58040019 DC AL1(ALT00038-LIN00038) FALSE DISP. 58080019 DC AL1(BRC00017-LIN00038) TRUE DISP. 58120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 58160019 DC AL1(001) LENGTH OF LITERAL 58200019 DC C'/' 58240019 ALT00038 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 58280019 DC AL1(ALT00039-LIN00038) FALSE DISP. 58320019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 58360019 DC AL1(PAR00041-LIN00038) POINT TO END OF OPT. ITEMS 58400019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 58440019 DC AL1(ACT700) ACTION CODE 58480019 PAR00041 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 58520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 58560019 DC AL1(001) LENGTH OF LITERAL 58600019 DC C'(' 58640019 DC AL1(DEFCOMIT) LOCAL COMMIT / 58680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 58720019 DC AL1(COD069) ERROR CODE 58760019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 58800019 DC AL1(ACT801) ACTION CODE 58840019 ALT00039 EQU * 58880019 BRC00017 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 58920019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 58960019 PAR00040 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 59000019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 59040019 DC AL1(PAR00042-LIN00038) POINT TO END OF OPT. ITEMS 59080019 DC AL1(DEFSYMBL) NEST OPERATOR 59120019 DC AL2(LIN00039-IPDTEE) FIELDESCR 59160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 59200019 DC AL1(PAR00043-LIN00038) POINT TO END OF OPT. ITEMS 59240019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 59280019 DC AL1(ALT00040-LIN00038) FALSE DISP. 59320019 DC AL1(BRC00018-LIN00038) TRUE DISP. 59360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 59400019 DC AL1(001) LENGTH OF LITERAL 59440019 DC C',' 59480019 DC AL1(DEFCOMIT) LOCAL COMMIT / 59520019 DC AL1(DEFSYMBL) NEST OPERATOR 59560019 DC AL2(LIN00039-IPDTEE) FIELDESCR 59600019 ALT00040 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 59640019 DC AL1(ALT00041-LIN00038) FALSE DISP. 59680019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 59720019 DC AL1(001) LENGTH OF LITERAL 59760019 DC C'/' 59800019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 59840019 DC AL1(PAR00044-LIN00038) POINT TO END OF OPT. ITEMS 59880019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 59920019 DC AL1(ALT00042-LIN00038) FALSE DISP. 59960019 DC AL1(BRC00019-LIN00038) TRUE DISP. 60000019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 60040019 DC AL1(001) LENGTH OF LITERAL 60080019 DC C'/' 60120019 ALT00042 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 60160019 DC AL1(ALT00043-LIN00038) FALSE DISP. 60200019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 60240019 DC AL1(PAR00045-LIN00038) POINT TO END OF OPT. ITEMS 60280019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 60320019 DC AL1(ACT700) ACTION CODE 60360019 PAR00045 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 60400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 60440019 DC AL1(001) LENGTH OF LITERAL 60480019 DC C'(' 60520019 DC AL1(DEFCOMIT) LOCAL COMMIT / 60560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 60600019 DC AL1(COD069) ERROR CODE 60640019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 60680019 DC AL1(ACT801) ACTION CODE 60720019 ALT00043 EQU * 60760019 BRC00019 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 60800019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 60840019 PAR00044 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 60880019 DC AL1(DEFSYMBL) NEST OPERATOR 60920019 DC AL2(LIN00039-IPDTEE) FIELDESCR 60960019 ALT00041 EQU * 61000019 BRC00018 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 61040019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 61080019 PAR00043 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 61120019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 61160019 DC AL1(PAR00046-LIN00038) POINT TO END OF OPT. ITEMS 61200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 61240019 DC AL1(001) LENGTH OF LITERAL 61280019 DC C'/' 61320019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 61360019 PAR00046 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 61400019 PAR00042 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 61440019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 61480019 DC AL1(001) LENGTH OF LITERAL 61520019 DC C')' 61560019 ALT00037 EQU * 61600019 BRC00016 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 61640019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 61680019 EJECT 61720019 *********************************************************************** 61760019 * * 61800019 *FIELDESCR = < C ³ $700 'X' ³ ( $700 ) * 61840019 * < < 'E' ³ 'F' ³ 'D' > / $700 *80 '.' $701 * 61880019 * ³ < 'I' ³ 'A' > / $700 > ³ H ³ 'T' / $700 * 61920019 * ³ ( '-' ) < $700 ³ '0' ( '0' ... ) > 'P' ( $700 ) * 61960019 * < 'E' ³ 'F' ³ 'D' > / $700 *80 '.' $701 > * 62000019 * * 62040019 * DEFINES ALL THE FIELD DESCRIPTORS WHICH MAY * 62080019 * APPEAR IN A FORMAT STATEMENT. * 62120019 * * 62160019 *********************************************************************** 62200019 LIN00039 EQU * START OF DEFINITION 62240019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 62280019 DC AL1(ALT00044-LIN00039) FALSE DISP. 62320019 DC AL1(BRC00020-LIN00039) TRUE DISP. 62360019 DC AL1(DEFCSTRG) CHARACTER STRING C 62400019 ALT00044 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 62440019 DC AL1(ALT00045-LIN00039) FALSE DISP. 62480019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 62520019 DC AL1(ACT700) ACTION CODE 62560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 62600019 DC AL1(001) LENGTH OF LITERAL 62640019 DC C'X' 62680019 ALT00045 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 62720019 DC AL1(ALT00046-LIN00039) FALSE DISP. 62760019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 62800019 DC AL1(PAR00047-LIN00039) POINT TO END OF OPT. ITEMS 62840019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 62880019 DC AL1(ACT700) ACTION CODE 62920019 PAR00047 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 62960019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 63000019 DC AL1(ALT00047-LIN00039) FALSE DISP. 63040019 DC AL1(BRC00021-LIN00039) TRUE DISP. 63080019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 63120019 DC AL1(ALT00048-LIN00039) FALSE DISP. 63160019 DC AL1(BRC00022-LIN00039) TRUE DISP. 63200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 63240019 DC AL1(001) LENGTH OF LITERAL 63280019 DC C'E' 63320019 ALT00048 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 63360019 DC AL1(ALT00049-LIN00039) FALSE DISP. 63400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 63440019 DC AL1(001) LENGTH OF LITERAL 63480019 DC C'F' 63520019 ALT00049 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 63560019 DC AL1(ALT00050-LIN00039) FALSE DISP. 63600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 63640019 DC AL1(001) LENGTH OF LITERAL 63680019 DC C'D' 63720019 ALT00050 EQU * 63760019 BRC00022 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 63800019 DC AL1(DEFCOMIT) LOCAL COMMIT / 63840019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 63880019 DC AL1(ACT700) ACTION CODE 63920019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 63960019 DC AL1(COD080) ERROR CODE 64000019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 64040019 DC AL1(001) LENGTH OF LITERAL 64080019 DC C'.' 64120019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 64160019 DC AL1(ACT701) ACTION CODE 64200019 ALT00047 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 64240019 DC AL1(ALT00051-LIN00039) FALSE DISP. 64280019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 64320019 DC AL1(ALT00052-LIN00039) FALSE DISP. 64360019 DC AL1(BRC00023-LIN00039) TRUE DISP. 64400019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 64440019 DC AL1(001) LENGTH OF LITERAL 64480019 DC C'I' 64520019 ALT00052 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 64560019 DC AL1(ALT00053-LIN00039) FALSE DISP. 64600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 64640019 DC AL1(001) LENGTH OF LITERAL 64680019 DC C'A' 64720019 ALT00053 EQU * 64760019 BRC00023 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 64800019 DC AL1(DEFCOMIT) LOCAL COMMIT / 64840019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 64880019 DC AL1(ACT700) ACTION CODE 64920019 ALT00051 EQU * 64960019 BRC00021 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 65000019 ALT00046 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 65040019 DC AL1(ALT00054-LIN00039) FALSE DISP. 65080019 DC AL1(DEFHOLLR) HOLLERITH OPERATOR H 65120019 ALT00054 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 65160019 DC AL1(ALT00055-LIN00039) FALSE DISP. 65200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 65240019 DC AL1(001) LENGTH OF LITERAL 65280019 DC C'T' 65320019 DC AL1(DEFCOMIT) LOCAL COMMIT / 65360019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 65400019 DC AL1(ACT700) ACTION CODE 65440019 ALT00055 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 65480019 DC AL1(ALT00056-LIN00039) FALSE DISP. 65520019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 65560019 DC AL1(PAR00048-LIN00039) POINT TO END OF OPT. ITEMS 65600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 65640019 DC AL1(001) LENGTH OF LITERAL 65680019 DC C'-' 65720019 PAR00048 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 65760019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 65800019 DC AL1(ALT00057-LIN00039) FALSE DISP. 65840019 DC AL1(BRC00024-LIN00039) TRUE DISP. 65880019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 65920019 DC AL1(ACT700) ACTION CODE 65960019 ALT00057 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 66000019 DC AL1(ALT00058-LIN00039) FALSE DISP. 66040019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 66080019 DC AL1(001) LENGTH OF LITERAL 66120019 DC C'0' 66160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 66200019 DC AL1(PAR00049-LIN00039) POINT TO END OF OPT. ITEMS 66240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 66280019 DC AL1(001) LENGTH OF LITERAL 66320019 DC C'0' 66360019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 66400019 PAR00049 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 66440019 ALT00058 EQU * 66480019 BRC00024 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 66520019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 66560019 DC AL1(001) LENGTH OF LITERAL 66600019 DC C'P' 66640019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 66680019 DC AL1(PAR00050-LIN00039) POINT TO END OF OPT. ITEMS 66720019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 66760019 DC AL1(ACT700) ACTION CODE 66800019 PAR00050 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 66840019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 66880019 DC AL1(ALT00059-LIN00039) FALSE DISP. 66920019 DC AL1(BRC00025-LIN00039) TRUE DISP. 66960019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 67000019 DC AL1(001) LENGTH OF LITERAL 67040019 DC C'E' 67080019 ALT00059 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 67120019 DC AL1(ALT00060-LIN00039) FALSE DISP. 67160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 67200019 DC AL1(001) LENGTH OF LITERAL 67240019 DC C'F' 67280019 ALT00060 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 67320019 DC AL1(ALT00061-LIN00039) FALSE DISP. 67360019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 67400019 DC AL1(001) LENGTH OF LITERAL 67440019 DC C'D' 67480019 ALT00061 EQU * 67520019 BRC00025 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 67560019 DC AL1(DEFCOMIT) LOCAL COMMIT / 67600019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 67640019 DC AL1(ACT700) ACTION CODE 67680019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 67720019 DC AL1(COD080) ERROR CODE 67760019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 67800019 DC AL1(001) LENGTH OF LITERAL 67840019 DC C'.' 67880019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 67920019 DC AL1(ACT701) ACTION CODE 67960019 ALT00056 EQU * 68000019 BRC00020 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 68040019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 68080019 EJECT 68120019 *********************************************************************** 68160019 * * 68200019 *FUNCTION = 'TION' : *32 N DUMMYARGS * 68240019 * * 68280019 * DEFINES FUNCTION STATEMENTS, INCLUDING * 68320019 * THOSE WHICH BEGIN WITH ONE OF THE * 68360019 * TYPE DECLARATORS REAL, INTEGER, OR DOUBLE * 68400019 * PRECISION. IF ONE OF THESE TYPE * 68440019 * DECLARATORS PRECEDES 'FUNCTION', IT HAS * 68480019 * BEEN MATCHED IN THE APPROPRIATE TABLE. * 68520019 * THEREFORE, THIS LINE DOES NOT NEED TO MATCH * 68560019 * ANY OF THE TYPE KEYWORDS. * 68600019 * * 68640019 *********************************************************************** 68680019 LIN00023 EQU * START OF DEFINITION 68720019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 68760019 DC AL1(004) LENGTH OF LITERAL 68800019 DC C'TION' 68840019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 68880019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 68920019 DC AL1(COD032) ERROR CODE 68960019 DC AL1(DEFNAME) NAME OPERATOR N 69000019 DC AL1(DEFSYMBL) NEST OPERATOR 69040019 DC AL2(LIN00040-IPDTEE) DUMMYARGS 69080019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 69120019 EJECT 69160019 *********************************************************************** 69200019 * * 69240019 *DUMMYARGS = *35 '(' / N ( ',' / N ... ) *13 ')'* 69280019 * * 69320019 * DEFINES THE LIST OF DUMMY ARGUMENTS, * 69360019 * INCLUDING THE PARENTHESES WHICH ENCLOSE * 69400019 * THE LIST, IN A FUNCTION STATEMENT. * 69440019 * * 69480019 *********************************************************************** 69520019 LIN00040 EQU * START OF DEFINITION 69560019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 69600019 DC AL1(COD035) ERROR CODE 69640019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 69680019 DC AL1(001) LENGTH OF LITERAL 69720019 DC C'(' 69760019 DC AL1(DEFCOMIT) LOCAL COMMIT / 69800019 DC AL1(DEFNAME) NAME OPERATOR N 69840019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 69880019 DC AL1(PAR00051-LIN00040) POINT TO END OF OPT. ITEMS 69920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 69960019 DC AL1(001) LENGTH OF LITERAL 70000019 DC C',' 70040019 DC AL1(DEFCOMIT) LOCAL COMMIT / 70080019 DC AL1(DEFNAME) NAME OPERATOR N 70120019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 70160019 PAR00051 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 70200019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 70240019 DC AL1(COD013) ERROR CODE 70280019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 70320019 DC AL1(001) LENGTH OF LITERAL 70360019 DC C')' 70400019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 70440019 EJECT 70480019 *********************************************************************** 70520019 * * 70560019 *GOTO = : < '(' / *43 S ( ',' / S ... ) *13 ')' * 70600019 * *52 ',' *33 N ³ / *43 S > * 70640019 * * 70680019 * DEFINES THE TWO KINDS OF GOTO STATEMENT. * 70720019 * THESE ARE DEFINED IN THE ORDER: * 70760019 * COMPUTED GOTO, UNCONDITIONAL GOTO. * 70800019 * THIS ORDERING ALLOWS A COMMIT * 70840019 * TO PRECEDE THE S OPERATOR IN THE DEFINITION OF * 70880019 * THE UNCONDITIONAL GOTO. * 70920019 * * 70960019 *********************************************************************** 71000019 LIN00024 EQU * START OF DEFINITION 71040019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 71080019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 71120019 DC AL1(ALT00062-LIN00024) FALSE DISP. 71160019 DC AL1(BRC00026-LIN00024) TRUE DISP. 71200019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 71240019 DC AL1(001) LENGTH OF LITERAL 71280019 DC C'(' 71320019 DC AL1(DEFCOMIT) LOCAL COMMIT / 71360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 71400019 DC AL1(COD043) ERROR CODE 71440019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 71480019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 71520019 DC AL1(PAR00052-LIN00024) POINT TO END OF OPT. ITEMS 71560019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 71600019 DC AL1(001) LENGTH OF LITERAL 71640019 DC C',' 71680019 DC AL1(DEFCOMIT) LOCAL COMMIT / 71720019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 71760019 DC AL1(DEFITIND) INDEFINITE ITERATION ... 71800019 PAR00052 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 71840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 71880019 DC AL1(COD013) ERROR CODE 71920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 71960019 DC AL1(001) LENGTH OF LITERAL 72000019 DC C')' 72040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 72080019 DC AL1(COD052) ERROR CODE 72120019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 72160019 DC AL1(001) LENGTH OF LITERAL 72200019 DC C',' 72240019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 72280019 DC AL1(COD033) ERROR CODE 72320019 DC AL1(DEFNAME) NAME OPERATOR N 72360019 ALT00062 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 72400019 DC AL1(ALT00063-LIN00024) FALSE DISP. 72440019 DC AL1(DEFCOMIT) LOCAL COMMIT / 72480019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 72520019 DC AL1(COD043) ERROR CODE 72560019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 72600019 ALT00063 EQU * 72640019 BRC00026 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 72680019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 72720019 EJECT 72760019 *********************************************************************** 72800019 * * 72840019 *IF = : *31 '(' *7 EXP *13 ')' *43 S *53 ',' * 72880019 * *43 S *53 ',' *43 S * 72920019 * * 72960019 * DEFINITION OF THE ARITHMETIC IF STATEMENT. * 73000019 * * 73040019 *********************************************************************** 73080019 LIN00025 EQU * START OF DEFINITION 73120019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 73160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 73200019 DC AL1(COD031) ERROR CODE 73240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 73280019 DC AL1(001) LENGTH OF LITERAL 73320019 DC C'(' 73360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 73400019 DC AL1(COD007) ERROR CODE 73440019 DC AL1(DEFSYMBL) NEST OPERATOR 73480019 DC AL2(LIN00007-IPDTEE) EXP 73520019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 73560019 DC AL1(COD013) ERROR CODE 73600019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 73640019 DC AL1(001) LENGTH OF LITERAL 73680019 DC C')' 73720019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 73760019 DC AL1(COD043) ERROR CODE 73800019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 73840019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 73880019 DC AL1(COD053) ERROR CODE 73920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 73960019 DC AL1(001) LENGTH OF LITERAL 74000019 DC C',' 74040019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 74080019 DC AL1(COD043) ERROR CODE 74120019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 74160019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 74200019 DC AL1(COD053) ERROR CODE 74240019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 74280019 DC AL1(001) LENGTH OF LITERAL 74320019 DC C',' 74360019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 74400019 DC AL1(COD043) ERROR CODE 74440019 DC AL1(DEFSTNUM) STATEMENT NO. OPERATOR S 74480019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 74520019 EJECT 74560019 *********************************************************************** 74600019 * * 74640019 *INTEGER = 'GER' < 'FUNC' FUNCTION ³ TYPE > * 74680019 * * 74720019 * TABLE OF TRANSFERS FOR STATEMENTS BEGINNING WITH * 74760019 * 'INTEGER'. * 74800019 * * 74840019 *********************************************************************** 74880019 LIN00026 EQU * START OF DEFINITION 74920019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 74960019 DC AL1(003) LENGTH OF LITERAL 75000019 DC C'GER' 75040019 DC AL1(DEFLBRCE) START OF ALTERNATIVES < 75080019 DC AL1(ALT00064-LIN00026) FALSE DISP. 75120019 DC AL1(BRC00027-LIN00026) TRUE DISP. 75160019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 75200019 DC AL1(004) LENGTH OF LITERAL 75240019 DC C'FUNC' 75280019 DC AL1(DEFSYMBL) NEST OPERATOR 75320019 DC AL2(LIN00023-IPDTEE) FUNCTION 75360019 ALT00064 DC AL1(DEFOR) ALTERNATE OPERATOR ³ 75400019 DC AL1(ALT00065-LIN00026) FALSE DISP. 75440019 DC AL1(DEFSYMBL) NEST OPERATOR 75480019 DC AL2(LIN00037-IPDTEE) TYPE 75520019 ALT00065 EQU * 75560019 BRC00027 DC AL1(DEFRBRCE) END OF ALTERNATIVES > 75600019 DC AL1(DEFEND) END OF STATEMENT DEFINITION 75640019 EJECT 75680019 *********************************************************************** 75720019 * * 75760019 *PAUSE = 'E' : ( D .5. ) *129 $800 * 75800019 * * 75840019 * DEFINES THE PAUSE STATEMENT. * 75880019 * * 75920019 *********************************************************************** 75960019 LIN00027 EQU * START OF DEFINITION 76000019 DC AL1(DEFQUOTE) LITERAL OPERATOR ' 76040019 DC AL1(001) LENGTH OF LITERAL 76080019 DC C'E' 76120019 DC AL1(DEFSTCMT) STATEMENT COMMIT : 76160019 DC AL1(DEFOPTST) START OF OPTIONAL ITEMS ( 76200019 DC AL1(PAR00053-LIN00027) POINT TO END OF OPT. ITEMS 76240019 DC AL1(DEFDIGIT) DIGIT OPERATOR D 76280019 DC AL1(DEFITDEF) DEFINITE ITERATION .N. 76320019 DC AL1(005) ITERATION COUNT 76360019 PAR00053 DC AL1(DEFOPTED) END OF OPTIONAL ITEMS ) 76400019 DC AL1(DEFMESSG) ERROR MESSAGE OPERATOR * 76440019 DC AL1(COD129) ERROR CODE 76480019 DC AL1(DEFACTN) ACTION CODE OPERATOR $ 76520019 DC AL1(ACT800) ACTION CODE 76560019