1: #
2: /*
3: * pxp - Pascal execution profiler
4: *
5: * Bill Joy UCB
6: * Version 1.2 January 1979
7: */
8:
9: #include "0.h"
10:
11: tyrec(r, p0)
12: int *r, p0;
13: {
14:
15: if (r != NIL)
16: setinfo(r[1]);
17: if (p0 == NIL) {
18: ppgoin(DECL);
19: ppnl();
20: indent();
21: ppkw("record");
22: ppspac();
23: } else {
24: ppspac();
25: ppbra("(");
26: }
27: ppgoin(DECL);
28: if (r) {
29: field(r[2], r[3]);
30: variant(r[3]);
31: }
32: if (r != NIL)
33: setinfo(r[1]);
34: putcml();
35: ppgoout(DECL);
36: if (p0 == NIL) {
37: ppnl();
38: indent();
39: ppkw("end");
40: ppgoout(DECL);
41: } else {
42: ppitem();
43: ppket(")");
44: }
45: }
46:
47: field(r, v)
48: int *r, *v;
49: {
50: register int *fp, *tp, *ip;
51:
52: fp = r;
53: if (fp != NIL)
54: for (;;) {
55: tp = fp[1];
56: if (tp != NIL) {
57: setline(tp[1]);
58: ip = tp[2];
59: ppitem();
60: if (ip != NIL)
61: for (;;) {
62: ppid(ip[1]);
63: ip = ip[2];
64: if (ip == NIL)
65: break;
66: ppsep(", ");
67: }
68: else
69: ppid("{field id list}");
70: ppsep(":");
71: gtype(tp[3]);
72: setinfo(tp[1]);
73: putcm();
74: }
75: fp = fp[2];
76: if (fp == NIL)
77: break;
78: ppsep(";");
79: }
80: if (v != NIL && r != NIL)
81: ppsep(";");
82: }
83:
84: variant(r)
85: register int *r;
86: {
87: register int *v, *vc;
88:
89: if (r == NIL)
90: return;
91: setline(r[1]);
92: ppitem();
93: ppkw("case");
94: v = r[2];
95: if (v != NIL) {
96: ppspac();
97: ppid(v);
98: ppsep(":");
99: }
100: gtype(r[3]);
101: ppspac();
102: ppkw("of");
103: for (vc = r[4]; vc != NIL;) {
104: v = vc[1];
105: if (v == NIL)
106: continue;
107: ppgoin(DECL);
108: setline(v[1]);
109: ppnl();
110: indent();
111: ppbra(NIL);
112: v = v[2];
113: if (v != NIL) {
114: for (;;) {
115: gconst(v[1]);
116: v = v[2];
117: if (v == NIL)
118: break;
119: ppsep(", ");
120: }
121: } else
122: ppid("{case label list}");
123: ppket(":");
124: v = vc[1];
125: tyrec(v[3], 1);
126: setinfo(v[1]);
127: putcml();
128: ppgoout(DECL);
129: vc = vc[2];
130: if (vc == NIL)
131: break;
132: ppsep(";");
133: }
134: setinfo(r[1]);
135: putcm();
136: }
Defined functions
field
defined in line
47; used 1 times
tyrec
defined in line
11; used 2 times