SUBROUTINE EQUIV INTEGER STMT, PSTMT, PDSA, DSA, TYPE, STACK, BNEXT, SYMHD LOGICAL ARDECL, CORNR, SAME, ERR, SYSERR, ABORT COMMON /DETECT/ ERR, SYSERR, ABORT COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT COMMON /CTABL/ LDSA, PDSA, DSA(5000) COMMON /CEXPRS/ LSTACK, STACK(620) C C PROCESSES AN EQUIVALENCE STMT-FINDS DECLARATORS SEPARATED BY , C IF DIFFERENT TYPE VARIABLES INVOLVED, CHECKS FOR USE OF CORNER C ELEMENTS; ARDECL CALLED TO PROCESS DECLARATORS C SAME IS .TRUE. IF ALL ITEMS EQUIVALENCED IN ONE (--) ARE SAME TYPE C CORNR IS .TRUE. IF ALL ITEMS EQUIV. IN ONE (--) ARE CORNER ELES. C E.G. A(1,1,1) C 10 IF (STMT(PSTMT).EQ.65) GO TO 30 20 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) GO TO 150 30 TYPE = -1 IPT = 1 CORNR = .TRUE. SAME = .TRUE. 40 PSTMT = PSTMT + 1 IF (PSTMT.GE.NSTMT) GO TO 20 IF (.NOT.ARDECL(K2,KK)) GO TO 150 IF (SYSERR .OR. ERR) GO TO 150 C C KK>= 0 FOR AN ARRAY ELEMENT MEANS IT WASN'T A CORNER ELEMENT C L = IGATT1(IABS(KK),7) IF (KK.GT.0 .AND. L.GT.0) CORNR = .FALSE. KK = IABS(KK) C C SET USAGE, IF UNSET C L = IGATT1(KK,8) IF (L.EQ.0) CALL SATT1(KK, 8, 10) C C STORE VARIABLE IN STACK, CHECK VARIABLE TYPE C STACK(IPT) = KK IPT = IPT + 1 CALL SATT1(KK, 3, 1) I = IGATT1(KK,1) I = MOD(I,8) IF (-1.EQ.TYPE) TYPE = I IF (TYPE.EQ.I) GO TO 50 SAME = .FALSE. C C END OF DELARATOR CHECKS; NEED , OR ) C 50 IF (STMT(K2).NE.68) GO TO 60 PSTMT = K2 GO TO 40 60 IF (STMT(K2).NE.62) GO TO 20 C C CHECK FOR CORNER ELEMENTS IF ARRAY ELEMENTS WERE USED C IF (.NOT.SAME .AND. .NOT.CORNR) CALL ERROR1( * 53H WARNING - USE CORNER ELEMENTS WHEN MIXING DATA TYPES, 53) C C CHECK FOR ELEMENTS IN COMMON; MAKE SURE ONLY ONE COMMON C REGION APPEARS C KK = IPT - 1 C C PUT COMMON REGIONS OF EACH DECLARATOR (IF ANY) ON STACK C DO 80 I=1,KK L = IGATT1(STACK(I),2) IF (L) 80, 80, 70 70 IF(IPT+1.GT.LSTACK) GOTO 160 L = STACK(I) L = DSA(L+2) STACK(IPT) = DSA(L+1) IPT = IPT + 1 80 CONTINUE IF (KK+2.GE.IPT) GO TO 90 CALL ERROR1(40H EQUIVALENCE CONFLICTS WITH COMMON DEFNS, 40) GO TO 130 90 IF (KK+1.EQ.IPT) GO TO 130 C C MARK ALL DECLARATORS IN EQUIV (--) AS IF IN COMMON BLOCK C THAT ANY ONE OF THEM IS ACTUALLY IN C DO 120 I=1,KK L = IGATT1(STACK(I),2) IF (L.EQ.1) GO TO 120 CALL SATT1(STACK(I), 2, 1) L = STACK(I) IF (DSA(L+2)) 100, 100, 110 100 IF(NEXT+2.GE.BNEXT) GOTO 170 DSA(L+2) = NEXT DSA(NEXT) = 0 DSA(NEXT+1) = STACK(IPT-1) NEXT = NEXT + 2 GO TO 120 110 L = DSA(L+2) DSA(L+1) = STACK(IPT-1) 120 CONTINUE 130 IF (K2+1.EQ.NSTMT) GO TO 150 IF (STMT(K2+1).NE.68) GO TO 20 PSTMT = K2 + 2 GO TO 10 150 RETURN 160 CALL ERROR1(34H IN EQUIV, TABLE OVERFLOW OF STACK,34) 180 SYSERR = .TRUE. GOTO 150 170 CALL ERROR1(32H IN EQUIV, TABLE OVERFLOW OF DSA, 32) GOTO 180 END