xref: /original-bsd/old/dbx/eval.c (revision a910c8b7) 
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static	char sccsid[] = "@(#)eval.c	1.15 (Berkeley) 03/01/85";
4 
5 static char rcsid[] = "$Header: eval.c,v 1.5 84/12/26 10:39:08 linton Exp $";
6 
7 /*
8  * Tree evaluation.
9  */
10 
11 #include "defs.h"
12 #include "tree.h"
13 #include "operators.h"
14 #include "debug.h"
15 #include "eval.h"
16 #include "events.h"
17 #include "symbols.h"
18 #include "scanner.h"
19 #include "source.h"
20 #include "object.h"
21 #include "mappings.h"
22 #include "process.h"
23 #include "runtime.h"
24 #include "machine.h"
25 #include <signal.h>
26 
27 #ifndef public
28 
29 #include "machine.h"
30 
31 #define STACKSIZE 20000
32 
33 typedef Char Stack;
34 
35 #define push(type, value) { \
36     ((type *) (sp += sizeof(type)))[-1] = (value); \
37 }
38 
39 #define pop(type) ( \
40     (*((type *) (sp -= sizeof(type)))) \
41 )
42 
43 #define popn(n, dest) { \
44     sp -= n; \
45     bcopy(sp, dest, n); \
46 }
47 
48 #define alignstack() { \
49     sp = (Stack *) (( ((int) sp) + sizeof(int) - 1)&~(sizeof(int) - 1)); \
50 }
51 
52 #endif
53 
54 public Stack stack[STACKSIZE];
55 public Stack *sp = &stack[0];
56 public Boolean useInstLoc = false;
57 
58 #define chksp() \
59 { \
60     if (sp < &stack[0]) { \
61 	panic("stack underflow"); \
62     } \
63 }
64 
65 #define poparg(n, r, fr) { \
66     eval(p->value.arg[n]); \
67     if (isreal(p->op)) { \
68 	if (size(p->value.arg[n]->nodetype) == sizeof(float)) { \
69 	    fr = pop(float); \
70 	} else { \
71 	    fr = pop(double); \
72 	} \
73     } else if (isint(p->op)) { \
74 	r = popsmall(p->value.arg[n]->nodetype); \
75     } \
76 }
77 
78 #define Boolrep char	/* underlying representation type for booleans */
79 
80 /*
81  * Command-level evaluation.
82  */
83 
84 public Node topnode;
85 
86 public topeval (p)
87 Node p;
88 {
89     if (traceeval) {
90 	fprintf(stderr, "topeval(");
91 	prtree(stderr, p);
92 	fprintf(stderr, ")\n");
93 	fflush(stderr);
94     }
95     topnode = p;
96     eval(p);
97 }
98 
99 /*
100  * Evaluate a parse tree leaving the value on the top of the stack.
101  */
102 
103 public eval(p)
104 register Node p;
105 {
106     long r0, r1;
107     double fr0, fr1;
108     Address addr;
109     long i, n;
110     int len;
111     Symbol s;
112     Node n1, n2;
113     boolean b;
114     File file;
115     String str;
116 
117     checkref(p);
118     if (traceeval) {
119 	fprintf(stderr, "begin eval %s\n", opname(p->op));
120     }
121     switch (degree(p->op)) {
122 	case BINARY:
123 	    poparg(1, r1, fr1);
124 	    poparg(0, r0, fr0);
125 	    break;
126 
127 	case UNARY:
128 	    poparg(0, r0, fr0);
129 	    break;
130 
131 	default:
132 	    /* do nothing */;
133     }
134     switch (p->op) {
135 	case O_SYM:
136 	    s = p->value.sym;
137 	    if (s == retaddrsym) {
138 		push(long, return_addr());
139 	    } else if (isvariable(s)) {
140 		if (s != program and not isactive(container(s))) {
141 		    error("\"%s\" is not active", symname(s));
142 		}
143 		if (isvarparam(s) and not isopenarray(s)) {
144 		    rpush(address(s, nil), sizeof(Address));
145 		} else {
146 		    push(Address, address(s, nil));
147 		}
148 	    } else if (isblock(s)) {
149 		push(Symbol, s);
150 	    } else if (isconst(s)) {
151 		eval(constval(s));
152 	    } else {
153 		error("can't evaluate a %s", classname(s));
154 	    }
155 	    break;
156 
157 	case O_LCON:
158 	case O_CCON:
159 	    r0 = p->value.lcon;
160 	    pushsmall(p->nodetype, r0);
161 	    break;
162 
163 	case O_FCON:
164 	    push(double, p->value.fcon);
165 	    break;
166 
167 	case O_SCON:
168 	    len = size(p->nodetype);
169 	    mov(p->value.scon, sp, len);
170 	    sp += len;
171 	    break;
172 
173 	case O_INDEX:
174 	    s = p->value.arg[0]->nodetype;
175 	    p->value.arg[0]->nodetype = t_addr;
176 	    eval(p->value.arg[0]);
177 	    p->value.arg[0]->nodetype = s;
178 	    n = pop(Address);
179 	    eval(p->value.arg[1]);
180 	    evalindex(s, n, popsmall(p->value.arg[1]->nodetype));
181 	    break;
182 
183 	case O_DOT:
184 	    s = p->value.arg[1]->value.sym;
185 	    eval(p->value.arg[0]);
186 	    n = pop(long);
187 	    push(long, n + (s->symvalue.field.offset div 8));
188 	    break;
189 
190 	/*
191 	 * Get the value of the expression addressed by the top of the stack.
192 	 * Push the result back on the stack.
193 	 */
194 
195 	case O_INDIR:
196 	case O_RVAL:
197 	    addr = pop(long);
198 	    if (addr == 0) {
199 		error("reference through nil pointer");
200 	    }
201 	    len = size(p->nodetype);
202 	    rpush(addr, len);
203 	    break;
204 
205 	/*
206 	 * Move the stack pointer so that the top of the stack has
207 	 * something corresponding to the size of the current node type.
208 	 * If this new type is bigger than the subtree (len > 0),
209 	 * then the stack is padded with nulls.  If it's smaller,
210 	 * the stack is just dropped by the appropriate amount.
211 	 */
212 	case O_TYPERENAME:
213 	    len = size(p->nodetype) - size(p->value.arg[0]->nodetype);
214 	    if (len > 0) {
215 		for (n = 0; n < len; n++) {
216 		    *sp++ = '\0';
217 		}
218 	    } else if (len < 0) {
219 		sp += len;
220 	    }
221 	    break;
222 
223 	case O_COMMA:
224 	    eval(p->value.arg[0]);
225 	    if (p->value.arg[1] != nil) {
226 		eval(p->value.arg[1]);
227 	    }
228 	    break;
229 
230 	case O_ITOF:
231 	    push(double, (double) r0);
232 	    break;
233 
234 	case O_ADD:
235 	    push(long, r0+r1);
236 	    break;
237 
238 	case O_ADDF:
239 	    push(double, fr0+fr1);
240 	    break;
241 
242 	case O_SUB:
243 	    push(long, r0-r1);
244 	    break;
245 
246 	case O_SUBF:
247 	    push(double, fr0-fr1);
248 	    break;
249 
250 	case O_NEG:
251 	    push(long, -r0);
252 	    break;
253 
254 	case O_NEGF:
255 	    push(double, -fr0);
256 	    break;
257 
258 	case O_MUL:
259 	    push(long, r0*r1);
260 	    break;
261 
262 	case O_MULF:
263 	    push(double, fr0*fr1);
264 	    break;
265 
266 	case O_DIVF:
267 	    if (fr1 == 0) {
268 		error("error: division by 0");
269 	    }
270 	    push(double, fr0 / fr1);
271 	    break;
272 
273 	case O_DIV:
274 	    if (r1 == 0) {
275 		error("error: div by 0");
276 	    }
277 	    push(long, r0 div r1);
278 	    break;
279 
280 	case O_MOD:
281 	    if (r1 == 0) {
282 		error("error: mod by 0");
283 	    }
284 	    push(long, r0 mod r1);
285 	    break;
286 
287 	case O_LT:
288 	    push(Boolrep, r0 < r1);
289 	    break;
290 
291 	case O_LTF:
292 	    push(Boolrep, fr0 < fr1);
293 	    break;
294 
295 	case O_LE:
296 	    push(Boolrep, r0 <= r1);
297 	    break;
298 
299 	case O_LEF:
300 	    push(Boolrep, fr0 <= fr1);
301 	    break;
302 
303 	case O_GT:
304 	    push(Boolrep, r0 > r1);
305 	    break;
306 
307 	case O_GTF:
308 	    push(Boolrep, fr0 > fr1);
309 	    break;
310 
311 	case O_EQ:
312 	    push(Boolrep, r0 == r1);
313 	    break;
314 
315 	case O_EQF:
316 	    push(Boolrep, fr0 == fr1);
317 	    break;
318 
319 	case O_NE:
320 	    push(Boolrep, r0 != r1);
321 	    break;
322 
323 	case O_NEF:
324 	    push(Boolrep, fr0 != fr1);
325 	    break;
326 
327 	case O_AND:
328 	    push(Boolrep, r0 and r1);
329 	    break;
330 
331 	case O_OR:
332 	    push(Boolrep, r0 or r1);
333 	    break;
334 
335 	case O_ASSIGN:
336 	    assign(p->value.arg[0], p->value.arg[1]);
337 	    break;
338 
339 	case O_CHFILE:
340 	    if (p->value.scon == nil) {
341 		printf("%s\n", cursource);
342 	    } else {
343 		file = opensource(p->value.scon);
344 		if (file == nil) {
345 		    error("can't read \"%s\"", p->value.scon);
346 		} else {
347 		    fclose(file);
348 		    setsource(p->value.scon);
349 		}
350 	    }
351 	    break;
352 
353 	case O_CONT:
354 	    cont(p->value.lcon);
355 	    printnews();
356 	    break;
357 
358 	case O_LIST:
359 	    list(p);
360 	    break;
361 
362 	case O_FUNC:
363 	    func(p->value.arg[0]);
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 (n2 == nil) {
456 		if (n1 == nil) {
457 		    alias(nil, nil, nil);
458 		} else {
459 		    alias(n1->value.name, nil, nil);
460 		}
461 	    } else if (n2->op == O_NAME) {
462 		str = ident(n2->value.name);
463 		alias(n1->value.name, nil, strdup(str));
464 	    } else {
465 		if (n1->op == O_COMMA) {
466 		    alias(
467 			n1->value.arg[0]->value.name,
468 			(List) n1->value.arg[1],
469 			n2->value.scon
470 		    );
471 		} else {
472 		    alias(n1->value.name, nil, n2->value.scon);
473 		}
474 	    }
475 	    break;
476 
477 	case O_UNALIAS:
478 	    unalias(p->value.arg[0]->value.name);
479 	    break;
480 
481 	case O_CALLPROC:
482 	    callproc(p, false);
483 	    break;
484 
485 	case O_CALL:
486 	    callproc(p, true);
487 	    break;
488 
489 	case O_CATCH:
490 	    if (p->value.lcon == 0) {
491 		printsigscaught(process);
492 	    } else {
493 		psigtrace(process, p->value.lcon, true);
494 	    }
495 	    break;
496 
497 	case O_EDIT:
498 	    edit(p->value.scon);
499 	    break;
500 
501         case O_DEBUG:
502             debug(p);
503 	    break;
504 
505 	case O_DOWN:
506 	    checkref(p->value.arg[0]);
507 	    assert(p->value.arg[0]->op == O_LCON);
508 	    down(p->value.arg[0]->value.lcon);
509 	    break;
510 
511 	case O_DUMP:
512 	    if (p->value.arg[0] == nil) {
513 		dumpall();
514 	    } else {
515 		s = p->value.arg[0]->value.sym;
516 		if (s == curfunc) {
517 		    dump(nil);
518 		} else {
519 		    dump(s);
520 		}
521 	    }
522 	    break;
523 
524 	case O_GRIPE:
525 	    gripe();
526 	    break;
527 
528 	case O_HELP:
529 	    help();
530 	    break;
531 
532 	case O_IGNORE:
533 	    if (p->value.lcon == 0) {
534 		printsigsignored(process);
535 	    } else {
536 		psigtrace(process, p->value.lcon, false);
537 	    }
538 	    break;
539 
540 	case O_RETURN:
541 	    if (p->value.arg[0] == nil) {
542 		rtnfunc(nil);
543 	    } else {
544 		assert(p->value.arg[0]->op == O_SYM);
545 		rtnfunc(p->value.arg[0]->value.sym);
546 	    }
547 	    break;
548 
549 	case O_RUN:
550 	    run();
551 	    break;
552 
553 	case O_SET:
554 	    set(p->value.arg[0], p->value.arg[1]);
555 	    break;
556 
557 	case O_SEARCH:
558 	    search(p->value.arg[0]->value.lcon, p->value.arg[1]->value.scon);
559 	    break;
560 
561 	case O_SOURCE:
562 	    setinput(p->value.scon);
563 	    break;
564 
565 	case O_STATUS:
566 	    status();
567 	    break;
568 
569 	case O_TRACE:
570 	case O_TRACEI:
571 	    trace(p);
572 	    break;
573 
574 	case O_STOP:
575 	case O_STOPI:
576 	    stop(p);
577 	    break;
578 
579 	case O_UNSET:
580 	    undefvar(p->value.arg[0]->value.name);
581 	    break;
582 
583 	case O_UP:
584 	    checkref(p->value.arg[0]);
585 	    assert(p->value.arg[0]->op == O_LCON);
586 	    up(p->value.arg[0]->value.lcon);
587 	    break;
588 
589 	case O_ADDEVENT:
590 	    addevent(p->value.event.cond, p->value.event.actions);
591 	    break;
592 
593 	case O_DELETE:
594 	    n1 = p->value.arg[0];
595 	    while (n1->op == O_COMMA) {
596 		n2 = n1->value.arg[0];
597 		assert(n2->op == O_LCON);
598 		if (not delevent((unsigned int) n2->value.lcon)) {
599 		    error("unknown event %ld", n2->value.lcon);
600 		}
601 		n1 = n1->value.arg[1];
602 	    }
603 	    assert(n1->op == O_LCON);
604 	    if (not delevent((unsigned int) n1->value.lcon)) {
605 		error("unknown event %ld", n1->value.lcon);
606 	    }
607 	    break;
608 
609 	case O_ENDX:
610 	    endprogram();
611 	    break;
612 
613 	case O_IF:
614 	    if (cond(p->value.event.cond)) {
615 		evalcmdlist(p->value.event.actions);
616 	    }
617 	    break;
618 
619 	case O_ONCE:
620 	    event_once(p->value.event.cond, p->value.event.actions);
621 	    break;
622 
623 	case O_PRINTCALL:
624 	    printcall(p->value.sym, whatblock(return_addr()));
625 	    break;
626 
627 	case O_PRINTIFCHANGED:
628 	    printifchanged(p->value.arg[0]);
629 	    break;
630 
631 	case O_PRINTRTN:
632 	    printrtn(p->value.sym);
633 	    break;
634 
635 	case O_PRINTSRCPOS:
636 	    getsrcpos();
637 	    if (p->value.arg[0] == nil) {
638 		printsrcpos();
639 		putchar('\n');
640 		printlines(curline, curline);
641 	    } else if (p->value.arg[0]->op == O_QLINE) {
642 		if (p->value.arg[0]->value.arg[1]->value.lcon == 0) {
643 		    printf("tracei: ");
644 		    printinst(pc, pc);
645 		} else {
646 		    if (canReadSource()) {
647 			printf("trace:  ");
648 			printlines(curline, curline);
649 		    }
650 		}
651 	    } else {
652 		printsrcpos();
653 		printf(": ");
654 		eval(p->value.arg[0]);
655 		prtree(stdout, p->value.arg[0]);
656 		printf(" = ");
657 		printval(p->value.arg[0]->nodetype);
658 		putchar('\n');
659 	    }
660 	    break;
661 
662 	case O_PROCRTN:
663 	    procreturn(p->value.sym);
664 	    break;
665 
666 	case O_STOPIFCHANGED:
667 	    stopifchanged(p->value.arg[0]);
668 	    break;
669 
670 	case O_STOPX:
671 	    isstopped = true;
672 	    break;
673 
674 	case O_TRACEON:
675 	    traceon(p->value.trace.inst, p->value.trace.event,
676 		p->value.trace.actions);
677 	    break;
678 
679 	case O_TRACEOFF:
680 	    traceoff(p->value.lcon);
681 	    break;
682 
683 	default:
684 	    panic("eval: bad op %d", p->op);
685     }
686     if (traceeval) {
687 	fprintf(stderr, "end eval %s\n", opname(p->op));
688     }
689 }
690 
691 /*
692  * Evaluate a list of commands.
693  */
694 
695 public evalcmdlist(cl)
696 Cmdlist cl;
697 {
698     Command c;
699 
700     foreach (Command, c, cl)
701 	evalcmd(c);
702     endfor
703 }
704 
705 /*
706  * Push "len" bytes onto the expression stack from address "addr"
707  * in the process.  If there isn't room on the stack, print an error message.
708  */
709 
710 public rpush(addr, len)
711 Address addr;
712 int len;
713 {
714     if (not canpush(len)) {
715 	error("expression too large to evaluate");
716     } else {
717 	chksp();
718 	dread(sp, addr, len);
719 	sp += len;
720     }
721 }
722 
723 /*
724  * Check if the stack has n bytes available.
725  */
726 
727 public Boolean canpush(n)
728 Integer n;
729 {
730     return (Boolean) (sp + n < &stack[STACKSIZE]);
731 }
732 
733 /*
734  * Push a small scalar of the given type onto the stack.
735  */
736 
737 public pushsmall(t, v)
738 Symbol t;
739 long v;
740 {
741     register Integer s;
742 
743     s = size(t);
744     switch (s) {
745 	case sizeof(char):
746 	    push(char, v);
747 	    break;
748 
749 	case sizeof(short):
750 	    push(short, v);
751 	    break;
752 
753 	case sizeof(long):
754 	    push(long, v);
755 	    break;
756 
757 	default:
758 	    panic("bad size %d in popsmall", s);
759     }
760 }
761 
762 /*
763  * Pop an item of the given type which is assumed to be no larger
764  * than a long and return it expanded into a long.
765  */
766 
767 public long popsmall(t)
768 Symbol t;
769 {
770     register integer n;
771     long r;
772 
773     n = size(t);
774     if (n == sizeof(char)) {
775 	if (t->class == RANGE and t->symvalue.rangev.lower >= 0) {
776 	    r = (long) pop(unsigned char);
777 	} else {
778 	    r = (long) pop(char);
779 	}
780     } else if (n == sizeof(short)) {
781 	if (t->class == RANGE and t->symvalue.rangev.lower >= 0) {
782 	    r = (long) pop(unsigned short);
783 	} else {
784 	    r = (long) pop(short);
785 	}
786     } else if (n == sizeof(long)) {
787 	r = pop(long);
788     } else {
789 	error("[internal error: size %d in popsmall]", n);
790     }
791     return r;
792 }
793 
794 /*
795  * Evaluate a conditional expression.
796  */
797 
798 public Boolean cond(p)
799 Node p;
800 {
801     register Boolean b;
802 
803     if (p == nil) {
804 	b = true;
805     } else {
806 	eval(p);
807 	b = (Boolean) pop(Boolrep);
808     }
809     return b;
810 }
811 
812 /*
813  * Return the address corresponding to a given tree.
814  */
815 
816 public Address lval(p)
817 Node p;
818 {
819     if (p->op == O_RVAL) {
820 	eval(p->value.arg[0]);
821     } else {
822 	eval(p);
823     }
824     return (Address) (pop(long));
825 }
826 
827 /*
828  * Process a trace command, translating into the appropriate events
829  * and associated actions.
830  */
831 
832 public trace(p)
833 Node p;
834 {
835     Node exp, place, cond;
836     Node left;
837 
838     exp = p->value.arg[0];
839     place = p->value.arg[1];
840     cond = p->value.arg[2];
841     if (exp == nil) {
842 	traceall(p->op, place, cond);
843     } else if (exp->op == O_QLINE or exp->op == O_LCON) {
844 	traceinst(p->op, exp, cond);
845     } else if (place != nil and place->op == O_QLINE) {
846 	traceat(p->op, exp, place, cond);
847     } else {
848 	left = exp;
849 	if (left->op == O_RVAL or left->op == O_CALL) {
850 	    left = left->value.arg[0];
851 	}
852 	if (left->op == O_SYM and isblock(left->value.sym)) {
853 	    traceproc(p->op, left->value.sym, place, cond);
854 	} else {
855 	    tracedata(p->op, exp, place, cond);
856 	}
857     }
858 }
859 
860 /*
861  * Set a breakpoint that will turn on tracing.
862  */
863 
864 private traceall(op, place, cond)
865 Operator op;
866 Node place;
867 Node cond;
868 {
869     Symbol s;
870     Node event;
871     Command action;
872 
873     if (place == nil) {
874 	s = program;
875     } else {
876 	s = place->value.sym;
877     }
878     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
879     action = build(O_PRINTSRCPOS,
880 	build(O_QLINE, nil, build(O_LCON, (op == O_TRACE) ? 1 : 0)));
881     if (cond != nil) {
882 	action = build(O_IF, cond, buildcmdlist(action));
883     }
884     action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
885     action->value.trace.event = addevent(event, buildcmdlist(action));
886     if (isstdin()) {
887 	printevent(action->value.trace.event);
888     }
889 }
890 
891 /*
892  * Set up the appropriate breakpoint for tracing an instruction.
893  */
894 
895 private traceinst(op, exp, cond)
896 Operator op;
897 Node exp;
898 Node cond;
899 {
900     Node event, wh;
901     Command action;
902     Event e;
903 
904     if (exp->op == O_LCON) {
905 	wh = build(O_QLINE, build(O_SCON, strdup(cursource)), exp);
906     } else {
907 	wh = exp;
908     }
909     if (op == O_TRACEI) {
910 	event = build(O_EQ, build(O_SYM, pcsym), wh);
911     } else {
912 	event = build(O_EQ, build(O_SYM, linesym), wh);
913     }
914     action = build(O_PRINTSRCPOS, wh);
915     if (cond) {
916 	action = build(O_IF, cond, buildcmdlist(action));
917     }
918     e = addevent(event, buildcmdlist(action));
919     if (isstdin()) {
920 	printevent(e);
921     }
922 }
923 
924 /*
925  * Set a breakpoint to print an expression at a given line or address.
926  */
927 
928 private traceat(op, exp, place, cond)
929 Operator op;
930 Node exp;
931 Node place;
932 Node cond;
933 {
934     Node event;
935     Command action;
936     Event e;
937 
938     if (op == O_TRACEI) {
939 	event = build(O_EQ, build(O_SYM, pcsym), place);
940     } else {
941 	event = build(O_EQ, build(O_SYM, linesym), place);
942     }
943     action = build(O_PRINTSRCPOS, exp);
944     if (cond != nil) {
945 	action = build(O_IF, cond, buildcmdlist(action));
946     }
947     e = addevent(event, buildcmdlist(action));
948     if (isstdin()) {
949 	printevent(e);
950     }
951 }
952 
953 /*
954  * Construct event for tracing a procedure.
955  *
956  * What we want here is
957  *
958  * 	when $proc = p do
959  *	    if <condition> then
960  *	        printcall;
961  *	        once $pc = $retaddr do
962  *	            printrtn;
963  *	        end;
964  *	    end if;
965  *	end;
966  *
967  * Note that "once" is like "when" except that the event
968  * deletes itself as part of its associated action.
969  */
970 
971 private traceproc(op, p, place, cond)
972 Operator op;
973 Symbol p;
974 Node place;
975 Node cond;
976 {
977     Node event;
978     Command action;
979     Cmdlist actionlist;
980     Event e;
981 
982     action = build(O_PRINTCALL, p);
983     actionlist = list_alloc();
984     cmdlist_append(action, actionlist);
985     event = build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym));
986     action = build(O_ONCE, event, buildcmdlist(build(O_PRINTRTN, p)));
987     cmdlist_append(action, actionlist);
988     if (cond != nil) {
989 	actionlist = buildcmdlist(build(O_IF, cond, actionlist));
990     }
991     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
992     e = addevent(event, actionlist);
993     if (isstdin()) {
994 	printevent(e);
995     }
996 }
997 
998 /*
999  * Set up breakpoint for tracing data.
1000  */
1001 
1002 private tracedata(op, exp, place, cond)
1003 Operator op;
1004 Node exp;
1005 Node place;
1006 Node cond;
1007 {
1008     Symbol p;
1009     Node event;
1010     Command action;
1011 
1012     p = (place == nil) ? tcontainer(exp) : place->value.sym;
1013     if (p == nil) {
1014 	p = program;
1015     }
1016     action = build(O_PRINTIFCHANGED, exp);
1017     if (cond != nil) {
1018 	action = build(O_IF, cond, buildcmdlist(action));
1019     }
1020     action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
1021     event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
1022     action->value.trace.event = addevent(event, buildcmdlist(action));
1023     if (isstdin()) {
1024 	printevent(action->value.trace.event);
1025     }
1026 }
1027 
1028 /*
1029  * Setting and unsetting of stops.
1030  */
1031 
1032 public stop(p)
1033 Node p;
1034 {
1035     Node exp, place, cond, t;
1036     Symbol s;
1037     Command action;
1038     Event e;
1039 
1040     exp = p->value.arg[0];
1041     place = p->value.arg[1];
1042     cond = p->value.arg[2];
1043     if (exp != nil) {
1044 	stopvar(p->op, exp, place, cond);
1045     } else {
1046 	action = build(O_STOPX);
1047 	if (cond != nil) {
1048 	    action = build(O_IF, cond, buildcmdlist(action));
1049 	}
1050 	if (place == nil or place->op == O_SYM) {
1051 	    if (place == nil) {
1052 		s = program;
1053 	    } else {
1054 		s = place->value.sym;
1055 	    }
1056 	    t = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
1057 	    if (cond != nil) {
1058 		action = build(O_TRACEON, (p->op == O_STOPI),
1059 		    buildcmdlist(action));
1060 		e = addevent(t, buildcmdlist(action));
1061 		action->value.trace.event = e;
1062 	    } else {
1063 		e = addevent(t, buildcmdlist(action));
1064 	    }
1065 	    if (isstdin()) {
1066 		printevent(e);
1067 	    }
1068 	} else {
1069 	    stopinst(p->op, place, cond, action);
1070 	}
1071     }
1072 }
1073 
1074 private stopinst(op, place, cond, action)
1075 Operator op;
1076 Node place;
1077 Node cond;
1078 Command action;
1079 {
1080     Node event;
1081     Event e;
1082 
1083     if (op == O_STOP) {
1084 	event = build(O_EQ, build(O_SYM, linesym), place);
1085     } else {
1086 	event = build(O_EQ, build(O_SYM, pcsym), place);
1087     }
1088     e = addevent(event, buildcmdlist(action));
1089     if (isstdin()) {
1090 	printevent(e);
1091     }
1092 }
1093 
1094 /*
1095  * Implement stopping on assignment to a variable by adding it to
1096  * the variable list.
1097  */
1098 
1099 private stopvar(op, exp, place, cond)
1100 Operator op;
1101 Node exp;
1102 Node place;
1103 Node cond;
1104 {
1105     Symbol p;
1106     Node event;
1107     Command action;
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     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 }
1298 
1299 /*
1300  * Give the user some help.
1301  */
1302 
1303 public help()
1304 {
1305     puts("run                    - begin execution of the program");
1306     puts("print <exp>            - print the value of the expression");
1307     puts("where                  - print currently active procedures");
1308     puts("stop at <line>         - suspend execution at the line");
1309     puts("stop in <proc>         - suspend execution when <proc> is called");
1310     puts("cont                   - continue execution");
1311     puts("step                   - single step one line");
1312     puts("next                   - step to next line (skip over calls)");
1313     puts("trace <line#>          - trace execution of the line");
1314     puts("trace <proc>           - trace calls to the procedure");
1315     puts("trace <var>            - trace changes to the variable");
1316     puts("trace <exp> at <line#> - print <exp> when <line> is reached");
1317     puts("status                 - print trace/stop's in effect");
1318     puts("delete <number>        - remove trace or stop of given number");
1319     puts("call <proc>            - call a procedure in program");
1320     puts("whatis <name>          - print the declaration of the name");
1321     puts("list <line>, <line>    - list source lines");
1322     puts("gripe                  - send mail to the person in charge of dbx");
1323     puts("quit                   - exit dbx");
1324 }
1325 
1326 /*
1327  * Divert output to the given file name.
1328  * Cannot redirect to an existing file.
1329  */
1330 
1331 private int so_fd;
1332 private Boolean notstdout;
1333 
1334 public setout(filename)
1335 String filename;
1336 {
1337     File f;
1338 
1339     f = fopen(filename, "r");
1340     if (f != nil) {
1341 	fclose(f);
1342 	error("%s: file already exists", filename);
1343     } else {
1344 	so_fd = dup(1);
1345 	close(1);
1346 	if (creat(filename, 0666) == nil) {
1347 	    unsetout();
1348 	    error("can't create %s", filename);
1349 	}
1350 	notstdout = true;
1351     }
1352 }
1353 
1354 /*
1355  * Revert output to standard output.
1356  */
1357 
1358 public unsetout()
1359 {
1360     fflush(stdout);
1361     close(1);
1362     if (dup(so_fd) != 1) {
1363 	panic("standard out dup failed");
1364     }
1365     close(so_fd);
1366     notstdout = false;
1367 }
1368 
1369 /*
1370  * Determine is standard output is currently being redirected
1371  * to a file (as far as we know).
1372  */
1373 
1374 public Boolean isredirected()
1375 {
1376     return notstdout;
1377 }
1378