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