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