![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rec.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / pi|
Return to rec.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2: #
3: /*
4: * pi - Pascal interpreter code translator
5: *
6: * Charles Haley, Bill Joy UCB
7: * Version 1.2 Novmeber 1978
8: */
9:
10: #include "whoami"
11: #include "0.h"
12: #include "tree.h"
13: #include "opcode.h"
14:
15: /*
16: * Build a record namelist entry.
17: * Some of the processing here is somewhat involved.
18: * The basic structure we are building is as follows.
19: *
20: * Each record has a main RECORD entry, with an attached
21: * chain of fields as ->chain; these include all the fields in all
22: * the variants of this record.
23: *
24: * Attached to NL_VARNT is a chain of VARNT structures
25: * describing each of the variants. These are further linked
26: * through ->chain. Each VARNT has, in ->range[0] the value of
27: * the associated constant, and each points at a RECORD describing
28: * the subrecord through NL_VTOREC. These pointers are not unique,
29: * more than one VARNT may reference the same RECORD.
30: *
31: * The involved processing here is in computing the NL_OFFS entry
32: * by maxing over the variants. This works as follows.
33: *
34: * Each RECORD has two size counters. NL_OFFS is the maximum size
35: * so far of any variant of this record; NL_FLDSZ gives the size
36: * of just the FIELDs to this point as a base for further variants.
37: *
38: * As we process each variant record, we start its size with the
39: * NL_FLDSZ we have so far. After processing it, if its NL_OFFS
40: * is the largest so far, we update the NL_OFFS of this subrecord.
41: * This will eventually propagate back and update the NL_OFFS of the
42: * entire record.
43: */
44:
45: /*
46: * P0 points to the outermost RECORD for name searches.
47: */
48: struct nl *P0;
49:
50: tyrec(r, off)
51: int *r, off;
52: {
53:
54: return tyrec1(r, off, 1);
55: }
56:
57: /*
58: * Define a record namelist entry.
59: * R is the tree for the record to be built.
60: * Off is the offset for the first item in this (sub)record.
61: */
62: struct nl *
63: tyrec1(r, off, first)
64: register int *r;
65: int off;
66: char first;
67: {
68: register struct nl *p, *P0was;
69:
70: p = defnl(0, RECORD, 0, 0);
71: P0was = P0;
72: if (first)
73: P0 = p;
74: #ifndef PI0
75: p->value[NL_FLDSZ] = p->value[NL_OFFS] = off;
76: #endif
77: if (r != NIL) {
78: fields(p, r[2]);
79: variants(p, r[3]);
80: }
81: P0 = P0was;
82: return (p);
83: }
84:
85: /*
86: * Define the fixed part fields for p.
87: */
88: struct nl *
89: fields(p, r)
90: struct nl *p;
91: int *r;
92: {
93: register int *fp, *tp, *ip;
94: struct nl *jp;
95:
96: for (fp = r; fp != NIL; fp = fp[2]) {
97: tp = fp[1];
98: if (tp == NIL)
99: continue;
100: jp = gtype(tp[3]);
101: line = tp[1];
102: for (ip = tp[2]; ip != NIL; ip = ip[2])
103: deffld(p, ip[1], jp);
104: }
105: }
106:
107: /*
108: * Define the variants for RECORD p.
109: */
110: struct nl *
111: variants(p, r)
112: struct nl *p;
113: register int *r;
114: {
115: register int *vc, *v;
116: int *vr;
117: struct nl *ct;
118:
119: if (r == NIL)
120: return;
121: ct = gtype(r[3]);
122: line = r[1];
123: /*
124: * Want it even if r[2] is NIL so
125: * we check its type in "new" and "dispose"
126: * calls -- link it to NL_TAG.
127: */
128: p->ptr[NL_TAG] = deffld(p, r[2], ct);
129: for (vc = r[4]; vc != NIL; vc = vc[2]) {
130: v = vc[1];
131: if (v == NIL)
132: continue;
133: vr = tyrec1(v[3], p->value[NL_FLDSZ], 0);
134: #ifndef PI0
135: if (vr->value[NL_OFFS] > p->value[NL_OFFS])
136: p->value[NL_OFFS] = vr->value[NL_OFFS];
137: #endif
138: line = v[1];
139: for (v = v[2]; v != NIL; v = v[2])
140: defvnt(p, v[1], vr, ct);
141: }
142: }
143:
144: /*
145: * Define a field in subrecord p of record P0
146: * with name s and type t.
147: */
148: struct nl *
149: deffld(p, s, t)
150: struct nl *p;
151: register char *s;
152: register struct nl *t;
153: {
154: register struct nl *fp;
155:
156: if (reclook(P0, s) != NIL) {
157: #ifndef PI1
158: error("%s is a duplicate field name in this record", s);
159: #endif
160: s = NIL;
161: }
162: #ifndef PI0
163: fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS]));
164: #else
165: fp = enter(defnl(s, FIELD, t, 0));
166: #endif
167: if (s != NIL) {
168: fp->chain = P0->chain;
169: P0->chain = fp;
170: #ifndef PI0
171: p->value[NL_FLDSZ] = p->value[NL_OFFS] += even(width(t));
172: #endif
173: if (t != NIL) {
174: P0->nl_flags |= t->nl_flags & NFILES;
175: p->nl_flags |= t->nl_flags & NFILES;
176: }
177: }
178: return (fp);
179: }
180:
181: /*
182: * Define a variant from the constant tree of t
183: * in subrecord p of record P0 where the casetype
184: * is ct and the variant record to be associated is vr.
185: */
186: struct nl *
187: defvnt(p, t, vr, ct)
188: struct nl *p, *vr;
189: int *t;
190: register struct nl *ct;
191: {
192: register struct nl *av;
193:
194: gconst(t);
195: if (ct != NIL && incompat(con.ctype, ct)) {
196: #ifndef PI1
197: cerror("Variant label type incompatible with selector type");
198: #endif
199: ct = NIL;
200: }
201: av = defnl(0, VARNT, ct, 0);
202: #ifndef PI1
203: if (ct != NIL)
204: uniqv(p);
205: #endif
206: av->chain = p->ptr[NL_VARNT];
207: p->ptr[NL_VARNT] = av;
208: av->ptr[NL_VTOREC] = vr;
209: av->range[0] = con.crval;
210: return (av);
211: }
212:
213: #ifndef PI1
214: /*
215: * Check that the constant label value
216: * is unique among the labels in this variant.
217: */
218: uniqv(p)
219: struct nl *p;
220: {
221: register struct nl *vt;
222:
223: for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain)
224: if (vt->range[0] == con.crval) {
225: error("Duplicate variant case label in record");
226: return;
227: }
228: }
229: #endif
230:
231: /*
232: * See if the field name s is defined
233: * in the record p, returning a pointer
234: * to it namelist entry if it is.
235: */
236: struct nl *
237: reclook(p, s)
238: register struct nl *p;
239: char *s;
240: {
241:
242: if (p == NIL || s == NIL)
243: return (NIL);
244: for (p = p->chain; p != NIL; p = p->chain)
245: if (p->symbol == s)
246: return (p);
247: return (NIL);
248: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.