INTEGER FUNCTION LOOKUP(K1, LABEL) C C STMT(PSTMT)-STMT(K2-1) TO BE ENTERED IN DSA C LABEL IS TRUE IF SYMBOL IS A LABEL. ROUTINE C RETURNS VALUE OF INDEX OF SYMBOL IN DSA, CREATING C A NEW ENTRY ID NESESSARY. IT ENTERS SYMBOL INTO C SYMBOL OR LABEL CHAIN AND CREATES A CROSSREFERENCE C ENTRY FOR THE CURRENT STATMT NUMBER C INTEGER PSTMT, SYMLEN, DSA, HASH, L(6), LL(6) INTEGER BLANK, SYMHD, STMT, OUTUT, BNEXT, Q(70) INTEGER PDSA, OUTUT2, OUTUT3, OUTUT4 LOGICAL LABEL, ERR, P1ERR, OPT, SYSERR, ABORT COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3, * OUTUT4 COMMON /DETECT/ ERR, SYSERR, ABORT COMMON /FACTS/ NAME, NOST, ITYP, IASF COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT COMMON /CTABL/ LDSA, PDSA, DSA(5000) COMMON /CHASH/ LHASH, HASH(401) COMMON /TRANS/ Q COMMON /OPTNS/ OPT(5), P1ERR DATA BLANK /1H / K = K1 - PSTMT IF (K.LE.6) GO TO 10 CALL ERROR1(39H IDENTIFIER TOO LONG, WILL BE TRUNCATED, 39) K = 6 10 KK = K DO 20 I=1,K II = PSTMT + I - 1 J = STMT(II) + 1 LL(I) = Q(J) 20 CONTINUE DO 30 I=1,SYMLEN L(I) = BLANK 30 CONTINUE CALL S5PACK(LL, L, K) C C HAVE PACKED SYMBOL;NOW CALCULATE HASH C HASH IS(PRODUCT OF FIRST AND THIRD LETTERS PLUS SECOND) MOD 257 C IF (KK.LT.3) GO TO 50 IHASHS = STMT(PSTMT)*STMT(PSTMT+2) + STMT(PSTMT+1) 40 IHASHS = MOD(IHASHS,LHASH) ISAVE = IHASHS IHASH = IHASHS + 1 GO TO 80 50 IHASHS = STMT(PSTMT) GO TO (60, 70), KK 60 IHASHS = IHASHS*69 + 69 GO TO 40 70 IHASHS = IHASHS*69 + STMT(PSTMT+1) GO TO 40 80 IF (HASH(IHASH).EQ.0) GO TO 140 C C IF TABLE EMPTY, CREATE ENTRY, SEND BACK INDEX OF FIRST WORD IN DSA C ELSE COMPARE SYMBOL TO ID AND RETURN INDEX OF PROPER ENTRY IN HASH C TABLE AFTER RESOLVING COLLISION C DO 90 J=1,SYMLEN II = HASH(IHASH) + 3 + J IF (L(J).NE.DSA(II)) GO TO 100 90 CONTINUE LOOKUP = HASH(IHASH) IF (DSA(LOOKUP+1)) 190, 190, 200 C C RESOLVE CONFLICTS BY LINEAR CONGRUENCE C 100 IHASHS = MOD(IHASHS+1,LHASH) IF (IHASHS.EQ.ISAVE) GO TO 110 IHASH = IHASHS + 1 GO TO 80 110 CALL ERROR1(34H IN LOOKUP, TABLE OVERFLOW OF HASH, 34) 120 SYSERR = .TRUE. RETURN 130 CALL ERROR1(33H IN LOOKUP, TABLE OVERFLOW OF DSA, 33) GO TO 120 C C CREATE NEW SYMBOL TABLE ENTRY; ZERO ITS CROSSREF TAIL PTR C 140 HASH(IHASH) = NEXT IF (NEXT+6+SYMLEN.GE.BNEXT) GO TO 130 LOOKUP = NEXT C C*****DSA C 1ST WORD..... ATTRIBUTE WORD C FIELD 1 C C BITS 0-2*TYPE (FOR SYMBOL) 0 DOUBLE PRECISION, 1 REAL, 2 INT, C 3 COMPLEX,4 LOGICAL, 5 HOLLERITH C TYPE (FOR LABEL) 1 EXECUTABLE STMT, 2 NONEXEC. STMT, C 3 FORMAT STMT C BIT 3****EXPLICITLY TYPED 1, IMPLICITLY 0 C FIELD 2 C BIT 4****(FOR SYMBOL) IN COMMON 1, NOT IN COMMON 0 C (FOR LABEL) DEFINED 1, REFERENCED 0 C (FOR COMMON-NAME) INITIALIZED IN BLOCK DATA SUBPGM C FIELD 3 C BIT 5****EQUIVALENCED 1 C FIELD 4 C BIT 6****DUMMY SUBROUTINE/FUNCTION ARGUMENT 1 C FIELD 5 C BIT 7****VALUE SET BY P.U. 1 C FIELD 6 C BIT 8****VARIABLE USED AS DIMENSION IN VARIABLY DIMENSIONED ARRAY C FIELD 7 C BIT 9-10*SCALAR 0, NUMBER OF ARRAY BOUNDS 1,2,3 C FIELD 8 C BITS 11-15**USAGE--UNSET 0, ASF ARG 1, ASF FCN 2, CURRENT P. U.= C SUBR 3, CURRENT P.U.=FCN 4, EXTERNAL FCN 5, EXTERNAL SUBR 6, C COMMON-NAME 7, ASSIGN/GOTO VARIABLE 8,LABEL 9, VARIABLE 10, C CURRENT P.U.=BLOCK DATA 11, CURRENT P.U.=MAIN 12, EXTERNAL ENTITY C 13, INTRINSIC FCN 14 C BITS 5-8 ARE 0 IF ENTRY CORRESPONDS TO ENTITY WITHOUT THE C ATTRIBUTE MENTIONED C C 2ND WD..... XREF LIST TAIL POINTER C 3D WORD.....EXTRA INFO POINTER C C FOR A VARIABLE, 3D WORD POINTS TO A 2 WORD BLOCK, FIRST WORD C CONTAINING STORAGE UNIT LENGTH OF THE VARIABLE (-1 IF VARIABLY C DIMENSIONED ARRAY); SECOND WORD CONTAINING INDEX OF COMMON C ENTRY IN DSA; C FOR A LABEL, 3D WORD CONTAINS POINTER TO 2 WORD BLOCK ; AFTER C LABEL DEFINED, FIRST WORD CONTAINS STMT NUMBER OF FIRST STMT C IN CURRENT DO NESTING LEVEL; SECOND WORD CONTAINS NEGATIVE THE C NESTING LEVEL; WHEN END OF THIS NESTING LEVEL IS ENCOUNTERED C ALL 2ND WORDS FOR THAT LEVEL ARE UPDATED TO CONTAIN STMT NUMBER C OF LAST STMT AT THAT NESTING LEVEL; C FOR A COMMON-NAME, 3D WORD POINTS TO HEAD OF LINEAR LINKED LIST C OF INDICES OF DSA ENTRIES FOR ORDERED ELEMENTS IN THAT COMMON; C FOR THE CURRENT P.U. IF ITS A SUBR OR FCN, 3D WORD CONTAINS C A LINEAR LINKED LIST OF INDICES IN DSA OF ENTRIES FOR ORDERED C DUMMIES OF THAT SUBPGM; C C 4TH WORD..... CHAIN POINTER TO ENTRY IN DSA FOR LAST SYMBOL C OR LABEL FOR WHICH A NEW ENTRY WAS CREATED C 5-7TH WORD.....PACKED CHARACTERS OF SYMBOL OR LABEL C J = NEXT + 2 DO 150 I=NEXT,J DSA(I) = 0 150 CONTINUE J = J + 1 DO 160 I=1,SYMLEN II = I + J DSA(II) = L(I) 160 CONTINUE C C SETONE OF THE CHAIN POINTERS TO PUT THIS SYMBOL ON CHAIN C IF (LABEL) GO TO 170 DSA(J) = SYMHD SYMHD = NEXT GO TO 180 170 DSA(J) = LABHD LABHD = NEXT 180 NEXT = 4 + SYMLEN + NEXT C C BEGINNEW XREF LIST C 190 IF (.NOT.LABEL .AND. .NOT.OPT(2)) GO TO 210 IF (NEXT+2.GE.BNEXT) GO TO 130 DSA(BNEXT-1) = NOST DSA(LOOKUP+1) = BNEXT - 1 DSA(BNEXT) = BNEXT - 1 BNEXT = BNEXT - 2 GO TO 210 C C XREF LIST UPDATE; CHECK TO SEE IF STATEMENT NUMBER IS ALREADY C THERE C 200 IF (.NOT.LABEL .AND. .NOT.OPT(2)) GO TO 210 IF (NEXT+2.GE.BNEXT) GO TO 130 J = DSA(LOOKUP+1) IF (DSA(J).EQ.NOST) GO TO 210 DSA(BNEXT) = DSA(J+1) DSA(J+1) = BNEXT - 1 DSA(LOOKUP+1) = BNEXT - 1 DSA(BNEXT-1) = NOST BNEXT = BNEXT - 2 210 RETURN END