[unix-history] / usr / src / usr.bin / pascal / pdx / tree / eval.c

/* Copyright (c) 1982 Regents of the University of California */

static char sccsid[] = "@(#)eval.c 1.1 %G%";

/*
 * parse tree evaluation
 */

#include "defs.h"
#include "tree.h"
#include "sym.h"
#include "process.h"
#include "source.h"
#include "mappings.h"
#include "breakpoint.h"
#include "machine.h"
#include "tree.rep"

/*
 * Evaluate a parse tree using a stack; value is left at top.
 */

STACK *sp = &stack[0];

eval(p)
register NODE *p;
{
	long r0, r1;
	double fr0, fr1;

	if (p == NULL) {
		return;
	}
	switch(degree(p->op)) {
		case BINARY:
			eval(p->right);
			if (isreal(p->op)) {
				fr1 = pop(double);
			} else if (isint(p->op)) {
				r1 = pop(long);
			}
			/* fall through */
		case UNARY:
			eval(p->left);
			if (isreal(p->op)) {
				fr0 = pop(double);
			} else if (isint(p->op)) {
				r0 = pop(long);
			}
			break;

		default:
			/* do nothing */;
		}
	switch(p->op) {
		case O_NAME: {
			SYM *s, *f;

			s = p->nameval;
			f = container(s);
			if (!isactive(f)) {
				error("\"%s\" is not active", name(f));
			}
			push(int, address(s, NIL));
			break;
		}

		case O_LCON:
			push(long, p->lconval);
			break;

		case O_FCON:
			push(double, p->fconval);
			break;

		case O_SCON: {
			int len;

			len = size(p->nodetype);
			mov(p->sconval, sp, len);
			sp += len;
			break;
		}

		case O_INDEX: {
			int n;
			long i;

			n = pop(int);
			i = evalindex(p->left->nodetype);
			push(int, n + i*size(p->nodetype));
			break;
		}

		case O_INDIR: {
			ADDRESS a;

			a = pop(ADDRESS);
			if (a == 0) {
				error("reference through nil pointer");
			}
			dread(sp, a, sizeof(ADDRESS));
			sp += sizeof(ADDRESS);
			break;
		}

		/*
		 * Get the value of the expression addressed by the top of the stack.
		 * Push the result back on the stack.  Never push less than a long.
		 */

		case O_RVAL: {
			ADDRESS addr, len;
			long i;

			addr = pop(int);
			if (addr == 0) {
				error("reference through nil pointer");
			}
			len = size(p->nodetype);
			dread(sp, addr, len);
			sp += len;
			if (len < sizeof(long)) {
				switch (len) {
					case sizeof(char):
						i = pop(char);
						break;

					case sizeof(short):
						i = pop(short);
						break;

					default:
						panic("bad size in RVAL");
				}
				push(long, i);
			}
			break;
		}

		case O_COMMA:
			break;

		case O_ITOF:
			push(double, (double) r0);
			break;

		case O_ADD:
			push(long, r0+r1);
			break;

		case O_ADDF:
			push(double, fr0+fr1);
			break;

		case O_SUB:
			push(long, r0-r1);
			break;

		case O_SUBF:
			push(double, fr0-fr1);
			break;

		case O_NEG:
			push(long, -r0);
			break;

		case O_NEGF:
			push(double, -fr0);
			break;

		case O_MUL:
			push(long, r0*r1);
			break;

		case O_MULF:
			push(double, fr0*fr1);
			break;

		case O_DIVF:
			if (fr1 == 0) {
				error("error: division by 0");
			}
			push(double, fr0/fr1);
			break;

		case O_DIV:
			if (r1 == 0) {
				error("error: div by 0");
			}
			push(long, r0/r1);
			break;

		case O_MOD:
			if (r1 == 0) {
				error("error: mod by 0");
			}
			push(long, r0%r1);
			break;

		case O_LT:
			push(BOOLEAN, r0 < r1);
			break;

		case O_LTF:
			push(BOOLEAN, fr0 < fr1);
			break;

		case O_LE:
			push(BOOLEAN, r0 <= r1);
			break;

		case O_LEF:
			push(BOOLEAN, fr0 <= fr1);
			break;

		case O_GT:
			push(BOOLEAN, r0 > r1);
			break;

		case O_GTF:
			push(BOOLEAN, fr0 > fr1);
			break;

		case O_EQ:
			push(BOOLEAN, r0 == r1);
			break;

		case O_EQF:
			push(BOOLEAN, fr0 == fr1);
			break;

		case O_NE:
			push(BOOLEAN, r0 != r1);
			break;

		case O_NEF:
			push(BOOLEAN, fr0 != fr1);
			break;

		case O_AND:
			push(BOOLEAN, r0 && r1);
			break;

		case O_OR:
			push(BOOLEAN, r0 || r1);
			break;

		case O_ASSIGN:
			assign(p->left, p->right);
			break;

		case O_CHFILE:
			if (p->sconval == NIL) {
				printf("%s\n", cursource);
			} else {
				skimsource(p->sconval);
			}
			break;

		case O_CONT:
			cont();
			printnews();
			break;

		case O_LIST: {
			SYM *b;

			if (p->left->op == O_NAME) {
				b = p->left->nameval;
				if (!isblock(b)) {
					error("\"%s\" is not a procedure or function", name(b));
				}
				r0 = srcline(firstline(b));
				r1 = r0 + 5;
				if (r1 > lastlinenum) {
					r1 = lastlinenum;
				}
				r0 = r0 - 5;
				if (r0 < 1) {
					r0 = 1;
				}
			} else {
				eval(p->left->right);
				eval(p->left->left);
				r0 = pop(long);
				r1 = pop(long);
			}
			printlines((LINENO) r0, (LINENO) r1);
			break;
		}

		case O_XI:
		case O_XD:
		{
			SYM *b;

			if (p->left->op == O_CALL) {
				b = p->left->left->nameval;
				r0 = codeloc(b);
				r1 = firstline(b);
			} else {
				eval(p->left->right);
				eval(p->left->left);
				r0 = pop(long);
				r1 = pop(long);
			}
			if (p->op == O_XI)  {
				printinst((ADDRESS) r0, (ADDRESS) r1);
			} else {
				printdata((ADDRESS) r0, (ADDRESS) r1);
			}
			break;
		}

		case O_NEXT:
			next();
			printnews();
			break;

		case O_PRINT: {
			NODE *o;

			for (o = p->left; o != NIL; o = o->right) {
				eval(o->left);
				printval(o->left->nodetype);
				putchar(' ');
			}
			putchar('\n');
			break;
		}

		case O_STEP:
			stepc();
			printnews();
			break;

		case O_WHATIS:
			if (p->left->op == O_NAME) {
				printdecl(p->left->nameval);
			} else {
				printdecl(p->left->nodetype);
			}
			break;

		case O_WHICH:
			printwhich(p->nameval);
			putchar('\n');
			break;

		case O_WHERE:
			where();
			break;

		case O_ALIAS:
			alias(p->left->sconval, p->right->sconval);
			break;

		case O_CALL:
			callproc(p->left, p->right);
			break;

		case O_EDIT:
			edit(p->sconval);
			break;

		case O_DUMP:
			dump();
			break;

		case O_HELP:
			help();
			break;

		case O_REMAKE:
			remake();
			break;

		case O_RUN:
			run();
			break;

		case O_SOURCE:
			setinput(p->sconval);
			break;

		case O_STATUS:
			status();
			break;

		case O_TRACE:
		case O_TRACEI:
			trace(p->op, p->what, p->where, p->cond);
			if (isstdin()) {
				status();
			}
			break;

		case O_STOP:
		case O_STOPI:
			stop(p->op, p->what, p->where, p->cond);
			if (isstdin()) {
				status();
			}
			break;

		case O_DELETE:
			eval(p->left);
			delbp((unsigned int) pop(long));
			break;

		default:
			panic("eval: bad op %d", p->op);
	}
}

/*
 * evaluate a conditional expression
 */

BOOLEAN cond(p)
NODE *p;
{
	if (p == NIL) {
		return(TRUE);
	}
	eval(p);
	return(pop(BOOLEAN));
}

/*
 * Return the address corresponding to a given tree.
 */

ADDRESS lval(p)
NODE *p;
{
	eval(p);
	return(pop(ADDRESS));
}
Commit	Line	Data
5b6b24ef ML	1	/* Copyright (c) 1982 Regents of the University of California */
	2
	3	static char sccsid[] = "@(#)eval.c 1.1 %G%";
	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	}