![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to INVOKE.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / pfort|
Return to INVOKE.f CVS log | Up to [Research Unix] / researchv10dc / cmd / pfort |
1.1 root 1: SUBROUTINE INVOKE
2: C
3: C PGM UNIT STEPS THROUGH NODES IN INVOCATION ORDER
4: C PUSHING ACTUAL PROC ARGS DOWN LATTICE WHERE NECESSARY
5: C AND READJUSTING LEVEL IF NECESSARY
6: C
7: INTEGER PNODE, PLAT, PDSA, DSA, SYMLEN, PREF, REF, FIND, CHK1,
8: * ZERO(1), FINDND
9: LOGICAL ERR, SYSERR, ABORT, OK, AOK
10: COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
11: COMMON /DETECT/ ERR, SYSERR, ABORT
12: COMMON /HEAD/ LNODE, PNODE, NODE(500)
13: COMMON /SCR1/ LINODE, INODE(500)
14: COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
15: COMMON /CTABL/ LDSA, PDSA, DSA(5000)
16: COMMON /CREF/ LREF, PREF, REF(100)
17: COMMON /FACTS/ NAME, NOST, ITYPE, IASF
18: DATA ZERO(1)/0/
19: C NC IS CURRENT NODE, NP IS PREVIOUS NODE PROCESSED
20: NC = 0
21: 10 NP = NC
22: OK = .TRUE.
23: AOK = .TRUE.
24: C
25: C SEARCH FOR NEXT NODE TO DO, NODE WITH LOWEST POSIT LEVEL IN INODE
26: C UPON ENTRY TO INVOKE, SUPEROOT IS -1, ASFS AND BLOCK DATA
27: C ARE -2. IF CANT FIND A POSITIVE LEVEL ARE DONE
28: C
29: L = PNODE - 1
30: DO 20 I=1,L
31: IF (INODE(I).LT.0) GO TO 20
32: NC = I
33: GO TO 40
34: 20 CONTINUE
35: 30 RETURN
36: 40 J = NC
37: DO 50 I=J,L
38: IF (INODE(I).GE.0 .AND. INODE(I).LT.INODE(NC)) NC = I
39: 50 CONTINUE
40: C READ IN SYMBOL TABLE FOR NODE(NC) AND POSITION REFS CORRECTLY
41: CALL RDSYM(NC, NP)
42: 60 IF (INREF(I6)) 140, 140, 70
43: C HAVE A REFERENCE TO PROCESS
44: 70 IF (IGATT1(REF(2),4).EQ.1) GO TO 80
45: C PROCESSING A DIRECT REFERENCE
46: C NEED ONLY PROCESS REF TEMPLATE IF ANY PROC ACTUAL ARGS IN REF
47: L = REF(2)
48: L = FINDND(DSA(L+4),K)
49: CALL PROC(NODE(NC), L, K, AOK)
50: IF (SYSERR .OR. ABORT) GO TO 30
51: GO TO 60
52: C PROCESSING AN INDIRECT REF
53: 80 K = NODE(NC) + SYMLEN + 5
54: K = LAT(K)
55: IF (K.EQ.0) GO TO 150
56: C K PTS TO A TEMPLATE OF ACTUALS AT LAT(NODE(NC))
57: C L GIVES REL POSIT AMONG PROC DUMMIES IN LAT(NODE(NC))
58: C OF PROC DUMMY BEING CALLED
59: L = REF(2)
60: L = DSA(L+2)
61: I = NODE(NC) + SYMLEN + 1
62: I = LAT(I)
63: IF (L.EQ.1) GO TO 100
64: DO 90 M=2,L
65: I = LAT(I+3)
66: 90 CONTINUE
67: C
68: C I PTS TO DUMMY PROC ARG ENTRY IN LAT
69: C
70: 100 M = LAT(I+1) + K
71: M = LAT(M)
72: C M PTS TO ACTUAL SUBSTITUTABLE FOR I
73: L = FIND(M)
74: C RECURSION DUE TO INDIRECT REF COMPLETING THE LOOP
75: IF (-1.NE.INODE(L)) GO TO 110
76: ABORT = .TRUE.
77: CALL ERROR2(26H RECURSIVE LOOP INVOLVING , 26, DSA(NAME+4), 1,1,0)
78: CALL ERROR2(14H AND POSSIBLY , 14, LAT(M), 1, 0, 1)
79: GO TO 30
80: C NOTE NEED NOT WORRY ABOUT MISSING SUBPGM SINCE
81: C THEN ITS LAT INDEX COULDNOT BE IN TEMPLATE
82: 110 IF (CHK1(NODE(NC),M).EQ.0) GO TO 130
83: C PROCESSED A LEGAL INDIRET REF
84: CALL SETPD(M, NODE(NC))
85: IF (SYSERR) GO TO 30
86: IF (-2.EQ.INODE(L) .OR. INODE(NC).LT.INODE(L)) GO TO 120
87: INODE(L) = INODE(NC) + 1
88: CALL ASLEV(L)
89: IF (ABORT .OR. SYSERR) GO TO 30
90: C LOOK FOR MORE ACTUALS
91: 120 CALL PROC(NODE(NC), M, L, AOK)
92: IF (SYSERR .OR. ABORT) GO TO 30
93: 130 K = LAT(K) + K
94: K = LAT(K)
95: IF (K) 60, 60, 100
96: C MARK CURRENT NODE DONE
97: 140 INODE(NC) = -1
98: GO TO 10
99: 150 IF (.NOT.OK) GO TO 60
100: K = NODE(NC)
101: CALL ERROR2(20H NO ACTUAL PROCS IN ,20, LAT(K), 1, 1, 0)
102: CALL ERROR2(28H CANNOT PROCESS FORMAL REFS , 28,
103: * ZERO, -3, 0, 1)
104: OK = .FALSE.
105: GO TO 60
106: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.