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