Mercurial > vba-clojure
diff src/lua/ldo.c @ 11:27763b933818
raise lua sources up one level
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 03 Mar 2012 11:07:39 -0600 |
parents | src/lua/src/ldo.c@f9f4f1b99eed |
children |
line wrap: on
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/src/lua/ldo.c Sat Mar 03 11:07:39 2012 -0600 1.3 @@ -0,0 +1,518 @@ 1.4 +/* 1.5 +** $Id: ldo.c,v 2.38.1.3 2008/01/18 22:31:22 roberto Exp $ 1.6 +** Stack and Call structure of Lua 1.7 +** See Copyright Notice in lua.h 1.8 +*/ 1.9 + 1.10 + 1.11 +#include <setjmp.h> 1.12 +#include <stdlib.h> 1.13 +#include <string.h> 1.14 + 1.15 +#define ldo_c 1.16 +#define LUA_CORE 1.17 + 1.18 +#include "lua.h" 1.19 + 1.20 +#include "ldebug.h" 1.21 +#include "ldo.h" 1.22 +#include "lfunc.h" 1.23 +#include "lgc.h" 1.24 +#include "lmem.h" 1.25 +#include "lobject.h" 1.26 +#include "lopcodes.h" 1.27 +#include "lparser.h" 1.28 +#include "lstate.h" 1.29 +#include "lstring.h" 1.30 +#include "ltable.h" 1.31 +#include "ltm.h" 1.32 +#include "lundump.h" 1.33 +#include "lvm.h" 1.34 +#include "lzio.h" 1.35 + 1.36 + 1.37 + 1.38 + 1.39 +/* 1.40 +** {====================================================== 1.41 +** Error-recovery functions 1.42 +** ======================================================= 1.43 +*/ 1.44 + 1.45 + 1.46 +/* chain list of long jump buffers */ 1.47 +struct lua_longjmp { 1.48 + struct lua_longjmp *previous; 1.49 + luai_jmpbuf b; 1.50 + volatile int status; /* error code */ 1.51 +}; 1.52 + 1.53 + 1.54 +void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) { 1.55 + switch (errcode) { 1.56 + case LUA_ERRMEM: { 1.57 + setsvalue2s(L, oldtop, luaS_newliteral(L, MEMERRMSG)); 1.58 + break; 1.59 + } 1.60 + case LUA_ERRERR: { 1.61 + setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling")); 1.62 + break; 1.63 + } 1.64 + case LUA_ERRSYNTAX: 1.65 + case LUA_ERRRUN: { 1.66 + setobjs2s(L, oldtop, L->top - 1); /* error message on current top */ 1.67 + break; 1.68 + } 1.69 + } 1.70 + L->top = oldtop + 1; 1.71 +} 1.72 + 1.73 + 1.74 +static void restore_stack_limit (lua_State *L) { 1.75 + lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1); 1.76 + if (L->size_ci > LUAI_MAXCALLS) { /* there was an overflow? */ 1.77 + int inuse = cast_int(L->ci - L->base_ci); 1.78 + if (inuse + 1 < LUAI_MAXCALLS) /* can `undo' overflow? */ 1.79 + luaD_reallocCI(L, LUAI_MAXCALLS); 1.80 + } 1.81 +} 1.82 + 1.83 + 1.84 +static void resetstack (lua_State *L, int status) { 1.85 + L->ci = L->base_ci; 1.86 + L->base = L->ci->base; 1.87 + luaF_close(L, L->base); /* close eventual pending closures */ 1.88 + luaD_seterrorobj(L, status, L->base); 1.89 + L->nCcalls = L->baseCcalls; 1.90 + L->allowhook = 1; 1.91 + restore_stack_limit(L); 1.92 + L->errfunc = 0; 1.93 + L->errorJmp = NULL; 1.94 +} 1.95 + 1.96 + 1.97 +void luaD_throw (lua_State *L, int errcode) { 1.98 + if (L->errorJmp) { 1.99 + L->errorJmp->status = errcode; 1.100 + LUAI_THROW(L, L->errorJmp); 1.101 + } 1.102 + else { 1.103 + L->status = cast_byte(errcode); 1.104 + if (G(L)->panic) { 1.105 + resetstack(L, errcode); 1.106 + lua_unlock(L); 1.107 + G(L)->panic(L); 1.108 + } 1.109 + exit(EXIT_FAILURE); 1.110 + } 1.111 +} 1.112 + 1.113 + 1.114 +int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { 1.115 + struct lua_longjmp lj; 1.116 + lj.status = 0; 1.117 + lj.previous = L->errorJmp; /* chain new error handler */ 1.118 + L->errorJmp = &lj; 1.119 + LUAI_TRY(L, &lj, 1.120 + (*f)(L, ud); 1.121 + ); 1.122 + L->errorJmp = lj.previous; /* restore old error handler */ 1.123 + return lj.status; 1.124 +} 1.125 + 1.126 +/* }====================================================== */ 1.127 + 1.128 + 1.129 +static void correctstack (lua_State *L, TValue *oldstack) { 1.130 + CallInfo *ci; 1.131 + GCObject *up; 1.132 + L->top = (L->top - oldstack) + L->stack; 1.133 + for (up = L->openupval; up != NULL; up = up->gch.next) 1.134 + gco2uv(up)->v = (gco2uv(up)->v - oldstack) + L->stack; 1.135 + for (ci = L->base_ci; ci <= L->ci; ci++) { 1.136 + ci->top = (ci->top - oldstack) + L->stack; 1.137 + ci->base = (ci->base - oldstack) + L->stack; 1.138 + ci->func = (ci->func - oldstack) + L->stack; 1.139 + } 1.140 + L->base = (L->base - oldstack) + L->stack; 1.141 +} 1.142 + 1.143 + 1.144 +void luaD_reallocstack (lua_State *L, int newsize) { 1.145 + TValue *oldstack = L->stack; 1.146 + int realsize = newsize + 1 + EXTRA_STACK; 1.147 + lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1); 1.148 + luaM_reallocvector(L, L->stack, L->stacksize, realsize, TValue); 1.149 + L->stacksize = realsize; 1.150 + L->stack_last = L->stack+newsize; 1.151 + correctstack(L, oldstack); 1.152 +} 1.153 + 1.154 + 1.155 +void luaD_reallocCI (lua_State *L, int newsize) { 1.156 + CallInfo *oldci = L->base_ci; 1.157 + luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo); 1.158 + L->size_ci = newsize; 1.159 + L->ci = (L->ci - oldci) + L->base_ci; 1.160 + L->end_ci = L->base_ci + L->size_ci - 1; 1.161 +} 1.162 + 1.163 + 1.164 +void luaD_growstack (lua_State *L, int n) { 1.165 + if (n <= L->stacksize) /* double size is enough? */ 1.166 + luaD_reallocstack(L, 2*L->stacksize); 1.167 + else 1.168 + luaD_reallocstack(L, L->stacksize + n); 1.169 +} 1.170 + 1.171 + 1.172 +static CallInfo *growCI (lua_State *L) { 1.173 + if (L->size_ci > LUAI_MAXCALLS) /* overflow while handling overflow? */ 1.174 + luaD_throw(L, LUA_ERRERR); 1.175 + else { 1.176 + luaD_reallocCI(L, 2*L->size_ci); 1.177 + if (L->size_ci > LUAI_MAXCALLS) 1.178 + luaG_runerror(L, "stack overflow"); 1.179 + } 1.180 + return ++L->ci; 1.181 +} 1.182 + 1.183 + 1.184 +void luaD_callhook (lua_State *L, int event, int line) { 1.185 + lua_Hook hook = L->hook; 1.186 + if (hook && L->allowhook) { 1.187 + ptrdiff_t top = savestack(L, L->top); 1.188 + ptrdiff_t ci_top = savestack(L, L->ci->top); 1.189 + lua_Debug ar; 1.190 + ar.event = event; 1.191 + ar.currentline = line; 1.192 + if (event == LUA_HOOKTAILRET) 1.193 + ar.i_ci = 0; /* tail call; no debug information about it */ 1.194 + else 1.195 + ar.i_ci = cast_int(L->ci - L->base_ci); 1.196 + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ 1.197 + L->ci->top = L->top + LUA_MINSTACK; 1.198 + lua_assert(L->ci->top <= L->stack_last); 1.199 + L->allowhook = 0; /* cannot call hooks inside a hook */ 1.200 + lua_unlock(L); 1.201 + (*hook)(L, &ar); 1.202 + lua_lock(L); 1.203 + lua_assert(!L->allowhook); 1.204 + L->allowhook = 1; 1.205 + L->ci->top = restorestack(L, ci_top); 1.206 + L->top = restorestack(L, top); 1.207 + } 1.208 +} 1.209 + 1.210 + 1.211 +static StkId adjust_varargs (lua_State *L, Proto *p, int actual) { 1.212 + int i; 1.213 + int nfixargs = p->numparams; 1.214 + Table *htab = NULL; 1.215 + StkId base, fixed; 1.216 + for (; actual < nfixargs; ++actual) 1.217 + setnilvalue(L->top++); 1.218 +#if defined(LUA_COMPAT_VARARG) 1.219 + if (p->is_vararg & VARARG_NEEDSARG) { /* compat. with old-style vararg? */ 1.220 + int nvar = actual - nfixargs; /* number of extra arguments */ 1.221 + lua_assert(p->is_vararg & VARARG_HASARG); 1.222 + luaC_checkGC(L); 1.223 + htab = luaH_new(L, nvar, 1); /* create `arg' table */ 1.224 + for (i=0; i<nvar; i++) /* put extra arguments into `arg' table */ 1.225 + setobj2n(L, luaH_setnum(L, htab, i+1), L->top - nvar + i); 1.226 + /* store counter in field `n' */ 1.227 + setnvalue(luaH_setstr(L, htab, luaS_newliteral(L, "n")), cast_num(nvar)); 1.228 + } 1.229 +#endif 1.230 + /* move fixed parameters to final position */ 1.231 + fixed = L->top - actual; /* first fixed argument */ 1.232 + base = L->top; /* final position of first argument */ 1.233 + for (i=0; i<nfixargs; i++) { 1.234 + setobjs2s(L, L->top++, fixed+i); 1.235 + setnilvalue(fixed+i); 1.236 + } 1.237 + /* add `arg' parameter */ 1.238 + if (htab) { 1.239 + sethvalue(L, L->top++, htab); 1.240 + lua_assert(iswhite(obj2gco(htab))); 1.241 + } 1.242 + return base; 1.243 +} 1.244 + 1.245 + 1.246 +static StkId tryfuncTM (lua_State *L, StkId func) { 1.247 + const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL); 1.248 + StkId p; 1.249 + ptrdiff_t funcr = savestack(L, func); 1.250 + if (!ttisfunction(tm)) 1.251 + luaG_typeerror(L, func, "call"); 1.252 + /* Open a hole inside the stack at `func' */ 1.253 + for (p = L->top; p > func; p--) setobjs2s(L, p, p-1); 1.254 + incr_top(L); 1.255 + func = restorestack(L, funcr); /* previous call may change stack */ 1.256 + setobj2s(L, func, tm); /* tag method is the new function to be called */ 1.257 + return func; 1.258 +} 1.259 + 1.260 + 1.261 + 1.262 +#define inc_ci(L) \ 1.263 + ((L->ci == L->end_ci) ? growCI(L) : \ 1.264 + (condhardstacktests(luaD_reallocCI(L, L->size_ci)), ++L->ci)) 1.265 + 1.266 + 1.267 +int luaD_precall (lua_State *L, StkId func, int nresults) { 1.268 + LClosure *cl; 1.269 + ptrdiff_t funcr; 1.270 + if (!ttisfunction(func)) /* `func' is not a function? */ 1.271 + func = tryfuncTM(L, func); /* check the `function' tag method */ 1.272 + funcr = savestack(L, func); 1.273 + cl = &clvalue(func)->l; 1.274 + L->ci->savedpc = L->savedpc; 1.275 + if (!cl->isC) { /* Lua function? prepare its call */ 1.276 + CallInfo *ci; 1.277 + StkId st, base; 1.278 + Proto *p = cl->p; 1.279 + luaD_checkstack(L, p->maxstacksize); 1.280 + func = restorestack(L, funcr); 1.281 + if (!p->is_vararg) { /* no varargs? */ 1.282 + base = func + 1; 1.283 + if (L->top > base + p->numparams) 1.284 + L->top = base + p->numparams; 1.285 + } 1.286 + else { /* vararg function */ 1.287 + int nargs = cast_int(L->top - func) - 1; 1.288 + base = adjust_varargs(L, p, nargs); 1.289 + func = restorestack(L, funcr); /* previous call may change the stack */ 1.290 + } 1.291 + ci = inc_ci(L); /* now `enter' new function */ 1.292 + ci->func = func; 1.293 + L->base = ci->base = base; 1.294 + ci->top = L->base + p->maxstacksize; 1.295 + lua_assert(ci->top <= L->stack_last); 1.296 + L->savedpc = p->code; /* starting point */ 1.297 + ci->tailcalls = 0; 1.298 + ci->nresults = nresults; 1.299 + for (st = L->top; st < ci->top; st++) 1.300 + setnilvalue(st); 1.301 + L->top = ci->top; 1.302 + if (L->hookmask & LUA_MASKCALL) { 1.303 + L->savedpc++; /* hooks assume 'pc' is already incremented */ 1.304 + luaD_callhook(L, LUA_HOOKCALL, -1); 1.305 + L->savedpc--; /* correct 'pc' */ 1.306 + } 1.307 + return PCRLUA; 1.308 + } 1.309 + else { /* if is a C function, call it */ 1.310 + CallInfo *ci; 1.311 + int n; 1.312 + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ 1.313 + ci = inc_ci(L); /* now `enter' new function */ 1.314 + ci->func = restorestack(L, funcr); 1.315 + L->base = ci->base = ci->func + 1; 1.316 + ci->top = L->top + LUA_MINSTACK; 1.317 + lua_assert(ci->top <= L->stack_last); 1.318 + ci->nresults = nresults; 1.319 + if (L->hookmask & LUA_MASKCALL) 1.320 + luaD_callhook(L, LUA_HOOKCALL, -1); 1.321 + lua_unlock(L); 1.322 + n = (*curr_func(L)->c.f)(L); /* do the actual call */ 1.323 + lua_lock(L); 1.324 + if (n < 0) /* yielding? */ 1.325 + return PCRYIELD; 1.326 + else { 1.327 + luaD_poscall(L, L->top - n); 1.328 + return PCRC; 1.329 + } 1.330 + } 1.331 +} 1.332 + 1.333 + 1.334 +static StkId callrethooks (lua_State *L, StkId firstResult) { 1.335 + ptrdiff_t fr = savestack(L, firstResult); /* next call may change stack */ 1.336 + luaD_callhook(L, LUA_HOOKRET, -1); 1.337 + if (f_isLua(L->ci)) { /* Lua function? */ 1.338 + while ((L->hookmask & LUA_MASKRET) && L->ci->tailcalls--) /* tail calls */ 1.339 + luaD_callhook(L, LUA_HOOKTAILRET, -1); 1.340 + } 1.341 + return restorestack(L, fr); 1.342 +} 1.343 + 1.344 + 1.345 +int luaD_poscall (lua_State *L, StkId firstResult) { 1.346 + StkId res; 1.347 + int wanted, i; 1.348 + CallInfo *ci; 1.349 + if (L->hookmask & LUA_MASKRET) 1.350 + firstResult = callrethooks(L, firstResult); 1.351 + ci = L->ci--; 1.352 + res = ci->func; /* res == final position of 1st result */ 1.353 + wanted = ci->nresults; 1.354 + L->base = (ci - 1)->base; /* restore base */ 1.355 + L->savedpc = (ci - 1)->savedpc; /* restore savedpc */ 1.356 + /* move results to correct place */ 1.357 + for (i = wanted; i != 0 && firstResult < L->top; i--) 1.358 + setobjs2s(L, res++, firstResult++); 1.359 + while (i-- > 0) 1.360 + setnilvalue(res++); 1.361 + L->top = res; 1.362 + return (wanted - LUA_MULTRET); /* 0 iff wanted == LUA_MULTRET */ 1.363 +} 1.364 + 1.365 + 1.366 +/* 1.367 +** Call a function (C or Lua). The function to be called is at *func. 1.368 +** The arguments are on the stack, right after the function. 1.369 +** When returns, all the results are on the stack, starting at the original 1.370 +** function position. 1.371 +*/ 1.372 +void luaD_call (lua_State *L, StkId func, int nResults) { 1.373 + if (++L->nCcalls >= LUAI_MAXCCALLS) { 1.374 + if (L->nCcalls == LUAI_MAXCCALLS) 1.375 + luaG_runerror(L, "C stack overflow"); 1.376 + else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3))) 1.377 + luaD_throw(L, LUA_ERRERR); /* error while handing stack error */ 1.378 + } 1.379 + if (luaD_precall(L, func, nResults) == PCRLUA) /* is a Lua function? */ 1.380 + luaV_execute(L, 1); /* call it */ 1.381 + L->nCcalls--; 1.382 + luaC_checkGC(L); 1.383 +} 1.384 + 1.385 + 1.386 +static void resume (lua_State *L, void *ud) { 1.387 + StkId firstArg = cast(StkId, ud); 1.388 + CallInfo *ci = L->ci; 1.389 + if (L->status == 0) { /* start coroutine? */ 1.390 + lua_assert(ci == L->base_ci && firstArg > L->base); 1.391 + if (luaD_precall(L, firstArg - 1, LUA_MULTRET) != PCRLUA) 1.392 + return; 1.393 + } 1.394 + else { /* resuming from previous yield */ 1.395 + lua_assert(L->status == LUA_YIELD); 1.396 + L->status = 0; 1.397 + if (!f_isLua(ci)) { /* `common' yield? */ 1.398 + /* finish interrupted execution of `OP_CALL' */ 1.399 + lua_assert(GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_CALL || 1.400 + GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_TAILCALL); 1.401 + if (luaD_poscall(L, firstArg)) /* complete it... */ 1.402 + L->top = L->ci->top; /* and correct top if not multiple results */ 1.403 + } 1.404 + else /* yielded inside a hook: just continue its execution */ 1.405 + L->base = L->ci->base; 1.406 + } 1.407 + luaV_execute(L, cast_int(L->ci - L->base_ci)); 1.408 +} 1.409 + 1.410 + 1.411 +static int resume_error (lua_State *L, const char *msg) { 1.412 + L->top = L->ci->base; 1.413 + setsvalue2s(L, L->top, luaS_new(L, msg)); 1.414 + incr_top(L); 1.415 + lua_unlock(L); 1.416 + return LUA_ERRRUN; 1.417 +} 1.418 + 1.419 + 1.420 +LUA_API int lua_resume (lua_State *L, int nargs) { 1.421 + int status; 1.422 + lua_lock(L); 1.423 + if (L->status != LUA_YIELD && (L->status != 0 || L->ci != L->base_ci)) 1.424 + return resume_error(L, "cannot resume non-suspended coroutine"); 1.425 + if (L->nCcalls >= LUAI_MAXCCALLS) 1.426 + return resume_error(L, "C stack overflow"); 1.427 + luai_userstateresume(L, nargs); 1.428 + lua_assert(L->errfunc == 0); 1.429 + L->baseCcalls = ++L->nCcalls; 1.430 + status = luaD_rawrunprotected(L, resume, L->top - nargs); 1.431 + if (status != 0) { /* error? */ 1.432 + L->status = cast_byte(status); /* mark thread as `dead' */ 1.433 + luaD_seterrorobj(L, status, L->top); 1.434 + L->ci->top = L->top; 1.435 + } 1.436 + else { 1.437 + lua_assert(L->nCcalls == L->baseCcalls); 1.438 + status = L->status; 1.439 + } 1.440 + --L->nCcalls; 1.441 + lua_unlock(L); 1.442 + return status; 1.443 +} 1.444 + 1.445 + 1.446 +LUA_API int lua_yield (lua_State *L, int nresults) { 1.447 + luai_userstateyield(L, nresults); 1.448 + lua_lock(L); 1.449 + if (L->nCcalls > L->baseCcalls) 1.450 + luaG_runerror(L, "attempt to yield across metamethod/C-call boundary"); 1.451 + L->base = L->top - nresults; /* protect stack slots below */ 1.452 + L->status = LUA_YIELD; 1.453 + lua_unlock(L); 1.454 + return -1; 1.455 +} 1.456 + 1.457 + 1.458 +int luaD_pcall (lua_State *L, Pfunc func, void *u, 1.459 + ptrdiff_t old_top, ptrdiff_t ef) { 1.460 + int status; 1.461 + unsigned short oldnCcalls = L->nCcalls; 1.462 + ptrdiff_t old_ci = saveci(L, L->ci); 1.463 + lu_byte old_allowhooks = L->allowhook; 1.464 + ptrdiff_t old_errfunc = L->errfunc; 1.465 + L->errfunc = ef; 1.466 + status = luaD_rawrunprotected(L, func, u); 1.467 + if (status != 0) { /* an error occurred? */ 1.468 + StkId oldtop = restorestack(L, old_top); 1.469 + luaF_close(L, oldtop); /* close eventual pending closures */ 1.470 + luaD_seterrorobj(L, status, oldtop); 1.471 + L->nCcalls = oldnCcalls; 1.472 + L->ci = restoreci(L, old_ci); 1.473 + L->base = L->ci->base; 1.474 + L->savedpc = L->ci->savedpc; 1.475 + L->allowhook = old_allowhooks; 1.476 + restore_stack_limit(L); 1.477 + } 1.478 + L->errfunc = old_errfunc; 1.479 + return status; 1.480 +} 1.481 + 1.482 + 1.483 + 1.484 +/* 1.485 +** Execute a protected parser. 1.486 +*/ 1.487 +struct SParser { /* data to `f_parser' */ 1.488 + ZIO *z; 1.489 + Mbuffer buff; /* buffer to be used by the scanner */ 1.490 + const char *name; 1.491 +}; 1.492 + 1.493 +static void f_parser (lua_State *L, void *ud) { 1.494 + int i; 1.495 + Proto *tf; 1.496 + Closure *cl; 1.497 + struct SParser *p = cast(struct SParser *, ud); 1.498 + int c = luaZ_lookahead(p->z); 1.499 + luaC_checkGC(L); 1.500 + tf = ((c == LUA_SIGNATURE[0]) ? luaU_undump : luaY_parser)(L, p->z, 1.501 + &p->buff, p->name); 1.502 + cl = luaF_newLclosure(L, tf->nups, hvalue(gt(L))); 1.503 + cl->l.p = tf; 1.504 + for (i = 0; i < tf->nups; i++) /* initialize eventual upvalues */ 1.505 + cl->l.upvals[i] = luaF_newupval(L); 1.506 + setclvalue(L, L->top, cl); 1.507 + incr_top(L); 1.508 +} 1.509 + 1.510 + 1.511 +int luaD_protectedparser (lua_State *L, ZIO *z, const char *name) { 1.512 + struct SParser p; 1.513 + int status; 1.514 + p.z = z; p.name = name; 1.515 + luaZ_initbuffer(L, &p.buff); 1.516 + status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc); 1.517 + luaZ_freebuffer(L, &p.buff); 1.518 + return status; 1.519 +} 1.520 + 1.521 +