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