4.3BSD - /usr/src/ucb/pascal/pdx/runtime/callproc.c

   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) 6/6/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: }

Defined functions

Defined variables