1*088332b5SXin Li /*
2*088332b5SXin Li ** $Id: lfunc.c $
3*088332b5SXin Li ** Auxiliary functions to manipulate prototypes and closures
4*088332b5SXin Li ** See Copyright Notice in lua.h
5*088332b5SXin Li */
6*088332b5SXin Li
7*088332b5SXin Li #define lfunc_c
8*088332b5SXin Li #define LUA_CORE
9*088332b5SXin Li
10*088332b5SXin Li #include "lprefix.h"
11*088332b5SXin Li
12*088332b5SXin Li
13*088332b5SXin Li #include <stddef.h>
14*088332b5SXin Li
15*088332b5SXin Li #include "lua.h"
16*088332b5SXin Li
17*088332b5SXin Li #include "ldebug.h"
18*088332b5SXin Li #include "ldo.h"
19*088332b5SXin Li #include "lfunc.h"
20*088332b5SXin Li #include "lgc.h"
21*088332b5SXin Li #include "lmem.h"
22*088332b5SXin Li #include "lobject.h"
23*088332b5SXin Li #include "lstate.h"
24*088332b5SXin Li
25*088332b5SXin Li
26*088332b5SXin Li
luaF_newCclosure(lua_State * L,int nupvals)27*088332b5SXin Li CClosure *luaF_newCclosure (lua_State *L, int nupvals) {
28*088332b5SXin Li GCObject *o = luaC_newobj(L, LUA_VCCL, sizeCclosure(nupvals));
29*088332b5SXin Li CClosure *c = gco2ccl(o);
30*088332b5SXin Li c->nupvalues = cast_byte(nupvals);
31*088332b5SXin Li return c;
32*088332b5SXin Li }
33*088332b5SXin Li
34*088332b5SXin Li
luaF_newLclosure(lua_State * L,int nupvals)35*088332b5SXin Li LClosure *luaF_newLclosure (lua_State *L, int nupvals) {
36*088332b5SXin Li GCObject *o = luaC_newobj(L, LUA_VLCL, sizeLclosure(nupvals));
37*088332b5SXin Li LClosure *c = gco2lcl(o);
38*088332b5SXin Li c->p = NULL;
39*088332b5SXin Li c->nupvalues = cast_byte(nupvals);
40*088332b5SXin Li while (nupvals--) c->upvals[nupvals] = NULL;
41*088332b5SXin Li return c;
42*088332b5SXin Li }
43*088332b5SXin Li
44*088332b5SXin Li
45*088332b5SXin Li /*
46*088332b5SXin Li ** fill a closure with new closed upvalues
47*088332b5SXin Li */
luaF_initupvals(lua_State * L,LClosure * cl)48*088332b5SXin Li void luaF_initupvals (lua_State *L, LClosure *cl) {
49*088332b5SXin Li int i;
50*088332b5SXin Li for (i = 0; i < cl->nupvalues; i++) {
51*088332b5SXin Li GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
52*088332b5SXin Li UpVal *uv = gco2upv(o);
53*088332b5SXin Li uv->v = &uv->u.value; /* make it closed */
54*088332b5SXin Li setnilvalue(uv->v);
55*088332b5SXin Li cl->upvals[i] = uv;
56*088332b5SXin Li luaC_objbarrier(L, cl, o);
57*088332b5SXin Li }
58*088332b5SXin Li }
59*088332b5SXin Li
60*088332b5SXin Li
61*088332b5SXin Li /*
62*088332b5SXin Li ** Create a new upvalue at the given level, and link it to the list of
63*088332b5SXin Li ** open upvalues of 'L' after entry 'prev'.
64*088332b5SXin Li **/
newupval(lua_State * L,int tbc,StkId level,UpVal ** prev)65*088332b5SXin Li static UpVal *newupval (lua_State *L, int tbc, StkId level, UpVal **prev) {
66*088332b5SXin Li GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
67*088332b5SXin Li UpVal *uv = gco2upv(o);
68*088332b5SXin Li UpVal *next = *prev;
69*088332b5SXin Li uv->v = s2v(level); /* current value lives in the stack */
70*088332b5SXin Li uv->tbc = tbc;
71*088332b5SXin Li uv->u.open.next = next; /* link it to list of open upvalues */
72*088332b5SXin Li uv->u.open.previous = prev;
73*088332b5SXin Li if (next)
74*088332b5SXin Li next->u.open.previous = &uv->u.open.next;
75*088332b5SXin Li *prev = uv;
76*088332b5SXin Li if (!isintwups(L)) { /* thread not in list of threads with upvalues? */
77*088332b5SXin Li L->twups = G(L)->twups; /* link it to the list */
78*088332b5SXin Li G(L)->twups = L;
79*088332b5SXin Li }
80*088332b5SXin Li return uv;
81*088332b5SXin Li }
82*088332b5SXin Li
83*088332b5SXin Li
84*088332b5SXin Li /*
85*088332b5SXin Li ** Find and reuse, or create if it does not exist, an upvalue
86*088332b5SXin Li ** at the given level.
87*088332b5SXin Li */
luaF_findupval(lua_State * L,StkId level)88*088332b5SXin Li UpVal *luaF_findupval (lua_State *L, StkId level) {
89*088332b5SXin Li UpVal **pp = &L->openupval;
90*088332b5SXin Li UpVal *p;
91*088332b5SXin Li lua_assert(isintwups(L) || L->openupval == NULL);
92*088332b5SXin Li while ((p = *pp) != NULL && uplevel(p) >= level) { /* search for it */
93*088332b5SXin Li lua_assert(!isdead(G(L), p));
94*088332b5SXin Li if (uplevel(p) == level) /* corresponding upvalue? */
95*088332b5SXin Li return p; /* return it */
96*088332b5SXin Li pp = &p->u.open.next;
97*088332b5SXin Li }
98*088332b5SXin Li /* not found: create a new upvalue after 'pp' */
99*088332b5SXin Li return newupval(L, 0, level, pp);
100*088332b5SXin Li }
101*088332b5SXin Li
102*088332b5SXin Li
callclose(lua_State * L,void * ud)103*088332b5SXin Li static void callclose (lua_State *L, void *ud) {
104*088332b5SXin Li UNUSED(ud);
105*088332b5SXin Li luaD_callnoyield(L, L->top - 3, 0);
106*088332b5SXin Li }
107*088332b5SXin Li
108*088332b5SXin Li
109*088332b5SXin Li /*
110*088332b5SXin Li ** Prepare closing method plus its arguments for object 'obj' with
111*088332b5SXin Li ** error message 'err'. (This function assumes EXTRA_STACK.)
112*088332b5SXin Li */
prepclosingmethod(lua_State * L,TValue * obj,TValue * err)113*088332b5SXin Li static int prepclosingmethod (lua_State *L, TValue *obj, TValue *err) {
114*088332b5SXin Li StkId top = L->top;
115*088332b5SXin Li const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
116*088332b5SXin Li if (ttisnil(tm)) /* no metamethod? */
117*088332b5SXin Li return 0; /* nothing to call */
118*088332b5SXin Li setobj2s(L, top, tm); /* will call metamethod... */
119*088332b5SXin Li setobj2s(L, top + 1, obj); /* with 'self' as the 1st argument */
120*088332b5SXin Li setobj2s(L, top + 2, err); /* and error msg. as 2nd argument */
121*088332b5SXin Li L->top = top + 3; /* add function and arguments */
122*088332b5SXin Li return 1;
123*088332b5SXin Li }
124*088332b5SXin Li
125*088332b5SXin Li
126*088332b5SXin Li /*
127*088332b5SXin Li ** Raise an error with message 'msg', inserting the name of the
128*088332b5SXin Li ** local variable at position 'level' in the stack.
129*088332b5SXin Li */
varerror(lua_State * L,StkId level,const char * msg)130*088332b5SXin Li static void varerror (lua_State *L, StkId level, const char *msg) {
131*088332b5SXin Li int idx = cast_int(level - L->ci->func);
132*088332b5SXin Li const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
133*088332b5SXin Li if (vname == NULL) vname = "?";
134*088332b5SXin Li luaG_runerror(L, msg, vname);
135*088332b5SXin Li }
136*088332b5SXin Li
137*088332b5SXin Li
138*088332b5SXin Li /*
139*088332b5SXin Li ** Prepare and call a closing method. If status is OK, code is still
140*088332b5SXin Li ** inside the original protected call, and so any error will be handled
141*088332b5SXin Li ** there. Otherwise, a previous error already activated the original
142*088332b5SXin Li ** protected call, and so the call to the closing method must be
143*088332b5SXin Li ** protected here. (A status == CLOSEPROTECT behaves like a previous
144*088332b5SXin Li ** error, to also run the closing method in protected mode).
145*088332b5SXin Li ** If status is OK, the call to the closing method will be pushed
146*088332b5SXin Li ** at the top of the stack. Otherwise, values are pushed after
147*088332b5SXin Li ** the 'level' of the upvalue being closed, as everything after
148*088332b5SXin Li ** that won't be used again.
149*088332b5SXin Li */
callclosemth(lua_State * L,StkId level,int status)150*088332b5SXin Li static int callclosemth (lua_State *L, StkId level, int status) {
151*088332b5SXin Li TValue *uv = s2v(level); /* value being closed */
152*088332b5SXin Li if (likely(status == LUA_OK)) {
153*088332b5SXin Li if (prepclosingmethod(L, uv, &G(L)->nilvalue)) /* something to call? */
154*088332b5SXin Li callclose(L, NULL); /* call closing method */
155*088332b5SXin Li else if (!l_isfalse(uv)) /* non-closable non-false value? */
156*088332b5SXin Li varerror(L, level, "attempt to close non-closable variable '%s'");
157*088332b5SXin Li }
158*088332b5SXin Li else { /* must close the object in protected mode */
159*088332b5SXin Li ptrdiff_t oldtop;
160*088332b5SXin Li level++; /* space for error message */
161*088332b5SXin Li oldtop = savestack(L, level + 1); /* top will be after that */
162*088332b5SXin Li luaD_seterrorobj(L, status, level); /* set error message */
163*088332b5SXin Li if (prepclosingmethod(L, uv, s2v(level))) { /* something to call? */
164*088332b5SXin Li int newstatus = luaD_pcall(L, callclose, NULL, oldtop, 0);
165*088332b5SXin Li if (newstatus != LUA_OK && status == CLOSEPROTECT) /* first error? */
166*088332b5SXin Li status = newstatus; /* this will be the new error */
167*088332b5SXin Li else {
168*088332b5SXin Li if (newstatus != LUA_OK) /* suppressed error? */
169*088332b5SXin Li luaE_warnerror(L, "__close metamethod");
170*088332b5SXin Li /* leave original error (or nil) on top */
171*088332b5SXin Li L->top = restorestack(L, oldtop);
172*088332b5SXin Li }
173*088332b5SXin Li }
174*088332b5SXin Li /* else no metamethod; ignore this case and keep original error */
175*088332b5SXin Li }
176*088332b5SXin Li return status;
177*088332b5SXin Li }
178*088332b5SXin Li
179*088332b5SXin Li
180*088332b5SXin Li /*
181*088332b5SXin Li ** Try to create a to-be-closed upvalue
182*088332b5SXin Li ** (can raise a memory-allocation error)
183*088332b5SXin Li */
trynewtbcupval(lua_State * L,void * ud)184*088332b5SXin Li static void trynewtbcupval (lua_State *L, void *ud) {
185*088332b5SXin Li newupval(L, 1, cast(StkId, ud), &L->openupval);
186*088332b5SXin Li }
187*088332b5SXin Li
188*088332b5SXin Li
189*088332b5SXin Li /*
190*088332b5SXin Li ** Create a to-be-closed upvalue. If there is a memory error
191*088332b5SXin Li ** when creating the upvalue, the closing method must be called here,
192*088332b5SXin Li ** as there is no upvalue to call it later.
193*088332b5SXin Li */
luaF_newtbcupval(lua_State * L,StkId level)194*088332b5SXin Li void luaF_newtbcupval (lua_State *L, StkId level) {
195*088332b5SXin Li TValue *obj = s2v(level);
196*088332b5SXin Li lua_assert(L->openupval == NULL || uplevel(L->openupval) < level);
197*088332b5SXin Li if (!l_isfalse(obj)) { /* false doesn't need to be closed */
198*088332b5SXin Li int status;
199*088332b5SXin Li const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
200*088332b5SXin Li if (ttisnil(tm)) /* no metamethod? */
201*088332b5SXin Li varerror(L, level, "variable '%s' got a non-closable value");
202*088332b5SXin Li status = luaD_rawrunprotected(L, trynewtbcupval, level);
203*088332b5SXin Li if (unlikely(status != LUA_OK)) { /* memory error creating upvalue? */
204*088332b5SXin Li lua_assert(status == LUA_ERRMEM);
205*088332b5SXin Li luaD_seterrorobj(L, LUA_ERRMEM, level + 1); /* save error message */
206*088332b5SXin Li /* next call must succeed, as object is closable */
207*088332b5SXin Li prepclosingmethod(L, s2v(level), s2v(level + 1));
208*088332b5SXin Li callclose(L, NULL); /* call closing method */
209*088332b5SXin Li luaD_throw(L, LUA_ERRMEM); /* throw memory error */
210*088332b5SXin Li }
211*088332b5SXin Li }
212*088332b5SXin Li }
213*088332b5SXin Li
214*088332b5SXin Li
luaF_unlinkupval(UpVal * uv)215*088332b5SXin Li void luaF_unlinkupval (UpVal *uv) {
216*088332b5SXin Li lua_assert(upisopen(uv));
217*088332b5SXin Li *uv->u.open.previous = uv->u.open.next;
218*088332b5SXin Li if (uv->u.open.next)
219*088332b5SXin Li uv->u.open.next->u.open.previous = uv->u.open.previous;
220*088332b5SXin Li }
221*088332b5SXin Li
222*088332b5SXin Li
luaF_close(lua_State * L,StkId level,int status)223*088332b5SXin Li int luaF_close (lua_State *L, StkId level, int status) {
224*088332b5SXin Li UpVal *uv;
225*088332b5SXin Li while ((uv = L->openupval) != NULL && uplevel(uv) >= level) {
226*088332b5SXin Li TValue *slot = &uv->u.value; /* new position for value */
227*088332b5SXin Li lua_assert(uplevel(uv) < L->top);
228*088332b5SXin Li if (uv->tbc && status != NOCLOSINGMETH) {
229*088332b5SXin Li /* must run closing method, which may change the stack */
230*088332b5SXin Li ptrdiff_t levelrel = savestack(L, level);
231*088332b5SXin Li status = callclosemth(L, uplevel(uv), status);
232*088332b5SXin Li level = restorestack(L, levelrel);
233*088332b5SXin Li }
234*088332b5SXin Li luaF_unlinkupval(uv);
235*088332b5SXin Li setobj(L, slot, uv->v); /* move value to upvalue slot */
236*088332b5SXin Li uv->v = slot; /* now current value lives here */
237*088332b5SXin Li if (!iswhite(uv)) { /* neither white nor dead? */
238*088332b5SXin Li nw2black(uv); /* closed upvalues cannot be gray */
239*088332b5SXin Li luaC_barrier(L, uv, slot);
240*088332b5SXin Li }
241*088332b5SXin Li }
242*088332b5SXin Li return status;
243*088332b5SXin Li }
244*088332b5SXin Li
245*088332b5SXin Li
luaF_newproto(lua_State * L)246*088332b5SXin Li Proto *luaF_newproto (lua_State *L) {
247*088332b5SXin Li GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
248*088332b5SXin Li Proto *f = gco2p(o);
249*088332b5SXin Li f->k = NULL;
250*088332b5SXin Li f->sizek = 0;
251*088332b5SXin Li f->p = NULL;
252*088332b5SXin Li f->sizep = 0;
253*088332b5SXin Li f->code = NULL;
254*088332b5SXin Li f->sizecode = 0;
255*088332b5SXin Li f->lineinfo = NULL;
256*088332b5SXin Li f->sizelineinfo = 0;
257*088332b5SXin Li f->abslineinfo = NULL;
258*088332b5SXin Li f->sizeabslineinfo = 0;
259*088332b5SXin Li f->upvalues = NULL;
260*088332b5SXin Li f->sizeupvalues = 0;
261*088332b5SXin Li f->numparams = 0;
262*088332b5SXin Li f->is_vararg = 0;
263*088332b5SXin Li f->maxstacksize = 0;
264*088332b5SXin Li f->locvars = NULL;
265*088332b5SXin Li f->sizelocvars = 0;
266*088332b5SXin Li f->linedefined = 0;
267*088332b5SXin Li f->lastlinedefined = 0;
268*088332b5SXin Li f->source = NULL;
269*088332b5SXin Li return f;
270*088332b5SXin Li }
271*088332b5SXin Li
272*088332b5SXin Li
luaF_freeproto(lua_State * L,Proto * f)273*088332b5SXin Li void luaF_freeproto (lua_State *L, Proto *f) {
274*088332b5SXin Li luaM_freearray(L, f->code, f->sizecode);
275*088332b5SXin Li luaM_freearray(L, f->p, f->sizep);
276*088332b5SXin Li luaM_freearray(L, f->k, f->sizek);
277*088332b5SXin Li luaM_freearray(L, f->lineinfo, f->sizelineinfo);
278*088332b5SXin Li luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo);
279*088332b5SXin Li luaM_freearray(L, f->locvars, f->sizelocvars);
280*088332b5SXin Li luaM_freearray(L, f->upvalues, f->sizeupvalues);
281*088332b5SXin Li luaM_free(L, f);
282*088332b5SXin Li }
283*088332b5SXin Li
284*088332b5SXin Li
285*088332b5SXin Li /*
286*088332b5SXin Li ** Look for n-th local variable at line 'line' in function 'func'.
287*088332b5SXin Li ** Returns NULL if not found.
288*088332b5SXin Li */
luaF_getlocalname(const Proto * f,int local_number,int pc)289*088332b5SXin Li const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
290*088332b5SXin Li int i;
291*088332b5SXin Li for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
292*088332b5SXin Li if (pc < f->locvars[i].endpc) { /* is variable active? */
293*088332b5SXin Li local_number--;
294*088332b5SXin Li if (local_number == 0)
295*088332b5SXin Li return getstr(f->locvars[i].varname);
296*088332b5SXin Li }
297*088332b5SXin Li }
298*088332b5SXin Li return NULL; /* not found */
299*088332b5SXin Li }
300*088332b5SXin Li
301