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