usr/src/usr.bin/pascal/pdx/tree/eval.c

/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#ifndef lint
static char sccsid[] = "@(#)eval.c	5.2 (Berkeley) %G%";
#endif not lint

/*
 * 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"
#include "process/process.rep"
#include "process/pxinfo.h"

#define Boolean char	/* underlying representation type for booleans */

/*
 * 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;
    FILE *fp;

    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 = popsmall(p->right->nodetype);
	    }
	    /* fall through */
	case UNARY:
	    eval(p->left);
	    if (isreal(p->op)) {
		fr0 = pop(double);
	    } else if (isint(p->op)) {
		r0 = popsmall(p->left->nodetype);
	    }
	    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(long, 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;
#ifdef tahoe
	    alignstack();
#endif tahoe
	    break;
	}

	case O_INDEX: {
	    long n;	/* base address for array */
	    long i;	/* index - lower bound */
	    long evalindex();

	    n = pop(long);
	    i = evalindex(p->left->nodetype, p->right);
	    push(long, 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.
	 */

	case O_RVAL: {
	    ADDRESS addr, len;

	    addr = pop(long);
	    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 {
		fp = fopen(p->sconval, "r");
		if (fp == NIL) {
		    error("can't read \"%s\"", p->sconval);
		} else {
		    fclose(fp);
		    skimsource(p->sconval);
		}
	    }
	    break;

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

	case O_LIST: {
	    SYM *b;
	    ADDRESS addr;

	    if (p->left->op == O_NAME) {
		b = p->left->nameval;
		if (!isblock(b)) {
		    error("\"%s\" is not a procedure or function", name(b));
		}
		addr = firstline(b);
		if ((int)addr == -1) {
		    error("\"%s\" is empty", name(b));
		}
		skimsource(srcfilename(addr));
		r0 = srcline(addr);
		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;
#ifdef tahoe
    register char *savesp = sp;
#endif

    if (sp + len >= &stack[STACKSIZE]) {
	success = FALSE;
    } else {
	dread(sp, addr, len);
	sp += len;
#ifdef tahoe
        alignstack();
	if (sp >= &stack[STACKSIZE]) {
		success = FALSE;
		sp = savesp;
	} else
#endif
	    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;

	/*
	 * A bit of a kludge here.  If an array element is a record,
	 * the dot operation will be converted into an addition with
	 * the record operand having a type whose size may be larger
	 * than a word.  Now actually this is a pointer, but the subscript
	 * operation isn't aware of this, so it's just hacked here.
	 *
	 * The right thing to do is to make dot directly evaluated
	 * instead of changing it into addition.
	 */
	default:
	    r = pop(ADDRESS);
	    break;
    }
    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
	1	/*
	2	* Copyright (c) 1980 Regents of the University of California.
	3	* All rights reserved. The Berkeley software License Agreement
	4	* specifies the terms and conditions for redistribution.
	5	*/
	6
	7	#ifndef lint
	8	static char sccsid[] = "@(#)eval.c 5.2 (Berkeley) %G%";
	9	#endif not lint
	10
	11	/*
	12	* Parse tree evaluation.
	13	*/
	14
	15	#include "defs.h"
	16	#include "tree.h"
	17	#include "sym.h"
	18	#include "process.h"
	19	#include "source.h"
	20	#include "mappings.h"
	21	#include "breakpoint.h"
	22	#include "machine.h"
	23	#include "tree.rep"
	24	#include "process/process.rep"
	25	#include "process/pxinfo.h"
	26
	27	#define Boolean char /* underlying representation type for booleans */
	28
	29	/*
	30	* Evaluate a parse tree using a stack; value is left at top.
	31	*/
	32
	33	#define STACKSIZE 2000
	34
	35	STACK stack[STACKSIZE];
	36	STACK *sp = &stack[0];
	37
	38	eval(p)
	39	register NODE *p;
	40	{
	41	long r0, r1;
	42	double fr0, fr1;
	43	FILE *fp;
	44
	45	if (p == NULL) {
	46	return;
	47	}
	48	switch(degree(p->op)) {
	49	case BINARY:
	50	eval(p->right);
	51	if (isreal(p->op)) {
	52	fr1 = pop(double);
	53	} else if (isint(p->op)) {
	54	r1 = popsmall(p->right->nodetype);
	55	}
	56	/* fall through */
	57	case UNARY:
	58	eval(p->left);
	59	if (isreal(p->op)) {
	60	fr0 = pop(double);
	61	} else if (isint(p->op)) {
	62	r0 = popsmall(p->left->nodetype);
	63	}
	64	break;
	65
	66	default:
	67	/* do nothing */;
	68	}
	69	switch(p->op) {
	70	case O_NAME: {
	71	SYM s, f;
	72
	73	s = p->nameval;
	74	if (!isvariable(s)) {
	75	error("cannot evaluate a %s", classname(s));
	76	} else {
	77	f = container(s);
	78	if (!isactive(f)) {
	79	error("\"%s\" is not active", name(f));
	80	}
	81	push(long, address(s, NIL));
	82	}
	83	break;
	84	}
	85
	86	case O_LCON:
	87	switch (size(p->nodetype)) {
	88	case sizeof(char):
	89	push(char, p->lconval);
	90	break;
	91
	92	case sizeof(short):
	93	push(short, p->lconval);
	94	break;
	95
	96	case sizeof(long):
	97	push(long, p->lconval);
	98	break;
	99
	100	default:
	101	panic("bad size %d for LCON", size(p->nodetype));
	102	}
	103	break;
	104
	105	case O_FCON:
	106	push(double, p->fconval);
	107	break;
	108
	109	case O_SCON: {
	110	int len;
	111
	112	len = size(p->nodetype);
	113	mov(p->sconval, sp, len);
	114	sp += len;
	115	#ifdef tahoe
	116	alignstack();
	117	#endif tahoe
	118	break;
	119	}
	120
	121	case O_INDEX: {
	122	long n; /* base address for array */
	123	long i; /* index - lower bound */
	124	long evalindex();
	125
	126	n = pop(long);
	127	i = evalindex(p->left->nodetype, p->right);
	128	push(long, n + i*size(p->nodetype));
	129	break;
	130	}
	131
	132	case O_INDIR: {
	133	ADDRESS a;
	134
	135	a = pop(ADDRESS);
	136	if (a == 0) {
	137	error("reference through nil pointer");
	138	}
	139	dread(sp, a, sizeof(ADDRESS));
	140	sp += sizeof(ADDRESS);
	141	break;
	142	}
	143
	144	/*
	145	* Get the value of the expression addressed by the top of the stack.
	146	* Push the result back on the stack.
	147	*/
	148
	149	case O_RVAL: {
	150	ADDRESS addr, len;
	151
	152	addr = pop(long);
	153	if (addr == 0) {
	154	error("reference through nil pointer");
	155	}
	156	len = size(p->nodetype);
	157	if (!rpush(addr, len)) {
	158	error("expression too large to evaluate");
	159	}
	160	break;
	161	}
	162
	163	case O_COMMA:
	164	break;
	165
	166	case O_ITOF:
	167	push(double, (double) r0);
	168	break;
	169
	170	case O_ADD:
	171	push(long, r0+r1);
	172	break;
	173
	174	case O_ADDF:
	175	push(double, fr0+fr1);
	176	break;
	177
	178	case O_SUB:
	179	push(long, r0-r1);
	180	break;
	181
	182	case O_SUBF:
	183	push(double, fr0-fr1);
	184	break;
	185
	186	case O_NEG:
	187	push(long, -r0);
	188	break;
	189
	190	case O_NEGF:
	191	push(double, -fr0);
	192	break;
	193
	194	case O_MUL:
	195	push(long, r0*r1);
	196	break;
	197
	198	case O_MULF:
	199	push(double, fr0*fr1);
	200	break;
	201
	202	case O_DIVF:
	203	if (fr1 == 0) {
	204	error("error: division by 0");
	205	}
	206	push(double, fr0/fr1);
	207	break;
	208
	209	case O_DIV:
	210	if (r1 == 0) {
	211	error("error: div by 0");
	212	}
	213	push(long, r0/r1);
	214	break;
	215
	216	case O_MOD:
	217	if (r1 == 0) {
	218	error("error: mod by 0");
	219	}
	220	push(long, r0%r1);
	221	break;
	222
	223	case O_LT:
	224	push(Boolean, r0 < r1);
	225	break;
	226
	227	case O_LTF:
	228	push(Boolean, fr0 < fr1);
	229	break;
	230
	231	case O_LE:
	232	push(Boolean, r0 <= r1);
	233	break;
	234
	235	case O_LEF:
	236	push(Boolean, fr0 <= fr1);
	237	break;
	238
	239	case O_GT:
	240	push(Boolean, r0 > r1);
	241	break;
	242
	243	case O_GTF:
	244	push(Boolean, fr0 > fr1);
	245	break;
	246
	247	case O_EQ:
	248	push(Boolean, r0 == r1);
	249	break;
	250
	251	case O_EQF:
	252	push(Boolean, fr0 == fr1);
	253	break;
	254
	255	case O_NE:
	256	push(Boolean, r0 != r1);
	257	break;
	258
	259	case O_NEF:
	260	push(Boolean, fr0 != fr1);
	261	break;
	262
	263	case O_AND:
	264	push(Boolean, r0 && r1);
	265	break;
	266
	267	case O_OR:
	268	push(Boolean, r0 \|\| r1);
	269	break;
	270
	271	case O_ASSIGN:
	272	assign(p->left, p->right);
	273	break;
	274
	275	case O_CHFILE:
	276	if (p->sconval == NIL) {
	277	printf("%s\n", cursource);
	278	} else {
	279	fp = fopen(p->sconval, "r");
	280	if (fp == NIL) {
	281	error("can't read \"%s\"", p->sconval);
	282	} else {
	283	fclose(fp);
	284	skimsource(p->sconval);
	285	}
	286	}
	287	break;
	288
	289	case O_CONT:
	290	cont();
	291	printnews();
	292	break;
	293
	294	case O_LIST: {
	295	SYM *b;
	296	ADDRESS addr;
	297
	298	if (p->left->op == O_NAME) {
	299	b = p->left->nameval;
	300	if (!isblock(b)) {
	301	error("\"%s\" is not a procedure or function", name(b));
	302	}
	303	addr = firstline(b);
	304	if ((int)addr == -1) {
	305	error("\"%s\" is empty", name(b));
	306	}
	307	skimsource(srcfilename(addr));
	308	r0 = srcline(addr);
	309	r1 = r0 + 5;
	310	if (r1 > lastlinenum) {
	311	r1 = lastlinenum;
	312	}
	313	r0 = r0 - 5;
	314	if (r0 < 1) {
	315	r0 = 1;
	316	}
	317	} else {
	318	eval(p->left->right);
	319	eval(p->left->left);
	320	r0 = pop(long);
	321	r1 = pop(long);
	322	}
	323	printlines((LINENO) r0, (LINENO) r1);
	324	break;
	325	}
	326
	327	case O_XI:
	328	case O_XD:
	329	{
	330	SYM *b;
	331
	332	if (p->left->op == O_CALL) {
	333	b = p->left->left->nameval;
	334	r0 = codeloc(b);
	335	r1 = firstline(b);
	336	} else {
	337	eval(p->left->right);
	338	eval(p->left->left);
	339	r0 = pop(long);
	340	r1 = pop(long);
	341	}
	342	if (p->op == O_XI) {
	343	printinst((ADDRESS) r0, (ADDRESS) r1);
	344	} else {
	345	printdata((ADDRESS) r0, (ADDRESS) r1);
	346	}
	347	break;
	348	}
	349
	350	case O_NEXT:
	351	next();
	352	printnews();
	353	break;
	354
	355	case O_PRINT: {
	356	NODE *o;
	357
	358	for (o = p->left; o != NIL; o = o->right) {
	359	eval(o->left);
	360	printval(o->left->nodetype);
	361	putchar(' ');
	362	}
	363	putchar('\n');
	364	break;
	365	}
	366
	367	case O_STEP:
	368	stepc();
	369	printnews();
	370	break;
	371
	372	case O_WHATIS:
	373	if (p->left->op == O_NAME) {
	374	printdecl(p->left->nameval);
	375	} else {
	376	printdecl(p->left->nodetype);
	377	}
	378	break;
	379
	380	case O_WHICH:
	381	printwhich(p->nameval);
	382	putchar('\n');
	383	break;
	384
	385	case O_WHERE:
	386	where();
	387	break;
	388
	389	case O_ALIAS:
	390	alias(p->left->sconval, p->right->sconval);
	391	break;
	392
	393	case O_CALL:
	394	callproc(p->left, p->right);
	395	break;
	396
	397	case O_EDIT:
	398	edit(p->sconval);
	399	break;
	400
	401	case O_DUMP:
	402	dump();
	403	break;
	404
	405	case O_GRIPE:
	406	gripe();
	407	break;
	408
	409	case O_HELP:
	410	help();
	411	break;
	412
	413	case O_REMAKE:
	414	remake();
	415	break;
	416
	417	case O_RUN:
	418	run();
	419	break;
	420
	421	case O_SOURCE:
	422	setinput(p->sconval);
	423	break;
	424
	425	case O_STATUS:
	426	status();
	427	break;
	428
	429	case O_TRACE:
	430	case O_TRACEI:
	431	trace(p->op, p->what, p->where, p->cond);
	432	if (isstdin()) {
	433	status();
	434	}
	435	break;
	436
	437	case O_STOP:
	438	case O_STOPI:
	439	stop(p->op, p->what, p->where, p->cond);
	440	if (isstdin()) {
	441	status();
	442	}
	443	break;
	444
	445	case O_DELETE:
	446	eval(p->left);
	447	delbp((unsigned int) pop(long));
	448	break;
	449
	450	default:
	451	panic("eval: bad op %d", p->op);
	452	}
	453	}
	454
	455	/*
	456	* Push "len" bytes onto the expression stack from address "addr"
	457	* in the process. Normally TRUE is returned, however if there
	458	* isn't enough room on the stack, rpush returns FALSE.
	459	*/
	460
	461	BOOLEAN rpush(addr, len)
	462	ADDRESS addr;
	463	int len;
	464	{
	465	BOOLEAN success;
	466	#ifdef tahoe
	467	register char *savesp = sp;
	468	#endif
	469
	470	if (sp + len >= &stack[STACKSIZE]) {
	471	success = FALSE;
	472	} else {
	473	dread(sp, addr, len);
	474	sp += len;
	475	#ifdef tahoe
	476	alignstack();
	477	if (sp >= &stack[STACKSIZE]) {
	478	success = FALSE;
	479	sp = savesp;
	480	} else
	481	#endif
	482	success = TRUE;
	483	}
	484	return success;
	485	}
	486
	487	/*
	488	* Pop an item of the given type which is assumed to be no larger
	489	* than a long and return it expanded into a long.
	490	*/
	491
	492	long popsmall(t)
	493	SYM *t;
	494	{
	495	long r;
	496
	497	switch (size(t)) {
	498	case sizeof(char):
	499	r = (long) pop(char);
	500	break;
	501
	502	case sizeof(short):
	503	r = (long) pop(short);
	504	break;
	505
	506	case sizeof(long):
	507	r = pop(long);
	508	break;
	509
	510	/*
	511	* A bit of a kludge here. If an array element is a record,
	512	* the dot operation will be converted into an addition with
	513	* the record operand having a type whose size may be larger
	514	* than a word. Now actually this is a pointer, but the subscript
	515	* operation isn't aware of this, so it's just hacked here.
	516	*
	517	* The right thing to do is to make dot directly evaluated
	518	* instead of changing it into addition.
	519	*/
	520	default:
	521	r = pop(ADDRESS);
	522	break;
	523	}
	524	return r;
	525	}
	526
	527	/*
	528	* evaluate a conditional expression
	529	*/
	530
	531	BOOLEAN cond(p)
	532	NODE *p;
	533	{
	534	if (p == NIL) {
	535	return(TRUE);
	536	}
	537	eval(p);
	538	return(pop(BOOLEAN));
	539	}
	540
	541	/*
	542	* Return the address corresponding to a given tree.
	543	*/
	544
	545	ADDRESS lval(p)
	546	NODE *p;
	547	{
	548	eval(p);
	549	return(pop(ADDRESS));
	550	}