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