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