1 /*-
2 * Copyright (c) 1980, 1993
3 * The Regents of the University of California. All rights reserved.
4 *
5 * %sccs.include.redist.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)fdec.c 8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11
12 /*
13 * pxp - Pascal execution profiler
14 *
15 * Bill Joy UCB
16 * Version 1.2 January 1979
17 */
18
19 #include "0.h"
20 #include "tree.h"
21
22 /*
23 * Program, procedure or function "header", i.e.:
24 *
25 * function sin: real;
26 */
funchdr(r)27 funchdr(r)
28 int *r;
29 {
30 register **rl, *il;
31
32 if (inpflist(r[2])) {
33 optstk['z'-'a'] <<= 1;
34 optstk['z'-'a'] |= opts['z'-'a'];
35 opts['z'-'a'] = 1;
36 }
37 cbn++;
38 lastbn = cbn;
39 getcnt();
40 if (nojunk && !inpflist(r[2]))
41 setprint();
42 else
43 printon();
44 if (r[0] == T_PROG && noinclude && bracket)
45 printoff();
46 if (cbn > 1 && !justify)
47 ppgoin(PRFN);
48 puthedr();
49 if (noblank(setline(r[1])))
50 ppnl();
51 cnttab(r[2], pfcnt++);
52 ppnl();
53 indent();
54 switch (r[0]) {
55 case T_PROG:
56 ppkw("program");
57 break;
58 case T_PDEC:
59 ppkw("procedure");
60 break;
61 case T_FDEC:
62 ppkw("function");
63 break;
64 default:
65 panic("funchdr");
66 }
67 ppspac();
68 ppid(r[2]);
69 if (r[0] != T_PROG) {
70 rl = r[3];
71 if (rl != NIL) {
72 ppbra("(");
73 for (;;) {
74 if (rl[1] == NIL) {
75 rl = rl[2];
76 continue;
77 }
78 switch (rl[1][0]) {
79 case T_PVAR:
80 ppkw("var");
81 ppspac();
82 break;
83 case T_PPROC:
84 ppkw("procedure");
85 ppspac();
86 break;
87 case T_PFUNC:
88 ppkw("function");
89 ppspac();
90 break;
91 }
92 il = rl[1][1];
93 if (il != NIL)
94 for (;;) {
95 ppid(il[1]);
96 il = il[2];
97 if (il == NIL)
98 break;
99 ppsep(", ");
100 }
101 else
102 ppid("{identifier list}");
103 if (rl[1][0] != T_PPROC) {
104 ppsep(":");
105 gtype(rl[1][2]);
106 }
107 rl = rl[2];
108 if (rl == NIL)
109 break;
110 ppsep(";");
111 ppspac();
112 }
113 ppket(")");
114 }
115 if (r[0] == T_FDEC && r[4] != NIL) {
116 ppsep(":");
117 gtype(r[4]);
118 }
119 ppsep(";");
120 } else {
121 rl = r[3];
122 if (rl != NIL) {
123 ppbra("(");
124 for (;;) {
125 ppid(rl[1]);
126 rl = rl[2];
127 if (rl == NIL)
128 break;
129 ppsep(", ");
130 }
131 ppket(")");
132 }
133 ppsep(";");
134 }
135 fhout:
136 setline(r[1]);
137 putcml();
138 savecnt(&pfcnts[cbn]);
139 setprint();
140 --cbn;
141 if (cbn && !justify)
142 ppgoout(PRFN);
143 return (r[2]);
144 }
145
146 /*
147 * Forward declaration i.e. the second line of
148 *
149 * procedure fum(var i: integer);
150 * forward;
151 */
funcfwd(fp)152 funcfwd(fp)
153 char *fp;
154 {
155
156 baroff();
157 ppgoin(DECL);
158 ppnl();
159 indent();
160 ppkw("forward");
161 ppsep(";");
162 ppgoout(DECL);
163 baron();
164 return (fp);
165 }
166
167 /*
168 * The "body" of a procedure, function, or program declaration,
169 * i.e. a non-forward definition encounter.
170 */
funcbody(fp)171 funcbody(fp)
172 char *fp;
173 {
174
175 if (cbn && !justify)
176 ppgoin(PRFN);
177 cbn++;
178 lastbn = cbn;
179 return (fp);
180 }
181
182 /*
183 * The guts of the procedure, function or program, i.e.
184 * the part between the begin and the end.
185 */
funcend(fp,bundle,binfo)186 funcend(fp, bundle, binfo)
187 char *fp;
188 int *bundle, *binfo;
189 {
190 int *blk;
191 extern int cntstat;
192
193 cntstat = 0;
194 blk = bundle[2];
195 rescnt(&pfcnts[cbn]);
196 setprint();
197 if (cbn == 1 && noinclude && bracket)
198 printoff();
199 if (lastbn > cbn)
200 unprint();
201 if (cbn == 1)
202 puthedr();
203 if (noblank(setline(bundle[1])) && lastbn > cbn)
204 ppnl();
205 ppnl();
206 indent();
207 ppkw("begin");
208 setline(bundle[1]);
209 if (putcml() == 0 && lastbn > cbn)
210 ppsname(fp);
211 ppgoin(DECL);
212 statlist(blk);
213 setinfo(bundle[1]);
214 putcmp();
215 ppgoout(DECL);
216 ppnl();
217 indent();
218 ppkw("end");
219 ppsep(cbn == 1 ? "." : ";");
220 setinfo(binfo);
221 if (putcml() == 0)
222 ppsname(fp);
223 cbn--;
224 if (cbn && !justify)
225 ppgoout(PRFN);
226 if (inpflist(fp)) {
227 opts['z'-'a'] = optstk['z'-'a'] & 1;
228 optstk['z'-'a'] >>= 1;
229 }
230 if (cbn == 0) {
231 flushcm();
232 printon();
233 ppnl();
234 }
235 }
236
ppsname(fp)237 ppsname(fp)
238 char *fp;
239 {
240 if (fp == NIL)
241 return;
242 ppsep(" { ");
243 ppid(fp);
244 ppsep(" }");
245 }
246
247 /*
248 * Segend is called at the end of a routine segment (a separately
249 * compiled segment that is not the main program). Since pxp only works
250 * with a single pascal file, this routine should never be called.
251 */
segend()252 segend()
253 {
254
255 if ( profile ) {
256 error("Missing program statement and program body");
257 }
258 }
259
260 /*
261 * External declaration i.e. the second line of
262 *
263 * procedure fum(var i: integer);
264 * external;
265 */
266 struct nl *
funcext(fp)267 funcext(fp)
268 struct nl *fp;
269 {
270
271 baroff();
272 ppgoin(DECL);
273 ppnl();
274 indent();
275 ppkw("external");
276 ppsep(";");
277 ppgoout(DECL);
278 baron();
279 return (fp);
280 }
281