xref: /csrg-svn/usr.bin/pascal/pdx/tree/eval.c (revision 5562)
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)eval.c 1.2 01/18/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 			push(long, p->lconval);
73 			break;
74 
75 		case O_FCON:
76 			push(double, p->fconval);
77 			break;
78 
79 		case O_SCON: {
80 			int len;
81 
82 			len = size(p->nodetype);
83 			mov(p->sconval, sp, len);
84 			sp += len;
85 			break;
86 		}
87 
88 		case O_INDEX: {
89 			int n;
90 			long i;
91 
92 			n = pop(int);
93 			i = evalindex(p->left->nodetype);
94 			push(int, n + i*size(p->nodetype));
95 			break;
96 		}
97 
98 		case O_INDIR: {
99 			ADDRESS a;
100 
101 			a = pop(ADDRESS);
102 			if (a == 0) {
103 				error("reference through nil pointer");
104 			}
105 			dread(sp, a, sizeof(ADDRESS));
106 			sp += sizeof(ADDRESS);
107 			break;
108 		}
109 
110 		/*
111 		 * Get the value of the expression addressed by the top of the stack.
112 		 * Push the result back on the stack.  Never push less than a long.
113 		 */
114 
115 		case O_RVAL: {
116 			ADDRESS addr, len;
117 			long i;
118 
119 			addr = pop(int);
120 			if (addr == 0) {
121 				error("reference through nil pointer");
122 			}
123 			len = size(p->nodetype);
124 			if (!rpush(addr, len)) {
125 				error("expression too large to evaluate");
126 			}
127 			if (len < sizeof(long)) {
128 				switch (len) {
129 					case sizeof(char):
130 						i = pop(char);
131 						break;
132 
133 					case sizeof(short):
134 						i = pop(short);
135 						break;
136 
137 					default:
138 						panic("bad size in RVAL");
139 				}
140 				push(long, i);
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 
432 BOOLEAN rpush(addr, len)
433 ADDRESS addr;
434 int len;
435 {
436 	BOOLEAN success;
437 
438 	if (sp + len >= &stack[STACKSIZE]) {
439 		success = FALSE;
440 	} else {
441 		dread(sp, addr, len);
442 		sp += len;
443 		success = TRUE;
444 	}
445 	return success;
446 }
447 
448 /*
449  * evaluate a conditional expression
450  */
451 
452 BOOLEAN cond(p)
453 NODE *p;
454 {
455 	if (p == NIL) {
456 		return(TRUE);
457 	}
458 	eval(p);
459 	return(pop(BOOLEAN));
460 }
461 
462 /*
463  * Return the address corresponding to a given tree.
464  */
465 
466 ADDRESS lval(p)
467 NODE *p;
468 {
469 	eval(p);
470 	return(pop(ADDRESS));
471 }
472