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