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