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