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.1 (Berkeley) 06/06/85";
9 #endif not lint
10 /*
11  * Evaluate a call to a procedure.
12  *
13  * This file is a botch as far as modularity is concerned.
14  */
15 
16 #include "defs.h"
17 #include "runtime.h"
18 #include "sym.h"
19 #include "tree.h"
20 #include "breakpoint.h"
21 #include "machine.h"
22 #include "process.h"
23 #include "source.h"
24 #include "frame.rep"
25 #include "sym/classes.h"
26 #include "sym/sym.rep"
27 #include "tree/tree.rep"
28 #include "process/process.rep"
29 #include "process/pxinfo.h"
30 
31 LOCAL ADDRESS retaddr;
32 
33 /*
34  * Controlling logic of procedure calling.
35  * Calling a procedure before ever executing the program must
36  * be special cased.
37  */
38 
39 callproc(procnode, arglist)
40 NODE *procnode;
41 NODE *arglist;
42 {
43 	SYM *proc;
44 
45 	if (pc == 0) {
46 		curline = firstline(program);
47 		setbp(curline);
48 		resume();
49 		unsetbp(curline);
50 	}
51 	proc = procnode->nameval;
52 	if (!isblock(proc)) {
53 		error("\"%s\" is not a procedure or function", proc->symbol);
54 	}
55 	pushargs(proc, arglist);
56 	pushenv(proc->symvalue.funcv.codeloc);
57 	pushframe(proc->blkno);
58 	execute(proc);
59 	/* NOTREACHED */
60 }
61 
62 /*
63  * Push the arguments on the process' stack.  We do this by first
64  * evaluating them on the "eval" stack, then copying into the process'
65  * space.
66  */
67 
68 LOCAL pushargs(proc, arglist)
69 SYM *proc;
70 NODE *arglist;
71 {
72 	STACK *savesp;
73 	int args_size;
74 
75 	savesp = sp;
76 	evalargs(proc->symbol, proc->chain, arglist);
77 	args_size = sp - savesp;
78 	process->sp -= args_size;
79 	dwrite(savesp, process->sp, args_size);
80 	sp = savesp;
81 }
82 
83 /*
84  * Evaluate arguments right-to-left because the eval stack
85  * grows up, px's stack grows down.
86  */
87 
88 LOCAL evalargs(procname, arg, explist)
89 char *procname;
90 SYM *arg;
91 NODE *explist;
92 {
93 	NODE *exp;
94 	STACK *savesp;
95 	ADDRESS addr;
96 
97 	if (arg == NIL) {
98 		if (explist != NIL) {
99 			error("too many parameters to \"%s\"", procname);
100 		}
101 	} else if (explist == NIL) {
102 		error("not enough parameters to \"%s\"", procname);
103 	} else {
104 		if (explist->op != O_COMMA) {
105 			panic("evalargs: arglist missing comma");
106 		}
107 		savesp = sp;
108 		evalargs(procname, arg->chain, explist->right);
109 		exp = explist->left;
110 		if (!compatible(arg->type, exp->nodetype)) {
111 			sp = savesp;
112 			trerror("%t is not the same type as parameter \"%s\"",
113 				exp, arg->symbol);
114 		}
115 		if (arg->class == REF) {
116 			if (exp->op != O_RVAL) {
117 				sp = savesp;
118 				error("variable expected for parameter \"%s\"", arg->symbol);
119 			}
120 			addr = lval(exp->left);
121 			push(ADDRESS, addr);
122 		} else {
123 			eval(exp);
124 		}
125 	}
126 }
127 
128 /*
129  * Simulate a CALL instruction by pushing the appropriate
130  * stack frame information.
131  *
132  * Massage register 10 appropriately since it contains the
133  * stack frame pointer.
134  */
135 
136 LOCAL pushframe(b)
137 int b;
138 {
139 	ADDRESS *newdp;
140 	FRAME callframe;
141 
142 	retaddr = program->symvalue.funcv.codeloc;
143 
144 /*
145  * This stuff is set by the callee, just here to take up space.
146  */
147 	callframe.stackref = 0;
148 	callframe.file = 0;
149 	callframe.blockp = 0;
150 	callframe.save_loc = NIL;
151 	callframe.save_disp = NIL;
152 
153 /*
154  * This is the useful stuff.
155  */
156 	callframe.save_dp = curdp();
157 	callframe.save_pc = retaddr + ENDOFF;
158 	callframe.save_lino = 0;
159 	newdp = DISPLAY + (2 * b);
160 	dwrite(&newdp, DP, sizeof(newdp));
161 	process->sp -= sizeof(callframe);
162 	dwrite(&callframe, process->sp, sizeof(callframe));
163 	process->reg[10] = process->sp;
164 }
165 
166 /*
167  * Execute the procedure.  This routine does NOT return because it
168  * calls "cont", which doesn't return.  We set a CALLPROC breakpoint
169  * at "retaddr", the address where the called routine will return.
170  *
171  * The action for a CALLPROC is to call "procreturn" where we restore
172  * the environment.
173  */
174 
175 LOCAL execute(f)
176 SYM *f;
177 {
178 	isstopped = TRUE;
179 	addbp(retaddr, CALLPROC, f, NIL, NIL, 0);
180 	cont();
181 	/* NOTREACHED */
182 }
183 
184 procreturn(f)
185 SYM *f;
186 {
187 	int len;
188 
189 	printf("%s returns ", f->symbol);
190 	if (f->class == FUNC) {
191 		len = size(f->type);
192 		dread(sp, process->sp, len);
193 		sp += len;
194 		printval(f->type);
195 		putchar('\n');
196 	} else {
197 		printf("successfully\n");
198 	}
199 	popenv();
200 }
201 
202 /*
203  * Push the current environment.
204  *
205  * This involves both saving pdx and interpreter values.
206  * LOOPADDR is the address of the main interpreter loop.
207  */
208 
209 LOCAL pushenv(newpc)
210 ADDRESS newpc;
211 {
212 	push(ADDRESS, pc);
213 	push(LINENO, curline);
214 	push(char *, cursource);
215 	push(BOOLEAN, isstopped);
216 	push(SYM *, curfunc);
217 	push(WORD, process->pc);
218 	push(WORD, process->sp);
219 	process->pc = LOOPADDR;
220 	pc = newpc;
221 	process->reg[11] = pc + ENDOFF;
222 }
223 
224 /*
225  * Pop back to the real world.
226  */
227 
228 popenv()
229 {
230 	register PROCESS *p;
231 	char *filename;
232 
233 	p = process;
234 	p->sp = pop(WORD);
235 	p->pc = pop(WORD);
236 	curfunc = pop(SYM *);
237 	isstopped = pop(BOOLEAN);
238 	filename = pop(char *);
239 	curline = pop(LINENO);
240 	pc = pop(ADDRESS);
241 	if (filename != cursource) {
242 		skimsource(filename);
243 	}
244 }
245