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