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