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