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