xref: /original-bsd/usr.bin/pascal/pdx/tree/eval.c (revision a910c8b7) 
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)eval.c 1.10 02/14/83";
4 
5 /*
6  * Parse tree evaluation.
7  */
8 
9 #include "defs.h"
10 #include "tree.h"
11 #include "sym.h"
12 #include "process.h"
13 #include "source.h"
14 #include "mappings.h"
15 #include "breakpoint.h"
16 #include "machine.h"
17 #include "tree.rep"
18 
19 #define Boolean char	/* underlying representation type for booleans */
20 
21 /*
22  * Evaluate a parse tree using a stack; value is left at top.
23  */
24 
25 #define STACKSIZE 2000
26 
27 STACK stack[STACKSIZE];
28 STACK *sp = &stack[0];
29 
30 eval(p)
31 register NODE *p;
32 {
33     long r0, r1;
34     double fr0, fr1;
35     FILE *fp;
36 
37     if (p == NULL) {
38 	return;
39     }
40     switch(degree(p->op)) {
41 	case BINARY:
42 	    eval(p->right);
43 	    if (isreal(p->op)) {
44 		fr1 = pop(double);
45 	    } else if (isint(p->op)) {
46 		r1 = popsmall(p->right->nodetype);
47 	    }
48 	    /* fall through */
49 	case UNARY:
50 	    eval(p->left);
51 	    if (isreal(p->op)) {
52 		fr0 = pop(double);
53 	    } else if (isint(p->op)) {
54 		r0 = popsmall(p->left->nodetype);
55 	    }
56 	    break;
57 
58 	default:
59 	    /* do nothing */;
60 	}
61     switch(p->op) {
62 	case O_NAME: {
63 	    SYM *s, *f;
64 
65 	    s = p->nameval;
66 	    if (!isvariable(s)) {
67 		error("cannot evaluate a %s", classname(s));
68 	    } else {
69 		f = container(s);
70 		if (!isactive(f)) {
71 		    error("\"%s\" is not active", name(f));
72 		}
73 		push(long, address(s, NIL));
74 	    }
75 	    break;
76 	}
77 
78 	case O_LCON:
79 	    switch (size(p->nodetype)) {
80 		case sizeof(char):
81 		    push(char, p->lconval);
82 		    break;
83 
84 		case sizeof(short):
85 		    push(short, p->lconval);
86 		    break;
87 
88 		case sizeof(long):
89 		    push(long, p->lconval);
90 		    break;
91 
92 		default:
93 		    panic("bad size %d for LCON", size(p->nodetype));
94 	    }
95 	    break;
96 
97 	case O_FCON:
98 	    push(double, p->fconval);
99 	    break;
100 
101 	case O_SCON: {
102 	    int len;
103 
104 	    len = size(p->nodetype);
105 	    mov(p->sconval, sp, len);
106 	    sp += len;
107 	    break;
108 	}
109 
110 	case O_INDEX: {
111 	    long n;	/* base address for array */
112 	    long i;	/* index - lower bound */
113 
114 	    n = pop(long);
115 	    i = evalindex(p->left->nodetype, p->right);
116 	    push(long, n + i*size(p->nodetype));
117 	    break;
118 	}
119 
120 	case O_INDIR: {
121 	    ADDRESS a;
122 
123 	    a = pop(ADDRESS);
124 	    if (a == 0) {
125 		error("reference through nil pointer");
126 	    }
127 	    dread(sp, a, sizeof(ADDRESS));
128 	    sp += sizeof(ADDRESS);
129 	    break;
130 	}
131 
132 	/*
133 	 * Get the value of the expression addressed by the top of the stack.
134 	 * Push the result back on the stack.
135 	 */
136 
137 	case O_RVAL: {
138 	    ADDRESS addr, len;
139 	    long i;
140 
141 	    addr = pop(long);
142 	    if (addr == 0) {
143 		error("reference through nil pointer");
144 	    }
145 	    len = size(p->nodetype);
146 	    if (!rpush(addr, len)) {
147 		error("expression too large to evaluate");
148 	    }
149 	    break;
150 	}
151 
152 	case O_COMMA:
153 	    break;
154 
155 	case O_ITOF:
156 	    push(double, (double) r0);
157 	    break;
158 
159 	case O_ADD:
160 	    push(long, r0+r1);
161 	    break;
162 
163 	case O_ADDF:
164 	    push(double, fr0+fr1);
165 	    break;
166 
167 	case O_SUB:
168 	    push(long, r0-r1);
169 	    break;
170 
171 	case O_SUBF:
172 	    push(double, fr0-fr1);
173 	    break;
174 
175 	case O_NEG:
176 	    push(long, -r0);
177 	    break;
178 
179 	case O_NEGF:
180 	    push(double, -fr0);
181 	    break;
182 
183 	case O_MUL:
184 	    push(long, r0*r1);
185 	    break;
186 
187 	case O_MULF:
188 	    push(double, fr0*fr1);
189 	    break;
190 
191 	case O_DIVF:
192 	    if (fr1 == 0) {
193 		error("error: division by 0");
194 	    }
195 	    push(double, fr0/fr1);
196 	    break;
197 
198 	case O_DIV:
199 	    if (r1 == 0) {
200 		error("error: div by 0");
201 	    }
202 	    push(long, r0/r1);
203 	    break;
204 
205 	case O_MOD:
206 	    if (r1 == 0) {
207 		error("error: mod by 0");
208 	    }
209 	    push(long, r0%r1);
210 	    break;
211 
212 	case O_LT:
213 	    push(Boolean, r0 < r1);
214 	    break;
215 
216 	case O_LTF:
217 	    push(Boolean, fr0 < fr1);
218 	    break;
219 
220 	case O_LE:
221 	    push(Boolean, r0 <= r1);
222 	    break;
223 
224 	case O_LEF:
225 	    push(Boolean, fr0 <= fr1);
226 	    break;
227 
228 	case O_GT:
229 	    push(Boolean, r0 > r1);
230 	    break;
231 
232 	case O_GTF:
233 	    push(Boolean, fr0 > fr1);
234 	    break;
235 
236 	case O_EQ:
237 	    push(Boolean, r0 == r1);
238 	    break;
239 
240 	case O_EQF:
241 	    push(Boolean, fr0 == fr1);
242 	    break;
243 
244 	case O_NE:
245 	    push(Boolean, r0 != r1);
246 	    break;
247 
248 	case O_NEF:
249 	    push(Boolean, fr0 != fr1);
250 	    break;
251 
252 	case O_AND:
253 	    push(Boolean, r0 && r1);
254 	    break;
255 
256 	case O_OR:
257 	    push(Boolean, r0 || r1);
258 	    break;
259 
260 	case O_ASSIGN:
261 	    assign(p->left, p->right);
262 	    break;
263 
264 	case O_CHFILE:
265 	    if (p->sconval == NIL) {
266 		printf("%s\n", cursource);
267 	    } else {
268 		fp = fopen(p->sconval, "r");
269 		if (fp == NIL) {
270 		    error("can't read \"%s\"", p->sconval);
271 		} else {
272 		    fclose(fp);
273 		    skimsource(p->sconval);
274 		}
275 	    }
276 	    break;
277 
278 	case O_CONT:
279 	    cont();
280 	    printnews();
281 	    break;
282 
283 	case O_LIST: {
284 	    SYM *b;
285 	    ADDRESS addr;
286 
287 	    if (p->left->op == O_NAME) {
288 		b = p->left->nameval;
289 		if (!isblock(b)) {
290 		    error("\"%s\" is not a procedure or function", name(b));
291 		}
292 		addr = firstline(b);
293 		if (addr == -1) {
294 		    error("\"%s\" is empty", name(b));
295 		}
296 		skimsource(srcfilename(addr));
297 		r0 = srcline(addr);
298 		r1 = r0 + 5;
299 		if (r1 > lastlinenum) {
300 		    r1 = lastlinenum;
301 		}
302 		r0 = r0 - 5;
303 		if (r0 < 1) {
304 		    r0 = 1;
305 		}
306 	    } else {
307 		eval(p->left->right);
308 		eval(p->left->left);
309 		r0 = pop(long);
310 		r1 = pop(long);
311 	    }
312 	    printlines((LINENO) r0, (LINENO) r1);
313 	    break;
314 	}
315 
316 	case O_XI:
317 	case O_XD:
318 	{
319 	    SYM *b;
320 
321 	    if (p->left->op == O_CALL) {
322 		b = p->left->left->nameval;
323 		r0 = codeloc(b);
324 		r1 = firstline(b);
325 	    } else {
326 		eval(p->left->right);
327 		eval(p->left->left);
328 		r0 = pop(long);
329 		r1 = pop(long);
330 	    }
331 	    if (p->op == O_XI)  {
332 		printinst((ADDRESS) r0, (ADDRESS) r1);
333 	    } else {
334 		printdata((ADDRESS) r0, (ADDRESS) r1);
335 	    }
336 	    break;
337 	}
338 
339 	case O_NEXT:
340 	    next();
341 	    printnews();
342 	    break;
343 
344 	case O_PRINT: {
345 	    NODE *o;
346 
347 	    for (o = p->left; o != NIL; o = o->right) {
348 		eval(o->left);
349 		printval(o->left->nodetype);
350 		putchar(' ');
351 	    }
352 	    putchar('\n');
353 	    break;
354 	}
355 
356 	case O_STEP:
357 	    stepc();
358 	    printnews();
359 	    break;
360 
361 	case O_WHATIS:
362 	    if (p->left->op == O_NAME) {
363 		printdecl(p->left->nameval);
364 	    } else {
365 		printdecl(p->left->nodetype);
366 	    }
367 	    break;
368 
369 	case O_WHICH:
370 	    printwhich(p->nameval);
371 	    putchar('\n');
372 	    break;
373 
374 	case O_WHERE:
375 	    where();
376 	    break;
377 
378 	case O_ALIAS:
379 	    alias(p->left->sconval, p->right->sconval);
380 	    break;
381 
382 	case O_CALL:
383 	    callproc(p->left, p->right);
384 	    break;
385 
386 	case O_EDIT:
387 	    edit(p->sconval);
388 	    break;
389 
390 	case O_DUMP:
391 	    dump();
392 	    break;
393 
394 	case O_GRIPE:
395 	    gripe();
396 	    break;
397 
398 	case O_HELP:
399 	    help();
400 	    break;
401 
402 	case O_REMAKE:
403 	    remake();
404 	    break;
405 
406 	case O_RUN:
407 	    run();
408 	    break;
409 
410 	case O_SOURCE:
411 	    setinput(p->sconval);
412 	    break;
413 
414 	case O_STATUS:
415 	    status();
416 	    break;
417 
418 	case O_TRACE:
419 	case O_TRACEI:
420 	    trace(p->op, p->what, p->where, p->cond);
421 	    if (isstdin()) {
422 		status();
423 	    }
424 	    break;
425 
426 	case O_STOP:
427 	case O_STOPI:
428 	    stop(p->op, p->what, p->where, p->cond);
429 	    if (isstdin()) {
430 		status();
431 	    }
432 	    break;
433 
434 	case O_DELETE:
435 	    eval(p->left);
436 	    delbp((unsigned int) pop(long));
437 	    break;
438 
439 	default:
440 	    panic("eval: bad op %d", p->op);
441     }
442 }
443 
444 /*
445  * Push "len" bytes onto the expression stack from address "addr"
446  * in the process.  Normally TRUE is returned, however if there
447  * isn't enough room on the stack, rpush returns FALSE.
448  */
449 
450 BOOLEAN rpush(addr, len)
451 ADDRESS addr;
452 int len;
453 {
454     BOOLEAN success;
455 
456     if (sp + len >= &stack[STACKSIZE]) {
457 	success = FALSE;
458     } else {
459 	dread(sp, addr, len);
460 	sp += len;
461 	success = TRUE;
462     }
463     return success;
464 }
465 
466 /*
467  * Pop an item of the given type which is assumed to be no larger
468  * than a long and return it expanded into a long.
469  */
470 
471 long popsmall(t)
472 SYM *t;
473 {
474     long r;
475 
476     switch (size(t)) {
477 	case sizeof(char):
478 	    r = (long) pop(char);
479 	    break;
480 
481 	case sizeof(short):
482 	    r = (long) pop(short);
483 	    break;
484 
485 	case sizeof(long):
486 	    r = pop(long);
487 	    break;
488 
489 	/*
490 	 * A bit of a kludge here.  If an array element is a record,
491 	 * the dot operation will be converted into an addition with
492 	 * the record operand having a type whose size may be larger
493 	 * than a word.  Now actually this is a pointer, but the subscript
494 	 * operation isn't aware of this, so it's just hacked here.
495 	 *
496 	 * The right thing to do is to make dot directly evaluated
497 	 * instead of changing it into addition.
498 	 */
499 	default:
500 	    r = pop(ADDRESS);
501 	    break;
502     }
503     return r;
504 }
505 
506 /*
507  * evaluate a conditional expression
508  */
509 
510 BOOLEAN cond(p)
511 NODE *p;
512 {
513     if (p == NIL) {
514 	return(TRUE);
515     }
516     eval(p);
517     return(pop(BOOLEAN));
518 }
519 
520 /*
521  * Return the address corresponding to a given tree.
522  */
523 
524 ADDRESS lval(p)
525 NODE *p;
526 {
527     eval(p);
528     return(pop(ADDRESS));
529 }
530