xref: /original-bsd/old/dbx/runtime.vax.c (revision 1afa398d)
1 /*
2  * Copyright (c) 1983 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.redist.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)runtime.vax.c	5.6 (Berkeley) 01/27/91";
10 #endif /* not lint */
11 
12 /*
13  * Runtime organization dependent routines, mostly dealing with
14  * activation records.
15  */
16 
17 #include "defs.h"
18 #include "runtime.h"
19 #include "process.h"
20 #include "machine.h"
21 #include "events.h"
22 #include "mappings.h"
23 #include "symbols.h"
24 #include "tree.h"
25 #include "eval.h"
26 #include "operators.h"
27 #include "object.h"
28 #include <sys/param.h>
29 #include <signal.h>
30 
31 #ifndef public
32 typedef struct Frame *Frame;
33 
34 #include "machine.h"
35 #endif
36 
37 #define NSAVEREG 12
38 
39 struct Frame {
40     integer condition_handler;
41     integer mask;
42     Address save_ap;		/* argument pointer */
43     Address save_fp;		/* frame pointer */
44     Address save_pc;		/* program counter */
45     Word save_reg[NSAVEREG];	/* not necessarily there */
46 };
47 
48 private Frame curframe = nil;
49 private struct Frame curframerec;
50 private Boolean walkingstack = false;
51 
52 #define frameeq(f1, f2) ((f1)->save_fp == (f2)->save_fp)
53 
54 #define inSignalHandler(addr) \
55     (((addr) < 0x80000000) and ((addr) > 0x80000000 - ctob(UPAGES)))
56 
57 typedef struct {
58     Node callnode;
59     Node cmdnode;
60     boolean isfunc;
61 } CallEnv;
62 
63 private CallEnv endproc;
64 
65 /*
66  * Set a frame to the current activation record.
67  */
68 
69 private getcurframe(frp)
70 Frame frp;
71 {
72     register int i;
73 
74     checkref(frp);
75     frp->mask = reg(NREG);
76     frp->save_ap = reg(ARGP);
77     frp->save_fp = reg(FRP);
78     frp->save_pc = reg(PROGCTR);
79     for (i = 0; i < NSAVEREG; i++) {
80 	frp->save_reg[i] = reg(i);
81     }
82 }
83 
84 /*
85  * Get the saved registers from one frame to another
86  * given mask specifying which registers were actually saved.
87  */
88 
89 #define bis(b, n) ((b & (1 << (n))) != 0)
90 
91 private getsaveregs (newfrp, frp, mask)
92 Frame newfrp, frp;
93 integer mask;
94 {
95     integer i, j;
96 
97     j = 0;
98     for (i = 0; i < NSAVEREG; i++) {
99 	if (bis(mask, i)) {
100 	    newfrp->save_reg[i] = frp->save_reg[j];
101 	    ++j;
102 	}
103     }
104 }
105 
106 /*
107  * Return a pointer to the next activation record up the stack.
108  * Return nil if there is none.
109  * Writes over space pointed to by given argument.
110  */
111 
112 private Frame nextframe(frp)
113 Frame frp;
114 {
115     Frame newfrp;
116     struct Frame frame;
117     integer mask;
118     Address prev_frame, callpc;
119     static integer ntramp = 0;
120 
121     newfrp = frp;
122     prev_frame = frp->save_fp;
123 
124 /*
125  *  The check for interrupt generated frames is taken from adb with only
126  *  partial understanding.  If you're in "sub" and on a sigxxx "sigsub"
127  *  gets control, then the stack does NOT look like <main, sub, sigsub>.
128  *
129  *  As best I can make out it looks like:
130  *
131  *     <main, (machine check exception block + sub), sysframe, sigsub>.
132  *
133  *  When the signal occurs an exception block and a frame for the routine
134  *  in which it occured are pushed on the user stack.  Then another frame
135  *  is pushed corresponding to a call from the kernel to sigsub.
136  *
137  *  The addr in sub at which the exception occured is not in sub.save_pc
138  *  but in the machine check exception block.  It is at the magic address
139  *  fp + 84.
140  *
141  *  The current approach ignores the sys_frame (what adb reports as sigtramp)
142  *  and takes the pc for sub from the exception block.  This allows the
143  *  "where" command to report <main, sub, sigsub>, which seems reasonable.
144  */
145 
146 nextf:
147     if (prev_frame + sizeof(struct Frame) <= USRSTACK) {
148 	dread(&frame, prev_frame, sizeof(struct Frame));
149     } else if (USRSTACK - prev_frame > 2 * sizeof(Word)) {
150 	dread(&frame, prev_frame, USRSTACK - prev_frame);
151     } else {
152 	frame.save_fp = nil;
153     }
154     if (ntramp == 1) {
155 	dread(&callpc, prev_frame + 92, sizeof(callpc));
156     } else {
157 	callpc = frame.save_pc;
158     }
159     if (frame.save_fp == nil or frame.save_pc == (Address) -1) {
160 	newfrp = nil;
161     } else {
162 	if (inSignalHandler(callpc)) {
163 	    ntramp++;
164 	    prev_frame = frame.save_fp;
165 	    goto nextf;
166 	}
167 	frame.save_pc = callpc;
168         ntramp = 0;
169 	newfrp->save_fp = frame.save_fp;
170 	newfrp->save_pc = frame.save_pc;
171 	mask = ((frame.mask >> 16) & 0x0fff);
172 	getsaveregs(newfrp, &frame, mask);
173 	newfrp->condition_handler = frame.condition_handler;
174 	newfrp->mask = mask;
175 	newfrp->save_ap = frame.save_ap;
176     }
177     return newfrp;
178 }
179 
180 /*
181  * Get the current frame information in the given Frame and store the
182  * associated function in the given value-result parameter.
183  */
184 
185 private getcurfunc (frp, fp)
186 Frame frp;
187 Symbol *fp;
188 {
189     getcurframe(frp);
190     *fp = whatblock(frp->save_pc);
191 }
192 
193 /*
194  * Return the frame associated with the next function up the call stack, or
195  * nil if there is none.  The function is returned in a value-result parameter.
196  * For "inline" functions the statically outer function and same frame
197  * are returned.
198  */
199 
200 public Frame nextfunc (frp, fp)
201 Frame frp;
202 Symbol *fp;
203 {
204     Symbol t;
205     Frame nfrp;
206 
207     t = *fp;
208     checkref(t);
209     if (isinline(t)) {
210 	t = container(t);
211 	nfrp = frp;
212     } else {
213 	nfrp = nextframe(frp);
214 	if (nfrp == nil) {
215 	    t = nil;
216 	} else {
217 	    t = whatblock(nfrp->save_pc);
218 	}
219     }
220     *fp = t;
221     return nfrp;
222 }
223 
224 /*
225  * Return the frame associated with the given function.
226  * If the function is nil, return the most recently activated frame.
227  *
228  * Static allocation for the frame.
229  */
230 
231 public Frame findframe(f)
232 Symbol f;
233 {
234     Frame frp;
235     static struct Frame frame;
236     Symbol p;
237     Boolean done;
238 
239     frp = &frame;
240     getcurframe(frp);
241     if (f != nil) {
242 	if (f == curfunc and curframe != nil) {
243 	    *frp = *curframe;
244 	} else {
245 	    done = false;
246 	    p = whatblock(frp->save_pc);
247 	    do {
248 		if (p == f) {
249 		    done = true;
250 		} else if (p == program) {
251 		    done = true;
252 		    frp = nil;
253 		} else {
254 		    frp = nextfunc(frp, &p);
255 		    if (frp == nil) {
256 			done = true;
257 		    }
258 		}
259 	    } while (not done);
260 	}
261     }
262     return frp;
263 }
264 
265 /*
266  * Set the registers according to the given frame pointer.
267  */
268 
269 public getnewregs (addr)
270 Address addr;
271 {
272     struct Frame frame;
273     integer i, j, mask;
274 
275     dread(&frame, addr, sizeof(frame));
276     setreg(FRP, frame.save_fp);
277     setreg(PROGCTR, frame.save_pc);
278     setreg(ARGP, frame.save_ap);
279     mask = ((frame.mask >> 16) & 0x0fff);
280     j = 0;
281     for (i = 0; i < NSAVEREG; i++) {
282 	if (bis(mask, i)) {
283 	setreg(i, frame.save_reg[j]);
284 	++j;
285 	}
286     }
287     pc = frame.save_pc;
288     setcurfunc(whatblock(pc));
289 }
290 
291 /*
292  * Find the return address of the current procedure/function.
293  */
294 
295 public Address return_addr()
296 {
297     Frame frp;
298     Address addr;
299     struct Frame frame;
300 
301     frp = &frame;
302     getcurframe(frp);
303     frp = nextframe(frp);
304     if (frp == nil) {
305 	addr = 0;
306     } else {
307 	addr = frp->save_pc;
308     }
309     return addr;
310 }
311 
312 /*
313  * Push the value associated with the current function.
314  */
315 
316 public pushretval(len, isindirect)
317 integer len;
318 boolean isindirect;
319 {
320     Word r0;
321 
322     r0 = reg(0);
323     if (isindirect) {
324 	rpush((Address) r0, len);
325     } else {
326 	switch (len) {
327 	    case sizeof(char):
328 		push(char, r0);
329 		break;
330 
331 	    case sizeof(short):
332 		push(short, r0);
333 		break;
334 
335 	    default:
336 		if (len == sizeof(Word)) {
337 		    push(Word, r0);
338 		} else if (len == 2*sizeof(Word)) {
339 		    push(Word, r0);
340 		    push(Word, reg(1));
341 		} else {
342 		    error("[internal error: bad size %d in pushretval]", len);
343 		}
344 		break;
345 	}
346     }
347 }
348 
349 /*
350  * Return the base address for locals in the given frame.
351  */
352 
353 public Address locals_base(frp)
354 Frame frp;
355 {
356     return (frp == nil) ? reg(FRP) : frp->save_fp;
357 }
358 
359 /*
360  * Return the base address for arguments in the given frame.
361  */
362 
363 public Address args_base(frp)
364 Frame frp;
365 {
366     return (frp == nil) ? reg(ARGP) : frp->save_ap;
367 }
368 
369 /*
370  * Return saved register n from the given frame.
371  */
372 
373 public Word savereg(n, frp)
374 integer n;
375 Frame frp;
376 {
377     Word w;
378 
379     if (frp == nil) {
380 	w = reg(n);
381     } else {
382 	switch (n) {
383 	    case ARGP:
384 		w = frp->save_ap;
385 		break;
386 
387 	    case FRP:
388 		w = frp->save_fp;
389 		break;
390 
391 	    case STKP:
392 		w = reg(STKP);
393 		break;
394 
395 	    case PROGCTR:
396 		w = frp->save_pc;
397 		break;
398 
399 	    default:
400 		assert(n >= 0 and n < NSAVEREG);
401 		w = frp->save_reg[n];
402 		break;
403 	}
404     }
405     return w;
406 }
407 
408 /*
409  * Return the nth argument to the current procedure.
410  */
411 
412 public Word argn(n, frp)
413 integer n;
414 Frame frp;
415 {
416     Address argaddr;
417     Word w;
418 
419     argaddr = args_base(frp) + (n * sizeof(Word));
420     dread(&w, argaddr, sizeof(w));
421     return w;
422 }
423 
424 /*
425  * Print a list of currently active blocks starting with most recent.
426  */
427 
428 public wherecmd()
429 {
430     walkstack(false);
431 }
432 
433 /*
434  * Print the variables in the given frame or the current one if nil.
435  */
436 
437 public dump (func)
438 Symbol func;
439 {
440     Symbol f;
441     Frame frp;
442 
443     if (func == nil) {
444 	f = curfunc;
445 	if (curframe != nil) {
446 	    frp = curframe;
447 	} else {
448 	    frp = findframe(f);
449 	}
450     } else {
451 	f = func;
452 	frp = findframe(f);
453     }
454     showaggrs = true;
455     printcallinfo(f, frp);
456     dumpvars(f, frp);
457 }
458 
459 /*
460  * Dump all values.
461  */
462 
463 public dumpall ()
464 {
465     walkstack(true);
466 }
467 
468 /*
469  * Walk the stack of active procedures printing information
470  * about each active procedure.
471  */
472 
473 private walkstack(dumpvariables)
474 Boolean dumpvariables;
475 {
476     Frame frp;
477     boolean save;
478     Symbol f;
479     struct Frame frame;
480 
481     if (notstarted(process) or isfinished(process)) {
482 	error("program is not active");
483     } else {
484 	save = walkingstack;
485 	walkingstack = true;
486 	showaggrs = dumpvariables;
487 	frp = &frame;
488 	getcurfunc(frp, &f);
489 	for (;;) {
490 	    printcallinfo(f, frp);
491 	    if (dumpvariables) {
492 		dumpvars(f, frp);
493 		putchar('\n');
494 	    }
495 	    frp = nextfunc(frp, &f);
496 	    if (frp == nil or f == program) {
497 		break;
498 	    }
499 	}
500 	if (dumpvariables) {
501 	    printf("in \"%s\":\n", symname(program));
502 	    dumpvars(program, nil);
503 	    putchar('\n');
504 	}
505 	walkingstack = save;
506     }
507 }
508 
509 /*
510  * Print out the information about a call, i.e.,
511  * routine name, parameter values, and source location.
512  */
513 
514 private printcallinfo (f, frp)
515 Symbol f;
516 Frame frp;
517 {
518     Lineno line;
519     Address savepc;
520 
521     savepc = frp->save_pc;
522     if (frp->save_fp != reg(FRP)) {
523 	savepc -= 1;
524     }
525     printname(stdout, f);
526     if (not isinline(f)) {
527 	printparams(f, frp);
528     }
529     line = srcline(savepc);
530     if (line != 0) {
531 	printf(", line %d", line);
532 	printf(" in \"%s\"\n", srcfilename(savepc));
533     } else {
534 	printf(" at 0x%x\n", savepc);
535     }
536 }
537 
538 /*
539  * Set the current function to the given symbol.
540  * We must adjust "curframe" so that subsequent operations are
541  * not confused; for simplicity we simply clear it.
542  */
543 
544 public setcurfunc (f)
545 Symbol f;
546 {
547     curfunc = f;
548     curframe = nil;
549 }
550 
551 /*
552  * Return the frame for the current function.
553  * The space for the frame is allocated statically.
554  */
555 
556 public Frame curfuncframe ()
557 {
558     static struct Frame frame;
559     Frame frp;
560 
561     if (curframe == nil) {
562 	frp = findframe(curfunc);
563 	curframe = &curframerec;
564 	*curframe = *frp;
565     } else {
566 	frp = &frame;
567 	*frp = *curframe;
568     }
569     return frp;
570 }
571 
572 /*
573  * Set curfunc to be N up/down the stack from its current value.
574  */
575 
576 public up (n)
577 integer n;
578 {
579     integer i;
580     Symbol f;
581     Frame frp;
582     boolean done;
583 
584     if (not isactive(program)) {
585 	error("program is not active");
586     } else if (curfunc == nil) {
587 	error("no current function");
588     } else {
589 	i = 0;
590 	f = curfunc;
591 	frp = curfuncframe();
592 	done = false;
593 	do {
594 	    if (frp == nil) {
595 		done = true;
596 		error("not that many levels");
597 	    } else if (i >= n) {
598 		done = true;
599 		curfunc = f;
600 		curframe = &curframerec;
601 		*curframe = *frp;
602 		showaggrs = false;
603 		printcallinfo(curfunc, curframe);
604 	    } else if (f == program) {
605 		done = true;
606 		error("not that many levels");
607 	    } else {
608 		frp = nextfunc(frp, &f);
609 	    }
610 	    ++i;
611 	} while (not done);
612     }
613 }
614 
615 public down (n)
616 integer n;
617 {
618     integer i, depth;
619     Frame frp, curfrp;
620     Symbol f;
621     struct Frame frame;
622 
623     if (not isactive(program)) {
624 	error("program is not active");
625     } else if (curfunc == nil) {
626 	error("no current function");
627     } else {
628 	depth = 0;
629 	frp = &frame;
630 	getcurfunc(frp, &f);
631 	if (curframe == nil) {
632 	    curfrp = findframe(curfunc);
633 	    curframe = &curframerec;
634 	    *curframe = *curfrp;
635 	}
636 	while ((f != curfunc or !frameeq(frp, curframe)) and f != nil) {
637 	    frp = nextfunc(frp, &f);
638 	    ++depth;
639 	}
640 	if (f == nil or n > depth) {
641 	    error("not that many levels");
642 	} else {
643 	    depth -= n;
644 	    frp = &frame;
645 	    getcurfunc(frp, &f);
646 	    for (i = 0; i < depth; i++) {
647 		frp = nextfunc(frp, &f);
648 		assert(frp != nil);
649 	    }
650 	    curfunc = f;
651 	    *curframe = *frp;
652 	    showaggrs = false;
653 	    printcallinfo(curfunc, curframe);
654 	}
655     }
656 }
657 
658 /*
659  * Find the entry point of a procedure or function.
660  *
661  * On the VAX we add the size of the register mask (FUNCOFFSET) or
662  * the size of the Modula-2 internal entry sequence, on other machines
663  * (68000's) we add the entry sequence size (FUNCOFFSET) unless
664  * we're right at the beginning of the program.
665  */
666 
667 public findbeginning (f)
668 Symbol f;
669 {
670     if (isinternal(f)) {
671 	f->symvalue.funcv.beginaddr += 18;	/* VAX only */
672     } else {
673 	f->symvalue.funcv.beginaddr += FUNCOFFSET;
674     }
675 }
676 
677 /*
678  * Return the address corresponding to the first line in a function.
679  */
680 
681 public Address firstline(f)
682 Symbol f;
683 {
684     Address addr;
685 
686     addr = codeloc(f);
687     while (linelookup(addr) == 0 and addr < objsize) {
688 	++addr;
689     }
690     if (addr == objsize) {
691 	addr = -1;
692     }
693     return addr;
694 }
695 
696 /*
697  * Catcher drops strike three ...
698  */
699 
700 public runtofirst()
701 {
702     Address addr, endaddr;
703 
704     addr = pc;
705     endaddr = objsize + CODESTART;
706     while (linelookup(addr) == 0 and addr < endaddr) {
707 	++addr;
708     }
709     if (addr < endaddr) {
710 	stepto(addr);
711     }
712 }
713 
714 /*
715  * Return the address corresponding to the end of the program.
716  *
717  * We look for the entry to "exit".
718  */
719 
720 public Address lastaddr()
721 {
722     Symbol s;
723 
724     s = lookup(identname("exit", true));
725     if (s == nil) {
726 	panic("can't find exit");
727     }
728     return codeloc(s);
729 }
730 
731 /*
732  * Decide if the given function is currently active.
733  *
734  * We avoid calls to "findframe" during a stack trace for efficiency.
735  * Presumably information evaluated while walking the stack is active.
736  */
737 
738 public Boolean isactive (f)
739 Symbol f;
740 {
741     Boolean b;
742 
743     if (isfinished(process)) {
744 	b = false;
745     } else {
746 	if (walkingstack or f == program or f == nil or
747 	  (ismodule(f) and isactive(container(f)))) {
748 	    b = true;
749 	} else {
750 	    b = (Boolean) (findframe(f) != nil);
751 	}
752     }
753     return b;
754 }
755 
756 /*
757  * Evaluate a call to a procedure.
758  */
759 
760 public callproc(exprnode, isfunc)
761 Node exprnode;
762 boolean isfunc;
763 {
764     Node procnode, arglist;
765     Symbol proc;
766     integer argc;
767 
768     procnode = exprnode->value.arg[0];
769     arglist = exprnode->value.arg[1];
770     if (procnode->op != O_SYM) {
771 	beginerrmsg();
772 	fprintf(stderr, "can't call \"");
773 	prtree(stderr, procnode);
774 	fprintf(stderr, "\"");
775 	enderrmsg();
776     }
777     assert(procnode->op == O_SYM);
778     proc = procnode->value.sym;
779     if (not isblock(proc)) {
780 	error("\"%s\" is not a procedure or function", symname(proc));
781     }
782     endproc.isfunc = isfunc;
783     endproc.callnode = exprnode;
784     endproc.cmdnode = topnode;
785     pushenv();
786     pc = codeloc(proc);
787     argc = pushargs(proc, arglist);
788     setreg(FRP, 1);	/* have to ensure it's non-zero for return_addr() */
789     beginproc(proc, argc);
790     event_once(
791 	build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym)),
792 	buildcmdlist(build(O_PROCRTN, proc))
793     );
794     isstopped = false;
795     if (not bpact()) {
796 	isstopped = true;
797 	cont(0);
798     }
799     /*
800      * bpact() won't return true, it will call printstatus() and go back
801      * to command input if a breakpoint is found.
802      */
803     /* NOTREACHED */
804 }
805 
806 /*
807  * Push the arguments on the process' stack.  We do this by first
808  * evaluating them on the "eval" stack, then copying into the process'
809  * space.
810  */
811 
812 private integer pushargs(proc, arglist)
813 Symbol proc;
814 Node arglist;
815 {
816     Stack *savesp;
817     int argc, args_size;
818 
819     savesp = sp;
820     if (varIsSet("$unsafecall")) {
821 	argc = unsafe_evalargs(proc, arglist);
822     } else {
823 	argc = evalargs(proc, arglist);
824     }
825     args_size = sp - savesp;
826     setreg(STKP, reg(STKP) - args_size);
827     dwrite(savesp, reg(STKP), args_size);
828     sp = savesp;
829     return argc;
830 }
831 
832 /*
833  * Check to see if an expression is correct for a given parameter.
834  * If the given parameter is false, don't worry about type inconsistencies.
835  *
836  * Return whether or not it is ok.
837  */
838 
839 private boolean chkparam (actual, formal, chk)
840 Node actual;
841 Symbol formal;
842 boolean chk;
843 {
844     boolean b;
845 
846     b = true;
847     if (chk) {
848 	if (formal == nil) {
849 	    beginerrmsg();
850 	    fprintf(stderr, "too many parameters");
851 	    b = false;
852 	} else if (not compatible(formal->type, actual->nodetype)) {
853 	    beginerrmsg();
854 	    fprintf(stderr, "type mismatch for %s", symname(formal));
855 	    b = false;
856 	}
857     }
858     if (b and formal != nil and
859 	isvarparam(formal) and not isopenarray(formal->type) and
860 	not (
861 	    actual->op == O_RVAL or actual->nodetype == t_addr or
862 	    (
863 		actual->op == O_TYPERENAME and
864 		(
865 		    actual->value.arg[0]->op == O_RVAL or
866 		    actual->value.arg[0]->nodetype == t_addr
867 		)
868 	    )
869 	)
870     ) {
871 	beginerrmsg();
872 	fprintf(stderr, "expected variable, found \"");
873 	prtree(stderr, actual);
874 	fprintf(stderr, "\"");
875 	b = false;
876     }
877     return b;
878 }
879 
880 /*
881  * Pass an expression to a particular parameter.
882  *
883  * Normally we pass either the address or value, but in some cases
884  * (such as C strings) we want to copy the value onto the stack and
885  * pass its address.
886  *
887  * Another special case raised by strings is the possibility that
888  * the actual parameter will be larger than the formal, even with
889  * appropriate type-checking.  This occurs because we assume during
890  * evaluation that strings are null-terminated, whereas some languages,
891  * notably Pascal, do not work under that assumption.
892  */
893 
894 private passparam (actual, formal)
895 Node actual;
896 Symbol formal;
897 {
898     boolean b;
899     Address addr;
900     Stack *savesp;
901     integer actsize, formsize;
902 
903     if (formal != nil and isvarparam(formal) and
904 	(not isopenarray(formal->type))
905     ) {
906 	addr = lval(actual->value.arg[0]);
907 	push(Address, addr);
908     } else if (passaddr(formal, actual->nodetype)) {
909 	savesp = sp;
910 	eval(actual);
911 	actsize = sp - savesp;
912 	setreg(STKP,
913 	    reg(STKP) - ((actsize + sizeof(Word) - 1) & ~(sizeof(Word) - 1))
914 	);
915 	dwrite(savesp, reg(STKP), actsize);
916 	sp = savesp;
917 	push(Address, reg(STKP));
918 	if (formal != nil and isopenarray(formal->type)) {
919 	    push(integer, actsize div size(formal->type->type));
920 	}
921     } else if (formal != nil) {
922 	formsize = size(formal);
923 	savesp = sp;
924 	eval(actual);
925 	actsize = sp - savesp;
926 	if (actsize > formsize) {
927 	    sp -= (actsize - formsize);
928 	}
929     } else {
930 	eval(actual);
931     }
932 }
933 
934 /*
935  * Evaluate an argument list left-to-right.
936  */
937 
938 private integer evalargs(proc, arglist)
939 Symbol proc;
940 Node arglist;
941 {
942     Node p, actual;
943     Symbol formal;
944     Stack *savesp;
945     integer count;
946     boolean chk;
947 
948     savesp = sp;
949     count = 0;
950     formal = proc->chain;
951     chk = (boolean) (not nosource(proc));
952     for (p = arglist; p != nil; p = p->value.arg[1]) {
953 	assert(p->op == O_COMMA);
954 	actual = p->value.arg[0];
955 	if (not chkparam(actual, formal, chk)) {
956 	    fprintf(stderr, " in call to %s", symname(proc));
957 	    sp = savesp;
958 	    enderrmsg();
959 	}
960 	passparam(actual, formal);
961 	if (formal != nil) {
962 	    formal = formal->chain;
963 	}
964 	++count;
965     }
966     if (chk) {
967 	if (formal != nil) {
968 	    sp = savesp;
969 	    error("not enough parameters to %s", symname(proc));
970 	}
971     }
972     return count;
973 }
974 
975 /*
976  * Evaluate an argument list without any type checking.
977  * This is only useful for procedures with a varying number of
978  * arguments that are compiled -g.
979  */
980 
981 private integer unsafe_evalargs (proc, arglist)
982 Symbol proc;
983 Node arglist;
984 {
985     Node p;
986     integer count;
987 
988     count = 0;
989     for (p = arglist; p != nil; p = p->value.arg[1]) {
990 	assert(p->op == O_COMMA);
991 	eval(p->value.arg[0]);
992 	++count;
993     }
994     return count;
995 }
996 
997 public procreturn(f)
998 Symbol f;
999 {
1000     integer retvalsize;
1001     Node tmp;
1002     char *copy;
1003 
1004     flushoutput();
1005     popenv();
1006     if (endproc.isfunc) {
1007 	retvalsize = size(f->type);
1008 	if (retvalsize > sizeof(long)) {
1009 	    pushretval(retvalsize, true);
1010 	    copy = newarr(char, retvalsize);
1011 	    popn(retvalsize, copy);
1012 	    tmp = build(O_SCON, copy);
1013 	} else {
1014 	    tmp = build(O_LCON, (long) (reg(0)));
1015 	}
1016 	tmp->nodetype = f->type;
1017 	tfree(endproc.callnode);
1018 	*(endproc.callnode) = *(tmp);
1019 	dispose(tmp);
1020 	eval(endproc.cmdnode);
1021     } else {
1022 	putchar('\n');
1023 	printname(stdout, f);
1024 	printf(" returns successfully\n");
1025     }
1026     erecover();
1027 }
1028 
1029 /*
1030  * Push the current environment.
1031  */
1032 
1033 private pushenv()
1034 {
1035     push(Address, pc);
1036     push(Lineno, curline);
1037     push(String, cursource);
1038     push(Boolean, isstopped);
1039     push(Symbol, curfunc);
1040     push(Frame, curframe);
1041     push(struct Frame, curframerec);
1042     push(CallEnv, endproc);
1043     push(Word, reg(PROGCTR));
1044     push(Word, reg(STKP));
1045     push(Word, reg(FRP));
1046 }
1047 
1048 /*
1049  * Pop back to the real world.
1050  */
1051 
1052 public popenv()
1053 {
1054     String filename;
1055 
1056     setreg(FRP, pop(Word));
1057     setreg(STKP, pop(Word));
1058     setreg(PROGCTR, pop(Word));
1059     endproc = pop(CallEnv);
1060     curframerec = pop(struct Frame);
1061     curframe = pop(Frame);
1062     curfunc = pop(Symbol);
1063     isstopped = pop(Boolean);
1064     filename = pop(String);
1065     curline = pop(Lineno);
1066     pc = pop(Address);
1067     setsource(filename);
1068 }
1069 
1070 /*
1071  * Flush the debuggee's standard output.
1072  *
1073  * This is VERY dependent on the use of stdio.
1074  */
1075 
1076 public flushoutput()
1077 {
1078     Symbol p, iob;
1079     Stack *savesp;
1080 
1081     p = lookup(identname("fflush", true));
1082     while (p != nil and not isblock(p)) {
1083 	p = p->next_sym;
1084     }
1085     if (p != nil) {
1086 	iob = lookup(identname("__sF", true));
1087 	if (iob != nil) {
1088 	    pushenv();
1089 	    pc = codeloc(p) - FUNCOFFSET;
1090 	    savesp = sp;
1091 	    push(long, address(iob, nil) + sizeof(*stdout));
1092 	    setreg(STKP, reg(STKP) - sizeof(long));
1093 	    dwrite(savesp, reg(STKP), sizeof(long));
1094 	    sp = savesp;
1095 	    beginproc(p, 1);
1096 	    stepto(return_addr());
1097 	    popenv();
1098 	}
1099     }
1100 }
1101