/* evmethod - evaluate a method */ LOCAL LVAL evmethod(LVAL obj, LVAL msgcls, LVAL method) { LVAL oldenv,oldfenv,cptr,name,val=NULL; XLCONTEXT cntxt; /* protect some pointers */ xlstkcheck(3); xlsave(oldenv); xlsave(oldfenv); xlsave(cptr); /* create an 'object' stack entry and a new environment frame */ oldenv = xlenv; oldfenv = xlfenv; xlenv = cons(cons(obj,msgcls),closure_getenv(method)); xlenv = xlframe(xlenv); xlfenv = getfenv(method); /* bind the formal parameters */ xlabind(method,xlargc,xlargv); /* setup the implicit block */ if ((name = getname(method))) xlbegin(&cntxt,CF_RETURN,name); /* execute the block */ if (name && _setjmp(cntxt.c_jmpbuf)) val = xlvalue; else for (cptr = getbody(method); consp(cptr); cptr = cdr(cptr)) val = xleval(car(cptr)); /* finish the block context */ if (name) xlend(&cntxt); /* restore the environment */ xlenv = oldenv; xlfenv = oldfenv; /* restore the stack */ xlpopn(3); /* return the result value */ return (val); }
/* evfun - evaluate a function */ LOCAL LVAL evfun(LVAL fun, int argc, LVAL *argv) { LVAL oldenv,oldfenv,cptr,name,val; XLCONTEXT cntxt; /* protect some pointers */ xlstkcheck(4); xlsave(oldenv); xlsave(oldfenv); xlsave(cptr); xlprotect(fun); /* (RBD) Otherwise, fun is unprotected */ /* create a new environment frame */ oldenv = xlenv; oldfenv = xlfenv; xlenv = xlframe(closure_getenv(fun)); xlfenv = getfenv(fun); /* bind the formal parameters */ xlabind(fun,argc,argv); /* setup the implicit block */ if (name = getname(fun)) xlbegin(&cntxt,CF_RETURN,name); /* execute the block */ if (name && setjmp(cntxt.c_jmpbuf)) val = xlvalue; else for (val = NIL, cptr = getbody(fun); consp(cptr); cptr = cdr(cptr)) val = xleval(car(cptr)); /* finish the block context */ if (name) xlend(&cntxt); /* restore the environment */ xlenv = oldenv; xlfenv = oldfenv; /* restore the stack */ xlpopn(4); /* return the result value */ return (val); }