C.......... THE MINICOMPILER C ************************* C * * C * OVERVIEW * C * * C ************************* C C C THIS PROGRAM IS A COMPILER WHICH TAKES AS DATA A PROGRAM WRITTEN C IN A SIMPLE PROGRAMMING LANGUAGE ( A DESCRIPTION OF WHICH FOLLOWS) C AND PRODUCES AS OUTPUT A TRANSLATION OF THAT PROGRAM INTO A SERIES C OF ASSIGNMENT STATEMENTS. THE STRAIGHT LINE CODE TRANSLATION IS C PRINTED IN A READABLE FORM FOR THE COMPILER USER AND ALSO PUNCHED C IN A CODED FORM FOR USE AS INPUT TO ANY OF SEVERAL ROUNDOFF ERROR C ANALYSIS PROGRAMS OF WEBB MILLER. C THE MAIN ROUTINE OF THE COMPILER IS AN LL-1 PARSING ROUTINE. IT C CALLS THE LEXICAL ANALYZER TO PRODUCE INTERNAL TOKENS BY SCANNING C THE SOURCE CODE. THE PARSER ALSO CALLS THE ROUTINE CODGEN WHICH C PRODUCES INTERMEDIATE CODE FOR THE INTERPRETER AND WHICH PERFORMS C SOME SYNTAX CHECKING AND OTHER PERIPHERAL FUNCTIONS NECESSARY C FOR PARSING. C WHEN THE ENTIRE INPUT HAS BEEN SCANNED AND PARSED, THE INTERPRETING C ROUTINES ARE ACTIVATED. THESE INTERPRET THE INTERMEDIATE CODE AND C GENERATE THE FINAL STRAIGHT LINE PRINTED AND PUNCHED OUTPUT. DURING C INTERPRETATION, ALL INTEGER EXPRESSIONS ARE ACTUALLY EVALUATED IN C ORDER TO PERFORM THE CORRECT NUMBER OF ITERATIONS OF EXPLICIT FOR- C LOOPS AND OF FOR-LOOPS IMPLICIT IN SUMMATION EXPRESSIONS, AND TO C INTERPRETIVELY PERFORM IF-THEN TESTS. IN CONTRAST, NO ACTUAL C REAL ARITHMETIC COMPUTATION IS DONE. THROUGHOUT, ALL REAL C VARIABLES ARE TREATED SYMBOLICALLY AS BEING THE N-TH INPUT VALUE, C INTERMEDIATE VALUE, OR REAL CONSTANT. C BOTH THE LEXICAL ANALYZER AND THE INTERPRETER COMPRISE SEVERAL SUB- C ROUTINES.IN ADDITION THERE ARE COLLECTIONS OF SYMBOL TABLE ROUTINES, C ERROR ROUTINES AND ROUTINES TO PRINT AND PUNCH THE COMPILER'S C OUTPUT. C IF ANY ERRORS ARE ENCOUNTERED DURING PARSING, THE PARSER CONTINUES C TO CHECK FOR SYNTAX ERRORS, BUT NO FURTHER INTERMEDIATE CODE WILL BE C GENERATED, AND NO INTERPRETATION WILL TAKE PLACE. SIMILARLY, IF C EXECUTION ERRORS ARE IDENTIFIED DURING INTERPRETATION, NO STRAIGHT C LINE CODE WILL BE EITHER PRINTED OR PUNCHED. C C C ************************************** C * * C * THE SOURCE LANGUAGE * C * * C ************************************** C C C THE LANGUAGE TO BE COMPILED IS A SIMPLE LANGUAGE DESIGNED FOR C CODING NUMERICAL ALGORITHMS. IT BASICALLY INCLUDES REAL ASSIGN- C MENT STATEMENTS, DIMENSION STATEMENTS AND SOME BLOCK STRUCTURE C IMPOSED BY FOR-LOOPS, AND IF-THEN TESTS. THERE ARE NO MIXED-MODE C ARITHMETIC EXPRESSIONS, AND NO STATEMENT LABELS. INTEGER EXPRESSIONS C AND VARIABLES ARE USED ONLY FOR DIMENSIONING REAL ARRAYS, FOR C DEFINING BOUNDS IN FOR-LOOPS AND SUMMATION EXPRESSION LOOPS, AND FOR C VARIABLES TO BE TESTED IN IF-THEN STATEMENTS. C THE CARD FORMAT IS SIMILAR TO FORTRAN. STATEMENTS APPEAR C IN COLUMNS 7-72, AND A 1 IN COLUMN 6 INDICATES CONTINUATION. A C C IN COLUMN 1 INDICATES A COMMENT. C THERE ARE NINE STATEMENT TYPES, BRIEFLY DESCRIBED BELOW: C C 1. THE TEST STATEMENT C C USE: TO ASSIGN VALUES TO INTEGER VARIABLES WHICH WILL THEMSELVES C BE USED TO DIMENSION REAL ARRAYS. C C FORM: TEST(I1,I2,I3,...) C C WHERE EACH I IS AN ASSIGNMENT STATEMENT OF THE FORM C INTEGER VARIABLE = INTEGER CONSTANT. C C 2. THE DIMENSION STATEMENT C C USE: TO ASSIGN DIMENSIONS TO ARRAYS. THE ARRAY NAME MAY BE C EITHER A DEFAULT REAL OR INTEGER IDENTIFIER. ITS USE IN C THE DIMENSION STATEMENT CONSTITUTES AN IMPLICIT REAL C DECLARATION. C C FORM: DIMENSION(D1,D2,D3 ..) C C WHERE EACH D IS OF ONE OF THE FOLLOWING FORMS: C IDENTIFIER(I) C IDENTIFIER(I1,I2) C AND EACH I IS AN INTEGER VARIABLE OR INTEGER CONSTANT. C C NOTE: DIMENSION AND TEST STATEMENTS ARE NON-EXECUTABLE AND MUST C PRECEED ALL EXECUTABLE STATEMENTS. IN ADDITION, AN INTEGER C VARIABLE APPEARING IN A DIMENSION STATEMENT MUST BE ASSIGNED A C VALUE IN A PRECEEDING TEST STATEMENT. C C 3. THE INPUT/OUTPUT STATEMENTS C C USE: TO NOTIFY THE COMPILER THAT CERTAIN VALUES WILL BE SUPPLIED C BY THE PROGRAMMER AS INITIAL VALUES FOR REAL VARIABLES WHEN C THE STRAIGHT LINE CODE IS USED AS INPUT FOR A ROUNDOFF ERROR C ANALYSIS; OR THAT CERTAIN REAL VARIABLES ARE EXPECTED TO C RECEIVE VALUES AS A RESULT OF RUNNING THE PROGRAM BEING C COMPILED. C C FORM: INPUT(D1,D2,D3,...) C OUTPUT(D1,D2,D3,..) C C EACH D IS EITHER THE NAME OF A REAL SCALAR, A SINGLE ARRAY C ELEMENT, OR AN ENTIRE ARRAY. IN THE LATTER CASE THE ARRAY C WILL BE INPUT(OUTPUT) IN COLUMN MAJOR ORDER. C NOTE THAT ONLY VALUES WHICH ARE THE RESULT OF A C COMPUTATION MAY BE OUTPUT. CONSTANTS OR DATA VALUES C MAY NOT BE OUTPUT. C C 4. THE REAL ASSIGNMENT STATEMENT C C USE: TO ASSIGN A VALUE TO A REAL VARIABLE C C FORM: REAL VARIABLE = REAL EXPRESSION C C WHERE THE REAL VARIABLE IS EITHER A REAL SCALAR OR SINGLE C ARRAY ELEMENT. REAL EXPRESSIONS ARE MADE UP OF REAL C VARIABLES AND CONSTANTS COMBINED WITH THE BINARY OPERATORS C +, -, * AND / AND THE UNARY OPERATORS UNARY - AND SQRT. C (THE OPERAND OF THE SQRT MUST APPEAR IN PARENTHESES.) C (NOTE THAT THERE IS NO REAL EXPONENTIATION ALLOWED.) C OPERATOR PRECEDENCE IS AS IN STANDARD FORTRAN. IN ADDITION C THERE IS A SUMMATION OPERATION ON ARRAY VECTORS, IN EFFECT, C A BUILT-IN INNER PRODUCT. A SUMMATION EXPRESSION CAN APPEAR C IN A REAL EXPRESSION AND IS OF THE FORM: C C SUMMATION(D1 * D2, SUMMATION-VARIABLE = INTEXP1 TO INTEXP2) C C WHERE INTEXP IS AN INTEGER EXPRESSION, THE SUMMATION C VARIABLE IS ANY INTEGER IDENTIFIER NAME, AND WHERE D1 AND D2 C ARE EACH OF ONE OF THE FORMS: C ARRAY NAME(SUMMATION-VARIABLE) C ARRAY NAME(SUMMATION-VARIABLE,SUMMATION-VARIABLE) C ARRAY NAME(SUMMATION-VARIABLE,INTEXP) C ARRAY NAME(INTEXP,SUMMATION-VARIABLE) C C A SUMMATION EXPRESSION WILL BE INTERPRETED AS AN IMPLICIT C FOR-LOOP. ANY USE OF THE SUMMATION VARIABLE IN THE INTEGER C EXPRESSIONS BOUNDING THE SUMMATION LOOP WILL BE FLAGGED AS C AN ERROR. C C 5. THE FOR STATEMENT C C USE: AS A MEANS OF INDICATING THAT A BLOCK OF STATEMENTS IS TO BE C ITERATIVELY EXECUTED A SPECIFIED NUMBER OF TIMES. C C FORM: FOR INTEGER-VARIABLE = INTEXP1 TO INTEXP2 BY INCREMENT C C WHERE INTEXP STANDS FOR INTEGER EXPRESSION, AND INCREMENT IS C WRITTEN AS EITHER +1, -1 OR 1. C C INTERPRETATION: ALL STATEMENTS UP TO THE END STATEMENT MATCHING C THIS FOR STATEMENT (SEE BELOW FOR DISCUSSION OF END C STATEMENTS) WILL BE ITERATIVELY INTERPRETED AS IN A FORTRAN C DO LOOP, EXCEPT THAT NEGATIVE INCREMENTS ARE ALLOWED AND IN C THIS CASE, THE LOOP VARIABLE TEST IS DONE AT THE TOP OF THE C LOOP. THUS, EMPTY LOOPS ARE POSSIBLE, THAT IS THOSE WHICH C WILL NOT BE EXECUTED AT ALL. (NOTE THE SAME IS TRUE OF THE C IMPLICIT FOR-LOOP IN A SUMMATION EXPRESSION.) C C 6. THE IF-THEN STATEMENT C C USE: TO ALLOW SELECTIVE EXECUTION OF A BLOCK OF STATEMENTS C DEPENDING ON THE OUTCOME OF A COMPARISON OF THE VALUES OF C TWO INTEGER EXPRESSIONS. C C FORM: IF INTEXP1 .R. INTEXP2 THEN C C WHERE INTEXP STANDS FOR INTEGER EXPRESSION AND R IS ONE OF C THE RELATIONS WRITTEN EQ,NE,GT,LT,LE OR GE WITH THE C STANDARD FORTRAN DENOTATION. NOTE THAT THERE ARE NO C PARENTHESES AROUND THE RELATIONAL EXPRESSION. C C INTERPRETATION: IF THE TEST SUCCEEDS, THAT IS IF THE TWO INTEGER C EXPRESSIONS ARE RELATED IN THE INDICATED WAY AT THE TIME OF C INTERPRETATION, THEN ALL THE STATEMENTS UP TO THE NEXT END C STATEMENT WILL BE INTERPRETED. OTHERWISE, THE FIRST C EXECUTABLE STATEMENT FOLLOWING THE NEXT END STATEMENT WILL C BE THE NEXT STATEMENT INTERPRETED. C C 7. THE END STATEMENT C C USE: TO DEFINE THE ENDS OF BLOCKS OF STATEMENTS BEGINNING WITH C FOR STATEMENTS OR IF-THEN STATEMENTS. C C FORM1: END C FORM2 : END(INTEGER-VARIABLE) C C MEANING: WHEN FORM 1 IS USED THE EFFECT IS TO CLOSE THE BLOCK OF C STATEMENTS BEGINNING AT THE NEAREST PRECEEDING FOR OR C IF-THEN STATEMENT. C WHEN FORM2 IS USED THE EFFECT IS TO CLOSE THE FOR BLOCK C WHOSE LOOP VARIABLE MATCHES THE END STATEMENT VARIABLE. IN C ADDITION, ANY FOR OR IF-THEN BLOCKS WHICH BEGIN BETWEEN THIS C END STATEMENT AND ITS MATCHING FOR STATEMENT ARE CLOSED. C THIS INTERPRETATION IMPOSES STANDARD FORTRAN LIKE NESTING C CONVENTIONS ON FOR AND IF-THEN BLOCKS. THAT IS, A SEQUENCE C OF STATEMENTS C FOR K = IE1 TO IE2 BY 1 C . C . C FOR I = IE3 TO IE4 BY 1 C . C . C END(K) C . C END(I) C WILL RESULT IN AN ERROR MESSAGE WHEN THE END(I) STATEMENT C IS ENCOUNTERED, BECAUSE BOTH FOR STATEMENTS WILL HAVE BEEN C CLOSED BY THE PARSER WHEN THE END(K) STATEMENT WAS PARSED. C C NOTE: ADDITIONAL RESTRICTIONS ON BLOCK STRUCTURES: C 1) AT MOST EIGHT FOR AND/OR IF-THEN BLOCKS CAN BE BEGUN C BEFORE AN END STATEMENT OCCURS. C 2) A FOR LOOP VARIABLE CANNOT BE USED AGAIN AS AN EXPLICIT C FOR LOOP VARIABLE WITHIN ITS ORIGINAL LOOP. IT CAN BE C REUSED AS A SUMMATION VARIABLE, HOWEVER. C C C 8. THE COMPOSITION STATEMENT C C USE: TO REPRESENT THE TEST PROGRAM AS THE COMPOSITION OF TWO C COMPUTATIONS SO THAT THE ERROR-ANALYSIS SOFTWARE CAN C TEST FOR INHERENT INSTABILITY, I.E., INSTABILITY THAT C PERSISTS REGARDLESS OF HOW THE TWO COMPUTATIONS ARE C PERFORMED. C C FORM: COMPOSITION C C 9. THE STOP STATEMENT C C USE: TO DENOTE THE END OF THE PROGRAM C C FORM: *STOP C C ************************************************************** C * * C * NAMING INPUT/OUTPUT DEVICES IN FORMAT STATEMENTS * C * * C ************************************************************** C C THE CURRENT VALUES ARE 5,6 AND 7 FOR (RESP.) CARD READER, LINE C PRINTER AND THE DEVICE FOR THE OUTPUT PREPARED FOR THE ROUNDOFF C ANALYSIS SOFTWARE. TO CHANGE THESE VALUES MERELY ALTER THE BLOCK C DATA INITIALIZATION OF COMMON AREA /IO/ JUST BELOW. C C C **************************** C * * C * THE PARSE TABLE * C * * C **************************** C C IN THE DOCUMENTATION OF THE PARSER WHICH FOLLOWS, THE SYMBOLS C OF THE GRAMMAR AND THE RULES OF THE GRAMMAR ARE DESCRIBED. THE PARSE C TABLE ITSELF IS NOT EXPLICITLY DESCRIBED BECAUSE IT IS TOO BIG TO C PRINT OUT IN COMMENTS. THE FOLLOWING CODE, FOLLOWED BY THE BLOCK C DATA SUBROUTINE IN THIS PROGRAM WILL CAUSE THE PARSE TABLE TO C BE PRINTED OUT. IN THE PRINT OUT, THE COLUMNS REPRESENT THE TOKENS C COMING TO THE PARSER FROM THE LEXICAL ANALYZER, AND THE ROWS C REPRESENT THE NONTERMINALS ON THE PARSE STACK. AN ENTRY OF -1 IN THE C TABLE INDICATES AN ERROR. ANY OTHER ENTRY IS THE INDEX OF THE RULE C BY WHICH THE TOP ENTRY OF THE PARSESTACK SHOULD BE EXPANDED. C CODE: C C COMMON /PARSER/P,R C INTEGER P(26,31),R(58,14) C 10 FORMAT('0',5X,5HI 0,30I4) C 20 FORMAT(' ',6H-----I,124(1HI)) C 30 FORMAT(' ',I2,3X,1HI,31I4) C 40 FORMAT(' ',5X,1HI) C WRITE(6,10) (I,I=1,30) C WRITE(6,20) C DO 100 I=1,26 C WRITE(6,40) C 100 WRITE(6,30) I,(P(I,J),J=1,31) C STOP C END C C BLOCK DATA C C IO INPUT/OUTPUT DEVICE NUMBERS: C NREAD CARD READER C NPRINT LINE PRINTER C NPUNCH DEVICE FOR PUNCHED OUTPUT (PREPARED FOR THE C ROUNDOFF ANALYSIS SOFTWARE.) C C SYMTAB THE COLLECTION OF ARRAYS WHICH MAKE UP THE SYMBOL TABLE, C INCLUDING: C NAME IDENTIFIER, UP TO 10 CHARACTERS, FILLED OUT C WITH BLANKS C TYPE SIGNIFIES WHETHER REAL OR INTEGER CONSTANT, C REAL OR INTEGER VARIABLE, OR ONE OR TWO C DIMENSIONAL ARRAY C VALUE FOR REAL AND INTEGER CONSTANTS AND VARIABLES C THIS CONTAINS THEIR VALUE; FOR ARRAYS C THIS IS A POINTER TO THE AUXILIARY STORAGE C SET ASIDE FOR THE ELEMENTS OF THE ARRAY C ROWS THE NUMBER OF ROWS IN AN ARRAY; FOR REAL AND C INTEGER CONSTANTS AND VARIABLES THIS IS C ALWAYS ZERO C COLS THE NUMBER OF COLUMNS IN AN ARRAY; FOR REAL C AND INTEGER CONSTANTS AND VARIABLES AND C ONE DIMENSIONAL ARRAYS THIS IS ALWAYS ZERO C DEFIND INDICATES WHETHER OR NOT A VALUE HAS BEEN C ASSIGNED C NPRINT LINE PRINTER C AUXVAL AUXILIARY STORAGE FOR ARRAY ELEMENTS; IF THE C AUXVAL CORRESPONDING TO A PARTICULAR C ELEMENT OF A PARTICULAR ARRAY IS ZERO C THIS MEANS THE ELEMENT IS UNDEFINED C C MISC MISCELLANEOUS COLLECTION OF CODES, COUNTERS, AND POINTERS C INCLUDING: C INTVAR CODE FOR INTEGER VARIABLE -- SET TO 0 C INTCON CODE FOR INTEGER CONSTANT -- SET TO 1 C REAVAR CODE FOR REAL VARIABLE -- SET TO 2 C ONEDIM CODE FOR ONE DIMENSIONAL ARRAY -- SET TO 3 C TWODIM CODE FOR TWO DIMENSIONAL ARRAY -- SET TO 4 C REACON CODE FOR REAL CONSTANT -- SET TO 5 C VAR CODE FOR VARIABLE, INTEGER OR REAL -- C SET TO -1 C AUXPTR POINTER TO LAST USED WORD OF AUXILIARY STORAGE C AUXLIM LIMIT ON TOTAL NUMBER OF WORDS OF AUXILIARY C STORAGE SET ASIDE FOR ARRAY ELEMENTS -- C SET TO 300 C SYMPTR POINTER TO LAST USED ENTRY IN SYMBOL TABLE C SYMLIM LIMIT ON TOTAL NUMBER OF ENTRIES IN SYMBOL C TABLE -- SET TO 50 C I SET TO THE INTERNAL CODE FOR THE LETTER I; C USED IN DETERMINING WHETHER A VARIABLE IS C INTEGER OR REAL ACCORDING TO THE FORTRAN C CONVENTION FOR THE FIRST LETTER OF THE NAME C N SET TO THE INTERNAL CODE FOR THE LETTER N; C USED ALONG WITH I AS DESCRIBED ABOVE C C ERRCT GLOBAL ERROR COUNT C C REACNT COUNTER WHICH IS INCREMENTED EACH TIME A REAL CONSTANT C IS ADDED TO THE SYMBOL TABLE; THE CONSTANT IS THEN C ASSIGNED THE NEGATIVE OF THE CURRENT VALUE OF REACNT C C SUPP ARRAY CONTAINING THE NAMES OF ALL REAL CONSTANTS IN C THE SYMBOL TABLE C COMMON /IO/ NREAD,NPRINT,NPUNCH C /SYMTAB/ NAME,TYPE,VALUE,ROWS,COLS,DEFIND, C AUXVAL C /MISC/ INTVAR,INTCON,REAVAR,ONEDIM,TWODIM, C REACON,VAR,AUXPTR,AUXLIM,SYMPTR, C SYMLIM,I,N C /TEMP/ SUPP,REACNT C /ERRNUM/ ERRCT C /FIN/ FDAT,FINT,FOUT,KDAT,KINT,KOUT C /SUM/ DUM,NULTAB,NULVAL,NULSTM C /INTCOD/ ICODE,LINE C /ITEMPS/ ITEM,TOP C /ATTSTK/ ASTACK,ATOP C /PARSER/ P,R C /OPTS/ F0,F1,OPT C /COMPOZ/ NCUT LOGICAL NULSTM,DEFIND(50) LOGICAL DUM INTEGER NAME (50,10), TYPE (50), VALUE (50), ROWS (50), C COLS (50), AUXVAL (300), INTVAR, INTCON, REAVAR, C ONEDIM, TWODIM, REACON, VAR, AUXPTR, AUXLIM, C ATOP, SYMPTR, SYMLIM, I, N, REACNT, SUPP (20,10), C R(58,14),P(26,31),FDAT(50,2),FINT(500,5),FOUT(20,3), C ASTACK(30),ICODE(500,11),ITEM(30),ERRCT,RD5,LP6,BT7 C ,F0,F1,OPT C C ********************************************* C * DECLARE I/O DEVICE NUMBERS * C ********************************************* DATA NREAD,NPRINT,NPUNCH /5,6,7/ C DATA NAME(1,1), NAME(1,2), NAME(1,3), NAME(1,4), NAME(1,5), C NAME(1,6), NAME(1,7), NAME(1,8), NAME(1,9), NAME(1,10) C / 1H*, 1HI, 1HN, 1HT, 1HR, 1H , 1H , 1H , 1H , 1H /, C TYPE(1) , VALUE(1) /3,1/, C INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, VAR, C AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N, REACNT, C ERRCT,ATOP,KDAT,KINT,KOUT,NULTAB,NULVAL,NULSTM, C DUM C / 0, 1, 2, 3, 4, 5, -1, 200, 300, 1, 50, C 1HI, 1HN, 7*0 , 50 , .TRUE. , .FALSE./ C DATA F0,F1,OPT/0,0,1/ DATA NCUT/0/ C C ************************************** C * INITIALIZATION OF THE PARSE TABLE * C ************************************** DATA P(1,1),P(1,2),P(1,3),P(1,4),P(1,5),P(1,6),P(1,7),P(1,8), * P(1,9),P(1,10),P(1,11),P(1,12),P(1,13),P(1,14),P(1,15),P(1,16) * /-1,-1,4,4,4,-1,7,-1,1,-1,-1,2,-1,3,-1,5/,P(1,17),P(1,18), * P(1,19),P(1,20),P(1,21),P(1,22),P(1,23),P(1,24),P(1,25),P(1,26), * P(1,27),P(1,28),P(1,29),P(1,30),P(1,31)/6,11*-1,58,2*-1/, * P(2,1),P(2,2),P(2,3),P(2,4),P(2,5),P(2,6),P(2,7),P(2,8),P(2,9), * P(2,10),P(2,11),P(2,12),P(2,13),P(2,14),P(2,15),P(2,16),P(2,17), * P(2,18),P(2,19),P(2,20),P(2,21),P(2,22),P(2,23),P(2,24),P(2,25), * P(2,26),P(2,27),P(2,28),P(2,29),P(2,30),P(2,31) * /-1,10,17*-1,8,9,10*-1/,P(3,1),P(3,2),P(3,3),P(3,4),P(3,5),P(3,6) * ,P(3,7),P(3,8),P(3,9),P(3,10),P(3,11),P(3,12),P(3,13),P(3,14), * P(3,15),P(3,16),P(3,17),P(3,18),P(3,19),P(3,20),P(3,21),P(3,22), * P(3,23),P(3,24),P(3,25),P(3,26),P(3,27),P(3,28),P(3,29),P(3,30), * P(3,31)/23*-1,11,3*-1,0,3*-1/,P(4,1),P(4,2),P(4,3),P(4,4),P(4,5), * P(4,6),P(4,7),P(4,8),P(4,9),P(4,10),P(4,11),P(4,12),P(4,13), * P(4,14),P(4,15),P(4,16),P(4,17),P(4,18),P(4,19),P(4,20),P(4,21), * P(4,22),P(4,23),P(4,24),P(4,25),P(4,26),P(4,27),P(4,28),P(4,29), * P(4,30),P(4,31)/-1,-1,12,13,14,26*-1/ DATA P(5,1),P(5,2),P(5,3),P(5,4),P(5,5),P(5,6),P(5,7),P(5,8), * P(5,9),P(5,10),P(5,11),P(5,12),P(5,13),P(5,14),P(5,15),P(5,16), * P(5,17),P(5,18),P(5,19),P(5,20),P(5,21),P(5,22),P(5,23),P(5,24), * P(5,25),P(5,26),P(5,27),P(5,28),P(5,29),P(5,30),P(5,31) * /23*-1,15,16,16,5*-1/,P(6,1),P(6,2),P(6,3),P(6,4),P(6,5),P(6,6), * P(6,7),P(6,8),P(6,9),P(6,10),P(6,11),P(6,12),P(6,13),P(6,14), * P(6,15),P(6,16),P(6,17),P(6,18),P(6,19),P(6,20),P(6,21),P(6,22), * P(6,23),P(6,24),P(6,25),P(6,26),P(6,27),P(6,28),P(6,29),P(6,30), * P(6,31)/23*-1,17,16,16,5*-1/,P(7,1),P(7,2),P(7,3),P(7,4),P(7,5), * P(7,6),P(7,7),P(7,8),P(7,9),P(7,10),P(7,11),P(7,12),P(7,13), * P(7,14),P(7,15),P(7,16),P(7,17),P(7,18),P(7,19),P(7,20),P(7,21), * P(7,22),P(7,23),P(7,24),P(7,25),P(7,26),P(7,27),P(7,28),P(7,29), * P(7,30),P(7,31)/24*-1,0,18,5*-1/ ,P(8,1),P(8,2),P(8,3),P(8,4), *P(8,5),P(8,6),P(8,7),P(8,8),P(8,9),P(8,10),P(8,11),P(8,12),P(8,13) * ,P(8,14),P(8,15),P(8,16),P(8,17),P(8,18),P(8,19),P(8,20),P(8,21), * P(8,22),P(8,23),P(8,24),P(8,25),P(8,26),P(8,27),P(8,28),P(8,29), * P(8,30),P(8,31)/24*-1,0,19,5*-1/ DATA P(9,1),P(9,2),P(9,3),P(9,4),P(9,5),P(9,6),P(9,7),P(9,8), * P(9,9),P(9,10),P(9,11),P(9,12),P(9,13),P(9,14),P(9,15),P(9,16), * P(9,17),P(9,18),P(9,19),P(9,20),P(9,21),P(9,22),P(9,23),P(9,24), * P(9,25),P(9,26),P(9,27),P(9,28),P(9,29),P(9,30),P(9,31) * /21,-1,20,23,22,26*-1/,P(10,1),P(10,2),P(10,3),P(10,4),P(10,5), * P(10,6),P(10,7),P(10,8),P(10,9),P(10,10),P(10,11),P(10,12), * P(10,13),P(10,14),P(10,15), P(10,16),P(10,17),P(10,18),P(10,19), * P(10,20),P(10,21),P(10,22),P(10,23),P(10,24),P(10,25),P(10,26), * P(10,27),P(10,28),P(10,29),P(10,30),P(10,31)/24*-1,24,25,5*-1/, * P(11,1),P(11,2),P(11,3),P(11,4),P(11,5),P(11,6),P(11,7), * P(11,8),P(11,9),P(11,10),P(11,11),P(11,12),P(11,13),P(11,14), * P(11,15),P(11,16),P(11,17),P(11,18),P(11,19),P(11,20),P(11,21), * P(11,22),P(11,23),P(11,24),P(11,25),P(11,26),P(11,27),P(11,28), * P(11,29),P(11,30),P(11,31)/24*-1,0,26,5*-1/,P(12,1),P(12,2), * P(12,3),P(12,4),P(12,5),P(12,6),P(12,7),P(12,8),P(12,9), * P(12,10),P(12,11),P(12,12),P(12,13),P(12,14),P(12,15), * P(12,16),P(12,17),P(12,18),P(12,19),P(12,20),P(12,21),P(12,22), * P(12,23),P(12,24),P(12,25),P(12,26),P(12,27),P(12,28),P(12,29), * P(12,30),P(12,31)/27,27,18*-1,28,-1,-1,27,7*-1/ DATA P(13,1),P(13,2),P(13,3),P(13,4),P(13,5),P(13,6),P(13,7), * P(13,8),P(13,9),P(13,10),P(13,11),P(13,12),P(13,13),P(13,14), * P(13,15),P(13,16),P(13,17),P(13,18),P(13,19),P(13,20),P(13,21), * P(13,22),P(13,23),P(13,24),P(13,25),P(13,26),P(13,27),P(13,28), * P(13,29),P(13,30),P(13,31) */9*-1,0,0,-1,0,6*-1,29,30,3*-1,0,0,4*-1,0/,P(14,1),P(14,2),P(14,3) *,P(14,4),P(14,5),P(14,6),P(14,7),P(14,8),P(14,9),P(14,10),P(14,11) * ,P(14,12),P(14,13),P(14,14),P(14,15),P(14,16),P(14,17),P(14,18), * P(14,19),P(14,20),P(14,21),P(14,22),P(14,23),P(14,24),P(14,25), * P(14,26),P(14,27),P(14,28),P(14,29),P(14,30),P(14,31) * /2*31,21*-1,31,7*-1/,P(15,1),P(15,2),P(15,3),P(15,4),P(15,5), * P(15,6),P(15,7),P(15,8),P(15,9),P(15,10),P(15,11),P(15,12), * P(15,13),P(15,14),P(15,15),P(15,16),P(15,17),P(15,18),P(15,19), * P(15,20),P(15,21),P(15,22),P(15,23),P(15,24),P(15,25),P(15,26), * P(15,27),P(15,28),P(15,29),P(15,30),P(15,31) */9*-1,0,0,-1,0,6*-1,0,0,32,33,-1,0,0,-1,0,-1,-1,0/,P(16,1),P(16,2) * ,P(16,3),P(16,4),P(16,5),P(16,6),P(16,7),P(16,8),P(16,9),P(16,10) * ,P(16,11),P(16,12),P(16,13),P(16,14),P(16,15),P(16,16),P(16,17), * P(16,18),P(16,19),P(16,20),P(16,21),P(16,22)/35,36,20*-1/ DATA P(16,23),P(16,24),P(16,25),P(16,26),P(16,27),P(16,28), * P(16,29),P(16,30),P(16,31)/-1,34,7*-1/,P(17,1),P(17,2),P(17,3), * P(17,4),P(17,5),P(17,6),P(17,7),P(17,8),P(17,9),P(17,10),P(17,11) * ,P(17,12),P(17,13),P(17,14),P(17,15),P(17,16),P(17,17),P(17,18), * P(17,19),P(17,20),P(17,21),P(17,22),P(17,23),P(17,24),P(17,25), * P(17,26),P(17,27),P(17,28),P(17,29),P(17,30),P(17,31) * /2*-1,37,38,39,26*-1/,P(18,1),P(18,2),P(18,3),P(18,4),P(18,5), * P(18,6),P(18,7),P(18,8),P(18,9),P(18,10),P(18,11),P(18,12), * P(18,13),P(18,14),P(18,15),P(18,16),P(18,17),P(18,18),P(18,19), * P(18,20),P(18,21),P(18,22),P(18,23),P(18,24),P(18,25),P(18,26), * P(18,27),P(18,28),P(18,29),P(18,30),P(18,31) * /2*-1,4*40,-1,40,9*-1,40,2*-1,41,-1,-1,40,7*-1/,P(19,1),P(19,2), *P(19,3),P(19,4),P(19,5),P(19,6),P(19,7),P(19,8),P(19,9),P(19,10), * P(19,11),P(19,12),P(19,13),P(19,14),P(19,15),P(19,16),P(19,17), * P(19,18),P(19,19),P(19,20),P(19,21),P(19,22),P(19,23),P(19,24), * P(19,25),P(19,26),P(19,27),P(19,28),P(19,29),P(19,30),P(19,31) * /19*-1,42,43,3*-1,0,2*-1,0,3*-1/ DATA P(20,1),P(20, 2),P(20,3),P(20,4),P(20,5),P(20,6),P(20,7), * P(20,8),P(20,9),P(20,10),P(20,11),P(20,12),P(20,13),P(20,14), * P(20,15),P(20,16),P(20,17),P(20,18),P(20,19),P(20,20),P(20,21), * P(20,22),P(20,23),P(20,24),P(20,25),P(20,26),P(20,27),P(20,28), * P(20,29),P(20,30),P(20,31)/2*-1,4*44,-1,44,9*-1,44,5*-1,44,7*-1/ DATA P(21,1),P(21,2),P(21,3),P(21,4),P(21,5),P(21,6),P(21,7), * P(21,8),P(21,9),P(21,10),P(21,11),P(21,12),P(21,13),P(21,14), * P(21,15),P(21,16),P(21,17),P(21,18),P(21,19),P(21,20), * P(21,21),P(21,22),P(21,23),P(21,24),P(21,25),P(21,26),P(21,27), * P(21,28),P(21,29),P(21,30),P(21,31) * /19*-1,0,0,45,46,-1,0,2*-1,0,3*-1/,P(22,1),P(22,2),P(22,3), *P(22,4),P(22,5),P(22,6),P(22,7),P(22,8),P(22,9),P(22,10),P(22,11), * P(22,12),P(22,13),P(22,14),P(22,15),P(22,16),P(22,17),P(22,18), * P(22,19),P(22,20),P(22,21),P(22,22),P(22,23),P(22,24),P(22,25), * P(22,26),P(22,27),P(22,28),P(22,29),P(22,30),P(22,31) */-1,-1,3*56,57,-1,49,9*-1,47,5*-1,48,7*-1/,P(23,1),P(23,2),P(23,3) *,P(23,4),P(23,5),P(23,6),P(23,7),P(23,8),P(23,9),P(23,10),P(23,11) * ,P(23,12),P(23,13),P(23,14),P(23,15),P(23,16),P(23,17),P(23,18), * P(23,19),P(23,20),P(23,21),P(23,22),P(23,23),P(23,24),P(23,25), * P(23,26),P(23,27),P(23,28),P(23,29),P(23,30),P(23,31) * /3*-1,50,51,26*-1/ DATA P(24,1),P(24,2),P(24,3),P(24,4),P(24,5),P(24,6),P(24,7), * P(24,8),P(24,9),P(24,10),P(24,11),P(24,12),P(24,13),P(24,14), * P(24,15),P(24,16),P(24,17),P(24,18),P(24,19),P(24,20),P(24,21), * P(24,22),P(24,23),P(24,24),P(24,25),P(24,26),P(24,27),P(24,28), * P(24,29),P(24,30),P(24,31)/2*52,18*-1,52,2*-1,52,5*-1,53,-1/, * P(25,1),P(25,2),P(25,3),P(25,4),P(25,5),P(25,6),P(25,7), * P(25,8),P(25,9),P(25,10),P(25,11),P(25,12),P(25,13),P(25,14), * P(25,15),P(25,16),P(25,17),P(25,18),P(25,19),P(25,20),P(25,21), * P(25,22),P(25,23),P(25,24),P(25,25),P(25,26),P(25,27),P(25,28), * P(25,29),P(25,30),P(25,31)/2*55,18*-1,55,2*-1,55,5*-1,54,-1/, * P(26,1),P(26,2),P(26,3),P(26,4),P(26,5),P(26,6),P(26,7),P(26,8), * P(26,9),P(26,10),P(26,11),P(26,12),P(26,13),P(26,14),P(26,15), * P(26,16),P(26,17),P(26,18),P(26,19),P(26,20),P(26,21),P(26,22), * P(26,23),P(26,24),P(26,25),P(26,26),P(26,27),P(26,28),P(26,29), * P(26,30),P(26,31)/21,10,29*-1/ C C ****************************************** C * INITIALIZATION OF RULES OF THE GRAMMAR * C ****************************************** DATA R(1,1),R(1,2),R(1,3),R(1,4),R(1,5),R(1,6),R(1,7),R(1,8), * R(1,9),R(1,10),R(1,11)/10,8,0,18,112,9,112,10,102,220,27/, * R(2,1),R(2,2),R(2,3),R(2,4),R(2,5),R(2,6),R(2,7),R(2,8), * R(2,9),R(2,10)/9,11,112,30,26,30,112,12,216,27/,R(3,1),R(3,2), * R(3,3),R(3,4),R(3,5)/4,13,103,221,27/,R(4,1),R(4,2),R(4,3), * R(4,4),R(4,5),R(4,6)/5,117,18,118,214,27/,R(5,1),R(5,2),R(5,3), * R(5,4),R(5,5),R(5,6),R(5,7),R(5,8)/7,15,23,104,217,107,24,27/, * R(6,1),R(6,2),R(6,3),R(6,4),R(6,5),R(6,6),R(6,7),R(6,8), * R(6,9),R(6,10)/9,16,23,0,18,1,218,108,24,27/,R(7,1),R(7,2),R(7,3) * ,R(7,4),R(7,5),R(7,6),R(7,7),R(7,8),R(7,9),R(7,10),R(7,11), * R(7,12)/11,6,23,109,23,126,110,24,219,111,24,27/,R(8,1),R(8,2), * R(8,3)/2,19,1/,R(9,1),R(9,2),R(9,3),R(9,4)/3,20,1,222/, * R(10,1),R(10,2)/1,1/,R(11,1),R(11,2),R(11,3),R(11,4)/3,23,0,24/, * R(12,1),R(12,2),R(12,3),R(12,4)/3,2,212,212/,R(13,1),R(13,2), *R(13,3)/2,3,105/,R(14,1),R(14,2),R(14,3)/2,4,106/,R(15,1),R(15,2), * R(15,3),R(15,4),R(15,5)/4,23,112,24,212/ DATA R(16,1),R(16,2),R(16,3)/2,212,212/,R(17,1),R(17,2), * R(17,3),R(17,4),R(17,5),R(17,6)/5,23,112,25,112,24/,R(18,1), * R(18,2),R(18,3),R(18,4),R(18,5)/4,25,104,217,107/,R(19,1), * R(19,2),R(19,3),R(19,4),R(19,5),R(19,6),R(19,7)/ * 6,25,0,18,1,218,108/,R(20,1),R(20,2)/1,2/,R(21,1),R(21,2)/ * 1,0/,R(22,1),R(22,2)/1,4/,R(23,1),R(23,2)/1,3/,R(24,1),R(24,2)/ * 1,212/,R(25,1),R(25,2),R(25,3)/2,25,126/,R(26,1),R(26,2),R(26,3), * R(26,4),R(26,5),R(26,6),R(26,7),R(26,8),R(26,9)/ * 8,25,109,23,126,110,24,219,111/,R(27,1),R(27,2),R(27,3)/ * 2,114,113/,R(28,1),R(28,2),R(28,3),R(28,4),R(28,5)/ * 4,20,114,211,113/,R(29,1),R(29,2),R(29,3),R(29,4),R(29,5)/ * 4,19,114,207,113/,R(30,1),R(30,2),R(30,3),R(30,4),R(30,5)/ * 4,20,114,208,113/,R(31,1),R(31,2),R(31,3)/2,116,115/,R(32,1), * R(32,2),R(32,3),R(32,4),R(32,5)/4,21,116,209,115/,R(33,1),R(33,2) * ,R(33,3),R(33,4),R(33,5)/4,22,116,210,115/ DATA R(34,1),R(34,2),R(34,3),R(34,4)/3,23,112,24/,R(35,1), * R(35,2),R(35,3)/2,0,215/,R(36,1),R(36,2),R(36,3)/2,1,215/, * R(37,1),R(37,2),R(37,3),R(37,4)/3,2,212,212/,R(38,1),R(38,2), * R(38,3),R(38,4),R(38,5),R(38,6)/5,3,23,112,24,212/,R(39,1), * R(39,2),R(39,3),R(39,4),R(39,5),R(39,6),R(39,7)/ * 6,4,23,112,25,112,24/,R(40,1),R(40,2),R(40,3)/2,120,119/, * R(41,1),R(41,2),R(41,3),R(41,4),R(41,5),R(41,6),R(41,7),R(41,8)/ * 7,20,120,3*212,206,119/,R(42,1),R(42,2),R(42,3),R(42,4),R(42,5)/ * 4,19,120,201,119/,R(43,1),R(43,2),R(43,3),R(43,4),R(43,5)/ * 4,20,120,202,119/,R(44,1),R(44,2),R(44,3)/2,122,121/,R(45,1), *R(45,2),R(45,3),R(45,4),R(45,5)/4,21,122,203,121/,R(46,1),R(46,2), *R(46,3),R(46,4),R(46,5)/4,22,122,204,121/,R(47,1),R(47,2),R(47,3), * R(47,4),R(47,5),R(47,6),R(47,7)/8,17,23,118,24,2*212 /,R(47,8), * R(47,9)/212,205/,R(48,1),R(48,2),R(48,3),R(48,4)/3,23,118,24/, * R(49,1),R(49,2),R(49,3),R(49,4),R(49,5),R(49,6),R(49,7),R(49,8), *R(49,9),R(49,10),R(49,11)/13,7,23,123,21,123,25,29,18,112,9/, *R(49,12),R(49,13),R(49,14)/112,24,224/,R(50,1),R(50,2),R(50,3), * R(50,4),R(50,5),R(50,6),R(50,7)/6,3,23,29,213,24,212/,R(51,1), * R(51,2),R(51,3),R(51,4),R(51,5)/4,4,23,124,24/ DATA R(52,1),R(52,2),R(52,3),R(52,4),R(52,5)/4,112,25,29,213/, * R(53,1),R(53,2),R(53,3),R(53,4),R(53,5)/4,29,213,25,125/, * R(54,1),R(54,2),R(54,3)/2,29,213/,R(55,1),R(55,2)/1,112/,R(56,1), * R(56,2)/1,117/,R(57,1),R(57,2),R(57,3),R(57,4)/3,5,212,212/, * R(58,1),R(58,2),R(58,3)/2,28,223/ C C END C C ******************************************* C * * C * MAIN PROGRAM (THE PARSER) * C * * C ******************************************* C * * C * GENERAL DESCRIPTION * C * * C ******************************************* C C THE PARSER PERFORMS AN LL-1 PARSE AND TRANSLATION BASED ON C INPUT TOKENS FROM THE LEXICAL ANALYZER. INITIALLY (AT THE C BEGINNING OF THE PARSING OF EACH STATEMENT) THE PARSE STACK C CONTAINS ONLY THE GRAMMATICAL SYMBOL WHICH IS THE SENTENTIAL C NONTERMINAL. WHENEVER A NONTERMINAL IS ON TOP OF THE PARSE STACK C THE PARSER REFERS TO THE PARSETABLE TO SEE IF THE CURRENT INPUT C TOKEN IS AN INSTANCE OF THE FIRST SYMBOL OF A POSSIBLE EXPANSION C OF THAT NONTERMINAL BY A RULE OF THE GRAMMAR. IF SO, THE C PARSETABLE ENTRY CORRESPONDING TO THE NONTERMINAL AND INPUT WILL C BE THE INDEX OF THE ENTRY OF THE RULES ARRAY IN WHICH THE RIGHT C HAND SIDE OF THE APPROPRIATE RULE IS STORED. THE NONTERMINAL ON C THE PARSESTACK WILL BE REPLACED BY THE INDICATED EXPANSION. IF C THE PARSE TABLE ENTRY HAD BEEN NEGATIVE, THEN AN SYNTAX ERROR HAS C BEEN ENCOUNTERED AND THE PARSERS ERROR ROUTINE WILL COMMENCE. C WHENEVER A TERMINAL IS ON TOP OF THE PARSE STACK AND IT MATCHES C THE CURRENT INPUT TOKEN, IT IS POPPED OFF THE STACK, AND THE INPUT C IS ADVANCED (THAT IS, THE LEXICAL ANALYZER IS CALLED TO PRODUCE THE C NEXT TOKEN.) IF A TERMINAL ON TOP OF THE PARSESTACK DOES NOT MATCH C THE INPUT, THIS INDICATES A SYNTAX ERROR, AND THE ERROR ROUTINE C BEGINS. C WHEN AN ACTION SYMBOL IS ON TOP OF THE PARSE STACK, THE CODE C GENERATOR IS CALLED TO PERFORM SOME ROUTINE DEPENDENT ON THE VALUE C OF THAT SYMBOL. C IN ADDITION TO SYNTACTIC ANALYSIS, THE PARSER ALSO PUSHES ANY C SEMANTIC INFORMATION ASSOCIATED WITH TOKENS ONTO A SUPPLEMENTARY C ATTRIBUTE STACK. THIS INFORMATION IS EITHER A SYMBOL TABLE INDEX C ASSOCIATED WITH A CONSTANT OR VARIABLE, AND INDICATOR OF WHETHER C AN I-O TOKEN REPRESENTS INPUT OR OUTPUT, OR AN INTEGER CODE C IDENTIFYING A PARTICULAR RELATION (GREATER THAN, EQUAL, LESSTHAN, C ETC.) ATTACHED TO A RELATION TOKEN. THE PARSER DOES NOT FURTHER C MANIPULATE THE ATTRIBUTE STACK. THE STACK ITSELF IS EMPTIED AT C THE COMPLETION OF PARSING EACH STATEMENT BY THE CODE GENERATOR. C C ******************************************************* C * * C * VARIABLES AND DATA STRUCTURES USED BY THE PARSER * C * * C ******************************************************* C C PSTACK(50) : THE PARSE STACK C PTOP : POINTER TO THE TOP OF PSTACK C ASTACK(30) : THE ATTRIBUTE STACK C ATOP : POINTER TO THE TOP OF ASTACK C (ASTACK AND ATOP ARE IN COMMON WITH CODGEN) C TYPE : THE INTERNAL NAME OF A TERMINAL (TOKEN) PASSED C TO THE PARSER BY A SUBROUITNE CALL TO LEXAN C ATTR : IF NOT EQUAL TO -1 THIS IS AN ATTRIBUTE C ASSOCIATED WITH A TOKEN AS DESCRIBED ABOVE C (PASSED TO THE PARSER BY A CALL TO LEXAN.) C P(26,31) : THE PARSE TABLE. THE ROWS CORRESPOND TO C NONTERMINALS, AND THE COLUMNS TO TERMINALS. C R(58,14) : THE RULES ARRAY. EACH ROW CONSISTS OF A FIRST C ENTRY WHICH TELLS HOW MANY SYMBOLS FOLLOW AND C THAT MANY ENTRIES WHICH CODE THE RIGHT HAND SIDE C A RULE. NOTE THAT SEVERAL RULES OF THE GRAMMAR C MAY HAVE THE SAME RIGHT HAND SIDES,WITH DIFFERENT C LEFT HAND SIDES. (SEE RULES BELOW) C ERR : THE COUNT OF ERRORS ENCOUNTERED SO FAR IN PARSING C (IN COMMON WITH ALL ERROR ROUTINES ) C ERRBIT : A LOGICAL VARIABLE WHICH IS FALSE AT THE START C OF PARSING EACH STATEMENT. IF AN ERROR IS C IDENTIFIED BY THE PARSER DURING THE ANALYSIS OF C THAT STATEMENT, ERRBIT IS SET TO TRUE, AND THE C PARSERS ERROR ROUTINE IS ACTIVATED. THIS CONSISTS C OF POPPING ALL ELEMENTS OFF THE PARSE STACK C EXCEPT FOR THE SYMBOL FOR END OF STATEMENT, AND C REPEATEDLY CALLING THE LEXICAL ANALYZER UNTIL C THE END OF STATEMENT TOKEN IS RETURNED. AT THAT C POINT, THE ERRBIT IS SET TO FALSE AGAIN, AND C PARSING CONTINUES. C C ********************************************************** C * * C * GRAMMATICAL SYMBOLS AND RULES OF THE GRAMMAR * C * * C ********************************************************** C C THE GRAMMATICAL SYMBOLS ARE LISTED BELOW. THE COMPILER USES ONLY C INTERNAL INTEGER CODES, BUT EACH SYMBOL HAS ALSO BEEN GIVEN A NAME C FOR CLARITY IN DOCUMENTATION. THE NAMES OF TERMINALS (TOKENS FROM C THE LEXICAL ANALYZER) ARE PREFACED BY A T, THE NAMES OF NONTERMINALS C ARE PREFACED BY AN N AND ACTION SYMBOLS (WHICH FUNCTIONS AS SIGNALS C TO THE PARSER TO CALL CODE GENERATION SUBROUTINES) ARE PREFACED BY AN C A. C C CODE NAME DESCRIPTION C C 0 T0 INTEGER VARIABLE C 1 T1 INTEGER CONSTANT C 2 T2 REAL SCALAR VARIABLE C 3 T3 ONE DIMENSIONAL ARRAY C 4 T4 TWO DIMENSIONAL ARRAY C 5 T5 REAL CONSTANT C 6 TDIM DIMENSION C 7 TSUM SUMMATION C 8 TFOR FOR C 9 TTO TO C 10 TBY BY C 11 TIF IF C 12 TTHEN THEN C 13 TEND END C 15 TI-O INPUT OR OUTPUT C 16 TTEST TEST C 17 TSQRT SQRT C 18 T= EQUAL SIGN C 19 T+ PLUS SIGN C 20 T- MINUS SIGN C 21 T* MULTIPLICATION SIGN C 22 T/ DIVISION SIGN C 23 T( LEFT PARENTHESIS C 24 T) RIGHT PARENTHESIS C 25 T, COMMA C 26 TREL RELATION NAME C 27 TEOS END OF STATEMENT C 28 TEOF END OF FILE C 29 TDUM SUMMATION VARIABLE C 30 TDOT PERIOD BEFORE OR AFTER RELATION NAME C C 101 NSENT STATEMENT C 102 NINC FOR STATEMENT INCREMENT C 103 NEND OPTIONAL INTEGER VARIABLE NAME IN END STATEMENT C 104 NIOVAR INPUT-OUTPUT VARIABLE C 105 NSUB2 OPTIONAL SINGLE SUBSCRIPT ON IO VARIABLE C 106 NSUB3 OPTIONAL DOUBLE SUBSCRIPT ON IO VARIABLE C 107 NIOLIST OPTIONAL ADDITIONAL INPUT-OUTPUT VARIABLES C 108 NTLIST OPTIONAL ADDITIONAL LIST OF INTEGER ASSIGNMENT C STATEMENTS C 109 NVAR ANY VARIABLE NAME C 110 NSUB1 OPTIONAL SECOND SUBSCRIPT IN ARRAY BEING C DIMENSIONED C 111 NDIMLIST OPTIONAL ADDITIONAL LIST OF ARRAY NAMES TO BE C DIMENSIONED C 112 NIE INTEGER EXPRESSION C 113 NIEX INTEGER EXPRESSION MINUS ITS FIRST TERM C 114 NIT INTEGER TERM C 115 NITX INTEGER TERM MINUS ITS FIRST FACTOR C 116 NIF INTEGER FACTOR C 117 NRV REAL VARIABLE NAME C 118 NRE REAL EXPRESSION C 119 NREX REAL EXPRESSION MINUS ITS FIRST TERM C 120 NRT REAL TERM C 121 NRTX REAL TERM MINUS ITS FIRST FACTOR C 122 NRF REAL FACTOR C 123 NMUL MULTIPLICAND IN SUMMATION EXPRESSION C 124 ND1 SUBSCRIPT LIST OF DOUBLY SUBSCRIPTED NMUL C 125 ND2 SECOND SUBSCRIPT OF ND1 C 126 NINT INTEGER VARIABLE OR CONSTANT C C 201 ARADD GENERATE INTERMEDIATE REAL ADDTION INSTRUCTION C 202 ARSUB GENERATE INTERMEDIATE REAL SUBTRACTION INSTRUCTION C 203 ARMUL GENERATE INTERMEDIATE REAL MULTIPLICATION C INSTRUCTION C 204 ARDIV GENERATE INTERMEDIATE REAL DIVISION INSTRUCTION C 205 ASQRT GENERATE INTERMEDIATE SQUARE ROOT INSTRUCTION C 206 AUMINUS GENERATE UNARY REAL MINUS INSTRUCTION C 207 AIMINUS DO INTEGER UNARY MINUS ROUTINE C 208 AIADD GENERATE INTERMEDIATE INTEGER ADD INSTRUCTION C 209 AISUB GENERATE INTERMEDIATE INTEGER SUBTRACTION C INSTRUCTION C 210 AIMUL GENERATE INTERMEDIATE INTEGER MULTIPLY INSTRUCTION C 211 AIDIV GENERATE INTERMEDIATE INTEGER DIVIDE INSTRUCTION C 212 A0PUSH PUSH A 0 ONTO THE ATTRIBUTE STACK C 213 A*PUSH PUSH A -1 ONTO THE ATTRIBUTE STACK C 214 ASTORE GENERATE INTERMEDIATE STORE INSTRUCTION C 215 ALOAD GENERATE INTERMEDIATE LOAD INSTRUCTION C 216 AIF MANIPULATE FOR STACK AND GENERATE INTERMEDIATE C TEST INSTRUCTION C 217 AI-O GENERATE INTERMEDIATE INPUT-OUTPUT INSTRUCTION C 218 ASSIGN STORE INTEGER VALUE IN SYMBOL TABLE ENTRY OF C INTEGER VARIABLE C 219 ADIM ASSIGN DIMENSIONS TO REAL VARIABLE C 220 AFOR MANIPULATE FOR-STACK AND DO FOR LOOP INTERMEDIATE C ROUTINE C 221 AEND MANIPULATE FOR STACK AND PREVIOUS INTERMEDIATE CODE C AND GENERATE INTERMEDIATE BRANCH INSTRUCTION C 222 ADEC INDICATE NEGATIVE FOR LOOP INCREMENT C 223 AEOF END OF FILE ROUTINE C 224 ASUM SUMMATION ACTIONS C 225 AEOS END OF STATEMENT ACTIONS C C C THE RULES OF THE GRAMMAR CONSIST OF A LEFT HAND SIDE WHICH IS A C SINGLE NONTERMINAL, AND A RIGHT HAND SIDE WHICH IS A STRING OF C TERMINALS, NONTERMINALS, AND ACTION SYMBOLS. THE LEFT HAND C SIDES ARE NOT STORED EXPLICITLY IN THE COMPILER BUT ARE GIVEN C BELOW FOR COMPLETENESS. PRECEEDING EACH RULE IS AN INTEGER C WHICH IS THE INDEX OF THE RULES ARRAY IN WHICH THE RIGHT HAND C SIDE IS STORED. IF THIS INTEGER IS ZERO, IT INDICATES THAT THE C RULE IS A NULL PRODUCTION. C C INDEX L.H.S. EXPANSION C C 1 NSENT : TFOR T0 T= NIE TTO NIE TBY NINC AFOR TEOS C 2 NSENT : TIF NIE TDOT TREL TDOT NIE TTHEN AIF TEOS C 3 NSENT : TEND NEND AEND TEOS C 4 NSENT : NRV T= NRE ASTORE TEOS C 5 NSENT : TI-O T( NIOVAR AI-O NIOLIST T) TEOS C 6 NSENT : TTEST T( T0 T= T1 ASSIGN NTLIST T) TEOS C 7 NSENT : TDIM T( NVAR T( NINT NSUB1 T) ADIM NDIMLIST T) TEOS C 58 NSENT : TEOF AEOF C C 8 NINC : T+ T1 C 9 NINC : T- T1 ADEC C 10 NINC : T1 C C 11 NEND : T( T0 T) C 0 NEND : C C 12 NIOVAR : T2 A0PUSH A0PUSH C 13 NIOVAR : T3 NSUB2 C 14 NIOVAR : T4 NSUB3 C C 15 NSUB2 : T( NIE T) A0PUSH C 16 NSUB2 : A0PUSH A0PUSH C C 16 NSUB3 : A0PUSH A0PUSH C 17 NSUB3 : T( NIE T, NIE T) C C 18 NIOLIST : T, NIOVAR AI-O NIOLIST C 0 NIOLIST : C C 19 NTLIST : T, T0 T= T1 ASSIGN NTLIST C 0 NTLIST : C C 20 NVAR : T2 C 21 NVAR : T0 C 22 NVAR : T4 C 23 NVAR : T3 C C 24 NSUB1 : A0PUSH C 25 NSUB1 : T, NINT C 0 NSUB1 : C C 26 NDIMLIST: T, NVAR T( NINT NSUB1 T) ADIM NDIMLIST C 0 NDIMLIST: C C 27 NIE : NIT NIEX C 28 NIE : T= NIT AIMINUS NIEX C C 29 NIEX : T+ NIT AIADD NIEX C 30 NIEX : T- NIT AISUB NIEX C 0 NIEX : C C 31 NIT : NIF NITX C C 32 NITX : T* NIF AIMUL NITX C 33 NITX : T/ NIF AIDIV NITX C 0 NITX : C C 34 NIF : T( NIE T) C 35 NIF : T0 ALOAD C 36 NIF : T1 ALOAD C C 37 NRV : T2 A0PUSH A0PUSH C 38 NRV : T3 T( NIE T) A0PUSH C 39 NRV : T4 T( NIE T, NIE T) C C 40 NRE : NRT NREX C 41 NRE : T- NRT A0PUSH A0PUSH A0PUSH AUMINUS NREX C C 42 NREX : T+ NRT ARADD NREX C 43 NREX : T- NRT ARSUB NREX C 0 NREX : C C 44 NRT : NRF NRTX C C 45 NRTX : T* NRF ARMUL NRTX C 46 NRTX : T/ NRF ARDIV NRTX C 0 NRTX : C C 47 NRF : TSQRT T( NRE T) A0PUSH A0PUSH A0PUSH ASQRT C 48 NRF : T( NRE T) C 49 NRF : TSUM T( NMUL T* NMUL T, TDUM T= NIE TTO NIE T) ASUM C 56 NRF : NRV C 57 NRF : T5 A0PUSH A0PUSH C C 50 NMUL : T3 T( TDUM A*PUSH T) A0PUSH C 51 NMUL : T4 T( ND1 T) C C 52 ND1 : NIE T, TDUM A*PUSH C 53 ND1 : TDUM A*PUSH T, ND2 C C 54 ND2 : TDUM A*PUSH C 55 ND2 : NIE C C 21 NINT : T0 C 10 NINT : T1 C INTEGER PSTACK(50), PTOP, ASTACK, ATOP, TYPE, ATTR, RULE, ERR COMMON /ATTSTK/ ASTACK(30), ATOP /PARSER/ P, R /ERRNUM/ ERR COMMON /IO/ NREAD, NPRINT, NPUNCH COMMON /STATE/ NBRSTM COMMON /INTCOD/ IC, T INTEGER IC(500,11), T LOGICAL ERRBIT INTEGER P(26,31), R(58,14) C C C CALL INITIALIZATION ROUTINES AND INITIALIZE THE PARSE STACK C AND INTERMEDIATE CODE ARRAY C T = 0 DO 20 I=1,500 DO 10 J=1,11 IC(I,J) = 0 10 CONTINUE 20 CONTINUE PTOP = 1 PSTACK(1) = 101 ERRBIT = .FALSE. CALL SYMINT CALL CODGEN(25) C C GET NEXT TOKEN FROM LEXICAL ANALYZER. ASSUMING NO ERROR C CONDITION, BRANCH ACCORDING TO TYPE OF STACK SYMBOL ON C TOP OF PARSE STACK. C 30 CALL LEXAN(TYPE, ATTR) IF (ERRBIT) GO TO 110 40 IF (PSTACK(PTOP).LT.100) GO TO 70 IF (PSTACK(PTOP).LT.200) GO TO 50 C C ACTION SYMBOL ON TOP OF PARSE STACK. CALL CODE GENERATOR AND POP C NSYM = PSTACK(PTOP) - 200 CALL CODGEN(NSYM) IF (NSYM.EQ.23) GO TO 120 PTOP = PTOP - 1 GO TO 40 C C NONTERMINAL ON TOP OF PARSE STACK. REPLACE IT BY ITS EXPANSION C ACCORDING TO 'TYPE' AS INDICATED BY THE PARSETABLE. IF THERE IS C NO LEGAL EXPANSION, SET ERROR CONDITION C 50 K = PSTACK(PTOP) - 100 RULE = P(K,TYPE+1) IF (RULE.LT.0) GO TO 100 PTOP = PTOP - 1 IF (RULE.EQ.0) GO TO 40 PTOP = PTOP + R(RULE,1) IF (PTOP.GT.50) CALL TERROR(4) K = R(RULE,1) DO 60 I=1,K J = PTOP + 1 - I PSTACK(J) = R(RULE,I+1) 60 CONTINUE GO TO 40 C C TERMINAL ON TOP OF PARSESTACK. SET ERROR CONDITION OF IT DOES C NOT MATCH 'TYPE'. ELSE, POP IT AND ADVANCE INPUT. IN ADDITION C IF CURRENT INPUT REPRESENTS A VARIABLE,CONSTANT, RELATION OR C I/O COMMAND, ITS ATTRIBUTE IS PUSHED ONTO ASTACK C 70 IF (PSTACK(PTOP).NE.TYPE) GO TO 100 IF (ATTR.LT.0) GO TO 80 ATOP = ATOP + 1 IF (ATOP.GT.30) CALL TERROR(4) ASTACK(ATOP) = ATTR 80 IF (TYPE.EQ.27) GO TO 90 PTOP = PTOP - 1 IF (TYPE.EQ.28) GO TO 40 GO TO 30 90 PSTACK(PTOP) = 101 CALL CODGEN(25) GO TO 30 C C AN ERROR HAS BEEN ENCOUNTERED. THE PARSE STACK IS POPPED TO C END OF STATEMENT MARKER AND ERROR CONDITION IS SET. NEW TOKENS ARE C GOTTEN UNTIL END OF STATEMENT AND PARSING OF NEXT STATEMENT CAN BEGIN C 100 CALL IERROR(21) ERRBIT = .TRUE. PSTACK(1) = 27 PTOP = 1 110 IF (TYPE.NE.27) GO TO 30 ERRBIT = .FALSE. GO TO 40 C C THIS STOP STATEMENT CAN'T BE REACHED. I AM TRICKING THE COMPILER. 120 STOP END SUBROUTINE ADDNAM(ARRAY, ASIZ, P, IS1, IS2) C ======================================= C C ADD A VARIABLE NAME TO AN ARRAY C - INCLUDE SUBSCRIPTS IF REQUESTED C C ======================================= INTEGER ASIZ, ARRAY(ASIZ), NAM(10), CONB, CON0, P DATA CONB /1H /, CON0 /1H0/ C === C FIRST INITIALIZE ARRAY TO BLANKS C DO 10 I=1,ASIZ ARRAY(I) = CONB 10 CONTINUE IF (P.NE.0) GO TO 20 C === C HERE IF THE CONSTANT ZERO IS DESIRED (FOR INTEGER STORE) C - PUT A HOLLERITH ZERO IN FIRST POSITION, RETURN C ARRAY(1) = CON0 GO TO 60 C === C GET NAME OF THE VARIABLE C 20 CALL GETNAM(P, NAM) C === C FIND LENGTH OF THE NAME (NEEDED BY ADDSUB) C KTR = 10 DO 30 I=1,10 ARRAY(I) = NAM(I) IF (NAM(I).NE.CONB) GO TO 30 KTR = I - 1 GO TO 40 30 CONTINUE C === C CALL ADDSUB TO GET THE SUBSCRIPTS (IF PRESENT) C 40 CONTINUE IF (P.NE.1) GO TO 50 CALL GETVAL(1, IS1, 0, IVAL) CALL ADDTMP(ARRAY, ASIZ, IVAL) GO TO 60 50 IF (IS1.NE.0) CALL ADDSUB(ARRAY, ASIZ, KTR, IS1, IS2) 60 RETURN END SUBROUTINE ADDSUB(ARRAY, ASIZ, KTR, IS1, IS2) C ======================================= C C ADD SUBSCIPTS TO AN ARRAY CONTAINING C ADD CHARACTER REPRESENTATION OF SUBSCRIPTS C C ======================================= INTEGER ASIZ, ARRAY(ASIZ), D(10) INTEGER OPNPAR, CLSPAR, COMMA, FAC LOGICAL SIG DATA OPNPAR, CLSPAR, COMMA /1H(,1H),1H,/ DATA D(1), D(2), D(3), D(4), D(5), D(6), D(7), D(8), D(9), D(10) * /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ C === C ADD OPEN PARENTHESIS, GET FIRST SUBSCRIPT C KTR = KTR + 1 ARRAY(KTR) = OPNPAR IRET = 1 NUM = IS1 GO TO 30 10 IF (IS2.EQ.0) GO TO 20 C === C HERE IF SECOND SUBSCRIPT IS NEEDED C - ADD A COMMA C - ADD THE SECOND SUBSCRIPT C KTR = KTR + 1 ARRAY(KTR) = COMMA IRET = 2 NUM = IS2 GO TO 30 20 KTR = KTR + 1 ARRAY(KTR) = CLSPAR GO TO 50 C === C INSERT THE CHARACTER REPRESENTATION OF THE SUBSCRIPT C 30 FAC = 100 SIG = .FALSE. DO 40 I=1,3 IDIG = NUM/FAC NUM = NUM - IDIG*FAC FAC = FAC/10 KTR = KTR + 1 IF (IDIG.NE.0 .OR. SIG .OR. I.EQ.3) ARRAY(KTR) = D(IDIG+1) IF (IDIG.NE.0) SIG = .TRUE. 40 CONTINUE GO TO (10, 20), IRET 50 RETURN END SUBROUTINE ADDTMP(ARRAY, ASIZ, ITMPVL) C ************************** C ************************** FINISHING ROUTINES C ************************** SUBROUTINES ADDNAM, ADDTMP, ADDSUB C ************************** C C >>===> ONLY THE PURPOSE OF THESE SUBROUTINES ARE DESCRIBED HERE, AS C THEIR IMPLEMENTATIONS ARE TRIVIAL. C C SUBROUTINE ADDNAM: C C - ADDNAM WILL ADD THE CHARACTER REPRESENTATION OF A VARIABLE (PLUS C ANY SUBSCRIPTS) TO AN INTEGER ARRAY (ITS FIRST ARGUMENT). C - ADDNAM CALLS ADDSUB TO ADD SUBSCRIPTS IF THEY ARE NEEDED. C - ADDNAM CALLS ADDTMP IF THE VARIABLE IS A REAL TEMPORARY. C C SUBROUTINE ADDTMP: C C - ADDTMP WILL ADD THE CHARACTER REPRESENTATION OF ANY REAL TEMP C VALUE POSSIBLE. POSSIBILITIES INCLUDE: C *DATA(I), *INTR(I), *CONS(I), *NULL C C SUBROUTINE ADDSUB: C C - ADDSUB WILL ADD THE CHARACTER EQUIVALENT OF SUBSCRIPTS TO C AN INTEGER ARRAY (ITS FIRST ARGUMENT). C POSSIBILITIES INCLUDE: "(I)", AND "(I,I)". C C ======================================= C C SET A PASSED ARRAY TO EITHER C *DATA(I), *CONS(I), OR *INTR(I) C C ======================================= COMMON /SUM/ DUM, NULTAB, NULVAL, NULSTM INTEGER ASIZ, ARRAY(ASIZ) INTEGER NCAR(5,4), Z(20), CONB LOGICAL DUM, NULSTM EQUIVALENCE (NCAR(1,1),Z(1)) DATA Z(1), Z(2), Z(3), Z(4), Z(5) /1H*,1HD,1HA,1HT,1HA/ DATA Z(6), Z(7), Z(8), Z(9), Z(10) /1H*,1HC,1HO,1HN,1HS/ DATA Z(11), Z(12), Z(13), Z(14), Z(15) /1H*,1HI,1HN,1HT,1HR/ DATA Z(16), Z(17), Z(18), Z(19), Z(20) /1H*,1HN,1HU,1HL,1HL/ DATA CONB /1H / C === C INITIALIZE ARRAY TO BLANKS C DO 10 I=1,ASIZ ARRAY(I) = CONB 10 CONTINUE C === C DETERMINE LABEL TO BE ADDED, THEN ADD IT C ITYPE = 4 IF (ITMPVL.EQ.50 .OR. ITMPVL.EQ.NULVAL) GO TO 20 IF (ITMPVL.GT.0) ITYPE = 1 IF (ITMPVL.LT.0) ITYPE = 2 IF (ITMPVL.GT.100) ITYPE = 3 20 DO 30 I=1,5 ARRAY(I) = NCAR(I,ITYPE) 30 CONTINUE C === C DETERMINE VALUE OF SUBSCRIPT, THEN CALL ADDSUB TO ADD SUBSCRIPTS C IF (ITYPE.EQ.4) GO TO 40 IS1 = IABS(ITMPVL) IF (IS1.GT.100) IS1 = IS1 - 100 IS2 = 0 KFILL = 5 CALL ADDSUB(ARRAY, ASIZ, KFILL, IS1, IS2) 40 RETURN END SUBROUTINE ADD(NAM, TYP, INDEX) C C ****************************************************************** C * * C * ADD * C * * C * GIVEN THE NAME OF A CONSTANT, VARIABLE, OR ARRAY, ADD * C * CHECKS WHETHER IT'S IN THE SYMBOL TABLE (IF IT'S AN ARRAY, * C * IT MUST BE) OR NOT. IF SO, ADD RETURNS THE TYPE AS RETRIEVED * C * FROM THE TABLE AND A POINTER TO THE LOCATION OF THE ITEM IN * C * THE TABLE. IF NOT, ADD PUTS THE ITEM IN THE TABLE AND RETURNS* C * A POINTER TO ITS LOCATION. IN THIS CASE, ADD MUST BE GIVEN * C * THE TYPE OF A CONSTANT. IF GIVEN A TYPE OF VARIABLE, ADD * C * WILL DECIDE WHETHER THE ITEM IS INTEGER OR REAL BASED ON * C * FORTRAN CONVENTIONS FOR THE FIRST LETTER OF THE NAME. * C * REAL CONSTANTS ARE ASSIGNED A VALUE WHEN PLACED IN THE TABLE. * C * NOTE THAT THE REAL CONSTANTS ZERO AND ONE ARE ENTERED AT MOST * C * ONCE IN THE SYMBOL TABLE, REGARDLESS OF REPRESENTATION IN THE * C * INPUT PROGRAM. * C * * C ****************************************************************** C COMMON /SYMTAB/ NAME, TYPE, VALUE, ROWS, COLS, DEFIND, AUXVAL * /MISC/ INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, VAR, * AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N /TEMP/ SUPP, REACNT COMMON /OPTS/ CON0, CON1, OPT LOGICAL DEFIND(50) INTEGER SUPP(20,10) INTEGER NAME(50,10), TYPE(50), VALUE(50), ROWS(50), COLS(50), * AUXVAL(300), INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, * VAR, AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N, REACNT C C INDEX POINTER INTO THE SYMBOL TABLE C NAM NAME (10 CHARACTERS -- SOME MAY BE TRAILING BLANKS) C OF ITEM WHICH IS TO BE ADDED TO SYMBOL TABLE IF C IT'S NOT ALREADY THERE C TYP TYPE OF ITEM WITH NAME NAM; IF ITEM IS ADDED, TYP MUST C BE INTEGER CONSTANT, REAL CONSTANT, OR SIMPLY VARIABLE C INTEGER NAM(10), TYP, INDEX INTEGER FLAG0, FLAG1, OPT, CON0, CON1 INTEGER ZERO, ONE, BLANK, DOT DATA ZERO /1H0/, BLANK /1H /, DOT /1H./, ONE /1H1/ C SEE IF IN SYMTAB DO 20 J=1,SYMPTR DO 10 K=1,10 IF (NAME(J,K).NE.NAM(K)) GO TO 20 10 CONTINUE INDEX = J TYP = TYPE(INDEX) GO TO 130 20 CONTINUE C CHECK FOR REAL CONSTANT ZERO OR ONE IF (TYP.NE.5) GO TO 80 C TEST FOR REAL ZERO DO 30 III=1,10 IF (NAM(III).NE.ZERO .AND. NAM(III).NE.BLANK .AND. * NAM(III).NE.DOT) GO TO 50 30 CONTINUE C NAME IS THAT OF ZERO IF (CON0.NE.0) GO TO 40 FLAG0 = SYMPTR + 1 CON0 = -(REACNT+1) GO TO 80 40 INDEX = FLAG0 GO TO 130 C TEST FOR REAL CONSTANT ONE 50 IF (NAM(1).NE.ONE) GO TO 80 IF (NAM(2).NE.DOT) GO TO 80 DO 60 III=3,10 IF (NAM(III).NE.ZERO .AND. NAM(III).NE.BLANK) GO TO 80 60 CONTINUE C NAME IS THAT OF ONE IF (CON1.NE.0) GO TO 70 FLAG1 = SYMPTR + 1 CON1 = -(REACNT+1) GO TO 80 70 INDEX = FLAG1 GO TO 130 C NOT IN SYMTAB SO PUT IT IN 80 SYMPTR = SYMPTR + 1 IF (SYMPTR.GT.SYMLIM) CALL TERROR(1) INDEX = SYMPTR DO 90 L=1,10 NAME(INDEX,L) = NAM(L) 90 CONTINUE IF (TYP.NE.VAR) GO TO 110 C ELSE THIS IS VAR--REAL OR INT? IF (NAM(1).LT.I .OR. NAM(1).GT.N) GO TO 100 C ELSE THIS IS INT TYP = INTVAR TYPE(INDEX) = INTVAR GO TO 130 C THEN THIS IS REAL 100 TYP = REAVAR TYPE(INDEX) = REAVAR GO TO 130 C THEN THIS IS CONSTANT 110 TYPE(INDEX) = TYP IF (TYP.EQ.INTCON) GO TO 130 C ELSE THIS IS REACON REACNT = REACNT + 1 IF (REACNT.GT.20) CALL TERROR(1) VALUE(INDEX) = -REACNT DEFIND(INDEX) = .TRUE. DO 120 M=1,10 SUPP(REACNT,M) = NAM(M) 120 CONTINUE 130 RETURN END C SUBROUTINE CODGEN(ACTION) C C ************************************************ C * * C * SUBROUTINE CODGEN * C * * C ************************************************ C C THE SUBROUTINE CODGEN IS CALLED BY THE MAIN PARSING ROUTINE C WHENEVER AN ACTION SYMBOL IS ON TOP OF THE PARSE STACK. CODGEN IS C ACTUALLY A COLLECTION OF INDEPENDENT BLOCKS OF CODE, ONLY ONE OF WHICH C IS EXECUTED ON EACH CALL TO CODGEN. THE PARAMETER ACTION USED TO C CALL CODGEN IS USED AS THE BASIS OF A COMPUTED GOTO TO INITIALLY C LOCATE THE APPROPRIATE CODE. CODGEN PERFORMS FOUR TYPES OF FUNCTIONS C LISTED HERE AND DESCRIBED IN DETAIL BELOW: C 1: ATTRIBUTE AND FOR-STACK MANIPULATION C 2: GLOBAL SYNTAX CHECKING C 3: INTERMEDIATE CODE GENERATION C 4: INTERACTION WITH THE SYMBOL TABLE TO ESTABLISH VALUES OF C INTEGER VARIABLES, AND DIMENSIONS OF REAL ARRAYS C C ************************************************************** C * * C * VARIABLES AND DATA STRUCTURES USED BY CODGEN * C * * C ************************************************************** C C ACTION : THE PARAMETER USED BY THE PARSER TO CALL CODGEN C ICODE(500,11): THE ARRAY OF INTERMEDIATE INSTRUCTIONS BUILT BY C CODGEN AND REPRESENTING A PROGRAM TO BE C INTERPRETED. EACH LINE BEGINS WITH AN OPCODE AND C ENDS WITH AN ENTRY TELLING WHICH LINE OF SOURCE CODE C PRODUCED THIS INSTRUCTION. THE INTERVENING FIELDS C CAN REPRESENT SYMBOL TABLE INDICES OR INDICES IN THE C ARRAY OF INTEGER TEMPORARIES, BRANCH LABELS, OR C CODES OF VARIOUS KINDS. THE MEANINGS OF OPERANDS C DEPEND ON THE OPCODE AND ARE FULLY DESCRIBED IN THE C DOCUMENTATION OF INTERPRETATION ROUTINES. (THIS C ARRAY IS IN COMMON WITH THE INTERPRETER.) C LINE : THE INDEX OF THE LAST LINE OF ICODE WHICH WAS FILLED C ASTACK(30) : THE ATTRIBUTE STACK. THIS IS IN COMMON WITH THE C PARSER AND IS DISCUSSED FURTHER BELOW. C ATOP : POINTER TO THE TOP OF ASTACK C ITOP : A POINTER TO THE NEXT AVAILABLE INTEGER TEMPORARY. C (NOTE THAT ITOP IS SET TO 0 AFTER EACH STATEMENT IS C PARSED.) C RTEMP : A POINTER TO THE NEXT AVAILABLE REAL TEMPORARY IN C THE SYMBOL TABLE. (ALL REAL TEMPORARIES ARE STORED C IN AN ARRAY WHOSE SYMBOL TABLE INDEX IS 1.) NOTE C THE CODE GENERATOR USES A DIFFERENT REAL TEMPORARY C AS THE INTENDED LOCATION OF THE RESULT OF EACH C INTERMEDIATE REAL OPERATION INSTRUCTION. THUS C THE ONLY WAY REAL TEMPORARIES CAN BE REUSED IS IF C THEY ARE ASSIGNED IN INSTRUCTIONS WHICH APPEAR IN AN C ITERATIVE FOR-LOOP. C L : THE INDEX OF THE LINE OF INTERMEDIATE CODE CURRENTLY C BEING BUILT. C VAL,VAL1 ; PARAMETERS FOR SUBROUTINES CALL TO THE SYMBOL TABLE C ERR : THE GLOBAL ERROR COUNT. IN COMMON WITH MOST ROUTINES C NOTE THAT WHENEVER ERR BECOMES NON-ZERO, NO FURTHER C INTERMEDIATE CODE WILL BE GENERATED. C FSTACK(8,4) : THE FOR-STACK. EACH LINE OF THIS ARRAY IS USED TO C RECORD INFORMATION ABOUT A FOR-LOOP OR IF-THEN BLOCK C WHICH IS CURRENTLY BEING PARSED. C C *************************************** C * * C * CODGEN FUNCTIONS * C * * C *************************************** C C 1: ATTRIBUTE AND FOR STACK MANIPTULATION C C ALL ATTRIBUTES OF TOKENS FROM THE LEXICAL ANALYZER ARE PUSHED C ONTO THE ATTRIBUTE STACK BY THE PARSER. SOME OF THESE ARE C SIMPLY NOTED BY CODGEN IN MAKING UP INTERMEDIATE INSTRUCTIONS, C BUT ATTRIBUTES RELEVANT TO INTEGER AND REAL EXPRESSIONS ARE USED C AND REPLACED AS FOLLOWS: C EVERY TIME AN INTEGER VARIABLE OR CONSTANT IS RECOGNIZED C CODGEN GENERATES AN INSTRUCTION TO THE INTERPRETER TO LOAD ITS C VALUE INTO AN INTEGER TEMPORARY, AND REPLACES ITS SYMBOL TABLE C INDEX ON ASTACK BY THE INDEX OF THIS TEMPORARY. WHEN INTEGER C OPERATORS ARE PARSED, CODGEN USES THE TOP TWO INTEGER TEMPORARY C INDICES ON ASTACK TO BUILD THE INTERMEDIATE INSTRUCTION AND THEN C REPLACES THEM BY THE INDEX OF THE RESULT. THUS, WHENEVER A SERIES C OF INTEGER OPERATIONS FORM AN INTEGER EXPRESSION, AT THE END OF C PARSING THE EXPRESSION THE TOP ELEMENT OF ASTACK WILL BE A POINTER C TO THE INTEGER TEMPORARY ARRAY ELEMENT WHICH WILL CONTAIN THE C ACTUAL VALUE OF THAT EXPRESSION AFTER INTERPRETATION. C IN REAL ARITHMETIC EXPRESSIONS, EVERY OPERAND WILL BE C REPRESENTED ON THE ASTACK BY THREE ELEMENTS, THESE BEING THE C SYMBOL TABLE INDEX OF THE REAL VARIABLE AND THE INTEGER C TEMPORARY INDICES OF THE VALUES OF ITS SUBSCRIPTS, IF ANY. C THE A0PUSH AND A*PUSH ACTIONS GUARANTEE THAT THESE INDICES WILL BE C 0 IF THERE IS NO SUBSCRIPT, OR -1 IF THE SUBSCRIPT IS A SUMMATION C VARIABLE. IN ADDITION, FOR UNIFORMITY, THE NULL OPERAND IN C UNARY REAL OPERATIONS WILL APPEAR ON ASTACK AS THREE ZEROES. AS C WITH INTEGERS, WHENEVER AN INTERMEDIATE REAL INSTRUCTION IS C GENERATED, THE ATTRIBUTES OF ITS OPERANDS ARE REPLACED ON THE C ATTRIBUTE STACK BY THE ATTRIBUTES OF THE REAL TEMPORARY C IN WHICH THE INTERMEDIATE RESULT WILL BE STORED BY THE C INTERPRETER. C THE ONLY OTHER TIMES THAT CODGEN CHANGES ASTACK IS TO PUT C ON A DUMMY INDICATOR OF A NEGATIVE FOR LOOP INCREMENT AND TO C EMPTY ASTACK AFTER A STATEMENT IS COMPLETELY PARSED. C C WHEN A FOR STATEMENT IS ENCOUNTERED, AN ENTRY IS PLACED ON C FSTACK WHICH INDICATES THAT A FOR STATEMENT HAS BEEN SEEN, ITS C LOOP-VARIABLE, WHETHER THE VARIABLE IS TO BE INCREMENTED OR C DECREMENTED, AND THE LINE OF INTERMEDIATE CODE GENERATED BY THE C FOR STATEMENT. WHEN THE MATCHING END IS LATER ENCOUNTERED, THE C LAST INFORMATION WILL BE NECESSARY FOR CODGEN TO FILL IN A C BRANCH LABEL IN THAT LINE OF CODE, AND TO GENERATE ANOTHER C INTERMEDIATE INSTRUCTION TO BRANCH FROM THE BOTTOM OF THE LOOP C BACK TO ITS TOP. C WHEN AN IF-THEN STATEMENT IS PARSED, AN ENTRY IS PLACED ON C FSTACK INDICATING THAT THIS IS AN IF STATEMENT, AND THE LINE OF C INTERMEDIATE CODE GENERATED FROM IT. THE LATTER INFORMATION C WILL BE USED WHEN THE MATCHING END IS FOUND, TO PLACE A PROPER C BRANCH LABEL IN THAT SAME LINE OF CODE. C C 2: INTERMEDIATE CODE GENERATION C C CODGEN BUILDS INSTRUCTIONS BASED ON THE ACTION SYMBOL USED C AS ITS PARAMETER (WHICH OFTEN BECOMES THE OPCODE OF THE C INTERMEDIATE INSTRUCTION) AND ON THE CURRENT ATTRIBUTE STACK. IN C THE CASES OF FOR OR IF-THEN BLOCKS OF INSTRUCTIONS, THE FIFTH C FIELD OF THE INSTRUCTION AT THE TOP OF THE BLOCK IS FILLED IN WHEN C WHEN THE END OF THE BLOCK IS IDENTIFIED. C C 3: INTERACTION WITH THE SYMBOL TABLE C C WHEN SOURCE STATEMENTS BEGINNING WITH THE KEY WORD TEST ARE C PARSED CODGEN CALLS THE SYMBOL TABLE TO STORE THE ASSIGNED C INTEGER VALUES. SIMILARLY, WHEN DIMENSION STATEMENTS ARE PARSED, C CODGEN RETRIEVES THE VALUES OF THE SUBSCRIPTS AND CALLS THE SYMBOL C TABLE TO ASSIGN DIMENSIONS TO REAL ARRAYS. C C 4: GLOBAL SYNTAX CHECKING. ERRORS AND WARNINGS IDENTIFIED BY CODGEN. C C TERROR 4 : ATTRIBUTE STACK OVERFLOW C TERROR 5 : INTEGER TEMPORARY OVERFLOW C TERR0R 6 : REAL TEMPORARY OVERFLOW C TERROR 7 : TOO MANY NESTED FOR AND/OR IF-THEN BLOCKS C ERROR 20 : DIMENSION STATEMENT FOLLOWS EXECUTABLE CODE C ERROR 22 : FOR LOOP INCREMENT NOT EQUAL TO PLUS OR MINUS 1 C ERROR 23 : EXTRANEIOUS END OR IMPROPER FOR LOOP NESTING C ERROR 24 : ATTEMPT TO ILLEGALLY REDEFINE FOR LOOP VARIABLE C ERROR 25 : WARNING - MISSING END C INTEGER ACTION, ICODE, ITOP, RTEMP, LINE, ASTACK, ATOP, L, VAL, * VAL1 INTEGER ERR, FSTACK(8,4), FTOP, FS COMMON /INTCOD/ ICODE(500,11), LINE COMMON /ATTSTK/ ASTACK(30), ATOP /ERRNUM/ ERR COMMON /OPTS/ F0, F1, OPT INTEGER F0, F1, OPT DATA RTEMP /2/, FTOP /0/ C C GO TO (40, 40, 40, 40, 40, 40, 10, 10, 10, 10, 10, 60, 60, 70, * 10, 90, 100, 120, 130, 140, 170, 240, 250, 260, 280), ACTION C C INTERMEDIATE CODE FOR INTEGER EXPRESSIONS C 10 IF (ERR.GT.0) RETURN CALL NEXT L = LINE ITOP = ITOP + 1 IF (ITOP.GT.30) CALL TERROR(5) IF (ACTION.EQ.15) GO TO 20 IF (ACTION.LT.11) GO TO 30 C C GENERATE AN INSTRUCTION TO LOAD ZERO INTO AN INTEGER TEMPORARY C FOLLOWED BY A SUBTRACT IN ORDER TO EFFECT A UNARY MINUS. C ICODE(L,1) = 19 ICODE(L,2) = 0 ICODE(L,3) = ITOP CALL NEXT L = LINE ICODE(L,1) = 8 ICODE(L,2) = ASTACK(ATOP) ICODE(L,3) = ITOP ICODE(L,4) = ASTACK(ATOP) RETURN C C GENERATE LOAD INSTRUCTION C 20 ICODE(L,1) = 19 ICODE(L,2) = ASTACK(ATOP) ICODE(L,3) = ITOP ASTACK(ATOP) = ITOP RETURN C C GENERATE INTERMEDIATE INTEGER BINARY OPERATIONS C 30 ICODE(L,1) = ACTION ICODE(L,2) = ITOP ICODE(L,3) = ASTACK(ATOP-1) ICODE(L,4) = ASTACK(ATOP) ATOP = ATOP - 1 ASTACK(ATOP) = ITOP RETURN C C CODE GENERATION FOR REAL ARITHMETIC OPERATORS C 40 IF (ERR.NE.0) RETURN CALL NEXT L = LINE RTEMP = RTEMP + 1 IF (RTEMP.GT.200) CALL TERROR(6) ICODE(L,1) = ACTION ICODE(L,2) = 1 ICODE(L,3) = RTEMP ICODE(L,4) = 0 DO 50 I=1,6 J = 10 - I + 1 K = ATOP - I + 1 ICODE(L,J) = ASTACK(K) 50 CONTINUE ATOP = ATOP - 3 K = ATOP - 2 ASTACK(K) = 1 K = ATOP - 1 ASTACK(K) = RTEMP ASTACK(ATOP) = 0 RETURN C C ATTRIBUTE STACK MANIPULATION NECESSARY FOR UNIFORMITY IN PROCESSING C REAL VARIABLES C 60 ATOP = ATOP + 1 IF (ATOP.GT.30) CALL TERROR(4) IF (ACTION.EQ.12) ASTACK(ATOP) = 0 IF (ACTION.EQ.13) ASTACK(ATOP) = -1 RETURN C C INTERMEDIATE STORE INSTRUCTION. GENERATED AT END OF REAL C ASSIGNMENT STATEMENT C 70 IF (ERR.NE.0) RETURN CALL NEXT L = LINE ICODE(L,1) = 15 DO 80 I=1,6 J = 7 - I + 1 K = ATOP - I + 1 ICODE(L,J) = ASTACK(K) 80 CONTINUE RETURN C C IF STATEMENT ACTIONS C C PUT IF-STATEMENT INCICATOR ON FOR STACK C 90 FTOP = FTOP + 1 IF (FTOP.GT.8) CALL TERROR(7) FSTACK(FTOP,1) = 1 FSTACK(FTOP,2) = 0 C C GENERATE INTERMEDIATE TEST INSTRUCTION C IF (ERR.NE.0) RETURN CALL NEXT L = LINE ICODE(L,1) = 13 K = ATOP - 2 ICODE(L,2) = ASTACK(K) ICODE(L,3) = ASTACK(ATOP) K = ATOP - 1 ICODE(L,4) = ASTACK(K) FSTACK(FTOP,4) = L RETURN C C INPUT/OUTPUT ACTIONS C 100 CALL NEXT L = LINE DO 110 I=1,4 ICODE(L,I) = ASTACK(I) 110 CONTINUE CALL GETDIM(ASTACK(2), I, J) K = 2 IF (I.NE.0) K = 3 IF (J.NE.0) K = 4 ICODE(L,5) = K ATOP = 1 RETURN C C TEST ACTIONS: STORE INTEGER VALUE IN SYMBOL TABLE ENTRY OF C INTEGER VARIABLE C C 120 CALL GETVAL(ASTACK(ATOP), 0, 0, VAL) CALL STORE(ASTACK(ATOP-1), 0, 0, VAL) ATOP = 0 RETURN C C DIMENSION ACTIONS: ASSIGN DIMENSIONS TO REAL VARIABLES C C 130 IF (LINE.GT.0) CALL IERROR(20) CALL GETVAL(ASTACK(ATOP-1), 0, 0, VAL) VAL1 = 0 IF (ASTACK(ATOP).NE.0) CALL GETVAL(ASTACK(ATOP), 0, 0, VAL1) CALL RDIM(ASTACK(ATOP-2), VAL, VAL1) ATOP = 0 RETURN C C FOR STATEMENT ACTIONS C 140 IF (FTOP.EQ.0) GO TO 160 C C CHECK FOR ATTEMPT TO REDEFINE FOR LOOP VARIABLE C DO 150 I=1,FTOP IF (FSTACK(I,2).NE.ASTACK(1)) GO TO 150 CALL IERROR(24) RETURN 150 CONTINUE C C PUT FOR-STATEMENT INDICATOR ON FOR STACK C 160 K = ATOP IF (ASTACK(K).EQ.(-1)) K = K - 1 CALL GETVAL(ASTACK(K), 0, 0, VAL) IF (VAL.NE.1) CALL IERROR(22) FTOP = FTOP + 1 IF (FTOP.GT.8) CALL TERROR(7) FSTACK(FTOP,1) = 0 FSTACK(FTOP,2) = ASTACK(1) FSTACK(FTOP,3) = 0 IF (ASTACK(ATOP).EQ.(-1)) FSTACK(FTOP,3) = 1 IF (ERR.NE.0) RETURN C C GENERATE ISTORE INSTRUCTION C IF (ATOP.EQ.5) FSTACK(FTOP,3) = 1 CALL NEXT L = LINE ICODE(L,1) = 20 ICODE(L,2) = ASTACK(1) ICODE(L,3) = ASTACK(2) C C GENERATE FOR INSTRUCTION C CALL NEXT L = LINE ICODE(L,1) = 12 ICODE(L,2) = ASTACK(1) ICODE(L,3) = ASTACK(3) ICODE(L,4) = FSTACK(FTOP,3) FSTACK(FTOP,4) = L RETURN C C C END ACTIONS: CHECK FOR PROPER NESTING OF LOOPS. FILL IN BRANCH C LABEL IN INTERMEDIATE CODE FOR IF AND FOR STATEMENTS. FOR FOR LOOPS C GENERATE INCREMENT/DECREMENT INTERMEDIATE CODE AND BRANCH C INSTRUCTION FOR BOTTOM OF THE LOOP. C 170 IF (FTOP.NE.0) GO TO 180 CALL IERROR(23) RETURN 180 J = FTOP IF (ATOP.EQ.0) GO TO 200 C C END STATEMENT HAS A LABEL. CHECK NESTING C J = 0 DO 190 I=1,FTOP IF (FSTACK(I,2).NE.ASTACK(1)) GO TO 190 J = I 190 CONTINUE IF (J.NE.0) GO TO 200 CALL IERROR(23) RETURN 200 IF (J.NE.FTOP) CALL IERROR(25) IF (ERR.NE.0) GO TO 230 DO 220 I=1,10 IF (FSTACK(FTOP,1).EQ.1) GO TO 210 C C GENERATE INTERMEDIATE INC/DEC AND BRANCH AT BOTTOM OF FOR LOOP C CALL NEXT L = LINE ICODE(L,1) = 11 ICODE(L,2) = FSTACK(FTOP,2) ICODE(L,5) = FSTACK(FTOP,3) CALL NEXT L = LINE ICODE(L,1) = 14 ICODE(L,2) = FSTACK(FTOP,4) C C FILL IN BRANCH LABEL IN FOR/IF INSTRUCTIONS C 210 FS = FSTACK(FTOP,4) ICODE(FS,5) = LINE + 1 IF (FTOP.EQ.J) GO TO 230 FTOP = FTOP - 1 220 CONTINUE 230 FTOP = J - 1 RETURN C C INDICATE NEGATIVE FOR LOOP INCREMENT C 240 ATOP = ATOP + 1 IF (ATOP.GT.30) CALL TERROR(4) ASTACK(ATOP) = -1 RETURN C C END OF PROGRAM ACTIONS C 250 IF (FTOP.NE.0) CALL IERROR(23) CALL IERROR(0) IF (ERR.NE.0) STOP CALL NEXT L = LINE ICODE(L,1) = 16 CALL INTERP RETURN C C SUMMATION ACTIONS C 260 IF (ERR.NE.0) RETURN RTEMP = RTEMP + 1 IF (RTEMP.GT.200) CALL TERROR(6) CALL NEXT L = LINE ICODE(L,1) = 21 K = ATOP - 7 DO 270 I=2,9 ICODE(L,I) = ASTACK(K) K = K + 1 270 CONTINUE ICODE(L,10) = RTEMP ATOP = ATOP - 5 ASTACK(ATOP-2) = 1 ASTACK(ATOP-1) = RTEMP ASTACK(ATOP) = 0 RETURN C C 280 ATOP = 0 ITOP = 0 RETURN C END SUBROUTINE CODOPT C ---------------------------------------------------------------------- C THIS PROGRAM PERFORMS 'CODE OPTIMIZATION' ON THE STRAIGHT-LINE PROGRAM C PRODUCED BY THE MINICOMPILER. THE FOLLOWING TRANSFORMATIONS ARE C APPLIED. C 1. AN OPERATION IS REMOVED IF EVERY OUTPUT VALUE IS INDEPENDENT C OF IT, I.E., USELESS OPERATIONS ARE STRIPPED AWAY. C 2. REDUNDANT OPERATIONS ARE REMOVED USING A 'VALUE NUMBER' C METHOD LIKE THAT IN COCKE AND SCHWARTZ, 'PROGRAMMING C LANGUAGES AND THEIR COMPILERS (2ND ED.), COURANT INST. (1970), C PP. 320-334. C 3. OPERATIONS OF THE FORMS 0.0 + X, X + 0.0, X - 0.0, 0.0*X, 0.0/X, C SQRT(0.0), -0.0, 1.0*X, X*1.0, X/1.0 AND SQRT(1.0) ARE REMOVED, C WHILE 0.0 - X IS CONVERTED TO A UNARY MINUS. C ---------------------------------------------------------------------- C ARRAY 'NUMBER' IS FIRST USED TO MARK (WITH 1) INTERMEDIATE VALUES C WHICH ARE NOT USELESS. LATER IT POINTS TO AN INTERMEDIATE C COMPUTED VALUE'S CORRESPONDING VALUE IN THE REDUCED PROGRAM. C COMMON /OPTS/ CON0, CON1, OPT COMMON /TEMP/ SUPP, REACNT COMMON /FIN/ FDAT, FINT, FOUT, KDAT, KINT, KOUT COMMON /IO/ NREAD, NPRINT, NPUNCH INTEGER NLOP(500), NOPER(500), NROP(500), NUMBER(500), NDXOUT(20) INTEGER FDAT(50,2), FINT(500,5), FOUT(20,3) INTEGER CON0, CON1, OPT, SUPP(20,10), REACNT EQUIVALENCE (FINT(1,1),NLOP(1)), (FINT(1,2),NROP(1)), (NOP,KINT), * (NFIND,KOUT), (NGIVEN,KDAT), (NCONST,REACNT) C C INITIALIZE THE HASH TABLE FOR THE 'OPTIMIZED' CODE. M0 = 0 N0 = 0 CALL INSERT(0, 0, 0, M0, N0, -1, IER) C C INITIALIZE OPERATION CODES DO 10 I=1,NOP J = FINT(I,3) K = J/10 NOPER(I) = J - K*10 10 CONTINUE C INITIALIZE OUTPUT VALUES DO 20 I=1,NFIND NDXOUT(I) = FOUT(I,3) - 100 20 CONTINUE C C C FIRST LOCATE THE 'LIVE' OPERATIONS, I.E., THOSE OPERATIONS USED IN THE C EVALUATION OF SOME OUTPUT. DO 30 I=1,NOP NUMBER(I) = 0 30 CONTINUE DO 40 I=1,NFIND NDXI = NDXOUT(I) NUMBER(NDXI) = 1 40 CONTINUE DO 50 IBACK=2,NOP I = NOP + 2 - IBACK NUMBI = NUMBER(I) IF (NUMBI.EQ.0) GO TO 50 NLOPM = NLOP(I) - 100 IF (NLOPM.GT.0) NUMBER(NLOPM) = 1 IF (NOPER(I).GT.4) GO TO 50 NROPM = NROP(I) - 100 IF (NROPM.GT.0) NUMBER(NROPM) = 1 50 CONTINUE C C C PROCESS THE I-TH OPERATION. DO 180 I=1,NOP NUMBI = NUMBER(I) C IGNORE USELESS OPERATIONS. IF (NUMBI.EQ.0) GO TO 180 ILOP = NLOP(I) C IF OPERAND IS A COMPUTED VALUE, LOCATE THE C CORRESPONDING VALUE IN THE REDUCED PROGRAM. C CONSTANT AND INPUT VALUES HAVE IDENTICAL C REPRESENTATIONS IN THE ORIGINAL AND THE C REDUCED PROGRAMS. IF (ILOP.GT.100) ILOP = NUMBER(ILOP-100) IOPER = NOPER(I) IROP = NROP(I) IF (IROP.GT.100) IROP = NUMBER(IROP-100) C NOW ILOP, IOPER AND IROP GIVE THE ORIGINAL C I-TH OPERATION IN TERMS OF THE REDUCED PROGRAM. C C HERE IF THE LEFT OPERAND IS 0.0. IF (ILOP.NE.CON0) GO TO 90 GO TO (60, 70, 80, 80, 80, 80), IOPER 60 NUMBER(I) = IROP GO TO 180 70 ILOP = IROP IOPER = 6 IROP = 0 GO TO 170 80 NUMBER(I) = CON0 GO TO 180 C C HERE IF THE LEFT OPERAND IS 1.0 90 IF (ILOP.NE.CON1) GO TO 120 GO TO (120, 120, 100, 120, 110, 120), IOPER 100 NUMBER(I) = IROP GO TO 180 110 NUMBER(I) = CON1 GO TO 180 120 IF (IOPER.GT.4) GO TO 170 C C HERE IF THE RIGHT OPERAND IS 0.0 IF (IROP.NE.CON0) GO TO 150 GO TO (130, 130, 140, 200), IOPER 130 NUMBER(I) = ILOP GO TO 180 140 NUMBER(I) = CON0 GO TO 180 C C HERE IF THE RIGHT OPERAND IS 1.0 150 IF (IROP.NE.CON1) GO TO 170 GO TO (170, 170, 160, 160), IOPER 160 NUMBER(I) = ILOP GO TO 180 C C INSERT THE OPERATION IF IT IS NOT REDUNDANT. 170 CALL INSERT(ILOP, IOPER, IROP, NBR, ISOLD, 0, IER) IF (IER.NE.0) GO TO 210 NUMBER(I) = NBR IF (ISOLD.EQ.1) GO TO 180 NBR = NBR - 100 NLOP(NBR) = ILOP NOPER(NBR) = IOPER NROP(NBR) = IROP IF (FINT(I,3).GT.10) FINT(NBR,4) = FINT(I,4) J = FINT(I,3)/10 FINT(NBR,3) = J*10 + IOPER FINT(NBR,5) = FINT(I,5) 180 CONTINUE N0 = 0 CALL INSERT(0, 0, 0, NOP, N0, 1, IER) C DO 190 I=1,NFIND NDXI = NDXOUT(I) FOUT(I,3) = NUMBER(NDXI) 190 CONTINUE RETURN C 200 WRITE (NPRINT,99999) GO TO 220 210 WRITE (NPRINT,99998) 220 STOP 99999 FORMAT (16H DIVISION BY 0.0) 99998 FORMAT (17H PROGRAM TOO LONG) END LOGICAL FUNCTION COMPO1(CARD) C THIS ADD HOC ROUTINE (AND COMPO2,COMPO3) WERE ADDED WHEN THE C 'COMPOSITION' INSTRUCTION WAS INCLUDED IN THE SOURCE LANGUAGE. C THIS ROUTINE CHECKS FOR COMPOSITION INSTRUCTIONS. INTEGER CARD(80), C(11), BLANK DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), * C(11) /1HC,1HO,1HM,1HP,1HO,1HS,1HI,1HT,1HI,1HO,1HN/ DATA BLANK /1H / COMPO1 = .FALSE. IF (CARD(1).EQ.C(1)) GO TO 30 K = 0 10 K = K + 1 IF (K.EQ.62) GO TO 30 IF (CARD(K).EQ.BLANK) GO TO 10 J = 1 20 IF (CARD(K).NE.C(J)) GO TO 30 K = K + 1 J = J + 1 IF (J.LE.11) GO TO 20 COMPO1 = .TRUE. 30 RETURN END SUBROUTINE COMPO2(LOCNTR) C A 'COMPOSITION' INSTRUCTION IS BEING EXECUTED BY THE INTERPRETER. C POINT NCUT TO THE LAST LINE OF THE STRAIGHT-LINE PROGRAM GENERATED C SO FAR. INCREMENT LOCNTR TO MOVE INTERPRETER TO ITS NEXT INSTRUCTION. COMMON /COMPOZ/ NCUT COMMON /FIN/ FDAT, INT, FOUT, KDAT, KINT, KOUT INTEGER FDAT(50,2), INT(500,5), FOUT(20,3) C AT MOST ON 'COMPOSITION' CAN BE EXECUTED. IF (NCUT.NE.0) CALL IERROR(26) NCUT = KINT LOCNTR = LOCNTR + 1 RETURN END SUBROUTINE COMPO3(OPSIGN) C IF A 'COMPOSITION' INSTRUCTION WAS EXECUTED, THEN MARK ALL C OPERATIONS 'PLUS'. OTHERWISE, MARK ALL 'BOUNDARY' NODES 'PLUS' C AND THE OTHER (I.E., ERROR-FREE) NODES 'MINUS'. COMMON /FIN/ FDAT, FINT, FOUT, KDAT, KINT, KOUT COMMON /COMPOZ/ NCUT INTEGER OPSIGN(500), FDAT(50,2), FINT(500,5), FOUT(20,3), PLUS DATA PLUS, MINUS /1,-1/ IF (NCUT.LE.0) GO TO 60 DO 10 I=1,KINT OPSIGN(I) = MINUS 10 CONTINUE IF (NCUT.EQ.KINT) GO TO 40 LIM = NCUT + 1 DO 20 I=LIM,KINT ILOP = FINT(I,1) - 100 IF (0.LT.ILOP .AND. ILOP.LE.NCUT) OPSIGN(ILOP) = PLUS ITMP = FINT(I,3) IPTR = ITMP/10 IOP = ITMP - IPTR*10 IF (IOP.GE.4) GO TO 20 IROP = FINT(I,2) - 100 IF (0.LT.IROP .AND. IROP.LE.NCUT) OPSIGN(IROP) = PLUS 20 CONTINUE 30 RETURN 40 IF (KOUT.EQ.0) GO TO 30 DO 50 I=1,KOUT ITMP = FOUT(I,3) - 100 OPSIGN(ITMP) = PLUS 50 CONTINUE GO TO 30 60 DO 70 I=1,KINT OPSIGN(I) = PLUS 70 CONTINUE GO TO 30 END SUBROUTINE ERROR(ERR, NAM, C1, C2) C C ****************************************************************** C * * C * ERROR * C * * C * GIVEN AN ERROR NUMBER AND THE NAME OF AN ITEM (AND POSSIBLY* C * SUBSCRIPTS), ERROR PRINTS THE APPROPRIATE ERROR MESSAGE AND * C * INCREMENTS THE GLOBAL ERROR COUNT. * C * NOTE THE ERRORS ARE DISTRIBUTED AS FOLLOWS: * C * 1-5,30 SYMBOL TABLE * C * 15,16 LEXICAL ANALYZER * C * * C ****************************************************************** C COMMON /ERRNUM/ ERRCT /STATE/ ST /IO/ NREAD, NPRINT, NPUNCH C C ERR NUMBER OF ERROR TO BE PRINTED C NAM NAME OF ITEM TO WHICH ERROR REFERS C C1 FIRST SUBSCRIPT OF ITEM -- MAY BE ZERO C C2 SECOND SUBSCRIPT OF ITEM -- MAY BE ZERO C INTEGER CONB, ERR, ERRCT, C1, C2, ST, NAM(10), NAM2(17) DATA CONB /1H / C INCREMENT GLOBAL ERROR COUNT ERRCT = ERRCT + 1 IF (ERR.GT.5) GO TO 50 GO TO (10, 10, 20, 30, 40), ERR C ERROR #1 AND #2 10 ISUB = C1 IF (ERR.EQ.2) ISUB = C2 WRITE (NPRINT,99999) ERR, (NAM(I),I=1,10), ISUB GO TO 100 C ERROR #3 20 WRITE (NPRINT,99998) (NAM(I),I=1,10) GO TO 110 C ERROR #4 30 WRITE (NPRINT,99997) (NAM(I),I=1,10) GO TO 100 C ERROR #5 40 WRITE (NPRINT,99996) GO TO 110 50 IF (ERR.GT.16) GO TO 60 C ERROR #15 AND #16 WRITE (NPRINT,99995) (NAM(I),I=1,10) GO TO 110 60 IF (ERR.GT.27) GO TO 70 WRITE (NPRINT,99993) C1 GO TO 100 C ERROR #30 70 DO 80 I=1,17 NAM2(I) = CONB 80 CONTINUE DO 90 I=1,10 IF (NAM(I).EQ.CONB) GO TO 90 K = I NAM2(I) = NAM(I) 90 CONTINUE IF (C1.NE.0) CALL ADDSUB(NAM2, 17, K, C1, C2) IF (ERR.EQ.30) WRITE (NPRINT,99994) (NAM2(I),I=1,17) IF (ERR.EQ.31) WRITE (NPRINT,99992) (NAM2(I),I=1,17) 100 WRITE (NPRINT,99991) ST 110 RETURN 99999 FORMAT (21H *** SUBSCRIPT NUMBER, I2, 10H OF ARRAY , 10A1, * 19H IS OUT OF BOUNDS (, I5, 17H), 1 IS USED. ***) 99998 FORMAT (11H *** ARRAY , 10A1, 27H IS ALREADY DIMENSIONED ***) 99997 FORMAT (5H *** , 10A1, 30H IS UNDEFINED (1 IS USED). ***) 99996 FORMAT (38H *** ATTEMPT TO REDEFINE REAL CONSTANT, 11H (COMPILER , * 11HERROR). ***) 99995 FORMAT (45H *** NAME OR CONSTANT TOO LONG (TRUNCATED TO , 10A1, * 6H). ***) 99994 FORMAT (5H *** , 17A1, 37H IS UNDEFINED (IT IS SET TO 0.0). ***) 99993 FORMAT (42H *** ATTEMPTED INTEGER DIVISION BY ZERO. , 8HRESULT I, * 19HS SET TO DIVIDEND (, I10, 1H)) 99992 FORMAT (5H *** , 29HTHE VALUE OF OUTPUT VARIABLE , 17A1, 6H DOES , * 30HNOT RESULT FROM A COMPUTATION.) 99991 FORMAT (28H *** ERROR OCCURRED IN LINE , I3, 5H. ***) END SUBROUTINE FINISH C ************************** C ************************** FINISHING ROUTINES C ************************** SUBROUTINE FINISH C ************************** C C CALLING SEQUENCE: C C CALL FINISH C C ARGUMENTS: NONE C C THE DATA FOR SUBROUTINE FINISH IS IN COMMON BLOCK FIN. C THESE INCLUDE THE ARRAYS CONTAINING REAL ARITHMETIC, INPUT, AND C OUTPUT INSTRUCTIONS, AND POINTERS INDICATING THE LAST FILLED C POSITION OF EACH ARRAY. C C PURPOSE: C C TO PRODUCE THE FINAL OUTPUT OF THE INTERPRETER. C THERE ARE TWO TYPES OF OUTPUT PRODUCED: C C - PUNCHED CARDS; C THESE CARDS CONTAIN THE CODES WHICH ARE USED AS INPUT TO THE C ERROR ANALYSIS SOFTWARE. C C - PRINTED LINES; C THERE ARE FOUR SECTIONS TO THE PRINTED OUTPUT. C - THE VARIABLES INTO WHICH INPUT VALUES GO ARE LISTED C (IN CHRONOLOGICAL ORDER OF INPUT). C - THE REAL CONSTANTS ARE LISTED C - THE INTERMEDIATE CODE INSTRUCTONS ARE LISTED. THESE C INCLUDE ALL REAL ARITHMETIC INSTRUCTIONS WHICH WERE C NOT DELETED BY THE CODE OPTIMIZER. IF AN INSTRUCTION C CHANGED THE VALUE OF SOME REAL VARIABLE IN THE PROGRAM, C THE NAME OF THAT VARIABLE (PLUS SUBSCRIPTS) IS OUTPUT. C - THE VARIABLES WHICH WERE OUTPUT BY THE PROGRAM (AND THEIR C VALUES AT THE TIME OF OUTPUT) ARE LISTED (IN CHRONOLO- C GICAL ORDER OF OUTPUT). C C SUBROUTINES CALLED: C C ADDNAM: ADD THE NAME OF A VARIABLE TO AN INTEGER ARRAY C (INCLUDING SUBSCRIPTS IF DESIRED). C ADDTMP: ADD THE CHARACTER REPRESENTATION OF THE VALUE OF A VARIABLE C INTO AN INTEGER ARRAY (I.E., "*INT(I)", "*DAT(I)", ETC.). C C PROCEDURE: C C (1) OUTPUT DATA VALUES. C C - IF NONE, PRINT MESSAGE, GO TO (2). C - FOR EACH ENTRY IN ARRAY FDAT, C C - GET SYMBOL TABLE POINTER, SUBSCRIPTS FROM FDAT. C - CALL ADDNAM FOR CHARACTER REPRESENTATION OF NAME, C PRINT IT OUT. C C (2) OUTPUT STRAIGHT LINE CODE. C C - OUTPUT NUMBER OF LINES BY FORMAT *** FORMAT(I3) ***. C - IF NONE, PRINT MESSAGE, GO TO (3). C - FOR EACH ENTRY IN ARRAY FINT, C C - GET VALUES FOR LEFT AND RIGHT ARGUMENTS, GET OPERATION C CODE FROM FINT. C - OUTPUT LEFT-VALUE, OP CODE, RIGHT-VALUE TO PUNCHED CARDS C BY FORMAT *** FORMAT(I3,I2,I4) ***. C - GET SYMBOL TABLE POINTER, SUBSCRIPTS OF TARGET. C IF POINTER IS NOT ZERO, ADD NAME OF TARGET TO PRINTER C OUTPUT. C C (3) OUTPUT OUTPUT VALUES (NAMES). C C - OUTPUT NUMBER OF OUTPUT VALUES BY FORMAT *** FORMAT(I2) ***. C - IF NONE, PRINT MESSAGE, GO TO (4) C - FOR EACH OF THE OUTPUT VALUES, C C - GET SYMBOL TABLE POINTER, SUBSCRIPTS OF VARIABLE. C - OUTPUT NAME, VALUE OF VARIABLE TO PRINTER. C - OUTPUT VALUE ONLY TO PUNCHED CARDS BY FORMAT C *** FORMAT(I3) ***. C C (4) OUTPUT REAL CONSTANTS. C C - OUTPUT NUMBER OF CONSTANTS BY FORMAT *** FORMAT(I2) ***. C - OUTPUT EACH OF THE CONSTANTS BY FORMAT *** FORMAT(10A1) ***. C C (5) OUTPUT NUMBER OF DATA VALUES C C - OUTPUT TO PUNCHED CARDS ONLY BY FORMAT *** FORMAT(I2) ***. C C COMMON /FIN/ FDAT, FINT, FOUT, KDAT, KINT, KOUT COMMON /TEMP/ SUPP, REACNT COMMON /OPTS/ N0, N1, NOPT COMMON /IO/ NREAD, NPRINT, NPUNCH COMMON /COMPOZ/ NCUT INTEGER FDAT(50,2), FINT(500,5), FOUT(20,3), SUPP(20,10), OP(4) INTEGER OPSIGN(500) INTEGER HOLD(17), HOLDL(10), HOLDR(10), CONB, VAL1, VAL2, REACNT DATA OP(1), OP(2), OP(3), OP(4), CONB /1H+,1H-,1H*,1H/,1H / C === C PROCESS DATA LINES C === CALL COMPO3(OPSIGN) WRITE (NPRINT,99995) IF (KDAT.EQ.0) GO TO 20 DO 10 I=1,KDAT IPTR = FDAT(I,1) ITMP = FDAT(I,2) IS1 = ITMP/101 IS2 = ITMP - IS1*101 CALL ADDNAM(HOLD, 17, IPTR, IS1, IS2) WRITE (NPRINT,99999) I, HOLD 10 CONTINUE GO TO 30 20 WRITE (NPRINT,99994) C === C PRINT THE REAL CONSTANTS C === 30 IF (REACNT.EQ.0) GO TO 50 WRITE (NPRINT,99988) DO 40 I=1,REACNT WRITE (NPRINT,99985) I, (SUPP(I,J),J=1,10) 40 CONTINUE C === C PROCESS INTERMEDIATE VALUE LINES C === 50 WRITE (NPRINT,99993) IF (NCUT.NE.0) WRITE (NPRINT,99992) WRITE (NPUNCH,99982) KINT IF (KINT.EQ.0) GO TO 110 DO 100 I=1,KINT I2 = FINT(I,5) VAL1 = FINT(I,1) CALL ADDTMP(HOLDL, 10, VAL1) VAL2 = FINT(I,2) IF (VAL2.NE.0) CALL ADDTMP(HOLDR, 10, VAL2) ITMP = FINT(I,3) IPTR = ITMP/10 IOP = ITMP - IPTR*10 IOPX = IOP*OPSIGN(I) WRITE (NPUNCH,99981) VAL1, IOPX, VAL2 IF (IPTR.EQ.0) GO TO 60 ITMP = FINT(I,4) IS1 = ITMP/101 IS2 = ITMP - IS1*101 CALL ADDNAM(HOLD, 17, IPTR, IS1, IS2) GO TO 80 60 DO 70 J=1,17 HOLD(J) = CONB 70 CONTINUE 80 IF (NCUT.GT.0 .AND. IOPX.LT.0) GO TO 90 IF (IOP.LE.4) IOPOP = OP(IOP) IF (IOP.LE.4) WRITE (NPRINT,99998) I2, I, HOLDL, IOPOP, HOLDR, * HOLD IF (IOP.EQ.5) WRITE (NPRINT,99987) I2, I, HOLDL, HOLD IF (IOP.EQ.6) WRITE (NPRINT,99984) I2, I, HOLDL, HOLD GO TO 100 90 IF (IOP.LE.4) IOPOP = OP(IOP) IF (IOP.LE.4) WRITE (NPRINT,99997) I2, I, HOLDL, IOPOP, HOLDR, * HOLD IF (IOP.EQ.5) WRITE (NPRINT,99986) I2, I, HOLDL, HOLD IF (IOP.EQ.6) WRITE (NPRINT,99983) I2, I, HOLDL, HOLD 100 CONTINUE GO TO 120 110 WRITE (NPRINT,99991) C === C PROCESS OUTPUT LINES C === 120 WRITE (NPRINT,99990) WRITE (NPUNCH,99980) KOUT IF (KOUT.EQ.0) GO TO 140 DO 130 I=1,KOUT IPTR = FOUT(I,1) ITMP = FOUT(I,2) IS1 = ITMP/101 IS2 = ITMP - IS1*101 ITMP = FOUT(I,3) CALL ADDTMP(HOLDL, 10, ITMP) CALL ADDNAM(HOLD, 17, IPTR, IS1, IS2) WRITE (NPRINT,99996) I, HOLDL, HOLD ITMP = ITMP - 100 WRITE (NPUNCH,99982) ITMP 130 CONTINUE GO TO 150 140 WRITE (NPRINT,99989) 150 WRITE (NPUNCH,99980) REACNT IF (REACNT.EQ.0) GO TO 170 DO 160 I=1,REACNT WRITE (NPUNCH,99979) (SUPP(I,J),J=1,10) 160 CONTINUE 170 WRITE (NPUNCH,99980) KDAT WRITE (NPRINT,99978) RETURN 99999 FORMAT (9H *DATA(, I2, 5H) IS , 17A1) 99998 FORMAT (I5, 9H *INTR(, I3, 8H) = , 10A1, 4X, A1, 4X, 10A1, * 10X, 17A1) 99997 FORMAT (I5, 9H INTR(, I3, 8H) = , 10A1, 4X, A1, 4X, 10A1, * 10X, 17A1) 99996 FORMAT (8H *OUT(, I2, 5H) IS , 10A1, 5X, 17A1) 99995 FORMAT (37H1*DATA(I) DENOTES THE I-TH DATA VALUE//) 99994 FORMAT (5X, 32H*** THERE ARE NO DATA VALUES ***//) 99993 FORMAT (//45H *INTR(I) DENOTES THE I-TH INTERMEDIATE VALUE//) 99992 FORMAT (29H+* SHOWS COMPOSITION BOUNDARY) 99991 FORMAT (5X, 40H*** THERE ARE NO INTERMEDIATE VALUES ***//) 99990 FORMAT (//38H *OUT(I) DENOTES THE I-TH OUTPUT VALUE//) 99989 FORMAT (5X, 34H*** THERE ARE NO OUTPUT VALUES ***) 99988 FORMAT (//35H *CONS(I) DENOTES THE I-TH CONSTANT//) 99987 FORMAT (I5, 9H *INTR(, I3, 5H) =, 14X, 8HSQRT , 10A1, 10X, * 17A1) 99986 FORMAT (I5, 9H INTR(, I3, 5H) =, 14X, 8HSQRT , 10A1, 10X, * 17A1) 99985 FORMAT (9H *CONS(, I2, 5H) IS , 10A1) 99984 FORMAT (I5, 9H *INTR(, I3, 5H) =, 17X, 5H- , 10A1, 10X, * 17A1) 99983 FORMAT (I5, 9H INTR(, I3, 5H) =, 17X, 5H- , 10A1, 10X, * 17A1) 99982 FORMAT (I3) 99981 FORMAT (I3, I2, I4) 99980 FORMAT (I2) 99979 FORMAT (10A1) 99978 FORMAT (1H0, 19X, 27HMINICOMPILER VERSION 2.1.79) END SUBROUTINE GETDIM(INDEX, D1, D2) C C ****************************************************************** C * * C * GETDIM * C * * C * GIVEN A POINTER INTO THE SYMBOL TABLE, GETDIM RETURNS THE * C * DIMENSIONS OF THE CONSTANT, VARIABLE, OR ARRAY AT THAT * C * LOCATION. * C * * C ****************************************************************** C COMMON /SYMTAB/ NAME, TYPE, VALUE, ROWS, COLS, DEFIND, AUXVAL * /MISC/ INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, VAR, * AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N LOGICAL DEFIND(50) INTEGER NAME(50,10), TYPE(50), VALUE(50), ROWS(50), COLS(50), * AUXVAL(300), INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, * VAR, AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N C C INDEX POINTER INTO THE SYMBOL TABLE C D1 ROW DIMENSION AS RETRIEVED FROM SYMBOL TABLE -- ZERO C FOR CONSTANTS AND VARIABLES C D2 COLUMN DIMENSION AS RETRIEVED FROM SYMBOL TABLE -- ZERO C FOR CONSTANTS, VARIABLES, AND ONE-DIMENSIONAL ARRAYS C INTEGER INDEX, D1, D2 D1 = ROWS(INDEX) D2 = COLS(INDEX) RETURN END SUBROUTINE GETNAM(INDEX, NAM) C C ****************************************************************** C * * C * GETNAM * C * * C * GIVEN A POINTER INTO THE SYMBOL TABLE, GETNAM RETURNS THE * C * NAME OF THE CONSTANT, VARIABLE, OR ARRAY AT THAT LOCATION. * C * * C ****************************************************************** C COMMON /SYMTAB/ NAME, TYPE, VALUE, ROWS, COLS, DEFIND, AUXVAL * /MISC/ INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, VAR, * AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N LOGICAL DEFIND(50) INTEGER NAME(50,10), TYPE(50), VALUE(50), ROWS(50), COLS(50), * AUXVAL(300), INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, * VAR, AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N C C INDEX POINTER INTO THE SYMBOL TABLE C NAM NAME OF CONSTANT, VARIABLE, OR ARRAY AS RETRIEVED FROM C SYMBOL TABLE C INTEGER INDEX, NAM(10) DO 10 J=1,10 NAM(J) = NAME(INDEX,J) 10 CONTINUE RETURN END SUBROUTINE GETSTM(STMCAR, STMCLS, KSTM) C ************************** C ************************** LEXICAL ANALYSER C ************************** SUBROUTINE GETSTM C ************************** C C CALLING SEQUENCE: C C CALL GETSTM(STMCAR,STMCLS,KSTM), C WHERE STMCAR AND STMCLS ARE 330 ELEMEMT INTEGER ARRAYS AND C KSTM IS AN INTEGER VARIABLE WHOSE VALUE WILL BE DEFINED BY C GETSTM. C C ARGUMENTS: C C STMCAR -- THE SIGNIFICANT CHARACTERS OF THE NEXT PROGRAM STATEMENT. C STMCLS -- THE CLASS OF EACH OF THE ABOVE CHARACTERS. C KSTM -- THE NUMBER OF CHARACTERS IN STMCAR. C C PURPOSE: C C TO RETURN THE CHARACTER REPRESENTATION THE NEXT STATEMENT, PLUS C THE CLASS OF THE CHARACTERS IN THE STATEMENT. C CLASS INFORMATION AIDS IN THE LEXICAL ANALYSIS AND IN DETERMINING C THE ACTUAL VALUE OF INTEGER CONSTANTS -- CHARACTER/CLASS GROUPINGS C ARE DEFINED BELOW. C C CHARACTER CLASS C --------- ----- C 0-9 0-9 C A-Z 10 C BLANK 12 C = 18 C + 19 C - 20 C * 21 C / 22 C ( 23 C ) 24 C , 25 C . 37 C C OTHER DUTIES ASSUMED BY GETSTM: C C DETECTION OF END-OF-FILE C HANDLE STATEMENT-TOO-LONG ERROR C HANDLE CONTINUED STATEMENTS C C PROCEDURE: C C GETSTM ASSUMES THE FOLLOWING SYNTAX RULES: C C (1) A STATEMENT IS TERMINATED BY A COMMENT CARD OR THE FIRST C CARD OF THE NEXT STATEMENT. C C (2) A COMMENT CARD IS ANY CARD WITH A "C" IN COLUMN ONE. C C (3) A STATEMENT MAY BE CONTINUED BY PUNCHING A "1" IN COLUMN SIX C OF THE FOLLOWING CARD, AND CONTINUING THE STATEMENT ON THAT C CARD. C C - COLUMN 72 OF THE PRECEEDING CARD, AND COLUMN 7 OF THE CONTIN- C UATION CARD WILL BE CONSIDERED CONTIGUOUS. C - AT LEAST 4 CONTINUATION CARDS MAY BE USED (SEE (4)). C C (4) A STATEMENT MAY CONSIST OF AT MOST 330 SIGNIFICANT CHARACTERS. C C - A SIGNIFICANT CHARACTER IS: C - ANY NON-BLANK CHARACTER C - ANY BLANK FOLLOWING A CHARACTER OR A DIGIT C C (5) ANY ADJACENT IDENTIFIERS, CONSTANTS, OR KEYWORDS MUST BE C SEPARATED BY AT LEAST ONE BLANK. ALSO, NO IDENTIFIER, C CONSTANT, OR KEYWORD MAY CONTAIN IMBEDDED BLANKS. C C THE BASIC ALGORITHM USED IS AS FOLLOWS. C C (1) INITIALIZATION. C C - SET KSTM TO 1. C - SET ENDCOL TO 1 (USED TO CHECK FOR END=OF=FILE). C - SET COL TO 7. C C (2) IF COL <= 72, GOTO (3), ELSE READ NEXT CARD. C C - IF NOT CONTINUATION CARD, GOTO (5), ELSE SET COL TO 7 AND C GOTO (2). C C (3) IF CHARACTER NOT EQUAL TO ENDCON(ENDCOL), SET ENDCOL TO 1 AND C GOTO (4), ELSE ADVANCE ENDCOL. C C - IF CHARACTER WAS BLANK, THE END-OF-FILE TOKEN HAS BEEN C ENCOUNTERED. RETURN END-OF-FILE AS ONLY TOKEN IN STATEMENT. C (ENDCON IS AN INTEGER ARRAY CONTAINING THE END-OF-FILE TOKEN C FOLLOWED BY ONE BLANK: PRESENTLY IT CONTAINS THE CHARACTERS C S, T, O, P, AND BLANK) C C (4) IF CHARACTER IS NON-SIGNIFICANT, ADVANCE COL AND GOTO (2). C ELSE, PERFORM BINARY SEARCH TO DETERMINE CLASS OF CHARACTER, C STORE CHARACTER IN STMCAR AND ITS CLASS IN STMCLS, ADVANCE C KSTM AND GOTO (2). C C (5) ADD END-OF-STATEMENT TOKEN TO STMCLS, RETURN. C C ======================================= C C COMMON; COMMON VARIABLES REFERENCED: C /STATE/ STMTNO: THE STATEMENT NUMBER (WHICH APPEARS ON LISTING) C FOR THIS STATEMENT. C C LOCAL INTEGER STRUCTURES: C CARD(80): INPUT CARD BEING SCANNED. C CHAR(45): VALID INPUT CHARACTERS. C -- R(45): USED TO DATA-INITIALIZE ARRAY CHAR. C CLASS(45): CLASS OF CORRESPONDING CHARACTERS IN CHAR. C -- S(45) : USED TO DATA-INITIALIZE ARRAY CLASS. C ENDCON(6): SYMBOL WHICH SIGNALS END OF INPUT DATA. C -- T(6) : USED TO DATA-INITIALIZE ARRAY ENDCON. C C LOCAL INTEGER VARIABLES: C COL: COLUMN OF CARD BEING PROCESSED. C CAR: TEMPORARY PLACE FOR CHARACTER BEING PROCESSED. C LCLASS: CLASS OF THE PREVIOUS CHARACTER. C LEFT, MID, RIT: POINTERS USED IN BINARY SEARCH. C -- CONSTANTS USED BY GETSTM -- C CONB: BLANK. C CONQ: PERIOD (REPLACES INVALID CHARACTERS IN TEXT). C CONC: CHARACTER C. C CON1: DIGIT 1. C ENDCOL: POINTER TO NEXT CHARACTER OF END-OF-INPUT TOKEN WHICH C MUST BE MATCHED. C KIN: NUMBER OF STATEMENT BEING PROCESSED, USED TO DEFINE STMTNO. C C LOCAL LOGICAL VARIABLES: C FIRST : TRUE WHEN THIS IS THE FIRST CALL TO GETSTM. C FERR10: TRUE WHEN ERROR # 10 HAS BEEN DETECTED ON THIS CARD. C FERR12: TRUE WHEN ERROR # 12 HAS BEEN DETECTED ON THIS CARD. C FEND : TRUE WHEN SCANNING ON THIS CARD IS COMPLETE. C C ======================================= COMMON /STATE/ STMTNO COMMON /OPTS/ F0, F1, OPT COMMON /IO/ NREAD, NPRINT, NPUNCH COMMON /INTCOD/ ICODE(500,11), LINE INTEGER STMCAR(330), STMCLS(330), CARD(80), CHAR(45), CLASS(45) INTEGER ENDCON(6), R(45), S(45), T(6), F0, F1, OPT INTEGER RD5, STMTNO, ENDCOL, COL, LEFT, RIT, CAR, CONB, CONQ, * CONC, CON1 LOGICAL FEND, FBLANK, FIRST, FERR10, FERR12, COMPO1, COMPOX EQUIVALENCE (CHAR(1),R(1)), (CLASS(1),S(1)), (ENDCON(1),T(1)) DATA R(1), R(2), R(3), R(4), R(5), R(6), R(7), R(8), R(9), R(10) * /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ/, R(11), R(12), R(13), * R(14), R(15), R(16), R(17), R(18), R(19), R(20) /1HK,1HL,1HM,1HN, * 1HO,1HP,1HQ,1HR,1HS,1HT/, R(21), R(22), R(23), R(24), R(25), * R(26), R(27), R(28), R(29), R(30) /1HU,1HV,1HW,1HX,1HY,1HZ,1H0, * 1H1,1H2,1H3/, R(31), R(32), R(33), R(34), R(35), R(36), R(37), * R(38), R(39), R(40) /1H4,1H5,1H6,1H7,1H8,1H9,1H.,1H(,1H+,1H*/, * R(41), R(42), R(43), R(44), R(45) /1H),1H-,1H/,1H,,1H=/ DATA S(1), S(2), S(3), S(4), S(5), S(6), S(7), S(8), S(9), S(10) * /10*10/, S(11), S(12), S(13), S(14), S(15), S(16), S(17), S(18), * S(19), S(20) /10*10/, S(21), S(22), S(23), S(24), S(25), S(26), * S(27), S(28), S(29), S(30) /6*10,0,1,2,3/, S(31), S(32), S(33), * S(34), S(35), S(36), S(37), S(38), S(39), S(40) * /4,5,6,7,8,9,30,23,19,21/, S(41), S(42), S(43), S(44), S(45) * /24,20,22,25,18/ DATA T(1), T(2), T(3), T(4), T(5), T(6) /1H*,1HS,1HT,1HO,1HP,1H / DATA FIRST, FBLANK, FERR10, FERR12 /.TRUE.,3*.FALSE./ DATA CONB, CONQ, CONC, CON1 /1H ,1H.,1HC,1H1/, ENDCOL, KIN /1,0/ KSTM = 1 LCLASS = 12 FBLANK = .TRUE. IF (.NOT.FIRST) GO TO 10 C === C HERE IF THIS IS THE FIRST CALL TO THE SUBROUTINE C - READ THE FIRST INPUT CARD C - SET LOGICAL VARIABLE FIRST TO .FALSE. C === FIRST = .FALSE. WRITE (NPRINT,99997) READ (NREAD,99999) CARD COMPOX = COMPO1(CARD) 10 IF (.NOT.COMPOX) GO TO 20 KIN = KIN + 1 WRITE (NPRINT,99998) KIN, CARD LINE = LINE + 1 IF (LINE.GT.500) CALL TERROR(2) ICODE(LINE,1) = 99 READ (NREAD,99999) CARD COMPOX = COMPO1(CARD) GO TO 10 20 IF (CARD(1).NE.CONC) GO TO 30 WRITE (NPRINT,99996) CARD READ (NREAD,99999) CARD COMPOX = COMPO1(CARD) GO TO 10 30 DO 40 I=1,6 IF (CARD(I).EQ.CONB) GO TO 40 FERR10 = .TRUE. GO TO 50 40 CONTINUE C === C THIS LOOP WILL CONTINUE TO PROCESS CARDS UNTIL END-OF-STATEMENT IS C REACHED. LOGICAL VARIABLE FEND SIGNALS END-OF-STATEMENT WHEN TRUE C === 50 FEND = .FALSE. KIN = KIN + 1 STMTNO = KIN 60 IF (FEND) GO TO 250 C === C THIS LOOP WILL PROCESS EVERY COLUMN OF THE INPUT CARD C === COL = 7 WRITE (NPRINT,99998) KIN, CARD IF (.NOT.FERR10) GO TO 70 FERR10 = .FALSE. CALL IERROR(10) 70 IF (COL.GT.72) GO TO 200 CAR = CARD(COL) C === C HERE IF CHECKING IS IN EFFECT FOR THE END-OF-FILE KEYWORD C - CHARACTERS MUST OCCUR IN THE FOLLOWING ORDER: C ENDCOL -- CHARACTER C 1 S C 2 T C 3 O C 4 P C 5 BLANK (OR 1) C - NOTE THAT SCANNING IS INITIATED BY THE OCCURENCE OF A * C IN THE INPUT STREAM C - IF THE END-OF-FILE KEYWORD IS DETECTED, C THEN THE END-OF-FILE TOKEN ONLY IS SENT C (ANY PREVIOUS TOKENS ARE DELETED) C - IF *STOP1 IS USED AS END OF FILE, THE OUTPUT CODE C WILL NOT BE OPTIMIZED C === IF (CAR.EQ.ENDCON(ENDCOL)) GO TO 80 ENDCOL = 1 GO TO 90 80 ENDCOL = ENDCOL + 1 IF (ENDCOL.LE.5) GO TO 90 COL = COL + 1 IF (COL.GT.72) GO TO 200 CAR = CARD(COL) ENDCOL = 1 IF (CAR.NE.CONB .AND. CAR.NE.CON1) GO TO 90 IF (CAR.EQ.CON1) OPT = 0 KSTM = 1 STMCLS(1) = 28 GO TO 260 90 IF (CAR.NE.CONB) GO TO 100 C === C HERE IF THE CHARACTER IS A BLANK: C - IF PREVIOUS CHARACTER WAS A BLANK, OR C WAS NOT A VALID NAME CHARACTER, IGNORE THIS BLANK C === IF (LCLASS.GT.11) GO TO 170 IF (KSTM.EQ.330) GO TO 180 FBLANK = .TRUE. STMCAR(KSTM) = CAR STMCLS(KSTM) = 12 LCLASS = 12 KSTM = KSTM + 1 GO TO 170 C === C HERE IF THE CHARACTER IS NOT A BLANK: C - DETERMINE CLASS OF CHARACTER C - REPLACE INVALID CHARACTERS BY '.', TREAT AS NULL STRING C === 100 FBLANK = .FALSE. IF (KSTM.EQ.330) GO TO 180 LEFT = 0 RIT = 46 MID = 23 110 IF (CAR.EQ.CHAR(MID)) GO TO 150 IF (CAR.LT.CHAR(MID)) GO TO 120 GO TO 130 C === C HERE IF CHARACTER LESS THAN CHARACTER IN TABLE C === 120 RIT = MID GO TO 140 C === C HERE IF CHARACTER GREATER THAN CHARACTER IN TABLE C - UNNECESSARY BLANKS DELETED HERE C === 130 LEFT = MID 140 IF (RIT-LEFT.EQ.1) GO TO 160 MID = (LEFT+RIT)/2 GO TO 110 C === C HERE IF CHARACTER EQUAL TO CHARACTER IN TABLE C BACKSPACE ONE CHARACTER IF THIS IS SPECIAL CHARACTER C FOLLOWING A BLANK (UNLESS THIS IS THE FIRST CHARACTER) C === 150 IF (CLASS(MID).GT.11 .AND. LCLASS.EQ.12 .AND. KSTM.GT.1) KSTM = * KSTM - 1 STMCAR(KSTM) = CAR LCLASS = CLASS(MID) STMCLS(KSTM) = LCLASS KSTM = KSTM + 1 GO TO 170 C === C HERE IF CHARACTER IS INVALID C === 160 CARD(COL) = CONQ FERR12 = .TRUE. C === C PROCEED TO NEXT CHARACTER ON CARD C === 170 COL = COL + 1 GO TO 70 C === C HERE IF STATEMENT LENGTH EXCEEDED C - PRINT ERROR MESSAGE C - FLUSH CARDS UP TO NEXT STATEMENT C - PUT END-OF-FILE TOKEN ON END OF STATEMENT C === 180 CALL IERROR(11) 190 READ (NREAD,99999) CARD IF (CARD(6).NE.CON1) GO TO 250 WRITE (NPRINT,99998) KIN, CARD GO TO 190 C === C READ NEXT CARD: C - FIRST OUTPUT ERRORS FROM PREVIOUS CARD C - CHECK COLUMNS 1-6 FOR CORRECTNESS C - SET FEND = .TRUE. IF NOT A CONTINUATION CARD C === 200 IF (.NOT.FERR12) GO TO 210 CALL IERROR(12) FERR12 = .FALSE. WRITE (NPRINT,99998) KIN, CARD 210 READ (NREAD,99999) CARD COMPOX = COMPO1(CARD) IF (COMPOX) GO TO 250 IF (CARD(1).NE.CONC .AND. CARD(6).EQ.CON1) GO TO 220 FEND = .TRUE. GO TO 240 220 DO 230 I=1,5 IF (CARD(I).EQ.CONB) GO TO 230 FERR10 = .TRUE. GO TO 240 230 CONTINUE 240 GO TO 60 C === C HERE ON END-OF-STATEMENT C === 250 STMCLS(KSTM) = 27 260 RETURN 99999 FORMAT (80A1) 99998 FORMAT (1X, I4, 5X, 80A1) 99997 FORMAT (7H STMT /7H NUMBER, 9X, 17H*** STATEMENT ***) 99996 FORMAT (10X, 80A1) END SUBROUTINE GETVAL(INDEX, IC1, IC2, VAL) C C ****************************************************************** C * * C * GETVAL * C * * C * GIVEN A POINTER INTO THE SYMBOL TABLE (AND ROW AND COLUMN * C * POINTERS FOR AN ARRAY ELEMENT), GETVAL RETURNS THE VALUE OF * C * A CONSTANT OR A DEFINED VARIABLE OR ARRAY ELEMENT. IF AN * C * INTEGER VARIABLE IS UNDEFINED, THE VALUE RETURNED IS 1. IF * C * A REAL VARIABLE OR ARRAY ELEMENT IS UNDEFINED, THE VALUE * C * RETURNED IS -1. * C * * C ****************************************************************** C COMMON /SYMTAB/ NAME, TYPE, VALUE, ROWS, COLS, DEFIND, AUXVAL * /MISC/ INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, VAR, * AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N /SUM/ DUM, NULTAB, NULVAL, * NULSTM LOGICAL DEFIND(50) INTEGER NAME(50,10), TYPE(50), VALUE(50), ROWS(50), COLS(50), * AUXVAL(300), INTVAR, INTCON, REAVAR, ONEDIM, TWODIM, REACON, * VAR, AUXPTR, AUXLIM, SYMPTR, SYMLIM, I, N C C INDEX POINTER INTO THE SYMBOL TABLE C C1 ROW POINTER FOR AN ARRAY ELEMENT -- SET TO 1 IF OUT C OF RANGE C C2 COLUMN POINTER FOR AN ARRAY ELEMENT -- SET TO 1 IF C OUT OF RANGE C VAL VALUE OF THE ITEM POINTED TO BY INDEX (AND POSSIBLY C C1 AND C2); SET TO 1 FOR UNDEFINED INTEGER VARIABLE, C TO -1 FOR UNDEFINED REAL VARIABLE OR ARRAY ELEMENT C NAM NAME OF ITEM POINTED TO BY INDEX -- USED IN CALLS TO C ERROR ROUTINE C PTR POINTER TO A PARTICULAR ELEMENT IN AN ARRAY C INTEGER INDEX, C1, C2, VAL, NAM(10), PTR C1 = IC1 C2 = IC2 IF (.NOT.(TYPE(INDEX).EQ.ONEDIM .OR. TYPE(INDEX).EQ.TWODIM)) GO * TO 60 C ELSE ARRAY -- CHECK OUT SUBSCRIPTS IF (C1.GT.0 .AND. C1.LE.ROWS(INDEX)) GO TO 10 C ELSE C1 NOT VALID CALL GETNAM(INDEX, NAM) CALL ERROR(1, NAM, C1, C2) C1 = 1 10 IF (TYPE(INDEX).EQ.ONEDIM) GO TO 30 C ELSE CHECK OUT C2 IF (C2.GT.0 .AND. C2.LE.COLS(INDEX)) GO TO 20 C ELSE C2 NOT VALID CALL GETNAM(INDEX, NAM) CALL ERROR(2, NAM, C1, C2) C2 = 1 20 PTR = VALUE(INDEX) + ((C1-1)*COLS(INDEX)) + C2 - 1 GO TO 40 C THEN SET PTR 30 PTR = VALUE(INDEX) + C1 - 1 40 IF (AUXVAL(PTR).NE.0) GO TO 50 C ELSE NOT DEFINED -- USE -1 CALL GETNAM(INDEX, NAM) CALL ERROR(30, NAM, C1, C2) VAL = -1 GO TO 90 C THEN GET VALUE 50 VAL = AUXVAL(PTR) GO TO 90 C THEN NOT AN ARRAY 60 IF (DEFIND(INDEX)) GO TO 80 C ELSE NOT DEFINED -- USE 1 OR -1 DEPENDING ON TYPE CALL GETNAM(INDEX, NAM) IF (TYPE(INDEX).EQ.INTVAR) GO TO 70 C ELSE IT'S A REAVAR CALL ERROR(30, NAM, C1, C2) VAL = NULVAL CALL STORE(INDEX, C1, C2, NULVAL) GO TO 90 C THEN 70 CALL ERROR(4, NAM, C1, C2) VAL = 1 GO TO 90 C THEN GET VALUE 80 VAL = VALUE(INDEX) 90 RETURN END SUBROUTINE IERROR(ERR) C C ****************************************************************** C * * C * IERROR * C * * C * GIVEN AN ERROR OR WARNING NUMBER, IERROR PRINTS THE * C * APPROPRIATE ERROR OR WARNING MESSAGE. FOR ERRORS (NOT * C * WARNINGS) IERROR INCREMENTS THE GLOBAL ERROR COUNT. * C * NOTE THE ERRORS AND WARNINGS ARE DISTRIBUTED AS FOLLOWS: * C * 10-19 LEXICAL ANALYZER * C * 20-29 PARSING AND INTERMEDIATE CODE GENERATION * C * A CALL OF IERROR (0) PRODUCES A MESSAGE CONCERNING THE * C * TOTAL NUMBER OF ERRORS DETECTED DURING COMPILATION. IF THE * C * TOTAL IS NOT ZERO THE PROGRAM TERMINATES. A CALL OF * C * IERROR (50) PRODUCES A MESSAGE CONCERNING THE TOTAL NUMBER * C * OF ERRORS DETECTED DURING INTERPRETATION. IF THE TOTAL IS * C * NOT ZERO THE PROGRAM IS TERMINATED. * C * * C ****************************************************************** C COMMON /ERRNUM/ ERRCT COMMON /IO/ NREAD, NPRINT, NPUNCH INTEGER ERRCT C C ERR NUMBER OF ERROR OR WARNING TO BE PRINTED; C IF ERR IS 0 OR 50 A MESSAGE IS PRINTED CONCERNING C THE TOTAL NUMBER OF ERRORS DETECTED UP TO THAT POINT C AND ACTION IS TAKEN AS DESCRIBED ABOVE C INTEGER ERR, MSGS(26), M(26) EQUIVALENCE (MSGS(1),M(1)) DATA M(1), M(2), M(3), M(4), M(5), M(6), M(7), M(8), M(9), M(10) * /9*1,2/, M(11), M(12), M(13), M(14), M(15), M(16), M(17), M(18), * M(19), M(20) /3,4,1,1,1,1,5,1,1,6/, M(21), M(22), M(23), M(24), * M(25), M(26) /7,8,9,10,11,12/ IF (ERR.EQ.0) GO TO 130 IF (ERR.EQ.50) GO TO 140 C INCREMENT THE GLOBAL ERROR COUNT FOR ERRORS (NOT WARNINGS) IF (ERR.NE.25) ERRCT = ERRCT + 1 MSGERR = MSGS(ERR) GO TO (10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 120, 110), MSGERR 10 WRITE (NPRINT,99999) ERRCT GO TO 160 20 WRITE (NPRINT,99998) GO TO 160 30 WRITE (NPRINT,99997) GO TO 160 40 WRITE (NPRINT,99996) GO TO 160 50 WRITE (NPRINT,99995) GO TO 160 60 WRITE (NPRINT,99994) GO TO 160 70 WRITE (NPRINT,99993) GO TO 160 80 WRITE (NPRINT,99992) GO TO 160 90 WRITE (NPRINT,99991) GO TO 160 100 WRITE (NPRINT,99990) GO TO 160 110 WRITE (NPRINT,99988) GO TO 160 120 WRITE (NPRINT,99989) GO TO 160 130 WRITE (NPRINT,99987) ERRCT IF (ERRCT.EQ.0) GO TO 160 GO TO 150 140 WRITE (NPRINT,99986) ERRCT IF (ERRCT.EQ.0) GO TO 160 150 WRITE (NPRINT,99985) WRITE (NPRINT,99984) 160 RETURN 99999 FORMAT (17H *** ERROR NUMBER, I3, 4H ***) 99998 FORMAT (48H *** FIRST SIX COLUMNS OF CARD NON-BLANK AND/OR , * 35HCONTINUATION CHARACTER NOT A 1. ***) 99997 FORMAT (46H *** STATEMENT TOO LONG. FIRST 329 CHARACTERS , * 12HARE USED ***) 99996 FORMAT (47H *** INVALID CHARACTER(S) IN INPUT. CHARACTERS , * 46HIGNORED, REPLACED BY A . IN SOURCE LISTING ***) 99995 FORMAT (46H *** INVALID SYNTAX FOR SUMMATION VARIABLE ***/ * 37H (MISSING = OR CLOSE PARENTHESIS)) 99994 FORMAT (52H *** DIMENSION STATEMENT FOLLOWS EXECUTABLE CODE ***) 99993 FORMAT (21H *** SYNTAX ERROR ***) 99992 FORMAT (46H *** INVALID FOR LOOP INCREMENT. 1 IS USED ***) 99991 FORMAT (51H *** EXTRANEOUS END OR INVALID FOR LOOP NESTING ***) 99990 FORMAT (44H *** ATTEMPT TO RE-DEFINE FOR LOOP INDEX ***) 99989 FORMAT (47H *** (WARNING) MISSING END. ONE IS SUPPLIED ***) 99988 FORMAT (43H *** MORE THAN ONE COMPOSITION EXECUTED ***) 99987 FORMAT (20X, I5, 1X, 26HCOMPILATION ERROR(S) FOUND) 99986 FORMAT (20X, I5, 1X, 24HEXECUTION ERROR(S) FOUND) 99985 FORMAT (54H *** PROGRAM TERMINATED DUE TO NON-ZERO ERROR COUNT **, * 1H*) 99984 FORMAT (1H0, 19X, 27HMINICOMPILER VERSION 2.1.79) END C SUBROUTINE INSERT(ILOP, IOPER, IROP, NBR, ISOLD, INISH, IER) C ---------------------------------------------------------------------- C THIS SUBROUTINE PERFORMS SEARCHES AND INSERTIONS IN A HASH TABLE OF C ALL OPERATIONS IN THE 'OPTIMIZED' PROGRAM. C ILOP, IOPER, IROP - INPUT PARAMETERS GIVING THE LEFT OPERAND, C OPERATOR AND RIGHT OPERAND OF THE OPERATION C TO BE LOCATED. C NBR - OUTPUT POINTER TO THE OPERATION IN THE REDUCED C CODE. C ISOLD - OUTPUT PARAMETER. 0 = OPERATION IS NOT C REDUNDANT AND SHOULD BE INSERTED AS THE NBR-TH C LINE OF THE REDUCED CODE. 1 = OPERATION C IS ALREADY IN THE TABLE. C INISH - INPUT PARAMETER. 0 = NORMAL ENTRY. 1 = SET NBR C TO THE TABLE SIZE (LENGTH OF REDUCED CODE). -1 C = INITIALIZE THE HASH TABLE. C IER - OUTPUT PARAMETER. 0 = NORMAL. 1 = TABLE C OVERFLOW. C ---------------------------------------------------------------------- INTEGER HASH(211), PACKED(500), NEXT(500), STKTOP, HASHPT, * CURSOR, TRY, PKDOPR, PC IER = 0 IF (INISH.NE.0) GO TO 50 PKDOPR = 10000*(ILOP+100) + 1000*IOPER + (IROP+100) C FOR + AND * OPERATIONS SEE IF THE OPERATION HAS OCCURRED WITH C OPERANDS IN THE OTHER ORDER. IF ((IOPER.EQ.1 .OR. IOPER.EQ.3) .AND. ILOP.GT.IROP) PKDOPR = * 10000*(IROP+100) + 1000*IOPER + (ILOP+100) CURSOR = 211 NMD211 = 1 + PKDOPR - (PKDOPR/211)*211 HASHPT = HASH(NMD211) IF (HASHPT.EQ.0) GO TO 20 CURSOR = HASHPT 10 PC = PACKED(CURSOR) IF (PC.EQ.PKDOPR) GO TO 30 TRY = NEXT(CURSOR) IF (TRY.EQ.0) GO TO 20 CURSOR = TRY GO TO 10 C C INSERT THE OPERATION SINCE IT IS NOT REDUNDANT. 20 STKTOP = STKTOP + 1 IF (STKTOP.GT.500) GO TO 70 IF (HASHPT.NE.0) NEXT(CURSOR) = STKTOP IF (HASHPT.EQ.0) HASH(NMD211) = STKTOP PACKED(STKTOP) = PKDOPR NEXT(STKTOP) = 0 NBR = STKTOP + 100 ISOLD = 0 GO TO 40 C C THE OPERATION IS REDUNDANT. 30 NBR = CURSOR + 100 ISOLD = 1 40 RETURN C C INITIALIZE OR TERMINATE. 50 IF (INISH.EQ.1) NBR = STKTOP IF (INISH.EQ.1) GO TO 40 DO 60 I=1,211 HASH(I) = 0 60 CONTINUE STKTOP = 0 GO TO 40 C C STACK OVERFLOW. 70 IER = 1 GO TO 40 END SUBROUTINE INTERP C ************************** C ************************** INTERPRETER C ************************** MAIN SUBROUTINE INTERP C ************************** C C CALLING SEQUENCE: C C CALL INTERP C C ARGUMENTS: NONE C C INTERP OPERATES ON THE INTEGER ARRAY ICODE IN COMMON WHICH CONTAINS C INTERMEDIATE CODE GENERATED BY THE PARSER/CODE GERATOR ROUTINES. C INTERP PLACES ITS RESULTS IN THREE MORE INTEGER ARRAYS IN COMMON C (FDAT, FINT, FOUT). C C PURPOSE: C C TO EXECUTE THE INTERMEDIATE CODE IN ICODE, RECORDING ALL SIGNIFICANT C OPERATIONS WHICH TAKE PLACE (REAL ARITHMETIC, INPUT AND OUTPUT OF C VARIABLES). C C PROCEDURE: C C INCLUDING INTERP, THERE ARE THREE SUBROUTINES INVOLVED IN C THE INTERPRETATION PROCESS. THEIR OBJECTIVES ARE BRIEFLY LISTED C BELOW. C C INTERP: THE MAIN ROUTINE, RESPONSIBLE FOR DIRECTING THE C EXECUTION OF EACH INSTRRUCTION. INTERP ITSELF C DOES NOT PRODUCE ANY OUTPUT. C OPER: THE ROUTINE WHICH HANDLES ALL GENERATION OF C OUTPUT IN THE FORM OF ARRAY ENTRIES. C REALOP: THE ROUTINE WHICH CHECKS ALL REAL OPERATIONS FOR C POSSIBLE OPTIMIZATION. THIS INVOLVES BYPASSING C OPERATIONS WHOSE RESULT WAS KNOWN BECAUSE ONE OR C MORE OF THE OPERANDS HAD THE VALUE ZERO. C C BASIC ELEMENTS OF THE INTERPRETATION PROCESS WILL BE DESCRIBED HERE. C DETAILED DESCRIPTIONS OF EACH INSTRUCTION WILL APPEAR IN THE DOCU- C MENTATION FOR SUBROUTINE OPER. C C - THE INTERPRETER EXECUTES A PROGRAM BY RECORDING THE OCCURENCE C OF OPERATIONS INVOLVING REAL VARIABLES. THIS IS POSSIBLE C BASICALLY BECAUSE ALL BRANCHING DECISIONS ARE BASED ON THE C VALUES OF INTEGER VARIABLES ONLY (NO REAL IF STATEMENT). C C - INTEGER EXPRESSIONS ARE EVALUATED AS THEY ARE ENCOUNTERED. C THAT IS, AT ANY TIME THE INTERPRETER KNOWS EXACTLY WHAT THE C VALUE OF ANY INTEGER VARIABLE IS. C C - REAL OPERATIONS ARE NOT PERFORMED, THEIR OCCURENCE IN THE C EXECUTION PHASE IS "RECORDED", AND VALUE OF REAL VARIABLES C IS CHANGED ACCORDINGLY. C C - EVERY REAL VARIABLE HAS ASSOCIATED WITH IT AN INTEGER CODE C WHICH DESCRIBES ITS VALUE. POSSIBLE CODES AND THEIR C MEANINGS ARE: C C (1) UNDEFINED (VALUE = 0): C C ALL REAL VARIABLES ARE INITIALIZED TO THIS VALUE. C C (2) THE I-TH CONSTANT (VALUE = -I): C C ALL CONSTANTS CODED IN THE PREGRAM ARE GIVEN A VALUE C LESS THAN ZERO. A VARIABLE MAY ALSO TAKE ON A VALUE C < 0 AS THE RESULT OF SOME REAL OPERATION. IT SHOULD C BE NOTED THAT ONLY ONE REAL ZERO CONSTANT AND ONE C REAL CONSTANT ONE ARE STORED, NO MATTER HOW MANY C ARE CODED. C C (3) THE I-TH INPUT VALUE (VALUE = I): C C A REAL VARIABLE IS ASSIGNED THIS VALUE AS THE RESULT C OF AN INPUT STATEMENT (OR AS THE RESULT OF A REAL C OPERATION). IT IS THE PROGRAMMERS RESPONSIBILITY TO C SEE THAT VALUES IN THE INPUT MATCH THE VARIABLES IN C THE INPUT STATEMENTS. C C (4) THE I-TH INTERMEDIATE VALUE (VALUE = 100+I): C THE I-TH INTERMEDIATE VALUE IS THAT WHICH IS THE C REAULT OF THE I-TH REAL OPERATION. C C (5) THE NULL VALUE (VALUE = 50): C THIS VALUE INDICATES THAT THIS REAL VARIABLE IS C EXACTLY ZERO.THE VALUE ZERO CAN BE GENERATED BY A C CONSTANT ZERO OR BY A NULL SUMMATION VARIABLE, AND C CODE OPTIMIZATION IS PERFORMED ON THE NULL VALUE C WHENEVER POSSIBLE (SEE SUBROUTINE REALOP). IT SHOULD C BE NOTED THAT IF A CONSTANT ZERO MUST BE ENTERED INTO C THE SYMBOL TABLE, THE NULL VALUE WILL BECOME THE C VALUE OF THE CONSTANT ZERO IN THE TABLE. C C INTERP WILL DISTINGUISH BETWEEN SIMPLE AND COMPLEX OPERATIONS. C SIMPLE OPERATIONS ARE HANDLED BY CALLING SUBROUTINE OPER, WHILE C COMPLEX OPERATIONS WILL REQUIRE ONE OR MORE CALLS TO OPER, PLUS C POSSIBLY SOME OTHER ACTIONS. COMPLEX OPERATIONS ARE INPUT, C OUTPUT, FOR, AND SUMMATION. C C THE BASIC ALGORITHM USED IS AS FOLLOWS. C C (0) INITIALIZATION. C SET LOCATION COUNTER = 1. C C (1) FETCH. C TRANSFER INSTRUCTION POINTED TO BY LOCATION COUNTER FROM ICODE C INTO INS ARRAY (DONE FOR FASTER ACCESS TO THE INSTRUCTION). C ADVANCE LOCATION COUNTER BY ONE. C C (2) PERFORM SIMPLE INSTRUCTION. C IF INSTRUCITON IS NOT SIMPLE TYPE, GOTO (3). C IF OPERATION IS REAL ARITHMETIC, CALL REALOP, ELSE CALL OPER. C GOTO (1). C C (3) PERFORM INPUT/OUTPUT OPERATIONS. C IF INSTRUCTION IS NOT INPUT OR OUTPUT, GOTO (4). C IF THIS IS INPUT/OUTPUT OF A VARIABLE OR OF ONE ELEMENT OF AN C ARRAY, CALL OPER, GOTO (1). C IF THIS INPUT/OUTPUT OF AN ARRAY, C - GET DIMENSIONS OF ARRAY FROM SUBROUTINE GETDIM. C - USING THESE DIMENSIONS, CALL OPER ONCE FOR EACH OF THE C ELEMENTS OF THE ARRAY, IN COLUMN-MAJOR ORDER. C GOTO (1). C C (4) PERFORM SUMMATION OPERATION. C IF INSTRUCTION IS NOT SUMMATION, GOTO (5). C IF INITIAL VALUE OF THE INDEX EXCEEDS THE BOUND VALUE, SET C THE RESULT EQUAL TO THE NULL VALUE, GOTO (1). C SET THE RESULT EQUAL TO THE FIRST PRODUCT IN THE SUMMATION. C FOR EACH TERM REMAINING IN THE SUMMATION, C SET A TEMPORARY EQUAL TO THE VALUE OF THAT PRODUCT. C SET THE RESULT EQUAL TO THE SUM OF THE RESULT AND THE C TEMPORARY VALUE. C GOTO (1). C C (5) PERFORM FOR OPERATION. C IF THIS IS THE FIRST TIME THROUGH THE FOR INSTRUCTION, SET C INS(6) = LOOP BOUND, INS(7) = 1 AND STORE BACK INTO THE C ICODE ARRAY. C CALL OPER. C IF THIS WAS THE LAST TIME THROUGH THE FOR LOOP C (OPER WOULD HAVE SET INS(7) = 0), STORE THE INSTRUCTION C BACK INTO THE ICODE ARRAY. C C ======================================= C C COMMON; COMMON VARIABLES REFERENCED: C /STATE/ STMTNO: NUMBER OF STATEMENT CONTAINING THIS INSTRUCTION. C /INTCOD/ ICODE(500,11): CONTAINS INSTRUCTIONS TO BE EXECUTED. C IKNT : NUMBER OF INSTRUCTIONS IN ICODE. C /SUM/ NULVAL: THE CODED VALUE OF THE REAL CONSTANT ZERO. C DUM : FLAG INDICATING A SUMMATION INSTRUCTION IS BEING C EXECUTED. C /ITEMPS/ ITEMP(30): ARRAY CONTAINING INTEGER TEMPORARIES. C C LOCAL INTEGER STRUCTURES: C INS(10): TEMPORARY ARRAY INTO WHICH EACH INSTRUCTION IS FETCHED. C -- TEMPORARIES USED IN SUMMATION INSTRUCTION -- C SMULT(10): THE MULTIPLICATION INSTRUCTION. C SADD(10): THE ADDITION INSTRUCTION. C IS(4): USED IN COMPUTING ARRAY SUBSCRIPTS. C C LOCAL LOGICAL STRUCTURES: C DUM2(4): USED IN THE SUMMATION INSTRUCTION. C (DUM2(I) = .TRUE. IF THE I'TH SUBSCRIPT IS THE DUMMY C VARIABLE: FOUR SUBSCRIPTS ARE POSSIBLE, TWO FOR EACH C REAL VARIABLE). C C LOCAL INTEGER VARIABLES: C OLDLOC: LOCATION IN ICODE OF THE CURRENT INSTRUCTION. C LOCNTR: LOCATION IN ICODE OF NEXT INSTRUCTION TO BE EXECUTED. C (MAY BE ALTERED BY A BRANCH, OR A TEST). C OP : OP CODE FOR THIS INSTRUCTION (EQUIVALENCED TO INS(1)). C IS1,IS2,IS3,IS4: TEMPORARIES USED IN SUBSCRIPT CALCULATION. C ITYP,ID1,ID2: TEMPORARIES USED IN THE INPUT/OUTPUT INSTRUCTIONS. C LSTART,LEND,LTIMES: TEMPORARIES USED IN SUMMATION INSTRUCTION. C C ======================================= COMMON /STATE/ STMTNO COMMON /INTCOD/ ICODE, IKNT COMMON /SUM/ DUM, NULTAB, NULVAL, NULSTM COMMON /ITEMPS/ ITEMP, ITOP COMMON /SUBS/ NDUMMY INTEGER ITEMP(30), ICODE(500,11), INS(10), SMULT(10), SADD(10), * IS(4), NDUMMY(6), OP, OLDLOC, RD5, BT7, STMTNO LOGICAL DUM, DUM2(4), NULSTM INTEGER ZERO(10) EQUIVALENCE (INS(1),OP) DATA SMULT(1), SMULT(2), SMULT(4) /3,1,0/, SADD(1), SADD(2), * SADD(4), SADD(5), SADD(7), SADD(8), SADD(9), SADD(10) * /1,1,0,1,0,1,1,0/, DUM2(1), DUM2(2), DUM2(3), DUM2(4) /4*.FALSE./ DATA ZERO(1), ZERO(2), ZERO(3), ZERO(4), ZERO(5), ZERO(6), * ZERO(7), ZERO(8), ZERO(9), ZERO(10) /1H0,1H.,1H0,7*1H / LOCNTR = 1 10 IF (LOCNTR.GT.IKNT) GO TO 180 OP = ICODE(LOCNTR,1) IF (OP.EQ.99) CALL COMPO2(LOCNTR) DO 20 I=1,10 INS(I) = ICODE(LOCNTR,I) 20 CONTINUE OLDLOC = LOCNTR STMTNO = ICODE(LOCNTR,11) LOCNTR = LOCNTR + 1 C === C DETERMINE TYPE OF OPERATION C - SIMPLE OR COMPLEX C IF (OP.EQ.17 .OR. OP.EQ.18) GO TO 40 IF (OP.EQ.12) GO TO 160 IF (OP.EQ.21) GO TO 80 IF (OP.GT.6) GO TO 30 CALL REALOP(INS, LOCNTR) CALL OPER(INS, OP, LOCNTR) GO TO 10 C === C HERE FOR SIMPLE OPERATIONS: CALL OPER C 30 CALL OPER(INS, OP, LOCNTR) GO TO 10 C === C HERE FOR INPUT/OUTPUT OPERATIONS C - CALL OPER FOR FOR EACH ELEMENT TO BE HANDLED C 40 ITYP = INS(5) IF (ITYP.GE.3 .AND. INS(3).EQ.0) GO TO 50 C === C HERE IF ONLY ONE ELEMENT IS BEING HANDLED C IS1 = INS(3) IS2 = INS(4) IF (IS1.NE.0) IS1 = ITEMP(IS1) IF (IS2.NE.0) IS2 = ITEMP(IS2) INS(3) = IS1 INS(4) = IS2 CALL OPER(INS, OP, LOCNTR) GO TO 10 C === C HERE FOR AN ENTIRE ARRAY: C GET DIMENSIONS, HANDLE ARRAY IN COLUMN-MAJOR ORDER C 50 CALL GETDIM(INS(2), ID1, ID2) IF (ID2.EQ.0) ID2 = 1 DO 70 I1=1,ID2 DO 60 I2=1,ID1 INS(3) = I2 IF (ITYP.EQ.4) INS(4) = I1 CALL OPER(INS, OP, LOCNTR) 60 CONTINUE 70 CONTINUE GO TO 10 C === C HERE FOR SUMMATION VARIABLE C 80 CONTINUE LSTART = INS(8) LEND = INS(9) LSTART = ITEMP(LSTART) + 1 LEND = ITEMP(LEND) IF (LSTART-1.LE.LEND) GO TO 90 N5 = 5 CALL ADD(ZERO, N5, NVAL) CALL GETVAL(NVAL, 0, 0, IVAL) CALL STORE(1, INS(10), 0, IVAL) GO TO 10 90 IS(1) = INS(3) IS(2) = INS(4) IS(3) = INS(6) IS(4) = INS(7) SMULT(3) = INS(10) SMULT(5) = INS(2) SMULT(8) = INS(5) DUM = .TRUE. DO 120 I=1,4 IF (IS(I)) 100, 120, 110 100 DUM2(I) = .TRUE. IS(I) = LSTART - 1 GO TO 120 110 IS1 = IS(I) IS(I) = ITEMP(IS1) 120 CONTINUE SMULT(6) = IS(1) SMULT(7) = IS(2) SMULT(9) = IS(3) SMULT(10) = IS(4) CALL REALOP(SMULT, LOCNTR) CALL OPER(SMULT, 3, LOCNTR) SMULT(3) = 1 SADD(3) = INS(10) SADD(6) = INS(10) LTIMES = LEND - LSTART + 1 IF (LTIMES.EQ.0) GO TO 140 DO 130 I2=1,LTIMES I = I2 + LSTART - 1 IF (DUM2(1)) SMULT(6) = I IF (DUM2(2)) SMULT(7) = I IF (DUM2(3)) SMULT(9) = I IF (DUM2(4)) SMULT(10) = I CALL REALOP(SMULT, LOCNTR) CALL OPER(SMULT, 3, LOCNTR) CALL REALOP(SADD, LOCNTR) CALL OPER(SADD, 1, LOCNTR) 130 CONTINUE 140 DO 150 I=1,4 DUM2(I) = .FALSE. 150 CONTINUE DUM = .FALSE. GO TO 10 C === C HERE FOR THE FOR OPERATION C - HANDLE FIRST AND LAST TIMES THROUGH AS SPECIAL CASES C 160 CONTINUE IF (INS(7).NE.0) GO TO 170 ITMP = INS(3) INS(6) = ITEMP(ITMP) ICODE(OLDLOC,6) = INS(6) INS(7) = 1 ICODE(OLDLOC,7) = 1 170 CALL OPER(INS, OP, LOCNTR) IF (INS(7).EQ.0) ICODE(OLDLOC,7) = 0 GO TO 10 180 RETURN END SUBROUTINE KFIND(SYMBOL, ICODE) C ************************** C ************************** LEXICAL ANALYZER C ************************** SUBROUTINE KFIND C ************************** C C CALLING SEQUENCE: C C CALL KFIND(SYMBOL,ICODE), C WHERE SYMBOL IS A TEN ELEMENT ARRAY CONTAINING THE SYMBOL TO C BE TESTED AND ICODE IS AN INTEGER VARIABLE WHOSE VALUE IS DE- C FINED BY KFIND. C C ARGUMENTS: C C SYMBOL -- THE SYMBOL WHICH IS TO BE TESTED. C ICODE -- THE RESULT OF THE TEST. C C PURPOSE: C C TO RETURN ICODE = 0 IF THE IDENTIFIER IN ARRAY SYMVOL IS NOT A C KEYWORD. ELSE, (IF THE IDENTIFIER IS A KEYWORD) TO RETURN THE C TYPE OF THAT KEYWORD. C C (FOR RELATION KEYWORDS, AND THE KEYWORDS INPUT AND OUTPUT, C SPECIAL VALUES ARE RETURNED FROM WHICH THE TYPE AND VALUE C ARE LATER DERIVED) C C PROCEDURE: C C SUBROUTINE KFIND EXECUTES A BINARY SEARCH ON A TABLE OF KEYWORDS C TO DETERMINE IF THE SYMBOL IS A KEYWORD. C C - IF IT IS, THE ICODE VALUE IS RETRIEVED FROM ANOTHER PRE- C DEFINED ARRAY (AN ARRAY OF ICODE VALUES CORRESPONDING TO C THE ARRAY OF KEYWORDS). C C - IF IT IS NOT, ICODE = 0 IS RETURNED. C C ======================================= C C LOCAL INTEGER STRUCTURES: C KEYCAR(10,18): CHARACTER REPRESENTATIONS OF ALL THE KEYWORDS. C --K(93),L(83): USED TO DATA-INITIALIZE ARRAY KEYCAR. C KEYTOK(18): TOKENS FOR THE CORRESPONDING KEYWORDS IN KEYCAR. C --M(18) : USED TO DATA-INITIALIZE KEYTOK. C C LOCAL INTEGER VARIABLES: C LEFT, MID, RIT: USED IN THE BINARY SEARCH. C -- CONSTANTS USED BY KFIND -- C BLK: BLANK. C C ======================================= INTEGER SYMBOL(10), KEYCAR(10,18), KEYTOK(18), BLK, LEFT, RIT, MID INTEGER K(93), L(83), M(18) EQUIVALENCE (KEYCAR(1),K(1)), (KEYCAR(1,11),L(1)), * (KEYTOK(1),M(1)) DATA BLK /1H / DATA K(1), K(2), K(3) /1HB,1HY,1H / DATA K(11), K(12), K(13), K(14), K(15), K(16), K(17), K(18), * K(19), K(20) /1HD,1HI,1HM,1HE,1HN,1HS,1HI,1HO,1HN,1H / DATA K(21), K(22), K(23), K(24) /1HE,1HN,1HD,1H / DATA K(31), K(32), K(33) /1HE,1HQ,1H / DATA K(41), K(42), K(43), K(44) /1HF,1HO,1HR,1H / DATA K(51), K(52), K(53) /1HG,1HE,1H / DATA K(61), K(62), K(63) /1HG,1HT,1H / DATA K(71), K(72), K(73) /1HI,1HF,1H / DATA K(81), K(82), K(83), K(84), K(85), K(86) /1HI,1HN,1HP,1HU, * 1HT,1H / DATA K(91), K(92), K(93) /1HL,1HE,1H / DATA L(1), L(2), L(3) /1HL,1HT,1H / DATA L(11), L(12), L(13) /1HN,1HE,1H / DATA L(21), L(22), L(23), L(24), L(25), L(26), L(27) /1HO,1HU,1HT, * 1HP,1HU,1HT,1H / DATA L(31), L(32), L(33), L(34), L(35) /1HS,1HQ,1HR,1HT,1H / DATA L(41), L(42), L(43), L(44), L(45), L(46), L(47), L(48), * L(49), L(50) /1HS,1HU,1HM,1HM,1HA,1HT,1HI,1HO,1HN,1H / DATA L(51), L(52), L(53), L(54), L(55) /1HT,1HE,1HS,1HT,1H / DATA L(61), L(62), L(63), L(64), L(65) /1HT,1HH,1HE,1HN,1H / DATA L(71), L(72), L(73) /1HT,1HO,1H / DATA M(1), M(2), M(3), M(4), M(5), M(6), M(7), M(8), M(9), M(10) * /10,6,13,31,8,36,34,11,67,35/ DATA M(11), M(12), M(13), M(14), M(15), M(16), M(17), M(18) * /33,32,68,17,7,16,12,9/ LEFT = 0 RIT = 19 MID = 10 C == C BEGIN BINARY SEARCH ON KEYWORD SYMBOL TABLE C === 10 DO 30 I=1,10 IF (SYMBOL(I).EQ.KEYCAR(I,MID)) GO TO 20 IF (SYMBOL(I).GT.KEYCAR(I,MID)) GO TO 60 GO TO 50 20 IF (SYMBOL(I).EQ.BLK) GO TO 40 30 CONTINUE C === C HERE IF SYMBOL EQUAL TO THIS KEYWORD C === 40 ICODE = KEYTOK(MID) GO TO 90 C === C HERE IF SYMBOL LESS THAN THIS KEYWORD C === 50 RIT = MID GO TO 70 C === C HERE IF SYMBOL GREATER THAN THIS KEYWORD C === 60 LEFT = MID 70 IF (RIT-LEFT.EQ.1) GO TO 80 MID = (LEFT+RIT)/2 GO TO 10 C === C HERE IF SYMBOL IS NOT A KEYWORD C === 80 ICODE = 0 90 RETURN END SUBROUTINE LEXAN(TYPE, VALUE) C ************************** C ************************** LEXICAL ANALYZER C ************************** MAIN SUBROUTINE LEXAN C ************************** C C CALLING SEQUENCE: C C CALL LEXAN(TYPE,VALUE), C WHERE TYPE AND VALUE ARE INTEGER VARIABLES WHOSE VALUE WILL BE C DEFINED BY THE LEXICAL ANALYZER. C C ARGUMENTS: C C TYPE -- TYPE OF THE NEXT TOKEN IN THE INPUT STREAM C VALUE -- THE VALUE ASSOCIATED WITH THE TOKEN (IF THIS TOKEN HAS NO C VALUE ASSOCIATED WITH IT, VALUE = -1 IS RETURNED) C C PURPOSE: C C TO RETURN THE TYPE AND VALUE OF THE NEXT TOKEN IN THE INPUT STREAM C WHEN CALLED BY THE PARSER. TYPE AND VALUE MEANINGS FOR TOKENS ARE C INDICATED BELOW. C C TOKEN TYPE VALUE C ----- ---- ----- C >>> (VARIABLES AND CONSTANTS) <<< C INTEGER VARIABLE 0 SYMBOL TABLE LOCATION OF VARIABLE C INTEGER CONSTANT 1 SYMBOL TABLE LOCATION OF CONSTANT C REAL VARIABLE 2 SYMBOL TABLE LOCATION OF VARIABLE C REAL 1-D ARRAY 3 SYMBOL TABLE LOCATION OF ARRAY C REAL 2-D ARRAY 4 SYMBOL TABLE LOCATION OF ARRAY C REAL CONSTANT 5 SYMBOL TABLE LOCATION OF CONSTANT C >>> (KEYWORDS) <<< C DIMENSION 6 -1 C SUMMATION 7 -1 C FOR 8 -1 C TO 9 -1 C BY 10 -1 C IF 11 -1 C THEN 12 -1 C END 13 -1 C INPUT 15 17 C OUTPUT 15 18 C TEST 16 -1 C SQRT 17 -1 C EQ 26 1 C NE 26 2 C LT 26 3 C GT 26 4 C LE 26 5 C GE 26 6 C >>> (SYMBOLS AND DELIMITERS) <<< C = (ASSIGNMENT) 18 -1 C + (ADDITION) 19 -1 C - (SUBTRACTION) 20 -1 C * (MULTIPLICATION) 21 -1 C / (DIVISION) 22 -1 C ( (OPEN PARENTHESIS) 23 -1 C ) (CLOSE PARENTHESIS) 24 -1 C , (COMMA SEPARATOR) 25 -1 C . (PERIOD) 30 -1 C END-OF-STATEMENT 27 -1 C END-OF-FILE 28 -1 C DUMMY VARIABLE 29 -1 C C OTHER DUTIES ASSUMED BY THE LEXICAL ANALYZER: C C DETECT END-OF-FILE C CHECK FOR SOME OF THE USER SYNTAX ERRORS C - NAMES, CONSTANTS TOO LONG C - STATEMENT TOO LONG C - INVALID CHARACTERS IN STATEMENT C ADD ALL SYMBOLS AND CONSTANTS