Update of /cvsroot/wxlua/wxLua/modules/lua/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14733/wxLua/modules/lua/src Added Files: Makefile README lapi.c lapi.h lcode.c lcode.h ldebug.c ldebug.h ldllmain.c ldo.c ldo.h ldump.c lfunc.c lfunc.h lgc.c lgc.h llex.c llex.h llimits.h lmem.c lmem.h lobject.c lobject.h lopcodes.c lopcodes.h lparser.c lparser.h lstate.c lstate.h lstring.c lstring.h ltable.c ltable.h ltests.c ltm.c ltm.h luadll.rc lundump.c lundump.h lvm.c lvm.h lzio.c lzio.h makefile.b32 Log Message: moved files to the modules directory structure --- NEW FILE: ltm.c --- /* ** $Id: ltm.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Tag methods ** See Copyright Notice in lua.h */ #include <string.h> #define ltm_c #include "lua.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" const char *const luaT_typenames[] = { "nil", "boolean", "userdata", "number", "string", "table", "function", "userdata", "thread" }; void luaT_init (lua_State *L) { static const char *const luaT_eventname[] = { /* ORDER TM */ "__index", "__newindex", "__gc", "__mode", "__eq", "__add", "__sub", "__mul", "__div", "__pow", "__unm", "__lt", "__le", "__concat", "__call" }; int i; for (i=0; i<TM_N; i++) { G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]); luaS_fix(G(L)->tmname[i]); /* never collect these names */ } } /* ** function to be used with macro "fasttm": optimized for absence of ** tag methods */ const TObject *luaT_gettm (Table *events, TMS event, TString *ename) { const TObject *tm = luaH_getstr(events, ename); lua_assert(event <= TM_EQ); if (ttisnil(tm)) { /* no tag method? */ events->flags |= cast(lu_byte, 1u<<event); /* cache this fact */ return NULL; } else return tm; } const TObject *luaT_gettmbyobj (lua_State *L, const TObject *o, TMS event) { TString *ename = G(L)->tmname[event]; switch (ttype(o)) { case LUA_TTABLE: return luaH_getstr(hvalue(o)->metatable, ename); case LUA_TUSERDATA: return luaH_getstr(uvalue(o)->uv.metatable, ename); default: return &luaO_nilobject; } } --- NEW FILE: lmem.c --- /* ** $Id: lmem.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ #include <stdlib.h> #define lmem_c #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" /* ** definition for realloc function. It must assure that l_realloc(NULL, ** 0, x) allocates a new block (ANSI C assures that). (`os' is the old ** block size; some allocators may use that.) */ #ifndef l_realloc #define l_realloc(b,os,s) realloc(b,s) #endif /* ** definition for free function. (`os' is the old block size; some ** allocators may use that.) */ #ifndef l_free #define l_free(b,os) free(b) #endif #define MINSIZEARRAY 4 void *luaM_growaux (lua_State *L, void *block, int *size, int size_elems, int limit, const char *errormsg) { void *newblock; int newsize = (*size)*2; if (newsize < MINSIZEARRAY) newsize = MINSIZEARRAY; /* minimum size */ else if (*size >= limit/2) { /* cannot double it? */ if (*size < limit - MINSIZEARRAY) /* try something smaller... */ newsize = limit; /* still have at least MINSIZEARRAY free places */ else luaG_runerror(L, errormsg); } newblock = luaM_realloc(L, block, cast(lu_mem, *size)*cast(lu_mem, size_elems), cast(lu_mem, newsize)*cast(lu_mem, size_elems)); *size = newsize; /* update only when everything else is OK */ return newblock; } /* ** generic allocation routine. */ void *luaM_realloc (lua_State *L, void *block, lu_mem oldsize, lu_mem size) { lua_assert((oldsize == 0) == (block == NULL)); if (size == 0) { if (block != NULL) { l_free(block, oldsize); block = NULL; } else return NULL; /* avoid `nblocks' computations when oldsize==size==0 */ } else if (size >= MAX_SIZET) luaG_runerror(L, "memory allocation error: block too big"); else { block = l_realloc(block, oldsize, size); if (block == NULL) { if (L) luaD_throw(L, LUA_ERRMEM); else return NULL; /* error before creating state! */ } } if (L) { lua_assert(G(L) != NULL && G(L)->nblocks > 0); G(L)->nblocks -= oldsize; G(L)->nblocks += size; } return block; } --- NEW FILE: Makefile --- # makefile for Lua core library LUA= .. include $(LUA)/config OBJS= \ lapi.o \ lcode.o \ ldebug.o \ ldo.o \ ldump.o \ lfunc.o \ lgc.o \ llex.o \ lmem.o \ lobject.o \ lopcodes.o \ lparser.o \ lstate.o \ lstring.o \ ltable.o \ ltests.o \ ltm.o \ lundump.o \ lvm.o \ lzio.o SRCS= \ lapi.c \ lcode.c \ ldebug.c \ ldo.c \ ldump.c \ lfunc.c \ lgc.c \ llex.c \ lmem.c \ lobject.c \ lopcodes.c \ lparser.c \ lstate.c \ lstring.c \ ltable.c \ ltests.c \ ltm.c \ lundump.c \ lvm.c \ lzio.c \ lapi.h \ lcode.h \ ldebug.h \ ldo.h \ lfunc.h \ lgc.h \ llex.h \ llimits.h \ lmem.h \ lobject.h \ lopcodes.h \ lparser.h \ lstate.h \ lstring.h \ ltable.h \ ltm.h \ lundump.h \ lvm.h \ lzio.h T= $(LIB)/liblua.a all: $T $T: $(OBJS) $(AR) $@ $(OBJS) $(RANLIB) $@ clean: rm -f $(OBJS) $T co: co -q -f -M $(SRCS) klean: clean rm -f $(SRCS) --- NEW FILE: lmem.h --- /* ** $Id: lmem.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ #ifndef lmem_h #define lmem_h #include <stddef.h> #include "llimits.h" #include "lua.h" #define MEMERRMSG "not enough memory" void *luaM_realloc (lua_State *L, void *oldblock, lu_mem oldsize, lu_mem size); void *luaM_growaux (lua_State *L, void *block, int *size, int size_elem, int limit, const char *errormsg); #define luaM_free(L, b, s) luaM_realloc(L, (b), (s), 0) #define luaM_freelem(L, b) luaM_realloc(L, (b), sizeof(*(b)), 0) #define luaM_freearray(L, b, n, t) luaM_realloc(L, (b), \ cast(lu_mem, n)*cast(lu_mem, sizeof(t)), 0) #define luaM_malloc(L, t) luaM_realloc(L, NULL, 0, (t)) #define luaM_new(L, t) cast(t *, luaM_malloc(L, sizeof(t))) #define luaM_newvector(L, n,t) cast(t *, luaM_malloc(L, \ cast(lu_mem, n)*cast(lu_mem, sizeof(t)))) #define luaM_growvector(L,v,nelems,size,t,limit,e) \ if (((nelems)+1) > (size)) \ ((v)=cast(t *, luaM_growaux(L,v,&(size),sizeof(t),limit,e))) #define luaM_reallocvector(L, v,oldn,n,t) \ ((v)=cast(t *, luaM_realloc(L, v,cast(lu_mem, oldn)*cast(lu_mem, sizeof(t)), \ cast(lu_mem, n)*cast(lu_mem, sizeof(t))))) #endif --- NEW FILE: ldump.c --- /* ** $Id: ldump.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** save bytecodes ** See Copyright Notice in lua.h */ #include <stddef.h> #define ldump_c #include "lua.h" #include "lobject.h" #include "lopcodes.h" #include "lstate.h" #include "lundump.h" #define DumpVector(b,n,size,D) DumpBlock(b,(n)*(size),D) #define DumpLiteral(s,D) DumpBlock("" s,(sizeof(s))-1,D) typedef struct { lua_State* L; lua_Chunkwriter write; void* data; } DumpState; static void DumpBlock(const void* b, size_t size, DumpState* D) { lua_unlock(D->L); (*D->write)(D->L,b,size,D->data); lua_lock(D->L); } static void DumpByte(int y, DumpState* D) { char x=(char)y; DumpBlock(&x,sizeof(x),D); } static void DumpInt(int x, DumpState* D) { DumpBlock(&x,sizeof(x),D); } static void DumpSize(size_t x, DumpState* D) { DumpBlock(&x,sizeof(x),D); } static void DumpNumber(lua_Number x, DumpState* D) { DumpBlock(&x,sizeof(x),D); } static void DumpString(TString* s, DumpState* D) { if (s==NULL || getstr(s)==NULL) DumpSize(0,D); else { size_t size=s->tsv.len+1; /* include trailing '\0' */ DumpSize(size,D); DumpBlock(getstr(s),size,D); } } static void DumpCode(const Proto* f, DumpState* D) { DumpInt(f->sizecode,D); DumpVector(f->code,f->sizecode,sizeof(*f->code),D); } static void DumpLocals(const Proto* f, DumpState* D) { int i,n=f->sizelocvars; DumpInt(n,D); for (i=0; i<n; i++) { DumpString(f->locvars[i].varname,D); DumpInt(f->locvars[i].startpc,D); DumpInt(f->locvars[i].endpc,D); } } static void DumpLines(const Proto* f, DumpState* D) { DumpInt(f->sizelineinfo,D); DumpVector(f->lineinfo,f->sizelineinfo,sizeof(*f->lineinfo),D); } static void DumpUpvalues(const Proto* f, DumpState* D) { int i,n=f->sizeupvalues; DumpInt(n,D); for (i=0; i<n; i++) DumpString(f->upvalues[i],D); } static void DumpFunction(const Proto* f, const TString* p, DumpState* D); static void DumpConstants(const Proto* f, DumpState* D) { int i,n; DumpInt(n=f->sizek,D); for (i=0; i<n; i++) { const TObject* o=&f->k[i]; DumpByte(ttype(o),D); switch (ttype(o)) { case LUA_TNUMBER: DumpNumber(nvalue(o),D); break; case LUA_TSTRING: DumpString(tsvalue(o),D); break; case LUA_TNIL: break; default: lua_assert(0); /* cannot happen */ break; } } DumpInt(n=f->sizep,D); for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D); } static void DumpFunction(const Proto* f, const TString* p, DumpState* D) { DumpString((f->source==p) ? NULL : f->source,D); DumpInt(f->lineDefined,D); DumpByte(f->nups,D); DumpByte(f->numparams,D); DumpByte(f->is_vararg,D); DumpByte(f->maxstacksize,D); DumpLines(f,D); DumpLocals(f,D); DumpUpvalues(f,D); DumpConstants(f,D); DumpCode(f,D); } static void DumpHeader(DumpState* D) { DumpLiteral(LUA_SIGNATURE,D); DumpByte(VERSION,D); DumpByte(luaU_endianness(),D); DumpByte(sizeof(int),D); DumpByte(sizeof(size_t),D); DumpByte(sizeof(Instruction),D); DumpByte(SIZE_OP,D); DumpByte(SIZE_A,D); DumpByte(SIZE_B,D); DumpByte(SIZE_C,D); DumpByte(sizeof(lua_Number),D); DumpNumber(TEST_NUMBER,D); } /* ** dump function as precompiled chunk */ void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data) { DumpState D; D.L=L; D.write=w; D.data=data; DumpHeader(&D); DumpFunction(Main,NULL,&D); } --- NEW FILE: ltable.h --- /* ** $Id: ltable.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ #ifndef ltable_h #define ltable_h #include "lobject.h" #define gnode(t,i) (&(t)->node[i]) #define gkey(n) (&(n)->i_key) #define gval(n) (&(n)->i_val) const TObject *luaH_getnum (Table *t, int key); TObject *luaH_setnum (lua_State *L, Table *t, int key); const TObject *luaH_getstr (Table *t, TString *key); const TObject *luaH_get (Table *t, const TObject *key); TObject *luaH_set (lua_State *L, Table *t, const TObject *key); Table *luaH_new (lua_State *L, int narray, int lnhash); void luaH_free (lua_State *L, Table *t); int luaH_next (lua_State *L, Table *t, StkId key); /* exported only for debugging */ Node *luaH_mainposition (const Table *t, const TObject *key); #endif --- NEW FILE: ldebug.h --- /* ** $Id: ldebug.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Auxiliary functions from Debug Interface module ** See Copyright Notice in lua.h */ #ifndef ldebug_h #define ldebug_h #include "lstate.h" #define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1) #define getline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0) #define resethookcount(L) (L->hookcount = L->basehookcount) void luaG_inithooks (lua_State *L); void luaG_typeerror (lua_State *L, const TObject *o, const char *opname); void luaG_concaterror (lua_State *L, StkId p1, StkId p2); void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2); int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2); void luaG_runerror (lua_State *L, const char *fmt, ...); void luaG_errormsg (lua_State *L); int luaG_checkcode (const Proto *pt); #endif --- NEW FILE: ltable.c --- /* ** $Id: ltable.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ /* ** Implementation of tables (aka arrays, objects, or hash tables). ** Tables keep its elements in two parts: an array part and a hash part. ** Non-negative integer keys are all candidates to be kept in the array ** part. The actual size of the array is the largest `n' such that at ** least half the slots between 0 and n are in use. ** Hash uses a mix of chained scatter table with Brent's variation. ** A main invariant of these tables is that, if an element is not ** in its main position (i.e. the `original' position that its hash gives ** to it), then the colliding element is in its own main position. ** In other words, there are collisions only when two elements have the ** same main position (i.e. the same hash values for that table size). ** Because of that, the load factor of these tables can be 100% without ** performance penalties. */ #include <string.h> #define ltable_c #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "ltable.h" /* ** max size of array part is 2^MAXBITS */ #if BITS_INT > 26 #define MAXBITS 24 #else #define MAXBITS (BITS_INT-2) #endif /* check whether `x' < 2^MAXBITS */ #define toobig(x) ((((x)-1) >> MAXBITS) != 0) /* function to convert a lua_Number to int (with any rounding method) */ #ifndef lua_number2int #define lua_number2int(i,n) ((i)=(int)(n)) #endif #define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) #define hashstr(t,str) hashpow2(t, (str)->tsv.hash) #define hashboolean(t,p) hashpow2(t, p) /* ** for some types, it is better to avoid modulus by power of 2, as ** they tend to have many 2 factors. */ #define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) #define hashpointer(t,p) hashmod(t, IntPoint(p)) /* ** number of ints inside a lua_Number */ #define numints cast(int, sizeof(lua_Number)/sizeof(int)) /* ** hash for lua_Numbers */ static Node *hashnum (const Table *t, lua_Number n) { unsigned int a[numints]; int i; n += 1; /* normalize number (avoid -0) */ lua_assert(sizeof(a) <= sizeof(n)); memcpy(a, &n, sizeof(a)); for (i = 1; i < numints; i++) a[0] += a[i]; return hashmod(t, cast(lu_hash, a[0])); } /* ** returns the `main' position of an element in a table (that is, the index ** of its hash value) */ Node *luaH_mainposition (const Table *t, const TObject *key) { switch (ttype(key)) { case LUA_TNUMBER: return hashnum(t, nvalue(key)); case LUA_TSTRING: return hashstr(t, tsvalue(key)); case LUA_TBOOLEAN: return hashboolean(t, bvalue(key)); case LUA_TLIGHTUSERDATA: return hashpointer(t, pvalue(key)); default: return hashpointer(t, gcvalue(key)); } } /* ** returns the index for `key' if `key' is an appropriate key to live in ** the array part of the table, -1 otherwise. */ static int arrayindex (const TObject *key) { if (ttisnumber(key)) { int k; lua_number2int(k, (nvalue(key))); if (cast(lua_Number, k) == nvalue(key) && k >= 1 && !toobig(k)) return k; } return -1; /* `key' did not match some condition */ } /* ** returns the index of a `key' for table traversals. First goes all ** elements in the array part, then elements in the hash part. The ** beginning and end of a traversal are signalled by -1. */ static int luaH_index (lua_State *L, Table *t, StkId key) { int i; if (ttisnil(key)) return -1; /* first iteration */ i = arrayindex(key); if (0 <= i && i <= t->sizearray) { /* is `key' inside array part? */ return i-1; /* yes; that's the index (corrected to C) */ } else { const TObject *v = luaH_get(t, key); if (v == &luaO_nilobject) luaG_runerror(L, "invalid key for `next'"); i = cast(int, (cast(const lu_byte *, v) - cast(const lu_byte *, gval(gnode(t, 0)))) / sizeof(Node)); return i + t->sizearray; /* hash elements are numbered after array ones */ } } int luaH_next (lua_State *L, Table *t, StkId key) { int i = luaH_index(L, t, key); /* find original element */ for (i++; i < t->sizearray; i++) { /* try first array part */ if (!ttisnil(&t->array[i])) { /* a non-nil value? */ setnvalue(key, cast(lua_Number, i+1)); setobj2s(key+1, &t->array[i]); return 1; } } for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */ if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */ setobj2s(key, gkey(gnode(t, i))); setobj2s(key+1, gval(gnode(t, i))); return 1; } } return 0; /* no more elements */ } /* ** {============================================================= ** Rehash ** ============================================================== */ static void computesizes (int nums[], int ntotal, int *narray, int *nhash) { int i; int a = nums[0]; /* number of elements smaller than 2^i */ int na = a; /* number of elements to go to array part */ int n = (na == 0) ? -1 : 0; /* (log of) optimal size for array part */ for (i = 1; a < *narray && *narray >= twoto(i-1); i++) { if (nums[i] > 0) { a += nums[i]; if (a >= twoto(i-1)) { /* more than half elements in use? */ n = i; na = a; } } } lua_assert(na <= *narray && *narray <= ntotal); *nhash = ntotal - na; *narray = (n == -1) ? 0 : twoto(n); lua_assert(na <= *narray && na >= *narray/2); } static void numuse (const Table *t, int *narray, int *nhash) { int nums[MAXBITS+1]; int i, lg; int totaluse = 0; /* count elements in array part */ for (i=0, lg=0; lg<=MAXBITS; lg++) { /* for each slice [2^(lg-1) to 2^lg) */ int ttlg = twoto(lg); /* 2^lg */ if (ttlg > t->sizearray) { ttlg = t->sizearray; if (i >= ttlg) break; } nums[lg] = 0; for (; i<ttlg; i++) { if (!ttisnil(&t->array[i])) { nums[lg]++; totaluse++; } } } for (; lg<=MAXBITS; lg++) nums[lg] = 0; /* reset other counts */ *narray = totaluse; /* all previous uses were in array part */ /* count elements in hash part */ i = sizenode(t); while (i--) { Node *n = &t->node[i]; if (!ttisnil(gval(n))) { int k = arrayindex(gkey(n)); if (k >= 0) { /* is `key' an appropriate array index? */ nums[luaO_log2(k-1)+1]++; /* count as such */ (*narray)++; } totaluse++; } } computesizes(nums, totaluse, narray, nhash); } static void setarrayvector (lua_State *L, Table *t, int size) { int i; luaM_reallocvector(L, t->array, t->sizearray, size, TObject); for (i=t->sizearray; i<size; i++) setnilvalue(&t->array[i]); t->sizearray = size; } static void setnodevector (lua_State *L, Table *t, int lsize) { int i; int size = twoto(lsize); if (lsize > MAXBITS) luaG_runerror(L, "table overflow"); if (lsize == 0) { /* no elements to hash part? */ t->node = G(L)->dummynode; /* use common `dummynode' */ lua_assert(ttisnil(gkey(t->node))); /* assert invariants: */ lua_assert(ttisnil(gval(t->node))); lua_assert(t->node->next == NULL); /* (`dummynode' must be empty) */ } else { t->node = luaM_newvector(L, size, Node); for (i=0; i<size; i++) { t->node[i].next = NULL; setnilvalue(gkey(gnode(t, i))); setnilvalue(gval(gnode(t, i))); } } t->lsizenode = cast(lu_byte, lsize); t->firstfree = gnode(t, size-1); /* first free position to be used */ } static void resize (lua_State *L, Table *t, int nasize, int nhsize) { int i; int oldasize = t->sizearray; int oldhsize = t->lsizenode; Node *nold; Node temp[1]; if (oldhsize) nold = t->node; /* save old hash ... */ else { /* old hash is `dummynode' */ lua_assert(t->node == G(L)->dummynode); temp[0] = t->node[0]; /* copy it to `temp' */ nold = temp; setnilvalue(gkey(G(L)->dummynode)); /* restate invariant */ setnilvalue(gval(G(L)->dummynode)); lua_assert(G(L)->dummynode->next == NULL); } if (nasize > oldasize) /* array part must grow? */ setarrayvector(L, t, nasize); /* create new hash part with appropriate size */ setnodevector(L, t, nhsize); /* re-insert elements */ if (nasize < oldasize) { /* array part must shrink? */ t->sizearray = nasize; /* re-insert elements from vanishing slice */ for (i=nasize; i<oldasize; i++) { if (!ttisnil(&t->array[i])) setobjt2t(luaH_setnum(L, t, i+1), &t->array[i]); } /* shrink array */ luaM_reallocvector(L, t->array, oldasize, nasize, TObject); } /* re-insert elements in hash part */ for (i = twoto(oldhsize) - 1; i >= 0; i--) { Node *old = nold+i; if (!ttisnil(gval(old))) setobjt2t(luaH_set(L, t, gkey(old)), gval(old)); } if (oldhsize) luaM_freearray(L, nold, twoto(oldhsize), Node); /* free old array */ } static void rehash (lua_State *L, Table *t) { int nasize, nhsize; numuse(t, &nasize, &nhsize); /* compute new sizes for array and hash parts */ resize(L, t, nasize, luaO_log2(nhsize)+1); } /* ** }============================================================= */ Table *luaH_new (lua_State *L, int narray, int lnhash) { Table *t = luaM_new(L, Table); luaC_link(L, valtogco(t), LUA_TTABLE); t->metatable = hvalue(defaultmeta(L)); t->flags = cast(lu_byte, ~0); /* temporary values (kept only if some malloc fails) */ t->array = NULL; t->sizearray = 0; t->lsizenode = 0; t->node = NULL; setarrayvector(L, t, narray); setnodevector(L, t, lnhash); return t; } void luaH_free (lua_State *L, Table *t) { if (t->lsizenode) luaM_freearray(L, t->node, sizenode(t), Node); luaM_freearray(L, t->array, t->sizearray, TObject); luaM_freelem(L, t); } #if 0 /* ** try to remove an element from a hash table; cannot move any element ** (because gc can call `remove' during a table traversal) */ void luaH_remove (Table *t, Node *e) { Node *mp = luaH_mainposition(t, gkey(e)); if (e != mp) { /* element not in its main position? */ while (mp->next != e) mp = mp->next; /* find previous */ mp->next = e->next; /* remove `e' from its list */ } else { if (e->next != NULL) ?? } lua_assert(ttisnil(gval(node))); setnilvalue(gkey(e)); /* clear node `e' */ e->next = NULL; } #endif /* ** inserts a new key into a hash table; first, check whether key's main ** position is free. If not, check whether colliding node is in its main ** position or not: if it is not, move colliding node to an empty place and ** put new key in its main position; otherwise (colliding node is in its main ** position), new key goes to an empty position. */ static TObject *newkey (lua_State *L, Table *t, const TObject *key) { TObject *val; Node *mp = luaH_mainposition(t, key); if (!ttisnil(gval(mp))) { /* main position is not free? */ Node *othern = luaH_mainposition(t, gkey(mp)); /* `mp' of colliding node */ Node *n = t->firstfree; /* get a free place */ if (othern != mp) { /* is colliding node out of its main position? */ /* yes; move colliding node into free position */ while (othern->next != mp) othern = othern->next; /* find previous */ othern->next = n; /* redo the chain with `n' in place of `mp' */ *n = *mp; /* copy colliding node into free pos. (mp->next also goes) */ mp->next = NULL; /* now `mp' is free */ setnilvalue(gval(mp)); } else { /* colliding node is in its own main position */ /* new node will go into free position */ n->next = mp->next; /* chain new position */ mp->next = n; mp = n; } } setobj2t(gkey(mp), key); /* write barrier */ lua_assert(ttisnil(gval(mp))); for (;;) { /* correct `firstfree' */ if (ttisnil(gkey(t->firstfree))) return gval(mp); /* OK; table still has a free place */ else if (t->firstfree == t->node) break; /* cannot decrement from here */ else (t->firstfree)--; } /* no more free places; must create one */ setbvalue(gval(mp), 0); /* avoid new key being removed */ rehash(L, t); /* grow table */ val = cast(TObject *, luaH_get(t, key)); /* get new position */ lua_assert(ttisboolean(val)); setnilvalue(val); return val; } /* ** generic search function */ static const TObject *luaH_getany (Table *t, const TObject *key) { if (ttisnil(key)) return &luaO_nilobject; else { Node *n = luaH_mainposition(t, key); do { /* check whether `key' is somewhere in the chain */ if (luaO_rawequalObj(gkey(n), key)) return gval(n); /* that's it */ else n = n->next; } while (n); return &luaO_nilobject; } } /* ** search function for integers */ const TObject *luaH_getnum (Table *t, int key) { if (1 <= key && key <= t->sizearray) return &t->array[key-1]; else { lua_Number nk = cast(lua_Number, key); Node *n = hashnum(t, nk); do { /* check whether `key' is somewhere in the chain */ if (ttisnumber(gkey(n)) && nvalue(gkey(n)) == nk) return gval(n); /* that's it */ else n = n->next; } while (n); return &luaO_nilobject; } } /* ** search function for strings */ const TObject *luaH_getstr (Table *t, TString *key) { Node *n = hashstr(t, key); do { /* check whether `key' is somewhere in the chain */ if (ttisstring(gkey(n)) && tsvalue(gkey(n)) == key) return gval(n); /* that's it */ else n = n->next; } while (n); return &luaO_nilobject; } /* ** main search function */ const TObject *luaH_get (Table *t, const TObject *key) { switch (ttype(key)) { case LUA_TSTRING: return luaH_getstr(t, tsvalue(key)); case LUA_TNUMBER: { int k; lua_number2int(k, (nvalue(key))); if (cast(lua_Number, k) == nvalue(key)) /* is an integer index? */ return luaH_getnum(t, k); /* use specialized version */ /* else go through */ } default: return luaH_getany(t, key); } } TObject *luaH_set (lua_State *L, Table *t, const TObject *key) { const TObject *p = luaH_get(t, key); t->flags = 0; if (p != &luaO_nilobject) return cast(TObject *, p); else { if (ttisnil(key)) luaG_runerror(L, "table index is nil"); else if (ttisnumber(key) && nvalue(key) != nvalue(key)) luaG_runerror(L, "table index is NaN"); return newkey(L, t, key); } } TObject *luaH_setnum (lua_State *L, Table *t, int key) { const TObject *p = luaH_getnum(t, key); if (p != &luaO_nilobject) return cast(TObject *, p); else { TObject k; setnvalue(&k, cast(lua_Number, key)); return newkey(L, t, &k); } } --- NEW FILE: ldebug.c --- /* ** $Id: ldebug.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Debug Interface ** See Copyright Notice in lua.h */ #include <stdlib.h> #include <string.h> #define ldebug_c #include "lua.h" #include "lapi.h" #include "lcode.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lobject.h" #include "lopcodes.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lvm.h" static const char *getfuncname (CallInfo *ci, const char **name); #define isLua(ci) (!((ci)->state & CI_C)) static int currentpc (CallInfo *ci) { if (!isLua(ci)) return -1; /* function is not a Lua function? */ if (ci->state & CI_HASFRAME) /* function has a frame? */ ci->u.l.savedpc = *ci->u.l.pc; /* use `pc' from there */ /* function's pc is saved */ return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p); } static int currentline (CallInfo *ci) { int pc = currentpc(ci); if (pc < 0) return -1; /* only active lua functions have current-line information */ else return getline(ci_func(ci)->l.p, pc); } void luaG_inithooks (lua_State *L) { CallInfo *ci; for (ci = L->ci; ci != L->base_ci; ci--) /* update all `savedpc's */ currentpc(ci); L->hookinit = 1; } /* ** this function can be called asynchronous (e.g. during a signal) */ LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { if (func == NULL || mask == 0) { /* turn off hooks? */ mask = 0; func = NULL; } L->hook = func; L->basehookcount = count; resethookcount(L); L->hookmask = cast(lu_byte, mask); L->hookinit = 0; return 1; } LUA_API lua_Hook lua_gethook (lua_State *L) { return L->hook; } LUA_API int lua_gethookmask (lua_State *L) { return L->hookmask; } LUA_API int lua_gethookcount (lua_State *L) { return L->basehookcount; } LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { int status; CallInfo *ci; lua_lock(L); for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) { level--; if (!(ci->state & CI_C)) /* Lua function? */ level -= ci->u.l.tailcalls; /* skip lost tail calls */ } if (level > 0 || ci == L->base_ci) status = 0; /* there is no such level */ else if (level < 0) { /* level is of a lost tail call */ status = 1; ar->i_ci = 0; } else { status = 1; ar->i_ci = ci - L->base_ci; } lua_unlock(L); return status; } static Proto *getluaproto (CallInfo *ci) { return (isLua(ci) ? ci_func(ci)->l.p : NULL); } LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { const char *name; CallInfo *ci; Proto *fp; lua_lock(L); name = NULL; ci = L->base_ci + ar->i_ci; fp = getluaproto(ci); if (fp) { /* is a Lua function? */ name = luaF_getlocalname(fp, n, currentpc(ci)); if (name) luaA_pushobject(L, ci->base+(n-1)); /* push value */ } lua_unlock(L); return name; } LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { const char *name; CallInfo *ci; Proto *fp; lua_lock(L); name = NULL; ci = L->base_ci + ar->i_ci; fp = getluaproto(ci); L->top--; /* pop new value */ if (fp) { /* is a Lua function? */ name = luaF_getlocalname(fp, n, currentpc(ci)); if (!name || name[0] == '(') /* `(' starts private locals */ name = NULL; else setobjs2s(ci->base+(n-1), L->top); } lua_unlock(L); return name; } static void funcinfo (lua_Debug *ar, StkId func) { Closure *cl = clvalue(func); if (cl->c.isC) { ar->source = "=[C]"; ar->linedefined = -1; ar->what = "C"; } else { ar->source = getstr(cl->l.p->source); ar->linedefined = cl->l.p->lineDefined; ar->what = (ar->linedefined == 0) ? "main" : "Lua"; } luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); } static const char *travglobals (lua_State *L, const TObject *o) { Table *g = hvalue(gt(L)); int i = sizenode(g); while (i--) { Node *n = gnode(g, i); if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n))) return getstr(tsvalue(gkey(n))); } return NULL; } static void info_tailcall (lua_State *L, lua_Debug *ar) { ar->name = ar->namewhat = ""; ar->what = "tail"; ar->linedefined = ar->currentline = -1; ar->source = "=(tail call)"; luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); ar->nups = 0; setnilvalue(L->top); } static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, StkId f, CallInfo *ci) { int status = 1; for (; *what; what++) { switch (*what) { case 'S': { funcinfo(ar, f); break; } case 'l': { ar->currentline = (ci) ? currentline(ci) : -1; break; } case 'u': { ar->nups = clvalue(f)->c.nupvalues; break; } case 'n': { ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL; if (ar->namewhat == NULL) { /* try to find a global name */ if ((ar->name = travglobals(L, f)) != NULL) ar->namewhat = "global"; else ar->namewhat = ""; /* not found */ } break; } case 'f': { setobj2s(L->top, f); break; } default: status = 0; /* invalid option */ } } return status; } LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { int status = 1; lua_lock(L); if (*what == '>') { StkId f = L->top - 1; if (!ttisfunction(f)) luaG_runerror(L, "value for `lua_getinfo' is not a function"); status = auxgetinfo(L, what + 1, ar, f, NULL); L->top--; /* pop function */ } else if (ar->i_ci != 0) { /* no tail call? */ CallInfo *ci = L->base_ci + ar->i_ci; lua_assert(ttisfunction(ci->base - 1)); status = auxgetinfo(L, what, ar, ci->base - 1, ci); } else info_tailcall(L, ar); if (strchr(what, 'f')) incr_top(L); lua_unlock(L); return status; } /* ** {====================================================== ** Symbolic Execution and code checker ** ======================================================= */ #define check(x) if (!(x)) return 0; #define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode) #define checkreg(pt,reg) check((reg) < (pt)->maxstacksize) static int precheck (const Proto *pt) { check(pt->maxstacksize <= MAXSTACK); check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0); lua_assert(pt->numparams+pt->is_vararg <= pt->maxstacksize); check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN); return 1; } static int checkopenop (const Proto *pt, int pc) { Instruction i = pt->code[pc+1]; switch (GET_OPCODE(i)) { case OP_CALL: case OP_TAILCALL: case OP_RETURN: { check(GETARG_B(i) == 0); return 1; } case OP_SETLISTO: return 1; default: return 0; /* invalid instruction after an open call */ } } static int checkRK (const Proto *pt, int r) { return (r < pt->maxstacksize || (r >= MAXSTACK && r-MAXSTACK < pt->sizek)); } static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) { int pc; int last; /* stores position of last instruction that changed `reg' */ last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */ check(precheck(pt)); for (pc = 0; pc < lastpc; pc++) { const Instruction i = pt->code[pc]; OpCode op = GET_OPCODE(i); int a = GETARG_A(i); int b = 0; int c = 0; checkreg(pt, a); switch (getOpMode(op)) { case iABC: { b = GETARG_B(i); c = GETARG_C(i); if (testOpMode(op, OpModeBreg)) { checkreg(pt, b); } else if (testOpMode(op, OpModeBrk)) check(checkRK(pt, b)); if (testOpMode(op, OpModeCrk)) check(checkRK(pt, c)); break; } case iABx: { b = GETARG_Bx(i); if (testOpMode(op, OpModeK)) check(b < pt->sizek); break; } case iAsBx: { b = GETARG_sBx(i); break; } } if (testOpMode(op, OpModesetA)) { if (a == reg) last = pc; /* change register `a' */ } if (testOpMode(op, OpModeT)) { check(pc+2 < pt->sizecode); /* check skip */ check(GET_OPCODE(pt->code[pc+1]) == OP_JMP); } switch (op) { case OP_LOADBOOL: { check(c == 0 || pc+2 < pt->sizecode); /* check its jump */ break; } case OP_LOADNIL: { if (a <= reg && reg <= b) last = pc; /* set registers from `a' to `b' */ break; } case OP_GETUPVAL: case OP_SETUPVAL: { check(b < pt->nups); break; } case OP_GETGLOBAL: case OP_SETGLOBAL: { check(ttisstring(&pt->k[b])); break; } case OP_SELF: { checkreg(pt, a+1); if (reg == a+1) last = pc; break; } case OP_CONCAT: { /* `c' is a register, and at least two operands */ check(c < MAXSTACK && b < c); break; } case OP_TFORLOOP: checkreg(pt, a+c+5); if (reg >= a) last = pc; /* affect all registers above base */ /* go through */ case OP_FORLOOP: checkreg(pt, a+2); /* go through */ case OP_JMP: { int dest = pc+1+b; check(0 <= dest && dest < pt->sizecode); /* not full check and jump is forward and do not skip `lastpc'? */ if (reg != NO_REG && pc < dest && dest <= lastpc) pc += b; /* do the jump */ break; } case OP_CALL: case OP_TAILCALL: { if (b != 0) { checkreg(pt, a+b-1); } c--; /* c = num. returns */ if (c == LUA_MULTRET) { check(checkopenop(pt, pc)); } else if (c != 0) checkreg(pt, a+c-1); if (reg >= a) last = pc; /* affect all registers above base */ break; } case OP_RETURN: { b--; /* b = num. returns */ if (b > 0) checkreg(pt, a+b-1); break; } case OP_SETLIST: { checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1); break; } case OP_CLOSURE: { int nup; check(b < pt->sizep); nup = pt->p[b]->nups; check(pc + nup < pt->sizecode); for (; nup>0; nup--) { OpCode op1 = GET_OPCODE(pt->code[pc+nup]); check(op1 == OP_GETUPVAL || op1 == OP_MOVE); } break; } default: break; } } return pt->code[last]; } #undef check #undef checkjump #undef checkreg /* }====================================================== */ int luaG_checkcode (const Proto *pt) { return luaG_symbexec(pt, pt->sizecode, NO_REG); } static const char *kname (Proto *p, int c) { c = c - MAXSTACK; if (c >= 0 && ttisstring(&p->k[c])) return svalue(&p->k[c]); else return "?"; } static const char *getobjname (CallInfo *ci, int stackpos, const char **name) { if (isLua(ci)) { /* a Lua function? */ Proto *p = ci_func(ci)->l.p; int pc = currentpc(ci); Instruction i; *name = luaF_getlocalname(p, stackpos+1, pc); if (*name) /* is a local? */ return "local"; i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */ lua_assert(pc != -1); switch (GET_OPCODE(i)) { case OP_GETGLOBAL: { int g = GETARG_Bx(i); /* global index */ lua_assert(ttisstring(&p->k[g])); *name = svalue(&p->k[g]); return "global"; } case OP_MOVE: { int a = GETARG_A(i); int b = GETARG_B(i); /* move from `b' to `a' */ if (b < a) return getobjname(ci, b, name); /* get name for `b' */ break; } case OP_GETTABLE: { int k = GETARG_C(i); /* key index */ *name = kname(p, k); return "field"; } case OP_SELF: { int k = GETARG_C(i); /* key index */ *name = kname(p, k); return "method"; } default: break; } } return NULL; /* no useful name found */ } static const char *getfuncname (CallInfo *ci, const char **name) { Instruction i; if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1)) return NULL; /* calling function is not Lua (or is unknown) */ ci--; /* calling function */ i = ci_func(ci)->l.p->code[currentpc(ci)]; if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL) return getobjname(ci, GETARG_A(i), name); else return NULL; /* no useful name can be found */ } /* only ANSI way to check whether a pointer points to an array */ static int isinstack (CallInfo *ci, const TObject *o) { StkId p; for (p = ci->base; p < ci->top; p++) if (o == p) return 1; return 0; } void luaG_typeerror (lua_State *L, const TObject *o, const char *op) { const char *name = NULL; const char *t = luaT_typenames[ttype(o)]; const char *kind = (isinstack(L->ci, o)) ? getobjname(L->ci, o - L->base, &name) : NULL; if (kind) luaG_runerror(L, "attempt to %s %s `%s' (a %s value)", op, kind, name, t); else luaG_runerror(L, "attempt to %s a %s value", op, t); } void luaG_concaterror (lua_State *L, StkId p1, StkId p2) { if (ttisstring(p1)) p1 = p2; lua_assert(!ttisstring(p1)); luaG_typeerror(L, p1, "concatenate"); } void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2) { TObject temp; if (luaV_tonumber(p1, &temp) == NULL) p2 = p1; /* first operand is wrong */ luaG_typeerror(L, p2, "perform arithmetic on"); } int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) { const char *t1 = luaT_typenames[ttype(p1)]; const char *t2 = luaT_typenames[ttype(p2)]; if (t1[2] == t2[2]) luaG_runerror(L, "attempt to compare two %s values", t1); else luaG_runerror(L, "attempt to compare %s with %s", t1, t2); return 0; } static void addinfo (lua_State *L, const char *msg) { CallInfo *ci = L->ci; if (isLua(ci)) { /* is Lua code? */ char buff[LUA_IDSIZE]; /* add file:line information */ int line = currentline(ci); luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE); luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); } } void luaG_errormsg (lua_State *L) { if (L->errfunc != 0) { /* is there an error handling function? */ StkId errfunc = restorestack(L, L->errfunc); if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); setobjs2s(L->top, L->top - 1); /* move argument */ setobjs2s(L->top - 1, errfunc); /* push function */ incr_top(L); luaD_call(L, L->top - 2, 1); /* call it */ } luaD_throw(L, LUA_ERRRUN); } void luaG_runerror (lua_State *L, const char *fmt, ...) { va_list argp; va_start(argp, fmt); addinfo(L, luaO_pushvfstring(L, fmt, argp)); va_end(argp); luaG_errormsg(L); } --- NEW FILE: lobject.h --- /* ** $Id: lobject.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Type definitions for Lua objects ** See Copyright Notice in lua.h */ #ifndef lobject_h #define lobject_h #include "llimits.h" #include "lua.h" /* tags for values visible from Lua */ #define NUM_TAGS LUA_TTHREAD /* ** Extra tags for non-values */ #define LUA_TPROTO (NUM_TAGS+1) #define LUA_TUPVAL (NUM_TAGS+2) /* ** Union of all collectable objects */ typedef union GCObject GCObject; /* ** Common Header for all collectable objects (in macro form, to be ** included in other objects) */ #define CommonHeader GCObject *next; lu_byte tt; lu_byte marked /* ** Common header in struct form */ typedef struct GCheader { CommonHeader; } GCheader; /* ** Union of all Lua values */ typedef union { GCObject *gc; void *p; lua_Number n; int b; } Value; /* ** Lua values (or `tagged objects') */ typedef struct lua_TObject { int tt; Value value; } TObject; /* Macros to test type */ #define ttisnil(o) (ttype(o) == LUA_TNIL) #define ttisnumber(o) (ttype(o) == LUA_TNUMBER) #define ttisstring(o) (ttype(o) == LUA_TSTRING) #define ttistable(o) (ttype(o) == LUA_TTABLE) #define ttisfunction(o) (ttype(o) == LUA_TFUNCTION) #define ttisboolean(o) (ttype(o) == LUA_TBOOLEAN) #define ttisuserdata(o) (ttype(o) == LUA_TUSERDATA) #define ttisthread(o) (ttype(o) == LUA_TTHREAD) #define ttislightuserdata(o) (ttype(o) == LUA_TLIGHTUSERDATA) /* Macros to access values */ #define ttype(o) ((o)->tt) #define gcvalue(o) check_exp(iscollectable(o), (o)->value.gc) #define pvalue(o) check_exp(ttislightuserdata(o), (o)->value.p) #define nvalue(o) check_exp(ttisnumber(o), (o)->value.n) #define tsvalue(o) check_exp(ttisstring(o), &(o)->value.gc->ts) #define uvalue(o) check_exp(ttisuserdata(o), &(o)->value.gc->u) #define clvalue(o) check_exp(ttisfunction(o), &(o)->value.gc->cl) #define hvalue(o) check_exp(ttistable(o), &(o)->value.gc->h) #define bvalue(o) check_exp(ttisboolean(o), (o)->value.b) #define thvalue(o) check_exp(ttisthread(o), &(o)->value.gc->th) #define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0)) /* Macros to set values */ #define setnvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TNUMBER; i_o->value.n=(x); } #define chgnvalue(obj,x) \ check_exp(ttype(obj)==LUA_TNUMBER, (obj)->value.n=(x)) #define setpvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TLIGHTUSERDATA; i_o->value.p=(x); } #define setbvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TBOOLEAN; i_o->value.b=(x); } #define setsvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TSTRING; \ i_o->value.gc=cast(GCObject *, (x)); \ lua_assert(i_o->value.gc->gch.tt == LUA_TSTRING); } #define setuvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TUSERDATA; \ i_o->value.gc=cast(GCObject *, (x)); \ lua_assert(i_o->value.gc->gch.tt == LUA_TUSERDATA); } #define setthvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TTHREAD; \ i_o->value.gc=cast(GCObject *, (x)); \ lua_assert(i_o->value.gc->gch.tt == LUA_TTHREAD); } #define setclvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; \ i_o->value.gc=cast(GCObject *, (x)); \ lua_assert(i_o->value.gc->gch.tt == LUA_TFUNCTION); } #define sethvalue(obj,x) \ { TObject *i_o=(obj); i_o->tt=LUA_TTABLE; \ i_o->value.gc=cast(GCObject *, (x)); \ lua_assert(i_o->value.gc->gch.tt == LUA_TTABLE); } #define setnilvalue(obj) ((obj)->tt=LUA_TNIL) /* ** for internal debug only */ #define checkconsistency(obj) \ lua_assert(!iscollectable(obj) || (ttype(obj) == (obj)->value.gc->gch.tt)) #define setobj(obj1,obj2) \ { const TObject *o2=(obj2); TObject *o1=(obj1); \ checkconsistency(o2); \ o1->tt=o2->tt; o1->value = o2->value; } /* ** different types of sets, according to destination */ /* from stack to (same) stack */ #define setobjs2s setobj /* to stack (not from same stack) */ #define setobj2s setobj #define setsvalue2s setsvalue /* from table to same table */ #define setobjt2t setobj /* to table */ #define setobj2t setobj /* to new object */ #define setobj2n setobj #define setsvalue2n setsvalue #define setttype(obj, tt) (ttype(obj) = (tt)) #define iscollectable(o) (ttype(o) >= LUA_TSTRING) typedef TObject *StkId; /* index to stack elements */ /* ** String headers for string table */ typedef union TString { L_Umaxalign dummy; /* ensures maximum alignment for strings */ struct { CommonHeader; lu_byte reserved; lu_hash hash; size_t len; } tsv; } TString; #define getstr(ts) cast(const char *, (ts) + 1) #define svalue(o) getstr(tsvalue(o)) typedef union Udata { L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */ struct { CommonHeader; struct Table *metatable; size_t len; } uv; } Udata; /* ** Function Prototypes */ typedef struct Proto { CommonHeader; TObject *k; /* constants used by the function */ Instruction *code; struct Proto **p; /* functions defined inside the function */ int *lineinfo; /* map from opcodes to source lines */ struct LocVar *locvars; /* information about local variables */ TString **upvalues; /* upvalue names */ TString *source; int sizeupvalues; int sizek; /* size of `k' */ int sizecode; int sizelineinfo; int sizep; /* size of `p' */ int sizelocvars; int lineDefined; GCObject *gclist; lu_byte nups; /* number of upvalues */ lu_byte numparams; lu_byte is_vararg; lu_byte maxstacksize; } Proto; typedef struct LocVar { TString *varname; int startpc; /* first point where variable is active */ int endpc; /* first point where variable is dead */ } LocVar; /* ** Upvalues */ typedef struct UpVal { CommonHeader; TObject *v; /* points to stack or to its own value */ TObject value; /* the value (when closed) */ } UpVal; /* ** Closures */ #define ClosureHeader \ CommonHeader; lu_byte isC; lu_byte nupvalues; GCObject *gclist typedef struct CClosure { ClosureHeader; lua_CFunction f; TObject upvalue[1]; } CClosure; typedef struct LClosure { ClosureHeader; struct Proto *p; TObject g; /* global table for this closure */ UpVal *upvals[1]; } LClosure; typedef union Closure { CClosure c; LClosure l; } Closure; #define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->c.isC) #define isLfunction(o) (ttype(o) == LUA_TFUNCTION && !clvalue(o)->c.isC) /* ** Tables */ typedef struct Node { TObject i_key; TObject i_val; struct Node *next; /* for chaining */ } Node; typedef struct Table { CommonHeader; lu_byte flags; /* 1<<p means tagmethod(p) is not present */ lu_byte lsizenode; /* log2 of size of `node' array */ struct Table *metatable; TObject *array; /* array part */ Node *node; Node *firstfree; /* this position is free; all positions after it are full */ GCObject *gclist; int sizearray; /* size of `array' array */ } Table; /* ** `module' operation for hashing (size is always a power of 2) */ #define lmod(s,size) \ check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1)))) #define twoto(x) (1<<(x)) #define sizenode(t) (twoto((t)->lsizenode)) extern const TObject luaO_nilobject; int luaO_log2 (unsigned int x); int luaO_int2fb (unsigned int x); #define fb2int(x) (((x) & 7) << ((x) >> 3)) int luaO_rawequalObj (const TObject *t1, const TObject *t2); int luaO_str2d (const char *s, lua_Number *result); const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp); const char *luaO_pushfstring (lua_State *L, const char *fmt, ...); void luaO_chunkid (char *out, const char *source, int len); #endif --- NEW FILE: lundump.c --- /* ** $Id: lundump.c,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** load pre-compiled Lua chunks ** See Copyright Notice in lua.h */ #define lundump_c #include "lua.h" #include "ldebug.h" #include "lfunc.h" #include "lmem.h" #include "lopcodes.h" #include "lstring.h" #include "lundump.h" #include "lzio.h" #define LoadByte (lu_byte) ezgetc typedef struct { lua_State* L; ZIO* Z; Mbuffer* b; int swap; const char* name; } LoadState; static void unexpectedEOZ (LoadState* S) { luaG_runerror(S->L,"unexpected end of file in %s",S->name); } static int ezgetc (LoadState* S) { int c=zgetc(S->Z); if (c==EOZ) unexpectedEOZ(S); return c; } static void ezread (LoadState* S, void* b, int n) { int r=luaZ_read(S->Z,b,n); if (r!=0) unexpectedEOZ(S); } static void LoadBlock (LoadState* S, void* b, size_t size) { if (S->swap) { char* p=(char*) b+size-1; int n=size; while (n--) *p--=(char)ezgetc(S); } else ezread(S,b,size); } static void LoadVector (LoadState* S, void* b, int m, size_t size) { if (S->swap) { char* q=(char*) b; while (m--) { char* p=q+size-1; int n=size; while (n--) *p--=(char)ezgetc(S); q+=size; } } else ezread(S,b,m*size); } static int LoadInt (LoadState* S) { int x; LoadBlock(S,&x,sizeof(x)); if (x<0) luaG_runerror(S->L,"bad integer in %s",S->name); return x; } static size_t LoadSize (LoadState* S) { size_t x; LoadBlock(S,&x,sizeof(x)); return x; } static lua_Number LoadNumber (LoadState* S) { lua_Number x; LoadBlock(S,&x,sizeof(x)); return x; } static TString* LoadString (LoadState* S) { size_t size=LoadSize(S); if (size==0) return NULL; else { char* s=luaZ_openspace(S->L,S->b,size); ezread(S,s,size); return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */ } } static void LoadCode (LoadState* S, Proto* f) { int size=LoadInt(S); f->code=luaM_newvector(S->L,size,Instruction); f->sizecode=size; LoadVector(S,f->code,size,sizeof(*f->code)); } static void LoadLocals (LoadState* S, Proto* f) { int i,n; n=LoadInt(S); f->locvars=luaM_newvector(S->L,n,LocVar); f->sizelocvars=n; for (i=0; i<n; i++) { f->locvars[i].varname=LoadString(S); f->locvars[i].startpc=LoadInt(S); f->locvars[i].endpc=LoadInt(S); } } static void LoadLines (LoadState* S, Proto* f) { int size=LoadInt(S); f->lineinfo=luaM_newvector(S->L,size,int); f->sizelineinfo=size; LoadVector(S,f->lineinfo,size,sizeof(*f->lineinfo)); } static void LoadUpvalues (LoadState* S, Proto* f) { int i,n; n=LoadInt(S); if (n!=0 && n!=f->nups) luaG_runerror(S->L,"bad nupvalues in %s: read %d; expected %d", S->name,n,f->nups); f->upvalues=luaM_newvector(S->L,n,TString*); f->sizeupvalues=n; for (i=0; i<n; i++) f->upvalues[i]=LoadString(S); } static Proto* LoadFunction (LoadState* S, TString* p); static void LoadConstants (LoadState* S, Proto* f) { int i,n; n=LoadInt(S); f->k=luaM_newvector(S->L,n,TObject); f->sizek=n; for (i=0; i<n; i++) { TObject* o=&f->k[i]; int t=LoadByte(S); switch (t) { case LUA_TNUMBER: setnvalue(o,LoadNumber(S)); break; case LUA_TSTRING: setsvalue2n(o,LoadString(S)); break; case LUA_TNIL: setnilvalue(o); break; default: luaG_runerror(S->L,"bad constant type (%d) in %s",t,S->name); break; } } n=LoadInt(S); f->p=luaM_newvector(S->L,n,Proto*); f->sizep=n; for (i=0; i<n; i++) f->p[i]=LoadFunction(S,f->source); } static Proto* LoadFunction (LoadState* S, TString* p) { Proto* f=luaF_newproto(S->L); f->source=LoadString(S); if (f->source==NULL) f->source=p; f->lineDefined=LoadInt(S); f->nups=LoadByte(S); f->numparams=LoadByte(S); f->is_vararg=LoadByte(S); f->maxstacksize=LoadByte(S); LoadLines(S,f); LoadLocals(S,f); LoadUpvalues(S,f); LoadConstants(S,f); LoadCode(S,f); #ifndef TRUST_BINARIES if (!luaG_checkcode(f)) luaG_runerror(S->L,"bad code in %s",S->name); #endif return f; } static void LoadSignature (LoadState* S) { const char* s=LUA_SIGNATURE; while (*s!=0 && ezgetc(S)==*s) ++s; if (*s!=0) luaG_runerror(S->L,"bad signature in %s",S->name); } static void TestSize (LoadState* S, int s, const char* what) { int r=LoadByte(S); if (r!=s) luaG_runerror(S->L,"virtual machine mismatch in %s: " "size of %s is %d but read %d",S->name,what,s,r); } #define TESTSIZE(s,w) TestSize(S,s,w) #define V(v) v/16,v%16 static void LoadHeader (LoadState* S) { int version; lua_Number x,tx=TEST_NUMBER; LoadSignature(S); version=LoadByte(S); if (version>VERSION) luaG_runerror(S->L,"%s too new: " "read version %d.%d; expected at most %d.%d", S->name,V(version),V(VERSION)); if (version<VERSION0) /* check last major change */ luaG_runerror(S->L,"%s too old: " "read version %d.%d; expected at least %d.%d", S->name,V(version),V(VERSION0)); S->swap=(luaU_endianness()!=LoadByte(S)); /* need to swap bytes? */ TESTSIZE(sizeof(int),"int"); TESTSIZE(sizeof(size_t), "size_t"); TESTSIZE(sizeof(Instruction), "Instruction"); TESTSIZE(SIZE_OP, "OP"); TESTSIZE(SIZE_A, "A"); TESTSIZE(SIZE_B, "B"); TESTSIZE(SIZE_C, "C"); TESTSIZE(sizeof(lua_Number), "number"); x=LoadNumber(S); if ((long)x!=(long)tx) /* disregard errors in last bits of fraction */ luaG_runerror(S->L,"unknown number format in %s",S->name); } static Proto* LoadChunk (LoadState* S) { LoadHeader(S); return LoadFunction(S,NULL); } /* ** load precompiled chunk */ Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff) { LoadState S; const char* s=zname(Z); if (*s=='@' || *s=='=') S.name=s+1; else if (*s==LUA_SIGNATURE[0]) S.name="binary string"; else S.name=s; S.L=L; S.Z=Z; S.b=buff; return LoadChunk(&S); } /* ** find byte order */ int luaU_endianness (void) { int x=1; return *(char*)&x; } --- NEW FILE: lundump.h --- /* ** $Id: lundump.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** load pre-compiled Lua chunks ** See Copyright Notice in lua.h */ #ifndef lundump_h #define lundump_h #include "lobject.h" #include "lzio.h" /* load one chunk; from lundump.c */ Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff); /* find byte order; from lundump.c */ int luaU_endianness (void); /* dump one chunk; from ldump.c */ void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data); /* print one chunk; from print.c */ void luaU_print (const Proto* Main); /* definitions for headers of binary files */ #define LUA_SIGNATURE "\033Lua" /* binary files start with "<esc>Lua" */ #define VERSION 0x50 /* last format change was in 5.0 */ #define VERSION0 0x50 /* last major change was in 5.0 */ /* a multiple of PI for testing native format */ /* multiplying by 1E7 gives non-trivial integer values */ #define TEST_NUMBER ((lua_Number)3.14159265358979323846E7) #endif --- NEW FILE: lopcodes.h --- /* ** $Id: lopcodes.h,v 1.1 2005/06/06 23:06:16 jrl1 Exp $ ** Opcodes for Lua virtual machine ** See Copyright Notice in lua.h */ #ifndef lopcodes_h #define lopcodes_h #include "llimits.h" /*=========================================================================== We assume that instructions are unsigned numbers. All instructions have an opcode in the first 6 bits. Instructions can have the following fields: `A' : 8 bits `B' : 9 bits `C' : 9 bits `Bx' : 18 bits (`B' and `C' together) `sBx' : signed Bx A signed argument is represented in excess K; that is, the number value is the unsigned value minus K. K is exactly the maximum value for that argument (so that -max is represented by 0, and +max is represented by 2*max), which is half the maximum for the corresponding unsigned argument. ===========================================================================*/ enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */ /* ** size and position of opcode arguments. */ #define SIZE_C 9 #define SIZE_B 9 #define SIZE_Bx (SIZE_C + SIZE_B) #define SIZE_A 8 #define SIZE_OP 6 #define POS_C SIZE_OP #define POS_B (POS_C + SIZE_C) #define POS_Bx POS_C #define POS_A (POS_B + SIZE_B) /* ** limits for opcode arguments. ** we use (signed) int to manipulate most arguments, ** so they must fit in BITS_INT-1 bits (-1 for sign) */ #if SIZE_Bx < BITS_INT-1 #define MAXARG_Bx ((1<<SIZE_Bx)-1) #define MAXARG_sBx (MAXARG_Bx>>1) /* `sBx' is signed */ #else #define MAXARG_Bx MAX_INT #define MAXARG_sBx MAX_INT #endif #define MAXARG_A ((1<<SIZE_A)-1) #define MAXARG_B ((1<<SIZE_B)-1) #define MAXARG_C ((1<<SIZE_C)-1) /* creates a mask with `n' 1 bits at position `p' */ #define MASK1(n,p) ((~((~(Instruction)0)<<n))<<p) /* creates a mask with `n' 0 bits at position `p' */ #define MASK0(n,p) (~MASK1(n,p)) /* ** the following macros help to manipulate instructions */ #define GET_OPCODE(i) (cast(OpCode, (i)&MASK1(SIZE_OP,0))) #define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | cast(Instruction, o))) #define GETARG_A(i) (cast(int, (i)>>POS_A)) #define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \ ((cast(Instruction, u)<<POS_A)&MASK1(SIZE_A,POS_A)))) #define GETARG_B(i) (cast(int, ((i)>>POS_B) & MASK1(SIZE_B,0))) #define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \ ((cast(Instruction, b)<<POS_B)&MASK1(SIZE_B,POS_B)))) #define GETARG_C(i) (cast(int, ((i)>>POS_C) & MASK1(SIZE_C,0))) #define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \ ((cast(Instruction, b)<<POS_C)&MASK1(SIZE_C,POS_C)))) #define GETARG_Bx(i) (cast(int, ((i)>>POS_Bx) & MASK1(SIZE_Bx,0))) #define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) | \ ((cast(Instruction, b)<<POS_Bx)&MASK1(SIZE_Bx,POS_Bx)))) #define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx) #define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx)) #define CREATE_ABC(o,a,b,c) (cast(Instruction, o) \ | (cast(Instruction, a)<<POS_A) \ | (cast(Instruction, b)<<POS_B) \ | (cast(Instruction, c)<<POS_C)) #define CREATE_ABx(o,a,bc) (cast(Instruction, o) \ | (cast(Instruction, a)<<POS_A) \ | (cast(Instruction, bc)<<POS_Bx)) /* ** invalid register that fits in 8 bits */ #define NO_REG MAXARG_A /* ** R(x) - register ** Kst(x) - constant (in constant table) ** RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK) */ /* ** grep "ORDER OP" if you change these enums */ typedef enum { /*---------------------------------------------------------------------- name args description ------------------------------------------------------------------------*/ OP_MOVE,/* A B R(A) := R(B) */ OP_LOADK,/* A Bx R(A) := Kst(Bx) */ OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) PC++ */ OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */ OP_GETUPVAL,/* A B R(A) := UpValue[B] */ OP_GETGLOBAL,/* A Bx R(A) := Gbl[Kst(Bx)] */ OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */ OP_SETGLOBAL,/* A Bx Gbl[Kst(Bx)] := R(A) */ OP_SETUPVAL,/* A B UpValue[B] := R(A) */ OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */ OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */ OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */ OP_ADD,/* A B C R(A) := RK(B) + RK(C) */ OP_SUB,/* A B C R(A) := RK(B) - RK(C) */ OP_MUL,/* A B C R(A) := RK(B) * RK(C) */ OP_DIV,/* A B C R(A) := RK(B) / RK(C) */ OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */ OP_UNM,/* A B R(A) := -R(B) */ OP_NOT,/* A B R(A) := not R(B) */ OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */ OP_JMP,/* sBx PC += sBx */ OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */ OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */ OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */ OP_TEST,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */ OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-... [truncated message content] |