1 /*
2  * Copyright (c) 1980 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[] = "@(#)callproc.c	5.3 (Berkeley) 01/09/89";
9 #endif not lint
10 
11 /*
12  * Evaluate a call to a procedure.
13  *
14  * This file is a botch as far as modularity is concerned.
15  *
16  * In fact, FIXME, it does not work on either the Vax or Tahoe
17  * at this point (Sep 22, 1988).  It possibly doesn't work because
18  * the ptrace interface never sets "pc" back into the interpreter's
19  * program counter location.
20  *
21  * Due to portability changes
22  * in px for ANSI C, it is now even further broken, since the operand
23  * stack is no longer the system stack and since the interpreter's
24  * "pc" that we see is never read by the interpreter.  We could fix
25  * this, and increase the modularity, by:
26  *
27  *    * changing this whole module to build a string of bytecodes
28  *	that would: push a series of constant parameters, then call a
29  *	procedure, then take a breakpoint.
30  *    * Having px allocate a place for us to do this, and pass us the
31  *	address of this (otherwise unused) variable.
32  *    * Creating an entry point into the px interpreter which would
33  *	pick up the pc value from "*addrpc" and then enter the main loop.
34  *	Currently we never pick up *addrpc for speed.
35  *    * Fix the code below to use the new entry point rather than "loopaddr".
36  *
37  * But I suspect this code is dead enough that nobody will ever get
38  * around to it.		-- gnu@toad.com, 22Sep88
39  */
40 
41 #include "defs.h"
42 #include "runtime.h"
43 #include "sym.h"
44 #include "tree.h"
45 #include "breakpoint.h"
46 #include "machine.h"
47 #include "process.h"
48 #include "source.h"
49 #include "frame.rep"
50 #include "sym/classes.h"
51 #include "sym/sym.rep"
52 #include "tree/tree.rep"
53 #include "process/process.rep"
54 #include "process/pxinfo.h"
55 
56 LOCAL ADDRESS retaddr;
57 #ifdef tahoe
58 BOOLEAN didret;
59 #endif
60 
61 /*
62  * Controlling logic of procedure calling.
63  * Calling a procedure before ever executing the program must
64  * be special cased.
65  */
66 
67 callproc(procnode, arglist)
68 NODE *procnode;
69 NODE *arglist;
70 {
71 	register SYM *proc;
72 #ifdef tahoe
73 	register int tmpsp, tmptmp;
74 	extern BOOLEAN shouldrestart;
75 
76 	if (shouldrestart) {
77 		initstart();
78 	}
79 #endif
80 	if (pc == 0) {
81 		curline = firstline(program);
82 		setbp(curline);
83 		resume();
84 		unsetbp(curline);
85 	}
86 	proc = procnode->nameval;
87 	if (!isblock(proc)) {
88 		error("\"%s\" is not a procedure or function", proc->symbol);
89 	}
90 #ifdef tahoe
91 	doret(process);
92 	tmpsp = process->sp;
93 #endif
94 	pushargs(proc, arglist);
95 #ifdef tahoe
96 	tmptmp = tmpsp;
97 	tmpsp = process->sp;
98 	process->sp = tmptmp;
99 #endif
100 	pushenv(proc->symvalue.funcv.codeloc);
101 #ifdef tahoe
102 	process->sp = tmpsp;
103 #endif
104 	pushframe(proc->blkno);
105 	execute(proc);
106 	/* NOTREACHED */
107 }
108 
109 /*
110  * Push the arguments on the process' stack.  We do this by first
111  * evaluating them on the "eval" stack, then copying into the process'
112  * space.
113  */
114 
115 LOCAL pushargs(proc, arglist)
116 SYM *proc;
117 NODE *arglist;
118 {
119 	STACK *savesp;
120 	int args_size;
121 
122 	savesp = sp;
123 #ifdef tahoe
124 	/*
125 	 * evalargs hopefully keeps stack aligned, so we won't bother
126 	 * aligning it afterwards, neither will we align process->sp
127 	 * after subtracting args_size.
128 	 */
129 #endif
130 	evalargs(proc->symbol, proc->chain, arglist);
131 	args_size = sp - savesp;
132 	process->sp -= args_size;
133 	dwrite(savesp, process->sp, args_size);
134 	sp = savesp;
135 }
136 
137 /*
138  * Evaluate arguments right-to-left because the eval stack
139  * grows up, px's stack grows down.
140  */
141 
142 LOCAL evalargs(procname, arg, explist)
143 char *procname;
144 SYM *arg;
145 NODE *explist;
146 {
147 	NODE *exp;
148 	STACK *savesp;
149 	ADDRESS addr;
150 
151 	if (arg == NIL) {
152 		if (explist != NIL) {
153 			error("too many parameters to \"%s\"", procname);
154 		}
155 	} else if (explist == NIL) {
156 		error("not enough parameters to \"%s\"", procname);
157 	} else {
158 		if (explist->op != O_COMMA) {
159 			panic("evalargs: arglist missing comma");
160 		}
161 		savesp = sp;
162 		evalargs(procname, arg->chain, explist->right);
163 		exp = explist->left;
164 		if (!compatible(arg->type, exp->nodetype)) {
165 			sp = savesp;
166 			trerror("%t is not the same type as parameter \"%s\"",
167 				exp, arg->symbol);
168 		}
169 		if (arg->class == REF) {
170 			if (exp->op != O_RVAL) {
171 				sp = savesp;
172 				error("variable expected for parameter \"%s\"", arg->symbol);
173 			}
174 			addr = lval(exp->left);
175 			push(ADDRESS, addr);
176 		} else {
177 			eval(exp);
178 		}
179 	}
180 }
181 
182 /*
183  * Simulate a CALL instruction by pushing the appropriate
184  * stack frame information.
185  *
186  * Massage register 10 or 11 appropriately since it contains the
187  * stack frame pointer.
188  */
189 
190 LOCAL pushframe(b)
191 int b;
192 {
193 	ADDRESS *newdp;
194 	FRAME callframe;
195 
196 	retaddr = program->symvalue.funcv.codeloc;
197 
198 /*
199  * This stuff is set by the callee, just here to take up space.
200  */
201 	callframe.stackref = 0;
202 	callframe.file = 0;
203 	callframe.blockp = 0;
204 	callframe.save_loc = NIL;
205 	callframe.save_disp = NIL;
206 
207 /*
208  * This is the useful stuff.
209  */
210 	callframe.save_dp = curdp();
211 	callframe.save_pc = retaddr + ENDOFF;
212 	callframe.save_lino = 0;
213 	newdp = DISPLAY + (2 * b);
214 	dwrite(&newdp, DP, sizeof(newdp));
215 	process->sp -= sizeof(callframe);
216 	dwrite(&callframe, process->sp, sizeof(callframe));
217 #ifdef tahoe
218 	process->reg[11] = process->sp;
219 #else
220 	process->reg[10] = process->sp;
221 #endif
222 }
223 
224 /*
225  * Execute the procedure.  This routine does NOT return because it
226  * calls "cont", which doesn't return.  We set a CALLPROC breakpoint
227  * at "retaddr", the address where the called routine will return.
228  *
229  * The action for a CALLPROC is to call "procreturn" where we restore
230  * the environment.
231  */
232 
233 LOCAL execute(f)
234 SYM *f;
235 {
236 	isstopped = TRUE;
237 	addbp(retaddr, CALLPROC, f, NIL, NIL, 0);
238 	cont();
239 	/* NOTREACHED */
240 }
241 
242 procreturn(f)
243 SYM *f;
244 {
245 	int len;
246 
247 #ifdef tahoe
248 	doret(process);
249 #endif
250 	printf("%s returns ", f->symbol);
251 	if (f->class == FUNC) {
252 		len = size(f->type);
253 		dread(sp, process->sp, len);
254 #ifdef tahoe
255 		len = (len + 3) & ~3;
256 #endif
257 		sp += len;
258 		printval(f->type);
259 		putchar('\n');
260 	} else {
261 		printf("successfully\n");
262 	}
263 	popenv();
264 }
265 
266 /*
267  * Push the current environment.
268  *
269  * This involves both saving pdx and interpreter values.
270  * LOOPADDR is the address of the main interpreter loop.
271  */
272 
273 LOCAL pushenv(newpc)
274 ADDRESS newpc;
275 {
276 #ifdef tahoe
277 	/* this should be done somewhere else, but... */
278 	INTFP = process->fp;
279 #endif
280 	push(ADDRESS, pc);
281 	push(LINENO, curline);
282 	push(char *, cursource);
283 	push(BOOLEAN, isstopped);
284 	push(SYM *, curfunc);
285 	push(WORD, process->pc);
286 	push(WORD, process->sp);
287 	process->pc = LOOPADDR;
288 	pc = newpc;
289 #ifdef tahoe
290 	process->reg[12] = pc + ENDOFF;
291 #else
292 	process->reg[11] = pc + ENDOFF;
293 #endif
294 }
295 
296 /*
297  * Pop back to the real world.
298  */
299 
300 popenv()
301 {
302 	register PROCESS *p;
303 	char *filename;
304 
305 	p = process;
306 	p->sp = pop(WORD);
307 	p->pc = pop(WORD);
308 	curfunc = pop(SYM *);
309 	isstopped = pop(BOOLEAN);
310 	filename = pop(char *);
311 	curline = pop(LINENO);
312 	pc = pop(ADDRESS);
313 #ifdef tahoe
314 	p->reg[12] = pc + 1 + ENDOFF;
315 #endif
316 	if (filename != cursource) {
317 		skimsource(filename);
318 	}
319 }
320