![[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.