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