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 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 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 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 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 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 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 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 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