![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to SETREF.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 SETREF.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 root 1: SUBROUTINE SETREF(GREEN,INDIR)
2: INTEGER CHK1, KBR(1)
3: INTEGER REF, PREF, PDSA, DSA, PLAT, PNODE, FINDND, SYMLEN
4: LOGICAL ERR, SYSERR, ABORT, COMPAR, GREEN, INDIR
5: COMMON /HEAD/ LNODE, PNODE, NODE(500)
6: COMMON/ SCR1/ LINODE, INODE(500)
7: COMMON /FACTS/ NAME, NOST, ITYP, IASF
8: COMMON /CREF/ LREF, PREF, REF(100)
9: COMMON /CTABL/ LDSA, PDSA, DSA(5000)
10: COMMON /DETECT/ ERR, SYSERR, ABORT
11: COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
12: COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
13: COMMON /TABL/ NEXT, LABHD, ISYM, IBNEXT
14: DATA IBR /1/, JBR /3/, KBR(1) /0/
15: C
16: C GREEN = T IF ENCOUNTER EXTERNAL ENTITIES AT ALL
17: C INDIR = T IF ENCOUNTER ANY INDIRECT REFS
18: C READS IN ALL REFS FOR A PROGRAM UNIT; FINDS MISSING
19: C SUBPROGRAM REFS AND DISCARDS THEM; CHECKS ASF REFS AND
20: C DISCARDS THEM; WRITES INDIRECT REFS OUT ON I6 WITHOUT
21: C PROCESSING; DOES MINIMAL CHECKING OF DIRECT REFS
22: C CREATING PAR/DESC LINKS AND WRITING GOOD
23: C REFS OUT ON I6, AFTER DONE WITH REFS, SEARCHES
24: C FOR EXTERNAL ENTITIES (USAGE 13) TO FIX UP LEVELS
25: C
26: IJK = FINDND(DSA(NAME+4),IIJK)
27: C READ IN A NEW REF; IF HIT END OF REFS RECORD
28: C END OF REFS ON I6 AND RETURN
29: 10 IF (INREF(I5)) 20, 20, 80
30: C WRITE END OF REFS
31: 20 WRITE (I6) IBR, JBR, IBR
32: C CHECK FOR NON DUMMY EXTERNALS IN SYMBOL TABLE WHICH
33: C C AUSE CHANGES IN LEVEL CALCS
34: K = ISYM
35: 30 IF (K) 40, 40, 50
36: 150 SYSERR=.TRUE.
37: CALL ERROR1(33H IN SETREF, TABLE OVERFLOW OF LAT,33)
38: 40 RETURN
39: 50 IF (IGATT1(K,8).NE.13 .OR. IGATT1(K,4).EQ.1) GO TO 70
40: L = FINDND(DSA(K+4),IL)
41: IF (L.NE.0) GO TO 60
42: CALL ERROR2(18H MISSING EXTERNAL , 18, DSA(K+4), 1, 1, 0)
43: CALL ERROR2(1H1,0,KBR(1),-1, 0, 1)
44: GO TO 70
45: C FOUND AN EXTERNAL ENTITY
46: 60 GREEN = .TRUE.
47: C ENTER ONTO GREEN LINKS LIST AT NODE
48: N = IJK + SYMLEN + 3
49: C J IS HEAD OF GREEN LINKS LIST (SEE SETPD)
50: 160 IF(LAT(N+1).LE.0) GOTO 170
51: N = LAT(N+1)
52: GOTO 160
53: 170 J = N+1
54: IF(PLAT+2.GT.LLAT) GOTO 150
55: LAT(PLAT) = -L
56: LAT(PLAT+1) = LAT(J)
57: LAT(J) = -PLAT
58: PLAT = PLAT+2
59: IF(-2.EQ.INODE(IL).OR.INODE(IL).GT.INODE(IIJK)) GOTO 70
60: INODE(IL) = INODE(IIJK) + 1
61: CALL ASLEV(-IL)
62: IF (ABORT .OR. SYSERR) GO TO 40
63: 70 K = DSA(K+3)
64: GO TO 30
65: C
66: C REF IS WD1--NUMBER OF ARGS(2 WD ENTRIES)
67: C WD2--PTR TO PGM UNIT CALLED IN DSA
68: C WD3--STMT NO OF CALL
69: C WD4--CODE, 0 FOR SUBR REFS; 1 FOR FCN REFS
70: C WD5+-ARG ENTRIES (WD1-SYMBOL TABLE INDEX OR 0
71: C WD2-TYPE/STRUCTURE INFO)
72: C
73: 80 IF (REF(4).LT.4) GO TO 100
74: C
75: C ASF REFERENCE; CHECKED AND THEN DISCARDED
76: C
77: K1 = PNODE - 1
78: DO 90 I=1,K1
79: IF (NODE(I).GE.0) GO TO 90
80: IJR = IABS(NODE(I))
81: L = IJR + SYMLEN + 3
82: L = LAT(L)
83: K = REF(2)
84: C
85: C IF HAVE ASF REF, FIND ASF BY NAME AND PAR CHECKS
86: C
87: IF (COMPAR(DSA(K+4),LAT(IJR)) .AND. LAT(L).EQ.IJK) GO TO 110
88: 90 CONTINUE
89: L = REF(2) + 4
90: CALL ERROR2(18H MISSING ASF DEFN , 18, DSA(L), 1, 1, 0)
91: CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
92: GO TO 10
93: C
94: C WRITE INDIRECT REF OUT ON I6
95: C
96: 100 K2 = IGATT1(REF(2),4)
97: IF(K2.EQ.0) GOTO 140
98: INDIR = .TRUE.
99: GOTO 130
100: C CHECK FOR MISSING SUBPROGRAM
101: 140 K1 = REF(2)
102: IJR = FINDND(DSA(K1+4),IIJR)
103: IF (IJR.NE.0) GO TO 110
104: CALL ERROR2(20H MISSING SUBPROGRAM , 20, DSA(K1+4), 1
105: * ,1, 0)
106: CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
107: GO TO 10
108: C CHECK DIRECT REFS AND ASF REFS
109: C 1 MEANS OK 0 MEANS N.G.
110: 110 IF (CHK1(IJK,IJR)) 10, 10, 120
111: 120 IF (REF(4).EQ.4) GO TO 10
112: C GOOD DIRECT REF; CREATE PAR/DES LINKS
113: CALL SETPD(IJR, IJK)
114: IF (SYSERR) GO TO 40
115: IF (-2.EQ.INODE(IIJR) .OR. INODE(IIJR).GT.INODE(IIJK)) GO TO 130
116: C FIX UP LEVELS
117: INODE(IIJR) = INODE(IIJK) + 1
118: CALL ASLEV(IIJR)
119: IF (SYSERR .OR. ABORT) GO TO 40
120: 130 WRITE (I6) PREF, IBR, (REF(L),L=1,PREF)
121: GO TO 10
122: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.