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