Return to callproc.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / pdx / runtime

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

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