xref: /csrg-svn/usr.bin/pascal/pdx/tree/eval.c (revision 6083) 
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)eval.c 1.6 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 	    ADDRESS addr;
277 
278 	    if (p->left->op == O_NAME) {
279 		b = p->left->nameval;
280 		if (!isblock(b)) {
281 		    error("\"%s\" is not a procedure or function", name(b));
282 		}
283 		addr = firstline(b);
284 		if (addr == -1) {
285 		    error("\"%s\" is empty", name(b));
286 		}
287 		skimsource(srcfilename(addr));
288 		r0 = srcline(addr);
289 		r1 = r0 + 5;
290 		if (r1 > lastlinenum) {
291 		    r1 = lastlinenum;
292 		}
293 		r0 = r0 - 5;
294 		if (r0 < 1) {
295 		    r0 = 1;
296 		}
297 	    } else {
298 		eval(p->left->right);
299 		eval(p->left->left);
300 		r0 = pop(long);
301 		r1 = pop(long);
302 	    }
303 	    printlines((LINENO) r0, (LINENO) r1);
304 	    break;
305 	}
306 
307 	case O_XI:
308 	case O_XD:
309 	{
310 	    SYM *b;
311 
312 	    if (p->left->op == O_CALL) {
313 		b = p->left->left->nameval;
314 		r0 = codeloc(b);
315 		r1 = firstline(b);
316 	    } else {
317 		eval(p->left->right);
318 		eval(p->left->left);
319 		r0 = pop(long);
320 		r1 = pop(long);
321 	    }
322 	    if (p->op == O_XI)  {
323 		printinst((ADDRESS) r0, (ADDRESS) r1);
324 	    } else {
325 		printdata((ADDRESS) r0, (ADDRESS) r1);
326 	    }
327 	    break;
328 	}
329 
330 	case O_NEXT:
331 	    next();
332 	    printnews();
333 	    break;
334 
335 	case O_PRINT: {
336 	    NODE *o;
337 
338 	    for (o = p->left; o != NIL; o = o->right) {
339 		eval(o->left);
340 		printval(o->left->nodetype);
341 		putchar(' ');
342 	    }
343 	    putchar('\n');
344 	    break;
345 	}
346 
347 	case O_STEP:
348 	    stepc();
349 	    printnews();
350 	    break;
351 
352 	case O_WHATIS:
353 	    if (p->left->op == O_NAME) {
354 		printdecl(p->left->nameval);
355 	    } else {
356 		printdecl(p->left->nodetype);
357 	    }
358 	    break;
359 
360 	case O_WHICH:
361 	    printwhich(p->nameval);
362 	    putchar('\n');
363 	    break;
364 
365 	case O_WHERE:
366 	    where();
367 	    break;
368 
369 	case O_ALIAS:
370 	    alias(p->left->sconval, p->right->sconval);
371 	    break;
372 
373 	case O_CALL:
374 	    callproc(p->left, p->right);
375 	    break;
376 
377 	case O_EDIT:
378 	    edit(p->sconval);
379 	    break;
380 
381 	case O_DUMP:
382 	    dump();
383 	    break;
384 
385 	case O_GRIPE:
386 	    gripe();
387 	    break;
388 
389 	case O_HELP:
390 	    help();
391 	    break;
392 
393 	case O_REMAKE:
394 	    remake();
395 	    break;
396 
397 	case O_RUN:
398 	    run();
399 	    break;
400 
401 	case O_SOURCE:
402 	    setinput(p->sconval);
403 	    break;
404 
405 	case O_STATUS:
406 	    status();
407 	    break;
408 
409 	case O_TRACE:
410 	case O_TRACEI:
411 	    trace(p->op, p->what, p->where, p->cond);
412 	    if (isstdin()) {
413 		status();
414 	    }
415 	    break;
416 
417 	case O_STOP:
418 	case O_STOPI:
419 	    stop(p->op, p->what, p->where, p->cond);
420 	    if (isstdin()) {
421 		status();
422 	    }
423 	    break;
424 
425 	case O_DELETE:
426 	    eval(p->left);
427 	    delbp((unsigned int) pop(long));
428 	    break;
429 
430 	default:
431 	    panic("eval: bad op %d", p->op);
432     }
433 }
434 
435 /*
436  * Push "len" bytes onto the expression stack from address "addr"
437  * in the process.  Normally TRUE is returned, however if there
438  * isn't enough room on the stack, rpush returns FALSE.
439  */
440 
441 BOOLEAN rpush(addr, len)
442 ADDRESS addr;
443 int len;
444 {
445     BOOLEAN success;
446 
447     if (sp + len >= &stack[STACKSIZE]) {
448 	success = FALSE;
449     } else {
450 	dread(sp, addr, len);
451 	sp += len;
452 	success = TRUE;
453     }
454     return success;
455 }
456 
457 /*
458  * Pop an item of the given type which is assumed to be no larger
459  * than a long and return it expanded into a long.
460  */
461 
462 long popsmall(t)
463 SYM *t;
464 {
465     long r;
466 
467     switch (size(t)) {
468 	case sizeof(char):
469 	    r = (long) pop(char);
470 	    break;
471 
472 	case sizeof(short):
473 	    r = (long) pop(short);
474 	    break;
475 
476 	case sizeof(long):
477 	    r = pop(long);
478 	    break;
479 
480 	default:
481 	    panic("popsmall: size is %d", size(t));
482     }
483     return r;
484 }
485 
486 /*
487  * evaluate a conditional expression
488  */
489 
490 BOOLEAN cond(p)
491 NODE *p;
492 {
493     if (p == NIL) {
494 	return(TRUE);
495     }
496     eval(p);
497     return(pop(BOOLEAN));
498 }
499 
500 /*
501  * Return the address corresponding to a given tree.
502  */
503 
504 ADDRESS lval(p)
505 NODE *p;
506 {
507     eval(p);
508     return(pop(ADDRESS));
509 }
510