![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to CONSTR.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 CONSTR.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 root 1: SUBROUTINE CONSTR(MAINND)
2: LOGICAL SYSERR, ERR, ABORT, INSYM, GREEN, INDIR
3: LOGICAL OVER
4: C NOTE SETNOD SETS ABORT FOR 2 P.U. WITH SAME NAME
5: C CONSTR SETS ABORT IF IT FINDS NO SYMBOL TABLES FROM PASS1
6: C ASLEV SETS ABORT IF IT FINDS RECURSION IN CALLING GRAPH
7: INTEGER OUTUT2, OUTUT3, OUTUT4, SYMLEN
8: INTEGER PNODE, PLAT, LS(2)
9: COMMON /HEAD/ LNODE, PNODE, NODE(500)
10: COMMON /SCR1/ LINODE, INODE(500)
11: COMMON /PARAMS/ I1, I2, I3, SYMLEN, OUTUT2, OUTUT3, OUTUT4
12: COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
13: COMMON /DETECT/ ERR, SYSERR, ABORT
14: DATA IBR /1/, JBR /4/
15: DATA LS(1) /1H,/, LS(2) /1H /
16: C
17: C CONSTR DIRECTS THE FIRST PORTION OF PASS2
18: C CALLS SETNOD TO CONSTRUCT THE LAT NODES FOR EACH P.U..
19: C CALLS SETEXT TO SETUP BASIC EXERNALS NODES
20: C AS NEEDED.
21: C CALLS SETREF TO MAKE CONNECTS BETWEEN THE NODES
22: C CALLS INVOKE TO CALCULATE LEVELS AND ASSIMILATE
23: C ALL PROC INFO NECESSARY
24: C CALLS ERASE TO GET RID OF NON-REFERENCE LINKS IN
25: C CALLING GRAPH
26: C CALLS CHKALL TO DO FINAL CHECKS OF ALL REFS AND TO
27: C WRITE ALL GOOD REFS OUT FOR FUTURE PROCESSING
28: C FORMS SUPERROOT IN GRAPH
29: C CALLS OUTPUT ROUTINES WHENEVER CAN, TO GIVE PARTIAL
30: C LISTINGS OF CURRENT DATA STRUCTURE
31: C
32: C USE INSYM TO POSSIBLY SKIP OVER BAD REFS WITH DUMMY SYM TBL
33: C SETREF READS REFS FROM OUTUT3, WRITES ON OUTUT4
34: C INVOKE READS FROM OUTUT4
35: C CHKALL READS FROM OUTUT4, WRITES OUTUT3
36: C UNSAFE READS FROM OUTUT3
37: C INITIALIZE LEVEL ARRAY AND ISR
38: ISR = 0
39: DO 10 I=1,LNODE
40: INODE(I) = 0
41: 10 CONTINUE
42: C INITIALIZE LOGICAL FLAGS FOR DETECTION OF PRESENCE OF
43: C EXTERNAL ENTITIES (GREEN) AND INDIRECT REFS(INDIR)
44: GREEN = .FALSE.
45: INDIR = .FALSE.
46: 20 IF(.NOT.INSYM(0,0)) GOTO 30
47: C
48: C SUCCESSFULLY READ SYMBOL TABLE
49: C
50: CALL SETNOD
51: IF (SYSERR .OR. ABORT) GO TO 130
52: GO TO 20
53: 30 REWIND OUTUT2
54: IF (PNODE.EQ.1) GO TO 150
55: C CHANGE LEVEL ON ASFS SO DONT PROCESS THEM
56: L = PNODE - 1
57: DO 40 I=1,L
58: IF (NODE(I).LT.0) INODE(I) = -2
59: 40 CONTINUE
60: C
61: C SETUP BASIC EXTERNAL DEFNS AS NEEDED
62: C
63: CALL SETEXT
64: IF (SYSERR) GO TO 130
65: C
66: C READ IN SYMBOL TABLES
67: C SETREF WILL READ IN REFS
68: C
69: 50 IF(.NOT.INSYM(OUTUT3, OUTUT4)) GOTO 60
70: CALL SETREF ( GREEN, INDIR )
71: IF (SYSERR .OR. ABORT) GO TO 130
72: GO TO 50
73: 60 REWIND OUTUT2
74: REWIND OUTUT3
75: WRITE (OUTUT4) IBR, JBR, IBR
76: REWIND OUTUT4
77: IF(.NOT.INDIR) GOTO 70
78: C
79: C CALL LEVEL ALG
80: C
81: CALL INVOKE
82: IF (ABORT .OR. SYSERR) GO TO 130
83: REWIND OUTUT2
84: REWIND OUTUT4
85: C
86: C CHECK AND EXPAND REFS AND SAVE ALL GOOD ONES FOR LATER
87: C
88: 70 IF(.NOT.INSYM(OUTUT4,OUTUT3)) GOTO 80
89: CALL CHKALL
90: IF (SYSERR) GO TO 130
91: GO TO 70
92: 80 WRITE (OUTUT3) IBR, JBR, IBR
93: C
94: C CONSTRUCT SUPEROOT IN LAT
95: C
96: IF (PNODE+1.GT.LNODE) GO TO 180
97: IF (PLAT+SYMLEN+7.GT.LLAT) GO TO 160
98: NODE(PNODE) = PLAT
99: C MAINND IS SUPEROOT INDEX IN NODE
100: C ISR IS SUPEROOT INDEX IN LAT
101: MAINND = PNODE
102: ISR = PLAT
103: PNODE = PNODE + 1
104: LAT(PLAT) = LS(1)
105: PLAT = PLAT + 1
106: IF (SYMLEN.EQ.1) GO TO 100
107: DO 90 I=2,SYMLEN
108: L = PLAT + I - 2
109: LAT(L) = LS(2)
110: 90 CONTINUE
111: PLAT = L + 1
112: 100 L = PLAT + 5
113: DO 110 I=PLAT,L
114: LAT(I) = 0
115: 110 CONTINUE
116: LAT(L+1) = 5
117: PLAT = L + 2
118: C
119: C LOOK FOR CALLABLE PGM UNITS WITHOUT PARENTS
120: C
121: L = PNODE - 2
122: DO 120 I=1,L
123: K = SYMLEN + 3 + IABS(NODE(I))
124: IF (LAT(K).EQ.0) CALL SETPD(IABS(NODE(I)), ISR)
125: IF (SYSERR) GO TO 130
126: 120 CONTINUE
127: 130 IF(.NOT.GREEN) GOTO 190
128: C ERASE GREEN LINKS
129: L = PNODE - 2
130: DO 210 I = 1,L
131: C SKIP ASF NODES
132: IF(NODE(I) .LT. 0) GOTO 210
133: C FIND HEAD OF GREEN LINKS
134: N = NODE(I) + SYMLEN + 3
135: 220 IF(LAT(N+1) .LE. 0) GOTO 230
136: N = LAT(N+1)
137: GOTO 220
138: 230 LAT(N+1) = 0
139: 210 CONTINUE
140: 190 OVER = SYSERR
141: SYSERR = .FALSE.
142: CALL OUT2 (ISR)
143: SYSERR = SYSERR.OR.OVER
144: IF(SYSERR) CALL ERROR1(
145: * 56H ILLEGAL COMMON USAGE AND UNSAFE REFERENCES NOT VERIFIED,
146: * 56)
147: CALL OUT2C
148: 140 RETURN
149: 150 ABORT = .TRUE.
150: GO TO 140
151: 160 CALL ERROR1(33H IN CONSTR, TABLE OVERFLOW OF LAT, 33)
152: 170 SYSERR = .TRUE.
153: GO TO 130
154: 180 CALL ERROR1(34H IN CONSTR, TABLE OVERFLOW OF NODE, 34)
155: GO TO 170
156: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.