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