[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.4 %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.
 */

#define STACKSIZE 2000

STACK stack[STACKSIZE];
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;
	    if (!isvariable(s)) {
		error("cannot evaluate a %s", classname(s));
	    } else {
		f = container(s);
		if (!isactive(f)) {
		    error("\"%s\" is not active", name(f));
		}
		push(int, address(s, NIL));
	    }
	    break;
	}

	case O_LCON:
	    switch (size(p->nodetype)) {
		case sizeof(char):
		    push(char, p->lconval);
		    break;

		case sizeof(short):
		    push(short, p->lconval);
		    break;

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

		default:
		    panic("bad size %d for LCON", size(p->nodetype));
	    }
	    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, popsmall(p->right->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);
	    if (!rpush(addr, len)) {
		error("expression too large to evaluate");
	    }
	    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_GRIPE:
	    gripe();
	    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);
    }
}

/*
 * Push "len" bytes onto the expression stack from address "addr"
 * in the process.  Normally TRUE is returned, however if there
 * isn't enough room on the stack, rpush returns FALSE.
 */

BOOLEAN rpush(addr, len)
ADDRESS addr;
int len;
{
    BOOLEAN success;

    if (sp + len >= &stack[STACKSIZE]) {
	success = FALSE;
    } else {
	dread(sp, addr, len);
	sp += len;
	success = TRUE;
    }
    return success;
}

/*
 * Pop an item of the given type which is assumed to be no larger
 * than a long and return it expanded into a long.
 */

long popsmall(t)
SYM *t;
{
    long r;

    switch (size(t)) {
	case sizeof(char):
	    r = (long) pop(char);
	    break;

	case sizeof(short):
	    r = (long) pop(short);
	    break;

	case sizeof(long):
	    r = pop(long);
	    break;

	default:
	    panic("popsmall: size is %d", size(t));
    }
    return r;
}

/*
 * 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 */
5b6b24ef ML	2
c6f75efb	3	static char sccsid[] = "@(#)eval.c 1.4 %G%";
5b6b24ef ML	4
5b6b24ef ML	5	/*
bd480296	6	* Parse tree evaluation.
5b6b24ef ML	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
bd480296 ML	23	#define STACKSIZE 2000
	24
	25	STACK stack[STACKSIZE];
5b6b24ef ML	26	STACK *sp = &stack[0];
	27
	28	eval(p)
	29	register NODE *p;
	30	{
dd7219e6 ML	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;
c6f75efb ML	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));
dd7219e6	71	}
dd7219e6	72	break;
5b6b24ef	73	}
5b6b24ef	74
dd7219e6 ML	75	case O_LCON:
	76	switch (size(p->nodetype)) {
	77	case sizeof(char):
	78	push(char, p->lconval);
	79	break;
5b6b24ef	80
dd7219e6 ML	81	case sizeof(short):
	82	push(short, p->lconval);
	83	break;
5b6b24ef	84
dd7219e6 ML	85	case sizeof(long):
	86	push(long, p->lconval);
	87	break;
5b6b24ef	88
dd7219e6 ML	89	default:
	90	panic("bad size %d for LCON", size(p->nodetype));
	91	}
	92	break;
5b6b24ef	93
dd7219e6 ML	94	case O_FCON:
	95	push(double, p->fconval);
	96	break;
5b6b24ef	97
dd7219e6 ML	98	case O_SCON: {
dd7219e6 ML	99	int len;
5b6b24ef	100
dd7219e6 ML	101	len = size(p->nodetype);
	102	mov(p->sconval, sp, len);
	103	sp += len;
	104	break;
	105	}
5b6b24ef	106
dd7219e6 ML	107	case O_INDEX: {
	108	int n;
	109	long i;
5b6b24ef	110
dd7219e6 ML	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	}
5b6b24ef	116
dd7219e6 ML	117	case O_INDIR: {
dd7219e6 ML	118	ADDRESS a;
5b6b24ef	119
dd7219e6 ML	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	}
5b6b24ef	128
dd7219e6 ML	129	/*
	130	* Get the value of the expression addressed by the top of the stack.
	131	* Push the result back on the stack. Never push less than a long.
	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	}
5b6b24ef	148
dd7219e6 ML	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
277	if (p->left->op == O_NAME) {
278	b = p->left->nameval;
279	if (!isblock(b)) {
280	error("\"%s\" is not a procedure or function", name(b));
281	}
282	r0 = srcline(firstline(b));
283	r1 = r0 + 5;
284	if (r1 > lastlinenum) {
285	r1 = lastlinenum;
5b6b24ef	286	}
dd7219e6 ML	287	r0 = r0 - 5;
	288	if (r0 < 1) {
	289	r0 = 1;
	290	}
	291	} else {
	292	eval(p->left->right);
	293	eval(p->left->left);
	294	r0 = pop(long);
	295	r1 = pop(long);
	296	}
	297	printlines((LINENO) r0, (LINENO) r1);
	298	break;
	299	}
5b6b24ef	300
dd7219e6 ML	301	case O_XI:
	302	case O_XD:
	303	{
	304	SYM *b;
	305
	306	if (p->left->op == O_CALL) {
	307	b = p->left->left->nameval;
	308	r0 = codeloc(b);
	309	r1 = firstline(b);
	310	} else {
	311	eval(p->left->right);
	312	eval(p->left->left);
	313	r0 = pop(long);
	314	r1 = pop(long);
	315	}
	316	if (p->op == O_XI) {
	317	printinst((ADDRESS) r0, (ADDRESS) r1);
	318	} else {
	319	printdata((ADDRESS) r0, (ADDRESS) r1);
	320	}
	321	break;
	322	}
5b6b24ef	323
dd7219e6 ML	324	case O_NEXT:
	325	next();
	326	printnews();
	327	break;
	328
	329	case O_PRINT: {
	330	NODE *o;
	331
	332	for (o = p->left; o != NIL; o = o->right) {
	333	eval(o->left);
	334	printval(o->left->nodetype);
	335	putchar(' ');
	336	}
	337	putchar('\n');
	338	break;
5b6b24ef	339	}
dd7219e6 ML	340
	341	case O_STEP:
	342	stepc();
	343	printnews();
	344	break;
	345
	346	case O_WHATIS:
	347	if (p->left->op == O_NAME) {
	348	printdecl(p->left->nameval);
	349	} else {
	350	printdecl(p->left->nodetype);
	351	}
	352	break;
	353
	354	case O_WHICH:
	355	printwhich(p->nameval);
	356	putchar('\n');
	357	break;
	358
	359	case O_WHERE:
	360	where();
	361	break;
	362
	363	case O_ALIAS:
	364	alias(p->left->sconval, p->right->sconval);
	365	break;
	366
	367	case O_CALL:
	368	callproc(p->left, p->right);
	369	break;
	370
	371	case O_EDIT:
	372	edit(p->sconval);
	373	break;
	374
	375	case O_DUMP:
	376	dump();
	377	break;
	378
	379	case O_GRIPE:
	380	gripe();
	381	break;
	382
	383	case O_HELP:
	384	help();
	385	break;
	386
	387	case O_REMAKE:
	388	remake();
	389	break;
	390
	391	case O_RUN:
	392	run();
	393	break;
	394
	395	case O_SOURCE:
	396	setinput(p->sconval);
	397	break;
	398
	399	case O_STATUS:
	400	status();
	401	break;
	402
	403	case O_TRACE:
404	case O_TRACEI:
405	trace(p->op, p->what, p->where, p->cond);
406	if (isstdin()) {
407	status();
408	}
409	break;
410
411	case O_STOP:
412	case O_STOPI:
413	stop(p->op, p->what, p->where, p->cond);
414	if (isstdin()) {
415	status();
416	}
417	break;
418
419	case O_DELETE:
420	eval(p->left);
421	delbp((unsigned int) pop(long));
422	break;
423
424	default:
425	panic("eval: bad op %d", p->op);
426	}
5b6b24ef ML	427	}
5b6b24ef ML	428
bd480296 ML	429	/*
	430	* Push "len" bytes onto the expression stack from address "addr"
	431	* in the process. Normally TRUE is returned, however if there
	432	* isn't enough room on the stack, rpush returns FALSE.
bd480296 ML	433	*/
	434
	435	BOOLEAN rpush(addr, len)
	436	ADDRESS addr;
	437	int len;
	438	{
dd7219e6 ML	439	BOOLEAN success;
	440
	441	if (sp + len >= &stack[STACKSIZE]) {
	442	success = FALSE;
	443	} else {
	444	dread(sp, addr, len);
	445	sp += len;
	446	success = TRUE;
	447	}
	448	return success;
	449	}
	450
	451	/*
	452	* Pop an item of the given type which is assumed to be no larger
	453	* than a long and return it expanded into a long.
	454	*/
	455
	456	long popsmall(t)
	457	SYM *t;
	458	{
	459	long r;
	460
	461	switch (size(t)) {
	462	case sizeof(char):
	463	r = (long) pop(char);
	464	break;
	465
	466	case sizeof(short):
	467	r = (long) pop(short);
	468	break;
	469
	470	case sizeof(long):
	471	r = pop(long);
	472	break;
	473
	474	default:
	475	panic("popsmall: size is %d", size(t));
	476	}
	477	return r;
bd480296 ML	478	}
bd480296 ML	479
5b6b24ef ML	480	/*
	481	* evaluate a conditional expression
	482	*/
	483
	484	BOOLEAN cond(p)
	485	NODE *p;
	486	{
dd7219e6 ML	487	if (p == NIL) {
	488	return(TRUE);
	489	}
	490	eval(p);
	491	return(pop(BOOLEAN));
5b6b24ef ML	492	}
	493
	494	/*
	495	* Return the address corresponding to a given tree.
	496	*/
	497
	498	ADDRESS lval(p)
	499	NODE *p;
	500	{
dd7219e6 ML	501	eval(p);
dd7219e6 ML	502	return(pop(ADDRESS));
5b6b24ef	503	}