Annotation of 43BSDReno/pgrm/pascal/pdx/runtime/callproc.c, revision 1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.