![[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] / researchv10no / cmd / pfort|
Return to INVOKE.f CVS log | Up to [Research Unix] / researchv10no / 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.