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 | |
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 | |
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 | */ |
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 | **/ |
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 | */ |
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 | 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 | */ |
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 | */ |
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 | */ |
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 | */ |
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 | */ |
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 | |
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 | |
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 | |
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 | |
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 | */ |
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 | |