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