xref: /csrg-svn/usr.bin/pascal/pdx/tree/eval.c (revision 6086)
15543Slinton /* Copyright (c) 1982 Regents of the University of California */
25543Slinton 
3*6086Slinton static char sccsid[] = "@(#)eval.c 1.7 03/09/82";
45543Slinton 
55543Slinton /*
65562Slinton  * Parse tree evaluation.
75543Slinton  */
85543Slinton 
95543Slinton #include "defs.h"
105543Slinton #include "tree.h"
115543Slinton #include "sym.h"
125543Slinton #include "process.h"
135543Slinton #include "source.h"
145543Slinton #include "mappings.h"
155543Slinton #include "breakpoint.h"
165543Slinton #include "machine.h"
175543Slinton #include "tree.rep"
185543Slinton 
19*6086Slinton #define Boolean char	/* underlying representation type for booleans */
20*6086Slinton 
215543Slinton /*
225543Slinton  * Evaluate a parse tree using a stack; value is left at top.
235543Slinton  */
245543Slinton 
255562Slinton #define STACKSIZE 2000
265562Slinton 
275562Slinton STACK stack[STACKSIZE];
285543Slinton STACK *sp = &stack[0];
295543Slinton 
305543Slinton eval(p)
315543Slinton register NODE *p;
325543Slinton {
335782Slinton     long r0, r1;
345782Slinton     double fr0, fr1;
355543Slinton 
365782Slinton     if (p == NULL) {
375782Slinton 	return;
385782Slinton     }
395782Slinton     switch(degree(p->op)) {
405782Slinton 	case BINARY:
415782Slinton 	    eval(p->right);
425782Slinton 	    if (isreal(p->op)) {
435782Slinton 		fr1 = pop(double);
445782Slinton 	    } else if (isint(p->op)) {
456076Slinton 		r1 = popsmall(p->right->nodetype);
465782Slinton 	    }
475782Slinton 	    /* fall through */
485782Slinton 	case UNARY:
495782Slinton 	    eval(p->left);
505782Slinton 	    if (isreal(p->op)) {
515782Slinton 		fr0 = pop(double);
525782Slinton 	    } else if (isint(p->op)) {
536076Slinton 		r0 = popsmall(p->left->nodetype);
545782Slinton 	    }
555782Slinton 	    break;
565782Slinton 
575782Slinton 	default:
585782Slinton 	    /* do nothing */;
595543Slinton 	}
605782Slinton     switch(p->op) {
615782Slinton 	case O_NAME: {
625782Slinton 	    SYM *s, *f;
635543Slinton 
645782Slinton 	    s = p->nameval;
655886Slinton 	    if (!isvariable(s)) {
665886Slinton 		error("cannot evaluate a %s", classname(s));
675886Slinton 	    } else {
685886Slinton 		f = container(s);
695886Slinton 		if (!isactive(f)) {
705886Slinton 		    error("\"%s\" is not active", name(f));
715886Slinton 		}
72*6086Slinton 		push(long, address(s, NIL));
735782Slinton 	    }
745782Slinton 	    break;
755782Slinton 	}
765543Slinton 
775782Slinton 	case O_LCON:
785782Slinton 	    switch (size(p->nodetype)) {
795782Slinton 		case sizeof(char):
805782Slinton 		    push(char, p->lconval);
815782Slinton 		    break;
825543Slinton 
835782Slinton 		case sizeof(short):
845782Slinton 		    push(short, p->lconval);
855782Slinton 		    break;
865543Slinton 
875782Slinton 		case sizeof(long):
885782Slinton 		    push(long, p->lconval);
895782Slinton 		    break;
905543Slinton 
915782Slinton 		default:
925782Slinton 		    panic("bad size %d for LCON", size(p->nodetype));
935782Slinton 	    }
945782Slinton 	    break;
955543Slinton 
965782Slinton 	case O_FCON:
975782Slinton 	    push(double, p->fconval);
985782Slinton 	    break;
995543Slinton 
1005782Slinton 	case O_SCON: {
1015782Slinton 	    int len;
1025543Slinton 
1035782Slinton 	    len = size(p->nodetype);
1045782Slinton 	    mov(p->sconval, sp, len);
1055782Slinton 	    sp += len;
1065782Slinton 	    break;
1075782Slinton 	}
1085543Slinton 
1095782Slinton 	case O_INDEX: {
1105782Slinton 	    int n;
1115782Slinton 	    long i;
1125543Slinton 
113*6086Slinton 	    n = pop(long);
1145782Slinton 	    i = evalindex(p->left->nodetype, popsmall(p->right->nodetype));
115*6086Slinton 	    push(long, n + i*size(p->nodetype));
1165782Slinton 	    break;
1175782Slinton 	}
1185543Slinton 
1195782Slinton 	case O_INDIR: {
1205782Slinton 	    ADDRESS a;
1215543Slinton 
1225782Slinton 	    a = pop(ADDRESS);
1235782Slinton 	    if (a == 0) {
1245782Slinton 		error("reference through nil pointer");
1255782Slinton 	    }
1265782Slinton 	    dread(sp, a, sizeof(ADDRESS));
1275782Slinton 	    sp += sizeof(ADDRESS);
1285782Slinton 	    break;
1295782Slinton 	}
1305543Slinton 
1315782Slinton 	/*
1325782Slinton 	 * Get the value of the expression addressed by the top of the stack.
1336076Slinton 	 * Push the result back on the stack.
1345782Slinton 	 */
1355543Slinton 
1365782Slinton 	case O_RVAL: {
1375782Slinton 	    ADDRESS addr, len;
1385782Slinton 	    long i;
1395543Slinton 
140*6086Slinton 	    addr = pop(long);
1415782Slinton 	    if (addr == 0) {
1425782Slinton 		error("reference through nil pointer");
1435782Slinton 	    }
1445782Slinton 	    len = size(p->nodetype);
1455782Slinton 	    if (!rpush(addr, len)) {
1465782Slinton 		error("expression too large to evaluate");
1475782Slinton 	    }
1485782Slinton 	    break;
1495782Slinton 	}
1505543Slinton 
1515782Slinton 	case O_COMMA:
1525782Slinton 	    break;
1535543Slinton 
1545782Slinton 	case O_ITOF:
1555782Slinton 	    push(double, (double) r0);
1565782Slinton 	    break;
1575543Slinton 
1585782Slinton 	case O_ADD:
1595782Slinton 	    push(long, r0+r1);
1605782Slinton 	    break;
1615543Slinton 
1625782Slinton 	case O_ADDF:
1635782Slinton 	    push(double, fr0+fr1);
1645782Slinton 	    break;
1655543Slinton 
1665782Slinton 	case O_SUB:
1675782Slinton 	    push(long, r0-r1);
1685782Slinton 	    break;
1695543Slinton 
1705782Slinton 	case O_SUBF:
1715782Slinton 	    push(double, fr0-fr1);
1725782Slinton 	    break;
1735543Slinton 
1745782Slinton 	case O_NEG:
1755782Slinton 	    push(long, -r0);
1765782Slinton 	    break;
1775543Slinton 
1785782Slinton 	case O_NEGF:
1795782Slinton 	    push(double, -fr0);
1805782Slinton 	    break;
1815543Slinton 
1825782Slinton 	case O_MUL:
1835782Slinton 	    push(long, r0*r1);
1845782Slinton 	    break;
1855543Slinton 
1865782Slinton 	case O_MULF:
1875782Slinton 	    push(double, fr0*fr1);
1885782Slinton 	    break;
1895543Slinton 
1905782Slinton 	case O_DIVF:
1915782Slinton 	    if (fr1 == 0) {
1925782Slinton 		error("error: division by 0");
1935782Slinton 	    }
1945782Slinton 	    push(double, fr0/fr1);
1955782Slinton 	    break;
1965543Slinton 
1975782Slinton 	case O_DIV:
1985782Slinton 	    if (r1 == 0) {
1995782Slinton 		error("error: div by 0");
2005782Slinton 	    }
2015782Slinton 	    push(long, r0/r1);
2025782Slinton 	    break;
2035543Slinton 
2045782Slinton 	case O_MOD:
2055782Slinton 	    if (r1 == 0) {
2065782Slinton 		error("error: mod by 0");
2075782Slinton 	    }
2085782Slinton 	    push(long, r0%r1);
2095782Slinton 	    break;
2105543Slinton 
2115782Slinton 	case O_LT:
212*6086Slinton 	    push(Boolean, r0 < r1);
2135782Slinton 	    break;
2145543Slinton 
2155782Slinton 	case O_LTF:
216*6086Slinton 	    push(Boolean, fr0 < fr1);
2175782Slinton 	    break;
2185543Slinton 
2195782Slinton 	case O_LE:
220*6086Slinton 	    push(Boolean, r0 <= r1);
2215782Slinton 	    break;
2225543Slinton 
2235782Slinton 	case O_LEF:
224*6086Slinton 	    push(Boolean, fr0 <= fr1);
2255782Slinton 	    break;
2265543Slinton 
2275782Slinton 	case O_GT:
228*6086Slinton 	    push(Boolean, r0 > r1);
2295782Slinton 	    break;
2305543Slinton 
2315782Slinton 	case O_GTF:
232*6086Slinton 	    push(Boolean, fr0 > fr1);
2335782Slinton 	    break;
2345543Slinton 
2355782Slinton 	case O_EQ:
236*6086Slinton 	    push(Boolean, r0 == r1);
2375782Slinton 	    break;
2385543Slinton 
2395782Slinton 	case O_EQF:
240*6086Slinton 	    push(Boolean, fr0 == fr1);
2415782Slinton 	    break;
2425543Slinton 
2435782Slinton 	case O_NE:
244*6086Slinton 	    push(Boolean, r0 != r1);
2455782Slinton 	    break;
2465543Slinton 
2475782Slinton 	case O_NEF:
248*6086Slinton 	    push(Boolean, fr0 != fr1);
2495782Slinton 	    break;
2505543Slinton 
2515782Slinton 	case O_AND:
252*6086Slinton 	    push(Boolean, r0 && r1);
2535782Slinton 	    break;
2545543Slinton 
2555782Slinton 	case O_OR:
256*6086Slinton 	    push(Boolean, r0 || r1);
2575782Slinton 	    break;
2585543Slinton 
2595782Slinton 	case O_ASSIGN:
2605782Slinton 	    assign(p->left, p->right);
2615782Slinton 	    break;
2625543Slinton 
2635782Slinton 	case O_CHFILE:
2645782Slinton 	    if (p->sconval == NIL) {
2655782Slinton 		printf("%s\n", cursource);
2665782Slinton 	    } else {
2675782Slinton 		skimsource(p->sconval);
2685782Slinton 	    }
2695782Slinton 	    break;
2705543Slinton 
2715782Slinton 	case O_CONT:
2725782Slinton 	    cont();
2735782Slinton 	    printnews();
2745782Slinton 	    break;
2755543Slinton 
2765782Slinton 	case O_LIST: {
2775782Slinton 	    SYM *b;
2786083Slinton 	    ADDRESS addr;
2795543Slinton 
2805782Slinton 	    if (p->left->op == O_NAME) {
2815782Slinton 		b = p->left->nameval;
2825782Slinton 		if (!isblock(b)) {
2835782Slinton 		    error("\"%s\" is not a procedure or function", name(b));
2845543Slinton 		}
2856083Slinton 		addr = firstline(b);
2866083Slinton 		if (addr == -1) {
2876083Slinton 		    error("\"%s\" is empty", name(b));
2886083Slinton 		}
2896083Slinton 		skimsource(srcfilename(addr));
2906083Slinton 		r0 = srcline(addr);
2915782Slinton 		r1 = r0 + 5;
2925782Slinton 		if (r1 > lastlinenum) {
2935782Slinton 		    r1 = lastlinenum;
2945782Slinton 		}
2955782Slinton 		r0 = r0 - 5;
2965782Slinton 		if (r0 < 1) {
2975782Slinton 		    r0 = 1;
2985782Slinton 		}
2995782Slinton 	    } else {
3005782Slinton 		eval(p->left->right);
3015782Slinton 		eval(p->left->left);
3025782Slinton 		r0 = pop(long);
3035782Slinton 		r1 = pop(long);
3045782Slinton 	    }
3055782Slinton 	    printlines((LINENO) r0, (LINENO) r1);
3065782Slinton 	    break;
3075782Slinton 	}
3085543Slinton 
3095782Slinton 	case O_XI:
3105782Slinton 	case O_XD:
3115782Slinton 	{
3125782Slinton 	    SYM *b;
3135543Slinton 
3145782Slinton 	    if (p->left->op == O_CALL) {
3155782Slinton 		b = p->left->left->nameval;
3165782Slinton 		r0 = codeloc(b);
3175782Slinton 		r1 = firstline(b);
3185782Slinton 	    } else {
3195782Slinton 		eval(p->left->right);
3205782Slinton 		eval(p->left->left);
3215782Slinton 		r0 = pop(long);
3225782Slinton 		r1 = pop(long);
3235782Slinton 	    }
3245782Slinton 	    if (p->op == O_XI)  {
3255782Slinton 		printinst((ADDRESS) r0, (ADDRESS) r1);
3265782Slinton 	    } else {
3275782Slinton 		printdata((ADDRESS) r0, (ADDRESS) r1);
3285782Slinton 	    }
3295782Slinton 	    break;
3305782Slinton 	}
3315543Slinton 
3325782Slinton 	case O_NEXT:
3335782Slinton 	    next();
3345782Slinton 	    printnews();
3355782Slinton 	    break;
3365543Slinton 
3375782Slinton 	case O_PRINT: {
3385782Slinton 	    NODE *o;
3395543Slinton 
3405782Slinton 	    for (o = p->left; o != NIL; o = o->right) {
3415782Slinton 		eval(o->left);
3425782Slinton 		printval(o->left->nodetype);
3435782Slinton 		putchar(' ');
3445782Slinton 	    }
3455782Slinton 	    putchar('\n');
3465782Slinton 	    break;
3475782Slinton 	}
3485543Slinton 
3495782Slinton 	case O_STEP:
3505782Slinton 	    stepc();
3515782Slinton 	    printnews();
3525782Slinton 	    break;
3535543Slinton 
3545782Slinton 	case O_WHATIS:
3555782Slinton 	    if (p->left->op == O_NAME) {
3565782Slinton 		printdecl(p->left->nameval);
3575782Slinton 	    } else {
3585782Slinton 		printdecl(p->left->nodetype);
3595782Slinton 	    }
3605782Slinton 	    break;
3615543Slinton 
3625782Slinton 	case O_WHICH:
3635782Slinton 	    printwhich(p->nameval);
3645782Slinton 	    putchar('\n');
3655782Slinton 	    break;
3665543Slinton 
3675782Slinton 	case O_WHERE:
3685782Slinton 	    where();
3695782Slinton 	    break;
3705543Slinton 
3715782Slinton 	case O_ALIAS:
3725782Slinton 	    alias(p->left->sconval, p->right->sconval);
3735782Slinton 	    break;
3745543Slinton 
3755782Slinton 	case O_CALL:
3765782Slinton 	    callproc(p->left, p->right);
3775782Slinton 	    break;
3785543Slinton 
3795782Slinton 	case O_EDIT:
3805782Slinton 	    edit(p->sconval);
3815782Slinton 	    break;
3825543Slinton 
3835782Slinton 	case O_DUMP:
3845782Slinton 	    dump();
3855782Slinton 	    break;
3865543Slinton 
3875782Slinton 	case O_GRIPE:
3885782Slinton 	    gripe();
3895782Slinton 	    break;
3905562Slinton 
3915782Slinton 	case O_HELP:
3925782Slinton 	    help();
3935782Slinton 	    break;
3945543Slinton 
3955782Slinton 	case O_REMAKE:
3965782Slinton 	    remake();
3975782Slinton 	    break;
3985543Slinton 
3995782Slinton 	case O_RUN:
4005782Slinton 	    run();
4015782Slinton 	    break;
4025543Slinton 
4035782Slinton 	case O_SOURCE:
4045782Slinton 	    setinput(p->sconval);
4055782Slinton 	    break;
4065543Slinton 
4075782Slinton 	case O_STATUS:
4085782Slinton 	    status();
4095782Slinton 	    break;
4105543Slinton 
4115782Slinton 	case O_TRACE:
4125782Slinton 	case O_TRACEI:
4135782Slinton 	    trace(p->op, p->what, p->where, p->cond);
4145782Slinton 	    if (isstdin()) {
4155782Slinton 		status();
4165782Slinton 	    }
4175782Slinton 	    break;
4185543Slinton 
4195782Slinton 	case O_STOP:
4205782Slinton 	case O_STOPI:
4215782Slinton 	    stop(p->op, p->what, p->where, p->cond);
4225782Slinton 	    if (isstdin()) {
4235782Slinton 		status();
4245782Slinton 	    }
4255782Slinton 	    break;
4265543Slinton 
4275782Slinton 	case O_DELETE:
4285782Slinton 	    eval(p->left);
4295782Slinton 	    delbp((unsigned int) pop(long));
4305782Slinton 	    break;
4315543Slinton 
4325782Slinton 	default:
4335782Slinton 	    panic("eval: bad op %d", p->op);
4345782Slinton     }
4355543Slinton }
4365543Slinton 
4375543Slinton /*
4385562Slinton  * Push "len" bytes onto the expression stack from address "addr"
4395562Slinton  * in the process.  Normally TRUE is returned, however if there
4405562Slinton  * isn't enough room on the stack, rpush returns FALSE.
4415562Slinton  */
4425562Slinton 
4435562Slinton BOOLEAN rpush(addr, len)
4445562Slinton ADDRESS addr;
4455562Slinton int len;
4465562Slinton {
4475782Slinton     BOOLEAN success;
4485562Slinton 
4495782Slinton     if (sp + len >= &stack[STACKSIZE]) {
4505782Slinton 	success = FALSE;
4515782Slinton     } else {
4525782Slinton 	dread(sp, addr, len);
4535782Slinton 	sp += len;
4545782Slinton 	success = TRUE;
4555782Slinton     }
4565782Slinton     return success;
4575562Slinton }
4585562Slinton 
4595562Slinton /*
4605782Slinton  * Pop an item of the given type which is assumed to be no larger
4615782Slinton  * than a long and return it expanded into a long.
4625782Slinton  */
4635782Slinton 
4645782Slinton long popsmall(t)
4655782Slinton SYM *t;
4665782Slinton {
4675782Slinton     long r;
4685782Slinton 
4695782Slinton     switch (size(t)) {
4705782Slinton 	case sizeof(char):
4715782Slinton 	    r = (long) pop(char);
4725782Slinton 	    break;
4735782Slinton 
4745782Slinton 	case sizeof(short):
4755782Slinton 	    r = (long) pop(short);
4765782Slinton 	    break;
4775782Slinton 
4785782Slinton 	case sizeof(long):
4795782Slinton 	    r = pop(long);
4805782Slinton 	    break;
4815782Slinton 
4825782Slinton 	default:
4835782Slinton 	    panic("popsmall: size is %d", size(t));
4845782Slinton     }
4855782Slinton     return r;
4865782Slinton }
4875782Slinton 
4885782Slinton /*
4895543Slinton  * evaluate a conditional expression
4905543Slinton  */
4915543Slinton 
4925543Slinton BOOLEAN cond(p)
4935543Slinton NODE *p;
4945543Slinton {
4955782Slinton     if (p == NIL) {
4965782Slinton 	return(TRUE);
4975782Slinton     }
4985782Slinton     eval(p);
4995782Slinton     return(pop(BOOLEAN));
5005543Slinton }
5015543Slinton 
5025543Slinton /*
5035543Slinton  * Return the address corresponding to a given tree.
5045543Slinton  */
5055543Slinton 
5065543Slinton ADDRESS lval(p)
5075543Slinton NODE *p;
5085543Slinton {
5095782Slinton     eval(p);
5105782Slinton     return(pop(ADDRESS));
5115543Slinton }
512