![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to OUTSYM.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 OUTSYM.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 ! root 1: SUBROUTINE OUTSYM ! 2: INTEGER HASH, STACK, BL, DSA, OUTUT, SYMHD, BNEXT, SYMLEN, ATT(8) ! 3: INTEGER CODE(11), CC(30), C(4), Q(70), SYM, PDSA ! 4: INTEGER OUTUT2, OUTUT3, OUTUT4 ! 5: LOGICAL OK ! 6: LOGICAL OPT, P1ERR, COMM ! 7: COMMON /CHASH/ LHASH, HASH(401) ! 8: COMMON /OPTNS/ OPT(5), P1ERR ! 9: COMMON /CTABL/ LDSA, PDSA, DSA(5000) ! 10: COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3, ! 11: * OUTUT4 ! 12: COMMON /TABL/ NEXT, LAB, SYM, BNEXT ! 13: COMMON /FACTS/ NAME, NOST, ITYP, IASF ! 14: COMMON /CEXPRS/ LSTACK, STACK(620) ! 15: COMMON /TRANS/ Q ! 16: DATA BL /1H / ! 17: DATA CODE(1) /1HD/, CODE(2) /1HR/, CODE(3) /1HI/, CODE(4) /1HC/, ! 18: * CODE(5) /1HL/, CODE(11) /1HE/, CODE(7) /1HA/, CODE(8) /1HS/, ! 19: * CODE(9) /1HF/, CODE(10) /1HN/, CODE(6) /1HH/, C(1) /4/, C(2) ! 20: * /11/, C(3) /7/, C(4) /8/ ! 21: DATA CC(2), CC(16), CC(20), CC(22), CC(26), CC(28) /6*1H /, ! 22: * CC(3), CC(5), CC(9), CC(11) /1HF,1HS,1HF,1HF/, CC(1), CC(4) / ! 23: * 1HU,1HA/, CC(6), CC(8), CC(10), CC(12), CC(14) /1HF,4*1HN/, ! 24: * CC(7), CC(13) /2*1HS/, CC(15) /1HC/, CC(17) /1HG/, CC(18) / ! 25: * 1HT/, CC(19) /1HL/, CC(21) /1HV/, CC(25) /1HM/, CC(23) /1HB/, ! 26: * CC(24) /1HD/, CC(27) /1HE/ ! 27: DATA CC(29) /1HI/, CC(30) /1HF/ ! 28: C ! 29: C ROUTINE PRINTS OUT SYMBOL TABLE FOR A PROGRAM UNIT ! 30: C ! 31: IF (NAME.EQ.0 .OR. .NOT.OPT(1)) RETURN ! 32: II = IGATT1(NAME,8) ! 33: CALL S5UNPK(DSA(NAME+4), STACK(1), 6) ! 34: WRITE (OUTUT,99999) (STACK(I),I=1,6) ! 35: 99999 FORMAT (14H1PROGRAM UNIT , 5X, 6A1) ! 36: IF (II.EQ.11 .OR. II.EQ.12 .OR. DSA(NAME+2).EQ.0) GO TO 60 ! 37: C ! 38: C PRINT FCN/SUBROUTINE ARGS ! 39: C ! 40: KK = DSA(NAME+2) ! 41: I = 0 ! 42: 10 L = 20 ! 43: CALL RDLIST(KK, 9, M, 0) ! 44: IF (M) 20, 60, 20 ! 45: 20 DO 30 I1=1,M ! 46: J = STACK(I1) + 4 ! 47: CALL S5UNPK(DSA(J), STACK(L), 6) ! 48: L = L + 7 ! 49: STACK(L-1) = BL ! 50: 30 CONTINUE ! 51: MM = M*7 + 19 ! 52: IF (I) 40, 40, 50 ! 53: 40 WRITE (OUTUT,99998) (STACK(L),L=20,MM) ! 54: 99998 FORMAT (//10H ARGUMENTS, 9X, 63A1) ! 55: I = 1 ! 56: GO TO 10 ! 57: 50 WRITE (OUTUT,99997) (STACK(L),L=20,MM) ! 58: 99997 FORMAT (19X, 63A1) ! 59: GO TO 10 ! 60: C ! 61: C PRINT SYMBOLS FOR PROGRAM UNIT ! 62: C ! 63: 60 CALL SORT(SYM, LBR) ! 64: COMM = .FALSE. ! 65: WRITE (OUTUT,99996) ! 66: 99996 FORMAT (//1X, 4HNAME, 5X, 4HTYPE, 2X, 3HUSE, 1X, 10HATTRIBUTES, ! 67: * 1X, 10HREFERENCES//) ! 68: DO 230 JBR=1,LBR ! 69: SYMHD = HASH(JBR) ! 70: DO 70 I=20,35 ! 71: STACK(I) = BL ! 72: 70 CONTINUE ! 73: DO 80 I=1,8 ! 74: ATT(I) = IGATT1(SYMHD,I) ! 75: 80 CONTINUE ! 76: C SKIPS OVER SYMBOL TABLE ENTRY FOR MAIN, BLOCK DATA, ! 77: C AND CURRENT SUBROUTINE NAME ! 78: IF (SYMHD.EQ.NAME .AND. ATT(8).NE.4) GO TO 230 ! 79: IF (ATT(8).NE.7) GO TO 90 ! 80: COMM = .TRUE. ! 81: GO TO 230 ! 82: 90 CALL S5UNPK(DSA(SYMHD+4), STACK(20), 6) ! 83: I1 = ATT(8) ! 84: L = 2*(I1+1) - 1 ! 85: STACK(28) = CC(L) ! 86: STACK(29) = CC(L+1) ! 87: C LEAVE BLANK IRRELEVANT TYPE INFO FOR EXT SUBR, COMMON, EXT ENTS ! 88: IF(ATT(8).EQ.6 .OR. ATT(8).EQ.7 .OR. ATT(8).EQ.13) ! 89: 1 GOTO 100 ! 90: I1 = MOD(ATT(1),8) ! 91: IF (ATT(1).GE.8) STACK(26)=CODE(11) ! 92: STACK(27) = CODE(I1 + 1) ! 93: 100 DO 110 I=1,4 ! 94: L = I + 29 ! 95: J = C(I) ! 96: IF (ATT(I+1).EQ.1) STACK(L) = CODE(J) ! 97: 110 CONTINUE ! 98: IF (ATT(8).EQ.7) STACK(30) = BL ! 99: IF (ATT(8).NE.10 .AND. ATT(8).NE.8) GO TO 140 ! 100: IF (ATT(7)) 120, 130, 120 ! 101: 120 STACK(34) = CODE(7) ! 102: J = ATT(7) + 1 ! 103: STACK(35) = Q(J) ! 104: GO TO 140 ! 105: 130 STACK(34) = CODE(8) ! 106: C ! 107: C XREF LIST ! 108: C ! 109: 140 IF (OPT(2)) GO TO 160 ! 110: 150 WRITE (OUTUT,99995) (STACK(L),L=20,35) ! 111: GO TO 230 ! 112: 160 OK = .FALSE. ! 113: N = DSA(SYMHD+1) ! 114: IF (N.LE.0) GO TO 150 ! 115: N = DSA( N+1 ) ! 116: 170 CALL RFLIST( N, M, J, DSA(SYMHD+1) ) ! 117: C ! 118: C FIRST TIME PRINT WHOLE LINE ! 119: C ! 120: K = M ! 121: IF (M.GE.57) K = 57 ! 122: WRITE (OUTUT,99995) (STACK(L),L=20,35), (STACK(L),L=50,K) ! 123: 99995 FORMAT (1X, 6A1, 5X, 2A1, 3X, 2A1, 3X, 6A1, 2X, 8(I5, 1X)) ! 124: IF (M-57) 220, 220, 180 ! 125: 180 L = (M-57)/8 ! 126: LL = 58 ! 127: IF (L) 220, 210, 190 ! 128: 190 DO 200 K=1,L ! 129: LK = LL + 7 ! 130: WRITE (OUTUT,99994) (STACK(I),I=LL,LK) ! 131: LL = LK + 1 ! 132: 200 CONTINUE ! 133: IF (LK.EQ.M) GO TO 220 ! 134: 210 WRITE (OUTUT,99994) (STACK(I),I=LL,M) ! 135: 99994 FORMAT (30X, 8(I5, 1X)) ! 136: C ! 137: C MAY HAVE TO CALL REFLIST AGAIN ! 138: C ! 139: 220 IF (J) 230, 230, 170 ! 140: 230 CONTINUE ! 141: C ! 142: C PRINT LABELS ! 143: C ! 144: IF (LAB.EQ.0) GO TO 320 ! 145: CALL SORT(LAB, LBR) ! 146: DO 310 JBR=1,LBR ! 147: LABHD = HASH(JBR) ! 148: CALL S5UNPK(DSA(LABHD+4), STACK(20), 6) ! 149: OK = .FALSE. ! 150: IF (OPT(2)) GO TO 240 ! 151: WRITE (OUTUT,99993) (STACK(L),L=20,25) ! 152: GO TO 310 ! 153: 240 II = DSA(LABHD+1) ! 154: II = DSA(II+1) ! 155: 250 CALL RFLIST(II, M, J, DSA(LABHD+1) ) ! 156: K = M ! 157: IF (M.GE.57) K = 57 ! 158: WRITE (OUTUT,99993) (STACK(I),I=20,25), (STACK(I),I=50,K) ! 159: 99993 FORMAT (1X, 6A1, 23X, 8(I5, 1X)) ! 160: IF (M-57) 300, 300, 260 ! 161: 260 L = (M-57)/8 ! 162: LL = 58 ! 163: IF (L) 300, 290, 270 ! 164: 270 DO 280 K=1,L ! 165: LK = LL + 7 ! 166: WRITE (OUTUT,99992) (STACK(I),I=LL,LK) ! 167: LL = LK + 1 ! 168: 280 CONTINUE ! 169: IF (LK.EQ.M) GO TO 300 ! 170: 290 WRITE (OUTUT,99992) (STACK(I),I=LL,M) ! 171: 99992 FORMAT (30X, 8(I5, 1X)) ! 172: 300 IF (J) 310, 310, 250 ! 173: 310 CONTINUE ! 174: 320 IF (.NOT.COMM) GO TO 390 ! 175: CALL SORT(SYM, LBR) ! 176: WRITE (OUTUT,99991) ! 177: 99991 FORMAT (//14H COMMON BLOCKS//) ! 178: DO 380 JBR=1,LBR ! 179: SYMHD = HASH(JBR) ! 180: I = IGATT1(SYMHD,8) ! 181: IF (I.NE.7) GO TO 380 ! 182: CALL S5UNPK(DSA(SYMHD+4), STACK(100), 6) ! 183: N = 0 ! 184: II = DSA(SYMHD+2) ! 185: 330 L = 11 ! 186: CALL RDLIST(II, 10, M, 0) ! 187: IF (M) 340, 380, 340 ! 188: 340 DO 350 I=1,M ! 189: J = STACK(I) + 4 ! 190: CALL S5UNPK(DSA(J), STACK(L), 6) ! 191: L = L + 7 ! 192: STACK(L-1) = BL ! 193: 350 CONTINUE ! 194: L = L - 1 ! 195: IF (N) 360, 360, 370 ! 196: 360 WRITE (OUTUT,99990) (STACK(I),I=100,105), (STACK(I),I=11,L) ! 197: 99990 FORMAT (1X, 6A1, 3X, 70A1) ! 198: N = 1 ! 199: GO TO 330 ! 200: 370 WRITE (OUTUT,99989) (STACK(K),K=11,L) ! 201: 99989 FORMAT (10X, 70A1) ! 202: GO TO 330 ! 203: 380 CONTINUE ! 204: 390 RETURN ! 205: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.