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) 06/06/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 } 536