|
|
1.1 ! root 1: INTEGER STMT, PSTMT, SYMLEN, OUTUT, SYMHD, BNEXT, HASH, DSA, ! 2: * STACK, DOLIST, DOPT, OUTUT2, OUTUT3, PDSA, OUTUT4, REF, PREF, ! 3: * PNODE, PLAT, PCOM, COM ! 4: LOGICAL ERR, SYSERR, OPT, P1ERR, ABORT, P2 ! 5: LOGICAL SW, QBR ! 6: COMMON /SWS/ SW(10) ! 7: C*****SWS ! 8: C SW(1) (LOG) IF TRUE, CAN USE END= OPTION IN READ STMTS ! 9: C ! 10: COMMON /OPTNS/ OPT(5), P1ERR ! 11: C ! 12: C*****OPTNS ! 13: C OPT(1) (LOG) IF TRUE, SYMBOL TABLE PRINTED FOR EACH P. U. ! 14: C OPT(2) (LOG) IF TRUE, CROSS REFERENCES PRINTED FOR EACH SYMBOL ! 15: C OPT(3) (LOG) IF TRUE, PASS 2 IS EXECUTED ! 16: C OPT(4) (LOG) IF TRUE, LISTING PRINTED FOR EACH P. U. ! 17: C OPT(5) (LOG) IF TRUE, FORTRAN PGM COMPILED AFTER VERIFIER ! 18: C RUN; IF ANY OF THESE ARE FALSE THE CORRESPONDING ACTION IS NOT TA ! 19: C P1ERR (LOG) SET TO TRUE IF INFO NORMALLY SAVED FOR PASS 2 IS ! 20: C SUPPRESSED FOR THIS P. U. ! 21: C ! 22: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) ! 23: C ! 24: C*****INPUT ! 25: C NSTMT (INT) INDEX OF END-OF-INPUT-STMT CHARACTER IN STMT ! 26: C PSTMT (INT) POINTS TO CURRENT POSITION IN STMT (EXCEPT IN LEXICAL ! 27: C SUBPGMS WHERE IT IS UPDATED IN CALLING SUBPGM AFTER A TOKEN IS ! 28: C FOUND) ! 29: C STMT (INT) ENCODED FORM OF DEBLANKED INPUT STMT ! 30: C ! 31: COMMON /CEXPRS/ LSTACK, STACK(620) ! 32: C ! 33: C*****CEXPRS ! 34: C LSTACK (INT) LENGTH OF STACK ! 35: C STACK(*), (INT) ARRAY USED IN EXPR AS A STACK; ALSO FOR AUXILLARY ! 36: C STORAGE AND OUTPUT ! 37: C ! 38: COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3, ! 39: * OUTUT4 ! 40: C ! 41: C*****PARAMS ! 42: C INUT (INT) LOGICAL INPUT NUMBER FOR THE HOST MACHINE ! 43: C OUTUT (INT) LOGICAL OUTPUT NUMBER FOR THE HOST MACHINE ! 44: C NOCHAR (INT) NUMBER OF CHARACTERS PER MACHINE WORD IN HOST ! 45: C SYMLEN (INT) NUMBER OF WORDS NECESSARY ON HOST TO STORE 6 ! 46: C CHARACTERS (I.E. A FORTRAN SYMBOL) ! 47: C OUTUT2 (INT), OUTUT3(INT), OUTUT4(INT) LOGICAL OUTPUT NUMBERS ! 48: C FOR THE HOST MACHINE TO BE USED BY THE VERIFIER FOR INTERPASS ! 49: C COMMUNICATION ! 50: C ! 51: COMMON /FACTS/ NAME, NOST, ITYP, IASF ! 52: C ! 53: C*****FACTS ! 54: C NAME (INT) INDEX IN SYMBOL TABLE OF ENTRY FOR CURRENT P.U. ! 55: C NOST (INT) STMT NUMBER OF CURRENT STMT BEING PROCESSED ! 56: C ITYP (INT) TYPE OF STMT CURRENTLY BEING PROCESSED (SEE PU ! 57: C FOR FURTHER DOC) ! 58: C ! 59: COMMON /DETECT/ ERR, SYSERR, ABORT ! 60: C ! 61: C*****DETECT ! 62: C ERROR (LOG) SET TO TRUE IN VARIOUS SUBPGMS USUALLY TO CEASE PROCES ! 63: C OF CURRENT STMT ! 64: C SYSERR (LOG) IRRECOVERABLE ERROR IN SYSTEM; (E.G., TABLE OVERFLOW) ! 65: C IN PASS 1 CAUSES CURRENT P.U. TO HAVE AN END STMT SIMULATED AND ! 66: C EXECUTION PROCEDES TO NEXT P.U.; IN PASS 2 CAUSES PROCESSING ! 67: C OF PROGRAM TO CEASE. ! 68: C ! 69: COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT ! 70: C ! 71: C*****TABL ! 72: C NEXT (INT) POINTS TO NEXT FREE WORD IN DSA (COUNTING FROM DSA(1)) ! 73: C LABHD (INT) POINTS TO HEAD OF LINEAR LINKED LIST IN DSA OF ALL ! 74: C LABELS IN P.U. ! 75: C SYMHD (INT) POINTS TO HEAD OF LINEAR LINKED LIST IN DSA OF ALL ! 76: C SYMBOLS IN P.U. ! 77: C BNEXT (INT) POINTS TO NEXT FREE WORD IN DSA (COUNTING FROM ! 78: C DSA(LDSA)) ! 79: C ! 80: COMMON /CHASH/ LHASH, HASH(401) ! 81: C ! 82: C*****CHASH ! 83: C LHASH (INT) LENGTH OF HASH ARRAY ! 84: C HASH (*) (INT) HASH TABLE USED TO INDEX INTO DSA ! 85: C ! 86: COMMON /CTABL/ LDSA, PDSA, DSA(5000) ! 87: C ! 88: C*****CTABL ! 89: C LDSA (INT) LENGTH OF DSA ! 90: C DSA(*) (INT) SYMBOL TABLE (SEE LOOKUP FOR MORE EXPLICIT DOC) ! 91: C ! 92: COMMON /DOS/ DOPT, LDO, DOLIST(192) ! 93: C ! 94: C*****DOS ! 95: C DOPT (INT) POINTER TO FIRST FREE WORD IN DOLIST ! 96: C LDO (INT) LENGTH OF DOLIST ! 97: C DOLIST (*) (INT) ARRAY USED AS STACK FOR NESTING OF DOS (USED ! 98: C TO TEST FOR LEGAL BRANCHING WITHIN P.U. (SEE DOSPEC FOR FURTHER ! 99: C DOC) ! 100: C ! 101: COMMON /LISTDO/ LPT, LEN, LS(64) ! 102: C ! 103: C*****LISTDO ! 104: C LPT (INT) POINTER TO FIRST FREE WORD IN LS ! 105: C LEN (INT) LENGTH OF LS ! 106: C LS (*) (INT) ARRAY USED AS STACK FOR NESTING OF IMPLIED ! 107: C DO'S IN INPUT/OUTPUT STMTS (SEE DOSPEC FOR FURTHER DOC) ! 108: C ! 109: COMMON /PASS/ P2, QBR ! 110: C ! 111: C*****PASS ! 112: C P2 (LOG) IF TRUE, VERIFIER IS IN PASS 2; ELSE VERIFIER IS IN PASS ! 113: C QBR (LOG) IF TRUE, VERIFIER IS TO PRINT ERROR MESSAGES ! 114: C ELSE IS NOT ! 115: C ! 116: COMMON /CREF/ LREF, PREF, REF(100) ! 117: C ! 118: C*****CREF ! 119: C LREF (INT) TOTAL LENGTH OF ARRAY REF ! 120: C PREF (INT) CURRENT LENGTH OF REF ! 121: C REF (*) (INT) ARRAY CONTAINING INFORMATION CONCERNING A SUBR/FCN ! 122: C REF (SEE SETREF FOR FURTHER DOC) ! 123: C ! 124: COMMON /HEAD/ LNODE, PNODE, NODE(500) ! 125: C ! 126: C*****HEAD ! 127: C LNODE (INT) LENGTH OF NODE ! 128: C PNODE (INT) POINTER TO NEXT FREE WORD IN NODE ! 129: C NODE (*) (INT) ARRAY OF INDICES OF P.U. ENTRIES IN LAT ! 130: C ! 131: COMMON /GRAPH/ LLAT, PLAT, LAT(6000) ! 132: C ! 133: C*****GRAPH ! 134: C LLAT (INT) LENGTH OF LAT ! 135: C PLAT (INT) POINTER TO NEXT FREE WORD IN LAT ! 136: C LAT (*) (INT) ARRAY WHOSE ENTRIES DESCRIBE EACH P.U. IN PGM ! 137: C AND THEIR INTER-RELNS (SEE SETNOD FOR FURTHER DOC) ! 138: C ! 139: COMMON /COMS/ LCOM, PCOM, COM(300) ! 140: C ! 141: C*****COMS ! 142: C LCOM (INT) LENGTH OF COM ! 143: C PCOM (INT) POINTER TO NEXT FREE WORD IN COM ! 144: C COM (*) (INT) ARRAY WHOSE ENTRIES DESCRIBE EACH COMMON BLOCK ! 145: C IN PGM (SEE SETCOM FOR FURTHER DOC) ! 146: COMMON /SCR1/ LINODE, INODE(500) ! 147: COMMON /SCR2/ LNNODE, NNODE(500) ! 148: C ! 149: C***SCR1,SCR2,SCR3 ! 150: C INODE(INT), NNODE(INT) SCRATCH ARRAYS KEYED ON LENGTH NODE(*) ! 151: C LINNODE = LNNODE .GE. MAX( LNODE, LCOM/(SYMLEN+5) ) ! 152: C ! 153: C THREE MORE BLOCK COMMON REGIONS ARE USED : STS -SEE TYPST ! 154: C TRANS - SEE MAPCHR EXPRS - SEE EXPR FOR FURTHER DOC ! 155: C ! 156: QBR = .FALSE. ! 157: NOCHAR = 4 ! 158: INUT = 5 ! 159: OUTUT = 6 ! 160: OUTUT2 = 7 ! 161: OUTUT3 = 8 ! 162: OUTUT4 = 9 ! 163: C NOCHAR WAS &, OUT2-4 was 12,13,14 in distribution tape ! 164: REWIND INUT ! 165: REWIND OUTUT2 ! 166: REWIND OUTUT3 ! 167: REWIND OUTUT4 ! 168: LEN = 64 ! 169: SYMLEN = (5/NOCHAR) + 1 ! 170: P2 = .FALSE. ! 171: ERR = .FALSE. ! 172: ABORT = .FALSE. ! 173: SYSERR = .FALSE. ! 174: SW(1) = .FALSE. ! 175: PDSA = 1 ! 176: LDSA = 5000 ! 177: LHASH = 401 ! 178: DO 10 I=1,LHASH ! 179: HASH(I) = 0 ! 180: 10 CONTINUE ! 181: OPT(1) = .TRUE. ! 182: OPT(2) = .TRUE. ! 183: OPT(3) = .TRUE. ! 184: OPT(4) = .TRUE. ! 185: OPT(5) = .FALSE. ! 186: LSTACK = 620 ! 187: LREF = 100 ! 188: PREF = 1 ! 189: LDO = 192 ! 190: CALL OVRLAY(1) ! 191: CALL PU ! 192: IF (.NOT.OPT(3) .OR. SYSERR) GO TO 30 ! 193: P2 = .TRUE. ! 194: IF (.NOT.OPT(4)) WRITE (OUTUT,99999) ! 195: 99999 FORMAT (1H1) ! 196: CALL OVRLAY(2) ! 197: LLAT = 6000 ! 198: PLAT = 1 ! 199: BNEXT = LDSA ! 200: NEXT = 1 ! 201: LNODE = 500 ! 202: PNODE = 1 ! 203: LCOM = 300 ! 204: PCOM = 1 ! 205: LINODE = LNODE ! 206: LNNODE = LNODE ! 207: C ! 208: C PASS 1 CAN SUPPRESS PASS 2 PROCESSING FOR SPECIFIC P.U. ! 209: C BUT NEVER SHUTS OFF PASS 2 COMPLETELY; PASS 2 CAN CEASE ! 210: C PROCESSING FOR VARIOUS REASONS: ! 211: C 1. 2 SUBPRGMS WITH SAME NAME(IN SETNOD) ! 212: C 2. NO PROGRAM UNIT SUCCESSFULLY PASSED TO PASS 2 ! 213: C (IN CONSTR) ! 214: C 3. RECURSION (IN ASLEV AND INVOKE) ! 215: C IF MISSING SUBPRGMS ARE DISCOVERED, PASS 2 CAN ! 216: C PROCEDE WITH INCOMPLETE PROCESSING, A MESSAGE ! 217: C IS PRINTED TO INFORM THE USER ! 218: C ! 219: REWIND OUTUT2 ! 220: REWIND OUTUT3 ! 221: REWIND OUTUT4 ! 222: CALL CONSTR(IROOT) ! 223: C CAN RETURN FROM CONSTR IN ERROR CONDITION WITH FILES LACKING ! 224: C VERIFIER SOFTWARE END OF FILE ! 225: IF (ABORT .OR. SYSERR) GO TO 30 ! 226: REWIND OUTUT4 ! 227: REWIND OUTUT3 ! 228: REWIND OUTUT2 ! 229: CALL CHECKS(IROOT) ! 230: 20 REWIND INUT ! 231: CALL OVRLAY(3) ! 232: CALL COMPIL(.NOT.(ABORT.OR.SYSERR).AND.OPT(5)) ! 233: STOP ! 234: 30 WRITE (OUTUT,99998) ! 235: 99998 FORMAT (47H1INTER-PROGRAM-UNIT COMMUNICATIONS NOT VERIFIED) ! 236: GO TO 20 ! 237: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.