4.3BSD - /usr/src/ucb/pascal/pdx/tree/eval.c

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

Defined functions

Defined variables

Defined macros