![[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.