xref: /csrg-svn/old/dbx/eval.c (revision 16608)
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)eval.c 1.10 8/17/83";
4 
5 static char rcsid[] = "$Header: eval.c,v 1.3 84/03/27 10:20:23 linton Exp $";
6 
7 /*
8  * Tree evaluation.
9  */
10 
11 #include "defs.h"
12 #include "tree.h"
13 #include "operators.h"
14 #include "eval.h"
15 #include "events.h"
16 #include "symbols.h"
17 #include "scanner.h"
18 #include "source.h"
19 #include "object.h"
20 #include "mappings.h"
21 #include "process.h"
22 #include "runtime.h"
23 #include "machine.h"
24 #include <signal.h>
25 
26 #ifndef public
27 
28 #include "machine.h"
29 
30 #define STACKSIZE 20000
31 
32 typedef Char Stack;
33 
34 #define push(type, value) { \
35     ((type *) (sp += sizeof(type)))[-1] = (value); \
36 }
37 
38 #define pop(type) ( \
39     (*((type *) (sp -= sizeof(type)))) \
40 )
41 
42 #define popn(n, dest) { \
43     sp -= n; \
44     bcopy(sp, dest, n); \
45 }
46 
47 #define alignstack() { \
48     sp = (Stack *) (( ((int) sp) + sizeof(int) - 1)&~(sizeof(int) - 1)); \
49 }
50 
51 #endif
52 
53 public Stack stack[STACKSIZE];
54 public Stack *sp = &stack[0];
55 public Boolean useInstLoc = false;
56 
57 #define chksp() \
58 { \
59     if (sp < &stack[0]) { \
60 	panic("stack underflow"); \
61     } \
62 }
63 
64 #define poparg(n, r, fr) { \
65     eval(p->value.arg[n]); \
66     if (isreal(p->op)) { \
67 	if (size(p->value.arg[n]->nodetype) == sizeof(float)) { \
68 	    fr = pop(float); \
69 	} else { \
70 	    fr = pop(double); \
71 	} \
72     } else if (isint(p->op)) { \
73 	r = popsmall(p->value.arg[n]->nodetype); \
74     } \
75 }
76 
77 #define Boolrep char	/* underlying representation type for booleans */
78 
79 /*
80  * Evaluate a parse tree leaving the value on the top of the stack.
81  */
82 
83 public eval(p)
84 register Node p;
85 {
86     long r0, r1;
87     double fr0, fr1;
88     Address addr;
89     long i, n;
90     int len;
91     Symbol s, f;
92     Node n1, n2;
93     Boolean b;
94     File file;
95 
96     checkref(p);
97     if (debug_flag[2]) {
98 	fprintf(stderr," evaluating %s \n",showoperator(p->op));
99     }
100     switch (degree(p->op)) {
101 	case BINARY:
102 	    poparg(1, r1, fr1);
103 	    poparg(0, r0, fr0);
104 	    break;
105 
106 	case UNARY:
107 	    poparg(0, r0, fr0);
108 	    break;
109 
110 	default:
111 	    /* do nothing */;
112     }
113     switch (p->op) {
114 	case O_SYM:
115 	    s = p->value.sym;
116 	    if (s == retaddrsym) {
117 		push(long, return_addr());
118 	    } else {
119 		if (isvariable(s)) {
120 		    if (s != program and not isactive(container(s))) {
121 			error("\"%s\" is not active", symname(s));
122 		    }
123 		    push(long, address(s, nil));
124 		} else if (isblock(s)) {
125 		    push(Symbol, s);
126 		} else {
127 		    error("can't evaluate a %s", classname(s));
128 		}
129 	    }
130 	    break;
131 
132 	case O_LCON:
133 	    r0 = p->value.lcon;
134 	    pushsmall(p->nodetype, r0);
135 	    break;
136 
137 	case O_FCON:
138 	    push(double, p->value.fcon);
139 	    break;
140 
141 	case O_SCON:
142 	    len = size(p->nodetype);
143 	    mov(p->value.scon, sp, len);
144 	    sp += len;
145 	    break;
146 
147 	case O_INDEX:
148 	    n = pop(long);
149 	    i = evalindex(p->value.arg[0]->nodetype,
150 		popsmall(p->value.arg[1]->nodetype));
151 	    push(long, n + i*size(p->nodetype));
152 	    break;
153 
154 	case O_DOT:
155 	    s = p->value.arg[1]->value.sym;
156 	    n = lval(p->value.arg[0]);
157 	    push(long, n + (s->symvalue.field.offset div 8));
158 	    break;
159 
160 	/*
161 	 * Get the value of the expression addressed by the top of the stack.
162 	 * Push the result back on the stack.
163 	 */
164 
165 	case O_INDIR:
166 	case O_RVAL:
167 	    addr = pop(long);
168 	    if (addr == 0) {
169 		error("reference through nil pointer");
170 	    }
171 	    if (p->op == O_INDIR) {
172 		len = sizeof(long);
173 	    } else {
174 		len = size(p->nodetype);
175 	    }
176 	    rpush(addr, len);
177 	    break;
178 
179 	/*
180 	 * Effectively, we want to pop n bytes off for the evaluated subtree
181 	 * and push len bytes on for the new type of the same tree.
182 	 */
183 	case O_TYPERENAME:
184 	    n = size(p->value.arg[0]->nodetype);
185 	    len = size(p->nodetype);
186 	    sp = sp - n + len;
187 	    break;
188 
189 	case O_COMMA:
190 	    break;
191 
192 	case O_ITOF:
193 	    push(double, (double) r0);
194 	    break;
195 
196 	case O_ADD:
197 	    push(long, r0+r1);
198 	    break;
199 
200 	case O_ADDF:
201 	    push(double, fr0+fr1);
202 	    break;
203 
204 	case O_SUB:
205 	    push(long, r0-r1);
206 	    break;
207 
208 	case O_SUBF:
209 	    push(double, fr0-fr1);
210 	    break;
211 
212 	case O_NEG:
213 	    push(long, -r0);
214 	    break;
215 
216 	case O_NEGF:
217 	    push(double, -fr0);
218 	    break;
219 
220 	case O_MUL:
221 	    push(long, r0*r1);
222 	    break;
223 
224 	case O_MULF:
225 	    push(double, fr0*fr1);
226 	    break;
227 
228 	case O_DIVF:
229 	    if (fr1 == 0) {
230 		error("error: division by 0");
231 	    }
232 	    push(double, fr0 / fr1);
233 	    break;
234 
235 	case O_DIV:
236 	    if (r1 == 0) {
237 		error("error: div by 0");
238 	    }
239 	    push(long, r0 div r1);
240 	    break;
241 
242 	case O_MOD:
243 	    if (r1 == 0) {
244 		error("error: mod by 0");
245 	    }
246 	    push(long, r0 mod r1);
247 	    break;
248 
249 	case O_LT:
250 	    push(Boolrep, r0 < r1);
251 	    break;
252 
253 	case O_LTF:
254 	    push(Boolrep, fr0 < fr1);
255 	    break;
256 
257 	case O_LE:
258 	    push(Boolrep, r0 <= r1);
259 	    break;
260 
261 	case O_LEF:
262 	    push(Boolrep, fr0 <= fr1);
263 	    break;
264 
265 	case O_GT:
266 	    push(Boolrep, r0 > r1);
267 	    break;
268 
269 	case O_GTF:
270 	    push(Boolrep, fr0 > fr1);
271 	    break;
272 
273 	case O_EQ:
274 	    push(Boolrep, r0 == r1);
275 	    break;
276 
277 	case O_EQF:
278 	    push(Boolrep, fr0 == fr1);
279 	    break;
280 
281 	case O_NE:
282 	    push(Boolrep, r0 != r1);
283 	    break;
284 
285 	case O_NEF:
286 	    push(Boolrep, fr0 != fr1);
287 	    break;
288 
289 	case O_AND:
290 	    push(Boolrep, r0 and r1);
291 	    break;
292 
293 	case O_OR:
294 	    push(Boolrep, r0 or r1);
295 	    break;
296 
297 	case O_ASSIGN:
298 	    assign(p->value.arg[0], p->value.arg[1]);
299 	    break;
300 
301 	case O_CHFILE:
302 	    if (p->value.scon == nil) {
303 		printf("%s\n", cursource);
304 	    } else {
305 		file = opensource(p->value.scon);
306 		if (file == nil) {
307 		    error("can't read \"%s\"", p->value.scon);
308 		} else {
309 		    fclose(file);
310 		    setsource(p->value.scon);
311 		}
312 	    }
313 	    break;
314 
315 	case O_CONT:
316 	    cont(p->value.lcon);
317 	    printnews();
318 	    break;
319 
320 	case O_LIST:
321 	    if (p->value.arg[0]->op == O_SYM) {
322 		f = p->value.arg[0]->value.sym;
323 		addr = firstline(f);
324 		if (addr == NOADDR) {
325 		    error("no source lines for \"%s\"", symname(f));
326 		}
327 		setsource(srcfilename(addr));
328 		r0 = srcline(addr) - 5;
329 		r1 = r0 + 10;
330 		if (r0 < 1) {
331 		    r0 = 1;
332 		}
333 	    } else {
334 		eval(p->value.arg[0]);
335 		r0 = pop(long);
336 		eval(p->value.arg[1]);
337 		r1 = pop(long);
338 	    }
339 	    printlines((Lineno) r0, (Lineno) r1);
340 	    break;
341 
342 	case O_FUNC:
343 	    if (p->value.arg[0] == nil) {
344 		printname(stdout, curfunc);
345 		putchar('\n');
346 	    } else {
347 		s = p->value.arg[0]->value.sym;
348 		if (isroutine(s)) {
349 		    setcurfunc(s);
350 		} else {
351 		    find(f, s->name) where isroutine(f) endfind(f);
352 		    if (f == nil) {
353 			error("%s is not a procedure or function", symname(s));
354 		    }
355 		    setcurfunc(f);
356 		}
357 		addr = codeloc(curfunc);
358 		if (addr != NOADDR) {
359 		    setsource(srcfilename(addr));
360 		    cursrcline = srcline(addr) - 5;
361 		    if (cursrcline < 1) {
362 			cursrcline = 1;
363 		    }
364 		}
365 	    }
366 	    break;
367 
368 	case O_EXAMINE:
369 	    eval(p->value.examine.beginaddr);
370 	    r0 = pop(long);
371 	    if (p->value.examine.endaddr == nil) {
372 		n = p->value.examine.count;
373 		if (n == 0) {
374 		    printvalue(r0, p->value.examine.mode);
375 		} else if (streq(p->value.examine.mode, "i")) {
376 		    printninst(n, (Address) r0);
377 		} else {
378 		    printndata(n, (Address) r0, p->value.examine.mode);
379 		}
380 	    } else {
381 		eval(p->value.examine.endaddr);
382 		r1 = pop(long);
383 		if (streq(p->value.examine.mode, "i")) {
384 		    printinst((Address)r0, (Address)r1);
385 		} else {
386 		    printdata((Address)r0, (Address)r1, p->value.examine.mode);
387 		}
388 	    }
389 	    break;
390 
391 	case O_PRINT:
392 	    for (n1 = p->value.arg[0]; n1 != nil; n1 = n1->value.arg[1]) {
393 		eval(n1->value.arg[0]);
394 		printval(n1->value.arg[0]->nodetype);
395 		putchar(' ');
396 	    }
397 	    putchar('\n');
398 	    break;
399 
400 	case O_PSYM:
401 	    if (p->value.arg[0]->op == O_SYM) {
402 		psym(p->value.arg[0]->value.sym);
403 	    } else {
404 		psym(p->value.arg[0]->nodetype);
405 	    }
406 	    break;
407 
408 	case O_QLINE:
409 	    eval(p->value.arg[1]);
410 	    break;
411 
412 	case O_STEP:
413 	    b = inst_tracing;
414 	    inst_tracing = (Boolean) (not p->value.step.source);
415 	    if (p->value.step.skipcalls) {
416 		next();
417 	    } else {
418 		stepc();
419 	    }
420 	    inst_tracing = b;
421 	    useInstLoc = (Boolean) (not p->value.step.source);
422 	    printnews();
423 	    break;
424 
425 	case O_WHATIS:
426 	    if (p->value.arg[0]->op == O_SYM) {
427 		printdecl(p->value.arg[0]->value.sym);
428 	    } else {
429 		printdecl(p->value.arg[0]->nodetype);
430 	    }
431 	    break;
432 
433 	case O_WHERE:
434 	    wherecmd();
435 	    break;
436 
437 	case O_WHEREIS:
438 	    if (p->value.arg[0]->op == O_SYM) {
439 		printwhereis(stdout,p->value.arg[0]->value.sym);
440 	    } else {
441 		printwhereis(stdout,p->value.arg[0]->nodetype);
442 	    }
443 	    break;
444 
445 	case O_WHICH:
446 	    if (p->value.arg[0]->op == O_SYM) {
447 		printwhich(stdout,p->value.arg[0]->value.sym);
448 	    } else {
449 		printwhich(stdout,p->value.arg[0]->nodetype);
450 	    }
451 	    putchar('\n');
452 	    break;
453 
454 	case O_ALIAS:
455 	    n1 = p->value.arg[0];
456 	    n2 = p->value.arg[1];
457 	    if (n1 == nil) {
458 		print_alias(nil);
459 	    } else if (n2 == nil) {
460 		print_alias(n1->value.name);
461 	    } else {
462 		enter_alias(n1->value.name, n2->value.name);
463 	    }
464 	    break;
465 
466 	case O_CALL:
467 	    callproc(p->value.arg[0], p->value.arg[1]);
468 	    break;
469 
470 	case O_CATCH:
471 	    psigtrace(process, p->value.lcon, true);
472 	    break;
473 
474 	case O_EDIT:
475 	    edit(p->value.scon);
476 	    break;
477 
478         case O_DEBUG:
479             debug(p);
480 	    break;
481 
482 	case O_DOWN:
483 	    checkref(p->value.arg[0]);
484 	    assert(p->value.arg[0]->op == O_LCON);
485 	    down(p->value.arg[0]->value.lcon);
486 	    break;
487 
488 	case O_DUMP:
489 	    dump();
490 	    break;
491 
492 	case O_GRIPE:
493 	    gripe();
494 	    break;
495 
496 	case O_HELP:
497 	    help();
498 	    break;
499 
500 	case O_IGNORE:
501 	    psigtrace(process, p->value.lcon, false);
502 	    break;
503 
504 	case O_RETURN:
505 	    if (p->value.arg[0] == nil) {
506 		rtnfunc(nil);
507 	    } else {
508 		assert(p->value.arg[0]->op == O_SYM);
509 		rtnfunc(p->value.arg[0]->value.sym);
510 	    }
511 	    break;
512 
513 	case O_RUN:
514 	    run();
515 	    break;
516 
517 	case O_SOURCE:
518 	    setinput(p->value.scon);
519 	    break;
520 
521 	case O_STATUS:
522 	    status();
523 	    break;
524 
525 	case O_TRACE:
526 	case O_TRACEI:
527 	    trace(p);
528 	    break;
529 
530 	case O_STOP:
531 	case O_STOPI:
532 	    stop(p);
533 	    break;
534 
535 	case O_UP:
536 	    checkref(p->value.arg[0]);
537 	    assert(p->value.arg[0]->op == O_LCON);
538 	    up(p->value.arg[0]->value.lcon);
539 	    break;
540 
541 	case O_ADDEVENT:
542 	    addevent(p->value.event.cond, p->value.event.actions);
543 	    break;
544 
545 	case O_DELETE:
546 	    n1 = p->value.arg[0];
547 	    while (n1->op == O_COMMA) {
548 		n2 = n1->value.arg[0];
549 		assert(n2->op == O_LCON);
550 		if (not delevent((unsigned int) n2->value.lcon)) {
551 		    error("unknown event %ld", n2->value.lcon);
552 		}
553 		n1 = n1->value.arg[1];
554 	    }
555 	    assert(n1->op == O_LCON);
556 	    if (not delevent((unsigned int) n1->value.lcon)) {
557 		error("unknown event %ld", n1->value.lcon);
558 	    }
559 	    break;
560 
561 	case O_ENDX:
562 	    endprogram();
563 	    break;
564 
565 	case O_IF:
566 	    if (cond(p->value.event.cond)) {
567 		evalcmdlist(p->value.event.actions);
568 	    }
569 	    break;
570 
571 	case O_ONCE:
572 	    event_once(p->value.event.cond, p->value.event.actions);
573 	    break;
574 
575 	case O_PRINTCALL:
576 	    printcall(p->value.sym, whatblock(return_addr()));
577 	    break;
578 
579 	case O_PRINTIFCHANGED:
580 	    printifchanged(p->value.arg[0]);
581 	    break;
582 
583 	case O_PRINTRTN:
584 	    printrtn(p->value.sym);
585 	    break;
586 
587 	case O_PRINTSRCPOS:
588 	    getsrcpos();
589 	    if (p->value.arg[0] == nil) {
590 		printsrcpos();
591 		putchar('\n');
592 		printlines(curline, curline);
593 	    } else if (p->value.arg[0]->op == O_QLINE) {
594 		if (p->value.arg[0]->value.arg[1]->value.lcon == 0) {
595 		    printf("tracei: ");
596 		    printinst(pc, pc);
597 		} else {
598 		    printf("trace:  ");
599 		    printlines(curline, curline);
600 		}
601 	    } else {
602 		printsrcpos();
603 		printf(": ");
604 		eval(p->value.arg[0]);
605 		prtree(stdout, p->value.arg[0]);
606 		printf(" = ");
607 		printval(p->value.arg[0]->nodetype);
608 		putchar('\n');
609 	    }
610 	    break;
611 
612 	case O_PROCRTN:
613 	    procreturn(p->value.sym);
614 	    break;
615 
616 	case O_STOPIFCHANGED:
617 	    stopifchanged(p->value.arg[0]);
618 	    break;
619 
620 	case O_STOPX:
621 	    isstopped = true;
622 	    break;
623 
624 	case O_TRACEON:
625 	    traceon(p->value.trace.inst, p->value.trace.event,
626 		p->value.trace.actions);
627 	    break;
628 
629 	case O_TRACEOFF:
630 	    traceoff(p->value.lcon);
631 	    break;
632 
633 	default:
634 	    panic("eval: bad op %d", p->op);
635     }
636  if(debug_flag[2]) {
637 	fprintf(stderr," evaluated %s \n",showoperator(p->op));
638  }
639 
640 }
641 
642 /*
643  * Evaluate a list of commands.
644  */
645 
646 public evalcmdlist(cl)
647 Cmdlist cl;
648 {
649     Command c;
650 
651     foreach (Command, c, cl)
652 	evalcmd(c);
653     endfor
654 }
655 
656 /*
657  * Push "len" bytes onto the expression stack from address "addr"
658  * in the process.  If there isn't room on the stack, print an error message.
659  */
660 
661 public rpush(addr, len)
662 Address addr;
663 int len;
664 {
665     if (not canpush(len)) {
666 	error("expression too large to evaluate");
667     } else {
668 	chksp();
669 	dread(sp, addr, len);
670 	sp += len;
671     }
672 }
673 
674 /*
675  * Check if the stack has n bytes available.
676  */
677 
678 public Boolean canpush(n)
679 Integer n;
680 {
681     return (Boolean) (sp + n < &stack[STACKSIZE]);
682 }
683 
684 /*
685  * Push a small scalar of the given type onto the stack.
686  */
687 
688 public pushsmall(t, v)
689 Symbol t;
690 long v;
691 {
692     register Integer s;
693 
694     s = size(t);
695     switch (s) {
696 	case sizeof(char):
697 	    push(char, v);
698 	    break;
699 
700 	case sizeof(short):
701 	    push(short, v);
702 	    break;
703 
704 	case sizeof(long):
705 	    push(long, v);
706 	    break;
707 
708 	default:
709 	    panic("bad size %d in popsmall", s);
710     }
711 }
712 
713 /*
714  * Pop an item of the given type which is assumed to be no larger
715  * than a long and return it expanded into a long.
716  */
717 
718 public long popsmall(t)
719 Symbol t;
720 {
721     long r;
722 
723     switch (size(t)) {
724 	case sizeof(char):
725 	    r = (long) pop(char);
726 	    break;
727 
728 	case sizeof(short):
729 	    r = (long) pop(short);
730 	    break;
731 
732 	case sizeof(long):
733 	    r = pop(long);
734 	    break;
735 
736 	default:
737 	    panic("popsmall: size is %d", size(t));
738     }
739     return r;
740 }
741 
742 /*
743  * Evaluate a conditional expression.
744  */
745 
746 public Boolean cond(p)
747 Node p;
748 {
749     register Boolean b;
750 
751     if (p == nil) {
752 	b = true;
753     } else {
754 	eval(p);
755 	b = (Boolean) pop(Boolrep);
756     }
757     return b;
758 }
759 
760 /*
761  * Return the address corresponding to a given tree.
762  */
763 
764 public Address lval(p)
765 Node p;
766 {
767     if (p->op == O_RVAL) {
768 	eval(p->value.arg[0]);
769     } else {
770 	eval(p);
771     }
772     return (Address) (pop(long));
773 }
774 
775 /*
776  * Process a trace command, translating into the appropriate events
777  * and associated actions.
778  */
779 
780 public trace(p)
781 Node p;
782 {
783     Node exp, place, cond;
784     Node left;
785 
786     exp = p->value.arg[0];
787     place = p->value.arg[1];
788     cond = p->value.arg[2];
789     if (exp == nil) {
790 	traceall(p->op, place, cond);
791     } else if (exp->op == O_QLINE or exp->op == O_LCON) {
792 	traceinst(p->op, exp, cond);
793     } else if (place != nil and place->op == O_QLINE) {
794 	traceat(p->op, exp, place, cond);
795     } else {
796 	left = exp;
797 	if (left->op == O_RVAL or left->op == O_CALL) {
798 	    left = left->value.arg[0];
799 	}
800 	if (left->op == O_SYM and isblock(left->value.sym)) {
801 	    traceproc(p->op, left->value.sym, place, cond);
802 	} else {
803 	    tracedata(p->op, exp, place, cond);
804 	}
805     }
806 }
807 
808 /*
809  * Set a breakpoint that will turn on tracing.
810  */
811 
812 private traceall(op, place, cond)
813 Operator op;
814 Node place;
815 Node cond;
816 {
817     Symbol s;
818     Node event;
819     Command action;
820 
821     if (place == nil) {
822 	s = program;
823     } else {
824 	s = place->value.sym;
825     }
826     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
827     action = build(O_PRINTSRCPOS,
828 	build(O_QLINE, nil, build(O_LCON, (op == O_TRACE) ? 1 : 0)));
829     if (cond != nil) {
830 	action = build(O_IF, cond, buildcmdlist(action));
831     }
832     action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
833     action->value.trace.event = addevent(event, buildcmdlist(action));
834     if (isstdin()) {
835 	printevent(action->value.trace.event);
836     }
837 }
838 
839 /*
840  * Set up the appropriate breakpoint for tracing an instruction.
841  */
842 
843 private traceinst(op, exp, cond)
844 Operator op;
845 Node exp;
846 Node cond;
847 {
848     Node event, wh;
849     Command action;
850     Event e;
851 
852     if (exp->op == O_LCON) {
853 	wh = build(O_QLINE, build(O_SCON, cursource), exp);
854     } else {
855 	wh = exp;
856     }
857     if (op == O_TRACEI) {
858 	event = build(O_EQ, build(O_SYM, pcsym), wh);
859     } else {
860 	event = build(O_EQ, build(O_SYM, linesym), wh);
861     }
862     action = build(O_PRINTSRCPOS, wh);
863     if (cond) {
864 	action = build(O_IF, cond, buildcmdlist(action));
865     }
866     e = addevent(event, buildcmdlist(action));
867     if (isstdin()) {
868 	printevent(e);
869     }
870 }
871 
872 /*
873  * Set a breakpoint to print an expression at a given line or address.
874  */
875 
876 private traceat(op, exp, place, cond)
877 Operator op;
878 Node exp;
879 Node place;
880 Node cond;
881 {
882     Node event;
883     Command action;
884     Event e;
885 
886     if (op == O_TRACEI) {
887 	event = build(O_EQ, build(O_SYM, pcsym), place);
888     } else {
889 	event = build(O_EQ, build(O_SYM, linesym), place);
890     }
891     action = build(O_PRINTSRCPOS, exp);
892     if (cond != nil) {
893 	action = build(O_IF, cond, buildcmdlist(action));
894     }
895     e = addevent(event, buildcmdlist(action));
896     if (isstdin()) {
897 	printevent(e);
898     }
899 }
900 
901 /*
902  * Construct event for tracing a procedure.
903  *
904  * What we want here is
905  *
906  * 	when $proc = p do
907  *	    if <condition> then
908  *	        printcall;
909  *	        once $pc = $retaddr do
910  *	            printrtn;
911  *	        end;
912  *	    end if;
913  *	end;
914  *
915  * Note that "once" is like "when" except that the event
916  * deletes itself as part of its associated action.
917  */
918 
919 private traceproc(op, p, place, cond)
920 Operator op;
921 Symbol p;
922 Node place;
923 Node cond;
924 {
925     Node event;
926     Command action;
927     Cmdlist actionlist;
928     Event e;
929 
930     action = build(O_PRINTCALL, p);
931     actionlist = list_alloc();
932     cmdlist_append(action, actionlist);
933     event = build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym));
934     action = build(O_ONCE, event, buildcmdlist(build(O_PRINTRTN, p)));
935     cmdlist_append(action, actionlist);
936     if (cond != nil) {
937 	actionlist = buildcmdlist(build(O_IF, cond, actionlist));
938     }
939     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
940     e = addevent(event, actionlist);
941     if (isstdin()) {
942 	printevent(e);
943     }
944 }
945 
946 /*
947  * Set up breakpoint for tracing data.
948  */
949 
950 private tracedata(op, exp, place, cond)
951 Operator op;
952 Node exp;
953 Node place;
954 Node cond;
955 {
956     Symbol p;
957     Node event;
958     Command action;
959 
960     p = (place == nil) ? tcontainer(exp) : place->value.sym;
961     if (p == nil) {
962 	p = program;
963     }
964     action = build(O_PRINTIFCHANGED, exp);
965     if (cond != nil) {
966 	action = build(O_IF, cond, buildcmdlist(action));
967     }
968     action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
969     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
970     action->value.trace.event = addevent(event, buildcmdlist(action));
971     if (isstdin()) {
972 	printevent(action->value.trace.event);
973     }
974 }
975 
976 /*
977  * Setting and unsetting of stops.
978  */
979 
980 public stop(p)
981 Node p;
982 {
983     Node exp, place, cond, t;
984     Symbol s;
985     Command action;
986     Event e;
987 
988     exp = p->value.arg[0];
989     place = p->value.arg[1];
990     cond = p->value.arg[2];
991     if (exp != nil) {
992 	stopvar(p->op, exp, place, cond);
993     } else {
994 	action = build(O_STOPX);
995 	if (cond != nil) {
996 	    action = build(O_IF, cond, buildcmdlist(action));
997 	}
998 	if (place == nil or place->op == O_SYM) {
999 	    if (place == nil) {
1000 		s = program;
1001 	    } else {
1002 		s = place->value.sym;
1003 	    }
1004 	    t = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
1005 	    if (cond != nil) {
1006 		action = build(O_TRACEON, (p->op == O_STOPI),
1007 		    buildcmdlist(action));
1008 		e = addevent(t, buildcmdlist(action));
1009 		action->value.trace.event = e;
1010 	    } else {
1011 		e = addevent(t, buildcmdlist(action));
1012 	    }
1013 	    if (isstdin()) {
1014 		printevent(e);
1015 	    }
1016 	} else {
1017 	    stopinst(p->op, place, cond, action);
1018 	}
1019     }
1020 }
1021 
1022 private stopinst(op, place, cond, action)
1023 Operator op;
1024 Node place;
1025 Node cond;
1026 Command action;
1027 {
1028     Node event;
1029     Event e;
1030 
1031     if (op == O_STOP) {
1032 	event = build(O_EQ, build(O_SYM, linesym), place);
1033     } else {
1034 	event = build(O_EQ, build(O_SYM, pcsym), place);
1035     }
1036     e = addevent(event, buildcmdlist(action));
1037     if (isstdin()) {
1038 	printevent(e);
1039     }
1040 }
1041 
1042 /*
1043  * Implement stopping on assignment to a variable by adding it to
1044  * the variable list.
1045  */
1046 
1047 private stopvar(op, exp, place, cond)
1048 Operator op;
1049 Node exp;
1050 Node place;
1051 Node cond;
1052 {
1053     Symbol p;
1054     Node event;
1055     Command action;
1056 
1057     if (place == nil) {
1058 	if (exp->op == O_LCON) {
1059 	    p = program;
1060 	} else {
1061 	    p = tcontainer(exp);
1062 	    if (p == nil) {
1063 		p = program;
1064 	    }
1065 	}
1066     } else {
1067 	p = place->value.sym;
1068     }
1069     action = build(O_STOPIFCHANGED, exp);
1070     if (cond != nil) {
1071 	action = build(O_IF, cond, buildcmdlist(action));
1072     }
1073     action = build(O_TRACEON, (op == O_STOPI), buildcmdlist(action));
1074     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
1075     action->value.trace.event = addevent(event, buildcmdlist(action));
1076     if (isstdin()) {
1077 	printevent(action->value.trace.event);
1078     }
1079 }
1080 
1081 /*
1082  * Assign the value of an expression to a variable (or term).
1083  */
1084 
1085 public assign(var, exp)
1086 Node var;
1087 Node exp;
1088 {
1089     Address addr;
1090     integer varsize, expsize;
1091     char cvalue;
1092     short svalue;
1093     long lvalue;
1094     float fvalue;
1095 
1096     if (not compatible(var->nodetype, exp->nodetype)) {
1097 	error("incompatible types");
1098     }
1099     addr = lval(var);
1100     varsize = size(var->nodetype);
1101     expsize = size(exp->nodetype);
1102     eval(exp);
1103     if (varsize == sizeof(float) and expsize == sizeof(double)) {
1104 	fvalue = (float) pop(double);
1105 	dwrite(&fvalue, addr, sizeof(fvalue));
1106     } else {
1107 	if (varsize < sizeof(long)) {
1108 	    lvalue = 0;
1109 	    popn(expsize, &lvalue);
1110 	    switch (varsize) {
1111 		case sizeof(char):
1112 		    cvalue = lvalue;
1113 		    dwrite(&cvalue, addr, sizeof(cvalue));
1114 		    break;
1115 
1116 		case sizeof(short):
1117 		    svalue = lvalue;
1118 		    dwrite(&svalue, addr, sizeof(svalue));
1119 		    break;
1120 
1121 		default:
1122 		    panic("bad size %d", varsize);
1123 	    }
1124 	} else {
1125 	    if (expsize <= varsize) {
1126 		sp -= expsize;
1127 		dwrite(sp, addr, expsize);
1128 	    } else {
1129 		sp -= expsize;
1130 		dwrite(sp, addr, varsize);
1131 	    }
1132 	}
1133     }
1134 }
1135 
1136 /*
1137  * Send some nasty mail to the current support person.
1138  */
1139 
1140 public gripe()
1141 {
1142     typedef Operation();
1143     Operation *old;
1144     int pid, status;
1145     extern int versionNumber;
1146     char subject[100];
1147     char *maintainer = "linton@berkeley";
1148 
1149     puts("Type control-D to end your message.  Be sure to include");
1150     puts("your name and the name of the file you are debugging.");
1151     putchar('\n');
1152     old = signal(SIGINT, SIG_DFL);
1153     sprintf(subject, "dbx (version %d) gripe", versionNumber);
1154     pid = back("Mail", stdin, stdout, "-s", subject, maintainer, nil);
1155     signal(SIGINT, SIG_IGN);
1156     pwait(pid, &status);
1157     signal(SIGINT, old);
1158     if (status == 0) {
1159 	puts("Thank you.");
1160     } else {
1161 	puts("\nMail not sent.");
1162     }
1163 }
1164 
1165 /*
1166  * Give the user some help.
1167  */
1168 
1169 public help()
1170 {
1171     puts("run                    - begin execution of the program");
1172     puts("print <exp>            - print the value of the expression");
1173     puts("where                  - print currently active procedures");
1174     puts("stop at <line>         - suspend execution at the line");
1175     puts("stop in <proc>         - suspend execution when <proc> is called");
1176     puts("cont                   - continue execution");
1177     puts("step                   - single step one line");
1178     puts("next                   - step to next line (skip over calls)");
1179     puts("trace <line#>          - trace execution of the line");
1180     puts("trace <proc>           - trace calls to the procedure");
1181     puts("trace <var>            - trace changes to the variable");
1182     puts("trace <exp> at <line#> - print <exp> when <line> is reached");
1183     puts("status                 - print trace/stop's in effect");
1184     puts("delete <number>        - remove trace or stop of given number");
1185     puts("call <proc>            - call a procedure in program");
1186     puts("whatis <name>          - print the declaration of the name");
1187     puts("list <line>, <line>    - list source lines");
1188     puts("gripe                  - send mail to the person in charge of dbx");
1189     puts("quit                   - exit dbx");
1190 }
1191 
1192 /*
1193  * Divert output to the given file name.
1194  * Cannot redirect to an existing file.
1195  */
1196 
1197 private int so_fd;
1198 private Boolean notstdout;
1199 
1200 public setout(filename)
1201 String filename;
1202 {
1203     File f;
1204 
1205     f = fopen(filename, "r");
1206     if (f != nil) {
1207 	fclose(f);
1208 	error("%s: file already exists", filename);
1209     } else {
1210 	so_fd = dup(1);
1211 	close(1);
1212 	if (creat(filename, 0666) == nil) {
1213 	    unsetout();
1214 	    error("can't create %s", filename);
1215 	}
1216 	notstdout = true;
1217     }
1218 }
1219 
1220 /*
1221  * Revert output to standard output.
1222  */
1223 
1224 public unsetout()
1225 {
1226     fflush(stdout);
1227     close(1);
1228     if (dup(so_fd) != 1) {
1229 	panic("standard out dup failed");
1230     }
1231     close(so_fd);
1232     notstdout = false;
1233 }
1234 
1235 /*
1236  * Determine is standard output is currently being redirected
1237  * to a file (as far as we know).
1238  */
1239 
1240 public Boolean isredirected()
1241 {
1242     return notstdout;
1243 }
1244