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 
103 /*
104 ** Call closing method for object 'obj' with error message 'err'. The
105 ** boolean 'yy' controls whether the call is yieldable.
106 ** (This function assumes EXTRA_STACK.)
107 */
callclosemethod(lua_State * L,TValue * obj,TValue * err,int yy)108 static void callclosemethod (lua_State *L, TValue *obj, TValue *err, int yy) {
109   StkId top = L->top;
110   const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
111   setobj2s(L, top, tm);  /* will call metamethod... */
112   setobj2s(L, top + 1, obj);  /* with 'self' as the 1st argument */
113   setobj2s(L, top + 2, err);  /* and error msg. as 2nd argument */
114   L->top = top + 3;  /* add function and arguments */
115   if (yy)
116     luaD_call(L, top, 0);
117   else
118     luaD_callnoyield(L, top, 0);
119 }
120 
121 
122 /*
123 ** Check whether object at given level has a close metamethod and raise
124 ** an error if not.
125 */
checkclosemth(lua_State * L,StkId level)126 static void checkclosemth (lua_State *L, StkId level) {
127   const TValue *tm = luaT_gettmbyobj(L, s2v(level), TM_CLOSE);
128   if (ttisnil(tm)) {  /* no metamethod? */
129     int idx = cast_int(level - L->ci->func);  /* variable index */
130     const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
131     if (vname == NULL) vname = "?";
132     luaG_runerror(L, "variable '%s' got a non-closable value", vname);
133   }
134 }
135 
136 
137 /*
138 ** Prepare and call a closing method.
139 ** If status is CLOSEKTOP, the call to the closing method will be pushed
140 ** at the top of the stack. Otherwise, values can be pushed right after
141 ** the 'level' of the upvalue being closed, as everything after that
142 ** won't be used again.
143 */
prepcallclosemth(lua_State * L,StkId level,int status,int yy)144 static void prepcallclosemth (lua_State *L, StkId level, int status, int yy) {
145   TValue *uv = s2v(level);  /* value being closed */
146   TValue *errobj;
147   if (status == CLOSEKTOP)
148     errobj = &G(L)->nilvalue;  /* error object is nil */
149   else {  /* 'luaD_seterrorobj' will set top to level + 2 */
150     errobj = s2v(level + 1);  /* error object goes after 'uv' */
151     luaD_seterrorobj(L, status, level + 1);  /* set error object */
152   }
153   callclosemethod(L, uv, errobj, yy);
154 }
155 
156 
157 /*
158 ** Maximum value for deltas in 'tbclist', dependent on the type
159 ** of delta. (This macro assumes that an 'L' is in scope where it
160 ** is used.)
161 */
162 #define MAXDELTA  \
163 	((256ul << ((sizeof(L->stack->tbclist.delta) - 1) * 8)) - 1)
164 
165 
166 /*
167 ** Insert a variable in the list of to-be-closed variables.
168 */
luaF_newtbcupval(lua_State * L,StkId level)169 void luaF_newtbcupval (lua_State *L, StkId level) {
170   lua_assert(level > L->tbclist);
171   if (l_isfalse(s2v(level)))
172     return;  /* false doesn't need to be closed */
173   checkclosemth(L, level);  /* value must have a close method */
174   while (cast_uint(level - L->tbclist) > MAXDELTA) {
175     L->tbclist += MAXDELTA;  /* create a dummy node at maximum delta */
176     L->tbclist->tbclist.delta = 0;
177   }
178   level->tbclist.delta = cast(unsigned short, level - L->tbclist);
179   L->tbclist = level;
180 }
181 
182 
luaF_unlinkupval(UpVal * uv)183 void luaF_unlinkupval (UpVal *uv) {
184   lua_assert(upisopen(uv));
185   *uv->u.open.previous = uv->u.open.next;
186   if (uv->u.open.next)
187     uv->u.open.next->u.open.previous = uv->u.open.previous;
188 }
189 
190 
191 /*
192 ** Close all upvalues up to the given stack level.
193 */
luaF_closeupval(lua_State * L,StkId level)194 void luaF_closeupval (lua_State *L, StkId level) {
195   UpVal *uv;
196   StkId upl;  /* stack index pointed by 'uv' */
197   while ((uv = L->openupval) != NULL && (upl = uplevel(uv)) >= level) {
198     TValue *slot = &uv->u.value;  /* new position for value */
199     lua_assert(uplevel(uv) < L->top);
200     luaF_unlinkupval(uv);  /* remove upvalue from 'openupval' list */
201     setobj(L, slot, uv->v);  /* move value to upvalue slot */
202     uv->v = slot;  /* now current value lives here */
203     if (!iswhite(uv)) {  /* neither white nor dead? */
204       nw2black(uv);  /* closed upvalues cannot be gray */
205       luaC_barrier(L, uv, slot);
206     }
207   }
208 }
209 
210 
211 /*
212 ** Remove firt element from the tbclist plus its dummy nodes.
213 */
poptbclist(lua_State * L)214 static void poptbclist (lua_State *L) {
215   StkId tbc = L->tbclist;
216   lua_assert(tbc->tbclist.delta > 0);  /* first element cannot be dummy */
217   tbc -= tbc->tbclist.delta;
218   while (tbc > L->stack && tbc->tbclist.delta == 0)
219     tbc -= MAXDELTA;  /* remove dummy nodes */
220   L->tbclist = tbc;
221 }
222 
223 
224 /*
225 ** Close all upvalues and to-be-closed variables up to the given stack
226 ** level.
227 */
luaF_close(lua_State * L,StkId level,int status,int yy)228 void luaF_close (lua_State *L, StkId level, int status, int yy) {
229   ptrdiff_t levelrel = savestack(L, level);
230   luaF_closeupval(L, level);  /* first, close the upvalues */
231   while (L->tbclist >= level) {  /* traverse tbc's down to that level */
232     StkId tbc = L->tbclist;  /* get variable index */
233     poptbclist(L);  /* remove it from list */
234     prepcallclosemth(L, tbc, status, yy);  /* close variable */
235     level = restorestack(L, levelrel);
236   }
237 }
238 
239 
luaF_newproto(lua_State * L)240 Proto *luaF_newproto (lua_State *L) {
241   GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
242   Proto *f = gco2p(o);
243   f->k = NULL;
244   f->sizek = 0;
245   f->p = NULL;
246   f->sizep = 0;
247   f->code = NULL;
248   f->sizecode = 0;
249   f->lineinfo = NULL;
250   f->sizelineinfo = 0;
251   f->abslineinfo = NULL;
252   f->sizeabslineinfo = 0;
253   f->upvalues = NULL;
254   f->sizeupvalues = 0;
255   f->numparams = 0;
256   f->is_vararg = 0;
257   f->maxstacksize = 0;
258   f->locvars = NULL;
259   f->sizelocvars = 0;
260   f->linedefined = 0;
261   f->lastlinedefined = 0;
262   f->source = NULL;
263   return f;
264 }
265 
266 
luaF_freeproto(lua_State * L,Proto * f)267 void luaF_freeproto (lua_State *L, Proto *f) {
268   luaM_freearray(L, f->code, f->sizecode);
269   luaM_freearray(L, f->p, f->sizep);
270   luaM_freearray(L, f->k, f->sizek);
271   luaM_freearray(L, f->lineinfo, f->sizelineinfo);
272   luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo);
273   luaM_freearray(L, f->locvars, f->sizelocvars);
274   luaM_freearray(L, f->upvalues, f->sizeupvalues);
275   luaM_free(L, f);
276 }
277 
278 
279 /*
280 ** Look for n-th local variable at line 'line' in function 'func'.
281 ** Returns NULL if not found.
282 */
luaF_getlocalname(const Proto * f,int local_number,int pc)283 const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
284   int i;
285   for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
286     if (pc < f->locvars[i].endpc) {  /* is variable active? */
287       local_number--;
288       if (local_number == 0)
289         return getstr(f->locvars[i].varname);
290     }
291   }
292   return NULL;  /* not found */
293 }
294 
295