|
|
1.1 root 1: static char *sccsid = "@(#)fdec.c 1.1 (Berkeley) 3/2/81";
2: /* Copyright (c) 1979 Regents of the University of California */
3: #
4: /*
5: * pxp - Pascal execution profiler
6: *
7: * Bill Joy UCB
8: * Version 1.2 January 1979
9: */
10:
11: #include "0.h"
12: #include "tree.h"
13:
14: /*
15: * Program, procedure or function "header", i.e.:
16: *
17: * function sin: real;
18: */
19: funchdr(r)
20: int *r;
21: {
22: register **rl, *il;
23:
24: if (inpflist(r[2])) {
25: optstk['z'-'a'] <<= 1;
26: optstk['z'-'a'] |= opts['z'-'a'];
27: opts['z'-'a'] = 1;
28: }
29: cbn++;
30: lastbn = cbn;
31: getcnt();
32: if (nojunk && !inpflist(r[2]))
33: setprint();
34: else
35: printon();
36: if (r[0] == T_PROG && noinclude && bracket)
37: printoff();
38: if (cbn > 1 && !justify)
39: ppgoin(PRFN);
40: puthedr();
41: if (noblank(setline(r[1])))
42: ppnl();
43: cnttab(r[2], pfcnt++);
44: ppnl();
45: indent();
46: switch (r[0]) {
47: case T_PROG:
48: ppkw("program");
49: break;
50: case T_PDEC:
51: ppkw("procedure");
52: break;
53: case T_FDEC:
54: ppkw("function");
55: break;
56: default:
57: panic("funchdr");
58: }
59: ppspac();
60: ppid(r[2]);
61: if (r[0] != T_PROG) {
62: rl = r[3];
63: if (rl != NIL) {
64: ppbra("(");
65: for (;;) {
66: if (rl[1] == NIL) {
67: rl = rl[2];
68: continue;
69: }
70: switch (rl[1][0]) {
71: case T_PVAR:
72: ppkw("var");
73: ppspac();
74: break;
75: case T_PPROC:
76: ppkw("procedure");
77: ppspac();
78: break;
79: case T_PFUNC:
80: ppkw("function");
81: ppspac();
82: break;
83: }
84: il = rl[1][1];
85: if (il != NIL)
86: for (;;) {
87: ppid(il[1]);
88: il = il[2];
89: if (il == NIL)
90: break;
91: ppsep(", ");
92: }
93: else
94: ppid("{identifier list}");
95: if (rl[1][0] != T_PPROC) {
96: ppsep(":");
97: gtype(rl[1][2]);
98: }
99: rl = rl[2];
100: if (rl == NIL)
101: break;
102: ppsep(";");
103: ppspac();
104: }
105: ppket(")");
106: }
107: if (r[0] == T_FDEC && r[4] != NIL) {
108: ppsep(":");
109: gtype(r[4]);
110: }
111: ppsep(";");
112: } else {
113: rl = r[3];
114: if (rl != NIL) {
115: ppbra("(");
116: for (;;) {
117: ppid(rl[1]);
118: rl = rl[2];
119: if (rl == NIL)
120: break;
121: ppsep(", ");
122: }
123: ppket(")");
124: }
125: ppsep(";");
126: }
127: fhout:
128: setline(r[1]);
129: putcml();
130: savecnt(&pfcnts[cbn]);
131: setprint();
132: --cbn;
133: if (cbn && !justify)
134: ppgoout(PRFN);
135: return (r[2]);
136: }
137:
138: /*
139: * Forward declaration i.e. the second line of
140: *
141: * procedure fum(var i: integer);
142: * forward;
143: */
144: funcfwd(fp)
145: char *fp;
146: {
147:
148: baroff();
149: ppgoin(DECL);
150: ppnl();
151: indent();
152: ppkw("forward");
153: ppsep(";");
154: ppgoout(DECL);
155: baron();
156: return (fp);
157: }
158:
159: /*
160: * The "body" of a procedure, function, or program declaration,
161: * i.e. a non-forward definition encounter.
162: */
163: funcbody(fp)
164: char *fp;
165: {
166:
167: if (cbn && !justify)
168: ppgoin(PRFN);
169: cbn++;
170: lastbn = cbn;
171: return (fp);
172: }
173:
174: /*
175: * The guts of the procedure, function or program, i.e.
176: * the part between the begin and the end.
177: */
178: funcend(fp, bundle, binfo)
179: char *fp;
180: int *bundle, *binfo;
181: {
182: int *blk;
183: extern int cntstat;
184:
185: cntstat = 0;
186: blk = bundle[2];
187: rescnt(&pfcnts[cbn]);
188: setprint();
189: if (cbn == 1 && noinclude && bracket)
190: printoff();
191: if (lastbn > cbn)
192: unprint();
193: if (cbn == 1)
194: puthedr();
195: if (noblank(setline(bundle[1])) && lastbn > cbn)
196: ppnl();
197: ppnl();
198: indent();
199: ppkw("begin");
200: setline(bundle[1]);
201: if (putcml() == 0 && lastbn > cbn)
202: ppsname(fp);
203: ppgoin(DECL);
204: statlist(blk);
205: setinfo(bundle[1]);
206: putcmp();
207: ppgoout(DECL);
208: ppnl();
209: indent();
210: ppkw("end");
211: ppsep(cbn == 1 ? "." : ";");
212: setinfo(binfo);
213: if (putcml() == 0)
214: ppsname(fp);
215: cbn--;
216: if (cbn && !justify)
217: ppgoout(PRFN);
218: if (inpflist(fp)) {
219: opts['z'-'a'] = optstk['z'-'a'] & 1;
220: optstk['z'-'a'] >>= 1;
221: }
222: if (cbn == 0) {
223: flushcm();
224: printon();
225: ppnl();
226: }
227: }
228:
229: ppsname(fp)
230: char *fp;
231: {
232: if (fp == NIL)
233: return;
234: ppsep(" { ");
235: ppid(fp);
236: ppsep(" }");
237: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.