![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to UNSAFE.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 UNSAFE.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 ! root 1: SUBROUTINE UNSAFE ! 2: C ! 3: C ROUTINE READS IN ALL DIRECT AND INDIRECT REFS FOR THE CURRENT ! 4: C PGM-UNIT; CHECKS FOR THE 3 UNSAFE REFS ! 5: C ! 6: LOGICAL IBR ! 7: INTEGER PLAT, PDSA, DSA, SYMLEN, PREF, REF, INREF, FINDCM ! 8: COMMON /CREF/ LREF, PREF, REF(100) ! 9: COMMON /GRAPH/ LLAT, PLAT, LAT(6000) ! 10: COMMON /FACTS/ NAME, I1, I2, IASF ! 11: COMMON /PARAMS/ I3, I4, I5, SYMLEN, I6, I7, I8 ! 12: COMMON /CTABL/ LDSA, PDSA, DSA(5000) ! 13: 10 IF (INREF(I7).LE.0) RETURN ! 14: C CHECK FOR REF WITHOUT ARGS ! 15: I = REF(1) ! 16: IF (I.EQ.0) GO TO 10 ! 17: LL = REF(2) ! 18: L = LL + SYMLEN + 1 ! 19: L = LAT(L) ! 20: C ! 21: C LPOINTS TO DUMMY ARGUMENT IN LAT ! 22: C ! 23: DO 70 K=1,I,2 ! 24: J = 4 + K ! 25: IF (REF(J).EQ.0) GO TO 20 ! 26: N = IGATT1(REF(J),8) ! 27: IF (N.EQ.10 .OR. N.EQ.4) GO TO 30 ! 28: GO TO 60 ! 29: C ! 30: C LOOK FOR EXPRESSION BEING MATCHED TO AN ARG WHICH ! 31: C IS SET; TYPE 1 UNSAFE REF ! 32: C ! 33: 20 IF (IGATT2(L,5).EQ.0) GO TO 60 ! 34: CALL ERROR2( ! 35: * 56H EXPRESSION MATCHED TO POSSIBLY SET ARG IN REFERENCE TO , ! 36: * 56, LAT(LL), 1, 1, 0) ! 37: CALL ERROR2(24H TYPE 1 UNSAFE REFERENCE, 24, REF(3), -1, 0, 1) ! 38: GO TO 60 ! 39: C ! 40: C CHECK FOR ACTUAL ARG IN COMMON BEING SENT DOWN WHERE RTNE ! 41: C BENEATH CHANGES ARG OR COMMON REGION ! 42: C TYPE 3 UNSAFE REFERENCE ! 43: C ! 44: 30 N = IGATT1(REF(J),2) ! 45: IF (N.NE.1) GO TO 40 ! 46: C ! 47: C SEE IF ACTUAL IS AN ARRAY ! 48: C ! 49: N = IGATT2(L,7) ! 50: IF (N.NE.0) GO TO 40 ! 51: N = REF(J) + 2 ! 52: N = DSA(N) ! 53: N = DSA(N+1) + 4 ! 54: N = FINDCM(DSA(N)) ! 55: NN = LL + SYMLEN + 2 ! 56: NN = MATCH(LAT(NN),2,N) ! 57: IF (NN.EQ.0) GO TO 40 ! 58: N = IGATT2(L,5) ! 59: IF (N.EQ.0 .AND. LAT(NN+1).EQ.0) GO TO 40 ! 60: CALL ERROR2(42H ARG OR COMMON MAY BE SET BY REFERENCE TO , 42, ! 61: * LAT(LL), 1, 1, 0) ! 62: CALL ERROR2(24H TYPE 3 UNSAFE REFERENCE, 24, REF(3), -1, 0, 1) ! 63: C ! 64: C CHECK FOR DO CONTROL VAR OR LIMIT MATCHED ! 65: C TO DUMMY ARG POSSIBLY SET ! 66: C ! 67: 40 NN = IGATT2(L,5) ! 68: IF (NN.EQ.0) GO TO 60 ! 69: NN = REF(J+1)/32 ! 70: IF (NN.NE.1) GO TO 50 ! 71: CALL ERROR2( ! 72: * 51H DO CONTROL VARIABLE OR LIMIT CAN BE SET IN REF TO , 51, ! 73: * LAT(LL), 1, 1, 0) ! 74: CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) ! 75: C ! 76: C CHECK FOR ADJUSTIBLE DIMENSION VARIABLE MATCHED TO DUMMY ! 77: C ARG POSSIBLY SET ! 78: C ! 79: 50 NN = REF(J+1)/64 ! 80: IF (NN.NE.1) GO TO 60 ! 81: CALL ERROR2( ! 82: * 52H ADJUSTIBLE DIMENSION VARIABLE CAN BE SET IN REF TO , ! 83: * 52, LAT(LL), 1, 1, 0) ! 84: CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) ! 85: 60 L = LAT(L+3) ! 86: 70 CONTINUE ! 87: C ! 88: C CHECK FOR SAME ACTUAL ARG SENT DOWN FOR DIFFERENT DUMMY-ARGS ! 89: C AND ONE OF DUMMIES MAY BE SET ! 90: C ! 91: C TYPE 2 UNSAFE REFERENCE ! 92: IF (REF(1).LE.2) GO TO 130 ! 93: LR = LL + SYMLEN + 1 ! 94: LR = LAT(LR) ! 95: C ! 96: C OUTER LOOP GOES TO NEXT TO LAST ARG ! 97: C ! 98: I = REF(1) + 3 ! 99: II = I - 2 ! 100: DO 120 K=5,II,2 ! 101: J = REF(K) ! 102: IF (J.EQ.0) GO TO 110 ! 103: JBR = IGATT1(J,8) ! 104: IF (JBR.NE.10 .AND. JBR.NE.4) GO TO 110 ! 105: L = LAT(LR+3) ! 106: MM = K + 2 ! 107: DO 100 M=MM,I,2 ! 108: IF (REF(M).NE.J) GO TO 90 ! 109: C ! 110: C HAVE TWO ACTUALS MAPPED ONTO DIFFERENT DUMMIES ! 111: C ! 112: C IF BOTH DUMMIES ARE ARRAYS OR BOTH ARE UNSET, NO UNSAFE ! 113: IF( IGATT2(L,7).NE.0 .AND. IGATT2(LR,7).NE.0 ) GOTO 90 ! 114: IF( IGATT2(L,5).EQ.0 .AND. IGATT2(LR,5).EQ.0 ) GOTO 90 ! 115: 80 CALL ERROR2(64 ! 116: *H ACTUAL ARG ASSOCIATED WITH 2 DUMMY ARGS POSSIBLY SET IN REF TO ! 117: *, 64, LAT(LL), 1, 1, 0) ! 118: CALL ERROR2(24H TYPE 2 UNSAFE REFERENCE, 24, REF(3), -1, 0, 1) ! 119: 90 L = LAT(L+3) ! 120: 100 CONTINUE ! 121: 110 LR = LAT(LR+3) ! 122: 120 CONTINUE ! 123: C ! 124: C CHECK FOR EXTERNAL FCNS WITHIN ASF-DEFS WHICH CONTAIN ! 125: C ASF-DUMMIES AND WHICH SET THEIR ARGS ! 126: C ! 127: 130 IF (REF(4).NE.1) GO TO 10 ! 128: II = REF(1) + 3 ! 129: IBR = .FALSE. ! 130: DO 140 K=5,II,2 ! 131: J = REF(K) ! 132: IF (J.EQ.0) GO TO 140 ! 133: IF (IGATT1(J,8).EQ.1) IBR = .TRUE. ! 134: 140 CONTINUE ! 135: IF (.NOT.IBR) GO TO 10 ! 136: C ! 137: C SEE IF EXTERNAL FCN SETS ANY OF ITS ARGS ! 138: C ! 139: K = LL + SYMLEN + 1 ! 140: K = LAT(K) ! 141: II = REF(1)/2 ! 142: DO 150 L=1,II ! 143: IF (IGATT2(K,8).EQ.10 .AND. IGATT2(K,5).EQ.1) IBR = .FALSE. ! 144: 150 CONTINUE ! 145: IF (IBR) GO TO 10 ! 146: CALL ERROR2(37H ILLEGAL USAGE OF ASF-DUMMY IN REF TO, 37, ! 147: * LAT(LL), 1, 1, 0) ! 148: CALL ERROR2(1H , 0, REF(3), -1 ,0, 1) ! 149: GO TO 10 ! 150: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.