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