![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tree.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / pdx / sym|
Return to tree.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / pdx / sym |
1.1 root 1: /* Copyright (c) 1982 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)tree.c 1.6 2/15/83";
4:
5: /*
6: * This module contains the interface between the SYM routines and
7: * the parse tree routines. It would be nice if such a crude
8: * interface were not necessary, but some parts of tree building are
9: * language and hence SYM-representation dependent. It's probably
10: * better to have tree-representation dependent code here than vice versa.
11: */
12:
13: #include "defs.h"
14: #include "tree.h"
15: #include "sym.h"
16: #include "btypes.h"
17: #include "classes.h"
18: #include "sym.rep"
19: #include "tree/tree.rep"
20:
21: typedef char *ARGLIST;
22:
23: #define nextarg(arglist, type) ((type *) (arglist += sizeof(type)))[-1]
24:
25: LOCAL SYM *mkstring();
26: LOCAL SYM *namenode();
27:
28: /*
29: * Determine the type of a parse tree. While we're at, check
30: * the parse tree out.
31: */
32:
33: SYM *treetype(p, ap)
34: register NODE *p;
35: register ARGLIST ap;
36: {
37: switch(p->op) {
38: case O_NAME: {
39: SYM *s;
40:
41: s = nextarg(ap, SYM *);
42: s = which(s);
43: return namenode(p, s);
44: /* NOTREACHED */
45: }
46:
47: case O_WHICH:
48: p->nameval = nextarg(ap, SYM *);
49: p->nameval = which(p->nameval);
50: return NIL;
51:
52: case O_LCON:
53: return t_int;
54:
55: case O_FCON:
56: return t_real;
57:
58: case O_SCON: {
59: char *cpy;
60: SYM *s;
61:
62: cpy = strdup(p->sconval);
63: p->sconval = cpy;
64: s = mkstring(p->sconval);
65: if (s == t_char) {
66: p->op = O_LCON;
67: p->lconval = p->sconval[0];
68: }
69: return s;
70: }
71:
72: case O_INDIR:
73: p->left = nextarg(ap, NODE *);
74: chkclass(p->left, PTR);
75: return rtype(p->left->nodetype)->type;
76:
77: case O_RVAL: {
78: NODE *p1, *q;
79:
80: p1 = p->left;
81: p->nodetype = p1->nodetype;
82: if (p1->op == O_NAME) {
83: if (p1->nodetype->class == FUNC) {
84: p->op = O_CALL;
85: p->right = NIL;
86: } else if (p1->nameval->class == CONST) {
87: if (p1->nameval->type == t_real->type) {
88: p->op = O_FCON;
89: p->fconval = p1->nameval->symvalue.fconval;
90: p->nodetype = t_real;
91: dispose(p1);
92: } else {
93: p->op = O_LCON;
94: p->lconval = p1->nameval->symvalue.iconval;
95: p->nodetype = p1->nameval->type;
96: dispose(p1);
97: }
98: }
99: }
100: return p->nodetype;
101: /* NOTREACHED */
102: }
103:
104: case O_CALL: {
105: SYM *s;
106:
107: p->left = nextarg(ap, NODE *);
108: p->right = nextarg(ap, NODE *);
109: s = p->left->nodetype;
110: if (isblock(s) && isbuiltin(s)) {
111: p->op = (OP) s->symvalue.token.tokval;
112: tfree(p->left);
113: p->left = p->right;
114: p->right = NIL;
115: }
116: return s->type;
117: }
118:
119: case O_ITOF:
120: return t_real;
121:
122: case O_NEG: {
123: SYM *s;
124:
125: p->left = nextarg(ap, NODE *);
126: s = p->left->nodetype;
127: if (!compatible(s, t_int)) {
128: if (!compatible(s, t_real)) {
129: trerror("%t is improper type", p->left);
130: } else {
131: p->op = O_NEGF;
132: }
133: }
134: return s;
135: }
136:
137: case O_ADD:
138: case O_SUB:
139: case O_MUL:
140: case O_LT:
141: case O_LE:
142: case O_GT:
143: case O_GE:
144: case O_EQ:
145: case O_NE:
146: {
147: BOOLEAN t1real, t2real;
148: SYM *t1, *t2;
149:
150: p->left = nextarg(ap, NODE *);
151: p->right = nextarg(ap, NODE *);
152: t1 = rtype(p->left->nodetype);
153: t2 = rtype(p->right->nodetype);
154: t1real = (t1 == t_real);
155: t2real = (t2 == t_real);
156: if (t1real || t2real) {
157: p->op++;
158: if (!t1real) {
159: p->left = build(O_ITOF, p->left);
160: } else if (!t2real) {
161: p->right = build(O_ITOF, p->right);
162: }
163: } else {
164: if (t1real) {
165: convert(&p->left, t_int, O_NOP);
166: }
167: if (t2real) {
168: convert(&p->right, t_int, O_NOP);
169: }
170: }
171: if (p->op >= O_LT) {
172: return t_boolean;
173: } else {
174: if (t1real || t2real) {
175: return t_real;
176: } else {
177: return t_int;
178: }
179: }
180: /* NOTREACHED */
181: }
182:
183: case O_DIVF:
184: p->left = nextarg(ap, NODE *);
185: p->right = nextarg(ap, NODE *);
186: convert(&p->left, t_real, O_ITOF);
187: convert(&p->right, t_real, O_ITOF);
188: return t_real;
189:
190: case O_DIV:
191: case O_MOD:
192: p->left = nextarg(ap, NODE *);
193: p->right = nextarg(ap, NODE *);
194: convert(&p->left, t_int, O_NOP);
195: convert(&p->right, t_int, O_NOP);
196: return t_int;
197:
198: case O_AND:
199: case O_OR:
200: p->left = nextarg(ap, NODE *);
201: p->right = nextarg(ap, NODE *);
202: chkboolean(p->left);
203: chkboolean(p->right);
204: return t_boolean;
205:
206: default:
207: return NIL;
208: }
209: }
210:
211: /*
212: * Create a node for a name. The symbol for the name has already
213: * been chosen, either implicitly with "which" or explicitly from
214: * the dot routine.
215: */
216:
217: LOCAL SYM *namenode(p, s)
218: NODE *p;
219: SYM *s;
220: {
221: NODE *np;
222:
223: p->nameval = s;
224: if (s->class == REF) {
225: np = alloc(1, NODE);
226: *np = *p;
227: p->op = O_INDIR;
228: p->left = np;
229: np->nodetype = s;
230: }
231: if (s->class == CONST || s->class == VAR || s->class == FVAR) {
232: return s->type;
233: } else {
234: return s;
235: }
236: }
237:
238: /*
239: * Convert a tree to a type via a conversion operator;
240: * if this isn't possible generate an error.
241: *
242: * Note the tree is call by address, hence the #define below.
243: */
244:
245: LOCAL convert(tp, typeto, op)
246: NODE **tp;
247: SYM *typeto;
248: OP op;
249: {
250: #define tree (*tp)
251:
252: SYM *s;
253:
254: s = rtype(tree->nodetype);
255: typeto = rtype(typeto);
256: if (typeto == t_real && compatible(s, t_int)) {
257: tree = build(op, tree);
258: } else if (!compatible(s, typeto)) {
259: trerror("%t is improper type");
260: } else if (op != O_NOP && s != typeto) {
261: tree = build(op, tree);
262: }
263:
264: #undef tree
265: }
266:
267: /*
268: * Construct a node for the Pascal dot operator.
269: *
270: * If the left operand is not a record, but rather a procedure
271: * or function, then we interpret the "." as referencing an
272: * "invisible" variable; i.e. a variable within a dynamically
273: * active block but not within the static scope of the current procedure.
274: */
275:
276: NODE *dot(record, field)
277: NODE *record;
278: SYM *field;
279: {
280: register NODE *p;
281: register SYM *s;
282:
283: if (isblock(record->nodetype)) {
284: s = findsym(field, record->nodetype);
285: if (s == NIL) {
286: error("\"%s\" is not defined in \"%s\"",
287: field->symbol, record->nodetype->symbol);
288: }
289: p = alloc(1, NODE);
290: p->op = O_NAME;
291: p->nodetype = namenode(p, s);
292: } else {
293: s = findclass(field, FIELD);
294: if (s == NIL) {
295: error("\"%s\" is not a field", field->symbol);
296: }
297: field = s;
298: chkfield(record, field);
299: p = alloc(1, NODE);
300: p->op = O_ADD;
301: p->nodetype = field->type;
302: p->left = record;
303: p->right = build(O_LCON, (long) field->symvalue.offset);
304: }
305: return p;
306: }
307:
308: /*
309: * Return a tree corresponding to an array reference and do the
310: * error checking.
311: */
312:
313: NODE *subscript(a, slist)
314: NODE *a, *slist;
315: {
316: register SYM *t;
317: register NODE *p;
318: SYM *etype, *atype, *eltype;
319: NODE *esub;
320:
321: t = rtype(a->nodetype);
322: if (t->class != ARRAY) {
323: trerror("%t is not an array", a);
324: }
325: eltype = t->type;
326: p = slist;
327: t = t->chain;
328: for (; p != NIL && t != NIL; p = p->right, t = t->chain) {
329: esub = p->left;
330: etype = rtype(esub->nodetype);
331: atype = rtype(t);
332: if (!compatible(atype, etype)) {
333: trerror("subscript %t is the wrong type", esub);
334: }
335: esub->nodetype = atype;
336: }
337: if (p != NIL) {
338: trerror("too many subscripts for %t", a);
339: } else if (t != NIL) {
340: trerror("not enough subscripts for %t", a);
341: }
342: p = alloc(1, NODE);
343: p->op = O_INDEX;
344: p->left = a;
345: p->right = slist;
346: p->nodetype = eltype;
347: return p;
348: }
349:
350: /*
351: * Evaluate a subscript (possibly more than one index).
352: */
353:
354: long evalindex(arraytype, subs)
355: SYM *arraytype;
356: NODE *subs;
357: {
358: long lb, ub, index, i;
359: SYM *t, *indextype;
360: NODE *p;
361:
362: t = rtype(arraytype);
363: if (t->class != ARRAY) {
364: panic("unexpected class %d in evalindex", t->class);
365: }
366: i = 0;
367: t = t->chain;
368: p = subs;
369: while (t != NIL) {
370: if (p == NIL) {
371: panic("unexpected end of subscript list in evalindex");
372: }
373: indextype = rtype(t);
374: lb = indextype->symvalue.rangev.lower;
375: ub = indextype->symvalue.rangev.upper;
376: eval(p->left);
377: index = popsmall(p->left->nodetype);
378: if (index < lb || index > ub) {
379: error("subscript value %d out of range %d..%d", index, lb, ub);
380: }
381: i = (ub-lb+1)*i + (index-lb);
382: t = t->chain;
383: p = p->right;
384: }
385: return i;
386: }
387:
388: /*
389: * Check that a record.field usage is proper.
390: */
391:
392: LOCAL chkfield(r, f)
393: NODE *r;
394: SYM *f;
395: {
396: register SYM *s;
397:
398: chkclass(r, RECORD);
399:
400: /*
401: * Don't do this for compiled code.
402: */
403: # if (!isvax)
404: for (s = r->nodetype->chain; s != NIL; s = s->chain) {
405: if (s == f) {
406: break;
407: }
408: }
409: if (s == NIL) {
410: error("\"%s\" is not a field in specified record", f->symbol);
411: }
412: # endif
413: }
414:
415: /*
416: * Check to see if a tree is boolean-valued, if not it's an error.
417: */
418:
419: chkboolean(p)
420: register NODE *p;
421: {
422: if (p->nodetype != t_boolean) {
423: trerror("found %t, expected boolean expression");
424: }
425: }
426:
427: /*
428: * Check to make sure the given tree has a type of the given class.
429: */
430:
431: LOCAL chkclass(p, class)
432: NODE *p;
433: int class;
434: {
435: SYM tmpsym;
436:
437: tmpsym.class = class;
438: if (p->nodetype->class != class) {
439: trerror("%t is not a %s", p, classname(&tmpsym));
440: }
441: }
442:
443: /*
444: * Construct a node for the type of a string. While we're at it,
445: * scan the string for '' that collapse to ', and chop off the ends.
446: */
447:
448: LOCAL SYM *mkstring(str)
449: char *str;
450: {
451: register char *p, *q;
452: SYM *s, *t;
453: static SYM zerosym;
454:
455: p = str;
456: q = str + 1;
457: while (*q != '\0') {
458: if (q[0] != '\'' || q[1] != '\'') {
459: *p = *q;
460: p++;
461: }
462: q++;
463: }
464: *--p = '\0';
465: if (p == str + 1) {
466: return t_char;
467: }
468: s = alloc(1, SYM);
469: *s = zerosym;
470: s->class = ARRAY;
471: s->type = t_char;
472: s->chain = alloc(1, SYM);
473: t = s->chain;
474: *t = zerosym;
475: t->class = RANGE;
476: t->type = t_int;
477: t->symvalue.rangev.lower = 1;
478: t->symvalue.rangev.upper = p - str + 1;
479: return s;
480: }
481:
482: /*
483: * Free up the space allocated for a string type.
484: */
485:
486: unmkstring(s)
487: SYM *s;
488: {
489: dispose(s->chain);
490: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.