BSD 4_3_Tahoe release
[unix-history] / usr / src / ucb / pascal / pdx / tree / eval.c
CommitLineData
3cd5310a
DF
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 */
5b6b24ef 6
3cd5310a 7#ifndef lint
ca67e7b4 8static char sccsid[] = "@(#)eval.c 5.2 (Berkeley) 4/7/87";
3cd5310a 9#endif not lint
5b6b24ef
ML
10
11/*
bd480296 12 * Parse tree evaluation.
5b6b24ef
ML
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"
82d3cd01
KM
24#include "process/process.rep"
25#include "process/pxinfo.h"
5b6b24ef 26
fc1ced71
ML
27#define Boolean char /* underlying representation type for booleans */
28
5b6b24ef
ML
29/*
30 * Evaluate a parse tree using a stack; value is left at top.
31 */
32
bd480296
ML
33#define STACKSIZE 2000
34
35STACK stack[STACKSIZE];
5b6b24ef
ML
36STACK *sp = &stack[0];
37
38eval(p)
39register NODE *p;
40{
dd7219e6
ML
41 long r0, r1;
42 double fr0, fr1;
a5823bfb 43 FILE *fp;
dd7219e6
ML
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)) {
488fdcff 54 r1 = popsmall(p->right->nodetype);
dd7219e6
ML
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)) {
488fdcff 62 r0 = popsmall(p->left->nodetype);
dd7219e6
ML
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;
c6f75efb
ML
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 }
fc1ced71 81 push(long, address(s, NIL));
dd7219e6 82 }
dd7219e6 83 break;
5b6b24ef 84 }
5b6b24ef 85
dd7219e6
ML
86 case O_LCON:
87 switch (size(p->nodetype)) {
88 case sizeof(char):
89 push(char, p->lconval);
90 break;
5b6b24ef 91
dd7219e6
ML
92 case sizeof(short):
93 push(short, p->lconval);
94 break;
5b6b24ef 95
dd7219e6
ML
96 case sizeof(long):
97 push(long, p->lconval);
98 break;
5b6b24ef 99
dd7219e6
ML
100 default:
101 panic("bad size %d for LCON", size(p->nodetype));
102 }
103 break;
5b6b24ef 104
dd7219e6
ML
105 case O_FCON:
106 push(double, p->fconval);
107 break;
5b6b24ef 108
dd7219e6
ML
109 case O_SCON: {
110 int len;
5b6b24ef 111
dd7219e6
ML
112 len = size(p->nodetype);
113 mov(p->sconval, sp, len);
114 sp += len;
82d3cd01
KM
115#ifdef tahoe
116 alignstack();
117#endif tahoe
dd7219e6
ML
118 break;
119 }
5b6b24ef 120
dd7219e6 121 case O_INDEX: {
41524cc9
ML
122 long n; /* base address for array */
123 long i; /* index - lower bound */
82d3cd01 124 long evalindex();
5b6b24ef 125
fc1ced71 126 n = pop(long);
41524cc9 127 i = evalindex(p->left->nodetype, p->right);
fc1ced71 128 push(long, n + i*size(p->nodetype));
dd7219e6
ML
129 break;
130 }
5b6b24ef 131
dd7219e6
ML
132 case O_INDIR: {
133 ADDRESS a;
5b6b24ef 134
dd7219e6
ML
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 }
5b6b24ef 143
dd7219e6
ML
144 /*
145 * Get the value of the expression addressed by the top of the stack.
488fdcff 146 * Push the result back on the stack.
dd7219e6
ML
147 */
148
149 case O_RVAL: {
150 ADDRESS addr, len;
dd7219e6 151
fc1ced71 152 addr = pop(long);
dd7219e6
ML
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 }
5b6b24ef 162
dd7219e6
ML
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:
fc1ced71 224 push(Boolean, r0 < r1);
dd7219e6
ML
225 break;
226
227 case O_LTF:
fc1ced71 228 push(Boolean, fr0 < fr1);
dd7219e6
ML
229 break;
230
231 case O_LE:
fc1ced71 232 push(Boolean, r0 <= r1);
dd7219e6
ML
233 break;
234
235 case O_LEF:
fc1ced71 236 push(Boolean, fr0 <= fr1);
dd7219e6
ML
237 break;
238
239 case O_GT:
fc1ced71 240 push(Boolean, r0 > r1);
dd7219e6
ML
241 break;
242
243 case O_GTF:
fc1ced71 244 push(Boolean, fr0 > fr1);
dd7219e6
ML
245 break;
246
247 case O_EQ:
fc1ced71 248 push(Boolean, r0 == r1);
dd7219e6
ML
249 break;
250
251 case O_EQF:
fc1ced71 252 push(Boolean, fr0 == fr1);
dd7219e6
ML
253 break;
254
255 case O_NE:
fc1ced71 256 push(Boolean, r0 != r1);
dd7219e6
ML
257 break;
258
259 case O_NEF:
fc1ced71 260 push(Boolean, fr0 != fr1);
dd7219e6
ML
261 break;
262
263 case O_AND:
fc1ced71 264 push(Boolean, r0 && r1);
dd7219e6
ML
265 break;
266
267 case O_OR:
fc1ced71 268 push(Boolean, r0 || r1);
dd7219e6
ML
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 {
a5823bfb
ML
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 }
dd7219e6
ML
286 }
287 break;
288
289 case O_CONT:
290 cont();
291 printnews();
292 break;
293
294 case O_LIST: {
295 SYM *b;
e96e3af6 296 ADDRESS addr;
dd7219e6
ML
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 }
e96e3af6 303 addr = firstline(b);
82d3cd01 304 if ((int)addr == -1) {
e96e3af6
ML
305 error("\"%s\" is empty", name(b));
306 }
307 skimsource(srcfilename(addr));
308 r0 = srcline(addr);
dd7219e6
ML
309 r1 = r0 + 5;
310 if (r1 > lastlinenum) {
311 r1 = lastlinenum;
5b6b24ef 312 }
dd7219e6
ML
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 }
5b6b24ef 326
dd7219e6
ML
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 }
5b6b24ef 349
dd7219e6
ML
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;
5b6b24ef 365 }
dd7219e6
ML
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 }
5b6b24ef
ML
453}
454
bd480296
ML
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.
bd480296
ML
459 */
460
461BOOLEAN rpush(addr, len)
462ADDRESS addr;
463int len;
464{
dd7219e6 465 BOOLEAN success;
82d3cd01
KM
466#ifdef tahoe
467 register char *savesp = sp;
468#endif
dd7219e6
ML
469
470 if (sp + len >= &stack[STACKSIZE]) {
471 success = FALSE;
472 } else {
473 dread(sp, addr, len);
474 sp += len;
82d3cd01
KM
475#ifdef tahoe
476 alignstack();
477 if (sp >= &stack[STACKSIZE]) {
478 success = FALSE;
479 sp = savesp;
480 } else
481#endif
482 success = TRUE;
dd7219e6
ML
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
492long popsmall(t)
493SYM *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
442887e2
ML
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 */
dd7219e6 520 default:
442887e2
ML
521 r = pop(ADDRESS);
522 break;
dd7219e6
ML
523 }
524 return r;
bd480296
ML
525}
526
5b6b24ef
ML
527/*
528 * evaluate a conditional expression
529 */
530
531BOOLEAN cond(p)
532NODE *p;
533{
dd7219e6
ML
534 if (p == NIL) {
535 return(TRUE);
536 }
537 eval(p);
538 return(pop(BOOLEAN));
5b6b24ef
ML
539}
540
541/*
542 * Return the address corresponding to a given tree.
543 */
544
545ADDRESS lval(p)
546NODE *p;
547{
dd7219e6
ML
548 eval(p);
549 return(pop(ADDRESS));
5b6b24ef 550}