![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to PROC.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 PROC.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 root 1: SUBROUTINE PROC(IP, IM, IIM, OK)
2: C
3: C P.U. AT LAT(IP) CALLS P.U. AT LAT(IM) (NODE(IIM))
4: C PROC COLLECTS ACTUAL PROC TEMPLATE(S) FROM THE CALL IF IT CAN
5: C CHECKS FOR MISSING SUBPGMS AND STORES TEMPLATES OFF PGM UNIT
6: C AT LAT(IM), THEM PROC CALLS ASLEV TO READJUST LEVELS OF ACTUALS
7: C SENT TO LAT(IM) VS LEVEL (IM)
8: C
9: LOGICAL ERR, SYSERR, ABORT, OK
10: INTEGER STACK, SYMLEN, PDSA, DSA, REF, PREF, PNODE, PLAT, FINDND,
11: * FIND, SS(120), KBR(1)
12: COMMON /CEXPRS/ LSTACK, STACK(620)
13: COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
14: COMMON /CTABL/ LDSA, PDSA, DSA(5000)
15: COMMON /CREF/ LREF, PREF, REF(100)
16: COMMON /HEAD/ LNODE, PNODE, NODE(500)
17: COMMON /SCR1/ LINODE, INODE(500)
18: COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
19: COMMON /DETECT/ ERR, SYSERR, ABORT
20: EQUIVALENCE (SS(1),STACK(501))
21: DATA KBR(1) /0/
22: LSS = 501
23: C ARE THERE ARGS IN THIS REF
24: IF (REF(1).NE.0) GO TO 20
25: 10 RETURN
26: C CYCLE THROUGH REF ARGS
27: C JJ IS LAST ENTRY IN REF FOR ARGS
28: C IS PTS TO FIRST FREE WD IN STACK
29: C MAX IS 1 IF NO DUMMY PROCS IN REF, ELSE IS EQUAL TO THE
30: C NUMBER OF ACTUAL PROCS SUBSTITUTABLE FOR THE DUMMY PROCS
31: 20 JJ = REF(1) + 4
32: IS = 1
33: MAX = 0
34: DO 90 I=5,JJ,2
35: C SKIP OVER EXPR AS ACTUAL ARGS AND ALL ACTUALS BUT PROC ARGS
36: IF (REF(I).EQ.0) GO TO 90
37: IF (REF(I+1).NE.6) GO TO 90
38: C SEE IF ACTUAL ARG IS DUMMY PROC ARG AT LAT(IP)
39: C OR ACTUAL PROCEDURE
40: IF (IGATT1(REF(I),4).EQ.1) GO TO 40
41: C HAVE AN ACTUAL PROCEDURE
42: L = REF(I)
43: L = FINDND(DSA(L+4),K)
44: IF (L.NE.0) GO TO 30
45: C IF, AS GATHERING ACTUAL PROCS MATCHED TO DUMMY PROC ARGS
46: C PROC FINDS A MISSING SUBPROGM, PROCESSING OF THIS REF CEASES
47: L = REF(I)
48: CALL ERROR2(20H MISSING SUBPROGRAM , 20, DSA(L+4), 1, 1, 0)
49: CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
50: GO TO 10
51: 30 IF (IS+2.GT.LSS) GO TO 200
52: C 2 WD STACK ENTRY FOR AN ACTUAL PROC AS AN ACTUAL ARG
53: C IS FIRST WD - 1, 2ND WD - LAT INDEX OF ACTUAL PROC
54: STACK(IS) = 1
55: STACK(IS+1) = L
56: IF (MAX.EQ.0) MAX = 1
57: IS = IS + 2
58: GO TO 90
59: C HAVE A DUMMY PROC CHECK OUT NO OF ACTUALS
60: C MATCHED TO IT AND STACK THOSE WITH COUNTER ON TOP
61: 40 L = IP + SYMLEN + 5
62: L = LAT(L)
63: IF (L.NE.0) GO TO 50
64: IF (.NOT.OK) GOTO 10
65: CALL ERROR2(26H MISSING ACTUAL PROCEDURES ,26, KBR(1), -1,1,1)
66: OK = .FALSE.
67: GO TO 10
68: C COLLECT ACTUALS CORRESPONDING TO THIS PROC ARG
69: C K IS REL POSIT OF PROC ARG AMONG ALL ARGS AT LAT(IP)
70: C L PTS TO TEMPLATE AT LAT(IP)
71: 50 K = REF(I)
72: K = DSA(K+2)
73: C J POINTS TO FIRST ELEMENT ON ARGLIST
74: J = IP + SYMLEN + 1
75: J = LAT(J)
76: IF (K.LE.1) GO TO 70
77: DO 60 LL=2,K
78: J = LAT(J+3)
79: 60 CONTINUE
80: C K IS REL POSIT OF PROC ARG AMONG PROC ARGS IN LAT(IP)
81: C THAT IS IT IS OFFSET NECESS TO READ CORRESP ACTUAL
82: C PROCS OFF TEMPLATES AT LAT(IP)
83: C J POINTS TO DUMMY PROC ARG ENTRY IN LAT (IP)
84: 70 K = LAT(J+1)
85: IF (IS+1.GE.LSS) GO TO 200
86: C J POINTS TO POSITION IN STACK OF COUNT OF HOW MANY
87: C ACTUALS ARE MATCHED TO THIS DUMMY
88: J = IS
89: STACK(IS) = 0
90: IS = IS + 1
91: 80 IF (IS+1.GE.LSS) GO TO 200
92: C N WD STACK ENTRY FOR DUMMY PROC ARGS USED AS ACTUAL ARGS IN REF
93: C WD 1 CONTAINS NO OF ACTUAL PROCS MATCHED TO THE DUMMY
94: C WDS 2 - N CONTAIN THE LAT INDICES OF EACH ACTUAL PROC
95: STACK(J) = STACK(J) + 1
96: LL = K + L
97: STACK(IS) = LAT(LL)
98: IS = IS + 1
99: L = LAT(L) + L
100: L = LAT(L)
101: IF (L.NE.0) GO TO 80
102: IF (STACK(J).GT.MAX) MAX = STACK(J)
103: 90 CONTINUE
104: C HAVE COLLECTED ALL PROC ACTUALS CORRESP TO THE PROC
105: C ARGS IN THE REF, NOTE MAX IS NO OF TEMPLATES RESULTING FROM
106: C THIS REF TO BE PASSED TO LAT(IM) AS LONG AS THEIR DUPS
107: C ARE NOT THERE ALREADY
108: C BUILD EACH TEMPLATE IN LOOP AND CHECK FOR DUPLICATION
109: C IF NOT THERE COPY INTO LAT OFF LAT(IM) AND CHECK LEVEL OF ACTUALS
110: C PASSED DOWN VS LEVEL OF LAT(IM)
111: IF (MAX.EQ.0) GO TO 10
112: DO 190 I=1,MAX
113: C CREATE PROC INDICES PORTION OF TEMPLATE IN SS
114: K = 1
115: ISS = 1
116: 100 IF (K.GE.IS) GO TO 110
117: L = 1
118: IF (STACK(K).GT.1) L = I
119: IF (ISS+1.GE.120) GO TO 200
120: J = K + L
121: SS(ISS) = STACK(J)
122: K = K + STACK(K) + 1
123: ISS = ISS + 1
124: GO TO 100
125: C HAVE TEMPLATE IN SS(1) THROUGH SS(ISS-1)
126: C SEE IF IT HAS A DUPLICATE AT LAT(IM)
127: 110 K = IM + SYMLEN + 5
128: K = LAT(K)
129: IST = ISS - 1
130: 120 IF (K.EQ.0) GO TO 150
131: DO 130 L=1,IST
132: J = K + L
133: IF (LAT(J).NE.SS(L)) GO TO 140
134: 130 CONTINUE
135: C FOUND DUPLICATE
136: GO TO 190
137: C HAVENT FOUND A DUPLICATE YET
138: C SEE IF THERE ARE MORE TEMPLATES TO COMPARE
139: 140 K = LAT(K) + K
140: K = LAT(K)
141: GO TO 120
142: C NOT A DUPLICATE WILL ADD IT ON
143: 150 IF (PLAT+IST+2.LE.LLAT) GO TO 160
144: CALL ERROR1(32H IN PROC, TABLE OVERFLOW OF LAT , 32)
145: SYSERR = .TRUE.
146: GO TO 10
147: C MAKE AN ENTRY CONSISTING OF 1ST WORD - NO OF PROCS+1, SUBSEQUENT
148: C WORDS - PROCS LAT INDICES, LAST WORD - PTR
149: C TO NEXT SUCH TEMPLATE
150: 160 DO 170 L=1,IST
151: J = PLAT + L
152: LAT(J) = SS(L)
153: 170 CONTINUE
154: LAT(PLAT) = IST + 1
155: L = PLAT
156: PLAT = PLAT + IST + 2
157: J = IM + SYMLEN + 5
158: LAT(PLAT-1) = LAT(J)
159: LAT(J) = L
160: C CHECK LEVELS
161: DO 180 L=1,IST
162: J = FIND(SS(L))
163: C FIND HEAD OF GREEN LINKS LIST AT LAT(IM)
164: JR = IM + SYMLEN + 3
165: JLR = -SS(L)
166: 210 IF(LAT(JR+1) .LE. 0) GOTO 220
167: JR = LAT(JR+1)
168: GOTO 210
169: C HAVE TOP OF GREEN LINKS LIST AT LAT(JR)
170: 220 IF(LAT(JR+1) .EQ. 0) GOTO 230
171: JR = IABS( LAT(JR+1) )
172: C LOOK FOR DUPLICATE ENTRY ON GREEN LINKS LIST
173: IF(LAT(JR) .EQ. JLR) GOTO 240
174: GOTO 220
175: C ADD ON ENTRY TO GREEN LINKS LIST
176: 230 IF(PLAT + 2 .GT. LLAT) GOTO 250
177: LAT(PLAT) = JLR
178: LAT(PLAT+1) = 0
179: LAT(JR+1) = -PLAT
180: PLAT = PLAT+2
181: 240 IF((-1).EQ.INODE(J) .OR. (-2).EQ.INODE(J) .OR.
182: * INODE(J).GT.INODE(IIM)) GOTO 180
183: INODE(J) = INODE(IIM) + 1
184: CALL ASLEV (-J)
185: IF (SYSERR .OR. ABORT) GO TO 10
186: 180 CONTINUE
187: 190 CONTINUE
188: GO TO 10
189: 200 SYSERR = .TRUE.
190: CALL ERROR1(33H IN PROC, TABLE OVERFLOW OF STACK, 33)
191: GO TO 10
192: 250 SYSERR = .TRUE.
193: CALL ERROR1(31H IN PROC, TABLE OVERFLOW OF LAT,31)
194: GOTO 10
195: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.