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