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
27CClosure *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
35LClosure *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*/
48void 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**/
65static 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*/
88UpVal *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
103static 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*/
113static 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*/
130static 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*/
150static 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*/
184static 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*/
194void 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
215void 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
223int 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
246Proto *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
273void 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*/
289const 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