- initial import of revision 374 from cnc
[apt.git] / lua / lfunc.c
1 /*
2 ** $Id: lfunc.c,v 1.67 2003/03/18 12:50:04 roberto Exp $
3 ** Auxiliary functions to manipulate prototypes and closures
4 ** See Copyright Notice in lua.h
5 */
6
7
8 #include <stdlib.h>
9
10 #define lfunc_c
11
12 #include "lua.h"
13
14 #include "lfunc.h"
15 #include "lgc.h"
16 #include "lmem.h"
17 #include "lobject.h"
18 #include "lstate.h"
19
20
21 #define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \
22                          cast(int, sizeof(TObject)*((n)-1)))
23
24 #define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \
25                          cast(int, sizeof(TObject *)*((n)-1)))
26
27
28
29 Closure *luaF_newCclosure (lua_State *L, int nelems) {
30   Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
31   luaC_link(L, valtogco(c), LUA_TFUNCTION);
32   c->c.isC = 1;
33   c->c.nupvalues = cast(lu_byte, nelems);
34   return c;
35 }
36
37
38 Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e) {
39   Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
40   luaC_link(L, valtogco(c), LUA_TFUNCTION);
41   c->l.isC = 0;
42   c->l.g = *e;
43   c->l.nupvalues = cast(lu_byte, nelems);
44   return c;
45 }
46
47
48 UpVal *luaF_findupval (lua_State *L, StkId level) {
49   GCObject **pp = &L->openupval;
50   UpVal *p;
51   UpVal *v;
52   while ((p = ngcotouv(*pp)) != NULL && p->v >= level) {
53     if (p->v == level) return p;
54     pp = &p->next;
55   }
56   v = luaM_new(L, UpVal);  /* not found: create a new one */
57   v->tt = LUA_TUPVAL;
58   v->marked = 1;  /* open upvalues should not be collected */
59   v->v = level;  /* current value lives in the stack */
60   v->next = *pp;  /* chain it in the proper position */
61   *pp = valtogco(v);
62   return v;
63 }
64
65
66 void luaF_close (lua_State *L, StkId level) {
67   UpVal *p;
68   while ((p = ngcotouv(L->openupval)) != NULL && p->v >= level) {
69     setobj(&p->value, p->v);  /* save current value (write barrier) */
70     p->v = &p->value;  /* now current value lives here */
71     L->openupval = p->next;  /* remove from `open' list */
72     luaC_link(L, valtogco(p), LUA_TUPVAL);
73   }
74 }
75
76
77 Proto *luaF_newproto (lua_State *L) {
78   Proto *f = luaM_new(L, Proto);
79   luaC_link(L, valtogco(f), LUA_TPROTO);
80   f->k = NULL;
81   f->sizek = 0;
82   f->p = NULL;
83   f->sizep = 0;
84   f->code = NULL;
85   f->sizecode = 0;
86   f->sizelineinfo = 0;
87   f->sizeupvalues = 0;
88   f->nups = 0;
89   f->upvalues = NULL;
90   f->numparams = 0;
91   f->is_vararg = 0;
92   f->maxstacksize = 0;
93   f->lineinfo = NULL;
94   f->sizelocvars = 0;
95   f->locvars = NULL;
96   f->lineDefined = 0;
97   f->source = NULL;
98   return f;
99 }
100
101
102 void luaF_freeproto (lua_State *L, Proto *f) {
103   luaM_freearray(L, f->code, f->sizecode, Instruction);
104   luaM_freearray(L, f->p, f->sizep, Proto *);
105   luaM_freearray(L, f->k, f->sizek, TObject);
106   luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
107   luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
108   luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);
109   luaM_freelem(L, f);
110 }
111
112
113 void luaF_freeclosure (lua_State *L, Closure *c) {
114   int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) :
115                           sizeLclosure(c->l.nupvalues);
116   luaM_free(L, c, size);
117 }
118
119
120 /*
121 ** Look for n-th local variable at line `line' in function `func'.
122 ** Returns NULL if not found.
123 */
124 const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
125   int i;
126   for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
127     if (pc < f->locvars[i].endpc) {  /* is variable active? */
128       local_number--;
129       if (local_number == 0)
130         return getstr(f->locvars[i].varname);
131     }
132   }
133   return NULL;  /* not found */
134 }
135