![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to EQUIV.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / pfort|
Return to EQUIV.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 ! root 1: SUBROUTINE EQUIV ! 2: INTEGER STMT, PSTMT, PDSA, DSA, TYPE, STACK, BNEXT, SYMHD ! 3: LOGICAL ARDECL, CORNR, SAME, ERR, SYSERR, ABORT ! 4: COMMON /DETECT/ ERR, SYSERR, ABORT ! 5: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) ! 6: COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT ! 7: COMMON /CTABL/ LDSA, PDSA, DSA(5000) ! 8: COMMON /CEXPRS/ LSTACK, STACK(620) ! 9: C ! 10: C PROCESSES AN EQUIVALENCE STMT-FINDS DECLARATORS SEPARATED BY , ! 11: C IF DIFFERENT TYPE VARIABLES INVOLVED, CHECKS FOR USE OF CORNER ! 12: C ELEMENTS; ARDECL CALLED TO PROCESS DECLARATORS ! 13: C SAME IS .TRUE. IF ALL ITEMS EQUIVALENCED IN ONE (--) ARE SAME TYPE ! 14: C CORNR IS .TRUE. IF ALL ITEMS EQUIV. IN ONE (--) ARE CORNER ELES. ! 15: C E.G. A(1,1,1) ! 16: C ! 17: 10 IF (STMT(PSTMT).EQ.65) GO TO 30 ! 18: 20 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) ! 19: GO TO 150 ! 20: 30 TYPE = -1 ! 21: IPT = 1 ! 22: CORNR = .TRUE. ! 23: SAME = .TRUE. ! 24: 40 PSTMT = PSTMT + 1 ! 25: IF (PSTMT.GE.NSTMT) GO TO 20 ! 26: IF (.NOT.ARDECL(K2,KK)) GO TO 150 ! 27: IF (SYSERR .OR. ERR) GO TO 150 ! 28: C ! 29: C KK>= 0 FOR AN ARRAY ELEMENT MEANS IT WASN'T A CORNER ELEMENT ! 30: C ! 31: L = IGATT1(IABS(KK),7) ! 32: IF (KK.GT.0 .AND. L.GT.0) CORNR = .FALSE. ! 33: KK = IABS(KK) ! 34: C ! 35: C SET USAGE, IF UNSET ! 36: C ! 37: L = IGATT1(KK,8) ! 38: IF (L.EQ.0) CALL SATT1(KK, 8, 10) ! 39: C ! 40: C STORE VARIABLE IN STACK, CHECK VARIABLE TYPE ! 41: C ! 42: STACK(IPT) = KK ! 43: IPT = IPT + 1 ! 44: CALL SATT1(KK, 3, 1) ! 45: I = IGATT1(KK,1) ! 46: I = MOD(I,8) ! 47: IF (-1.EQ.TYPE) TYPE = I ! 48: IF (TYPE.EQ.I) GO TO 50 ! 49: SAME = .FALSE. ! 50: C ! 51: C END OF DELARATOR CHECKS; NEED , OR ) ! 52: C ! 53: 50 IF (STMT(K2).NE.68) GO TO 60 ! 54: PSTMT = K2 ! 55: GO TO 40 ! 56: 60 IF (STMT(K2).NE.62) GO TO 20 ! 57: C ! 58: C CHECK FOR CORNER ELEMENTS IF ARRAY ELEMENTS WERE USED ! 59: C ! 60: IF (.NOT.SAME .AND. .NOT.CORNR) CALL ERROR1( ! 61: * 53H WARNING - USE CORNER ELEMENTS WHEN MIXING DATA TYPES, 53) ! 62: C ! 63: C CHECK FOR ELEMENTS IN COMMON; MAKE SURE ONLY ONE COMMON ! 64: C REGION APPEARS ! 65: C ! 66: KK = IPT - 1 ! 67: C ! 68: C PUT COMMON REGIONS OF EACH DECLARATOR (IF ANY) ON STACK ! 69: C ! 70: DO 80 I=1,KK ! 71: L = IGATT1(STACK(I),2) ! 72: IF (L) 80, 80, 70 ! 73: 70 IF(IPT+1.GT.LSTACK) GOTO 160 ! 74: L = STACK(I) ! 75: L = DSA(L+2) ! 76: STACK(IPT) = DSA(L+1) ! 77: IPT = IPT + 1 ! 78: 80 CONTINUE ! 79: IF (KK+2.GE.IPT) GO TO 90 ! 80: CALL ERROR1(40H EQUIVALENCE CONFLICTS WITH COMMON DEFNS, 40) ! 81: GO TO 130 ! 82: 90 IF (KK+1.EQ.IPT) GO TO 130 ! 83: C ! 84: C MARK ALL DECLARATORS IN EQUIV (--) AS IF IN COMMON BLOCK ! 85: C THAT ANY ONE OF THEM IS ACTUALLY IN ! 86: C ! 87: DO 120 I=1,KK ! 88: L = IGATT1(STACK(I),2) ! 89: IF (L.EQ.1) GO TO 120 ! 90: CALL SATT1(STACK(I), 2, 1) ! 91: L = STACK(I) ! 92: IF (DSA(L+2)) 100, 100, 110 ! 93: 100 IF(NEXT+2.GE.BNEXT) GOTO 170 ! 94: DSA(L+2) = NEXT ! 95: DSA(NEXT) = 0 ! 96: DSA(NEXT+1) = STACK(IPT-1) ! 97: NEXT = NEXT + 2 ! 98: GO TO 120 ! 99: 110 L = DSA(L+2) ! 100: DSA(L+1) = STACK(IPT-1) ! 101: 120 CONTINUE ! 102: 130 IF (K2+1.EQ.NSTMT) GO TO 150 ! 103: IF (STMT(K2+1).NE.68) GO TO 20 ! 104: PSTMT = K2 + 2 ! 105: GO TO 10 ! 106: 150 RETURN ! 107: 160 CALL ERROR1(34H IN EQUIV, TABLE OVERFLOW OF STACK,34) ! 108: 180 SYSERR = .TRUE. ! 109: GOTO 150 ! 110: 170 CALL ERROR1(32H IN EQUIV, TABLE OVERFLOW OF DSA, 32) ! 111: GOTO 180 ! 112: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.