X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/551efd5bd782e379f393d15741751e8a5a2fc352..dc0e9d5051968b633dbad1c43b90e583b0784799:/usr/src/old/dbx/runtime.c

diff --git a/usr/src/old/dbx/runtime.c b/usr/src/old/dbx/runtime.c
index 0592fba046..5bc63eaab2 100644
--- a/usr/src/old/dbx/runtime.c
+++ b/usr/src/old/dbx/runtime.c
@@ -1,6 +1,14 @@
-/* Copyright (c) 1982 Regents of the University of California */
+/*
+ * Copyright (c) 1983 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
+ */
 
-static char sccsid[] = "@(#)runtime.c 1.5 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)runtime.c	5.3 (Berkeley) %G%";
+#endif not lint
+
+static char rcsid[] = "$Header: runtime.c,v 1.5 84/12/26 10:41:52 linton Exp $";
 
 /*
  * Runtime organization dependent routines, mostly dealing with
@@ -18,6 +26,7 @@ static char sccsid[] = "@(#)runtime.c 1.5 %G%";
 #include "eval.h"
 #include "operators.h"
 #include "object.h"
+#include <sys/param.h>
 
 #ifndef public
 typedef struct Frame *Frame;
@@ -28,22 +37,37 @@ typedef struct Frame *Frame;
 #define NSAVEREG 12
 
 struct Frame {
-    Integer condition_handler;
-    Integer mask;
+    integer condition_handler;
+    integer mask;
     Address save_ap;		/* argument pointer */
     Address save_fp;		/* frame pointer */
     Address save_pc;		/* program counter */
     Word save_reg[NSAVEREG];	/* not necessarily there */
 };
 
+private Frame curframe = nil;
+private struct Frame curframerec;
 private Boolean walkingstack = false;
 
+#define frameeq(f1, f2) ((f1)->save_fp == (f2)->save_fp)
+
+#define isstackaddr(addr) \
+    (((addr) < 0x80000000) and ((addr) > 0x80000000 - 0x200 * UPAGES))
+
+typedef struct {
+    Node callnode;
+    Node cmdnode;
+    boolean isfunc;
+} CallEnv;
+
+private CallEnv endproc;
+
 /*
  * Set a frame to the current activation record.
  */
 
 private getcurframe(frp)
-register Frame frp;
+Frame frp;
 {
     register int i;
 
@@ -51,40 +75,92 @@ register Frame frp;
     frp->mask = reg(NREG);
     frp->save_ap = reg(ARGP);
     frp->save_fp = reg(FRP);
-    frp->save_pc = reg(PROGCTR) + 1;
+    frp->save_pc = reg(PROGCTR);
     for (i = 0; i < NSAVEREG; i++) {
 	frp->save_reg[i] = reg(i);
     }
 }
 
+/*
+ * Get the saved registers from one frame to another
+ * given mask specifying which registers were actually saved.
+ */
+
+#define bis(b, n) ((b & (1 << (n))) != 0)
+
+private getsaveregs (newfrp, frp, mask)
+Frame newfrp, frp;
+integer mask;
+{
+    integer i, j;
+
+    j = 0;
+    for (i = 0; i < NSAVEREG; i++) {
+	if (bis(mask, i)) {
+	    newfrp->save_reg[i] = frp->save_reg[j];
+	    ++j;
+	}
+    }
+}
+
 /*
  * Return a pointer to the next activation record up the stack.
  * Return nil if there is none.
  * Writes over space pointed to by given argument.
  */
 
-#define bis(b, n) ((b & (1 << (n))) != 0)
-
 private Frame nextframe(frp)
 Frame frp;
 {
-    register Frame newfrp;
+    Frame newfrp;
     struct Frame frame;
-    register Integer i, j, mask;
+    integer mask;
+    Address prev_frame, callpc; 
+    static integer ntramp = 0;
 
     newfrp = frp;
-    dread(&frame, newfrp->save_fp, sizeof(struct Frame));
-    if (frame.save_fp == nil) {
+    prev_frame = frp->save_fp;
+
+/*
+ *  The check for interrupt generated frames is taken from adb with only
+ *  partial understanding.  If you're in "sub" and on a sigxxx "sigsub"
+ *  gets control, then the stack does NOT look like <main, sub, sigsub>.
+ *
+ *  As best I can make out it looks like:
+ *
+ *     <main, (machine check exception block + sub), sysframe, sigsub>.
+ *
+ *  When the signal occurs an exception block and a frame for the routine
+ *  in which it occured are pushed on the user stack.  Then another frame
+ *  is pushed corresponding to a call from the kernel to sigsub.
+ *
+ *  The addr in sub at which the exception occured is not in sub.save_pc
+ *  but in the machine check exception block.  It is at the magic address
+ *  fp + 84.
+ *
+ *  The current approach ignores the sys_frame (what adb reports as sigtramp)
+ *  and takes the pc for sub from the exception block.  This allows the
+ *  "where" command to report <main, sub, sigsub>, which seems reasonable.
+ */
+
+nextf:
+    dread(&frame, prev_frame, sizeof(struct Frame));
+    if (ntramp == 1) {
+	dread(&callpc, prev_frame + 84, sizeof(callpc));
+    } else {
+	callpc = frame.save_pc;
+    }
+    if (frame.save_fp == nil or frame.save_pc == (Address) -1) {
 	newfrp = nil;
+    } else if (isstackaddr(callpc)) {
+	ntramp++;
+	prev_frame = frame.save_fp;
+	goto nextf;
     } else {
+	frame.save_pc = callpc;
+        ntramp = 0;
 	mask = ((frame.mask >> 16) & 0x0fff);
-	j = 0;
-	for (i = 0; i < NSAVEREG; i++) {
-	    if (bis(mask, i)) {
-		newfrp->save_reg[i] = frame.save_reg[j];
-		++j;
-	    }
-	}
+	getsaveregs(newfrp, &frame, mask);
 	newfrp->condition_handler = frame.condition_handler;
 	newfrp->mask = mask;
 	newfrp->save_ap = frame.save_ap;
@@ -94,6 +170,50 @@ Frame frp;
     return newfrp;
 }
 
+/*
+ * Get the current frame information in the given Frame and store the
+ * associated function in the given value-result parameter.
+ */
+
+private getcurfunc (frp, fp)
+Frame frp;
+Symbol *fp;
+{
+    getcurframe(frp);
+    *fp = whatblock(frp->save_pc);
+}
+
+/*
+ * Return the frame associated with the next function up the call stack, or
+ * nil if there is none.  The function is returned in a value-result parameter.
+ * For "inline" functions the statically outer function and same frame
+ * are returned.
+ */
+
+public Frame nextfunc (frp, fp)
+Frame frp;
+Symbol *fp;
+{
+    Symbol t;
+    Frame nfrp;
+
+    t = *fp;
+    checkref(t);
+    if (isinline(t)) {
+	t = container(t);
+	nfrp = frp;
+    } else {
+	nfrp = nextframe(frp);
+	if (nfrp == nil) {
+	    t = nil;
+	} else {
+	    t = whatblock(nfrp->save_pc);
+	}
+    }
+    *fp = t;
+    return nfrp;
+}
+
 /*
  * Return the frame associated with the given function.
  * If the function is nil, return the most recently activated frame.
@@ -104,7 +224,7 @@ Frame frp;
 public Frame findframe(f)
 Symbol f;
 {
-    register Frame frp;
+    Frame frp;
     static struct Frame frame;
     Symbol p;
     Boolean done;
@@ -112,25 +232,55 @@ Symbol f;
     frp = &frame;
     getcurframe(frp);
     if (f != nil) {
-	done = false;
-	do {
+	if (f == curfunc and curframe != nil) {
+	    *frp = *curframe;
+	} else {
+	    done = false;
 	    p = whatblock(frp->save_pc);
-	    if (p == f) {
-		done = true;
-	    } else if (p == program) {
-		done = true;
-		frp = nil;
-	    } else {
-		frp = nextframe(frp);
-		if (frp == nil) {
+	    do {
+		if (p == f) {
 		    done = true;
+		} else if (p == program) {
+		    done = true;
+		    frp = nil;
+		} else {
+		    frp = nextfunc(frp, &p);
+		    if (frp == nil) {
+			done = true;
+		    }
 		}
-	    }
-	} while (not done);
+	    } while (not done);
+	}
     }
     return frp;
 }
 
+/*
+ * Set the registers according to the given frame pointer.
+ */
+
+public getnewregs (addr)
+Address addr;
+{
+    struct Frame frame;
+    integer i, j, mask;
+
+    dread(&frame, addr, sizeof(frame));
+    setreg(ARGP, frame.save_ap);
+    setreg(FRP, frame.save_fp);
+    setreg(PROGCTR, frame.save_pc);
+    mask = ((frame.mask >> 16) & 0x0fff);
+    j = 0;
+    for (i = 0; i < NSAVEREG; i++) {
+	if (bis(mask, i)) {
+	    setreg(i, frame.save_reg[j]);
+	    ++j;
+	}
+    }
+    pc = frame.save_pc;
+    setcurfunc(whatblock(pc));
+}
+
 /*
  * Find the return address of the current procedure/function.
  */
@@ -157,8 +307,8 @@ public Address return_addr()
  */
 
 public pushretval(len, isindirect)
-Integer len;
-Boolean isindirect;
+integer len;
+boolean isindirect;
 {
     Word r0;
 
@@ -182,7 +332,7 @@ Boolean isindirect;
 		    push(Word, r0);
 		    push(Word, reg(1));
 		} else {
-		    panic("not indirect in pushretval?");
+		    error("[internal error: bad size %d in pushretval]", len);
 		}
 		break;
 	}
@@ -194,7 +344,7 @@ Boolean isindirect;
  */
 
 public Address locals_base(frp)
-register Frame frp;
+Frame frp;
 {
     return (frp == nil) ? reg(FRP) : frp->save_fp;
 }
@@ -204,7 +354,7 @@ register Frame frp;
  */
 
 public Address args_base(frp)
-register Frame frp;
+Frame frp;
 {
     return (frp == nil) ? reg(ARGP) : frp->save_ap;
 }
@@ -214,10 +364,10 @@ register Frame frp;
  */
 
 public Word savereg(n, frp)
-register Integer n;
-register Frame frp;
+integer n;
+Frame frp;
 {
-    register Word w;
+    Word w;
 
     if (frp == nil) {
 	w = reg(n);
@@ -253,7 +403,7 @@ register Frame frp;
  */
 
 public Word argn(n, frp)
-Integer n;
+integer n;
 Frame frp;
 {
     Word w;
@@ -263,34 +413,45 @@ Frame frp;
 }
 
 /*
- * Calculate the entry address for a procedure or function parameter,
- * given the address of the descriptor.
+ * Print a list of currently active blocks starting with most recent.
  */
 
-public Address fparamaddr(a)
-Address a;
+public wherecmd()
 {
-    Address r;
-
-    dread(&r, a, sizeof(r));
-    return r;
+    walkstack(false);
 }
 
 /*
- * Print a list of currently active blocks starting with most recent.
+ * Print the variables in the given frame or the current one if nil.
  */
 
-public wherecmd()
+public dump (func)
+Symbol func;
 {
-    walkstack(false);
+    Symbol f;
+    Frame frp;
+
+    if (func == nil) {
+	f = curfunc;
+	if (curframe != nil) {
+	    frp = curframe;
+	} else {
+	    frp = findframe(f);
+	}
+    } else {
+	f = func;
+	frp = findframe(f);
+    }
+    showaggrs = true;
+    printcallinfo(f, frp);
+    dumpvars(f, frp);
 }
 
 /*
- * Dump the world to the given file.
- * Like "where", but variables are dumped also.
+ * Dump all values.
  */
 
-public dump()
+public dumpall ()
 {
     walkstack(true);
 }
@@ -303,39 +464,30 @@ public dump()
 private walkstack(dumpvariables)
 Boolean dumpvariables;
 {
-    register Frame frp;
-    register Symbol f;
-    register Boolean save;
-    register Lineno line;
+    Frame frp;
+    boolean save;
+    Symbol f;
     struct Frame frame;
 
-    if (notstarted(process)) {
+    if (notstarted(process) or isfinished(process)) {
 	error("program is not active");
     } else {
 	save = walkingstack;
 	walkingstack = true;
+	showaggrs = dumpvariables;
 	frp = &frame;
-	getcurframe(frp);
-	f = whatblock(frp->save_pc);
-	do {
-	    printf("%s", symname(f));
-	    printparams(f, frp);
-	    line = srcline(frp->save_pc - 1);
-	    if (line != 0) {
-		printf(", line %d", line);
-		printf(" in \"%s\"\n", srcfilename(frp->save_pc - 1));
-	    } else {
-		printf(" at 0x%x\n", frp->save_pc);
-	    }
+	getcurfunc(frp, &f);
+	for (;;) {
+	    printcallinfo(f, frp);
 	    if (dumpvariables) {
 		dumpvars(f, frp);
 		putchar('\n');
 	    }
-	    frp = nextframe(frp);
-	    if (frp != nil) {
-		f = whatblock(frp->save_pc);
+	    frp = nextfunc(frp, &f);
+	    if (frp == nil or f == program) {
+		break;
 	    }
-	} while (frp != nil and f != program);
+	}
 	if (dumpvariables) {
 	    printf("in \"%s\":\n", symname(program));
 	    dumpvars(program, nil);
@@ -345,14 +497,167 @@ Boolean dumpvariables;
     }
 }
 
+/*
+ * Print out the information about a call, i.e.,
+ * routine name, parameter values, and source location.
+ */
+
+private printcallinfo (f, frp)
+Symbol f;
+Frame frp;
+{
+    Lineno line;
+    Address savepc;
+
+    savepc = frp->save_pc;
+    if (frp->save_fp != reg(FRP)) {
+	savepc -= 1;
+    }
+    printname(stdout, f);
+    if (not isinline(f)) {
+	printparams(f, frp);
+    }
+    line = srcline(savepc);
+    if (line != 0) {
+	printf(", line %d", line);
+	printf(" in \"%s\"\n", srcfilename(savepc));
+    } else {
+	printf(" at 0x%x\n", savepc);
+    }
+}
+
+/*
+ * Set the current function to the given symbol.
+ * We must adjust "curframe" so that subsequent operations are
+ * not confused; for simplicity we simply clear it.
+ */
+
+public setcurfunc (f)
+Symbol f;
+{
+    curfunc = f;
+    curframe = nil;
+}
+
+/*
+ * Return the frame for the current function.
+ * The space for the frame is allocated statically.
+ */
+
+public Frame curfuncframe ()
+{
+    static struct Frame frame;
+    Frame frp;
+
+    if (curframe == nil) {
+	frp = findframe(curfunc);
+	curframe = &curframerec;
+	*curframe = *frp;
+    } else {
+	frp = &frame;
+	*frp = *curframe;
+    }
+    return frp;
+}
+
+/*
+ * Set curfunc to be N up/down the stack from its current value.
+ */
+
+public up (n)
+integer n;
+{
+    integer i;
+    Symbol f;
+    Frame frp;
+    boolean done;
+
+    if (not isactive(program)) {
+	error("program is not active");
+    } else if (curfunc == nil) {
+	error("no current function");
+    } else {
+	i = 0;
+	f = curfunc;
+	frp = curfuncframe();
+	done = false;
+	do {
+	    if (frp == nil) {
+		done = true;
+		error("not that many levels");
+	    } else if (i >= n) {
+		done = true;
+		curfunc = f;
+		curframe = &curframerec;
+		*curframe = *frp;
+		showaggrs = false;
+		printcallinfo(curfunc, curframe);
+	    } else if (f == program) {
+		done = true;
+		error("not that many levels");
+	    } else {
+		frp = nextfunc(frp, &f);
+	    }
+	    ++i;
+	} while (not done);
+    }
+}
+
+public down (n)
+integer n;
+{
+    integer i, depth;
+    Frame frp, curfrp;
+    Symbol f;
+    struct Frame frame;
+
+    if (not isactive(program)) {
+	error("program is not active");
+    } else if (curfunc == nil) {
+	error("no current function");
+    } else {
+	depth = 0;
+	frp = &frame;
+	getcurfunc(frp, &f);
+	if (curframe == nil) {
+	    curfrp = findframe(curfunc);
+	    curframe = &curframerec;
+	    *curframe = *curfrp;
+	}
+	while ((f != curfunc or !frameeq(frp, curframe)) and f != nil) {
+	    frp = nextfunc(frp, &f);
+	    ++depth;
+	}
+	if (f == nil or n > depth) {
+	    error("not that many levels");
+	} else {
+	    depth -= n;
+	    frp = &frame;
+	    getcurfunc(frp, &f);
+	    for (i = 0; i < depth; i++) {
+		frp = nextfunc(frp, &f);
+		assert(frp != nil);
+	    }
+	    curfunc = f;
+	    *curframe = *frp;
+	    showaggrs = false;
+	    printcallinfo(curfunc, curframe);
+	}
+    }
+}
+
 /*
  * Find the entry point of a procedure or function.
  */
 
-public findbeginning(f)
+public findbeginning (f)
 Symbol f;
 {
-    f->symvalue.funcv.beginaddr += 2;
+    if (isinternal(f)) {
+	f->symvalue.funcv.beginaddr += 15;
+    } else {
+	f->symvalue.funcv.beginaddr += 2;
+    }
 }
 
 /*
@@ -399,7 +704,7 @@ public runtofirst()
 
 public Address lastaddr()
 {
-    register Symbol s;
+    Symbol s;
 
     s = lookup(identname("exit", true));
     if (s == nil) {
@@ -418,7 +723,7 @@ public Address lastaddr()
 public Boolean isactive(f)
 Symbol f;
 {
-    register Boolean b;
+    Boolean b;
 
     if (isfinished(process)) {
 	b = false;
@@ -437,13 +742,16 @@ Symbol f;
  * Evaluate a call to a procedure.
  */
 
-public callproc(procnode, arglist)
-Node procnode;
-Node arglist;
+public callproc(exprnode, isfunc)
+Node exprnode;
+boolean isfunc;
 {
+    Node procnode, arglist;
     Symbol proc;
-    Integer argc;
+    integer argc;
 
+    procnode = exprnode->value.arg[0];
+    arglist = exprnode->value.arg[1];
     if (procnode->op != O_SYM) {
 	beginerrmsg();
 	fprintf(stderr, "can't call \"");
@@ -456,14 +764,26 @@ Node arglist;
     if (not isblock(proc)) {
 	error("\"%s\" is not a procedure or function", symname(proc));
     }
+    endproc.isfunc = isfunc;
+    endproc.callnode = exprnode;
+    endproc.cmdnode = topnode;
     pushenv();
     pc = codeloc(proc);
     argc = pushargs(proc, arglist);
     beginproc(proc, argc);
-    isstopped = true;
-    event_once(build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym)),
-	buildcmdlist(build(O_PROCRTN, proc)));
-    cont();
+    event_once(
+	build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym)),
+	buildcmdlist(build(O_PROCRTN, proc))
+    );
+    isstopped = false;
+    if (not bpact()) {
+	isstopped = true;
+	cont(0);
+    }
+    /*
+     * bpact() won't return true, it will call printstatus() and go back
+     * to command input if a breakpoint is found.
+     */
     /* NOTREACHED */
 }
 
@@ -473,7 +793,7 @@ Node arglist;
  * space.
  */
 
-private Integer pushargs(proc, arglist)
+private integer pushargs(proc, arglist)
 Symbol proc;
 Node arglist;
 {
@@ -481,7 +801,11 @@ Node arglist;
     int argc, args_size;
 
     savesp = sp;
-    argc = evalargs(proc, arglist);
+    if (varIsSet("$unsafecall")) {
+	argc = unsafe_evalargs(proc, arglist);
+    } else {
+	argc = evalargs(proc, arglist);
+    }
     args_size = sp - savesp;
     setreg(STKP, reg(STKP) - args_size);
     dwrite(savesp, reg(STKP), args_size);
@@ -490,51 +814,166 @@ Node arglist;
 }
 
 /*
- * Evaluate arguments left-to-right.
+ * Check to see if an expression is correct for a given parameter.
+ * If the given parameter is false, don't worry about type inconsistencies.
+ *
+ * Return whether or not it is ok.
+ */
+
+private boolean chkparam (actual, formal, chk)
+Node actual;
+Symbol formal;
+boolean chk;
+{
+    boolean b;
+
+    b = true;
+    if (chk) {
+	if (formal == nil) {
+	    beginerrmsg();
+	    fprintf(stderr, "too many parameters");
+	    b = false;
+	} else if (not compatible(formal->type, actual->nodetype)) {
+	    beginerrmsg();
+	    fprintf(stderr, "type mismatch for %s", symname(formal));
+	    b = false;
+	}
+    }
+    if (b and formal != nil and
+	isvarparam(formal) and not isopenarray(formal->type) and
+	not (
+	    actual->op == O_RVAL or actual->nodetype == t_addr or
+	    (
+		actual->op == O_TYPERENAME and
+		(
+		    actual->value.arg[0]->op == O_RVAL or
+		    actual->value.arg[0]->nodetype == t_addr
+		)
+	    )
+	)
+    ) {
+	beginerrmsg();
+	fprintf(stderr, "expected variable, found \"");
+	prtree(stderr, actual);
+	fprintf(stderr, "\"");
+	b = false;
+    }
+    return b;
+}
+
+/*
+ * Pass an expression to a particular parameter.
+ *
+ * Normally we pass either the address or value, but in some cases
+ * (such as C strings) we want to copy the value onto the stack and
+ * pass its address.
+ *
+ * Another special case raised by strings is the possibility that
+ * the actual parameter will be larger than the formal, even with
+ * appropriate type-checking.  This occurs because we assume during
+ * evaluation that strings are null-terminated, whereas some languages,
+ * notably Pascal, do not work under that assumption.
  */
 
-private Integer evalargs(proc, arglist)
+private passparam (actual, formal)
+Node actual;
+Symbol formal;
+{
+    boolean b;
+    Address addr;
+    Stack *savesp;
+    integer actsize, formsize;
+
+    if (formal != nil and isvarparam(formal) and
+	(not isopenarray(formal->type))
+    ) {
+	addr = lval(actual->value.arg[0]);
+	push(Address, addr);
+    } else if (passaddr(formal, actual->nodetype)) {
+	savesp = sp;
+	eval(actual);
+	actsize = sp - savesp;
+	setreg(STKP,
+	    reg(STKP) - ((actsize + sizeof(Word) - 1) & ~(sizeof(Word) - 1))
+	);
+	dwrite(savesp, reg(STKP), actsize);
+	sp = savesp;
+	push(Address, reg(STKP));
+	if (formal != nil and isopenarray(formal->type)) {
+	    push(integer, actsize div size(formal->type->type));
+	}
+    } else if (formal != nil) {
+	formsize = size(formal);
+	savesp = sp;
+	eval(actual);
+	actsize = sp - savesp;
+	if (actsize > formsize) {
+	    sp -= (actsize - formsize);
+	}
+    } else {
+	eval(actual);
+    }
+}
+
+/*
+ * Evaluate an argument list left-to-right.
+ */
+
+private integer evalargs(proc, arglist)
 Symbol proc;
 Node arglist;
 {
-    Node p, exp;
-    Symbol arg;
+    Node p, actual;
+    Symbol formal;
     Stack *savesp;
-    Address addr;
-    Integer count;
+    integer count;
+    boolean chk;
 
     savesp = sp;
     count = 0;
-    arg = proc->chain;
+    formal = proc->chain;
+    chk = (boolean) (not nosource(proc));
     for (p = arglist; p != nil; p = p->value.arg[1]) {
-	if (p->op != O_COMMA) {
-	    panic("evalargs: arglist missing comma");
-	}
-	if (arg == nil) {
+	assert(p->op == O_COMMA);
+	actual = p->value.arg[0];
+	if (not chkparam(actual, formal, chk)) {
+	    fprintf(stderr, " in call to %s", symname(proc));
 	    sp = savesp;
-	    error("too many parameters to %s", symname(proc));
+	    enderrmsg();
 	}
-	exp = p->value.arg[0];
-	if (not compatible(arg->type, exp->nodetype)) {
-	    sp = savesp;
-	    error("expression for parameter %s is of wrong type", symname(arg));
-	}
-	if (arg->class == REF) {
-	    if (exp->op != O_RVAL) {
-		sp = savesp;
-		error("variable expected for parameter \"%s\"", symname(arg));
-	    }
-	    addr = lval(exp->value.arg[0]);
-	    push(Address, addr);
-	} else {
-	    eval(exp);
+	passparam(actual, formal);
+	if (formal != nil) {
+	    formal = formal->chain;
 	}
-	arg = arg->chain;
 	++count;
     }
-    if (arg != nil) {
-	sp = savesp;
-	error("not enough parameters to %s", symname(proc));
+    if (chk) {
+	if (formal != nil) {
+	    sp = savesp;
+	    error("not enough parameters to %s", symname(proc));
+	}
+    }
+    return count;
+}
+
+/*
+ * Evaluate an argument list without concern for matching the formal
+ * parameters of a function in type or quantity.  Useful for functions
+ * like C's printf().
+ */
+
+private integer unsafe_evalargs(proc, arglist)
+Symbol proc;
+Node arglist;
+{
+    Node p;
+    Integer count;
+
+    count = 0;
+    for (p = arglist; p != nil; p = p->value.arg[1]) {
+	assert(p->op == O_COMMA);
+	eval(p->value.arg[0]);
+	++count;
     }
     return count;
 }
@@ -542,11 +981,32 @@ Node arglist;
 public procreturn(f)
 Symbol f;
 {
+    integer retvalsize;
+    Node tmp;
+    char *copy;
+
     flushoutput();
-    putchar('\n');
-    printname(stdout, f);
-    printf(" returns successfully\n", symname(f));
     popenv();
+    if (endproc.isfunc) {
+	retvalsize = size(f->type);
+	if (retvalsize > sizeof(long)) {
+	    pushretval(retvalsize, true);
+	    copy = newarr(char, retvalsize);
+	    popn(retvalsize, copy);
+	    tmp = build(O_SCON, copy);
+	} else {
+	    tmp = build(O_LCON, (long) (reg(0)));
+	}
+	tmp->nodetype = f->type;
+	tfree(endproc.callnode);
+	*(endproc.callnode) = *(tmp);
+	dispose(tmp);
+	eval(endproc.cmdnode);
+    } else {
+	putchar('\n');
+	printname(stdout, f);
+	printf("%s returns successfully\n", symname(f));
+    }
     erecover();
 }
 
@@ -561,6 +1021,9 @@ private pushenv()
     push(String, cursource);
     push(Boolean, isstopped);
     push(Symbol, curfunc);
+    push(Frame, curframe);
+    push(struct Frame, curframerec);
+    push(CallEnv, endproc);
     push(Word, reg(PROGCTR));
     push(Word, reg(STKP));
 }
@@ -571,10 +1034,13 @@ private pushenv()
 
 public popenv()
 {
-    register String filename;
+    String filename;
 
     setreg(STKP, pop(Word));
     setreg(PROGCTR, pop(Word));
+    endproc = pop(CallEnv);
+    curframerec = pop(struct Frame);
+    curframe = pop(Frame);
     curfunc = pop(Symbol);
     isstopped = pop(Boolean);
     filename = pop(String);
@@ -591,8 +1057,8 @@ public popenv()
 
 public flushoutput()
 {
-    register Symbol p, iob;
-    register Stack *savesp;
+    Symbol p, iob;
+    Stack *savesp;
 
     p = lookup(identname("fflush", true));
     while (p != nil and not isblock(p)) {