--- /dev/null
+# Makefile for building Lua
+# See ../doc/readme.html for installation and customization instructions.
+
+# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
+
+# Your platform. See PLATS for possible values.
+PLAT= none
+
+CC= gcc
+CFLAGS= -O2 -Wall -DLUA_COMPAT_ALL $(SYSCFLAGS) $(MYCFLAGS)
+LDFLAGS= $(SYSLDFLAGS) $(MYLDFLAGS)
+LIBS= -lm $(SYSLIBS) $(MYLIBS)
+
+AR= ar rcu
+RANLIB= ranlib
+RM= rm -f
+
+SYSCFLAGS=
+SYSLDFLAGS=
+SYSLIBS=
+
+MYCFLAGS=
+MYLDFLAGS=
+MYLIBS=
+MYOBJS=
+
+# == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE =======
+
+PLATS= aix ansi bsd freebsd generic linux macosx mingw posix solaris
+
+LUA_A= liblua.a
+CORE_O= lapi.o lcode.o lctype.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 \
+ ltm.o lundump.o lvm.o lzio.o
+LIB_O= lauxlib.o lbaselib.o lbitlib.o lcorolib.o ldblib.o liolib.o \
+ lmathlib.o loslib.o lstrlib.o ltablib.o loadlib.o linit.o
+BASE_O= $(CORE_O) $(LIB_O) $(MYOBJS)
+
+LUA_T= lua
+LUA_O= lua.o
+
+LUAC_T= luac
+LUAC_O= luac.o
+
+ALL_O= $(BASE_O) $(LUA_O) $(LUAC_O)
+ALL_T= $(LUA_A) $(LUA_T) $(LUAC_T)
+ALL_A= $(LUA_A)
+
+# Targets start here.
+default: $(PLAT)
+
+all: $(ALL_T)
+
+o: $(ALL_O)
+
+a: $(ALL_A)
+
+$(LUA_A): $(BASE_O)
+ $(AR) $@ $(BASE_O)
+ $(RANLIB) $@
+
+$(LUA_T): $(LUA_O) $(LUA_A)
+ $(CC) -o $@ $(LDFLAGS) $(LUA_O) $(LUA_A) $(LIBS)
+
+$(LUAC_T): $(LUAC_O) $(LUA_A)
+ $(CC) -o $@ $(LDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS)
+
+clean:
+ $(RM) $(ALL_T) $(ALL_O)
+
+depend:
+ @$(CC) $(CFLAGS) -MM l*.c
+
+echo:
+ @echo "PLAT= $(PLAT)"
+ @echo "CC= $(CC)"
+ @echo "CFLAGS= $(CFLAGS)"
+ @echo "LDFLAGS= $(SYSLDFLAGS)"
+ @echo "LIBS= $(LIBS)"
+ @echo "AR= $(AR)"
+ @echo "RANLIB= $(RANLIB)"
+ @echo "RM= $(RM)"
+
+# Convenience targets for popular platforms
+ALL= all
+
+none:
+ @echo "Please do 'make PLATFORM' where PLATFORM is one of these:"
+ @echo " $(PLATS)"
+
+aix:
+ $(MAKE) $(ALL) CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl" SYSLDFLAGS="-brtl -bexpall"
+
+ansi:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_ANSI"
+
+bsd:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-Wl,-E"
+
+freebsd:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -lreadline"
+
+generic: $(ALL)
+
+linux:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl -lreadline"
+
+macosx:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX" SYSLIBS="-lreadline"
+
+mingw:
+ $(MAKE) "LUA_A=lua52.dll" "LUA_T=lua.exe" \
+ "AR=$(CC) -shared -o" "RANLIB=strip --strip-unneeded" \
+ "SYSCFLAGS=-DLUA_BUILD_AS_DLL" "SYSLIBS=" "SYSLDFLAGS=-s" lua.exe
+ $(MAKE) "LUAC_T=luac.exe" luac.exe
+
+posix:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX"
+
+solaris:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl"
+
+# list targets that do not create files (but not all makes understand .PHONY)
+.PHONY: all $(PLATS) default o a clean depend echo none
+
+# DO NOT DELETE
+
+lapi.o: lapi.c lua.h luaconf.h lapi.h llimits.h lstate.h lobject.h ltm.h \
+ lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h ltable.h lundump.h \
+ lvm.h
+lauxlib.o: lauxlib.c lua.h luaconf.h lauxlib.h
+lbaselib.o: lbaselib.c lua.h luaconf.h lauxlib.h lualib.h
+lbitlib.o: lbitlib.c lua.h luaconf.h lauxlib.h lualib.h
+lcode.o: lcode.c lua.h luaconf.h lcode.h llex.h lobject.h llimits.h \
+ lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h ldo.h lgc.h \
+ lstring.h ltable.h lvm.h
+lcorolib.o: lcorolib.c lua.h luaconf.h lauxlib.h lualib.h
+lctype.o: lctype.c lctype.h lua.h luaconf.h llimits.h
+ldblib.o: ldblib.c lua.h luaconf.h lauxlib.h lualib.h
+ldebug.o: ldebug.c lua.h luaconf.h lapi.h llimits.h lstate.h lobject.h \
+ ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h ldebug.h ldo.h \
+ lfunc.h lstring.h lgc.h ltable.h lvm.h
+ldo.o: ldo.c lua.h luaconf.h lapi.h llimits.h lstate.h lobject.h ltm.h \
+ lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h lparser.h \
+ lstring.h ltable.h lundump.h lvm.h
+ldump.o: ldump.c lua.h luaconf.h lobject.h llimits.h lstate.h ltm.h \
+ lzio.h lmem.h lundump.h
+lfunc.o: lfunc.c lua.h luaconf.h lfunc.h lobject.h llimits.h lgc.h \
+ lstate.h ltm.h lzio.h lmem.h
+lgc.o: lgc.c lua.h luaconf.h ldebug.h lstate.h lobject.h llimits.h ltm.h \
+ lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h
+linit.o: linit.c lua.h luaconf.h lualib.h lauxlib.h
+liolib.o: liolib.c lua.h luaconf.h lauxlib.h lualib.h
+llex.o: llex.c lua.h luaconf.h lctype.h llimits.h ldo.h lobject.h \
+ lstate.h ltm.h lzio.h lmem.h llex.h lparser.h lstring.h lgc.h ltable.h
+lmathlib.o: lmathlib.c lua.h luaconf.h lauxlib.h lualib.h
+lmem.o: lmem.c lua.h luaconf.h ldebug.h lstate.h lobject.h llimits.h \
+ ltm.h lzio.h lmem.h ldo.h lgc.h
+loadlib.o: loadlib.c lua.h luaconf.h lauxlib.h lualib.h
+lobject.o: lobject.c lua.h luaconf.h lctype.h llimits.h ldebug.h lstate.h \
+ lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h lvm.h
+lopcodes.o: lopcodes.c lopcodes.h llimits.h lua.h luaconf.h
+loslib.o: loslib.c lua.h luaconf.h lauxlib.h lualib.h
+lparser.o: lparser.c lua.h luaconf.h lcode.h llex.h lobject.h llimits.h \
+ lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h ldo.h lfunc.h \
+ lstring.h lgc.h ltable.h
+lstate.o: lstate.c lua.h luaconf.h lapi.h llimits.h lstate.h lobject.h \
+ ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h lstring.h \
+ ltable.h
+lstring.o: lstring.c lua.h luaconf.h lmem.h llimits.h lobject.h lstate.h \
+ ltm.h lzio.h lstring.h lgc.h
+lstrlib.o: lstrlib.c lua.h luaconf.h lauxlib.h lualib.h
+ltable.o: ltable.c lua.h luaconf.h ldebug.h lstate.h lobject.h llimits.h \
+ ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
+ltablib.o: ltablib.c lua.h luaconf.h lauxlib.h lualib.h
+ltm.o: ltm.c lua.h luaconf.h lobject.h llimits.h lstate.h ltm.h lzio.h \
+ lmem.h lstring.h lgc.h ltable.h
+lua.o: lua.c lua.h luaconf.h lauxlib.h lualib.h
+luac.o: luac.c lua.h luaconf.h lauxlib.h lobject.h llimits.h lstate.h \
+ ltm.h lzio.h lmem.h lundump.h ldebug.h lopcodes.h
+lundump.o: lundump.c lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h lundump.h
+lvm.o: lvm.c lua.h luaconf.h ldebug.h lstate.h lobject.h llimits.h ltm.h \
+ lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h ltable.h lvm.h
+lzio.o: lzio.c lua.h luaconf.h llimits.h lmem.h lstate.h lobject.h ltm.h \
+ lzio.h
+
--- /dev/null
+/*
+** $Id: lapi.c,v 2.171 2013/03/16 21:10:18 roberto Exp $
+** Lua API
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdarg.h>
+#include <string.h>
+
+#define lapi_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lundump.h"
+#include "lvm.h"
+
+
+
+const char lua_ident[] =
+ "$LuaVersion: " LUA_COPYRIGHT " $"
+ "$LuaAuthors: " LUA_AUTHORS " $";
+
+
+/* value at a non-valid index */
+#define NONVALIDVALUE cast(TValue *, luaO_nilobject)
+
+/* corresponding test */
+#define isvalid(o) ((o) != luaO_nilobject)
+
+/* test for pseudo index */
+#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)
+
+/* test for valid but not pseudo index */
+#define isstackindex(i, o) (isvalid(o) && !ispseudo(i))
+
+#define api_checkvalidindex(L, o) api_check(L, isvalid(o), "invalid index")
+
+#define api_checkstackindex(L, i, o) \
+ api_check(L, isstackindex(i, o), "index not in the stack")
+
+
+static TValue *index2addr (lua_State *L, int idx) {
+ CallInfo *ci = L->ci;
+ if (idx > 0) {
+ TValue *o = ci->func + idx;
+ api_check(L, idx <= ci->top - (ci->func + 1), "unacceptable index");
+ if (o >= L->top) return NONVALIDVALUE;
+ else return o;
+ }
+ else if (!ispseudo(idx)) { /* negative index */
+ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
+ return L->top + idx;
+ }
+ else if (idx == LUA_REGISTRYINDEX)
+ return &G(L)->l_registry;
+ else { /* upvalues */
+ idx = LUA_REGISTRYINDEX - idx;
+ api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large");
+ if (ttislcf(ci->func)) /* light C function? */
+ return NONVALIDVALUE; /* it has no upvalues */
+ else {
+ CClosure *func = clCvalue(ci->func);
+ return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : NONVALIDVALUE;
+ }
+ }
+}
+
+
+/*
+** to be called by 'lua_checkstack' in protected mode, to grow stack
+** capturing memory errors
+*/
+static void growstack (lua_State *L, void *ud) {
+ int size = *(int *)ud;
+ luaD_growstack(L, size);
+}
+
+
+LUA_API int lua_checkstack (lua_State *L, int size) {
+ int res;
+ CallInfo *ci = L->ci;
+ lua_lock(L);
+ if (L->stack_last - L->top > size) /* stack large enough? */
+ res = 1; /* yes; check is OK */
+ else { /* no; need to grow stack */
+ int inuse = cast_int(L->top - L->stack) + EXTRA_STACK;
+ if (inuse > LUAI_MAXSTACK - size) /* can grow without overflow? */
+ res = 0; /* no */
+ else /* try to grow stack */
+ res = (luaD_rawrunprotected(L, &growstack, &size) == LUA_OK);
+ }
+ if (res && ci->top < L->top + size)
+ ci->top = L->top + size; /* adjust frame top */
+ lua_unlock(L);
+ return res;
+}
+
+
+LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {
+ int i;
+ if (from == to) return;
+ lua_lock(to);
+ api_checknelems(from, n);
+ api_check(from, G(from) == G(to), "moving among independent states");
+ api_check(from, to->ci->top - to->top >= n, "not enough elements to move");
+ from->top -= n;
+ for (i = 0; i < n; i++) {
+ setobj2s(to, to->top++, from->top + i);
+ }
+ lua_unlock(to);
+}
+
+
+LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
+ lua_CFunction old;
+ lua_lock(L);
+ old = G(L)->panic;
+ G(L)->panic = panicf;
+ lua_unlock(L);
+ return old;
+}
+
+
+LUA_API const lua_Number *lua_version (lua_State *L) {
+ static const lua_Number version = LUA_VERSION_NUM;
+ if (L == NULL) return &version;
+ else return G(L)->version;
+}
+
+
+
+/*
+** basic stack manipulation
+*/
+
+
+/*
+** convert an acceptable stack index into an absolute index
+*/
+LUA_API int lua_absindex (lua_State *L, int idx) {
+ return (idx > 0 || ispseudo(idx))
+ ? idx
+ : cast_int(L->top - L->ci->func + idx);
+}
+
+
+LUA_API int lua_gettop (lua_State *L) {
+ return cast_int(L->top - (L->ci->func + 1));
+}
+
+
+LUA_API void lua_settop (lua_State *L, int idx) {
+ StkId func = L->ci->func;
+ lua_lock(L);
+ if (idx >= 0) {
+ api_check(L, idx <= L->stack_last - (func + 1), "new top too large");
+ while (L->top < (func + 1) + idx)
+ setnilvalue(L->top++);
+ L->top = (func + 1) + idx;
+ }
+ else {
+ api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");
+ L->top += idx+1; /* `subtract' index (index is negative) */
+ }
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_remove (lua_State *L, int idx) {
+ StkId p;
+ lua_lock(L);
+ p = index2addr(L, idx);
+ api_checkstackindex(L, idx, p);
+ while (++p < L->top) setobjs2s(L, p-1, p);
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_insert (lua_State *L, int idx) {
+ StkId p;
+ StkId q;
+ lua_lock(L);
+ p = index2addr(L, idx);
+ api_checkstackindex(L, idx, p);
+ for (q = L->top; q > p; q--) /* use L->top as a temporary */
+ setobjs2s(L, q, q - 1);
+ setobjs2s(L, p, L->top);
+ lua_unlock(L);
+}
+
+
+static void moveto (lua_State *L, TValue *fr, int idx) {
+ TValue *to = index2addr(L, idx);
+ api_checkvalidindex(L, to);
+ setobj(L, to, fr);
+ if (idx < LUA_REGISTRYINDEX) /* function upvalue? */
+ luaC_barrier(L, clCvalue(L->ci->func), fr);
+ /* LUA_REGISTRYINDEX does not need gc barrier
+ (collector revisits it before finishing collection) */
+}
+
+
+LUA_API void lua_replace (lua_State *L, int idx) {
+ lua_lock(L);
+ api_checknelems(L, 1);
+ moveto(L, L->top - 1, idx);
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {
+ TValue *fr;
+ lua_lock(L);
+ fr = index2addr(L, fromidx);
+ moveto(L, fr, toidx);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushvalue (lua_State *L, int idx) {
+ lua_lock(L);
+ setobj2s(L, L->top, index2addr(L, idx));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+
+/*
+** access functions (stack -> C)
+*/
+
+
+LUA_API int lua_type (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ return (isvalid(o) ? ttypenv(o) : LUA_TNONE);
+}
+
+
+LUA_API const char *lua_typename (lua_State *L, int t) {
+ UNUSED(L);
+ return ttypename(t);
+}
+
+
+LUA_API int lua_iscfunction (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ return (ttislcf(o) || (ttisCclosure(o)));
+}
+
+
+LUA_API int lua_isnumber (lua_State *L, int idx) {
+ TValue n;
+ const TValue *o = index2addr(L, idx);
+ return tonumber(o, &n);
+}
+
+
+LUA_API int lua_isstring (lua_State *L, int idx) {
+ int t = lua_type(L, idx);
+ return (t == LUA_TSTRING || t == LUA_TNUMBER);
+}
+
+
+LUA_API int lua_isuserdata (lua_State *L, int idx) {
+ const TValue *o = index2addr(L, idx);
+ return (ttisuserdata(o) || ttislightuserdata(o));
+}
+
+
+LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
+ StkId o1 = index2addr(L, index1);
+ StkId o2 = index2addr(L, index2);
+ return (isvalid(o1) && isvalid(o2)) ? luaV_rawequalobj(o1, o2) : 0;
+}
+
+
+LUA_API void lua_arith (lua_State *L, int op) {
+ StkId o1; /* 1st operand */
+ StkId o2; /* 2nd operand */
+ lua_lock(L);
+ if (op != LUA_OPUNM) /* all other operations expect two operands */
+ api_checknelems(L, 2);
+ else { /* for unary minus, add fake 2nd operand */
+ api_checknelems(L, 1);
+ setobjs2s(L, L->top, L->top - 1);
+ L->top++;
+ }
+ o1 = L->top - 2;
+ o2 = L->top - 1;
+ if (ttisnumber(o1) && ttisnumber(o2)) {
+ setnvalue(o1, luaO_arith(op, nvalue(o1), nvalue(o2)));
+ }
+ else
+ luaV_arith(L, o1, o1, o2, cast(TMS, op - LUA_OPADD + TM_ADD));
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {
+ StkId o1, o2;
+ int i = 0;
+ lua_lock(L); /* may call tag method */
+ o1 = index2addr(L, index1);
+ o2 = index2addr(L, index2);
+ if (isvalid(o1) && isvalid(o2)) {
+ switch (op) {
+ case LUA_OPEQ: i = equalobj(L, o1, o2); break;
+ case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;
+ case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break;
+ default: api_check(L, 0, "invalid option");
+ }
+ }
+ lua_unlock(L);
+ return i;
+}
+
+
+LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *isnum) {
+ TValue n;
+ const TValue *o = index2addr(L, idx);
+ if (tonumber(o, &n)) {
+ if (isnum) *isnum = 1;
+ return nvalue(o);
+ }
+ else {
+ if (isnum) *isnum = 0;
+ return 0;
+ }
+}
+
+
+LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *isnum) {
+ TValue n;
+ const TValue *o = index2addr(L, idx);
+ if (tonumber(o, &n)) {
+ lua_Integer res;
+ lua_Number num = nvalue(o);
+ lua_number2integer(res, num);
+ if (isnum) *isnum = 1;
+ return res;
+ }
+ else {
+ if (isnum) *isnum = 0;
+ return 0;
+ }
+}
+
+
+LUA_API lua_Unsigned lua_tounsignedx (lua_State *L, int idx, int *isnum) {
+ TValue n;
+ const TValue *o = index2addr(L, idx);
+ if (tonumber(o, &n)) {
+ lua_Unsigned res;
+ lua_Number num = nvalue(o);
+ lua_number2unsigned(res, num);
+ if (isnum) *isnum = 1;
+ return res;
+ }
+ else {
+ if (isnum) *isnum = 0;
+ return 0;
+ }
+}
+
+
+LUA_API int lua_toboolean (lua_State *L, int idx) {
+ const TValue *o = index2addr(L, idx);
+ return !l_isfalse(o);
+}
+
+
+LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {
+ StkId o = index2addr(L, idx);
+ if (!ttisstring(o)) {
+ lua_lock(L); /* `luaV_tostring' may create a new string */
+ if (!luaV_tostring(L, o)) { /* conversion failed? */
+ if (len != NULL) *len = 0;
+ lua_unlock(L);
+ return NULL;
+ }
+ luaC_checkGC(L);
+ o = index2addr(L, idx); /* previous call may reallocate the stack */
+ lua_unlock(L);
+ }
+ if (len != NULL) *len = tsvalue(o)->len;
+ return svalue(o);
+}
+
+
+LUA_API size_t lua_rawlen (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ switch (ttypenv(o)) {
+ case LUA_TSTRING: return tsvalue(o)->len;
+ case LUA_TUSERDATA: return uvalue(o)->len;
+ case LUA_TTABLE: return luaH_getn(hvalue(o));
+ default: return 0;
+ }
+}
+
+
+LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ if (ttislcf(o)) return fvalue(o);
+ else if (ttisCclosure(o))
+ return clCvalue(o)->f;
+ else return NULL; /* not a C function */
+}
+
+
+LUA_API void *lua_touserdata (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ switch (ttypenv(o)) {
+ case LUA_TUSERDATA: return (rawuvalue(o) + 1);
+ case LUA_TLIGHTUSERDATA: return pvalue(o);
+ default: return NULL;
+ }
+}
+
+
+LUA_API lua_State *lua_tothread (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ return (!ttisthread(o)) ? NULL : thvalue(o);
+}
+
+
+LUA_API const void *lua_topointer (lua_State *L, int idx) {
+ StkId o = index2addr(L, idx);
+ switch (ttype(o)) {
+ case LUA_TTABLE: return hvalue(o);
+ case LUA_TLCL: return clLvalue(o);
+ case LUA_TCCL: return clCvalue(o);
+ case LUA_TLCF: return cast(void *, cast(size_t, fvalue(o)));
+ case LUA_TTHREAD: return thvalue(o);
+ case LUA_TUSERDATA:
+ case LUA_TLIGHTUSERDATA:
+ return lua_touserdata(L, idx);
+ default: return NULL;
+ }
+}
+
+
+
+/*
+** push functions (C -> stack)
+*/
+
+
+LUA_API void lua_pushnil (lua_State *L) {
+ lua_lock(L);
+ setnilvalue(L->top);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
+ lua_lock(L);
+ setnvalue(L->top, n);
+ luai_checknum(L, L->top,
+ luaG_runerror(L, "C API - attempt to push a signaling NaN"));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {
+ lua_lock(L);
+ setnvalue(L->top, cast_num(n));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushunsigned (lua_State *L, lua_Unsigned u) {
+ lua_Number n;
+ lua_lock(L);
+ n = lua_unsigned2number(u);
+ setnvalue(L->top, n);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) {
+ TString *ts;
+ lua_lock(L);
+ luaC_checkGC(L);
+ ts = luaS_newlstr(L, s, len);
+ setsvalue2s(L, L->top, ts);
+ api_incr_top(L);
+ lua_unlock(L);
+ return getstr(ts);
+}
+
+
+LUA_API const char *lua_pushstring (lua_State *L, const char *s) {
+ if (s == NULL) {
+ lua_pushnil(L);
+ return NULL;
+ }
+ else {
+ TString *ts;
+ lua_lock(L);
+ luaC_checkGC(L);
+ ts = luaS_new(L, s);
+ setsvalue2s(L, L->top, ts);
+ api_incr_top(L);
+ lua_unlock(L);
+ return getstr(ts);
+ }
+}
+
+
+LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,
+ va_list argp) {
+ const char *ret;
+ lua_lock(L);
+ luaC_checkGC(L);
+ ret = luaO_pushvfstring(L, fmt, argp);
+ lua_unlock(L);
+ return ret;
+}
+
+
+LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {
+ const char *ret;
+ va_list argp;
+ lua_lock(L);
+ luaC_checkGC(L);
+ va_start(argp, fmt);
+ ret = luaO_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ lua_unlock(L);
+ return ret;
+}
+
+
+LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
+ lua_lock(L);
+ if (n == 0) {
+ setfvalue(L->top, fn);
+ }
+ else {
+ Closure *cl;
+ api_checknelems(L, n);
+ api_check(L, n <= MAXUPVAL, "upvalue index too large");
+ luaC_checkGC(L);
+ cl = luaF_newCclosure(L, n);
+ cl->c.f = fn;
+ L->top -= n;
+ while (n--)
+ setobj2n(L, &cl->c.upvalue[n], L->top + n);
+ setclCvalue(L, L->top, cl);
+ }
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushboolean (lua_State *L, int b) {
+ lua_lock(L);
+ setbvalue(L->top, (b != 0)); /* ensure that true is 1 */
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {
+ lua_lock(L);
+ setpvalue(L->top, p);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_pushthread (lua_State *L) {
+ lua_lock(L);
+ setthvalue(L, L->top, L);
+ api_incr_top(L);
+ lua_unlock(L);
+ return (G(L)->mainthread == L);
+}
+
+
+
+/*
+** get functions (Lua -> stack)
+*/
+
+
+LUA_API void lua_getglobal (lua_State *L, const char *var) {
+ Table *reg = hvalue(&G(L)->l_registry);
+ const TValue *gt; /* global table */
+ lua_lock(L);
+ gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
+ setsvalue2s(L, L->top++, luaS_new(L, var));
+ luaV_gettable(L, gt, L->top - 1, L->top - 1);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_gettable (lua_State *L, int idx) {
+ StkId t;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ luaV_gettable(L, t, L->top - 1, L->top - 1);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_getfield (lua_State *L, int idx, const char *k) {
+ StkId t;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ setsvalue2s(L, L->top, luaS_new(L, k));
+ api_incr_top(L);
+ luaV_gettable(L, t, L->top - 1, L->top - 1);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawget (lua_State *L, int idx) {
+ StkId t;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1));
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {
+ StkId t;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ setobj2s(L, L->top, luaH_getint(hvalue(t), n));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawgetp (lua_State *L, int idx, const void *p) {
+ StkId t;
+ TValue k;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ setpvalue(&k, cast(void *, p));
+ setobj2s(L, L->top, luaH_get(hvalue(t), &k));
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {
+ Table *t;
+ lua_lock(L);
+ luaC_checkGC(L);
+ t = luaH_new(L);
+ sethvalue(L, L->top, t);
+ api_incr_top(L);
+ if (narray > 0 || nrec > 0)
+ luaH_resize(L, t, narray, nrec);
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_getmetatable (lua_State *L, int objindex) {
+ const TValue *obj;
+ Table *mt = NULL;
+ int res;
+ lua_lock(L);
+ obj = index2addr(L, objindex);
+ switch (ttypenv(obj)) {
+ case LUA_TTABLE:
+ mt = hvalue(obj)->metatable;
+ break;
+ case LUA_TUSERDATA:
+ mt = uvalue(obj)->metatable;
+ break;
+ default:
+ mt = G(L)->mt[ttypenv(obj)];
+ break;
+ }
+ if (mt == NULL)
+ res = 0;
+ else {
+ sethvalue(L, L->top, mt);
+ api_incr_top(L);
+ res = 1;
+ }
+ lua_unlock(L);
+ return res;
+}
+
+
+LUA_API void lua_getuservalue (lua_State *L, int idx) {
+ StkId o;
+ lua_lock(L);
+ o = index2addr(L, idx);
+ api_check(L, ttisuserdata(o), "userdata expected");
+ if (uvalue(o)->env) {
+ sethvalue(L, L->top, uvalue(o)->env);
+ } else
+ setnilvalue(L->top);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+/*
+** set functions (stack -> Lua)
+*/
+
+
+LUA_API void lua_setglobal (lua_State *L, const char *var) {
+ Table *reg = hvalue(&G(L)->l_registry);
+ const TValue *gt; /* global table */
+ lua_lock(L);
+ api_checknelems(L, 1);
+ gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
+ setsvalue2s(L, L->top++, luaS_new(L, var));
+ luaV_settable(L, gt, L->top - 1, L->top - 2);
+ L->top -= 2; /* pop value and key */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_settable (lua_State *L, int idx) {
+ StkId t;
+ lua_lock(L);
+ api_checknelems(L, 2);
+ t = index2addr(L, idx);
+ luaV_settable(L, t, L->top - 2, L->top - 1);
+ L->top -= 2; /* pop index and value */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
+ StkId t;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = index2addr(L, idx);
+ setsvalue2s(L, L->top++, luaS_new(L, k));
+ luaV_settable(L, t, L->top - 1, L->top - 2);
+ L->top -= 2; /* pop value and key */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawset (lua_State *L, int idx) {
+ StkId t;
+ lua_lock(L);
+ api_checknelems(L, 2);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ setobj2t(L, luaH_set(L, hvalue(t), L->top-2), L->top-1);
+ invalidateTMcache(hvalue(t));
+ luaC_barrierback(L, gcvalue(t), L->top-1);
+ L->top -= 2;
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawseti (lua_State *L, int idx, int n) {
+ StkId t;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ luaH_setint(L, hvalue(t), n, L->top - 1);
+ luaC_barrierback(L, gcvalue(t), L->top-1);
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {
+ StkId t;
+ TValue k;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ setpvalue(&k, cast(void *, p));
+ setobj2t(L, luaH_set(L, hvalue(t), &k), L->top - 1);
+ luaC_barrierback(L, gcvalue(t), L->top - 1);
+ L->top--;
+ lua_unlock(L);
+}
+
+
+LUA_API int lua_setmetatable (lua_State *L, int objindex) {
+ TValue *obj;
+ Table *mt;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ obj = index2addr(L, objindex);
+ if (ttisnil(L->top - 1))
+ mt = NULL;
+ else {
+ api_check(L, ttistable(L->top - 1), "table expected");
+ mt = hvalue(L->top - 1);
+ }
+ switch (ttypenv(obj)) {
+ case LUA_TTABLE: {
+ hvalue(obj)->metatable = mt;
+ if (mt) {
+ luaC_objbarrierback(L, gcvalue(obj), mt);
+ luaC_checkfinalizer(L, gcvalue(obj), mt);
+ }
+ break;
+ }
+ case LUA_TUSERDATA: {
+ uvalue(obj)->metatable = mt;
+ if (mt) {
+ luaC_objbarrier(L, rawuvalue(obj), mt);
+ luaC_checkfinalizer(L, gcvalue(obj), mt);
+ }
+ break;
+ }
+ default: {
+ G(L)->mt[ttypenv(obj)] = mt;
+ break;
+ }
+ }
+ L->top--;
+ lua_unlock(L);
+ return 1;
+}
+
+
+LUA_API void lua_setuservalue (lua_State *L, int idx) {
+ StkId o;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ o = index2addr(L, idx);
+ api_check(L, ttisuserdata(o), "userdata expected");
+ if (ttisnil(L->top - 1))
+ uvalue(o)->env = NULL;
+ else {
+ api_check(L, ttistable(L->top - 1), "table expected");
+ uvalue(o)->env = hvalue(L->top - 1);
+ luaC_objbarrier(L, gcvalue(o), hvalue(L->top - 1));
+ }
+ L->top--;
+ lua_unlock(L);
+}
+
+
+/*
+** `load' and `call' functions (run Lua code)
+*/
+
+
+#define checkresults(L,na,nr) \
+ api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \
+ "results from function overflow current stack size")
+
+
+LUA_API int lua_getctx (lua_State *L, int *ctx) {
+ if (L->ci->callstatus & CIST_YIELDED) {
+ if (ctx) *ctx = L->ci->u.c.ctx;
+ return L->ci->u.c.status;
+ }
+ else return LUA_OK;
+}
+
+
+LUA_API void lua_callk (lua_State *L, int nargs, int nresults, int ctx,
+ lua_CFunction k) {
+ StkId func;
+ lua_lock(L);
+ api_check(L, k == NULL || !isLua(L->ci),
+ "cannot use continuations inside hooks");
+ api_checknelems(L, nargs+1);
+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
+ checkresults(L, nargs, nresults);
+ func = L->top - (nargs+1);
+ if (k != NULL && L->nny == 0) { /* need to prepare continuation? */
+ L->ci->u.c.k = k; /* save continuation */
+ L->ci->u.c.ctx = ctx; /* save context */
+ luaD_call(L, func, nresults, 1); /* do the call */
+ }
+ else /* no continuation or no yieldable */
+ luaD_call(L, func, nresults, 0); /* just do the call */
+ adjustresults(L, nresults);
+ lua_unlock(L);
+}
+
+
+
+/*
+** Execute a protected call.
+*/
+struct CallS { /* data to `f_call' */
+ StkId func;
+ int nresults;
+};
+
+
+static void f_call (lua_State *L, void *ud) {
+ struct CallS *c = cast(struct CallS *, ud);
+ luaD_call(L, c->func, c->nresults, 0);
+}
+
+
+
+LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,
+ int ctx, lua_CFunction k) {
+ struct CallS c;
+ int status;
+ ptrdiff_t func;
+ lua_lock(L);
+ api_check(L, k == NULL || !isLua(L->ci),
+ "cannot use continuations inside hooks");
+ api_checknelems(L, nargs+1);
+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
+ checkresults(L, nargs, nresults);
+ if (errfunc == 0)
+ func = 0;
+ else {
+ StkId o = index2addr(L, errfunc);
+ api_checkstackindex(L, errfunc, o);
+ func = savestack(L, o);
+ }
+ c.func = L->top - (nargs+1); /* function to be called */
+ if (k == NULL || L->nny > 0) { /* no continuation or no yieldable? */
+ c.nresults = nresults; /* do a 'conventional' protected call */
+ status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
+ }
+ else { /* prepare continuation (call is already protected by 'resume') */
+ CallInfo *ci = L->ci;
+ ci->u.c.k = k; /* save continuation */
+ ci->u.c.ctx = ctx; /* save context */
+ /* save information for error recovery */
+ ci->extra = savestack(L, c.func);
+ ci->u.c.old_allowhook = L->allowhook;
+ ci->u.c.old_errfunc = L->errfunc;
+ L->errfunc = func;
+ /* mark that function may do error recovery */
+ ci->callstatus |= CIST_YPCALL;
+ luaD_call(L, c.func, nresults, 1); /* do the call */
+ ci->callstatus &= ~CIST_YPCALL;
+ L->errfunc = ci->u.c.old_errfunc;
+ status = LUA_OK; /* if it is here, there were no errors */
+ }
+ adjustresults(L, nresults);
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,
+ const char *chunkname, const char *mode) {
+ ZIO z;
+ int status;
+ lua_lock(L);
+ if (!chunkname) chunkname = "?";
+ luaZ_init(L, &z, reader, data);
+ status = luaD_protectedparser(L, &z, chunkname, mode);
+ if (status == LUA_OK) { /* no errors? */
+ LClosure *f = clLvalue(L->top - 1); /* get newly created function */
+ if (f->nupvalues == 1) { /* does it have one upvalue? */
+ /* get global table from registry */
+ Table *reg = hvalue(&G(L)->l_registry);
+ const TValue *gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
+ /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */
+ setobj(L, f->upvals[0]->v, gt);
+ luaC_barrier(L, f->upvals[0], gt);
+ }
+ }
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data) {
+ int status;
+ TValue *o;
+ lua_lock(L);
+ api_checknelems(L, 1);
+ o = L->top - 1;
+ if (isLfunction(o))
+ status = luaU_dump(L, getproto(o), writer, data, 0);
+ else
+ status = 1;
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_status (lua_State *L) {
+ return L->status;
+}
+
+
+/*
+** Garbage-collection function
+*/
+
+LUA_API int lua_gc (lua_State *L, int what, int data) {
+ int res = 0;
+ global_State *g;
+ lua_lock(L);
+ g = G(L);
+ switch (what) {
+ case LUA_GCSTOP: {
+ g->gcrunning = 0;
+ break;
+ }
+ case LUA_GCRESTART: {
+ luaE_setdebt(g, 0);
+ g->gcrunning = 1;
+ break;
+ }
+ case LUA_GCCOLLECT: {
+ luaC_fullgc(L, 0);
+ break;
+ }
+ case LUA_GCCOUNT: {
+ /* GC values are expressed in Kbytes: #bytes/2^10 */
+ res = cast_int(gettotalbytes(g) >> 10);
+ break;
+ }
+ case LUA_GCCOUNTB: {
+ res = cast_int(gettotalbytes(g) & 0x3ff);
+ break;
+ }
+ case LUA_GCSTEP: {
+ if (g->gckind == KGC_GEN) { /* generational mode? */
+ res = (g->GCestimate == 0); /* true if it will do major collection */
+ luaC_forcestep(L); /* do a single step */
+ }
+ else {
+ lu_mem debt = cast(lu_mem, data) * 1024 - GCSTEPSIZE;
+ if (g->gcrunning)
+ debt += g->GCdebt; /* include current debt */
+ luaE_setdebt(g, debt);
+ luaC_forcestep(L);
+ if (g->gcstate == GCSpause) /* end of cycle? */
+ res = 1; /* signal it */
+ }
+ break;
+ }
+ case LUA_GCSETPAUSE: {
+ res = g->gcpause;
+ g->gcpause = data;
+ break;
+ }
+ case LUA_GCSETMAJORINC: {
+ res = g->gcmajorinc;
+ g->gcmajorinc = data;
+ break;
+ }
+ case LUA_GCSETSTEPMUL: {
+ res = g->gcstepmul;
+ g->gcstepmul = data;
+ break;
+ }
+ case LUA_GCISRUNNING: {
+ res = g->gcrunning;
+ break;
+ }
+ case LUA_GCGEN: { /* change collector to generational mode */
+ luaC_changemode(L, KGC_GEN);
+ break;
+ }
+ case LUA_GCINC: { /* change collector to incremental mode */
+ luaC_changemode(L, KGC_NORMAL);
+ break;
+ }
+ default: res = -1; /* invalid option */
+ }
+ lua_unlock(L);
+ return res;
+}
+
+
+
+/*
+** miscellaneous functions
+*/
+
+
+LUA_API int lua_error (lua_State *L) {
+ lua_lock(L);
+ api_checknelems(L, 1);
+ luaG_errormsg(L);
+ /* code unreachable; will unlock when control actually leaves the kernel */
+ return 0; /* to avoid warnings */
+}
+
+
+LUA_API int lua_next (lua_State *L, int idx) {
+ StkId t;
+ int more;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ more = luaH_next(L, hvalue(t), L->top - 1);
+ if (more) {
+ api_incr_top(L);
+ }
+ else /* no more elements */
+ L->top -= 1; /* remove key */
+ lua_unlock(L);
+ return more;
+}
+
+
+LUA_API void lua_concat (lua_State *L, int n) {
+ lua_lock(L);
+ api_checknelems(L, n);
+ if (n >= 2) {
+ luaC_checkGC(L);
+ luaV_concat(L, n);
+ }
+ else if (n == 0) { /* push empty string */
+ setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));
+ api_incr_top(L);
+ }
+ /* else n == 1; nothing to do */
+ lua_unlock(L);
+}
+
+
+LUA_API void lua_len (lua_State *L, int idx) {
+ StkId t;
+ lua_lock(L);
+ t = index2addr(L, idx);
+ luaV_objlen(L, L->top, t);
+ api_incr_top(L);
+ lua_unlock(L);
+}
+
+
+LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {
+ lua_Alloc f;
+ lua_lock(L);
+ if (ud) *ud = G(L)->ud;
+ f = G(L)->frealloc;
+ lua_unlock(L);
+ return f;
+}
+
+
+LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {
+ lua_lock(L);
+ G(L)->ud = ud;
+ G(L)->frealloc = f;
+ lua_unlock(L);
+}
+
+
+LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
+ Udata *u;
+ lua_lock(L);
+ luaC_checkGC(L);
+ u = luaS_newudata(L, size, NULL);
+ setuvalue(L, L->top, u);
+ api_incr_top(L);
+ lua_unlock(L);
+ return u + 1;
+}
+
+
+
+static const char *aux_upvalue (StkId fi, int n, TValue **val,
+ GCObject **owner) {
+ switch (ttype(fi)) {
+ case LUA_TCCL: { /* C closure */
+ CClosure *f = clCvalue(fi);
+ if (!(1 <= n && n <= f->nupvalues)) return NULL;
+ *val = &f->upvalue[n-1];
+ if (owner) *owner = obj2gco(f);
+ return "";
+ }
+ case LUA_TLCL: { /* Lua closure */
+ LClosure *f = clLvalue(fi);
+ TString *name;
+ Proto *p = f->p;
+ if (!(1 <= n && n <= p->sizeupvalues)) return NULL;
+ *val = f->upvals[n-1]->v;
+ if (owner) *owner = obj2gco(f->upvals[n - 1]);
+ name = p->upvalues[n-1].name;
+ return (name == NULL) ? "" : getstr(name);
+ }
+ default: return NULL; /* not a closure */
+ }
+}
+
+
+LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
+ const char *name;
+ TValue *val = NULL; /* to avoid warnings */
+ lua_lock(L);
+ name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL);
+ if (name) {
+ setobj2s(L, L->top, val);
+ api_incr_top(L);
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
+ const char *name;
+ TValue *val = NULL; /* to avoid warnings */
+ GCObject *owner = NULL; /* to avoid warnings */
+ StkId fi;
+ lua_lock(L);
+ fi = index2addr(L, funcindex);
+ api_checknelems(L, 1);
+ name = aux_upvalue(fi, n, &val, &owner);
+ if (name) {
+ L->top--;
+ setobj(L, val, L->top);
+ luaC_barrier(L, owner, L->top);
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
+ LClosure *f;
+ StkId fi = index2addr(L, fidx);
+ api_check(L, ttisLclosure(fi), "Lua function expected");
+ f = clLvalue(fi);
+ api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index");
+ if (pf) *pf = f;
+ return &f->upvals[n - 1]; /* get its upvalue pointer */
+}
+
+
+LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
+ StkId fi = index2addr(L, fidx);
+ switch (ttype(fi)) {
+ case LUA_TLCL: { /* lua closure */
+ return *getupvalref(L, fidx, n, NULL);
+ }
+ case LUA_TCCL: { /* C closure */
+ CClosure *f = clCvalue(fi);
+ api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index");
+ return &f->upvalue[n - 1];
+ }
+ default: {
+ api_check(L, 0, "closure expected");
+ return NULL;
+ }
+ }
+}
+
+
+LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,
+ int fidx2, int n2) {
+ LClosure *f1;
+ UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
+ UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
+ *up1 = *up2;
+ luaC_objbarrier(L, f1, *up2);
+}
+
--- /dev/null
+/*
+** $Id: lapi.h,v 2.7 2009/11/27 15:37:59 roberto Exp $
+** Auxiliary functions from Lua API
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lapi_h
+#define lapi_h
+
+
+#include "llimits.h"
+#include "lstate.h"
+
+#define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \
+ "stack overflow");}
+
+#define adjustresults(L,nres) \
+ { if ((nres) == LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; }
+
+#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \
+ "not enough elements in the stack")
+
+
+#endif
--- /dev/null
+/*
+** $Id: lauxlib.c,v 1.248 2013/03/21 13:54:57 roberto Exp $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#include <errno.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+/* This file uses only the official API of Lua.
+** Any function declared here could be written as an application function.
+*/
+
+#define lauxlib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+
+
+/*
+** {======================================================
+** Traceback
+** =======================================================
+*/
+
+
+#define LEVELS1 12 /* size of the first part of the stack */
+#define LEVELS2 10 /* size of the second part of the stack */
+
+
+
+/*
+** search for 'objidx' in table at index -1.
+** return 1 + string at top if find a good name.
+*/
+static int findfield (lua_State *L, int objidx, int level) {
+ if (level == 0 || !lua_istable(L, -1))
+ return 0; /* not found */
+ lua_pushnil(L); /* start 'next' loop */
+ while (lua_next(L, -2)) { /* for each pair in table */
+ if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */
+ if (lua_rawequal(L, objidx, -1)) { /* found object? */
+ lua_pop(L, 1); /* remove value (but keep name) */
+ return 1;
+ }
+ else if (findfield(L, objidx, level - 1)) { /* try recursively */
+ lua_remove(L, -2); /* remove table (but keep name) */
+ lua_pushliteral(L, ".");
+ lua_insert(L, -2); /* place '.' between the two names */
+ lua_concat(L, 3);
+ return 1;
+ }
+ }
+ lua_pop(L, 1); /* remove value */
+ }
+ return 0; /* not found */
+}
+
+
+static int pushglobalfuncname (lua_State *L, lua_Debug *ar) {
+ int top = lua_gettop(L);
+ lua_getinfo(L, "f", ar); /* push function */
+ lua_pushglobaltable(L);
+ if (findfield(L, top + 1, 2)) {
+ lua_copy(L, -1, top + 1); /* move name to proper place */
+ lua_pop(L, 2); /* remove pushed values */
+ return 1;
+ }
+ else {
+ lua_settop(L, top); /* remove function and global table */
+ return 0;
+ }
+}
+
+
+static void pushfuncname (lua_State *L, lua_Debug *ar) {
+ if (*ar->namewhat != '\0') /* is there a name? */
+ lua_pushfstring(L, "function " LUA_QS, ar->name);
+ else if (*ar->what == 'm') /* main? */
+ lua_pushliteral(L, "main chunk");
+ else if (*ar->what == 'C') {
+ if (pushglobalfuncname(L, ar)) {
+ lua_pushfstring(L, "function " LUA_QS, lua_tostring(L, -1));
+ lua_remove(L, -2); /* remove name */
+ }
+ else
+ lua_pushliteral(L, "?");
+ }
+ else
+ lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined);
+}
+
+
+static int countlevels (lua_State *L) {
+ lua_Debug ar;
+ int li = 1, le = 1;
+ /* find an upper bound */
+ while (lua_getstack(L, le, &ar)) { li = le; le *= 2; }
+ /* do a binary search */
+ while (li < le) {
+ int m = (li + le)/2;
+ if (lua_getstack(L, m, &ar)) li = m + 1;
+ else le = m;
+ }
+ return le - 1;
+}
+
+
+LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,
+ const char *msg, int level) {
+ lua_Debug ar;
+ int top = lua_gettop(L);
+ int numlevels = countlevels(L1);
+ int mark = (numlevels > LEVELS1 + LEVELS2) ? LEVELS1 : 0;
+ if (msg) lua_pushfstring(L, "%s\n", msg);
+ lua_pushliteral(L, "stack traceback:");
+ while (lua_getstack(L1, level++, &ar)) {
+ if (level == mark) { /* too many levels? */
+ lua_pushliteral(L, "\n\t..."); /* add a '...' */
+ level = numlevels - LEVELS2; /* and skip to last ones */
+ }
+ else {
+ lua_getinfo(L1, "Slnt", &ar);
+ lua_pushfstring(L, "\n\t%s:", ar.short_src);
+ if (ar.currentline > 0)
+ lua_pushfstring(L, "%d:", ar.currentline);
+ lua_pushliteral(L, " in ");
+ pushfuncname(L, &ar);
+ if (ar.istailcall)
+ lua_pushliteral(L, "\n\t(...tail calls...)");
+ lua_concat(L, lua_gettop(L) - top);
+ }
+ }
+ lua_concat(L, lua_gettop(L) - top);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Error-report functions
+** =======================================================
+*/
+
+LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) {
+ lua_Debug ar;
+ if (!lua_getstack(L, 0, &ar)) /* no stack frame? */
+ return luaL_error(L, "bad argument #%d (%s)", narg, extramsg);
+ lua_getinfo(L, "n", &ar);
+ if (strcmp(ar.namewhat, "method") == 0) {
+ narg--; /* do not count `self' */
+ if (narg == 0) /* error is in the self argument itself? */
+ return luaL_error(L, "calling " LUA_QS " on bad self (%s)",
+ ar.name, extramsg);
+ }
+ if (ar.name == NULL)
+ ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?";
+ return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)",
+ narg, ar.name, extramsg);
+}
+
+
+static int typeerror (lua_State *L, int narg, const char *tname) {
+ const char *msg = lua_pushfstring(L, "%s expected, got %s",
+ tname, luaL_typename(L, narg));
+ return luaL_argerror(L, narg, msg);
+}
+
+
+static void tag_error (lua_State *L, int narg, int tag) {
+ typeerror(L, narg, lua_typename(L, tag));
+}
+
+
+LUALIB_API void luaL_where (lua_State *L, int level) {
+ lua_Debug ar;
+ if (lua_getstack(L, level, &ar)) { /* check function at level */
+ lua_getinfo(L, "Sl", &ar); /* get info about it */
+ if (ar.currentline > 0) { /* is there info? */
+ lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
+ return;
+ }
+ }
+ lua_pushliteral(L, ""); /* else, no information available... */
+}
+
+
+LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
+ va_list argp;
+ va_start(argp, fmt);
+ luaL_where(L, 1);
+ lua_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ lua_concat(L, 2);
+ return lua_error(L);
+}
+
+
+LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {
+ int en = errno; /* calls to Lua API may change this value */
+ if (stat) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ else {
+ lua_pushnil(L);
+ if (fname)
+ lua_pushfstring(L, "%s: %s", fname, strerror(en));
+ else
+ lua_pushstring(L, strerror(en));
+ lua_pushinteger(L, en);
+ return 3;
+ }
+}
+
+
+#if !defined(inspectstat) /* { */
+
+#if defined(LUA_USE_POSIX)
+
+#include <sys/wait.h>
+
+/*
+** use appropriate macros to interpret 'pclose' return status
+*/
+#define inspectstat(stat,what) \
+ if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \
+ else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; }
+
+#else
+
+#define inspectstat(stat,what) /* no op */
+
+#endif
+
+#endif /* } */
+
+
+LUALIB_API int luaL_execresult (lua_State *L, int stat) {
+ const char *what = "exit"; /* type of termination */
+ if (stat == -1) /* error? */
+ return luaL_fileresult(L, 0, NULL);
+ else {
+ inspectstat(stat, what); /* interpret result */
+ if (*what == 'e' && stat == 0) /* successful termination? */
+ lua_pushboolean(L, 1);
+ else
+ lua_pushnil(L);
+ lua_pushstring(L, what);
+ lua_pushinteger(L, stat);
+ return 3; /* return true/nil,what,code */
+ }
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Userdata's metatable manipulation
+** =======================================================
+*/
+
+LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
+ luaL_getmetatable(L, tname); /* try to get metatable */
+ if (!lua_isnil(L, -1)) /* name already in use? */
+ return 0; /* leave previous value on top, but return 0 */
+ lua_pop(L, 1);
+ lua_newtable(L); /* create metatable */
+ lua_pushvalue(L, -1);
+ lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */
+ return 1;
+}
+
+
+LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) {
+ luaL_getmetatable(L, tname);
+ lua_setmetatable(L, -2);
+}
+
+
+LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) {
+ void *p = lua_touserdata(L, ud);
+ if (p != NULL) { /* value is a userdata? */
+ if (lua_getmetatable(L, ud)) { /* does it have a metatable? */
+ luaL_getmetatable(L, tname); /* get correct metatable */
+ if (!lua_rawequal(L, -1, -2)) /* not the same? */
+ p = NULL; /* value is a userdata with wrong metatable */
+ lua_pop(L, 2); /* remove both metatables */
+ return p;
+ }
+ }
+ return NULL; /* value is not a userdata with a metatable */
+}
+
+
+LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
+ void *p = luaL_testudata(L, ud, tname);
+ if (p == NULL) typeerror(L, ud, tname);
+ return p;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Argument check functions
+** =======================================================
+*/
+
+LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def,
+ const char *const lst[]) {
+ const char *name = (def) ? luaL_optstring(L, narg, def) :
+ luaL_checkstring(L, narg);
+ int i;
+ for (i=0; lst[i]; i++)
+ if (strcmp(lst[i], name) == 0)
+ return i;
+ return luaL_argerror(L, narg,
+ lua_pushfstring(L, "invalid option " LUA_QS, name));
+}
+
+
+LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) {
+ /* keep some extra space to run error routines, if needed */
+ const int extra = LUA_MINSTACK;
+ if (!lua_checkstack(L, space + extra)) {
+ if (msg)
+ luaL_error(L, "stack overflow (%s)", msg);
+ else
+ luaL_error(L, "stack overflow");
+ }
+}
+
+
+LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {
+ if (lua_type(L, narg) != t)
+ tag_error(L, narg, t);
+}
+
+
+LUALIB_API void luaL_checkany (lua_State *L, int narg) {
+ if (lua_type(L, narg) == LUA_TNONE)
+ luaL_argerror(L, narg, "value expected");
+}
+
+
+LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) {
+ const char *s = lua_tolstring(L, narg, len);
+ if (!s) tag_error(L, narg, LUA_TSTRING);
+ return s;
+}
+
+
+LUALIB_API const char *luaL_optlstring (lua_State *L, int narg,
+ const char *def, size_t *len) {
+ if (lua_isnoneornil(L, narg)) {
+ if (len)
+ *len = (def ? strlen(def) : 0);
+ return def;
+ }
+ else return luaL_checklstring(L, narg, len);
+}
+
+
+LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {
+ int isnum;
+ lua_Number d = lua_tonumberx(L, narg, &isnum);
+ if (!isnum)
+ tag_error(L, narg, LUA_TNUMBER);
+ return d;
+}
+
+
+LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {
+ return luaL_opt(L, luaL_checknumber, narg, def);
+}
+
+
+LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) {
+ int isnum;
+ lua_Integer d = lua_tointegerx(L, narg, &isnum);
+ if (!isnum)
+ tag_error(L, narg, LUA_TNUMBER);
+ return d;
+}
+
+
+LUALIB_API lua_Unsigned luaL_checkunsigned (lua_State *L, int narg) {
+ int isnum;
+ lua_Unsigned d = lua_tounsignedx(L, narg, &isnum);
+ if (!isnum)
+ tag_error(L, narg, LUA_TNUMBER);
+ return d;
+}
+
+
+LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg,
+ lua_Integer def) {
+ return luaL_opt(L, luaL_checkinteger, narg, def);
+}
+
+
+LUALIB_API lua_Unsigned luaL_optunsigned (lua_State *L, int narg,
+ lua_Unsigned def) {
+ return luaL_opt(L, luaL_checkunsigned, narg, def);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Generic Buffer manipulation
+** =======================================================
+*/
+
+/*
+** check whether buffer is using a userdata on the stack as a temporary
+** buffer
+*/
+#define buffonstack(B) ((B)->b != (B)->initb)
+
+
+/*
+** returns a pointer to a free area with at least 'sz' bytes
+*/
+LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {
+ lua_State *L = B->L;
+ if (B->size - B->n < sz) { /* not enough space? */
+ char *newbuff;
+ size_t newsize = B->size * 2; /* double buffer size */
+ if (newsize - B->n < sz) /* not big enough? */
+ newsize = B->n + sz;
+ if (newsize < B->n || newsize - B->n < sz)
+ luaL_error(L, "buffer too large");
+ /* create larger buffer */
+ newbuff = (char *)lua_newuserdata(L, newsize * sizeof(char));
+ /* move content to new buffer */
+ memcpy(newbuff, B->b, B->n * sizeof(char));
+ if (buffonstack(B))
+ lua_remove(L, -2); /* remove old buffer */
+ B->b = newbuff;
+ B->size = newsize;
+ }
+ return &B->b[B->n];
+}
+
+
+LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
+ char *b = luaL_prepbuffsize(B, l);
+ memcpy(b, s, l * sizeof(char));
+ luaL_addsize(B, l);
+}
+
+
+LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
+ luaL_addlstring(B, s, strlen(s));
+}
+
+
+LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
+ lua_State *L = B->L;
+ lua_pushlstring(L, B->b, B->n);
+ if (buffonstack(B))
+ lua_remove(L, -2); /* remove old buffer */
+}
+
+
+LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {
+ luaL_addsize(B, sz);
+ luaL_pushresult(B);
+}
+
+
+LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
+ lua_State *L = B->L;
+ size_t l;
+ const char *s = lua_tolstring(L, -1, &l);
+ if (buffonstack(B))
+ lua_insert(L, -2); /* put value below buffer */
+ luaL_addlstring(B, s, l);
+ lua_remove(L, (buffonstack(B)) ? -2 : -1); /* remove value */
+}
+
+
+LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
+ B->L = L;
+ B->b = B->initb;
+ B->n = 0;
+ B->size = LUAL_BUFFERSIZE;
+}
+
+
+LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
+ luaL_buffinit(L, B);
+ return luaL_prepbuffsize(B, sz);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Reference system
+** =======================================================
+*/
+
+/* index of free-list header */
+#define freelist 0
+
+
+LUALIB_API int luaL_ref (lua_State *L, int t) {
+ int ref;
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* remove from stack */
+ return LUA_REFNIL; /* `nil' has a unique fixed reference */
+ }
+ t = lua_absindex(L, t);
+ lua_rawgeti(L, t, freelist); /* get first free element */
+ ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */
+ lua_pop(L, 1); /* remove it from stack */
+ if (ref != 0) { /* any free element? */
+ lua_rawgeti(L, t, ref); /* remove it from list */
+ lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */
+ }
+ else /* no free elements */
+ ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */
+ lua_rawseti(L, t, ref);
+ return ref;
+}
+
+
+LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
+ if (ref >= 0) {
+ t = lua_absindex(L, t);
+ lua_rawgeti(L, t, freelist);
+ lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */
+ lua_pushinteger(L, ref);
+ lua_rawseti(L, t, freelist); /* t[freelist] = ref */
+ }
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Load functions
+** =======================================================
+*/
+
+typedef struct LoadF {
+ int n; /* number of pre-read characters */
+ FILE *f; /* file being read */
+ char buff[LUAL_BUFFERSIZE]; /* area for reading file */
+} LoadF;
+
+
+static const char *getF (lua_State *L, void *ud, size_t *size) {
+ LoadF *lf = (LoadF *)ud;
+ (void)L; /* not used */
+ if (lf->n > 0) { /* are there pre-read characters to be read? */
+ *size = lf->n; /* return them (chars already in buffer) */
+ lf->n = 0; /* no more pre-read characters */
+ }
+ else { /* read a block from file */
+ /* 'fread' can return > 0 *and* set the EOF flag. If next call to
+ 'getF' called 'fread', it might still wait for user input.
+ The next check avoids this problem. */
+ if (feof(lf->f)) return NULL;
+ *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */
+ }
+ return lf->buff;
+}
+
+
+static int errfile (lua_State *L, const char *what, int fnameindex) {
+ const char *serr = strerror(errno);
+ const char *filename = lua_tostring(L, fnameindex) + 1;
+ lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
+ lua_remove(L, fnameindex);
+ return LUA_ERRFILE;
+}
+
+
+static int skipBOM (LoadF *lf) {
+ const char *p = "\xEF\xBB\xBF"; /* Utf8 BOM mark */
+ int c;
+ lf->n = 0;
+ do {
+ c = getc(lf->f);
+ if (c == EOF || c != *(const unsigned char *)p++) return c;
+ lf->buff[lf->n++] = c; /* to be read by the parser */
+ } while (*p != '\0');
+ lf->n = 0; /* prefix matched; discard it */
+ return getc(lf->f); /* return next character */
+}
+
+
+/*
+** reads the first character of file 'f' and skips an optional BOM mark
+** in its beginning plus its first line if it starts with '#'. Returns
+** true if it skipped the first line. In any case, '*cp' has the
+** first "valid" character of the file (after the optional BOM and
+** a first-line comment).
+*/
+static int skipcomment (LoadF *lf, int *cp) {
+ int c = *cp = skipBOM(lf);
+ if (c == '#') { /* first line is a comment (Unix exec. file)? */
+ do { /* skip first line */
+ c = getc(lf->f);
+ } while (c != EOF && c != '\n') ;
+ *cp = getc(lf->f); /* skip end-of-line, if present */
+ return 1; /* there was a comment */
+ }
+ else return 0; /* no comment */
+}
+
+
+LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,
+ const char *mode) {
+ LoadF lf;
+ int status, readstatus;
+ int c;
+ int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
+ if (filename == NULL) {
+ lua_pushliteral(L, "=stdin");
+ lf.f = stdin;
+ }
+ else {
+ lua_pushfstring(L, "@%s", filename);
+ lf.f = fopen(filename, "r");
+ if (lf.f == NULL) return errfile(L, "open", fnameindex);
+ }
+ if (skipcomment(&lf, &c)) /* read initial portion */
+ lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */
+ if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */
+ lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */
+ if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
+ skipcomment(&lf, &c); /* re-read initial portion */
+ }
+ if (c != EOF)
+ lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */
+ status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);
+ readstatus = ferror(lf.f);
+ if (filename) fclose(lf.f); /* close file (even in case of errors) */
+ if (readstatus) {
+ lua_settop(L, fnameindex); /* ignore results from `lua_load' */
+ return errfile(L, "read", fnameindex);
+ }
+ lua_remove(L, fnameindex);
+ return status;
+}
+
+
+typedef struct LoadS {
+ const char *s;
+ size_t size;
+} LoadS;
+
+
+static const char *getS (lua_State *L, void *ud, size_t *size) {
+ LoadS *ls = (LoadS *)ud;
+ (void)L; /* not used */
+ if (ls->size == 0) return NULL;
+ *size = ls->size;
+ ls->size = 0;
+ return ls->s;
+}
+
+
+LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,
+ const char *name, const char *mode) {
+ LoadS ls;
+ ls.s = buff;
+ ls.size = size;
+ return lua_load(L, getS, &ls, name, mode);
+}
+
+
+LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {
+ return luaL_loadbuffer(L, s, strlen(s), s);
+}
+
+/* }====================================================== */
+
+
+
+LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
+ if (!lua_getmetatable(L, obj)) /* no metatable? */
+ return 0;
+ lua_pushstring(L, event);
+ lua_rawget(L, -2);
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 2); /* remove metatable and metafield */
+ return 0;
+ }
+ else {
+ lua_remove(L, -2); /* remove only metatable */
+ return 1;
+ }
+}
+
+
+LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
+ obj = lua_absindex(L, obj);
+ if (!luaL_getmetafield(L, obj, event)) /* no metafield? */
+ return 0;
+ lua_pushvalue(L, obj);
+ lua_call(L, 1, 1);
+ return 1;
+}
+
+
+LUALIB_API int luaL_len (lua_State *L, int idx) {
+ int l;
+ int isnum;
+ lua_len(L, idx);
+ l = (int)lua_tointegerx(L, -1, &isnum);
+ if (!isnum)
+ luaL_error(L, "object length is not a number");
+ lua_pop(L, 1); /* remove object */
+ return l;
+}
+
+
+LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {
+ if (!luaL_callmeta(L, idx, "__tostring")) { /* no metafield? */
+ switch (lua_type(L, idx)) {
+ case LUA_TNUMBER:
+ case LUA_TSTRING:
+ lua_pushvalue(L, idx);
+ break;
+ case LUA_TBOOLEAN:
+ lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));
+ break;
+ case LUA_TNIL:
+ lua_pushliteral(L, "nil");
+ break;
+ default:
+ lua_pushfstring(L, "%s: %p", luaL_typename(L, idx),
+ lua_topointer(L, idx));
+ break;
+ }
+ }
+ return lua_tolstring(L, -1, len);
+}
+
+
+/*
+** {======================================================
+** Compatibility with 5.1 module functions
+** =======================================================
+*/
+#if defined(LUA_COMPAT_MODULE)
+
+static const char *luaL_findtable (lua_State *L, int idx,
+ const char *fname, int szhint) {
+ const char *e;
+ if (idx) lua_pushvalue(L, idx);
+ do {
+ e = strchr(fname, '.');
+ if (e == NULL) e = fname + strlen(fname);
+ lua_pushlstring(L, fname, e - fname);
+ lua_rawget(L, -2);
+ if (lua_isnil(L, -1)) { /* no such field? */
+ lua_pop(L, 1); /* remove this nil */
+ lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */
+ lua_pushlstring(L, fname, e - fname);
+ lua_pushvalue(L, -2);
+ lua_settable(L, -4); /* set new table into field */
+ }
+ else if (!lua_istable(L, -1)) { /* field has a non-table value? */
+ lua_pop(L, 2); /* remove table and value */
+ return fname; /* return problematic part of the name */
+ }
+ lua_remove(L, -2); /* remove previous table */
+ fname = e + 1;
+ } while (*e == '.');
+ return NULL;
+}
+
+
+/*
+** Count number of elements in a luaL_Reg list.
+*/
+static int libsize (const luaL_Reg *l) {
+ int size = 0;
+ for (; l && l->name; l++) size++;
+ return size;
+}
+
+
+/*
+** Find or create a module table with a given name. The function
+** first looks at the _LOADED table and, if that fails, try a
+** global variable with that name. In any case, leaves on the stack
+** the module table.
+*/
+LUALIB_API void luaL_pushmodule (lua_State *L, const char *modname,
+ int sizehint) {
+ luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1); /* get _LOADED table */
+ lua_getfield(L, -1, modname); /* get _LOADED[modname] */
+ if (!lua_istable(L, -1)) { /* not found? */
+ lua_pop(L, 1); /* remove previous result */
+ /* try global variable (and create one if it does not exist) */
+ lua_pushglobaltable(L);
+ if (luaL_findtable(L, 0, modname, sizehint) != NULL)
+ luaL_error(L, "name conflict for module " LUA_QS, modname);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -3, modname); /* _LOADED[modname] = new table */
+ }
+ lua_remove(L, -2); /* remove _LOADED table */
+}
+
+
+LUALIB_API void luaL_openlib (lua_State *L, const char *libname,
+ const luaL_Reg *l, int nup) {
+ luaL_checkversion(L);
+ if (libname) {
+ luaL_pushmodule(L, libname, libsize(l)); /* get/create library table */
+ lua_insert(L, -(nup + 1)); /* move library table to below upvalues */
+ }
+ if (l)
+ luaL_setfuncs(L, l, nup);
+ else
+ lua_pop(L, nup); /* remove upvalues */
+}
+
+#endif
+/* }====================================================== */
+
+/*
+** set functions from list 'l' into table at top - 'nup'; each
+** function gets the 'nup' elements at the top as upvalues.
+** Returns with only the table at the stack.
+*/
+LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
+ luaL_checkversion(L);
+ luaL_checkstack(L, nup, "too many upvalues");
+ for (; l->name != NULL; l++) { /* fill the table with given functions */
+ int i;
+ for (i = 0; i < nup; i++) /* copy upvalues to the top */
+ lua_pushvalue(L, -nup);
+ lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
+ lua_setfield(L, -(nup + 2), l->name);
+ }
+ lua_pop(L, nup); /* remove upvalues */
+}
+
+
+/*
+** ensure that stack[idx][fname] has a table and push that table
+** into the stack
+*/
+LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {
+ lua_getfield(L, idx, fname);
+ if (lua_istable(L, -1)) return 1; /* table already there */
+ else {
+ lua_pop(L, 1); /* remove previous result */
+ idx = lua_absindex(L, idx);
+ lua_newtable(L);
+ lua_pushvalue(L, -1); /* copy to be left at top */
+ lua_setfield(L, idx, fname); /* assign new table to field */
+ return 0; /* false, because did not find table there */
+ }
+}
+
+
+/*
+** stripped-down 'require'. Calls 'openf' to open a module,
+** registers the result in 'package.loaded' table and, if 'glb'
+** is true, also registers the result in the global table.
+** Leaves resulting module on the top.
+*/
+LUALIB_API void luaL_requiref (lua_State *L, const char *modname,
+ lua_CFunction openf, int glb) {
+ lua_pushcfunction(L, openf);
+ lua_pushstring(L, modname); /* argument to open function */
+ lua_call(L, 1, 1); /* open module */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED");
+ lua_pushvalue(L, -2); /* make copy of module (call result) */
+ lua_setfield(L, -2, modname); /* _LOADED[modname] = module */
+ lua_pop(L, 1); /* remove _LOADED table */
+ if (glb) {
+ lua_pushvalue(L, -1); /* copy of 'mod' */
+ lua_setglobal(L, modname); /* _G[modname] = module */
+ }
+}
+
+
+LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,
+ const char *r) {
+ const char *wild;
+ size_t l = strlen(p);
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ while ((wild = strstr(s, p)) != NULL) {
+ luaL_addlstring(&b, s, wild - s); /* push prefix */
+ luaL_addstring(&b, r); /* push replacement in place of pattern */
+ s = wild + l; /* continue after `p' */
+ }
+ luaL_addstring(&b, s); /* push last suffix */
+ luaL_pushresult(&b);
+ return lua_tostring(L, -1);
+}
+
+
+static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
+ (void)ud; (void)osize; /* not used */
+ if (nsize == 0) {
+ free(ptr);
+ return NULL;
+ }
+ else
+ return realloc(ptr, nsize);
+}
+
+
+static int panic (lua_State *L) {
+ luai_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
+ lua_tostring(L, -1));
+ return 0; /* return to Lua to abort */
+}
+
+
+LUALIB_API lua_State *luaL_newstate (void) {
+ lua_State *L = lua_newstate(l_alloc, NULL);
+ if (L) lua_atpanic(L, &panic);
+ return L;
+}
+
+
+LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver) {
+ const lua_Number *v = lua_version(L);
+ if (v != lua_version(NULL))
+ luaL_error(L, "multiple Lua VMs detected");
+ else if (*v != ver)
+ luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
+ ver, *v);
+ /* check conversions number -> integer types */
+ lua_pushnumber(L, -(lua_Number)0x1234);
+ if (lua_tointeger(L, -1) != -0x1234 ||
+ lua_tounsigned(L, -1) != (lua_Unsigned)-0x1234)
+ luaL_error(L, "bad conversion number->int;"
+ " must recompile Lua with proper settings");
+ lua_pop(L, 1);
+}
+
--- /dev/null
+/*
+** $Id: lauxlib.h,v 1.120 2011/11/29 15:55:08 roberto Exp $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lauxlib_h
+#define lauxlib_h
+
+
+#include <stddef.h>
+#include <stdio.h>
+
+#include "lua.h"
+
+
+
+/* extra error code for `luaL_load' */
+#define LUA_ERRFILE (LUA_ERRERR+1)
+
+
+typedef struct luaL_Reg {
+ const char *name;
+ lua_CFunction func;
+} luaL_Reg;
+
+
+LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver);
+#define luaL_checkversion(L) luaL_checkversion_(L, LUA_VERSION_NUM)
+
+LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);
+LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);
+LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);
+LUALIB_API int (luaL_argerror) (lua_State *L, int numarg, const char *extramsg);
+LUALIB_API const char *(luaL_checklstring) (lua_State *L, int numArg,
+ size_t *l);
+LUALIB_API const char *(luaL_optlstring) (lua_State *L, int numArg,
+ const char *def, size_t *l);
+LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int numArg);
+LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int nArg, lua_Number def);
+
+LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int numArg);
+LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int nArg,
+ lua_Integer def);
+LUALIB_API lua_Unsigned (luaL_checkunsigned) (lua_State *L, int numArg);
+LUALIB_API lua_Unsigned (luaL_optunsigned) (lua_State *L, int numArg,
+ lua_Unsigned def);
+
+LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);
+LUALIB_API void (luaL_checktype) (lua_State *L, int narg, int t);
+LUALIB_API void (luaL_checkany) (lua_State *L, int narg);
+
+LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);
+LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);
+LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);
+LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
+
+LUALIB_API void (luaL_where) (lua_State *L, int lvl);
+LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);
+
+LUALIB_API int (luaL_checkoption) (lua_State *L, int narg, const char *def,
+ const char *const lst[]);
+
+LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
+LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
+
+/* pre-defined references */
+#define LUA_NOREF (-2)
+#define LUA_REFNIL (-1)
+
+LUALIB_API int (luaL_ref) (lua_State *L, int t);
+LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);
+
+LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,
+ const char *mode);
+
+#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)
+
+LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,
+ const char *name, const char *mode);
+LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
+
+LUALIB_API lua_State *(luaL_newstate) (void);
+
+LUALIB_API int (luaL_len) (lua_State *L, int idx);
+
+LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p,
+ const char *r);
+
+LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);
+
+LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);
+
+LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,
+ const char *msg, int level);
+
+LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
+ lua_CFunction openf, int glb);
+
+/*
+** ===============================================================
+** some useful macros
+** ===============================================================
+*/
+
+
+#define luaL_newlibtable(L,l) \
+ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)
+
+#define luaL_newlib(L,l) (luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))
+
+#define luaL_argcheck(L, cond,numarg,extramsg) \
+ ((void)((cond) || luaL_argerror(L, (numarg), (extramsg))))
+#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
+#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
+#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))
+#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))
+#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))
+#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))
+
+#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))
+
+#define luaL_dofile(L, fn) \
+ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))
+
+#define luaL_dostring(L, s) \
+ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))
+
+#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))
+
+#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))
+
+#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
+
+
+/*
+** {======================================================
+** Generic Buffer manipulation
+** =======================================================
+*/
+
+typedef struct luaL_Buffer {
+ char *b; /* buffer address */
+ size_t size; /* buffer size */
+ size_t n; /* number of characters in buffer */
+ lua_State *L;
+ char initb[LUAL_BUFFERSIZE]; /* initial buffer */
+} luaL_Buffer;
+
+
+#define luaL_addchar(B,c) \
+ ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \
+ ((B)->b[(B)->n++] = (c)))
+
+#define luaL_addsize(B,s) ((B)->n += (s))
+
+LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);
+LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);
+LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);
+LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);
+LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);
+LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);
+LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);
+LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);
+
+#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** File handles for IO library
+** =======================================================
+*/
+
+/*
+** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and
+** initial structure 'luaL_Stream' (it may contain other fields
+** after that initial structure).
+*/
+
+#define LUA_FILEHANDLE "FILE*"
+
+
+typedef struct luaL_Stream {
+ FILE *f; /* stream (NULL for incompletely created streams) */
+ lua_CFunction closef; /* to close stream (NULL for closed streams) */
+} luaL_Stream;
+
+/* }====================================================== */
+
+
+
+/* compatibility with old module system */
+#if defined(LUA_COMPAT_MODULE)
+
+LUALIB_API void (luaL_pushmodule) (lua_State *L, const char *modname,
+ int sizehint);
+LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname,
+ const luaL_Reg *l, int nup);
+
+#define luaL_register(L,n,l) (luaL_openlib(L,(n),(l),0))
+
+#endif
+
+
+#endif
+
+
--- /dev/null
+/*
+** $Id: lbaselib.c,v 1.276 2013/02/21 13:44:53 roberto Exp $
+** Basic library
+** See Copyright Notice in lua.h
+*/
+
+
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define lbaselib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+static int luaB_print (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int i;
+ lua_getglobal(L, "tostring");
+ for (i=1; i<=n; i++) {
+ const char *s;
+ size_t l;
+ lua_pushvalue(L, -1); /* function to be called */
+ lua_pushvalue(L, i); /* value to print */
+ lua_call(L, 1, 1);
+ s = lua_tolstring(L, -1, &l); /* get result */
+ if (s == NULL)
+ return luaL_error(L,
+ LUA_QL("tostring") " must return a string to " LUA_QL("print"));
+ if (i>1) luai_writestring("\t", 1);
+ luai_writestring(s, l);
+ lua_pop(L, 1); /* pop result */
+ }
+ luai_writeline();
+ return 0;
+}
+
+
+#define SPACECHARS " \f\n\r\t\v"
+
+static int luaB_tonumber (lua_State *L) {
+ if (lua_isnoneornil(L, 2)) { /* standard conversion */
+ int isnum;
+ lua_Number n = lua_tonumberx(L, 1, &isnum);
+ if (isnum) {
+ lua_pushnumber(L, n);
+ return 1;
+ } /* else not a number; must be something */
+ luaL_checkany(L, 1);
+ }
+ else {
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ const char *e = s + l; /* end point for 's' */
+ int base = luaL_checkint(L, 2);
+ int neg = 0;
+ luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
+ s += strspn(s, SPACECHARS); /* skip initial spaces */
+ if (*s == '-') { s++; neg = 1; } /* handle signal */
+ else if (*s == '+') s++;
+ if (isalnum((unsigned char)*s)) {
+ lua_Number n = 0;
+ do {
+ int digit = (isdigit((unsigned char)*s)) ? *s - '0'
+ : toupper((unsigned char)*s) - 'A' + 10;
+ if (digit >= base) break; /* invalid numeral; force a fail */
+ n = n * (lua_Number)base + (lua_Number)digit;
+ s++;
+ } while (isalnum((unsigned char)*s));
+ s += strspn(s, SPACECHARS); /* skip trailing spaces */
+ if (s == e) { /* no invalid trailing characters? */
+ lua_pushnumber(L, (neg) ? -n : n);
+ return 1;
+ } /* else not a number */
+ } /* else not a number */
+ }
+ lua_pushnil(L); /* not a number */
+ return 1;
+}
+
+
+static int luaB_error (lua_State *L) {
+ int level = luaL_optint(L, 2, 1);
+ lua_settop(L, 1);
+ if (lua_isstring(L, 1) && level > 0) { /* add extra information? */
+ luaL_where(L, level);
+ lua_pushvalue(L, 1);
+ lua_concat(L, 2);
+ }
+ return lua_error(L);
+}
+
+
+static int luaB_getmetatable (lua_State *L) {
+ luaL_checkany(L, 1);
+ if (!lua_getmetatable(L, 1)) {
+ lua_pushnil(L);
+ return 1; /* no metatable */
+ }
+ luaL_getmetafield(L, 1, "__metatable");
+ return 1; /* returns either __metatable field (if present) or metatable */
+}
+
+
+static int luaB_setmetatable (lua_State *L) {
+ int t = lua_type(L, 2);
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
+ "nil or table expected");
+ if (luaL_getmetafield(L, 1, "__metatable"))
+ return luaL_error(L, "cannot change a protected metatable");
+ lua_settop(L, 2);
+ lua_setmetatable(L, 1);
+ return 1;
+}
+
+
+static int luaB_rawequal (lua_State *L) {
+ luaL_checkany(L, 1);
+ luaL_checkany(L, 2);
+ lua_pushboolean(L, lua_rawequal(L, 1, 2));
+ return 1;
+}
+
+
+static int luaB_rawlen (lua_State *L) {
+ int t = lua_type(L, 1);
+ luaL_argcheck(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
+ "table or string expected");
+ lua_pushinteger(L, lua_rawlen(L, 1));
+ return 1;
+}
+
+
+static int luaB_rawget (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_checkany(L, 2);
+ lua_settop(L, 2);
+ lua_rawget(L, 1);
+ return 1;
+}
+
+static int luaB_rawset (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ luaL_checkany(L, 2);
+ luaL_checkany(L, 3);
+ lua_settop(L, 3);
+ lua_rawset(L, 1);
+ return 1;
+}
+
+
+static int luaB_collectgarbage (lua_State *L) {
+ static const char *const opts[] = {"stop", "restart", "collect",
+ "count", "step", "setpause", "setstepmul",
+ "setmajorinc", "isrunning", "generational", "incremental", NULL};
+ static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
+ LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
+ LUA_GCSETMAJORINC, LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC};
+ int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
+ int ex = luaL_optint(L, 2, 0);
+ int res = lua_gc(L, o, ex);
+ switch (o) {
+ case LUA_GCCOUNT: {
+ int b = lua_gc(L, LUA_GCCOUNTB, 0);
+ lua_pushnumber(L, res + ((lua_Number)b/1024));
+ lua_pushinteger(L, b);
+ return 2;
+ }
+ case LUA_GCSTEP: case LUA_GCISRUNNING: {
+ lua_pushboolean(L, res);
+ return 1;
+ }
+ default: {
+ lua_pushinteger(L, res);
+ return 1;
+ }
+ }
+}
+
+
+static int luaB_type (lua_State *L) {
+ luaL_checkany(L, 1);
+ lua_pushstring(L, luaL_typename(L, 1));
+ return 1;
+}
+
+
+static int pairsmeta (lua_State *L, const char *method, int iszero,
+ lua_CFunction iter) {
+ if (!luaL_getmetafield(L, 1, method)) { /* no metamethod? */
+ luaL_checktype(L, 1, LUA_TTABLE); /* argument must be a table */
+ lua_pushcfunction(L, iter); /* will return generator, */
+ lua_pushvalue(L, 1); /* state, */
+ if (iszero) lua_pushinteger(L, 0); /* and initial value */
+ else lua_pushnil(L);
+ }
+ else {
+ lua_pushvalue(L, 1); /* argument 'self' to metamethod */
+ lua_call(L, 1, 3); /* get 3 values from metamethod */
+ }
+ return 3;
+}
+
+
+static int luaB_next (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ lua_settop(L, 2); /* create a 2nd argument if there isn't one */
+ if (lua_next(L, 1))
+ return 2;
+ else {
+ lua_pushnil(L);
+ return 1;
+ }
+}
+
+
+static int luaB_pairs (lua_State *L) {
+ return pairsmeta(L, "__pairs", 0, luaB_next);
+}
+
+
+static int ipairsaux (lua_State *L) {
+ int i = luaL_checkint(L, 2);
+ luaL_checktype(L, 1, LUA_TTABLE);
+ i++; /* next value */
+ lua_pushinteger(L, i);
+ lua_rawgeti(L, 1, i);
+ return (lua_isnil(L, -1)) ? 1 : 2;
+}
+
+
+static int luaB_ipairs (lua_State *L) {
+ return pairsmeta(L, "__ipairs", 1, ipairsaux);
+}
+
+
+static int load_aux (lua_State *L, int status, int envidx) {
+ if (status == LUA_OK) {
+ if (envidx != 0) { /* 'env' parameter? */
+ lua_pushvalue(L, envidx); /* environment for loaded function */
+ if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */
+ lua_pop(L, 1); /* remove 'env' if not used by previous call */
+ }
+ return 1;
+ }
+ else { /* error (message is on top of the stack) */
+ lua_pushnil(L);
+ lua_insert(L, -2); /* put before error message */
+ return 2; /* return nil plus error message */
+ }
+}
+
+
+static int luaB_loadfile (lua_State *L) {
+ const char *fname = luaL_optstring(L, 1, NULL);
+ const char *mode = luaL_optstring(L, 2, NULL);
+ int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */
+ int status = luaL_loadfilex(L, fname, mode);
+ return load_aux(L, status, env);
+}
+
+
+/*
+** {======================================================
+** Generic Read function
+** =======================================================
+*/
+
+
+/*
+** reserved slot, above all arguments, to hold a copy of the returned
+** string to avoid it being collected while parsed. 'load' has four
+** optional arguments (chunk, source name, mode, and environment).
+*/
+#define RESERVEDSLOT 5
+
+
+/*
+** Reader for generic `load' function: `lua_load' uses the
+** stack for internal stuff, so the reader cannot change the
+** stack top. Instead, it keeps its resulting string in a
+** reserved slot inside the stack.
+*/
+static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
+ (void)(ud); /* not used */
+ luaL_checkstack(L, 2, "too many nested functions");
+ lua_pushvalue(L, 1); /* get function */
+ lua_call(L, 0, 1); /* call it */
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* pop result */
+ *size = 0;
+ return NULL;
+ }
+ else if (!lua_isstring(L, -1))
+ luaL_error(L, "reader function must return a string");
+ lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */
+ return lua_tolstring(L, RESERVEDSLOT, size);
+}
+
+
+static int luaB_load (lua_State *L) {
+ int status;
+ size_t l;
+ const char *s = lua_tolstring(L, 1, &l);
+ const char *mode = luaL_optstring(L, 3, "bt");
+ int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */
+ if (s != NULL) { /* loading a string? */
+ const char *chunkname = luaL_optstring(L, 2, s);
+ status = luaL_loadbufferx(L, s, l, chunkname, mode);
+ }
+ else { /* loading from a reader function */
+ const char *chunkname = luaL_optstring(L, 2, "=(load)");
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ lua_settop(L, RESERVEDSLOT); /* create reserved slot */
+ status = lua_load(L, generic_reader, NULL, chunkname, mode);
+ }
+ return load_aux(L, status, env);
+}
+
+/* }====================================================== */
+
+
+static int dofilecont (lua_State *L) {
+ return lua_gettop(L) - 1;
+}
+
+
+static int luaB_dofile (lua_State *L) {
+ const char *fname = luaL_optstring(L, 1, NULL);
+ lua_settop(L, 1);
+ if (luaL_loadfile(L, fname) != LUA_OK)
+ return lua_error(L);
+ lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);
+ return dofilecont(L);
+}
+
+
+static int luaB_assert (lua_State *L) {
+ if (!lua_toboolean(L, 1))
+ return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
+ return lua_gettop(L);
+}
+
+
+static int luaB_select (lua_State *L) {
+ int n = lua_gettop(L);
+ if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
+ lua_pushinteger(L, n-1);
+ return 1;
+ }
+ else {
+ int i = luaL_checkint(L, 1);
+ if (i < 0) i = n + i;
+ else if (i > n) i = n;
+ luaL_argcheck(L, 1 <= i, 1, "index out of range");
+ return n - i;
+ }
+}
+
+
+static int finishpcall (lua_State *L, int status) {
+ if (!lua_checkstack(L, 1)) { /* no space for extra boolean? */
+ lua_settop(L, 0); /* create space for return values */
+ lua_pushboolean(L, 0);
+ lua_pushstring(L, "stack overflow");
+ return 2; /* return false, msg */
+ }
+ lua_pushboolean(L, status); /* first result (status) */
+ lua_replace(L, 1); /* put first result in first slot */
+ return lua_gettop(L);
+}
+
+
+static int pcallcont (lua_State *L) {
+ int status = lua_getctx(L, NULL);
+ return finishpcall(L, (status == LUA_YIELD));
+}
+
+
+static int luaB_pcall (lua_State *L) {
+ int status;
+ luaL_checkany(L, 1);
+ lua_pushnil(L);
+ lua_insert(L, 1); /* create space for status result */
+ status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, pcallcont);
+ return finishpcall(L, (status == LUA_OK));
+}
+
+
+static int luaB_xpcall (lua_State *L) {
+ int status;
+ int n = lua_gettop(L);
+ luaL_argcheck(L, n >= 2, 2, "value expected");
+ lua_pushvalue(L, 1); /* exchange function... */
+ lua_copy(L, 2, 1); /* ...and error handler */
+ lua_replace(L, 2);
+ status = lua_pcallk(L, n - 2, LUA_MULTRET, 1, 0, pcallcont);
+ return finishpcall(L, (status == LUA_OK));
+}
+
+
+static int luaB_tostring (lua_State *L) {
+ luaL_checkany(L, 1);
+ luaL_tolstring(L, 1, NULL);
+ return 1;
+}
+
+
+static const luaL_Reg base_funcs[] = {
+ {"assert", luaB_assert},
+ {"collectgarbage", luaB_collectgarbage},
+ {"dofile", luaB_dofile},
+ {"error", luaB_error},
+ {"getmetatable", luaB_getmetatable},
+ {"ipairs", luaB_ipairs},
+ {"loadfile", luaB_loadfile},
+ {"load", luaB_load},
+#if defined(LUA_COMPAT_LOADSTRING)
+ {"loadstring", luaB_load},
+#endif
+ {"next", luaB_next},
+ {"pairs", luaB_pairs},
+ {"pcall", luaB_pcall},
+ {"print", luaB_print},
+ {"rawequal", luaB_rawequal},
+ {"rawlen", luaB_rawlen},
+ {"rawget", luaB_rawget},
+ {"rawset", luaB_rawset},
+ {"select", luaB_select},
+ {"setmetatable", luaB_setmetatable},
+ {"tonumber", luaB_tonumber},
+ {"tostring", luaB_tostring},
+ {"type", luaB_type},
+ {"xpcall", luaB_xpcall},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_base (lua_State *L) {
+ /* set global _G */
+ lua_pushglobaltable(L);
+ lua_pushglobaltable(L);
+ lua_setfield(L, -2, "_G");
+ /* open lib into global table */
+ luaL_setfuncs(L, base_funcs, 0);
+ lua_pushliteral(L, LUA_VERSION);
+ lua_setfield(L, -2, "_VERSION"); /* set global _VERSION */
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: lbitlib.c,v 1.18 2013/03/19 13:19:12 roberto Exp $
+** Standard library for bitwise operations
+** See Copyright Notice in lua.h
+*/
+
+#define lbitlib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/* number of bits to consider in a number */
+#if !defined(LUA_NBITS)
+#define LUA_NBITS 32
+#endif
+
+
+#define ALLONES (~(((~(lua_Unsigned)0) << (LUA_NBITS - 1)) << 1))
+
+/* macro to trim extra bits */
+#define trim(x) ((x) & ALLONES)
+
+
+/* builds a number with 'n' ones (1 <= n <= LUA_NBITS) */
+#define mask(n) (~((ALLONES << 1) << ((n) - 1)))
+
+
+typedef lua_Unsigned b_uint;
+
+
+
+static b_uint andaux (lua_State *L) {
+ int i, n = lua_gettop(L);
+ b_uint r = ~(b_uint)0;
+ for (i = 1; i <= n; i++)
+ r &= luaL_checkunsigned(L, i);
+ return trim(r);
+}
+
+
+static int b_and (lua_State *L) {
+ b_uint r = andaux(L);
+ lua_pushunsigned(L, r);
+ return 1;
+}
+
+
+static int b_test (lua_State *L) {
+ b_uint r = andaux(L);
+ lua_pushboolean(L, r != 0);
+ return 1;
+}
+
+
+static int b_or (lua_State *L) {
+ int i, n = lua_gettop(L);
+ b_uint r = 0;
+ for (i = 1; i <= n; i++)
+ r |= luaL_checkunsigned(L, i);
+ lua_pushunsigned(L, trim(r));
+ return 1;
+}
+
+
+static int b_xor (lua_State *L) {
+ int i, n = lua_gettop(L);
+ b_uint r = 0;
+ for (i = 1; i <= n; i++)
+ r ^= luaL_checkunsigned(L, i);
+ lua_pushunsigned(L, trim(r));
+ return 1;
+}
+
+
+static int b_not (lua_State *L) {
+ b_uint r = ~luaL_checkunsigned(L, 1);
+ lua_pushunsigned(L, trim(r));
+ return 1;
+}
+
+
+static int b_shift (lua_State *L, b_uint r, int i) {
+ if (i < 0) { /* shift right? */
+ i = -i;
+ r = trim(r);
+ if (i >= LUA_NBITS) r = 0;
+ else r >>= i;
+ }
+ else { /* shift left */
+ if (i >= LUA_NBITS) r = 0;
+ else r <<= i;
+ r = trim(r);
+ }
+ lua_pushunsigned(L, r);
+ return 1;
+}
+
+
+static int b_lshift (lua_State *L) {
+ return b_shift(L, luaL_checkunsigned(L, 1), luaL_checkint(L, 2));
+}
+
+
+static int b_rshift (lua_State *L) {
+ return b_shift(L, luaL_checkunsigned(L, 1), -luaL_checkint(L, 2));
+}
+
+
+static int b_arshift (lua_State *L) {
+ b_uint r = luaL_checkunsigned(L, 1);
+ int i = luaL_checkint(L, 2);
+ if (i < 0 || !(r & ((b_uint)1 << (LUA_NBITS - 1))))
+ return b_shift(L, r, -i);
+ else { /* arithmetic shift for 'negative' number */
+ if (i >= LUA_NBITS) r = ALLONES;
+ else
+ r = trim((r >> i) | ~(~(b_uint)0 >> i)); /* add signal bit */
+ lua_pushunsigned(L, r);
+ return 1;
+ }
+}
+
+
+static int b_rot (lua_State *L, int i) {
+ b_uint r = luaL_checkunsigned(L, 1);
+ i &= (LUA_NBITS - 1); /* i = i % NBITS */
+ r = trim(r);
+ r = (r << i) | (r >> (LUA_NBITS - i));
+ lua_pushunsigned(L, trim(r));
+ return 1;
+}
+
+
+static int b_lrot (lua_State *L) {
+ return b_rot(L, luaL_checkint(L, 2));
+}
+
+
+static int b_rrot (lua_State *L) {
+ return b_rot(L, -luaL_checkint(L, 2));
+}
+
+
+/*
+** get field and width arguments for field-manipulation functions,
+** checking whether they are valid.
+** ('luaL_error' called without 'return' to avoid later warnings about
+** 'width' being used uninitialized.)
+*/
+static int fieldargs (lua_State *L, int farg, int *width) {
+ int f = luaL_checkint(L, farg);
+ int w = luaL_optint(L, farg + 1, 1);
+ luaL_argcheck(L, 0 <= f, farg, "field cannot be negative");
+ luaL_argcheck(L, 0 < w, farg + 1, "width must be positive");
+ if (f + w > LUA_NBITS)
+ luaL_error(L, "trying to access non-existent bits");
+ *width = w;
+ return f;
+}
+
+
+static int b_extract (lua_State *L) {
+ int w;
+ b_uint r = luaL_checkunsigned(L, 1);
+ int f = fieldargs(L, 2, &w);
+ r = (r >> f) & mask(w);
+ lua_pushunsigned(L, r);
+ return 1;
+}
+
+
+static int b_replace (lua_State *L) {
+ int w;
+ b_uint r = luaL_checkunsigned(L, 1);
+ b_uint v = luaL_checkunsigned(L, 2);
+ int f = fieldargs(L, 3, &w);
+ int m = mask(w);
+ v &= m; /* erase bits outside given width */
+ r = (r & ~(m << f)) | (v << f);
+ lua_pushunsigned(L, r);
+ return 1;
+}
+
+
+static const luaL_Reg bitlib[] = {
+ {"arshift", b_arshift},
+ {"band", b_and},
+ {"bnot", b_not},
+ {"bor", b_or},
+ {"bxor", b_xor},
+ {"btest", b_test},
+ {"extract", b_extract},
+ {"lrotate", b_lrot},
+ {"lshift", b_lshift},
+ {"replace", b_replace},
+ {"rrotate", b_rrot},
+ {"rshift", b_rshift},
+ {NULL, NULL}
+};
+
+
+
+LUAMOD_API int luaopen_bit32 (lua_State *L) {
+ luaL_newlib(L, bitlib);
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: lcode.c,v 2.62 2012/08/16 17:34:28 roberto Exp $
+** Code generator for Lua
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+
+#define lcode_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lcode.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "lvm.h"
+
+
+#define hasjumps(e) ((e)->t != (e)->f)
+
+
+static int isnumeral(expdesc *e) {
+ return (e->k == VKNUM && e->t == NO_JUMP && e->f == NO_JUMP);
+}
+
+
+void luaK_nil (FuncState *fs, int from, int n) {
+ Instruction *previous;
+ int l = from + n - 1; /* last register to set nil */
+ if (fs->pc > fs->lasttarget) { /* no jumps to current position? */
+ previous = &fs->f->code[fs->pc-1];
+ if (GET_OPCODE(*previous) == OP_LOADNIL) {
+ int pfrom = GETARG_A(*previous);
+ int pl = pfrom + GETARG_B(*previous);
+ if ((pfrom <= from && from <= pl + 1) ||
+ (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */
+ if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */
+ if (pl > l) l = pl; /* l = max(l, pl) */
+ SETARG_A(*previous, from);
+ SETARG_B(*previous, l - from);
+ return;
+ }
+ } /* else go through */
+ }
+ luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */
+}
+
+
+int luaK_jump (FuncState *fs) {
+ int jpc = fs->jpc; /* save list of jumps to here */
+ int j;
+ fs->jpc = NO_JUMP;
+ j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP);
+ luaK_concat(fs, &j, jpc); /* keep them on hold */
+ return j;
+}
+
+
+void luaK_ret (FuncState *fs, int first, int nret) {
+ luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);
+}
+
+
+static int condjump (FuncState *fs, OpCode op, int A, int B, int C) {
+ luaK_codeABC(fs, op, A, B, C);
+ return luaK_jump(fs);
+}
+
+
+static void fixjump (FuncState *fs, int pc, int dest) {
+ Instruction *jmp = &fs->f->code[pc];
+ int offset = dest-(pc+1);
+ lua_assert(dest != NO_JUMP);
+ if (abs(offset) > MAXARG_sBx)
+ luaX_syntaxerror(fs->ls, "control structure too long");
+ SETARG_sBx(*jmp, offset);
+}
+
+
+/*
+** returns current `pc' and marks it as a jump target (to avoid wrong
+** optimizations with consecutive instructions not in the same basic block).
+*/
+int luaK_getlabel (FuncState *fs) {
+ fs->lasttarget = fs->pc;
+ return fs->pc;
+}
+
+
+static int getjump (FuncState *fs, int pc) {
+ int offset = GETARG_sBx(fs->f->code[pc]);
+ if (offset == NO_JUMP) /* point to itself represents end of list */
+ return NO_JUMP; /* end of list */
+ else
+ return (pc+1)+offset; /* turn offset into absolute position */
+}
+
+
+static Instruction *getjumpcontrol (FuncState *fs, int pc) {
+ Instruction *pi = &fs->f->code[pc];
+ if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1))))
+ return pi-1;
+ else
+ return pi;
+}
+
+
+/*
+** check whether list has any jump that do not produce a value
+** (or produce an inverted value)
+*/
+static int need_value (FuncState *fs, int list) {
+ for (; list != NO_JUMP; list = getjump(fs, list)) {
+ Instruction i = *getjumpcontrol(fs, list);
+ if (GET_OPCODE(i) != OP_TESTSET) return 1;
+ }
+ return 0; /* not found */
+}
+
+
+static int patchtestreg (FuncState *fs, int node, int reg) {
+ Instruction *i = getjumpcontrol(fs, node);
+ if (GET_OPCODE(*i) != OP_TESTSET)
+ return 0; /* cannot patch other instructions */
+ if (reg != NO_REG && reg != GETARG_B(*i))
+ SETARG_A(*i, reg);
+ else /* no register to put value or register already has the value */
+ *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i));
+
+ return 1;
+}
+
+
+static void removevalues (FuncState *fs, int list) {
+ for (; list != NO_JUMP; list = getjump(fs, list))
+ patchtestreg(fs, list, NO_REG);
+}
+
+
+static void patchlistaux (FuncState *fs, int list, int vtarget, int reg,
+ int dtarget) {
+ while (list != NO_JUMP) {
+ int next = getjump(fs, list);
+ if (patchtestreg(fs, list, reg))
+ fixjump(fs, list, vtarget);
+ else
+ fixjump(fs, list, dtarget); /* jump to default target */
+ list = next;
+ }
+}
+
+
+static void dischargejpc (FuncState *fs) {
+ patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc);
+ fs->jpc = NO_JUMP;
+}
+
+
+void luaK_patchlist (FuncState *fs, int list, int target) {
+ if (target == fs->pc)
+ luaK_patchtohere(fs, list);
+ else {
+ lua_assert(target < fs->pc);
+ patchlistaux(fs, list, target, NO_REG, target);
+ }
+}
+
+
+LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level) {
+ level++; /* argument is +1 to reserve 0 as non-op */
+ while (list != NO_JUMP) {
+ int next = getjump(fs, list);
+ lua_assert(GET_OPCODE(fs->f->code[list]) == OP_JMP &&
+ (GETARG_A(fs->f->code[list]) == 0 ||
+ GETARG_A(fs->f->code[list]) >= level));
+ SETARG_A(fs->f->code[list], level);
+ list = next;
+ }
+}
+
+
+void luaK_patchtohere (FuncState *fs, int list) {
+ luaK_getlabel(fs);
+ luaK_concat(fs, &fs->jpc, list);
+}
+
+
+void luaK_concat (FuncState *fs, int *l1, int l2) {
+ if (l2 == NO_JUMP) return;
+ else if (*l1 == NO_JUMP)
+ *l1 = l2;
+ else {
+ int list = *l1;
+ int next;
+ while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */
+ list = next;
+ fixjump(fs, list, l2);
+ }
+}
+
+
+static int luaK_code (FuncState *fs, Instruction i) {
+ Proto *f = fs->f;
+ dischargejpc(fs); /* `pc' will change */
+ /* put new instruction in code array */
+ luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction,
+ MAX_INT, "opcodes");
+ f->code[fs->pc] = i;
+ /* save corresponding line information */
+ luaM_growvector(fs->ls->L, f->lineinfo, fs->pc, f->sizelineinfo, int,
+ MAX_INT, "opcodes");
+ f->lineinfo[fs->pc] = fs->ls->lastline;
+ return fs->pc++;
+}
+
+
+int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {
+ lua_assert(getOpMode(o) == iABC);
+ lua_assert(getBMode(o) != OpArgN || b == 0);
+ lua_assert(getCMode(o) != OpArgN || c == 0);
+ lua_assert(a <= MAXARG_A && b <= MAXARG_B && c <= MAXARG_C);
+ return luaK_code(fs, CREATE_ABC(o, a, b, c));
+}
+
+
+int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
+ lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx);
+ lua_assert(getCMode(o) == OpArgN);
+ lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);
+ return luaK_code(fs, CREATE_ABx(o, a, bc));
+}
+
+
+static int codeextraarg (FuncState *fs, int a) {
+ lua_assert(a <= MAXARG_Ax);
+ return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a));
+}
+
+
+int luaK_codek (FuncState *fs, int reg, int k) {
+ if (k <= MAXARG_Bx)
+ return luaK_codeABx(fs, OP_LOADK, reg, k);
+ else {
+ int p = luaK_codeABx(fs, OP_LOADKX, reg, 0);
+ codeextraarg(fs, k);
+ return p;
+ }
+}
+
+
+void luaK_checkstack (FuncState *fs, int n) {
+ int newstack = fs->freereg + n;
+ if (newstack > fs->f->maxstacksize) {
+ if (newstack >= MAXSTACK)
+ luaX_syntaxerror(fs->ls, "function or expression too complex");
+ fs->f->maxstacksize = cast_byte(newstack);
+ }
+}
+
+
+void luaK_reserveregs (FuncState *fs, int n) {
+ luaK_checkstack(fs, n);
+ fs->freereg += n;
+}
+
+
+static void freereg (FuncState *fs, int reg) {
+ if (!ISK(reg) && reg >= fs->nactvar) {
+ fs->freereg--;
+ lua_assert(reg == fs->freereg);
+ }
+}
+
+
+static void freeexp (FuncState *fs, expdesc *e) {
+ if (e->k == VNONRELOC)
+ freereg(fs, e->u.info);
+}
+
+
+static int addk (FuncState *fs, TValue *key, TValue *v) {
+ lua_State *L = fs->ls->L;
+ TValue *idx = luaH_set(L, fs->h, key);
+ Proto *f = fs->f;
+ int k, oldsize;
+ if (ttisnumber(idx)) {
+ lua_Number n = nvalue(idx);
+ lua_number2int(k, n);
+ if (luaV_rawequalobj(&f->k[k], v))
+ return k;
+ /* else may be a collision (e.g., between 0.0 and "\0\0\0\0\0\0\0\0");
+ go through and create a new entry for this value */
+ }
+ /* constant not found; create a new entry */
+ oldsize = f->sizek;
+ k = fs->nk;
+ /* numerical value does not need GC barrier;
+ table has no metatable, so it does not need to invalidate cache */
+ setnvalue(idx, cast_num(k));
+ luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants");
+ while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
+ setobj(L, &f->k[k], v);
+ fs->nk++;
+ luaC_barrier(L, f, v);
+ return k;
+}
+
+
+int luaK_stringK (FuncState *fs, TString *s) {
+ TValue o;
+ setsvalue(fs->ls->L, &o, s);
+ return addk(fs, &o, &o);
+}
+
+
+int luaK_numberK (FuncState *fs, lua_Number r) {
+ int n;
+ lua_State *L = fs->ls->L;
+ TValue o;
+ setnvalue(&o, r);
+ if (r == 0 || luai_numisnan(NULL, r)) { /* handle -0 and NaN */
+ /* use raw representation as key to avoid numeric problems */
+ setsvalue(L, L->top++, luaS_newlstr(L, (char *)&r, sizeof(r)));
+ n = addk(fs, L->top - 1, &o);
+ L->top--;
+ }
+ else
+ n = addk(fs, &o, &o); /* regular case */
+ return n;
+}
+
+
+static int boolK (FuncState *fs, int b) {
+ TValue o;
+ setbvalue(&o, b);
+ return addk(fs, &o, &o);
+}
+
+
+static int nilK (FuncState *fs) {
+ TValue k, v;
+ setnilvalue(&v);
+ /* cannot use nil as key; instead use table itself to represent nil */
+ sethvalue(fs->ls->L, &k, fs->h);
+ return addk(fs, &k, &v);
+}
+
+
+void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
+ if (e->k == VCALL) { /* expression is an open function call? */
+ SETARG_C(getcode(fs, e), nresults+1);
+ }
+ else if (e->k == VVARARG) {
+ SETARG_B(getcode(fs, e), nresults+1);
+ SETARG_A(getcode(fs, e), fs->freereg);
+ luaK_reserveregs(fs, 1);
+ }
+}
+
+
+void luaK_setoneret (FuncState *fs, expdesc *e) {
+ if (e->k == VCALL) { /* expression is an open function call? */
+ e->k = VNONRELOC;
+ e->u.info = GETARG_A(getcode(fs, e));
+ }
+ else if (e->k == VVARARG) {
+ SETARG_B(getcode(fs, e), 2);
+ e->k = VRELOCABLE; /* can relocate its simple result */
+ }
+}
+
+
+void luaK_dischargevars (FuncState *fs, expdesc *e) {
+ switch (e->k) {
+ case VLOCAL: {
+ e->k = VNONRELOC;
+ break;
+ }
+ case VUPVAL: {
+ e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);
+ e->k = VRELOCABLE;
+ break;
+ }
+ case VINDEXED: {
+ OpCode op = OP_GETTABUP; /* assume 't' is in an upvalue */
+ freereg(fs, e->u.ind.idx);
+ if (e->u.ind.vt == VLOCAL) { /* 't' is in a register? */
+ freereg(fs, e->u.ind.t);
+ op = OP_GETTABLE;
+ }
+ e->u.info = luaK_codeABC(fs, op, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOCABLE;
+ break;
+ }
+ case VVARARG:
+ case VCALL: {
+ luaK_setoneret(fs, e);
+ break;
+ }
+ default: break; /* there is one value available (somewhere) */
+ }
+}
+
+
+static int code_label (FuncState *fs, int A, int b, int jump) {
+ luaK_getlabel(fs); /* those instructions may be jump targets */
+ return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump);
+}
+
+
+static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VNIL: {
+ luaK_nil(fs, reg, 1);
+ break;
+ }
+ case VFALSE: case VTRUE: {
+ luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0);
+ break;
+ }
+ case VK: {
+ luaK_codek(fs, reg, e->u.info);
+ break;
+ }
+ case VKNUM: {
+ luaK_codek(fs, reg, luaK_numberK(fs, e->u.nval));
+ break;
+ }
+ case VRELOCABLE: {
+ Instruction *pc = &getcode(fs, e);
+ SETARG_A(*pc, reg);
+ break;
+ }
+ case VNONRELOC: {
+ if (reg != e->u.info)
+ luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0);
+ break;
+ }
+ default: {
+ lua_assert(e->k == VVOID || e->k == VJMP);
+ return; /* nothing to do... */
+ }
+ }
+ e->u.info = reg;
+ e->k = VNONRELOC;
+}
+
+
+static void discharge2anyreg (FuncState *fs, expdesc *e) {
+ if (e->k != VNONRELOC) {
+ luaK_reserveregs(fs, 1);
+ discharge2reg(fs, e, fs->freereg-1);
+ }
+}
+
+
+static void exp2reg (FuncState *fs, expdesc *e, int reg) {
+ discharge2reg(fs, e, reg);
+ if (e->k == VJMP)
+ luaK_concat(fs, &e->t, e->u.info); /* put this jump in `t' list */
+ if (hasjumps(e)) {
+ int final; /* position after whole expression */
+ int p_f = NO_JUMP; /* position of an eventual LOAD false */
+ int p_t = NO_JUMP; /* position of an eventual LOAD true */
+ if (need_value(fs, e->t) || need_value(fs, e->f)) {
+ int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);
+ p_f = code_label(fs, reg, 0, 1);
+ p_t = code_label(fs, reg, 1, 0);
+ luaK_patchtohere(fs, fj);
+ }
+ final = luaK_getlabel(fs);
+ patchlistaux(fs, e->f, final, reg, p_f);
+ patchlistaux(fs, e->t, final, reg, p_t);
+ }
+ e->f = e->t = NO_JUMP;
+ e->u.info = reg;
+ e->k = VNONRELOC;
+}
+
+
+void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
+ luaK_dischargevars(fs, e);
+ freeexp(fs, e);
+ luaK_reserveregs(fs, 1);
+ exp2reg(fs, e, fs->freereg - 1);
+}
+
+
+int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
+ luaK_dischargevars(fs, e);
+ if (e->k == VNONRELOC) {
+ if (!hasjumps(e)) return e->u.info; /* exp is already in a register */
+ if (e->u.info >= fs->nactvar) { /* reg. is not a local? */
+ exp2reg(fs, e, e->u.info); /* put value on it */
+ return e->u.info;
+ }
+ }
+ luaK_exp2nextreg(fs, e); /* default */
+ return e->u.info;
+}
+
+
+void luaK_exp2anyregup (FuncState *fs, expdesc *e) {
+ if (e->k != VUPVAL || hasjumps(e))
+ luaK_exp2anyreg(fs, e);
+}
+
+
+void luaK_exp2val (FuncState *fs, expdesc *e) {
+ if (hasjumps(e))
+ luaK_exp2anyreg(fs, e);
+ else
+ luaK_dischargevars(fs, e);
+}
+
+
+int luaK_exp2RK (FuncState *fs, expdesc *e) {
+ luaK_exp2val(fs, e);
+ switch (e->k) {
+ case VTRUE:
+ case VFALSE:
+ case VNIL: {
+ if (fs->nk <= MAXINDEXRK) { /* constant fits in RK operand? */
+ e->u.info = (e->k == VNIL) ? nilK(fs) : boolK(fs, (e->k == VTRUE));
+ e->k = VK;
+ return RKASK(e->u.info);
+ }
+ else break;
+ }
+ case VKNUM: {
+ e->u.info = luaK_numberK(fs, e->u.nval);
+ e->k = VK;
+ /* go through */
+ }
+ case VK: {
+ if (e->u.info <= MAXINDEXRK) /* constant fits in argC? */
+ return RKASK(e->u.info);
+ else break;
+ }
+ default: break;
+ }
+ /* not a constant in the right range: put it in a register */
+ return luaK_exp2anyreg(fs, e);
+}
+
+
+void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {
+ switch (var->k) {
+ case VLOCAL: {
+ freeexp(fs, ex);
+ exp2reg(fs, ex, var->u.info);
+ return;
+ }
+ case VUPVAL: {
+ int e = luaK_exp2anyreg(fs, ex);
+ luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);
+ break;
+ }
+ case VINDEXED: {
+ OpCode op = (var->u.ind.vt == VLOCAL) ? OP_SETTABLE : OP_SETTABUP;
+ int e = luaK_exp2RK(fs, ex);
+ luaK_codeABC(fs, op, var->u.ind.t, var->u.ind.idx, e);
+ break;
+ }
+ default: {
+ lua_assert(0); /* invalid var kind to store */
+ break;
+ }
+ }
+ freeexp(fs, ex);
+}
+
+
+void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
+ int ereg;
+ luaK_exp2anyreg(fs, e);
+ ereg = e->u.info; /* register where 'e' was placed */
+ freeexp(fs, e);
+ e->u.info = fs->freereg; /* base register for op_self */
+ e->k = VNONRELOC;
+ luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */
+ luaK_codeABC(fs, OP_SELF, e->u.info, ereg, luaK_exp2RK(fs, key));
+ freeexp(fs, key);
+}
+
+
+static void invertjump (FuncState *fs, expdesc *e) {
+ Instruction *pc = getjumpcontrol(fs, e->u.info);
+ lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&
+ GET_OPCODE(*pc) != OP_TEST);
+ SETARG_A(*pc, !(GETARG_A(*pc)));
+}
+
+
+static int jumponcond (FuncState *fs, expdesc *e, int cond) {
+ if (e->k == VRELOCABLE) {
+ Instruction ie = getcode(fs, e);
+ if (GET_OPCODE(ie) == OP_NOT) {
+ fs->pc--; /* remove previous OP_NOT */
+ return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond);
+ }
+ /* else go through */
+ }
+ discharge2anyreg(fs, e);
+ freeexp(fs, e);
+ return condjump(fs, OP_TESTSET, NO_REG, e->u.info, cond);
+}
+
+
+void luaK_goiftrue (FuncState *fs, expdesc *e) {
+ int pc; /* pc of last jump */
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VJMP: {
+ invertjump(fs, e);
+ pc = e->u.info;
+ break;
+ }
+ case VK: case VKNUM: case VTRUE: {
+ pc = NO_JUMP; /* always true; do nothing */
+ break;
+ }
+ default: {
+ pc = jumponcond(fs, e, 0);
+ break;
+ }
+ }
+ luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */
+ luaK_patchtohere(fs, e->t);
+ e->t = NO_JUMP;
+}
+
+
+void luaK_goiffalse (FuncState *fs, expdesc *e) {
+ int pc; /* pc of last jump */
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VJMP: {
+ pc = e->u.info;
+ break;
+ }
+ case VNIL: case VFALSE: {
+ pc = NO_JUMP; /* always false; do nothing */
+ break;
+ }
+ default: {
+ pc = jumponcond(fs, e, 1);
+ break;
+ }
+ }
+ luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */
+ luaK_patchtohere(fs, e->f);
+ e->f = NO_JUMP;
+}
+
+
+static void codenot (FuncState *fs, expdesc *e) {
+ luaK_dischargevars(fs, e);
+ switch (e->k) {
+ case VNIL: case VFALSE: {
+ e->k = VTRUE;
+ break;
+ }
+ case VK: case VKNUM: case VTRUE: {
+ e->k = VFALSE;
+ break;
+ }
+ case VJMP: {
+ invertjump(fs, e);
+ break;
+ }
+ case VRELOCABLE:
+ case VNONRELOC: {
+ discharge2anyreg(fs, e);
+ freeexp(fs, e);
+ e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);
+ e->k = VRELOCABLE;
+ break;
+ }
+ default: {
+ lua_assert(0); /* cannot happen */
+ break;
+ }
+ }
+ /* interchange true and false lists */
+ { int temp = e->f; e->f = e->t; e->t = temp; }
+ removevalues(fs, e->f);
+ removevalues(fs, e->t);
+}
+
+
+void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
+ lua_assert(!hasjumps(t));
+ t->u.ind.t = t->u.info;
+ t->u.ind.idx = luaK_exp2RK(fs, k);
+ t->u.ind.vt = (t->k == VUPVAL) ? VUPVAL
+ : check_exp(vkisinreg(t->k), VLOCAL);
+ t->k = VINDEXED;
+}
+
+
+static int constfolding (OpCode op, expdesc *e1, expdesc *e2) {
+ lua_Number r;
+ if (!isnumeral(e1) || !isnumeral(e2)) return 0;
+ if ((op == OP_DIV || op == OP_MOD) && e2->u.nval == 0)
+ return 0; /* do not attempt to divide by 0 */
+ r = luaO_arith(op - OP_ADD + LUA_OPADD, e1->u.nval, e2->u.nval);
+ e1->u.nval = r;
+ return 1;
+}
+
+
+static void codearith (FuncState *fs, OpCode op,
+ expdesc *e1, expdesc *e2, int line) {
+ if (constfolding(op, e1, e2))
+ return;
+ else {
+ int o2 = (op != OP_UNM && op != OP_LEN) ? luaK_exp2RK(fs, e2) : 0;
+ int o1 = luaK_exp2RK(fs, e1);
+ if (o1 > o2) {
+ freeexp(fs, e1);
+ freeexp(fs, e2);
+ }
+ else {
+ freeexp(fs, e2);
+ freeexp(fs, e1);
+ }
+ e1->u.info = luaK_codeABC(fs, op, 0, o1, o2);
+ e1->k = VRELOCABLE;
+ luaK_fixline(fs, line);
+ }
+}
+
+
+static void codecomp (FuncState *fs, OpCode op, int cond, expdesc *e1,
+ expdesc *e2) {
+ int o1 = luaK_exp2RK(fs, e1);
+ int o2 = luaK_exp2RK(fs, e2);
+ freeexp(fs, e2);
+ freeexp(fs, e1);
+ if (cond == 0 && op != OP_EQ) {
+ int temp; /* exchange args to replace by `<' or `<=' */
+ temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */
+ cond = 1;
+ }
+ e1->u.info = condjump(fs, op, cond, o1, o2);
+ e1->k = VJMP;
+}
+
+
+void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) {
+ expdesc e2;
+ e2.t = e2.f = NO_JUMP; e2.k = VKNUM; e2.u.nval = 0;
+ switch (op) {
+ case OPR_MINUS: {
+ if (isnumeral(e)) /* minus constant? */
+ e->u.nval = luai_numunm(NULL, e->u.nval); /* fold it */
+ else {
+ luaK_exp2anyreg(fs, e);
+ codearith(fs, OP_UNM, e, &e2, line);
+ }
+ break;
+ }
+ case OPR_NOT: codenot(fs, e); break;
+ case OPR_LEN: {
+ luaK_exp2anyreg(fs, e); /* cannot operate on constants */
+ codearith(fs, OP_LEN, e, &e2, line);
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+
+void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
+ switch (op) {
+ case OPR_AND: {
+ luaK_goiftrue(fs, v);
+ break;
+ }
+ case OPR_OR: {
+ luaK_goiffalse(fs, v);
+ break;
+ }
+ case OPR_CONCAT: {
+ luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */
+ break;
+ }
+ case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
+ case OPR_MOD: case OPR_POW: {
+ if (!isnumeral(v)) luaK_exp2RK(fs, v);
+ break;
+ }
+ default: {
+ luaK_exp2RK(fs, v);
+ break;
+ }
+ }
+}
+
+
+void luaK_posfix (FuncState *fs, BinOpr op,
+ expdesc *e1, expdesc *e2, int line) {
+ switch (op) {
+ case OPR_AND: {
+ lua_assert(e1->t == NO_JUMP); /* list must be closed */
+ luaK_dischargevars(fs, e2);
+ luaK_concat(fs, &e2->f, e1->f);
+ *e1 = *e2;
+ break;
+ }
+ case OPR_OR: {
+ lua_assert(e1->f == NO_JUMP); /* list must be closed */
+ luaK_dischargevars(fs, e2);
+ luaK_concat(fs, &e2->t, e1->t);
+ *e1 = *e2;
+ break;
+ }
+ case OPR_CONCAT: {
+ luaK_exp2val(fs, e2);
+ if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) {
+ lua_assert(e1->u.info == GETARG_B(getcode(fs, e2))-1);
+ freeexp(fs, e1);
+ SETARG_B(getcode(fs, e2), e1->u.info);
+ e1->k = VRELOCABLE; e1->u.info = e2->u.info;
+ }
+ else {
+ luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */
+ codearith(fs, OP_CONCAT, e1, e2, line);
+ }
+ break;
+ }
+ case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
+ case OPR_MOD: case OPR_POW: {
+ codearith(fs, cast(OpCode, op - OPR_ADD + OP_ADD), e1, e2, line);
+ break;
+ }
+ case OPR_EQ: case OPR_LT: case OPR_LE: {
+ codecomp(fs, cast(OpCode, op - OPR_EQ + OP_EQ), 1, e1, e2);
+ break;
+ }
+ case OPR_NE: case OPR_GT: case OPR_GE: {
+ codecomp(fs, cast(OpCode, op - OPR_NE + OP_EQ), 0, e1, e2);
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+
+void luaK_fixline (FuncState *fs, int line) {
+ fs->f->lineinfo[fs->pc - 1] = line;
+}
+
+
+void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) {
+ int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1;
+ int b = (tostore == LUA_MULTRET) ? 0 : tostore;
+ lua_assert(tostore != 0);
+ if (c <= MAXARG_C)
+ luaK_codeABC(fs, OP_SETLIST, base, b, c);
+ else if (c <= MAXARG_Ax) {
+ luaK_codeABC(fs, OP_SETLIST, base, b, 0);
+ codeextraarg(fs, c);
+ }
+ else
+ luaX_syntaxerror(fs->ls, "constructor too long");
+ fs->freereg = base + 1; /* free registers with list values */
+}
+
--- /dev/null
+/*
+** $Id: lcode.h,v 1.58 2011/08/30 16:26:41 roberto Exp $
+** Code generator for Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lcode_h
+#define lcode_h
+
+#include "llex.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+
+
+/*
+** Marks the end of a patch list. It is an invalid value both as an absolute
+** address, and as a list link (would link an element to itself).
+*/
+#define NO_JUMP (-1)
+
+
+/*
+** grep "ORDER OPR" if you change these enums (ORDER OP)
+*/
+typedef enum BinOpr {
+ OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW,
+ OPR_CONCAT,
+ OPR_EQ, OPR_LT, OPR_LE,
+ OPR_NE, OPR_GT, OPR_GE,
+ OPR_AND, OPR_OR,
+ OPR_NOBINOPR
+} BinOpr;
+
+
+typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
+
+
+#define getcode(fs,e) ((fs)->f->code[(e)->u.info])
+
+#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx)
+
+#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)
+
+#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t)
+
+LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
+LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
+LUAI_FUNC int luaK_codek (FuncState *fs, int reg, int k);
+LUAI_FUNC void luaK_fixline (FuncState *fs, int line);
+LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);
+LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);
+LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);
+LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s);
+LUAI_FUNC int luaK_numberK (FuncState *fs, lua_Number r);
+LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
+LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
+LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e);
+LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
+LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);
+LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);
+LUAI_FUNC int luaK_jump (FuncState *fs);
+LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);
+LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);
+LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);
+LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level);
+LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);
+LUAI_FUNC int luaK_getlabel (FuncState *fs);
+LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line);
+LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
+LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1,
+ expdesc *v2, int line);
+LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
+
+
+#endif
--- /dev/null
+/*
+** $Id: lcorolib.c,v 1.5 2013/02/21 13:44:53 roberto Exp $
+** Coroutine Library
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+
+
+#define lcorolib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+static int auxresume (lua_State *L, lua_State *co, int narg) {
+ int status;
+ if (!lua_checkstack(co, narg)) {
+ lua_pushliteral(L, "too many arguments to resume");
+ return -1; /* error flag */
+ }
+ if (lua_status(co) == LUA_OK && lua_gettop(co) == 0) {
+ lua_pushliteral(L, "cannot resume dead coroutine");
+ return -1; /* error flag */
+ }
+ lua_xmove(L, co, narg);
+ status = lua_resume(co, L, narg);
+ if (status == LUA_OK || status == LUA_YIELD) {
+ int nres = lua_gettop(co);
+ if (!lua_checkstack(L, nres + 1)) {
+ lua_pop(co, nres); /* remove results anyway */
+ lua_pushliteral(L, "too many results to resume");
+ return -1; /* error flag */
+ }
+ lua_xmove(co, L, nres); /* move yielded values */
+ return nres;
+ }
+ else {
+ lua_xmove(co, L, 1); /* move error message */
+ return -1; /* error flag */
+ }
+}
+
+
+static int luaB_coresume (lua_State *L) {
+ lua_State *co = lua_tothread(L, 1);
+ int r;
+ luaL_argcheck(L, co, 1, "coroutine expected");
+ r = auxresume(L, co, lua_gettop(L) - 1);
+ if (r < 0) {
+ lua_pushboolean(L, 0);
+ lua_insert(L, -2);
+ return 2; /* return false + error message */
+ }
+ else {
+ lua_pushboolean(L, 1);
+ lua_insert(L, -(r + 1));
+ return r + 1; /* return true + `resume' returns */
+ }
+}
+
+
+static int luaB_auxwrap (lua_State *L) {
+ lua_State *co = lua_tothread(L, lua_upvalueindex(1));
+ int r = auxresume(L, co, lua_gettop(L));
+ if (r < 0) {
+ if (lua_isstring(L, -1)) { /* error object is a string? */
+ luaL_where(L, 1); /* add extra info */
+ lua_insert(L, -2);
+ lua_concat(L, 2);
+ }
+ return lua_error(L); /* propagate error */
+ }
+ return r;
+}
+
+
+static int luaB_cocreate (lua_State *L) {
+ lua_State *NL;
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ NL = lua_newthread(L);
+ lua_pushvalue(L, 1); /* move function to top */
+ lua_xmove(L, NL, 1); /* move function from L to NL */
+ return 1;
+}
+
+
+static int luaB_cowrap (lua_State *L) {
+ luaB_cocreate(L);
+ lua_pushcclosure(L, luaB_auxwrap, 1);
+ return 1;
+}
+
+
+static int luaB_yield (lua_State *L) {
+ return lua_yield(L, lua_gettop(L));
+}
+
+
+static int luaB_costatus (lua_State *L) {
+ lua_State *co = lua_tothread(L, 1);
+ luaL_argcheck(L, co, 1, "coroutine expected");
+ if (L == co) lua_pushliteral(L, "running");
+ else {
+ switch (lua_status(co)) {
+ case LUA_YIELD:
+ lua_pushliteral(L, "suspended");
+ break;
+ case LUA_OK: {
+ lua_Debug ar;
+ if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */
+ lua_pushliteral(L, "normal"); /* it is running */
+ else if (lua_gettop(co) == 0)
+ lua_pushliteral(L, "dead");
+ else
+ lua_pushliteral(L, "suspended"); /* initial state */
+ break;
+ }
+ default: /* some error occurred */
+ lua_pushliteral(L, "dead");
+ break;
+ }
+ }
+ return 1;
+}
+
+
+static int luaB_corunning (lua_State *L) {
+ int ismain = lua_pushthread(L);
+ lua_pushboolean(L, ismain);
+ return 2;
+}
+
+
+static const luaL_Reg co_funcs[] = {
+ {"create", luaB_cocreate},
+ {"resume", luaB_coresume},
+ {"running", luaB_corunning},
+ {"status", luaB_costatus},
+ {"wrap", luaB_cowrap},
+ {"yield", luaB_yield},
+ {NULL, NULL}
+};
+
+
+
+LUAMOD_API int luaopen_coroutine (lua_State *L) {
+ luaL_newlib(L, co_funcs);
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: lctype.c,v 1.11 2011/10/03 16:19:23 roberto Exp $
+** 'ctype' functions for Lua
+** See Copyright Notice in lua.h
+*/
+
+#define lctype_c
+#define LUA_CORE
+
+#include "lctype.h"
+
+#if !LUA_USE_CTYPE /* { */
+
+#include <limits.h>
+
+LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {
+ 0x00, /* EOZ */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */
+ 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */
+ 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
+ 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */
+ 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */
+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05,
+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */
+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 8. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 9. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* a. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* b. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* c. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* d. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* e. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* f. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+};
+
+#endif /* } */
--- /dev/null
+/*
+** $Id: lctype.h,v 1.12 2011/07/15 12:50:29 roberto Exp $
+** 'ctype' functions for Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lctype_h
+#define lctype_h
+
+#include "lua.h"
+
+
+/*
+** WARNING: the functions defined here do not necessarily correspond
+** to the similar functions in the standard C ctype.h. They are
+** optimized for the specific needs of Lua
+*/
+
+#if !defined(LUA_USE_CTYPE)
+
+#if 'A' == 65 && '0' == 48
+/* ASCII case: can use its own tables; faster and fixed */
+#define LUA_USE_CTYPE 0
+#else
+/* must use standard C ctype */
+#define LUA_USE_CTYPE 1
+#endif
+
+#endif
+
+
+#if !LUA_USE_CTYPE /* { */
+
+#include <limits.h>
+
+#include "llimits.h"
+
+
+#define ALPHABIT 0
+#define DIGITBIT 1
+#define PRINTBIT 2
+#define SPACEBIT 3
+#define XDIGITBIT 4
+
+
+#define MASK(B) (1 << (B))
+
+
+/*
+** add 1 to char to allow index -1 (EOZ)
+*/
+#define testprop(c,p) (luai_ctype_[(c)+1] & (p))
+
+/*
+** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'
+*/
+#define lislalpha(c) testprop(c, MASK(ALPHABIT))
+#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))
+#define lisdigit(c) testprop(c, MASK(DIGITBIT))
+#define lisspace(c) testprop(c, MASK(SPACEBIT))
+#define lisprint(c) testprop(c, MASK(PRINTBIT))
+#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))
+
+/*
+** this 'ltolower' only works for alphabetic characters
+*/
+#define ltolower(c) ((c) | ('A' ^ 'a'))
+
+
+/* two more entries for 0 and -1 (EOZ) */
+LUAI_DDEC const lu_byte luai_ctype_[UCHAR_MAX + 2];
+
+
+#else /* }{ */
+
+/*
+** use standard C ctypes
+*/
+
+#include <ctype.h>
+
+
+#define lislalpha(c) (isalpha(c) || (c) == '_')
+#define lislalnum(c) (isalnum(c) || (c) == '_')
+#define lisdigit(c) (isdigit(c))
+#define lisspace(c) (isspace(c))
+#define lisprint(c) (isprint(c))
+#define lisxdigit(c) (isxdigit(c))
+
+#define ltolower(c) (tolower(c))
+
+#endif /* } */
+
+#endif
+
--- /dev/null
+/*
+** $Id: ldblib.c,v 1.132 2012/01/19 20:14:44 roberto Exp $
+** Interface from Lua to its debug API
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define ldblib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#define HOOKKEY "_HKEY"
+
+
+
+static int db_getregistry (lua_State *L) {
+ lua_pushvalue(L, LUA_REGISTRYINDEX);
+ return 1;
+}
+
+
+static int db_getmetatable (lua_State *L) {
+ luaL_checkany(L, 1);
+ if (!lua_getmetatable(L, 1)) {
+ lua_pushnil(L); /* no metatable */
+ }
+ return 1;
+}
+
+
+static int db_setmetatable (lua_State *L) {
+ int t = lua_type(L, 2);
+ luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
+ "nil or table expected");
+ lua_settop(L, 2);
+ lua_setmetatable(L, 1);
+ return 1; /* return 1st argument */
+}
+
+
+static int db_getuservalue (lua_State *L) {
+ if (lua_type(L, 1) != LUA_TUSERDATA)
+ lua_pushnil(L);
+ else
+ lua_getuservalue(L, 1);
+ return 1;
+}
+
+
+static int db_setuservalue (lua_State *L) {
+ if (lua_type(L, 1) == LUA_TLIGHTUSERDATA)
+ luaL_argerror(L, 1, "full userdata expected, got light userdata");
+ luaL_checktype(L, 1, LUA_TUSERDATA);
+ if (!lua_isnoneornil(L, 2))
+ luaL_checktype(L, 2, LUA_TTABLE);
+ lua_settop(L, 2);
+ lua_setuservalue(L, 1);
+ return 1;
+}
+
+
+static void settabss (lua_State *L, const char *i, const char *v) {
+ lua_pushstring(L, v);
+ lua_setfield(L, -2, i);
+}
+
+
+static void settabsi (lua_State *L, const char *i, int v) {
+ lua_pushinteger(L, v);
+ lua_setfield(L, -2, i);
+}
+
+
+static void settabsb (lua_State *L, const char *i, int v) {
+ lua_pushboolean(L, v);
+ lua_setfield(L, -2, i);
+}
+
+
+static lua_State *getthread (lua_State *L, int *arg) {
+ if (lua_isthread(L, 1)) {
+ *arg = 1;
+ return lua_tothread(L, 1);
+ }
+ else {
+ *arg = 0;
+ return L;
+ }
+}
+
+
+static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
+ if (L == L1) {
+ lua_pushvalue(L, -2);
+ lua_remove(L, -3);
+ }
+ else
+ lua_xmove(L1, L, 1);
+ lua_setfield(L, -2, fname);
+}
+
+
+static int db_getinfo (lua_State *L) {
+ lua_Debug ar;
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ const char *options = luaL_optstring(L, arg+2, "flnStu");
+ if (lua_isnumber(L, arg+1)) {
+ if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), &ar)) {
+ lua_pushnil(L); /* level out of range */
+ return 1;
+ }
+ }
+ else if (lua_isfunction(L, arg+1)) {
+ lua_pushfstring(L, ">%s", options);
+ options = lua_tostring(L, -1);
+ lua_pushvalue(L, arg+1);
+ lua_xmove(L, L1, 1);
+ }
+ else
+ return luaL_argerror(L, arg+1, "function or level expected");
+ if (!lua_getinfo(L1, options, &ar))
+ return luaL_argerror(L, arg+2, "invalid option");
+ lua_createtable(L, 0, 2);
+ if (strchr(options, 'S')) {
+ settabss(L, "source", ar.source);
+ settabss(L, "short_src", ar.short_src);
+ settabsi(L, "linedefined", ar.linedefined);
+ settabsi(L, "lastlinedefined", ar.lastlinedefined);
+ settabss(L, "what", ar.what);
+ }
+ if (strchr(options, 'l'))
+ settabsi(L, "currentline", ar.currentline);
+ if (strchr(options, 'u')) {
+ settabsi(L, "nups", ar.nups);
+ settabsi(L, "nparams", ar.nparams);
+ settabsb(L, "isvararg", ar.isvararg);
+ }
+ if (strchr(options, 'n')) {
+ settabss(L, "name", ar.name);
+ settabss(L, "namewhat", ar.namewhat);
+ }
+ if (strchr(options, 't'))
+ settabsb(L, "istailcall", ar.istailcall);
+ if (strchr(options, 'L'))
+ treatstackoption(L, L1, "activelines");
+ if (strchr(options, 'f'))
+ treatstackoption(L, L1, "func");
+ return 1; /* return table */
+}
+
+
+static int db_getlocal (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ lua_Debug ar;
+ const char *name;
+ int nvar = luaL_checkint(L, arg+2); /* local-variable index */
+ if (lua_isfunction(L, arg + 1)) { /* function argument? */
+ lua_pushvalue(L, arg + 1); /* push function */
+ lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */
+ return 1;
+ }
+ else { /* stack-level argument */
+ if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
+ return luaL_argerror(L, arg+1, "level out of range");
+ name = lua_getlocal(L1, &ar, nvar);
+ if (name) {
+ lua_xmove(L1, L, 1); /* push local value */
+ lua_pushstring(L, name); /* push name */
+ lua_pushvalue(L, -2); /* re-order */
+ return 2;
+ }
+ else {
+ lua_pushnil(L); /* no name (nor value) */
+ return 1;
+ }
+ }
+}
+
+
+static int db_setlocal (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ lua_Debug ar;
+ if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
+ return luaL_argerror(L, arg+1, "level out of range");
+ luaL_checkany(L, arg+3);
+ lua_settop(L, arg+3);
+ lua_xmove(L, L1, 1);
+ lua_pushstring(L, lua_setlocal(L1, &ar, luaL_checkint(L, arg+2)));
+ return 1;
+}
+
+
+static int auxupvalue (lua_State *L, int get) {
+ const char *name;
+ int n = luaL_checkint(L, 2);
+ luaL_checktype(L, 1, LUA_TFUNCTION);
+ name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
+ if (name == NULL) return 0;
+ lua_pushstring(L, name);
+ lua_insert(L, -(get+1));
+ return get + 1;
+}
+
+
+static int db_getupvalue (lua_State *L) {
+ return auxupvalue(L, 1);
+}
+
+
+static int db_setupvalue (lua_State *L) {
+ luaL_checkany(L, 3);
+ return auxupvalue(L, 0);
+}
+
+
+static int checkupval (lua_State *L, int argf, int argnup) {
+ lua_Debug ar;
+ int nup = luaL_checkint(L, argnup);
+ luaL_checktype(L, argf, LUA_TFUNCTION);
+ lua_pushvalue(L, argf);
+ lua_getinfo(L, ">u", &ar);
+ luaL_argcheck(L, 1 <= nup && nup <= ar.nups, argnup, "invalid upvalue index");
+ return nup;
+}
+
+
+static int db_upvalueid (lua_State *L) {
+ int n = checkupval(L, 1, 2);
+ lua_pushlightuserdata(L, lua_upvalueid(L, 1, n));
+ return 1;
+}
+
+
+static int db_upvaluejoin (lua_State *L) {
+ int n1 = checkupval(L, 1, 2);
+ int n2 = checkupval(L, 3, 4);
+ luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
+ luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
+ lua_upvaluejoin(L, 1, n1, 3, n2);
+ return 0;
+}
+
+
+#define gethooktable(L) luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)
+
+
+static void hookf (lua_State *L, lua_Debug *ar) {
+ static const char *const hooknames[] =
+ {"call", "return", "line", "count", "tail call"};
+ gethooktable(L);
+ lua_pushthread(L);
+ lua_rawget(L, -2);
+ if (lua_isfunction(L, -1)) {
+ lua_pushstring(L, hooknames[(int)ar->event]);
+ if (ar->currentline >= 0)
+ lua_pushinteger(L, ar->currentline);
+ else lua_pushnil(L);
+ lua_assert(lua_getinfo(L, "lS", ar));
+ lua_call(L, 2, 0);
+ }
+}
+
+
+static int makemask (const char *smask, int count) {
+ int mask = 0;
+ if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
+ if (strchr(smask, 'r')) mask |= LUA_MASKRET;
+ if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
+ if (count > 0) mask |= LUA_MASKCOUNT;
+ return mask;
+}
+
+
+static char *unmakemask (int mask, char *smask) {
+ int i = 0;
+ if (mask & LUA_MASKCALL) smask[i++] = 'c';
+ if (mask & LUA_MASKRET) smask[i++] = 'r';
+ if (mask & LUA_MASKLINE) smask[i++] = 'l';
+ smask[i] = '\0';
+ return smask;
+}
+
+
+static int db_sethook (lua_State *L) {
+ int arg, mask, count;
+ lua_Hook func;
+ lua_State *L1 = getthread(L, &arg);
+ if (lua_isnoneornil(L, arg+1)) {
+ lua_settop(L, arg+1);
+ func = NULL; mask = 0; count = 0; /* turn off hooks */
+ }
+ else {
+ const char *smask = luaL_checkstring(L, arg+2);
+ luaL_checktype(L, arg+1, LUA_TFUNCTION);
+ count = luaL_optint(L, arg+3, 0);
+ func = hookf; mask = makemask(smask, count);
+ }
+ if (gethooktable(L) == 0) { /* creating hook table? */
+ lua_pushstring(L, "k");
+ lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
+ lua_pushvalue(L, -1);
+ lua_setmetatable(L, -2); /* setmetatable(hooktable) = hooktable */
+ }
+ lua_pushthread(L1); lua_xmove(L1, L, 1);
+ lua_pushvalue(L, arg+1);
+ lua_rawset(L, -3); /* set new hook */
+ lua_sethook(L1, func, mask, count); /* set hooks */
+ return 0;
+}
+
+
+static int db_gethook (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ char buff[5];
+ int mask = lua_gethookmask(L1);
+ lua_Hook hook = lua_gethook(L1);
+ if (hook != NULL && hook != hookf) /* external hook? */
+ lua_pushliteral(L, "external hook");
+ else {
+ gethooktable(L);
+ lua_pushthread(L1); lua_xmove(L1, L, 1);
+ lua_rawget(L, -2); /* get hook */
+ lua_remove(L, -2); /* remove hook table */
+ }
+ lua_pushstring(L, unmakemask(mask, buff));
+ lua_pushinteger(L, lua_gethookcount(L1));
+ return 3;
+}
+
+
+static int db_debug (lua_State *L) {
+ for (;;) {
+ char buffer[250];
+ luai_writestringerror("%s", "lua_debug> ");
+ if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
+ strcmp(buffer, "cont\n") == 0)
+ return 0;
+ if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
+ lua_pcall(L, 0, 0, 0))
+ luai_writestringerror("%s\n", lua_tostring(L, -1));
+ lua_settop(L, 0); /* remove eventual returns */
+ }
+}
+
+
+static int db_traceback (lua_State *L) {
+ int arg;
+ lua_State *L1 = getthread(L, &arg);
+ const char *msg = lua_tostring(L, arg + 1);
+ if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */
+ lua_pushvalue(L, arg + 1); /* return it untouched */
+ else {
+ int level = luaL_optint(L, arg + 2, (L == L1) ? 1 : 0);
+ luaL_traceback(L, L1, msg, level);
+ }
+ return 1;
+}
+
+
+static const luaL_Reg dblib[] = {
+ {"debug", db_debug},
+ {"getuservalue", db_getuservalue},
+ {"gethook", db_gethook},
+ {"getinfo", db_getinfo},
+ {"getlocal", db_getlocal},
+ {"getregistry", db_getregistry},
+ {"getmetatable", db_getmetatable},
+ {"getupvalue", db_getupvalue},
+ {"upvaluejoin", db_upvaluejoin},
+ {"upvalueid", db_upvalueid},
+ {"setuservalue", db_setuservalue},
+ {"sethook", db_sethook},
+ {"setlocal", db_setlocal},
+ {"setmetatable", db_setmetatable},
+ {"setupvalue", db_setupvalue},
+ {"traceback", db_traceback},
+ {NULL, NULL}
+};
+
+
+LUAMOD_API int luaopen_debug (lua_State *L) {
+ luaL_newlib(L, dblib);
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: ldebug.c,v 2.90 2012/08/16 17:34:28 roberto Exp $
+** Debug Interface
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdarg.h>
+#include <stddef.h>
+#include <string.h>
+
+
+#define ldebug_c
+#define LUA_CORE
+
+#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"
+
+
+
+#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL)
+
+
+static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
+
+
+static int currentpc (CallInfo *ci) {
+ lua_assert(isLua(ci));
+ return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
+}
+
+
+static int currentline (CallInfo *ci) {
+ return getfuncline(ci_func(ci)->p, currentpc(ci));
+}
+
+
+/*
+** 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;
+ }
+ if (isLua(L->ci))
+ L->oldpc = L->ci->u.l.savedpc;
+ L->hook = func;
+ L->basehookcount = count;
+ resethookcount(L);
+ L->hookmask = cast_byte(mask);
+ 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;
+ if (level < 0) return 0; /* invalid (negative) level */
+ lua_lock(L);
+ for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
+ level--;
+ if (level == 0 && ci != &L->base_ci) { /* level found? */
+ status = 1;
+ ar->i_ci = ci;
+ }
+ else status = 0; /* no such level */
+ lua_unlock(L);
+ return status;
+}
+
+
+static const char *upvalname (Proto *p, int uv) {
+ TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
+ if (s == NULL) return "?";
+ else return getstr(s);
+}
+
+
+static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
+ int nparams = clLvalue(ci->func)->p->numparams;
+ if (n >= ci->u.l.base - ci->func - nparams)
+ return NULL; /* no such vararg */
+ else {
+ *pos = ci->func + nparams + n;
+ return "(*vararg)"; /* generic name for any vararg */
+ }
+}
+
+
+static const char *findlocal (lua_State *L, CallInfo *ci, int n,
+ StkId *pos) {
+ const char *name = NULL;
+ StkId base;
+ if (isLua(ci)) {
+ if (n < 0) /* access to vararg values? */
+ return findvararg(ci, -n, pos);
+ else {
+ base = ci->u.l.base;
+ name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
+ }
+ }
+ else
+ base = ci->func + 1;
+ if (name == NULL) { /* no 'standard' name? */
+ StkId limit = (ci == L->ci) ? L->top : ci->next->func;
+ if (limit - base >= n && n > 0) /* is 'n' inside 'ci' stack? */
+ name = "(*temporary)"; /* generic name for any valid slot */
+ else
+ return NULL; /* no name */
+ }
+ *pos = base + (n - 1);
+ return name;
+}
+
+
+LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
+ const char *name;
+ lua_lock(L);
+ if (ar == NULL) { /* information about non-active function? */
+ if (!isLfunction(L->top - 1)) /* not a Lua function? */
+ name = NULL;
+ else /* consider live variables at function start (parameters) */
+ name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);
+ }
+ else { /* active function; get information through 'ar' */
+ StkId pos = 0; /* to avoid warnings */
+ name = findlocal(L, ar->i_ci, n, &pos);
+ if (name) {
+ setobj2s(L, L->top, pos);
+ api_incr_top(L);
+ }
+ }
+ lua_unlock(L);
+ return name;
+}
+
+
+LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
+ StkId pos = 0; /* to avoid warnings */
+ const char *name = findlocal(L, ar->i_ci, n, &pos);
+ lua_lock(L);
+ if (name)
+ setobjs2s(L, pos, L->top - 1);
+ L->top--; /* pop value */
+ lua_unlock(L);
+ return name;
+}
+
+
+static void funcinfo (lua_Debug *ar, Closure *cl) {
+ if (noLuaClosure(cl)) {
+ ar->source = "=[C]";
+ ar->linedefined = -1;
+ ar->lastlinedefined = -1;
+ ar->what = "C";
+ }
+ else {
+ Proto *p = cl->l.p;
+ ar->source = p->source ? getstr(p->source) : "=?";
+ ar->linedefined = p->linedefined;
+ ar->lastlinedefined = p->lastlinedefined;
+ ar->what = (ar->linedefined == 0) ? "main" : "Lua";
+ }
+ luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
+}
+
+
+static void collectvalidlines (lua_State *L, Closure *f) {
+ if (noLuaClosure(f)) {
+ setnilvalue(L->top);
+ api_incr_top(L);
+ }
+ else {
+ int i;
+ TValue v;
+ int *lineinfo = f->l.p->lineinfo;
+ Table *t = luaH_new(L); /* new table to store active lines */
+ sethvalue(L, L->top, t); /* push it on stack */
+ api_incr_top(L);
+ setbvalue(&v, 1); /* boolean 'true' to be the value of all indices */
+ for (i = 0; i < f->l.p->sizelineinfo; i++) /* for all lines with code */
+ luaH_setint(L, t, lineinfo[i], &v); /* table[line] = true */
+ }
+}
+
+
+static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
+ Closure *f, CallInfo *ci) {
+ int status = 1;
+ for (; *what; what++) {
+ switch (*what) {
+ case 'S': {
+ funcinfo(ar, f);
+ break;
+ }
+ case 'l': {
+ ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;
+ break;
+ }
+ case 'u': {
+ ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
+ if (noLuaClosure(f)) {
+ ar->isvararg = 1;
+ ar->nparams = 0;
+ }
+ else {
+ ar->isvararg = f->l.p->is_vararg;
+ ar->nparams = f->l.p->numparams;
+ }
+ break;
+ }
+ case 't': {
+ ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
+ break;
+ }
+ case 'n': {
+ /* calling function is a known Lua function? */
+ if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
+ ar->namewhat = getfuncname(L, ci->previous, &ar->name);
+ else
+ ar->namewhat = NULL;
+ if (ar->namewhat == NULL) {
+ ar->namewhat = ""; /* not found */
+ ar->name = NULL;
+ }
+ break;
+ }
+ case 'L':
+ case 'f': /* handled by lua_getinfo */
+ break;
+ default: status = 0; /* invalid option */
+ }
+ }
+ return status;
+}
+
+
+LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
+ int status;
+ Closure *cl;
+ CallInfo *ci;
+ StkId func;
+ lua_lock(L);
+ if (*what == '>') {
+ ci = NULL;
+ func = L->top - 1;
+ api_check(L, ttisfunction(func), "function expected");
+ what++; /* skip the '>' */
+ L->top--; /* pop function */
+ }
+ else {
+ ci = ar->i_ci;
+ func = ci->func;
+ lua_assert(ttisfunction(ci->func));
+ }
+ cl = ttisclosure(func) ? clvalue(func) : NULL;
+ status = auxgetinfo(L, what, ar, cl, ci);
+ if (strchr(what, 'f')) {
+ setobjs2s(L, L->top, func);
+ api_incr_top(L);
+ }
+ if (strchr(what, 'L'))
+ collectvalidlines(L, cl);
+ lua_unlock(L);
+ return status;
+}
+
+
+/*
+** {======================================================
+** Symbolic Execution
+** =======================================================
+*/
+
+static const char *getobjname (Proto *p, int lastpc, int reg,
+ const char **name);
+
+
+/*
+** find a "name" for the RK value 'c'
+*/
+static void kname (Proto *p, int pc, int c, const char **name) {
+ if (ISK(c)) { /* is 'c' a constant? */
+ TValue *kvalue = &p->k[INDEXK(c)];
+ if (ttisstring(kvalue)) { /* literal constant? */
+ *name = svalue(kvalue); /* it is its own name */
+ return;
+ }
+ /* else no reasonable name found */
+ }
+ else { /* 'c' is a register */
+ const char *what = getobjname(p, pc, c, name); /* search for 'c' */
+ if (what && *what == 'c') { /* found a constant name? */
+ return; /* 'name' already filled */
+ }
+ /* else no reasonable name found */
+ }
+ *name = "?"; /* no reasonable name found */
+}
+
+
+/*
+** try to find last instruction before 'lastpc' that modified register 'reg'
+*/
+static int findsetreg (Proto *p, int lastpc, int reg) {
+ int pc;
+ int setreg = -1; /* keep last instruction that changed 'reg' */
+ for (pc = 0; pc < lastpc; pc++) {
+ Instruction i = p->code[pc];
+ OpCode op = GET_OPCODE(i);
+ int a = GETARG_A(i);
+ switch (op) {
+ case OP_LOADNIL: {
+ int b = GETARG_B(i);
+ if (a <= reg && reg <= a + b) /* set registers from 'a' to 'a+b' */
+ setreg = pc;
+ break;
+ }
+ case OP_TFORCALL: {
+ if (reg >= a + 2) setreg = pc; /* affect all regs above its base */
+ break;
+ }
+ case OP_CALL:
+ case OP_TAILCALL: {
+ if (reg >= a) setreg = pc; /* affect all registers above base */
+ break;
+ }
+ case OP_JMP: {
+ int b = GETARG_sBx(i);
+ int dest = pc + 1 + b;
+ /* jump is forward and do not skip `lastpc'? */
+ if (pc < dest && dest <= lastpc)
+ pc += b; /* do the jump */
+ break;
+ }
+ case OP_TEST: {
+ if (reg == a) setreg = pc; /* jumped code can change 'a' */
+ break;
+ }
+ default:
+ if (testAMode(op) && reg == a) /* any instruction that set A */
+ setreg = pc;
+ break;
+ }
+ }
+ return setreg;
+}
+
+
+static const char *getobjname (Proto *p, int lastpc, int reg,
+ const char **name) {
+ int pc;
+ *name = luaF_getlocalname(p, reg + 1, lastpc);
+ if (*name) /* is a local? */
+ return "local";
+ /* else try symbolic execution */
+ pc = findsetreg(p, lastpc, reg);
+ if (pc != -1) { /* could find instruction? */
+ Instruction i = p->code[pc];
+ OpCode op = GET_OPCODE(i);
+ switch (op) {
+ case OP_MOVE: {
+ int b = GETARG_B(i); /* move from 'b' to 'a' */
+ if (b < GETARG_A(i))
+ return getobjname(p, pc, b, name); /* get name for 'b' */
+ break;
+ }
+ case OP_GETTABUP:
+ case OP_GETTABLE: {
+ int k = GETARG_C(i); /* key index */
+ int t = GETARG_B(i); /* table index */
+ const char *vn = (op == OP_GETTABLE) /* name of indexed variable */
+ ? luaF_getlocalname(p, t + 1, pc)
+ : upvalname(p, t);
+ kname(p, pc, k, name);
+ return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";
+ }
+ case OP_GETUPVAL: {
+ *name = upvalname(p, GETARG_B(i));
+ return "upvalue";
+ }
+ case OP_LOADK:
+ case OP_LOADKX: {
+ int b = (op == OP_LOADK) ? GETARG_Bx(i)
+ : GETARG_Ax(p->code[pc + 1]);
+ if (ttisstring(&p->k[b])) {
+ *name = svalue(&p->k[b]);
+ return "constant";
+ }
+ break;
+ }
+ case OP_SELF: {
+ int k = GETARG_C(i); /* key index */
+ kname(p, pc, k, name);
+ return "method";
+ }
+ default: break; /* go through to return NULL */
+ }
+ }
+ return NULL; /* could not find reasonable name */
+}
+
+
+static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
+ TMS tm;
+ Proto *p = ci_func(ci)->p; /* calling function */
+ int pc = currentpc(ci); /* calling instruction index */
+ Instruction i = p->code[pc]; /* calling instruction */
+ switch (GET_OPCODE(i)) {
+ case OP_CALL:
+ case OP_TAILCALL: /* get function name */
+ return getobjname(p, pc, GETARG_A(i), name);
+ case OP_TFORCALL: { /* for iterator */
+ *name = "for iterator";
+ return "for iterator";
+ }
+ /* all other instructions can call only through metamethods */
+ case OP_SELF:
+ case OP_GETTABUP:
+ case OP_GETTABLE: tm = TM_INDEX; break;
+ case OP_SETTABUP:
+ case OP_SETTABLE: tm = TM_NEWINDEX; break;
+ case OP_EQ: tm = TM_EQ; break;
+ case OP_ADD: tm = TM_ADD; break;
+ case OP_SUB: tm = TM_SUB; break;
+ case OP_MUL: tm = TM_MUL; break;
+ case OP_DIV: tm = TM_DIV; break;
+ case OP_MOD: tm = TM_MOD; break;
+ case OP_POW: tm = TM_POW; break;
+ case OP_UNM: tm = TM_UNM; break;
+ case OP_LEN: tm = TM_LEN; break;
+ case OP_LT: tm = TM_LT; break;
+ case OP_LE: tm = TM_LE; break;
+ case OP_CONCAT: tm = TM_CONCAT; break;
+ default:
+ return NULL; /* else no useful name can be found */
+ }
+ *name = getstr(G(L)->tmname[tm]);
+ return "metamethod";
+}
+
+/* }====================================================== */
+
+
+
+/*
+** only ANSI way to check whether a pointer points to an array
+** (used only for error messages, so efficiency is not a big concern)
+*/
+static int isinstack (CallInfo *ci, const TValue *o) {
+ StkId p;
+ for (p = ci->u.l.base; p < ci->top; p++)
+ if (o == p) return 1;
+ return 0;
+}
+
+
+static const char *getupvalname (CallInfo *ci, const TValue *o,
+ const char **name) {
+ LClosure *c = ci_func(ci);
+ int i;
+ for (i = 0; i < c->nupvalues; i++) {
+ if (c->upvals[i]->v == o) {
+ *name = upvalname(c->p, i);
+ return "upvalue";
+ }
+ }
+ return NULL;
+}
+
+
+l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
+ CallInfo *ci = L->ci;
+ const char *name = NULL;
+ const char *t = objtypename(o);
+ const char *kind = NULL;
+ if (isLua(ci)) {
+ kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */
+ if (!kind && isinstack(ci, o)) /* no? try a register */
+ kind = getobjname(ci_func(ci)->p, currentpc(ci),
+ cast_int(o - ci->u.l.base), &name);
+ }
+ if (kind)
+ luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
+ op, kind, name, t);
+ else
+ luaG_runerror(L, "attempt to %s a %s value", op, t);
+}
+
+
+l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
+ if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
+ lua_assert(!ttisstring(p1) && !ttisnumber(p2));
+ luaG_typeerror(L, p1, "concatenate");
+}
+
+
+l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
+ TValue temp;
+ if (luaV_tonumber(p1, &temp) == NULL)
+ p2 = p1; /* first operand is wrong */
+ luaG_typeerror(L, p2, "perform arithmetic on");
+}
+
+
+l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
+ const char *t1 = objtypename(p1);
+ const char *t2 = objtypename(p2);
+ if (t1 == t2)
+ luaG_runerror(L, "attempt to compare two %s values", t1);
+ else
+ luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
+}
+
+
+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);
+ TString *src = ci_func(ci)->p->source;
+ if (src)
+ luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
+ else { /* no source available; use "?" instead */
+ buff[0] = '?'; buff[1] = '\0';
+ }
+ luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
+ }
+}
+
+
+l_noret 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, L->top, L->top - 1); /* move argument */
+ setobjs2s(L, L->top - 1, errfunc); /* push function */
+ L->top++;
+ luaD_call(L, L->top - 2, 1, 0); /* call it */
+ }
+ luaD_throw(L, LUA_ERRRUN);
+}
+
+
+l_noret 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);
+}
+
--- /dev/null
+/*
+** $Id: ldebug.h,v 2.7 2011/10/07 20:45:19 roberto 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 getfuncline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0)
+
+#define resethookcount(L) (L->hookcount = L->basehookcount)
+
+/* Active Lua function (given call info) */
+#define ci_func(ci) (clLvalue((ci)->func))
+
+
+LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
+ const char *opname);
+LUAI_FUNC l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2);
+LUAI_FUNC l_noret luaG_aritherror (lua_State *L, const TValue *p1,
+ const TValue *p2);
+LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,
+ const TValue *p2);
+LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);
+LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
+
+#endif
--- /dev/null
+/*
+** $Id: ldo.c,v 2.108 2012/10/01 14:05:04 roberto Exp $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+
+#include <setjmp.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define ldo_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lapi.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lundump.h"
+#include "lvm.h"
+#include "lzio.h"
+
+
+
+
+/*
+** {======================================================
+** Error-recovery functions
+** =======================================================
+*/
+
+/*
+** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By
+** default, Lua handles errors with exceptions when compiling as
+** C++ code, with _longjmp/_setjmp when asked to use them, and with
+** longjmp/setjmp otherwise.
+*/
+#if !defined(LUAI_THROW)
+
+#if defined(__cplusplus) && !defined(LUA_USE_LONGJMP)
+/* C++ exceptions */
+#define LUAI_THROW(L,c) throw(c)
+#define LUAI_TRY(L,c,a) \
+ try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; }
+#define luai_jmpbuf int /* dummy variable */
+
+#elif defined(LUA_USE_ULONGJMP)
+/* in Unix, try _longjmp/_setjmp (more efficient) */
+#define LUAI_THROW(L,c) _longjmp((c)->b, 1)
+#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a }
+#define luai_jmpbuf jmp_buf
+
+#else
+/* default handling with long jumps */
+#define LUAI_THROW(L,c) longjmp((c)->b, 1)
+#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a }
+#define luai_jmpbuf jmp_buf
+
+#endif
+
+#endif
+
+
+
+/* chain list of long jump buffers */
+struct lua_longjmp {
+ struct lua_longjmp *previous;
+ luai_jmpbuf b;
+ volatile int status; /* error code */
+};
+
+
+static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
+ switch (errcode) {
+ case LUA_ERRMEM: { /* memory error? */
+ setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
+ break;
+ }
+ case LUA_ERRERR: {
+ setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));
+ break;
+ }
+ default: {
+ setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
+ break;
+ }
+ }
+ L->top = oldtop + 1;
+}
+
+
+l_noret luaD_throw (lua_State *L, int errcode) {
+ if (L->errorJmp) { /* thread has an error handler? */
+ L->errorJmp->status = errcode; /* set status */
+ LUAI_THROW(L, L->errorJmp); /* jump to it */
+ }
+ else { /* thread has no error handler */
+ L->status = cast_byte(errcode); /* mark it as dead */
+ if (G(L)->mainthread->errorJmp) { /* main thread has a handler? */
+ setobjs2s(L, G(L)->mainthread->top++, L->top - 1); /* copy error obj. */
+ luaD_throw(G(L)->mainthread, errcode); /* re-throw in main thread */
+ }
+ else { /* no handler at all; abort */
+ if (G(L)->panic) { /* panic function? */
+ lua_unlock(L);
+ G(L)->panic(L); /* call it (last chance to jump out) */
+ }
+ abort();
+ }
+ }
+}
+
+
+int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
+ unsigned short oldnCcalls = L->nCcalls;
+ struct lua_longjmp lj;
+ lj.status = LUA_OK;
+ lj.previous = L->errorJmp; /* chain new error handler */
+ L->errorJmp = &lj;
+ LUAI_TRY(L, &lj,
+ (*f)(L, ud);
+ );
+ L->errorJmp = lj.previous; /* restore old error handler */
+ L->nCcalls = oldnCcalls;
+ return lj.status;
+}
+
+/* }====================================================== */
+
+
+static void correctstack (lua_State *L, TValue *oldstack) {
+ CallInfo *ci;
+ GCObject *up;
+ L->top = (L->top - oldstack) + L->stack;
+ for (up = L->openupval; up != NULL; up = up->gch.next)
+ gco2uv(up)->v = (gco2uv(up)->v - oldstack) + L->stack;
+ for (ci = L->ci; ci != NULL; ci = ci->previous) {
+ ci->top = (ci->top - oldstack) + L->stack;
+ ci->func = (ci->func - oldstack) + L->stack;
+ if (isLua(ci))
+ ci->u.l.base = (ci->u.l.base - oldstack) + L->stack;
+ }
+}
+
+
+/* some space for error handling */
+#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)
+
+
+void luaD_reallocstack (lua_State *L, int newsize) {
+ TValue *oldstack = L->stack;
+ int lim = L->stacksize;
+ lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);
+ lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK);
+ luaM_reallocvector(L, L->stack, L->stacksize, newsize, TValue);
+ for (; lim < newsize; lim++)
+ setnilvalue(L->stack + lim); /* erase new segment */
+ L->stacksize = newsize;
+ L->stack_last = L->stack + newsize - EXTRA_STACK;
+ correctstack(L, oldstack);
+}
+
+
+void luaD_growstack (lua_State *L, int n) {
+ int size = L->stacksize;
+ if (size > LUAI_MAXSTACK) /* error after extra size? */
+ luaD_throw(L, LUA_ERRERR);
+ else {
+ int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK;
+ int newsize = 2 * size;
+ if (newsize > LUAI_MAXSTACK) newsize = LUAI_MAXSTACK;
+ if (newsize < needed) newsize = needed;
+ if (newsize > LUAI_MAXSTACK) { /* stack overflow? */
+ luaD_reallocstack(L, ERRORSTACKSIZE);
+ luaG_runerror(L, "stack overflow");
+ }
+ else
+ luaD_reallocstack(L, newsize);
+ }
+}
+
+
+static int stackinuse (lua_State *L) {
+ CallInfo *ci;
+ StkId lim = L->top;
+ for (ci = L->ci; ci != NULL; ci = ci->previous) {
+ lua_assert(ci->top <= L->stack_last);
+ if (lim < ci->top) lim = ci->top;
+ }
+ return cast_int(lim - L->stack) + 1; /* part of stack in use */
+}
+
+
+void luaD_shrinkstack (lua_State *L) {
+ int inuse = stackinuse(L);
+ int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK;
+ if (goodsize > LUAI_MAXSTACK) goodsize = LUAI_MAXSTACK;
+ if (inuse > LUAI_MAXSTACK || /* handling stack overflow? */
+ goodsize >= L->stacksize) /* would grow instead of shrink? */
+ condmovestack(L); /* don't change stack (change only for debugging) */
+ else
+ luaD_reallocstack(L, goodsize); /* shrink it */
+}
+
+
+void luaD_hook (lua_State *L, int event, int line) {
+ lua_Hook hook = L->hook;
+ if (hook && L->allowhook) {
+ CallInfo *ci = L->ci;
+ ptrdiff_t top = savestack(L, L->top);
+ ptrdiff_t ci_top = savestack(L, ci->top);
+ lua_Debug ar;
+ ar.event = event;
+ ar.currentline = line;
+ ar.i_ci = ci;
+ luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
+ ci->top = L->top + LUA_MINSTACK;
+ lua_assert(ci->top <= L->stack_last);
+ L->allowhook = 0; /* cannot call hooks inside a hook */
+ ci->callstatus |= CIST_HOOKED;
+ lua_unlock(L);
+ (*hook)(L, &ar);
+ lua_lock(L);
+ lua_assert(!L->allowhook);
+ L->allowhook = 1;
+ ci->top = restorestack(L, ci_top);
+ L->top = restorestack(L, top);
+ ci->callstatus &= ~CIST_HOOKED;
+ }
+}
+
+
+static void callhook (lua_State *L, CallInfo *ci) {
+ int hook = LUA_HOOKCALL;
+ ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */
+ if (isLua(ci->previous) &&
+ GET_OPCODE(*(ci->previous->u.l.savedpc - 1)) == OP_TAILCALL) {
+ ci->callstatus |= CIST_TAIL;
+ hook = LUA_HOOKTAILCALL;
+ }
+ luaD_hook(L, hook, -1);
+ ci->u.l.savedpc--; /* correct 'pc' */
+}
+
+
+static StkId adjust_varargs (lua_State *L, Proto *p, int actual) {
+ int i;
+ int nfixargs = p->numparams;
+ StkId base, fixed;
+ lua_assert(actual >= nfixargs);
+ /* move fixed parameters to final position */
+ fixed = L->top - actual; /* first fixed argument */
+ base = L->top; /* final position of first argument */
+ for (i=0; i<nfixargs; i++) {
+ setobjs2s(L, L->top++, fixed + i);
+ setnilvalue(fixed + i);
+ }
+ return base;
+}
+
+
+static StkId tryfuncTM (lua_State *L, StkId func) {
+ const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL);
+ StkId p;
+ ptrdiff_t funcr = savestack(L, func);
+ if (!ttisfunction(tm))
+ luaG_typeerror(L, func, "call");
+ /* Open a hole inside the stack at `func' */
+ for (p = L->top; p > func; p--) setobjs2s(L, p, p-1);
+ incr_top(L);
+ func = restorestack(L, funcr); /* previous call may change stack */
+ setobj2s(L, func, tm); /* tag method is the new function to be called */
+ return func;
+}
+
+
+
+#define next_ci(L) (L->ci = (L->ci->next ? L->ci->next : luaE_extendCI(L)))
+
+
+/*
+** returns true if function has been executed (C function)
+*/
+int luaD_precall (lua_State *L, StkId func, int nresults) {
+ lua_CFunction f;
+ CallInfo *ci;
+ int n; /* number of arguments (Lua) or returns (C) */
+ ptrdiff_t funcr = savestack(L, func);
+ switch (ttype(func)) {
+ case LUA_TLCF: /* light C function */
+ f = fvalue(func);
+ goto Cfunc;
+ case LUA_TCCL: { /* C closure */
+ f = clCvalue(func)->f;
+ Cfunc:
+ luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
+ ci = next_ci(L); /* now 'enter' new function */
+ ci->nresults = nresults;
+ ci->func = restorestack(L, funcr);
+ ci->top = L->top + LUA_MINSTACK;
+ lua_assert(ci->top <= L->stack_last);
+ ci->callstatus = 0;
+ luaC_checkGC(L); /* stack grow uses memory */
+ if (L->hookmask & LUA_MASKCALL)
+ luaD_hook(L, LUA_HOOKCALL, -1);
+ lua_unlock(L);
+ n = (*f)(L); /* do the actual call */
+ lua_lock(L);
+ api_checknelems(L, n);
+ luaD_poscall(L, L->top - n);
+ return 1;
+ }
+ case LUA_TLCL: { /* Lua function: prepare its call */
+ StkId base;
+ Proto *p = clLvalue(func)->p;
+ luaD_checkstack(L, p->maxstacksize);
+ func = restorestack(L, funcr);
+ n = cast_int(L->top - func) - 1; /* number of real arguments */
+ for (; n < p->numparams; n++)
+ setnilvalue(L->top++); /* complete missing arguments */
+ base = (!p->is_vararg) ? func + 1 : adjust_varargs(L, p, n);
+ ci = next_ci(L); /* now 'enter' new function */
+ ci->nresults = nresults;
+ ci->func = func;
+ ci->u.l.base = base;
+ ci->top = base + p->maxstacksize;
+ lua_assert(ci->top <= L->stack_last);
+ ci->u.l.savedpc = p->code; /* starting point */
+ ci->callstatus = CIST_LUA;
+ L->top = ci->top;
+ luaC_checkGC(L); /* stack grow uses memory */
+ if (L->hookmask & LUA_MASKCALL)
+ callhook(L, ci);
+ return 0;
+ }
+ default: { /* not a function */
+ func = tryfuncTM(L, func); /* retry with 'function' tag method */
+ return luaD_precall(L, func, nresults); /* now it must be a function */
+ }
+ }
+}
+
+
+int luaD_poscall (lua_State *L, StkId firstResult) {
+ StkId res;
+ int wanted, i;
+ CallInfo *ci = L->ci;
+ if (L->hookmask & (LUA_MASKRET | LUA_MASKLINE)) {
+ if (L->hookmask & LUA_MASKRET) {
+ ptrdiff_t fr = savestack(L, firstResult); /* hook may change stack */
+ luaD_hook(L, LUA_HOOKRET, -1);
+ firstResult = restorestack(L, fr);
+ }
+ L->oldpc = ci->previous->u.l.savedpc; /* 'oldpc' for caller function */
+ }
+ res = ci->func; /* res == final position of 1st result */
+ wanted = ci->nresults;
+ L->ci = ci = ci->previous; /* back to caller */
+ /* move results to correct place */
+ for (i = wanted; i != 0 && firstResult < L->top; i--)
+ setobjs2s(L, res++, firstResult++);
+ while (i-- > 0)
+ setnilvalue(res++);
+ L->top = res;
+ return (wanted - LUA_MULTRET); /* 0 iff wanted == LUA_MULTRET */
+}
+
+
+/*
+** Call a function (C or Lua). The function to be called is at *func.
+** The arguments are on the stack, right after the function.
+** When returns, all the results are on the stack, starting at the original
+** function position.
+*/
+void luaD_call (lua_State *L, StkId func, int nResults, int allowyield) {
+ if (++L->nCcalls >= LUAI_MAXCCALLS) {
+ if (L->nCcalls == LUAI_MAXCCALLS)
+ luaG_runerror(L, "C stack overflow");
+ else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3)))
+ luaD_throw(L, LUA_ERRERR); /* error while handing stack error */
+ }
+ if (!allowyield) L->nny++;
+ if (!luaD_precall(L, func, nResults)) /* is a Lua function? */
+ luaV_execute(L); /* call it */
+ if (!allowyield) L->nny--;
+ L->nCcalls--;
+}
+
+
+static void finishCcall (lua_State *L) {
+ CallInfo *ci = L->ci;
+ int n;
+ lua_assert(ci->u.c.k != NULL); /* must have a continuation */
+ lua_assert(L->nny == 0);
+ if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */
+ ci->callstatus &= ~CIST_YPCALL; /* finish 'lua_pcall' */
+ L->errfunc = ci->u.c.old_errfunc;
+ }
+ /* finish 'lua_callk'/'lua_pcall' */
+ adjustresults(L, ci->nresults);
+ /* call continuation function */
+ if (!(ci->callstatus & CIST_STAT)) /* no call status? */
+ ci->u.c.status = LUA_YIELD; /* 'default' status */
+ lua_assert(ci->u.c.status != LUA_OK);
+ ci->callstatus = (ci->callstatus & ~(CIST_YPCALL | CIST_STAT)) | CIST_YIELDED;
+ lua_unlock(L);
+ n = (*ci->u.c.k)(L);
+ lua_lock(L);
+ api_checknelems(L, n);
+ /* finish 'luaD_precall' */
+ luaD_poscall(L, L->top - n);
+}
+
+
+static void unroll (lua_State *L, void *ud) {
+ UNUSED(ud);
+ for (;;) {
+ if (L->ci == &L->base_ci) /* stack is empty? */
+ return; /* coroutine finished normally */
+ if (!isLua(L->ci)) /* C function? */
+ finishCcall(L);
+ else { /* Lua function */
+ luaV_finishOp(L); /* finish interrupted instruction */
+ luaV_execute(L); /* execute down to higher C 'boundary' */
+ }
+ }
+}
+
+
+/*
+** check whether thread has a suspended protected call
+*/
+static CallInfo *findpcall (lua_State *L) {
+ CallInfo *ci;
+ for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */
+ if (ci->callstatus & CIST_YPCALL)
+ return ci;
+ }
+ return NULL; /* no pending pcall */
+}
+
+
+static int recover (lua_State *L, int status) {
+ StkId oldtop;
+ CallInfo *ci = findpcall(L);
+ if (ci == NULL) return 0; /* no recovery point */
+ /* "finish" luaD_pcall */
+ oldtop = restorestack(L, ci->extra);
+ luaF_close(L, oldtop);
+ seterrorobj(L, status, oldtop);
+ L->ci = ci;
+ L->allowhook = ci->u.c.old_allowhook;
+ L->nny = 0; /* should be zero to be yieldable */
+ luaD_shrinkstack(L);
+ L->errfunc = ci->u.c.old_errfunc;
+ ci->callstatus |= CIST_STAT; /* call has error status */
+ ci->u.c.status = status; /* (here it is) */
+ return 1; /* continue running the coroutine */
+}
+
+
+/*
+** signal an error in the call to 'resume', not in the execution of the
+** coroutine itself. (Such errors should not be handled by any coroutine
+** error handler and should not kill the coroutine.)
+*/
+static l_noret resume_error (lua_State *L, const char *msg, StkId firstArg) {
+ L->top = firstArg; /* remove args from the stack */
+ setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */
+ api_incr_top(L);
+ luaD_throw(L, -1); /* jump back to 'lua_resume' */
+}
+
+
+/*
+** do the work for 'lua_resume' in protected mode
+*/
+static void resume (lua_State *L, void *ud) {
+ int nCcalls = L->nCcalls;
+ StkId firstArg = cast(StkId, ud);
+ CallInfo *ci = L->ci;
+ if (nCcalls >= LUAI_MAXCCALLS)
+ resume_error(L, "C stack overflow", firstArg);
+ if (L->status == LUA_OK) { /* may be starting a coroutine */
+ if (ci != &L->base_ci) /* not in base level? */
+ resume_error(L, "cannot resume non-suspended coroutine", firstArg);
+ /* coroutine is in base level; start running it */
+ if (!luaD_precall(L, firstArg - 1, LUA_MULTRET)) /* Lua function? */
+ luaV_execute(L); /* call it */
+ }
+ else if (L->status != LUA_YIELD)
+ resume_error(L, "cannot resume dead coroutine", firstArg);
+ else { /* resuming from previous yield */
+ L->status = LUA_OK;
+ ci->func = restorestack(L, ci->extra);
+ if (isLua(ci)) /* yielded inside a hook? */
+ luaV_execute(L); /* just continue running Lua code */
+ else { /* 'common' yield */
+ if (ci->u.c.k != NULL) { /* does it have a continuation? */
+ int n;
+ ci->u.c.status = LUA_YIELD; /* 'default' status */
+ ci->callstatus |= CIST_YIELDED;
+ lua_unlock(L);
+ n = (*ci->u.c.k)(L); /* call continuation */
+ lua_lock(L);
+ api_checknelems(L, n);
+ firstArg = L->top - n; /* yield results come from continuation */
+ }
+ luaD_poscall(L, firstArg); /* finish 'luaD_precall' */
+ }
+ unroll(L, NULL);
+ }
+ lua_assert(nCcalls == L->nCcalls);
+}
+
+
+LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs) {
+ int status;
+ lua_lock(L);
+ luai_userstateresume(L, nargs);
+ L->nCcalls = (from) ? from->nCcalls + 1 : 1;
+ L->nny = 0; /* allow yields */
+ api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
+ status = luaD_rawrunprotected(L, resume, L->top - nargs);
+ if (status == -1) /* error calling 'lua_resume'? */
+ status = LUA_ERRRUN;
+ else { /* yield or regular error */
+ while (status != LUA_OK && status != LUA_YIELD) { /* error? */
+ if (recover(L, status)) /* recover point? */
+ status = luaD_rawrunprotected(L, unroll, NULL); /* run continuation */
+ else { /* unrecoverable error */
+ L->status = cast_byte(status); /* mark thread as `dead' */
+ seterrorobj(L, status, L->top);
+ L->ci->top = L->top;
+ break;
+ }
+ }
+ lua_assert(status == L->status);
+ }
+ L->nny = 1; /* do not allow yields */
+ L->nCcalls--;
+ lua_assert(L->nCcalls == ((from) ? from->nCcalls : 0));
+ lua_unlock(L);
+ return status;
+}
+
+
+LUA_API int lua_yieldk (lua_State *L, int nresults, int ctx, lua_CFunction k) {
+ CallInfo *ci = L->ci;
+ luai_userstateyield(L, nresults);
+ lua_lock(L);
+ api_checknelems(L, nresults);
+ if (L->nny > 0) {
+ if (L != G(L)->mainthread)
+ luaG_runerror(L, "attempt to yield across a C-call boundary");
+ else
+ luaG_runerror(L, "attempt to yield from outside a coroutine");
+ }
+ L->status = LUA_YIELD;
+ ci->extra = savestack(L, ci->func); /* save current 'func' */
+ if (isLua(ci)) { /* inside a hook? */
+ api_check(L, k == NULL, "hooks cannot continue after yielding");
+ }
+ else {
+ if ((ci->u.c.k = k) != NULL) /* is there a continuation? */
+ ci->u.c.ctx = ctx; /* save context */
+ ci->func = L->top - nresults - 1; /* protect stack below results */
+ luaD_throw(L, LUA_YIELD);
+ }
+ lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */
+ lua_unlock(L);
+ return 0; /* return to 'luaD_hook' */
+}
+
+
+int luaD_pcall (lua_State *L, Pfunc func, void *u,
+ ptrdiff_t old_top, ptrdiff_t ef) {
+ int status;
+ CallInfo *old_ci = L->ci;
+ lu_byte old_allowhooks = L->allowhook;
+ unsigned short old_nny = L->nny;
+ ptrdiff_t old_errfunc = L->errfunc;
+ L->errfunc = ef;
+ status = luaD_rawrunprotected(L, func, u);
+ if (status != LUA_OK) { /* an error occurred? */
+ StkId oldtop = restorestack(L, old_top);
+ luaF_close(L, oldtop); /* close possible pending closures */
+ seterrorobj(L, status, oldtop);
+ L->ci = old_ci;
+ L->allowhook = old_allowhooks;
+ L->nny = old_nny;
+ luaD_shrinkstack(L);
+ }
+ L->errfunc = old_errfunc;
+ return status;
+}
+
+
+
+/*
+** Execute a protected parser.
+*/
+struct SParser { /* data to `f_parser' */
+ ZIO *z;
+ Mbuffer buff; /* dynamic structure used by the scanner */
+ Dyndata dyd; /* dynamic structures used by the parser */
+ const char *mode;
+ const char *name;
+};
+
+
+static void checkmode (lua_State *L, const char *mode, const char *x) {
+ if (mode && strchr(mode, x[0]) == NULL) {
+ luaO_pushfstring(L,
+ "attempt to load a %s chunk (mode is " LUA_QS ")", x, mode);
+ luaD_throw(L, LUA_ERRSYNTAX);
+ }
+}
+
+
+static void f_parser (lua_State *L, void *ud) {
+ int i;
+ Closure *cl;
+ struct SParser *p = cast(struct SParser *, ud);
+ int c = zgetc(p->z); /* read first character */
+ if (c == LUA_SIGNATURE[0]) {
+ checkmode(L, p->mode, "binary");
+ cl = luaU_undump(L, p->z, &p->buff, p->name);
+ }
+ else {
+ checkmode(L, p->mode, "text");
+ cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c);
+ }
+ lua_assert(cl->l.nupvalues == cl->l.p->sizeupvalues);
+ for (i = 0; i < cl->l.nupvalues; i++) { /* initialize upvalues */
+ UpVal *up = luaF_newupval(L);
+ cl->l.upvals[i] = up;
+ luaC_objbarrier(L, cl, up);
+ }
+}
+
+
+int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
+ const char *mode) {
+ struct SParser p;
+ int status;
+ L->nny++; /* cannot yield during parsing */
+ p.z = z; p.name = name; p.mode = mode;
+ p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0;
+ p.dyd.gt.arr = NULL; p.dyd.gt.size = 0;
+ p.dyd.label.arr = NULL; p.dyd.label.size = 0;
+ luaZ_initbuffer(L, &p.buff);
+ status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);
+ luaZ_freebuffer(L, &p.buff);
+ luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size);
+ luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size);
+ luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size);
+ L->nny--;
+ return status;
+}
+
+
--- /dev/null
+/*
+** $Id: ldo.h,v 2.20 2011/11/29 15:55:08 roberto Exp $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ldo_h
+#define ldo_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+#include "lzio.h"
+
+
+#define luaD_checkstack(L,n) if (L->stack_last - L->top <= (n)) \
+ luaD_growstack(L, n); else condmovestack(L);
+
+
+#define incr_top(L) {L->top++; luaD_checkstack(L,0);}
+
+#define savestack(L,p) ((char *)(p) - (char *)L->stack)
+#define restorestack(L,n) ((TValue *)((char *)L->stack + (n)))
+
+
+/* type of protected functions, to be ran by `runprotected' */
+typedef void (*Pfunc) (lua_State *L, void *ud);
+
+LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
+ const char *mode);
+LUAI_FUNC void luaD_hook (lua_State *L, int event, int line);
+LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults);
+LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults,
+ int allowyield);
+LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
+ ptrdiff_t oldtop, ptrdiff_t ef);
+LUAI_FUNC int luaD_poscall (lua_State *L, StkId firstResult);
+LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize);
+LUAI_FUNC void luaD_growstack (lua_State *L, int n);
+LUAI_FUNC void luaD_shrinkstack (lua_State *L);
+
+LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode);
+LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
+
+#endif
+
--- /dev/null
+/*
+** $Id: ldump.c,v 2.17 2012/01/23 23:02:10 roberto Exp $
+** save precompiled Lua chunks
+** See Copyright Notice in lua.h
+*/
+
+#include <stddef.h>
+
+#define ldump_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lobject.h"
+#include "lstate.h"
+#include "lundump.h"
+
+typedef struct {
+ lua_State* L;
+ lua_Writer writer;
+ void* data;
+ int strip;
+ int status;
+} DumpState;
+
+#define DumpMem(b,n,size,D) DumpBlock(b,(n)*(size),D)
+#define DumpVar(x,D) DumpMem(&x,1,sizeof(x),D)
+
+static void DumpBlock(const void* b, size_t size, DumpState* D)
+{
+ if (D->status==0)
+ {
+ lua_unlock(D->L);
+ D->status=(*D->writer)(D->L,b,size,D->data);
+ lua_lock(D->L);
+ }
+}
+
+static void DumpChar(int y, DumpState* D)
+{
+ char x=(char)y;
+ DumpVar(x,D);
+}
+
+static void DumpInt(int x, DumpState* D)
+{
+ DumpVar(x,D);
+}
+
+static void DumpNumber(lua_Number x, DumpState* D)
+{
+ DumpVar(x,D);
+}
+
+static void DumpVector(const void* b, int n, size_t size, DumpState* D)
+{
+ DumpInt(n,D);
+ DumpMem(b,n,size,D);
+}
+
+static void DumpString(const TString* s, DumpState* D)
+{
+ if (s==NULL)
+ {
+ size_t size=0;
+ DumpVar(size,D);
+ }
+ else
+ {
+ size_t size=s->tsv.len+1; /* include trailing '\0' */
+ DumpVar(size,D);
+ DumpBlock(getstr(s),size*sizeof(char),D);
+ }
+}
+
+#define DumpCode(f,D) DumpVector(f->code,f->sizecode,sizeof(Instruction),D)
+
+static void DumpFunction(const Proto* f, DumpState* D);
+
+static void DumpConstants(const Proto* f, DumpState* D)
+{
+ int i,n=f->sizek;
+ DumpInt(n,D);
+ for (i=0; i<n; i++)
+ {
+ const TValue* o=&f->k[i];
+ DumpChar(ttypenv(o),D);
+ switch (ttypenv(o))
+ {
+ case LUA_TNIL:
+ break;
+ case LUA_TBOOLEAN:
+ DumpChar(bvalue(o),D);
+ break;
+ case LUA_TNUMBER:
+ DumpNumber(nvalue(o),D);
+ break;
+ case LUA_TSTRING:
+ DumpString(rawtsvalue(o),D);
+ break;
+ default: lua_assert(0);
+ }
+ }
+ n=f->sizep;
+ DumpInt(n,D);
+ for (i=0; i<n; i++) DumpFunction(f->p[i],D);
+}
+
+static void DumpUpvalues(const Proto* f, DumpState* D)
+{
+ int i,n=f->sizeupvalues;
+ DumpInt(n,D);
+ for (i=0; i<n; i++)
+ {
+ DumpChar(f->upvalues[i].instack,D);
+ DumpChar(f->upvalues[i].idx,D);
+ }
+}
+
+static void DumpDebug(const Proto* f, DumpState* D)
+{
+ int i,n;
+ DumpString((D->strip) ? NULL : f->source,D);
+ n= (D->strip) ? 0 : f->sizelineinfo;
+ DumpVector(f->lineinfo,n,sizeof(int),D);
+ n= (D->strip) ? 0 : 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);
+ }
+ n= (D->strip) ? 0 : f->sizeupvalues;
+ DumpInt(n,D);
+ for (i=0; i<n; i++) DumpString(f->upvalues[i].name,D);
+}
+
+static void DumpFunction(const Proto* f, DumpState* D)
+{
+ DumpInt(f->linedefined,D);
+ DumpInt(f->lastlinedefined,D);
+ DumpChar(f->numparams,D);
+ DumpChar(f->is_vararg,D);
+ DumpChar(f->maxstacksize,D);
+ DumpCode(f,D);
+ DumpConstants(f,D);
+ DumpUpvalues(f,D);
+ DumpDebug(f,D);
+}
+
+static void DumpHeader(DumpState* D)
+{
+ lu_byte h[LUAC_HEADERSIZE];
+ luaU_header(h);
+ DumpBlock(h,LUAC_HEADERSIZE,D);
+}
+
+/*
+** dump Lua function as precompiled chunk
+*/
+int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip)
+{
+ DumpState D;
+ D.L=L;
+ D.writer=w;
+ D.data=data;
+ D.strip=strip;
+ D.status=0;
+ DumpHeader(&D);
+ DumpFunction(f,&D);
+ return D.status;
+}
--- /dev/null
+/*
+** $Id: lfunc.c,v 2.30 2012/10/03 12:36:46 roberto Exp $
+** Auxiliary functions to manipulate prototypes and closures
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stddef.h>
+
+#define lfunc_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+
+
+
+Closure *luaF_newCclosure (lua_State *L, int n) {
+ Closure *c = &luaC_newobj(L, LUA_TCCL, sizeCclosure(n), NULL, 0)->cl;
+ c->c.nupvalues = cast_byte(n);
+ return c;
+}
+
+
+Closure *luaF_newLclosure (lua_State *L, int n) {
+ Closure *c = &luaC_newobj(L, LUA_TLCL, sizeLclosure(n), NULL, 0)->cl;
+ c->l.p = NULL;
+ c->l.nupvalues = cast_byte(n);
+ while (n--) c->l.upvals[n] = NULL;
+ return c;
+}
+
+
+UpVal *luaF_newupval (lua_State *L) {
+ UpVal *uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), NULL, 0)->uv;
+ uv->v = &uv->u.value;
+ setnilvalue(uv->v);
+ return uv;
+}
+
+
+UpVal *luaF_findupval (lua_State *L, StkId level) {
+ global_State *g = G(L);
+ GCObject **pp = &L->openupval;
+ UpVal *p;
+ UpVal *uv;
+ while (*pp != NULL && (p = gco2uv(*pp))->v >= level) {
+ GCObject *o = obj2gco(p);
+ lua_assert(p->v != &p->u.value);
+ lua_assert(!isold(o) || isold(obj2gco(L)));
+ if (p->v == level) { /* found a corresponding upvalue? */
+ if (isdead(g, o)) /* is it dead? */
+ changewhite(o); /* resurrect it */
+ return p;
+ }
+ pp = &p->next;
+ }
+ /* not found: create a new one */
+ uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), pp, 0)->uv;
+ uv->v = level; /* current value lives in the stack */
+ uv->u.l.prev = &g->uvhead; /* double link it in `uvhead' list */
+ uv->u.l.next = g->uvhead.u.l.next;
+ uv->u.l.next->u.l.prev = uv;
+ g->uvhead.u.l.next = uv;
+ lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);
+ return uv;
+}
+
+
+static void unlinkupval (UpVal *uv) {
+ lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);
+ uv->u.l.next->u.l.prev = uv->u.l.prev; /* remove from `uvhead' list */
+ uv->u.l.prev->u.l.next = uv->u.l.next;
+}
+
+
+void luaF_freeupval (lua_State *L, UpVal *uv) {
+ if (uv->v != &uv->u.value) /* is it open? */
+ unlinkupval(uv); /* remove from open list */
+ luaM_free(L, uv); /* free upvalue */
+}
+
+
+void luaF_close (lua_State *L, StkId level) {
+ UpVal *uv;
+ global_State *g = G(L);
+ while (L->openupval != NULL && (uv = gco2uv(L->openupval))->v >= level) {
+ GCObject *o = obj2gco(uv);
+ lua_assert(!isblack(o) && uv->v != &uv->u.value);
+ L->openupval = uv->next; /* remove from `open' list */
+ if (isdead(g, o))
+ luaF_freeupval(L, uv); /* free upvalue */
+ else {
+ unlinkupval(uv); /* remove upvalue from 'uvhead' list */
+ setobj(L, &uv->u.value, uv->v); /* move value to upvalue slot */
+ uv->v = &uv->u.value; /* now current value lives here */
+ gch(o)->next = g->allgc; /* link upvalue into 'allgc' list */
+ g->allgc = o;
+ luaC_checkupvalcolor(g, uv);
+ }
+ }
+}
+
+
+Proto *luaF_newproto (lua_State *L) {
+ Proto *f = &luaC_newobj(L, LUA_TPROTO, sizeof(Proto), NULL, 0)->p;
+ f->k = NULL;
+ f->sizek = 0;
+ f->p = NULL;
+ f->sizep = 0;
+ f->code = NULL;
+ f->cache = NULL;
+ f->sizecode = 0;
+ f->lineinfo = NULL;
+ f->sizelineinfo = 0;
+ f->upvalues = NULL;
+ f->sizeupvalues = 0;
+ f->numparams = 0;
+ f->is_vararg = 0;
+ f->maxstacksize = 0;
+ f->locvars = NULL;
+ f->sizelocvars = 0;
+ f->linedefined = 0;
+ f->lastlinedefined = 0;
+ f->source = NULL;
+ return f;
+}
+
+
+void luaF_freeproto (lua_State *L, Proto *f) {
+ luaM_freearray(L, f->code, f->sizecode);
+ luaM_freearray(L, f->p, f->sizep);
+ luaM_freearray(L, f->k, f->sizek);
+ luaM_freearray(L, f->lineinfo, f->sizelineinfo);
+ luaM_freearray(L, f->locvars, f->sizelocvars);
+ luaM_freearray(L, f->upvalues, f->sizeupvalues);
+ luaM_free(L, f);
+}
+
+
+/*
+** Look for n-th local variable at line `line' in function `func'.
+** Returns NULL if not found.
+*/
+const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
+ int i;
+ for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
+ if (pc < f->locvars[i].endpc) { /* is variable active? */
+ local_number--;
+ if (local_number == 0)
+ return getstr(f->locvars[i].varname);
+ }
+ }
+ return NULL; /* not found */
+}
+
--- /dev/null
+/*
+** $Id: lfunc.h,v 2.8 2012/05/08 13:53:33 roberto Exp $
+** Auxiliary functions to manipulate prototypes and closures
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lfunc_h
+#define lfunc_h
+
+
+#include "lobject.h"
+
+
+#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \
+ cast(int, sizeof(TValue)*((n)-1)))
+
+#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \
+ cast(int, sizeof(TValue *)*((n)-1)))
+
+
+LUAI_FUNC Proto *luaF_newproto (lua_State *L);
+LUAI_FUNC Closure *luaF_newCclosure (lua_State *L, int nelems);
+LUAI_FUNC Closure *luaF_newLclosure (lua_State *L, int nelems);
+LUAI_FUNC UpVal *luaF_newupval (lua_State *L);
+LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
+LUAI_FUNC void luaF_close (lua_State *L, StkId level);
+LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
+LUAI_FUNC void luaF_freeupval (lua_State *L, UpVal *uv);
+LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
+ int pc);
+
+
+#endif
--- /dev/null
+/*
+** $Id: lgc.c,v 2.140 2013/03/16 21:10:18 roberto Exp $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+#include <string.h>
+
+#define lgc_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+
+
+
+/*
+** cost of sweeping one element (the size of a small object divided
+** by some adjust for the sweep speed)
+*/
+#define GCSWEEPCOST ((sizeof(TString) + 4) / 4)
+
+/* maximum number of elements to sweep in each single step */
+#define GCSWEEPMAX (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4))
+
+/* maximum number of finalizers to call in each GC step */
+#define GCFINALIZENUM 4
+
+
+/*
+** macro to adjust 'stepmul': 'stepmul' is actually used like
+** 'stepmul / STEPMULADJ' (value chosen by tests)
+*/
+#define STEPMULADJ 200
+
+
+/*
+** macro to adjust 'pause': 'pause' is actually used like
+** 'pause / PAUSEADJ' (value chosen by tests)
+*/
+#define PAUSEADJ 100
+
+
+/*
+** 'makewhite' erases all color bits plus the old bit and then
+** sets only the current white bit
+*/
+#define maskcolors (~(bit2mask(BLACKBIT, OLDBIT) | WHITEBITS))
+#define makewhite(g,x) \
+ (gch(x)->marked = cast_byte((gch(x)->marked & maskcolors) | luaC_white(g)))
+
+#define white2gray(x) resetbits(gch(x)->marked, WHITEBITS)
+#define black2gray(x) resetbit(gch(x)->marked, BLACKBIT)
+
+
+#define isfinalized(x) testbit(gch(x)->marked, FINALIZEDBIT)
+
+#define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n)))
+
+
+#define checkconsistency(obj) \
+ lua_longassert(!iscollectable(obj) || righttt(obj))
+
+
+#define markvalue(g,o) { checkconsistency(o); \
+ if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
+
+#define markobject(g,t) { if ((t) && iswhite(obj2gco(t))) \
+ reallymarkobject(g, obj2gco(t)); }
+
+static void reallymarkobject (global_State *g, GCObject *o);
+
+
+/*
+** {======================================================
+** Generic functions
+** =======================================================
+*/
+
+
+/*
+** one after last element in a hash array
+*/
+#define gnodelast(h) gnode(h, cast(size_t, sizenode(h)))
+
+
+/*
+** link table 'h' into list pointed by 'p'
+*/
+#define linktable(h,p) ((h)->gclist = *(p), *(p) = obj2gco(h))
+
+
+/*
+** if key is not marked, mark its entry as dead (therefore removing it
+** from the table)
+*/
+static void removeentry (Node *n) {
+ lua_assert(ttisnil(gval(n)));
+ if (valiswhite(gkey(n)))
+ setdeadvalue(gkey(n)); /* unused and unmarked key; remove it */
+}
+
+
+/*
+** tells whether a key or value can be cleared from a weak
+** table. Non-collectable objects are never removed from weak
+** tables. Strings behave as `values', so are never removed too. for
+** other objects: if really collected, cannot keep them; for objects
+** being finalized, keep them in keys, but not in values
+*/
+static int iscleared (global_State *g, const TValue *o) {
+ if (!iscollectable(o)) return 0;
+ else if (ttisstring(o)) {
+ markobject(g, rawtsvalue(o)); /* strings are `values', so are never weak */
+ return 0;
+ }
+ else return iswhite(gcvalue(o));
+}
+
+
+/*
+** barrier that moves collector forward, that is, mark the white object
+** being pointed by a black object.
+*/
+void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
+ global_State *g = G(L);
+ lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
+ lua_assert(g->gcstate != GCSpause);
+ lua_assert(gch(o)->tt != LUA_TTABLE);
+ if (keepinvariantout(g)) /* must keep invariant? */
+ reallymarkobject(g, v); /* restore invariant */
+ else { /* sweep phase */
+ lua_assert(issweepphase(g));
+ makewhite(g, o); /* mark main obj. as white to avoid other barriers */
+ }
+}
+
+
+/*
+** barrier that moves collector backward, that is, mark the black object
+** pointing to a white object as gray again. (Current implementation
+** only works for tables; access to 'gclist' is not uniform across
+** different types.)
+*/
+void luaC_barrierback_ (lua_State *L, GCObject *o) {
+ global_State *g = G(L);
+ lua_assert(isblack(o) && !isdead(g, o) && gch(o)->tt == LUA_TTABLE);
+ black2gray(o); /* make object gray (again) */
+ gco2t(o)->gclist = g->grayagain;
+ g->grayagain = o;
+}
+
+
+/*
+** barrier for prototypes. When creating first closure (cache is
+** NULL), use a forward barrier; this may be the only closure of the
+** prototype (if it is a "regular" function, with a single instance)
+** and the prototype may be big, so it is better to avoid traversing
+** it again. Otherwise, use a backward barrier, to avoid marking all
+** possible instances.
+*/
+LUAI_FUNC void luaC_barrierproto_ (lua_State *L, Proto *p, Closure *c) {
+ global_State *g = G(L);
+ lua_assert(isblack(obj2gco(p)));
+ if (p->cache == NULL) { /* first time? */
+ luaC_objbarrier(L, p, c);
+ }
+ else { /* use a backward barrier */
+ black2gray(obj2gco(p)); /* make prototype gray (again) */
+ p->gclist = g->grayagain;
+ g->grayagain = obj2gco(p);
+ }
+}
+
+
+/*
+** check color (and invariants) for an upvalue that was closed,
+** i.e., moved into the 'allgc' list
+*/
+void luaC_checkupvalcolor (global_State *g, UpVal *uv) {
+ GCObject *o = obj2gco(uv);
+ lua_assert(!isblack(o)); /* open upvalues are never black */
+ if (isgray(o)) {
+ if (keepinvariant(g)) {
+ resetoldbit(o); /* see MOVE OLD rule */
+ gray2black(o); /* it is being visited now */
+ markvalue(g, uv->v);
+ }
+ else {
+ lua_assert(issweepphase(g));
+ makewhite(g, o);
+ }
+ }
+}
+
+
+/*
+** create a new collectable object (with given type and size) and link
+** it to '*list'. 'offset' tells how many bytes to allocate before the
+** object itself (used only by states).
+*/
+GCObject *luaC_newobj (lua_State *L, int tt, size_t sz, GCObject **list,
+ int offset) {
+ global_State *g = G(L);
+ char *raw = cast(char *, luaM_newobject(L, novariant(tt), sz));
+ GCObject *o = obj2gco(raw + offset);
+ if (list == NULL)
+ list = &g->allgc; /* standard list for collectable objects */
+ gch(o)->marked = luaC_white(g);
+ gch(o)->tt = tt;
+ gch(o)->next = *list;
+ *list = o;
+ return o;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** Mark functions
+** =======================================================
+*/
+
+
+/*
+** mark an object. Userdata, strings, and closed upvalues are visited
+** and turned black here. Other objects are marked gray and added
+** to appropriate list to be visited (and turned black) later. (Open
+** upvalues are already linked in 'headuv' list.)
+*/
+static void reallymarkobject (global_State *g, GCObject *o) {
+ lu_mem size;
+ white2gray(o);
+ switch (gch(o)->tt) {
+ case LUA_TSHRSTR:
+ case LUA_TLNGSTR: {
+ size = sizestring(gco2ts(o));
+ break; /* nothing else to mark; make it black */
+ }
+ case LUA_TUSERDATA: {
+ Table *mt = gco2u(o)->metatable;
+ markobject(g, mt);
+ markobject(g, gco2u(o)->env);
+ size = sizeudata(gco2u(o));
+ break;
+ }
+ case LUA_TUPVAL: {
+ UpVal *uv = gco2uv(o);
+ markvalue(g, uv->v);
+ if (uv->v != &uv->u.value) /* open? */
+ return; /* open upvalues remain gray */
+ size = sizeof(UpVal);
+ break;
+ }
+ case LUA_TLCL: {
+ gco2lcl(o)->gclist = g->gray;
+ g->gray = o;
+ return;
+ }
+ case LUA_TCCL: {
+ gco2ccl(o)->gclist = g->gray;
+ g->gray = o;
+ return;
+ }
+ case LUA_TTABLE: {
+ linktable(gco2t(o), &g->gray);
+ return;
+ }
+ case LUA_TTHREAD: {
+ gco2th(o)->gclist = g->gray;
+ g->gray = o;
+ return;
+ }
+ case LUA_TPROTO: {
+ gco2p(o)->gclist = g->gray;
+ g->gray = o;
+ return;
+ }
+ default: lua_assert(0); return;
+ }
+ gray2black(o);
+ g->GCmemtrav += size;
+}
+
+
+/*
+** mark metamethods for basic types
+*/
+static void markmt (global_State *g) {
+ int i;
+ for (i=0; i < LUA_NUMTAGS; i++)
+ markobject(g, g->mt[i]);
+}
+
+
+/*
+** mark all objects in list of being-finalized
+*/
+static void markbeingfnz (global_State *g) {
+ GCObject *o;
+ for (o = g->tobefnz; o != NULL; o = gch(o)->next) {
+ makewhite(g, o);
+ reallymarkobject(g, o);
+ }
+}
+
+
+/*
+** mark all values stored in marked open upvalues. (See comment in
+** 'lstate.h'.)
+*/
+static void remarkupvals (global_State *g) {
+ UpVal *uv;
+ for (uv = g->uvhead.u.l.next; uv != &g->uvhead; uv = uv->u.l.next) {
+ if (isgray(obj2gco(uv)))
+ markvalue(g, uv->v);
+ }
+}
+
+
+/*
+** mark root set and reset all gray lists, to start a new
+** incremental (or full) collection
+*/
+static void restartcollection (global_State *g) {
+ g->gray = g->grayagain = NULL;
+ g->weak = g->allweak = g->ephemeron = NULL;
+ markobject(g, g->mainthread);
+ markvalue(g, &g->l_registry);
+ markmt(g);
+ markbeingfnz(g); /* mark any finalizing object left from previous cycle */
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Traverse functions
+** =======================================================
+*/
+
+static void traverseweakvalue (global_State *g, Table *h) {
+ Node *n, *limit = gnodelast(h);
+ /* if there is array part, assume it may have white values (do not
+ traverse it just to check) */
+ int hasclears = (h->sizearray > 0);
+ for (n = gnode(h, 0); n < limit; n++) {
+ checkdeadkey(n);
+ if (ttisnil(gval(n))) /* entry is empty? */
+ removeentry(n); /* remove it */
+ else {
+ lua_assert(!ttisnil(gkey(n)));
+ markvalue(g, gkey(n)); /* mark key */
+ if (!hasclears && iscleared(g, gval(n))) /* is there a white value? */
+ hasclears = 1; /* table will have to be cleared */
+ }
+ }
+ if (hasclears)
+ linktable(h, &g->weak); /* has to be cleared later */
+ else /* no white values */
+ linktable(h, &g->grayagain); /* no need to clean */
+}
+
+
+static int traverseephemeron (global_State *g, Table *h) {
+ int marked = 0; /* true if an object is marked in this traversal */
+ int hasclears = 0; /* true if table has white keys */
+ int prop = 0; /* true if table has entry "white-key -> white-value" */
+ Node *n, *limit = gnodelast(h);
+ int i;
+ /* traverse array part (numeric keys are 'strong') */
+ for (i = 0; i < h->sizearray; i++) {
+ if (valiswhite(&h->array[i])) {
+ marked = 1;
+ reallymarkobject(g, gcvalue(&h->array[i]));
+ }
+ }
+ /* traverse hash part */
+ for (n = gnode(h, 0); n < limit; n++) {
+ checkdeadkey(n);
+ if (ttisnil(gval(n))) /* entry is empty? */
+ removeentry(n); /* remove it */
+ else if (iscleared(g, gkey(n))) { /* key is not marked (yet)? */
+ hasclears = 1; /* table must be cleared */
+ if (valiswhite(gval(n))) /* value not marked yet? */
+ prop = 1; /* must propagate again */
+ }
+ else if (valiswhite(gval(n))) { /* value not marked yet? */
+ marked = 1;
+ reallymarkobject(g, gcvalue(gval(n))); /* mark it now */
+ }
+ }
+ if (prop)
+ linktable(h, &g->ephemeron); /* have to propagate again */
+ else if (hasclears) /* does table have white keys? */
+ linktable(h, &g->allweak); /* may have to clean white keys */
+ else /* no white keys */
+ linktable(h, &g->grayagain); /* no need to clean */
+ return marked;
+}
+
+
+static void traversestrongtable (global_State *g, Table *h) {
+ Node *n, *limit = gnodelast(h);
+ int i;
+ for (i = 0; i < h->sizearray; i++) /* traverse array part */
+ markvalue(g, &h->array[i]);
+ for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
+ checkdeadkey(n);
+ if (ttisnil(gval(n))) /* entry is empty? */
+ removeentry(n); /* remove it */
+ else {
+ lua_assert(!ttisnil(gkey(n)));
+ markvalue(g, gkey(n)); /* mark key */
+ markvalue(g, gval(n)); /* mark value */
+ }
+ }
+}
+
+
+static lu_mem traversetable (global_State *g, Table *h) {
+ const char *weakkey, *weakvalue;
+ const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
+ markobject(g, h->metatable);
+ if (mode && ttisstring(mode) && /* is there a weak mode? */
+ ((weakkey = strchr(svalue(mode), 'k')),
+ (weakvalue = strchr(svalue(mode), 'v')),
+ (weakkey || weakvalue))) { /* is really weak? */
+ black2gray(obj2gco(h)); /* keep table gray */
+ if (!weakkey) /* strong keys? */
+ traverseweakvalue(g, h);
+ else if (!weakvalue) /* strong values? */
+ traverseephemeron(g, h);
+ else /* all weak */
+ linktable(h, &g->allweak); /* nothing to traverse now */
+ }
+ else /* not weak */
+ traversestrongtable(g, h);
+ return sizeof(Table) + sizeof(TValue) * h->sizearray +
+ sizeof(Node) * cast(size_t, sizenode(h));
+}
+
+
+static int traverseproto (global_State *g, Proto *f) {
+ int i;
+ if (f->cache && iswhite(obj2gco(f->cache)))
+ f->cache = NULL; /* allow cache to be collected */
+ markobject(g, f->source);
+ for (i = 0; i < f->sizek; i++) /* mark literals */
+ markvalue(g, &f->k[i]);
+ for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */
+ markobject(g, f->upvalues[i].name);
+ for (i = 0; i < f->sizep; i++) /* mark nested protos */
+ markobject(g, f->p[i]);
+ for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */
+ markobject(g, f->locvars[i].varname);
+ return sizeof(Proto) + sizeof(Instruction) * f->sizecode +
+ sizeof(Proto *) * f->sizep +
+ sizeof(TValue) * f->sizek +
+ sizeof(int) * f->sizelineinfo +
+ sizeof(LocVar) * f->sizelocvars +
+ sizeof(Upvaldesc) * f->sizeupvalues;
+}
+
+
+static lu_mem traverseCclosure (global_State *g, CClosure *cl) {
+ int i;
+ for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */
+ markvalue(g, &cl->upvalue[i]);
+ return sizeCclosure(cl->nupvalues);
+}
+
+static lu_mem traverseLclosure (global_State *g, LClosure *cl) {
+ int i;
+ markobject(g, cl->p); /* mark its prototype */
+ for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */
+ markobject(g, cl->upvals[i]);
+ return sizeLclosure(cl->nupvalues);
+}
+
+
+static lu_mem traversestack (global_State *g, lua_State *th) {
+ StkId o = th->stack;
+ if (o == NULL)
+ return 1; /* stack not completely built yet */
+ for (; o < th->top; o++)
+ markvalue(g, o);
+ if (g->gcstate == GCSatomic) { /* final traversal? */
+ StkId lim = th->stack + th->stacksize; /* real end of stack */
+ for (; o < lim; o++) /* clear not-marked stack slice */
+ setnilvalue(o);
+ }
+ return sizeof(lua_State) + sizeof(TValue) * th->stacksize;
+}
+
+
+/*
+** traverse one gray object, turning it to black (except for threads,
+** which are always gray).
+*/
+static void propagatemark (global_State *g) {
+ lu_mem size;
+ GCObject *o = g->gray;
+ lua_assert(isgray(o));
+ gray2black(o);
+ switch (gch(o)->tt) {
+ case LUA_TTABLE: {
+ Table *h = gco2t(o);
+ g->gray = h->gclist; /* remove from 'gray' list */
+ size = traversetable(g, h);
+ break;
+ }
+ case LUA_TLCL: {
+ LClosure *cl = gco2lcl(o);
+ g->gray = cl->gclist; /* remove from 'gray' list */
+ size = traverseLclosure(g, cl);
+ break;
+ }
+ case LUA_TCCL: {
+ CClosure *cl = gco2ccl(o);
+ g->gray = cl->gclist; /* remove from 'gray' list */
+ size = traverseCclosure(g, cl);
+ break;
+ }
+ case LUA_TTHREAD: {
+ lua_State *th = gco2th(o);
+ g->gray = th->gclist; /* remove from 'gray' list */
+ th->gclist = g->grayagain;
+ g->grayagain = o; /* insert into 'grayagain' list */
+ black2gray(o);
+ size = traversestack(g, th);
+ break;
+ }
+ case LUA_TPROTO: {
+ Proto *p = gco2p(o);
+ g->gray = p->gclist; /* remove from 'gray' list */
+ size = traverseproto(g, p);
+ break;
+ }
+ default: lua_assert(0); return;
+ }
+ g->GCmemtrav += size;
+}
+
+
+static void propagateall (global_State *g) {
+ while (g->gray) propagatemark(g);
+}
+
+
+static void propagatelist (global_State *g, GCObject *l) {
+ lua_assert(g->gray == NULL); /* no grays left */
+ g->gray = l;
+ propagateall(g); /* traverse all elements from 'l' */
+}
+
+/*
+** retraverse all gray lists. Because tables may be reinserted in other
+** lists when traversed, traverse the original lists to avoid traversing
+** twice the same table (which is not wrong, but inefficient)
+*/
+static void retraversegrays (global_State *g) {
+ GCObject *weak = g->weak; /* save original lists */
+ GCObject *grayagain = g->grayagain;
+ GCObject *ephemeron = g->ephemeron;
+ g->weak = g->grayagain = g->ephemeron = NULL;
+ propagateall(g); /* traverse main gray list */
+ propagatelist(g, grayagain);
+ propagatelist(g, weak);
+ propagatelist(g, ephemeron);
+}
+
+
+static void convergeephemerons (global_State *g) {
+ int changed;
+ do {
+ GCObject *w;
+ GCObject *next = g->ephemeron; /* get ephemeron list */
+ g->ephemeron = NULL; /* tables will return to this list when traversed */
+ changed = 0;
+ while ((w = next) != NULL) {
+ next = gco2t(w)->gclist;
+ if (traverseephemeron(g, gco2t(w))) { /* traverse marked some value? */
+ propagateall(g); /* propagate changes */
+ changed = 1; /* will have to revisit all ephemeron tables */
+ }
+ }
+ } while (changed);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Sweep Functions
+** =======================================================
+*/
+
+
+/*
+** clear entries with unmarked keys from all weaktables in list 'l' up
+** to element 'f'
+*/
+static void clearkeys (global_State *g, GCObject *l, GCObject *f) {
+ for (; l != f; l = gco2t(l)->gclist) {
+ Table *h = gco2t(l);
+ Node *n, *limit = gnodelast(h);
+ for (n = gnode(h, 0); n < limit; n++) {
+ if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) {
+ setnilvalue(gval(n)); /* remove value ... */
+ removeentry(n); /* and remove entry from table */
+ }
+ }
+ }
+}
+
+
+/*
+** clear entries with unmarked values from all weaktables in list 'l' up
+** to element 'f'
+*/
+static void clearvalues (global_State *g, GCObject *l, GCObject *f) {
+ for (; l != f; l = gco2t(l)->gclist) {
+ Table *h = gco2t(l);
+ Node *n, *limit = gnodelast(h);
+ int i;
+ for (i = 0; i < h->sizearray; i++) {
+ TValue *o = &h->array[i];
+ if (iscleared(g, o)) /* value was collected? */
+ setnilvalue(o); /* remove value */
+ }
+ for (n = gnode(h, 0); n < limit; n++) {
+ if (!ttisnil(gval(n)) && iscleared(g, gval(n))) {
+ setnilvalue(gval(n)); /* remove value ... */
+ removeentry(n); /* and remove entry from table */
+ }
+ }
+ }
+}
+
+
+static void freeobj (lua_State *L, GCObject *o) {
+ switch (gch(o)->tt) {
+ case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break;
+ case LUA_TLCL: {
+ luaM_freemem(L, o, sizeLclosure(gco2lcl(o)->nupvalues));
+ break;
+ }
+ case LUA_TCCL: {
+ luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));
+ break;
+ }
+ case LUA_TUPVAL: luaF_freeupval(L, gco2uv(o)); break;
+ case LUA_TTABLE: luaH_free(L, gco2t(o)); break;
+ case LUA_TTHREAD: luaE_freethread(L, gco2th(o)); break;
+ case LUA_TUSERDATA: luaM_freemem(L, o, sizeudata(gco2u(o))); break;
+ case LUA_TSHRSTR:
+ G(L)->strt.nuse--;
+ /* go through */
+ case LUA_TLNGSTR: {
+ luaM_freemem(L, o, sizestring(gco2ts(o)));
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+
+#define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM)
+static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count);
+
+
+/*
+** sweep the (open) upvalues of a thread and resize its stack and
+** list of call-info structures.
+*/
+static void sweepthread (lua_State *L, lua_State *L1) {
+ if (L1->stack == NULL) return; /* stack not completely built yet */
+ sweepwholelist(L, &L1->openupval); /* sweep open upvalues */
+ luaE_freeCI(L1); /* free extra CallInfo slots */
+ /* should not change the stack during an emergency gc cycle */
+ if (G(L)->gckind != KGC_EMERGENCY)
+ luaD_shrinkstack(L1);
+}
+
+
+/*
+** sweep at most 'count' elements from a list of GCObjects erasing dead
+** objects, where a dead (not alive) object is one marked with the "old"
+** (non current) white and not fixed.
+** In non-generational mode, change all non-dead objects back to white,
+** preparing for next collection cycle.
+** In generational mode, keep black objects black, and also mark them as
+** old; stop when hitting an old object, as all objects after that
+** one will be old too.
+** When object is a thread, sweep its list of open upvalues too.
+*/
+static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {
+ global_State *g = G(L);
+ int ow = otherwhite(g);
+ int toclear, toset; /* bits to clear and to set in all live objects */
+ int tostop; /* stop sweep when this is true */
+ if (isgenerational(g)) { /* generational mode? */
+ toclear = ~0; /* clear nothing */
+ toset = bitmask(OLDBIT); /* set the old bit of all surviving objects */
+ tostop = bitmask(OLDBIT); /* do not sweep old generation */
+ }
+ else { /* normal mode */
+ toclear = maskcolors; /* clear all color bits + old bit */
+ toset = luaC_white(g); /* make object white */
+ tostop = 0; /* do not stop */
+ }
+ while (*p != NULL && count-- > 0) {
+ GCObject *curr = *p;
+ int marked = gch(curr)->marked;
+ if (isdeadm(ow, marked)) { /* is 'curr' dead? */
+ *p = gch(curr)->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else {
+ if (testbits(marked, tostop))
+ return NULL; /* stop sweeping this list */
+ if (gch(curr)->tt == LUA_TTHREAD)
+ sweepthread(L, gco2th(curr)); /* sweep thread's upvalues */
+ /* update marks */
+ gch(curr)->marked = cast_byte((marked & toclear) | toset);
+ p = &gch(curr)->next; /* go to next element */
+ }
+ }
+ return (*p == NULL) ? NULL : p;
+}
+
+
+/*
+** sweep a list until a live object (or end of list)
+*/
+static GCObject **sweeptolive (lua_State *L, GCObject **p, int *n) {
+ GCObject ** old = p;
+ int i = 0;
+ do {
+ i++;
+ p = sweeplist(L, p, 1);
+ } while (p == old);
+ if (n) *n += i;
+ return p;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Finalization
+** =======================================================
+*/
+
+static void checkSizes (lua_State *L) {
+ global_State *g = G(L);
+ if (g->gckind != KGC_EMERGENCY) { /* do not change sizes in emergency */
+ int hs = g->strt.size / 2; /* half the size of the string table */
+ if (g->strt.nuse < cast(lu_int32, hs)) /* using less than that half? */
+ luaS_resize(L, hs); /* halve its size */
+ luaZ_freebuffer(L, &g->buff); /* free concatenation buffer */
+ }
+}
+
+
+static GCObject *udata2finalize (global_State *g) {
+ GCObject *o = g->tobefnz; /* get first element */
+ lua_assert(isfinalized(o));
+ g->tobefnz = gch(o)->next; /* remove it from 'tobefnz' list */
+ gch(o)->next = g->allgc; /* return it to 'allgc' list */
+ g->allgc = o;
+ resetbit(gch(o)->marked, SEPARATED); /* mark that it is not in 'tobefnz' */
+ lua_assert(!isold(o)); /* see MOVE OLD rule */
+ if (!keepinvariantout(g)) /* not keeping invariant? */
+ makewhite(g, o); /* "sweep" object */
+ return o;
+}
+
+
+static void dothecall (lua_State *L, void *ud) {
+ UNUSED(ud);
+ luaD_call(L, L->top - 2, 0, 0);
+}
+
+
+static void GCTM (lua_State *L, int propagateerrors) {
+ global_State *g = G(L);
+ const TValue *tm;
+ TValue v;
+ setgcovalue(L, &v, udata2finalize(g));
+ tm = luaT_gettmbyobj(L, &v, TM_GC);
+ if (tm != NULL && ttisfunction(tm)) { /* is there a finalizer? */
+ int status;
+ lu_byte oldah = L->allowhook;
+ int running = g->gcrunning;
+ L->allowhook = 0; /* stop debug hooks during GC metamethod */
+ g->gcrunning = 0; /* avoid GC steps */
+ setobj2s(L, L->top, tm); /* push finalizer... */
+ setobj2s(L, L->top + 1, &v); /* ... and its argument */
+ L->top += 2; /* and (next line) call the finalizer */
+ status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
+ L->allowhook = oldah; /* restore hooks */
+ g->gcrunning = running; /* restore state */
+ if (status != LUA_OK && propagateerrors) { /* error while running __gc? */
+ if (status == LUA_ERRRUN) { /* is there an error object? */
+ const char *msg = (ttisstring(L->top - 1))
+ ? svalue(L->top - 1)
+ : "no message";
+ luaO_pushfstring(L, "error in __gc metamethod (%s)", msg);
+ status = LUA_ERRGCMM; /* error in __gc metamethod */
+ }
+ luaD_throw(L, status); /* re-throw error */
+ }
+ }
+}
+
+
+/*
+** move all unreachable objects (or 'all' objects) that need
+** finalization from list 'finobj' to list 'tobefnz' (to be finalized)
+*/
+static void separatetobefnz (lua_State *L, int all) {
+ global_State *g = G(L);
+ GCObject **p = &g->finobj;
+ GCObject *curr;
+ GCObject **lastnext = &g->tobefnz;
+ /* find last 'next' field in 'tobefnz' list (to add elements in its end) */
+ while (*lastnext != NULL)
+ lastnext = &gch(*lastnext)->next;
+ while ((curr = *p) != NULL) { /* traverse all finalizable objects */
+ lua_assert(!isfinalized(curr));
+ lua_assert(testbit(gch(curr)->marked, SEPARATED));
+ if (!(iswhite(curr) || all)) /* not being collected? */
+ p = &gch(curr)->next; /* don't bother with it */
+ else {
+ l_setbit(gch(curr)->marked, FINALIZEDBIT); /* won't be finalized again */
+ *p = gch(curr)->next; /* remove 'curr' from 'finobj' list */
+ gch(curr)->next = *lastnext; /* link at the end of 'tobefnz' list */
+ *lastnext = curr;
+ lastnext = &gch(curr)->next;
+ }
+ }
+}
+
+
+/*
+** if object 'o' has a finalizer, remove it from 'allgc' list (must
+** search the list to find it) and link it in 'finobj' list.
+*/
+void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
+ global_State *g = G(L);
+ if (testbit(gch(o)->marked, SEPARATED) || /* obj. is already separated... */
+ isfinalized(o) || /* ... or is finalized... */
+ gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */
+ return; /* nothing to be done */
+ else { /* move 'o' to 'finobj' list */
+ GCObject **p;
+ GCheader *ho = gch(o);
+ if (g->sweepgc == &ho->next) { /* avoid removing current sweep object */
+ lua_assert(issweepphase(g));
+ g->sweepgc = sweeptolive(L, g->sweepgc, NULL);
+ }
+ /* search for pointer pointing to 'o' */
+ for (p = &g->allgc; *p != o; p = &gch(*p)->next) { /* empty */ }
+ *p = ho->next; /* remove 'o' from root list */
+ ho->next = g->finobj; /* link it in list 'finobj' */
+ g->finobj = o;
+ l_setbit(ho->marked, SEPARATED); /* mark it as such */
+ if (!keepinvariantout(g)) /* not keeping invariant? */
+ makewhite(g, o); /* "sweep" object */
+ else
+ resetoldbit(o); /* see MOVE OLD rule */
+ }
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** GC control
+** =======================================================
+*/
+
+
+/*
+** set a reasonable "time" to wait before starting a new GC cycle;
+** cycle will start when memory use hits threshold
+*/
+static void setpause (global_State *g, l_mem estimate) {
+ l_mem debt, threshold;
+ estimate = estimate / PAUSEADJ; /* adjust 'estimate' */
+ threshold = (g->gcpause < MAX_LMEM / estimate) /* overflow? */
+ ? estimate * g->gcpause /* no overflow */
+ : MAX_LMEM; /* overflow; truncate to maximum */
+ debt = -cast(l_mem, threshold - gettotalbytes(g));
+ luaE_setdebt(g, debt);
+}
+
+
+#define sweepphases \
+ (bitmask(GCSsweepstring) | bitmask(GCSsweepudata) | bitmask(GCSsweep))
+
+
+/*
+** enter first sweep phase (strings) and prepare pointers for other
+** sweep phases. The calls to 'sweeptolive' make pointers point to an
+** object inside the list (instead of to the header), so that the real
+** sweep do not need to skip objects created between "now" and the start
+** of the real sweep.
+** Returns how many objects it swept.
+*/
+static int entersweep (lua_State *L) {
+ global_State *g = G(L);
+ int n = 0;
+ g->gcstate = GCSsweepstring;
+ lua_assert(g->sweepgc == NULL && g->sweepfin == NULL);
+ /* prepare to sweep strings, finalizable objects, and regular objects */
+ g->sweepstrgc = 0;
+ g->sweepfin = sweeptolive(L, &g->finobj, &n);
+ g->sweepgc = sweeptolive(L, &g->allgc, &n);
+ return n;
+}
+
+
+/*
+** change GC mode
+*/
+void luaC_changemode (lua_State *L, int mode) {
+ global_State *g = G(L);
+ if (mode == g->gckind) return; /* nothing to change */
+ if (mode == KGC_GEN) { /* change to generational mode */
+ /* make sure gray lists are consistent */
+ luaC_runtilstate(L, bitmask(GCSpropagate));
+ g->GCestimate = gettotalbytes(g);
+ g->gckind = KGC_GEN;
+ }
+ else { /* change to incremental mode */
+ /* sweep all objects to turn them back to white
+ (as white has not changed, nothing extra will be collected) */
+ g->gckind = KGC_NORMAL;
+ entersweep(L);
+ luaC_runtilstate(L, ~sweepphases);
+ }
+}
+
+
+/*
+** call all pending finalizers
+*/
+static void callallpendingfinalizers (lua_State *L, int propagateerrors) {
+ global_State *g = G(L);
+ while (g->tobefnz) {
+ resetoldbit(g->tobefnz);
+ GCTM(L, propagateerrors);
+ }
+}
+
+
+void luaC_freeallobjects (lua_State *L) {
+ global_State *g = G(L);
+ int i;
+ separatetobefnz(L, 1); /* separate all objects with finalizers */
+ lua_assert(g->finobj == NULL);
+ callallpendingfinalizers(L, 0);
+ g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */
+ g->gckind = KGC_NORMAL;
+ sweepwholelist(L, &g->finobj); /* finalizers can create objs. in 'finobj' */
+ sweepwholelist(L, &g->allgc);
+ for (i = 0; i < g->strt.size; i++) /* free all string lists */
+ sweepwholelist(L, &g->strt.hash[i]);
+ lua_assert(g->strt.nuse == 0);
+}
+
+
+static l_mem atomic (lua_State *L) {
+ global_State *g = G(L);
+ l_mem work = -cast(l_mem, g->GCmemtrav); /* start counting work */
+ GCObject *origweak, *origall;
+ lua_assert(!iswhite(obj2gco(g->mainthread)));
+ markobject(g, L); /* mark running thread */
+ /* registry and global metatables may be changed by API */
+ markvalue(g, &g->l_registry);
+ markmt(g); /* mark basic metatables */
+ /* remark occasional upvalues of (maybe) dead threads */
+ remarkupvals(g);
+ propagateall(g); /* propagate changes */
+ work += g->GCmemtrav; /* stop counting (do not (re)count grays) */
+ /* traverse objects caught by write barrier and by 'remarkupvals' */
+ retraversegrays(g);
+ work -= g->GCmemtrav; /* restart counting */
+ convergeephemerons(g);
+ /* at this point, all strongly accessible objects are marked. */
+ /* clear values from weak tables, before checking finalizers */
+ clearvalues(g, g->weak, NULL);
+ clearvalues(g, g->allweak, NULL);
+ origweak = g->weak; origall = g->allweak;
+ work += g->GCmemtrav; /* stop counting (objects being finalized) */
+ separatetobefnz(L, 0); /* separate objects to be finalized */
+ markbeingfnz(g); /* mark objects that will be finalized */
+ propagateall(g); /* remark, to propagate `preserveness' */
+ work -= g->GCmemtrav; /* restart counting */
+ convergeephemerons(g);
+ /* at this point, all resurrected objects are marked. */
+ /* remove dead objects from weak tables */
+ clearkeys(g, g->ephemeron, NULL); /* clear keys from all ephemeron tables */
+ clearkeys(g, g->allweak, NULL); /* clear keys from all allweak tables */
+ /* clear values from resurrected weak tables */
+ clearvalues(g, g->weak, origweak);
+ clearvalues(g, g->allweak, origall);
+ g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */
+ work += g->GCmemtrav; /* complete counting */
+ return work; /* estimate of memory marked by 'atomic' */
+}
+
+
+static lu_mem singlestep (lua_State *L) {
+ global_State *g = G(L);
+ switch (g->gcstate) {
+ case GCSpause: {
+ /* start to count memory traversed */
+ g->GCmemtrav = g->strt.size * sizeof(GCObject*);
+ lua_assert(!isgenerational(g));
+ restartcollection(g);
+ g->gcstate = GCSpropagate;
+ return g->GCmemtrav;
+ }
+ case GCSpropagate: {
+ if (g->gray) {
+ lu_mem oldtrav = g->GCmemtrav;
+ propagatemark(g);
+ return g->GCmemtrav - oldtrav; /* memory traversed in this step */
+ }
+ else { /* no more `gray' objects */
+ lu_mem work;
+ int sw;
+ g->gcstate = GCSatomic; /* finish mark phase */
+ g->GCestimate = g->GCmemtrav; /* save what was counted */;
+ work = atomic(L); /* add what was traversed by 'atomic' */
+ g->GCestimate += work; /* estimate of total memory traversed */
+ sw = entersweep(L);
+ return work + sw * GCSWEEPCOST;
+ }
+ }
+ case GCSsweepstring: {
+ int i;
+ for (i = 0; i < GCSWEEPMAX && g->sweepstrgc + i < g->strt.size; i++)
+ sweepwholelist(L, &g->strt.hash[g->sweepstrgc + i]);
+ g->sweepstrgc += i;
+ if (g->sweepstrgc >= g->strt.size) /* no more strings to sweep? */
+ g->gcstate = GCSsweepudata;
+ return i * GCSWEEPCOST;
+ }
+ case GCSsweepudata: {
+ if (g->sweepfin) {
+ g->sweepfin = sweeplist(L, g->sweepfin, GCSWEEPMAX);
+ return GCSWEEPMAX*GCSWEEPCOST;
+ }
+ else {
+ g->gcstate = GCSsweep;
+ return 0;
+ }
+ }
+ case GCSsweep: {
+ if (g->sweepgc) {
+ g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);
+ return GCSWEEPMAX*GCSWEEPCOST;
+ }
+ else {
+ /* sweep main thread */
+ GCObject *mt = obj2gco(g->mainthread);
+ sweeplist(L, &mt, 1);
+ checkSizes(L);
+ g->gcstate = GCSpause; /* finish collection */
+ return GCSWEEPCOST;
+ }
+ }
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+/*
+** advances the garbage collector until it reaches a state allowed
+** by 'statemask'
+*/
+void luaC_runtilstate (lua_State *L, int statesmask) {
+ global_State *g = G(L);
+ while (!testbit(statesmask, g->gcstate))
+ singlestep(L);
+}
+
+
+static void generationalcollection (lua_State *L) {
+ global_State *g = G(L);
+ lua_assert(g->gcstate == GCSpropagate);
+ if (g->GCestimate == 0) { /* signal for another major collection? */
+ luaC_fullgc(L, 0); /* perform a full regular collection */
+ g->GCestimate = gettotalbytes(g); /* update control */
+ }
+ else {
+ lu_mem estimate = g->GCestimate;
+ luaC_runtilstate(L, bitmask(GCSpause)); /* run complete (minor) cycle */
+ g->gcstate = GCSpropagate; /* skip restart */
+ if (gettotalbytes(g) > (estimate / 100) * g->gcmajorinc)
+ g->GCestimate = 0; /* signal for a major collection */
+ else
+ g->GCestimate = estimate; /* keep estimate from last major coll. */
+
+ }
+ setpause(g, gettotalbytes(g));
+ lua_assert(g->gcstate == GCSpropagate);
+}
+
+
+static void incstep (lua_State *L) {
+ global_State *g = G(L);
+ l_mem debt = g->GCdebt;
+ int stepmul = g->gcstepmul;
+ if (stepmul < 40) stepmul = 40; /* avoid ridiculous low values (and 0) */
+ /* convert debt from Kb to 'work units' (avoid zero debt and overflows) */
+ debt = (debt / STEPMULADJ) + 1;
+ debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM;
+ do { /* always perform at least one single step */
+ lu_mem work = singlestep(L); /* do some work */
+ debt -= work;
+ } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause);
+ if (g->gcstate == GCSpause)
+ setpause(g, g->GCestimate); /* pause until next cycle */
+ else {
+ debt = (debt / stepmul) * STEPMULADJ; /* convert 'work units' to Kb */
+ luaE_setdebt(g, debt);
+ }
+}
+
+
+/*
+** performs a basic GC step
+*/
+void luaC_forcestep (lua_State *L) {
+ global_State *g = G(L);
+ int i;
+ if (isgenerational(g)) generationalcollection(L);
+ else incstep(L);
+ /* run a few finalizers (or all of them at the end of a collect cycle) */
+ for (i = 0; g->tobefnz && (i < GCFINALIZENUM || g->gcstate == GCSpause); i++)
+ GCTM(L, 1); /* call one finalizer */
+}
+
+
+/*
+** performs a basic GC step only if collector is running
+*/
+void luaC_step (lua_State *L) {
+ global_State *g = G(L);
+ if (g->gcrunning) luaC_forcestep(L);
+ else luaE_setdebt(g, -GCSTEPSIZE); /* avoid being called too often */
+}
+
+
+
+/*
+** performs a full GC cycle; if "isemergency", does not call
+** finalizers (which could change stack positions)
+*/
+void luaC_fullgc (lua_State *L, int isemergency) {
+ global_State *g = G(L);
+ int origkind = g->gckind;
+ lua_assert(origkind != KGC_EMERGENCY);
+ if (isemergency) /* do not run finalizers during emergency GC */
+ g->gckind = KGC_EMERGENCY;
+ else {
+ g->gckind = KGC_NORMAL;
+ callallpendingfinalizers(L, 1);
+ }
+ if (keepinvariant(g)) { /* may there be some black objects? */
+ /* must sweep all objects to turn them back to white
+ (as white has not changed, nothing will be collected) */
+ entersweep(L);
+ }
+ /* finish any pending sweep phase to start a new cycle */
+ luaC_runtilstate(L, bitmask(GCSpause));
+ luaC_runtilstate(L, ~bitmask(GCSpause)); /* start new collection */
+ luaC_runtilstate(L, bitmask(GCSpause)); /* run entire collection */
+ if (origkind == KGC_GEN) { /* generational mode? */
+ /* generational mode must be kept in propagate phase */
+ luaC_runtilstate(L, bitmask(GCSpropagate));
+ }
+ g->gckind = origkind;
+ setpause(g, gettotalbytes(g));
+ if (!isemergency) /* do not run finalizers during emergency GC */
+ callallpendingfinalizers(L, 1);
+}
+
+/* }====================================================== */
+
+
--- /dev/null
+/*
+** $Id: lgc.h,v 2.58 2012/09/11 12:53:08 roberto Exp $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lgc_h
+#define lgc_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+
+/*
+** Collectable objects may have one of three colors: white, which
+** means the object is not marked; gray, which means the
+** object is marked, but its references may be not marked; and
+** black, which means that the object and all its references are marked.
+** The main invariant of the garbage collector, while marking objects,
+** is that a black object can never point to a white one. Moreover,
+** any gray object must be in a "gray list" (gray, grayagain, weak,
+** allweak, ephemeron) so that it can be visited again before finishing
+** the collection cycle. These lists have no meaning when the invariant
+** is not being enforced (e.g., sweep phase).
+*/
+
+
+
+/* how much to allocate before next GC step */
+#if !defined(GCSTEPSIZE)
+/* ~100 small strings */
+#define GCSTEPSIZE (cast_int(100 * sizeof(TString)))
+#endif
+
+
+/*
+** Possible states of the Garbage Collector
+*/
+#define GCSpropagate 0
+#define GCSatomic 1
+#define GCSsweepstring 2
+#define GCSsweepudata 3
+#define GCSsweep 4
+#define GCSpause 5
+
+
+#define issweepphase(g) \
+ (GCSsweepstring <= (g)->gcstate && (g)->gcstate <= GCSsweep)
+
+#define isgenerational(g) ((g)->gckind == KGC_GEN)
+
+/*
+** macros to tell when main invariant (white objects cannot point to black
+** ones) must be kept. During a non-generational collection, the sweep
+** phase may break the invariant, as objects turned white may point to
+** still-black objects. The invariant is restored when sweep ends and
+** all objects are white again. During a generational collection, the
+** invariant must be kept all times.
+*/
+
+#define keepinvariant(g) (isgenerational(g) || g->gcstate <= GCSatomic)
+
+
+/*
+** Outside the collector, the state in generational mode is kept in
+** 'propagate', so 'keepinvariant' is always true.
+*/
+#define keepinvariantout(g) \
+ check_exp(g->gcstate == GCSpropagate || !isgenerational(g), \
+ g->gcstate <= GCSatomic)
+
+
+/*
+** some useful bit tricks
+*/
+#define resetbits(x,m) ((x) &= cast(lu_byte, ~(m)))
+#define setbits(x,m) ((x) |= (m))
+#define testbits(x,m) ((x) & (m))
+#define bitmask(b) (1<<(b))
+#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2))
+#define l_setbit(x,b) setbits(x, bitmask(b))
+#define resetbit(x,b) resetbits(x, bitmask(b))
+#define testbit(x,b) testbits(x, bitmask(b))
+
+
+/* Layout for bit use in `marked' field: */
+#define WHITE0BIT 0 /* object is white (type 0) */
+#define WHITE1BIT 1 /* object is white (type 1) */
+#define BLACKBIT 2 /* object is black */
+#define FINALIZEDBIT 3 /* object has been separated for finalization */
+#define SEPARATED 4 /* object is in 'finobj' list or in 'tobefnz' */
+#define FIXEDBIT 5 /* object is fixed (should not be collected) */
+#define OLDBIT 6 /* object is old (only in generational mode) */
+/* bit 7 is currently used by tests (luaL_checkmemory) */
+
+#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
+
+
+#define iswhite(x) testbits((x)->gch.marked, WHITEBITS)
+#define isblack(x) testbit((x)->gch.marked, BLACKBIT)
+#define isgray(x) /* neither white nor black */ \
+ (!testbits((x)->gch.marked, WHITEBITS | bitmask(BLACKBIT)))
+
+#define isold(x) testbit((x)->gch.marked, OLDBIT)
+
+/* MOVE OLD rule: whenever an object is moved to the beginning of
+ a GC list, its old bit must be cleared */
+#define resetoldbit(o) resetbit((o)->gch.marked, OLDBIT)
+
+#define otherwhite(g) (g->currentwhite ^ WHITEBITS)
+#define isdeadm(ow,m) (!(((m) ^ WHITEBITS) & (ow)))
+#define isdead(g,v) isdeadm(otherwhite(g), (v)->gch.marked)
+
+#define changewhite(x) ((x)->gch.marked ^= WHITEBITS)
+#define gray2black(x) l_setbit((x)->gch.marked, BLACKBIT)
+
+#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
+
+#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS)
+
+
+#define luaC_condGC(L,c) \
+ {if (G(L)->GCdebt > 0) {c;}; condchangemem(L);}
+#define luaC_checkGC(L) luaC_condGC(L, luaC_step(L);)
+
+
+#define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \
+ luaC_barrier_(L,obj2gco(p),gcvalue(v)); }
+
+#define luaC_barrierback(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \
+ luaC_barrierback_(L,p); }
+
+#define luaC_objbarrier(L,p,o) \
+ { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \
+ luaC_barrier_(L,obj2gco(p),obj2gco(o)); }
+
+#define luaC_objbarrierback(L,p,o) \
+ { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) luaC_barrierback_(L,p); }
+
+#define luaC_barrierproto(L,p,c) \
+ { if (isblack(obj2gco(p))) luaC_barrierproto_(L,p,c); }
+
+LUAI_FUNC void luaC_freeallobjects (lua_State *L);
+LUAI_FUNC void luaC_step (lua_State *L);
+LUAI_FUNC void luaC_forcestep (lua_State *L);
+LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
+LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
+LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz,
+ GCObject **list, int offset);
+LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
+LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
+LUAI_FUNC void luaC_barrierproto_ (lua_State *L, Proto *p, Closure *c);
+LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
+LUAI_FUNC void luaC_checkupvalcolor (global_State *g, UpVal *uv);
+LUAI_FUNC void luaC_changemode (lua_State *L, int mode);
+
+#endif
--- /dev/null
+/*
+** $Id: linit.c,v 1.32 2011/04/08 19:17:36 roberto Exp $
+** Initialization of libraries for lua.c and other clients
+** See Copyright Notice in lua.h
+*/
+
+
+/*
+** If you embed Lua in your program and need to open the standard
+** libraries, call luaL_openlibs in your program. If you need a
+** different set of libraries, copy this file to your project and edit
+** it to suit your needs.
+*/
+
+
+#define linit_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lualib.h"
+#include "lauxlib.h"
+
+
+/*
+** these libs are loaded by lua.c and are readily available to any Lua
+** program
+*/
+static const luaL_Reg loadedlibs[] = {
+ {"_G", luaopen_base},
+ {LUA_LOADLIBNAME, luaopen_package},
+ {LUA_COLIBNAME, luaopen_coroutine},
+ {LUA_TABLIBNAME, luaopen_table},
+ {LUA_IOLIBNAME, luaopen_io},
+ {LUA_OSLIBNAME, luaopen_os},
+ {LUA_STRLIBNAME, luaopen_string},
+ {LUA_BITLIBNAME, luaopen_bit32},
+ {LUA_MATHLIBNAME, luaopen_math},
+ {LUA_DBLIBNAME, luaopen_debug},
+ {NULL, NULL}
+};
+
+
+/*
+** these libs are preloaded and must be required before used
+*/
+static const luaL_Reg preloadedlibs[] = {
+ {NULL, NULL}
+};
+
+
+LUALIB_API void luaL_openlibs (lua_State *L) {
+ const luaL_Reg *lib;
+ /* call open functions from 'loadedlibs' and set results to global table */
+ for (lib = loadedlibs; lib->func; lib++) {
+ luaL_requiref(L, lib->name, lib->func, 1);
+ lua_pop(L, 1); /* remove lib */
+ }
+ /* add open functions from 'preloadedlibs' into 'package.preload' table */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD");
+ for (lib = preloadedlibs; lib->func; lib++) {
+ lua_pushcfunction(L, lib->func);
+ lua_setfield(L, -2, lib->name);
+ }
+ lua_pop(L, 1); /* remove _PRELOAD table */
+}
+
--- /dev/null
+/*
+** $Id: liolib.c,v 2.111 2013/03/21 13:57:27 roberto Exp $
+** Standard I/O (and system) library
+** See Copyright Notice in lua.h
+*/
+
+
+/*
+** POSIX idiosyncrasy!
+** This definition must come before the inclusion of 'stdio.h'; it
+** should not affect non-POSIX systems
+*/
+#if !defined(_FILE_OFFSET_BITS)
+#define _FILE_OFFSET_BITS 64
+#endif
+
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define liolib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#if !defined(lua_checkmode)
+
+/*
+** Check whether 'mode' matches '[rwa]%+?b?'.
+** Change this macro to accept other modes for 'fopen' besides
+** the standard ones.
+*/
+#define lua_checkmode(mode) \
+ (*mode != '\0' && strchr("rwa", *(mode++)) != NULL && \
+ (*mode != '+' || ++mode) && /* skip if char is '+' */ \
+ (*mode != 'b' || ++mode) && /* skip if char is 'b' */ \
+ (*mode == '\0'))
+
+#endif
+
+/*
+** {======================================================
+** lua_popen spawns a new process connected to the current
+** one through the file streams.
+** =======================================================
+*/
+
+#if !defined(lua_popen) /* { */
+
+#if defined(LUA_USE_POPEN) /* { */
+
+#define lua_popen(L,c,m) ((void)L, fflush(NULL), popen(c,m))
+#define lua_pclose(L,file) ((void)L, pclose(file))
+
+#elif defined(LUA_WIN) /* }{ */
+
+#define lua_popen(L,c,m) ((void)L, _popen(c,m))
+#define lua_pclose(L,file) ((void)L, _pclose(file))
+
+
+#else /* }{ */
+
+#define lua_popen(L,c,m) ((void)((void)c, m), \
+ luaL_error(L, LUA_QL("popen") " not supported"), (FILE*)0)
+#define lua_pclose(L,file) ((void)((void)L, file), -1)
+
+
+#endif /* } */
+
+#endif /* } */
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** lua_fseek/lua_ftell: configuration for longer offsets
+** =======================================================
+*/
+
+#if !defined(lua_fseek) /* { */
+
+#if defined(LUA_USE_POSIX)
+
+#define l_fseek(f,o,w) fseeko(f,o,w)
+#define l_ftell(f) ftello(f)
+#define l_seeknum off_t
+
+#elif defined(LUA_WIN) && !defined(_CRTIMP_TYPEINFO) \
+ && defined(_MSC_VER) && (_MSC_VER >= 1400)
+/* Windows (but not DDK) and Visual C++ 2005 or higher */
+
+#define l_fseek(f,o,w) _fseeki64(f,o,w)
+#define l_ftell(f) _ftelli64(f)
+#define l_seeknum __int64
+
+#else
+
+#define l_fseek(f,o,w) fseek(f,o,w)
+#define l_ftell(f) ftell(f)
+#define l_seeknum long
+
+#endif
+
+#endif /* } */
+
+/* }====================================================== */
+
+
+#define IO_PREFIX "_IO_"
+#define IO_INPUT (IO_PREFIX "input")
+#define IO_OUTPUT (IO_PREFIX "output")
+
+
+typedef luaL_Stream LStream;
+
+
+#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))
+
+#define isclosed(p) ((p)->closef == NULL)
+
+
+static int io_type (lua_State *L) {
+ LStream *p;
+ luaL_checkany(L, 1);
+ p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);
+ if (p == NULL)
+ lua_pushnil(L); /* not a file */
+ else if (isclosed(p))
+ lua_pushliteral(L, "closed file");
+ else
+ lua_pushliteral(L, "file");
+ return 1;
+}
+
+
+static int f_tostring (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (isclosed(p))
+ lua_pushliteral(L, "file (closed)");
+ else
+ lua_pushfstring(L, "file (%p)", p->f);
+ return 1;
+}
+
+
+static FILE *tofile (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (isclosed(p))
+ luaL_error(L, "attempt to use a closed file");
+ lua_assert(p->f);
+ return p->f;
+}
+
+
+/*
+** When creating file handles, always creates a `closed' file handle
+** before opening the actual file; so, if there is a memory error, the
+** file is not left opened.
+*/
+static LStream *newprefile (lua_State *L) {
+ LStream *p = (LStream *)lua_newuserdata(L, sizeof(LStream));
+ p->closef = NULL; /* mark file handle as 'closed' */
+ luaL_setmetatable(L, LUA_FILEHANDLE);
+ return p;
+}
+
+
+static int aux_close (lua_State *L) {
+ LStream *p = tolstream(L);
+ lua_CFunction cf = p->closef;
+ p->closef = NULL; /* mark stream as closed */
+ return (*cf)(L); /* close it */
+}
+
+
+static int io_close (lua_State *L) {
+ if (lua_isnone(L, 1)) /* no argument? */
+ lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use standard output */
+ tofile(L); /* make sure argument is an open stream */
+ return aux_close(L);
+}
+
+
+static int f_gc (lua_State *L) {
+ LStream *p = tolstream(L);
+ if (!isclosed(p) && p->f != NULL)
+ aux_close(L); /* ignore closed and incompletely open files */
+ return 0;
+}
+
+
+/*
+** function to close regular files
+*/
+static int io_fclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ int res = fclose(p->f);
+ return luaL_fileresult(L, (res == 0), NULL);
+}
+
+
+static LStream *newfile (lua_State *L) {
+ LStream *p = newprefile(L);
+ p->f = NULL;
+ p->closef = &io_fclose;
+ return p;
+}
+
+
+static void opencheck (lua_State *L, const char *fname, const char *mode) {
+ LStream *p = newfile(L);
+ p->f = fopen(fname, mode);
+ if (p->f == NULL)
+ luaL_error(L, "cannot open file " LUA_QS " (%s)", fname, strerror(errno));
+}
+
+
+static int io_open (lua_State *L) {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newfile(L);
+ const char *md = mode; /* to traverse/check mode */
+ luaL_argcheck(L, lua_checkmode(md), 2, "invalid mode");
+ p->f = fopen(filename, mode);
+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
+}
+
+
+/*
+** function to close 'popen' files
+*/
+static int io_pclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ return luaL_execresult(L, lua_pclose(L, p->f));
+}
+
+
+static int io_popen (lua_State *L) {
+ const char *filename = luaL_checkstring(L, 1);
+ const char *mode = luaL_optstring(L, 2, "r");
+ LStream *p = newprefile(L);
+ p->f = lua_popen(L, filename, mode);
+ p->closef = &io_pclose;
+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
+}
+
+
+static int io_tmpfile (lua_State *L) {
+ LStream *p = newfile(L);
+ p->f = tmpfile();
+ return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1;
+}
+
+
+static FILE *getiofile (lua_State *L, const char *findex) {
+ LStream *p;
+ lua_getfield(L, LUA_REGISTRYINDEX, findex);
+ p = (LStream *)lua_touserdata(L, -1);
+ if (isclosed(p))
+ luaL_error(L, "standard %s file is closed", findex + strlen(IO_PREFIX));
+ return p->f;
+}
+
+
+static int g_iofile (lua_State *L, const char *f, const char *mode) {
+ if (!lua_isnoneornil(L, 1)) {
+ const char *filename = lua_tostring(L, 1);
+ if (filename)
+ opencheck(L, filename, mode);
+ else {
+ tofile(L); /* check that it's a valid file handle */
+ lua_pushvalue(L, 1);
+ }
+ lua_setfield(L, LUA_REGISTRYINDEX, f);
+ }
+ /* return current value */
+ lua_getfield(L, LUA_REGISTRYINDEX, f);
+ return 1;
+}
+
+
+static int io_input (lua_State *L) {
+ return g_iofile(L, IO_INPUT, "r");
+}
+
+
+static int io_output (lua_State *L) {
+ return g_iofile(L, IO_OUTPUT, "w");
+}
+
+
+static int io_readline (lua_State *L);
+
+
+static void aux_lines (lua_State *L, int toclose) {
+ int i;
+ int n = lua_gettop(L) - 1; /* number of arguments to read */
+ /* ensure that arguments will fit here and into 'io_readline' stack */
+ luaL_argcheck(L, n <= LUA_MINSTACK - 3, LUA_MINSTACK - 3, "too many options");
+ lua_pushvalue(L, 1); /* file handle */
+ lua_pushinteger(L, n); /* number of arguments to read */
+ lua_pushboolean(L, toclose); /* close/not close file when finished */
+ for (i = 1; i <= n; i++) lua_pushvalue(L, i + 1); /* copy arguments */
+ lua_pushcclosure(L, io_readline, 3 + n);
+}
+
+
+static int f_lines (lua_State *L) {
+ tofile(L); /* check that it's a valid file handle */
+ aux_lines(L, 0);
+ return 1;
+}
+
+
+static int io_lines (lua_State *L) {
+ int toclose;
+ if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */
+ if (lua_isnil(L, 1)) { /* no file name? */
+ lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */
+ lua_replace(L, 1); /* put it at index 1 */
+ tofile(L); /* check that it's a valid file handle */
+ toclose = 0; /* do not close it after iteration */
+ }
+ else { /* open a new file */
+ const char *filename = luaL_checkstring(L, 1);
+ opencheck(L, filename, "r");
+ lua_replace(L, 1); /* put file at index 1 */
+ toclose = 1; /* close it after iteration */
+ }
+ aux_lines(L, toclose);
+ return 1;
+}
+
+
+/*
+** {======================================================
+** READ
+** =======================================================
+*/
+
+
+static int read_number (lua_State *L, FILE *f) {
+ lua_Number d;
+ if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) {
+ lua_pushnumber(L, d);
+ return 1;
+ }
+ else {
+ lua_pushnil(L); /* "result" to be removed */
+ return 0; /* read fails */
+ }
+}
+
+
+static int test_eof (lua_State *L, FILE *f) {
+ int c = getc(f);
+ ungetc(c, f);
+ lua_pushlstring(L, NULL, 0);
+ return (c != EOF);
+}
+
+
+static int read_line (lua_State *L, FILE *f, int chop) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ for (;;) {
+ size_t l;
+ char *p = luaL_prepbuffer(&b);
+ if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */
+ luaL_pushresult(&b); /* close buffer */
+ return (lua_rawlen(L, -1) > 0); /* check whether read something */
+ }
+ l = strlen(p);
+ if (l == 0 || p[l-1] != '\n')
+ luaL_addsize(&b, l);
+ else {
+ luaL_addsize(&b, l - chop); /* chop 'eol' if needed */
+ luaL_pushresult(&b); /* close buffer */
+ return 1; /* read at least an `eol' */
+ }
+ }
+}
+
+
+#define MAX_SIZE_T (~(size_t)0)
+
+static void read_all (lua_State *L, FILE *f) {
+ size_t rlen = LUAL_BUFFERSIZE; /* how much to read in each cycle */
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ for (;;) {
+ char *p = luaL_prepbuffsize(&b, rlen);
+ size_t nr = fread(p, sizeof(char), rlen, f);
+ luaL_addsize(&b, nr);
+ if (nr < rlen) break; /* eof? */
+ else if (rlen <= (MAX_SIZE_T / 4)) /* avoid buffers too large */
+ rlen *= 2; /* double buffer size at each iteration */
+ }
+ luaL_pushresult(&b); /* close buffer */
+}
+
+
+static int read_chars (lua_State *L, FILE *f, size_t n) {
+ size_t nr; /* number of chars actually read */
+ char *p;
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */
+ nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */
+ luaL_addsize(&b, nr);
+ luaL_pushresult(&b); /* close buffer */
+ return (nr > 0); /* true iff read something */
+}
+
+
+static int g_read (lua_State *L, FILE *f, int first) {
+ int nargs = lua_gettop(L) - 1;
+ int success;
+ int n;
+ clearerr(f);
+ if (nargs == 0) { /* no arguments? */
+ success = read_line(L, f, 1);
+ n = first+1; /* to return 1 result */
+ }
+ else { /* ensure stack space for all results and for auxlib's buffer */
+ luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
+ success = 1;
+ for (n = first; nargs-- && success; n++) {
+ if (lua_type(L, n) == LUA_TNUMBER) {
+ size_t l = (size_t)lua_tointeger(L, n);
+ success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
+ }
+ else {
+ const char *p = lua_tostring(L, n);
+ luaL_argcheck(L, p && p[0] == '*', n, "invalid option");
+ switch (p[1]) {
+ case 'n': /* number */
+ success = read_number(L, f);
+ break;
+ case 'l': /* line */
+ success = read_line(L, f, 1);
+ break;
+ case 'L': /* line with end-of-line */
+ success = read_line(L, f, 0);
+ break;
+ case 'a': /* file */
+ read_all(L, f); /* read entire file */
+ success = 1; /* always success */
+ break;
+ default:
+ return luaL_argerror(L, n, "invalid format");
+ }
+ }
+ }
+ }
+ if (ferror(f))
+ return luaL_fileresult(L, 0, NULL);
+ if (!success) {
+ lua_pop(L, 1); /* remove last result */
+ lua_pushnil(L); /* push nil instead */
+ }
+ return n - first;
+}
+
+
+static int io_read (lua_State *L) {
+ return g_read(L, getiofile(L, IO_INPUT), 1);
+}
+
+
+static int f_read (lua_State *L) {
+ return g_read(L, tofile(L), 2);
+}
+
+
+static int io_readline (lua_State *L) {
+ LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));
+ int i;
+ int n = (int)lua_tointeger(L, lua_upvalueindex(2));
+ if (isclosed(p)) /* file is already closed? */
+ return luaL_error(L, "file is already closed");
+ lua_settop(L , 1);
+ for (i = 1; i <= n; i++) /* push arguments to 'g_read' */
+ lua_pushvalue(L, lua_upvalueindex(3 + i));
+ n = g_read(L, p->f, 2); /* 'n' is number of results */
+ lua_assert(n > 0); /* should return at least a nil */
+ if (!lua_isnil(L, -n)) /* read at least one value? */
+ return n; /* return them */
+ else { /* first result is nil: EOF or error */
+ if (n > 1) { /* is there error information? */
+ /* 2nd result is error message */
+ return luaL_error(L, "%s", lua_tostring(L, -n + 1));
+ }
+ if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */
+ lua_settop(L, 0);
+ lua_pushvalue(L, lua_upvalueindex(1));
+ aux_close(L); /* close it */
+ }
+ return 0;
+ }
+}
+
+/* }====================================================== */
+
+
+static int g_write (lua_State *L, FILE *f, int arg) {
+ int nargs = lua_gettop(L) - arg;
+ int status = 1;
+ for (; nargs--; arg++) {
+ if (lua_type(L, arg) == LUA_TNUMBER) {
+ /* optimization: could be done exactly as for strings */
+ status = status &&
+ fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0;
+ }
+ else {
+ size_t l;
+ const char *s = luaL_checklstring(L, arg, &l);
+ status = status && (fwrite(s, sizeof(char), l, f) == l);
+ }
+ }
+ if (status) return 1; /* file handle already on stack top */
+ else return luaL_fileresult(L, status, NULL);
+}
+
+
+static int io_write (lua_State *L) {
+ return g_write(L, getiofile(L, IO_OUTPUT), 1);
+}
+
+
+static int f_write (lua_State *L) {
+ FILE *f = tofile(L);
+ lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */
+ return g_write(L, f, 2);
+}
+
+
+static int f_seek (lua_State *L) {
+ static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+ static const char *const modenames[] = {"set", "cur", "end", NULL};
+ FILE *f = tofile(L);
+ int op = luaL_checkoption(L, 2, "cur", modenames);
+ lua_Number p3 = luaL_optnumber(L, 3, 0);
+ l_seeknum offset = (l_seeknum)p3;
+ luaL_argcheck(L, (lua_Number)offset == p3, 3,
+ "not an integer in proper range");
+ op = l_fseek(f, offset, mode[op]);
+ if (op)
+ return luaL_fileresult(L, 0, NULL); /* error */
+ else {
+ lua_pushnumber(L, (lua_Number)l_ftell(f));
+ return 1;
+ }
+}
+
+
+static int f_setvbuf (lua_State *L) {
+ static const int mode[] = {_IONBF, _IOFBF, _IOLBF};
+ static const char *const modenames[] = {"no", "full", "line", NULL};
+ FILE *f = tofile(L);
+ int op = luaL_checkoption(L, 2, NULL, modenames);
+ lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);
+ int res = setvbuf(f, NULL, mode[op], sz);
+ return luaL_fileresult(L, res == 0, NULL);
+}
+
+
+
+static int io_flush (lua_State *L) {
+ return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
+}
+
+
+static int f_flush (lua_State *L) {
+ return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL);
+}
+
+
+/*
+** functions for 'io' library
+*/
+static const luaL_Reg iolib[] = {
+ {"close", io_close},
+ {"flush", io_flush},
+ {"input", io_input},
+ {"lines", io_lines},
+ {"open", io_open},
+ {"output", io_output},
+ {"popen", io_popen},
+ {"read", io_read},
+ {"tmpfile", io_tmpfile},
+ {"type", io_type},
+ {"write", io_write},
+ {NULL, NULL}
+};
+
+
+/*
+** methods for file handles
+*/
+static const luaL_Reg flib[] = {
+ {"close", io_close},
+ {"flush", f_flush},
+ {"lines", f_lines},
+ {"read", f_read},
+ {"seek", f_seek},
+ {"setvbuf", f_setvbuf},
+ {"write", f_write},
+ {"__gc", f_gc},
+ {"__tostring", f_tostring},
+ {NULL, NULL}
+};
+
+
+static void createmeta (lua_State *L) {
+ luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */
+ lua_pushvalue(L, -1); /* push metatable */
+ lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */
+ luaL_setfuncs(L, flib, 0); /* add file methods to new metatable */
+ lua_pop(L, 1); /* pop new metatable */
+}
+
+
+/*
+** function to (not) close the standard files stdin, stdout, and stderr
+*/
+static int io_noclose (lua_State *L) {
+ LStream *p = tolstream(L);
+ p->closef = &io_noclose; /* keep file opened */
+ lua_pushnil(L);
+ lua_pushliteral(L, "cannot close standard file");
+ return 2;
+}
+
+
+static void createstdfile (lua_State *L, FILE *f, const char *k,
+ const char *fname) {
+ LStream *p = newprefile(L);
+ p->f = f;
+ p->closef = &io_noclose;
+ if (k != NULL) {
+ lua_pushvalue(L, -1);
+ lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */
+ }
+ lua_setfield(L, -2, fname); /* add file to module */
+}
+
+
+LUAMOD_API int luaopen_io (lua_State *L) {
+ luaL_newlib(L, iolib); /* new module */
+ createmeta(L);
+ /* create (and set) default files */
+ createstdfile(L, stdin, IO_INPUT, "stdin");
+ createstdfile(L, stdout, IO_OUTPUT, "stdout");
+ createstdfile(L, stderr, NULL, "stderr");
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: llex.c,v 2.63 2013/03/16 21:10:18 roberto Exp $
+** Lexical Analyzer
+** See Copyright Notice in lua.h
+*/
+
+
+#include <locale.h>
+#include <string.h>
+
+#define llex_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lctype.h"
+#include "ldo.h"
+#include "llex.h"
+#include "lobject.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "lzio.h"
+
+
+
+#define next(ls) (ls->current = zgetc(ls->z))
+
+
+
+#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')
+
+
+/* ORDER RESERVED */
+static const char *const luaX_tokens [] = {
+ "and", "break", "do", "else", "elseif",
+ "end", "false", "for", "function", "goto", "if",
+ "in", "local", "nil", "not", "or", "repeat",
+ "return", "then", "true", "until", "while",
+ "..", "...", "==", ">=", "<=", "~=", "::", "<eof>",
+ "<number>", "<name>", "<string>"
+};
+
+
+#define save_and_next(ls) (save(ls, ls->current), next(ls))
+
+
+static l_noret lexerror (LexState *ls, const char *msg, int token);
+
+
+static void save (LexState *ls, int c) {
+ Mbuffer *b = ls->buff;
+ if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) {
+ size_t newsize;
+ if (luaZ_sizebuffer(b) >= MAX_SIZET/2)
+ lexerror(ls, "lexical element too long", 0);
+ newsize = luaZ_sizebuffer(b) * 2;
+ luaZ_resizebuffer(ls->L, b, newsize);
+ }
+ b->buffer[luaZ_bufflen(b)++] = cast(char, c);
+}
+
+
+void luaX_init (lua_State *L) {
+ int i;
+ for (i=0; i<NUM_RESERVED; i++) {
+ TString *ts = luaS_new(L, luaX_tokens[i]);
+ luaS_fix(ts); /* reserved words are never collected */
+ ts->tsv.extra = cast_byte(i+1); /* reserved word */
+ }
+}
+
+
+const char *luaX_token2str (LexState *ls, int token) {
+ if (token < FIRST_RESERVED) { /* single-byte symbols? */
+ lua_assert(token == cast(unsigned char, token));
+ return (lisprint(token)) ? luaO_pushfstring(ls->L, LUA_QL("%c"), token) :
+ luaO_pushfstring(ls->L, "char(%d)", token);
+ }
+ else {
+ const char *s = luaX_tokens[token - FIRST_RESERVED];
+ if (token < TK_EOS) /* fixed format (symbols and reserved words)? */
+ return luaO_pushfstring(ls->L, LUA_QS, s);
+ else /* names, strings, and numerals */
+ return s;
+ }
+}
+
+
+static const char *txtToken (LexState *ls, int token) {
+ switch (token) {
+ case TK_NAME:
+ case TK_STRING:
+ case TK_NUMBER:
+ save(ls, '\0');
+ return luaO_pushfstring(ls->L, LUA_QS, luaZ_buffer(ls->buff));
+ default:
+ return luaX_token2str(ls, token);
+ }
+}
+
+
+static l_noret lexerror (LexState *ls, const char *msg, int token) {
+ char buff[LUA_IDSIZE];
+ luaO_chunkid(buff, getstr(ls->source), LUA_IDSIZE);
+ msg = luaO_pushfstring(ls->L, "%s:%d: %s", buff, ls->linenumber, msg);
+ if (token)
+ luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));
+ luaD_throw(ls->L, LUA_ERRSYNTAX);
+}
+
+
+l_noret luaX_syntaxerror (LexState *ls, const char *msg) {
+ lexerror(ls, msg, ls->t.token);
+}
+
+
+/*
+** creates a new string and anchors it in function's table so that
+** it will not be collected until the end of the function's compilation
+** (by that time it should be anchored in function's prototype)
+*/
+TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
+ lua_State *L = ls->L;
+ TValue *o; /* entry for `str' */
+ TString *ts = luaS_newlstr(L, str, l); /* create new string */
+ setsvalue2s(L, L->top++, ts); /* temporarily anchor it in stack */
+ o = luaH_set(L, ls->fs->h, L->top - 1);
+ if (ttisnil(o)) { /* not in use yet? (see 'addK') */
+ /* boolean value does not need GC barrier;
+ table has no metatable, so it does not need to invalidate cache */
+ setbvalue(o, 1); /* t[string] = true */
+ luaC_checkGC(L);
+ }
+ L->top--; /* remove string from stack */
+ return ts;
+}
+
+
+/*
+** increment line number and skips newline sequence (any of
+** \n, \r, \n\r, or \r\n)
+*/
+static void inclinenumber (LexState *ls) {
+ int old = ls->current;
+ lua_assert(currIsNewline(ls));
+ next(ls); /* skip `\n' or `\r' */
+ if (currIsNewline(ls) && ls->current != old)
+ next(ls); /* skip `\n\r' or `\r\n' */
+ if (++ls->linenumber >= MAX_INT)
+ luaX_syntaxerror(ls, "chunk has too many lines");
+}
+
+
+void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
+ int firstchar) {
+ ls->decpoint = '.';
+ ls->L = L;
+ ls->current = firstchar;
+ ls->lookahead.token = TK_EOS; /* no look-ahead token */
+ ls->z = z;
+ ls->fs = NULL;
+ ls->linenumber = 1;
+ ls->lastline = 1;
+ ls->source = source;
+ ls->envn = luaS_new(L, LUA_ENV); /* create env name */
+ luaS_fix(ls->envn); /* never collect this name */
+ luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
+}
+
+
+
+/*
+** =======================================================
+** LEXICAL ANALYZER
+** =======================================================
+*/
+
+
+
+static int check_next (LexState *ls, const char *set) {
+ if (ls->current == '\0' || !strchr(set, ls->current))
+ return 0;
+ save_and_next(ls);
+ return 1;
+}
+
+
+/*
+** change all characters 'from' in buffer to 'to'
+*/
+static void buffreplace (LexState *ls, char from, char to) {
+ size_t n = luaZ_bufflen(ls->buff);
+ char *p = luaZ_buffer(ls->buff);
+ while (n--)
+ if (p[n] == from) p[n] = to;
+}
+
+
+#if !defined(getlocaledecpoint)
+#define getlocaledecpoint() (localeconv()->decimal_point[0])
+#endif
+
+
+#define buff2d(b,e) luaO_str2d(luaZ_buffer(b), luaZ_bufflen(b) - 1, e)
+
+/*
+** in case of format error, try to change decimal point separator to
+** the one defined in the current locale and check again
+*/
+static void trydecpoint (LexState *ls, SemInfo *seminfo) {
+ char old = ls->decpoint;
+ ls->decpoint = getlocaledecpoint();
+ buffreplace(ls, old, ls->decpoint); /* try new decimal separator */
+ if (!buff2d(ls->buff, &seminfo->r)) {
+ /* format error with correct decimal point: no more options */
+ buffreplace(ls, ls->decpoint, '.'); /* undo change (for error message) */
+ lexerror(ls, "malformed number", TK_NUMBER);
+ }
+}
+
+
+/* LUA_NUMBER */
+/*
+** this function is quite liberal in what it accepts, as 'luaO_str2d'
+** will reject ill-formed numerals.
+*/
+static void read_numeral (LexState *ls, SemInfo *seminfo) {
+ const char *expo = "Ee";
+ int first = ls->current;
+ lua_assert(lisdigit(ls->current));
+ save_and_next(ls);
+ if (first == '0' && check_next(ls, "Xx")) /* hexadecimal? */
+ expo = "Pp";
+ for (;;) {
+ if (check_next(ls, expo)) /* exponent part? */
+ check_next(ls, "+-"); /* optional exponent sign */
+ if (lisxdigit(ls->current) || ls->current == '.')
+ save_and_next(ls);
+ else break;
+ }
+ save(ls, '\0');
+ buffreplace(ls, '.', ls->decpoint); /* follow locale for decimal point */
+ if (!buff2d(ls->buff, &seminfo->r)) /* format error? */
+ trydecpoint(ls, seminfo); /* try to update decimal point separator */
+}
+
+
+/*
+** skip a sequence '[=*[' or ']=*]' and return its number of '='s or
+** -1 if sequence is malformed
+*/
+static int skip_sep (LexState *ls) {
+ int count = 0;
+ int s = ls->current;
+ lua_assert(s == '[' || s == ']');
+ save_and_next(ls);
+ while (ls->current == '=') {
+ save_and_next(ls);
+ count++;
+ }
+ return (ls->current == s) ? count : (-count) - 1;
+}
+
+
+static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) {
+ save_and_next(ls); /* skip 2nd `[' */
+ if (currIsNewline(ls)) /* string starts with a newline? */
+ inclinenumber(ls); /* skip it */
+ for (;;) {
+ switch (ls->current) {
+ case EOZ:
+ lexerror(ls, (seminfo) ? "unfinished long string" :
+ "unfinished long comment", TK_EOS);
+ break; /* to avoid warnings */
+ case ']': {
+ if (skip_sep(ls) == sep) {
+ save_and_next(ls); /* skip 2nd `]' */
+ goto endloop;
+ }
+ break;
+ }
+ case '\n': case '\r': {
+ save(ls, '\n');
+ inclinenumber(ls);
+ if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */
+ break;
+ }
+ default: {
+ if (seminfo) save_and_next(ls);
+ else next(ls);
+ }
+ }
+ } endloop:
+ if (seminfo)
+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep),
+ luaZ_bufflen(ls->buff) - 2*(2 + sep));
+}
+
+
+static void escerror (LexState *ls, int *c, int n, const char *msg) {
+ int i;
+ luaZ_resetbuffer(ls->buff); /* prepare error message */
+ save(ls, '\\');
+ for (i = 0; i < n && c[i] != EOZ; i++)
+ save(ls, c[i]);
+ lexerror(ls, msg, TK_STRING);
+}
+
+
+static int readhexaesc (LexState *ls) {
+ int c[3], i; /* keep input for error message */
+ int r = 0; /* result accumulator */
+ c[0] = 'x'; /* for error message */
+ for (i = 1; i < 3; i++) { /* read two hexadecimal digits */
+ c[i] = next(ls);
+ if (!lisxdigit(c[i]))
+ escerror(ls, c, i + 1, "hexadecimal digit expected");
+ r = (r << 4) + luaO_hexavalue(c[i]);
+ }
+ return r;
+}
+
+
+static int readdecesc (LexState *ls) {
+ int c[3], i;
+ int r = 0; /* result accumulator */
+ for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */
+ c[i] = ls->current;
+ r = 10*r + c[i] - '0';
+ next(ls);
+ }
+ if (r > UCHAR_MAX)
+ escerror(ls, c, i, "decimal escape too large");
+ return r;
+}
+
+
+static void read_string (LexState *ls, int del, SemInfo *seminfo) {
+ save_and_next(ls); /* keep delimiter (for error messages) */
+ while (ls->current != del) {
+ switch (ls->current) {
+ case EOZ:
+ lexerror(ls, "unfinished string", TK_EOS);
+ break; /* to avoid warnings */
+ case '\n':
+ case '\r':
+ lexerror(ls, "unfinished string", TK_STRING);
+ break; /* to avoid warnings */
+ case '\\': { /* escape sequences */
+ int c; /* final character to be saved */
+ next(ls); /* do not save the `\' */
+ switch (ls->current) {
+ case 'a': c = '\a'; goto read_save;
+ case 'b': c = '\b'; goto read_save;
+ case 'f': c = '\f'; goto read_save;
+ case 'n': c = '\n'; goto read_save;
+ case 'r': c = '\r'; goto read_save;
+ case 't': c = '\t'; goto read_save;
+ case 'v': c = '\v'; goto read_save;
+ case 'x': c = readhexaesc(ls); goto read_save;
+ case '\n': case '\r':
+ inclinenumber(ls); c = '\n'; goto only_save;
+ case '\\': case '\"': case '\'':
+ c = ls->current; goto read_save;
+ case EOZ: goto no_save; /* will raise an error next loop */
+ case 'z': { /* zap following span of spaces */
+ next(ls); /* skip the 'z' */
+ while (lisspace(ls->current)) {
+ if (currIsNewline(ls)) inclinenumber(ls);
+ else next(ls);
+ }
+ goto no_save;
+ }
+ default: {
+ if (!lisdigit(ls->current))
+ escerror(ls, &ls->current, 1, "invalid escape sequence");
+ /* digital escape \ddd */
+ c = readdecesc(ls);
+ goto only_save;
+ }
+ }
+ read_save: next(ls); /* read next character */
+ only_save: save(ls, c); /* save 'c' */
+ no_save: break;
+ }
+ default:
+ save_and_next(ls);
+ }
+ }
+ save_and_next(ls); /* skip delimiter */
+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
+ luaZ_bufflen(ls->buff) - 2);
+}
+
+
+static int llex (LexState *ls, SemInfo *seminfo) {
+ luaZ_resetbuffer(ls->buff);
+ for (;;) {
+ switch (ls->current) {
+ case '\n': case '\r': { /* line breaks */
+ inclinenumber(ls);
+ break;
+ }
+ case ' ': case '\f': case '\t': case '\v': { /* spaces */
+ next(ls);
+ break;
+ }
+ case '-': { /* '-' or '--' (comment) */
+ next(ls);
+ if (ls->current != '-') return '-';
+ /* else is a comment */
+ next(ls);
+ if (ls->current == '[') { /* long comment? */
+ int sep = skip_sep(ls);
+ luaZ_resetbuffer(ls->buff); /* `skip_sep' may dirty the buffer */
+ if (sep >= 0) {
+ read_long_string(ls, NULL, sep); /* skip long comment */
+ luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
+ break;
+ }
+ }
+ /* else short comment */
+ while (!currIsNewline(ls) && ls->current != EOZ)
+ next(ls); /* skip until end of line (or end of file) */
+ break;
+ }
+ case '[': { /* long string or simply '[' */
+ int sep = skip_sep(ls);
+ if (sep >= 0) {
+ read_long_string(ls, seminfo, sep);
+ return TK_STRING;
+ }
+ else if (sep == -1) return '[';
+ else lexerror(ls, "invalid long string delimiter", TK_STRING);
+ }
+ case '=': {
+ next(ls);
+ if (ls->current != '=') return '=';
+ else { next(ls); return TK_EQ; }
+ }
+ case '<': {
+ next(ls);
+ if (ls->current != '=') return '<';
+ else { next(ls); return TK_LE; }
+ }
+ case '>': {
+ next(ls);
+ if (ls->current != '=') return '>';
+ else { next(ls); return TK_GE; }
+ }
+ case '~': {
+ next(ls);
+ if (ls->current != '=') return '~';
+ else { next(ls); return TK_NE; }
+ }
+ case ':': {
+ next(ls);
+ if (ls->current != ':') return ':';
+ else { next(ls); return TK_DBCOLON; }
+ }
+ case '"': case '\'': { /* short literal strings */
+ read_string(ls, ls->current, seminfo);
+ return TK_STRING;
+ }
+ case '.': { /* '.', '..', '...', or number */
+ save_and_next(ls);
+ if (check_next(ls, ".")) {
+ if (check_next(ls, "."))
+ return TK_DOTS; /* '...' */
+ else return TK_CONCAT; /* '..' */
+ }
+ else if (!lisdigit(ls->current)) return '.';
+ /* else go through */
+ }
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9': {
+ read_numeral(ls, seminfo);
+ return TK_NUMBER;
+ }
+ case EOZ: {
+ return TK_EOS;
+ }
+ default: {
+ if (lislalpha(ls->current)) { /* identifier or reserved word? */
+ TString *ts;
+ do {
+ save_and_next(ls);
+ } while (lislalnum(ls->current));
+ ts = luaX_newstring(ls, luaZ_buffer(ls->buff),
+ luaZ_bufflen(ls->buff));
+ seminfo->ts = ts;
+ if (isreserved(ts)) /* reserved word? */
+ return ts->tsv.extra - 1 + FIRST_RESERVED;
+ else {
+ return TK_NAME;
+ }
+ }
+ else { /* single-char tokens (+ - / ...) */
+ int c = ls->current;
+ next(ls);
+ return c;
+ }
+ }
+ }
+ }
+}
+
+
+void luaX_next (LexState *ls) {
+ ls->lastline = ls->linenumber;
+ if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
+ ls->t = ls->lookahead; /* use this one */
+ ls->lookahead.token = TK_EOS; /* and discharge it */
+ }
+ else
+ ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */
+}
+
+
+int luaX_lookahead (LexState *ls) {
+ lua_assert(ls->lookahead.token == TK_EOS);
+ ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
+ return ls->lookahead.token;
+}
+
--- /dev/null
+/*
+** $Id: llex.h,v 1.72 2011/11/30 12:43:51 roberto Exp $
+** Lexical Analyzer
+** See Copyright Notice in lua.h
+*/
+
+#ifndef llex_h
+#define llex_h
+
+#include "lobject.h"
+#include "lzio.h"
+
+
+#define FIRST_RESERVED 257
+
+
+
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER RESERVED"
+*/
+enum RESERVED {
+ /* terminal symbols denoted by reserved words */
+ TK_AND = FIRST_RESERVED, TK_BREAK,
+ TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
+ TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
+ TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
+ /* other terminal symbols */
+ TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_DBCOLON, TK_EOS,
+ TK_NUMBER, TK_NAME, TK_STRING
+};
+
+/* number of reserved words */
+#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1))
+
+
+typedef union {
+ lua_Number r;
+ TString *ts;
+} SemInfo; /* semantics information */
+
+
+typedef struct Token {
+ int token;
+ SemInfo seminfo;
+} Token;
+
+
+/* state of the lexer plus state of the parser when shared by all
+ functions */
+typedef struct LexState {
+ int current; /* current character (charint) */
+ int linenumber; /* input line counter */
+ int lastline; /* line of last token `consumed' */
+ Token t; /* current token */
+ Token lookahead; /* look ahead token */
+ struct FuncState *fs; /* current function (parser) */
+ struct lua_State *L;
+ ZIO *z; /* input stream */
+ Mbuffer *buff; /* buffer for tokens */
+ struct Dyndata *dyd; /* dynamic structures used by the parser */
+ TString *source; /* current source name */
+ TString *envn; /* environment variable name */
+ char decpoint; /* locale decimal point */
+} LexState;
+
+
+LUAI_FUNC void luaX_init (lua_State *L);
+LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
+ TString *source, int firstchar);
+LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
+LUAI_FUNC void luaX_next (LexState *ls);
+LUAI_FUNC int luaX_lookahead (LexState *ls);
+LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);
+LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
+
+
+#endif
--- /dev/null
+/*
+** $Id: llimits.h,v 1.103 2013/02/20 14:08:56 roberto Exp $
+** Limits, basic types, and some other `installation-dependent' definitions
+** See Copyright Notice in lua.h
+*/
+
+#ifndef llimits_h
+#define llimits_h
+
+
+#include <limits.h>
+#include <stddef.h>
+
+
+#include "lua.h"
+
+
+typedef unsigned LUA_INT32 lu_int32;
+
+typedef LUAI_UMEM lu_mem;
+
+typedef LUAI_MEM l_mem;
+
+
+
+/* chars used as small naturals (so that `char' is reserved for characters) */
+typedef unsigned char lu_byte;
+
+
+#define MAX_SIZET ((size_t)(~(size_t)0)-2)
+
+#define MAX_LUMEM ((lu_mem)(~(lu_mem)0)-2)
+
+#define MAX_LMEM ((l_mem) ((MAX_LUMEM >> 1) - 2))
+
+
+#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
+
+/*
+** conversion of pointer to integer
+** this is for hashing only; there is no problem if the integer
+** cannot hold the whole pointer value
+*/
+#define IntPoint(p) ((unsigned int)(lu_mem)(p))
+
+
+
+/* type to ensure maximum alignment */
+#if !defined(LUAI_USER_ALIGNMENT_T)
+#define LUAI_USER_ALIGNMENT_T union { double u; void *s; long l; }
+#endif
+
+typedef LUAI_USER_ALIGNMENT_T L_Umaxalign;
+
+
+/* result of a `usual argument conversion' over lua_Number */
+typedef LUAI_UACNUMBER l_uacNumber;
+
+
+/* internal assertions for in-house debugging */
+#if defined(lua_assert)
+#define check_exp(c,e) (lua_assert(c), (e))
+/* to avoid problems with conditions too long */
+#define lua_longassert(c) { if (!(c)) lua_assert(0); }
+#else
+#define lua_assert(c) ((void)0)
+#define check_exp(c,e) (e)
+#define lua_longassert(c) ((void)0)
+#endif
+
+/*
+** assertion for checking API calls
+*/
+#if !defined(luai_apicheck)
+
+#if defined(LUA_USE_APICHECK)
+#include <assert.h>
+#define luai_apicheck(L,e) assert(e)
+#else
+#define luai_apicheck(L,e) lua_assert(e)
+#endif
+
+#endif
+
+#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)
+
+
+#if !defined(UNUSED)
+#define UNUSED(x) ((void)(x)) /* to avoid warnings */
+#endif
+
+
+#define cast(t, exp) ((t)(exp))
+
+#define cast_byte(i) cast(lu_byte, (i))
+#define cast_num(i) cast(lua_Number, (i))
+#define cast_int(i) cast(int, (i))
+#define cast_uchar(i) cast(unsigned char, (i))
+
+
+/*
+** non-return type
+*/
+#if defined(__GNUC__)
+#define l_noret void __attribute__((noreturn))
+#elif defined(_MSC_VER)
+#define l_noret void __declspec(noreturn)
+#else
+#define l_noret void
+#endif
+
+
+
+/*
+** maximum depth for nested C calls and syntactical nested non-terminals
+** in a program. (Value must fit in an unsigned short int.)
+*/
+#if !defined(LUAI_MAXCCALLS)
+#define LUAI_MAXCCALLS 200
+#endif
+
+/*
+** maximum number of upvalues in a closure (both C and Lua). (Value
+** must fit in an unsigned char.)
+*/
+#define MAXUPVAL UCHAR_MAX
+
+
+/*
+** type for virtual-machine instructions
+** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
+*/
+typedef lu_int32 Instruction;
+
+
+
+/* maximum stack for a Lua function */
+#define MAXSTACK 250
+
+
+
+/* minimum size for the string table (must be power of 2) */
+#if !defined(MINSTRTABSIZE)
+#define MINSTRTABSIZE 32
+#endif
+
+
+/* minimum size for string buffer */
+#if !defined(LUA_MINBUFFER)
+#define LUA_MINBUFFER 32
+#endif
+
+
+#if !defined(lua_lock)
+#define lua_lock(L) ((void) 0)
+#define lua_unlock(L) ((void) 0)
+#endif
+
+#if !defined(luai_threadyield)
+#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}
+#endif
+
+
+/*
+** these macros allow user-specific actions on threads when you defined
+** LUAI_EXTRASPACE and need to do something extra when a thread is
+** created/deleted/resumed/yielded.
+*/
+#if !defined(luai_userstateopen)
+#define luai_userstateopen(L) ((void)L)
+#endif
+
+#if !defined(luai_userstateclose)
+#define luai_userstateclose(L) ((void)L)
+#endif
+
+#if !defined(luai_userstatethread)
+#define luai_userstatethread(L,L1) ((void)L)
+#endif
+
+#if !defined(luai_userstatefree)
+#define luai_userstatefree(L,L1) ((void)L)
+#endif
+
+#if !defined(luai_userstateresume)
+#define luai_userstateresume(L,n) ((void)L)
+#endif
+
+#if !defined(luai_userstateyield)
+#define luai_userstateyield(L,n) ((void)L)
+#endif
+
+/*
+** lua_number2int is a macro to convert lua_Number to int.
+** lua_number2integer is a macro to convert lua_Number to lua_Integer.
+** lua_number2unsigned is a macro to convert a lua_Number to a lua_Unsigned.
+** lua_unsigned2number is a macro to convert a lua_Unsigned to a lua_Number.
+** luai_hashnum is a macro to hash a lua_Number value into an integer.
+** The hash must be deterministic and give reasonable values for
+** both small and large values (outside the range of integers).
+*/
+
+#if defined(MS_ASMTRICK) || defined(LUA_MSASMTRICK) /* { */
+/* trick with Microsoft assembler for X86 */
+
+#define lua_number2int(i,n) __asm {__asm fld n __asm fistp i}
+#define lua_number2integer(i,n) lua_number2int(i, n)
+#define lua_number2unsigned(i,n) \
+ {__int64 l; __asm {__asm fld n __asm fistp l} i = (unsigned int)l;}
+
+
+#elif defined(LUA_IEEE754TRICK) /* }{ */
+/* the next trick should work on any machine using IEEE754 with
+ a 32-bit int type */
+
+union luai_Cast { double l_d; LUA_INT32 l_p[2]; };
+
+#if !defined(LUA_IEEEENDIAN) /* { */
+#define LUAI_EXTRAIEEE \
+ static const union luai_Cast ieeeendian = {-(33.0 + 6755399441055744.0)};
+#define LUA_IEEEENDIANLOC (ieeeendian.l_p[1] == 33)
+#else
+#define LUA_IEEEENDIANLOC LUA_IEEEENDIAN
+#define LUAI_EXTRAIEEE /* empty */
+#endif /* } */
+
+#define lua_number2int32(i,n,t) \
+ { LUAI_EXTRAIEEE \
+ volatile union luai_Cast u; u.l_d = (n) + 6755399441055744.0; \
+ (i) = (t)u.l_p[LUA_IEEEENDIANLOC]; }
+
+#define luai_hashnum(i,n) \
+ { volatile union luai_Cast u; u.l_d = (n) + 1.0; /* avoid -0 */ \
+ (i) = u.l_p[0]; (i) += u.l_p[1]; } /* add double bits for his hash */
+
+#define lua_number2int(i,n) lua_number2int32(i, n, int)
+#define lua_number2unsigned(i,n) lua_number2int32(i, n, lua_Unsigned)
+
+/* the trick can be expanded to lua_Integer when it is a 32-bit value */
+#if defined(LUA_IEEELL)
+#define lua_number2integer(i,n) lua_number2int32(i, n, lua_Integer)
+#endif
+
+#endif /* } */
+
+
+/* the following definitions always work, but may be slow */
+
+#if !defined(lua_number2int)
+#define lua_number2int(i,n) ((i)=(int)(n))
+#endif
+
+#if !defined(lua_number2integer)
+#define lua_number2integer(i,n) ((i)=(lua_Integer)(n))
+#endif
+
+#if !defined(lua_number2unsigned) /* { */
+/* the following definition assures proper modulo behavior */
+#if defined(LUA_NUMBER_DOUBLE) || defined(LUA_NUMBER_FLOAT)
+#include <math.h>
+#define SUPUNSIGNED ((lua_Number)(~(lua_Unsigned)0) + 1)
+#define lua_number2unsigned(i,n) \
+ ((i)=(lua_Unsigned)((n) - floor((n)/SUPUNSIGNED)*SUPUNSIGNED))
+#else
+#define lua_number2unsigned(i,n) ((i)=(lua_Unsigned)(n))
+#endif
+#endif /* } */
+
+
+#if !defined(lua_unsigned2number)
+/* on several machines, coercion from unsigned to double is slow,
+ so it may be worth to avoid */
+#define lua_unsigned2number(u) \
+ (((u) <= (lua_Unsigned)INT_MAX) ? (lua_Number)(int)(u) : (lua_Number)(u))
+#endif
+
+
+
+#if defined(ltable_c) && !defined(luai_hashnum)
+
+#include <float.h>
+#include <math.h>
+
+#define luai_hashnum(i,n) { int e; \
+ n = l_mathop(frexp)(n, &e) * (lua_Number)(INT_MAX - DBL_MAX_EXP); \
+ lua_number2int(i, n); i += e; }
+
+#endif
+
+
+
+/*
+** macro to control inclusion of some hard tests on stack reallocation
+*/
+#if !defined(HARDSTACKTESTS)
+#define condmovestack(L) ((void)0)
+#else
+/* realloc stack keeping its size */
+#define condmovestack(L) luaD_reallocstack((L), (L)->stacksize)
+#endif
+
+#if !defined(HARDMEMTESTS)
+#define condchangemem(L) condmovestack(L)
+#else
+#define condchangemem(L) \
+ ((void)(!(G(L)->gcrunning) || (luaC_fullgc(L, 0), 1)))
+#endif
+
+#endif
--- /dev/null
+/*
+** $Id: lmathlib.c,v 1.83 2013/03/07 18:21:32 roberto Exp $
+** Standard mathematical library
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+#include <math.h>
+
+#define lmathlib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+#undef PI
+#define PI ((lua_Number)(3.1415926535897932384626433832795))
+#define RADIANS_PER_DEGREE ((lua_Number)(PI/180.0))
+
+
+
+static int math_abs (lua_State *L) {
+ lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_sin (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_sinh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_cos (lua_State *L) {
+ lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_cosh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_tan (lua_State *L) {
+ lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_tanh (lua_State *L) {
+ lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_asin (lua_State *L) {
+ lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_acos (lua_State *L) {
+ lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_atan (lua_State *L) {
+ lua_pushnumber(L, l_mathop(atan)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_atan2 (lua_State *L) {
+ lua_pushnumber(L, l_mathop(atan2)(luaL_checknumber(L, 1),
+ luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int math_ceil (lua_State *L) {
+ lua_pushnumber(L, l_mathop(ceil)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_floor (lua_State *L) {
+ lua_pushnumber(L, l_mathop(floor)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_fmod (lua_State *L) {
+ lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1),
+ luaL_checknumber(L, 2)));
+ return 1;
+}
+
+static int math_modf (lua_State *L) {
+ lua_Number ip;
+ lua_Number fp = l_mathop(modf)(luaL_checknumber(L, 1), &ip);
+ lua_pushnumber(L, ip);
+ lua_pushnumber(L, fp);
+ return 2;
+}
+
+static int math_sqrt (lua_State *L) {
+ lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_pow (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ lua_Number y = luaL_checknumber(L, 2);
+ lua_pushnumber(L, l_mathop(pow)(x, y));
+ return 1;
+}
+
+static int math_log (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ lua_Number res;
+ if (lua_isnoneornil(L, 2))
+ res = l_mathop(log)(x);
+ else {
+ lua_Number base = luaL_checknumber(L, 2);
+ if (base == (lua_Number)10.0) res = l_mathop(log10)(x);
+ else res = l_mathop(log)(x)/l_mathop(log)(base);
+ }
+ lua_pushnumber(L, res);
+ return 1;
+}
+
+#if defined(LUA_COMPAT_LOG10)
+static int math_log10 (lua_State *L) {
+ lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));
+ return 1;
+}
+#endif
+
+static int math_exp (lua_State *L) {
+ lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));
+ return 1;
+}
+
+static int math_deg (lua_State *L) {
+ lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE);
+ return 1;
+}
+
+static int math_rad (lua_State *L) {
+ lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE);
+ return 1;
+}
+
+static int math_frexp (lua_State *L) {
+ int e;
+ lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e));
+ lua_pushinteger(L, e);
+ return 2;
+}
+
+static int math_ldexp (lua_State *L) {
+ lua_Number x = luaL_checknumber(L, 1);
+ int ep = luaL_checkint(L, 2);
+ lua_pushnumber(L, l_mathop(ldexp)(x, ep));
+ return 1;
+}
+
+
+
+static int math_min (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ lua_Number dmin = luaL_checknumber(L, 1);
+ int i;
+ for (i=2; i<=n; i++) {
+ lua_Number d = luaL_checknumber(L, i);
+ if (d < dmin)
+ dmin = d;
+ }
+ lua_pushnumber(L, dmin);
+ return 1;
+}
+
+
+static int math_max (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ lua_Number dmax = luaL_checknumber(L, 1);
+ int i;
+ for (i=2; i<=n; i++) {
+ lua_Number d = luaL_checknumber(L, i);
+ if (d > dmax)
+ dmax = d;
+ }
+ lua_pushnumber(L, dmax);
+ return 1;
+}
+
+
+static int math_random (lua_State *L) {
+ /* the `%' avoids the (rare) case of r==1, and is needed also because on
+ some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */
+ lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX;
+ switch (lua_gettop(L)) { /* check number of arguments */
+ case 0: { /* no arguments */
+ lua_pushnumber(L, r); /* Number between 0 and 1 */
+ break;
+ }
+ case 1: { /* only upper limit */
+ lua_Number u = luaL_checknumber(L, 1);
+ luaL_argcheck(L, (lua_Number)1.0 <= u, 1, "interval is empty");
+ lua_pushnumber(L, l_mathop(floor)(r*u) + (lua_Number)(1.0)); /* [1, u] */
+ break;
+ }
+ case 2: { /* lower and upper limits */
+ lua_Number l = luaL_checknumber(L, 1);
+ lua_Number u = luaL_checknumber(L, 2);
+ luaL_argcheck(L, l <= u, 2, "interval is empty");
+ lua_pushnumber(L, l_mathop(floor)(r*(u-l+1)) + l); /* [l, u] */
+ break;
+ }
+ default: return luaL_error(L, "wrong number of arguments");
+ }
+ return 1;
+}
+
+
+static int math_randomseed (lua_State *L) {
+ srand(luaL_checkunsigned(L, 1));
+ (void)rand(); /* discard first value to avoid undesirable correlations */
+ return 0;
+}
+
+
+static const luaL_Reg mathlib[] = {
+ {"abs", math_abs},
+ {"acos", math_acos},
+ {"asin", math_asin},
+ {"atan2", math_atan2},
+ {"atan", math_atan},
+ {"ceil", math_ceil},
+ {"cosh", math_cosh},
+ {"cos", math_cos},
+ {"deg", math_deg},
+ {"exp", math_exp},
+ {"floor", math_floor},
+ {"fmod", math_fmod},
+ {"frexp", math_frexp},
+ {"ldexp", math_ldexp},
+#if defined(LUA_COMPAT_LOG10)
+ {"log10", math_log10},
+#endif
+ {"log", math_log},
+ {"max", math_max},
+ {"min", math_min},
+ {"modf", math_modf},
+ {"pow", math_pow},
+ {"rad", math_rad},
+ {"random", math_random},
+ {"randomseed", math_randomseed},
+ {"sinh", math_sinh},
+ {"sin", math_sin},
+ {"sqrt", math_sqrt},
+ {"tanh", math_tanh},
+ {"tan", math_tan},
+ {NULL, NULL}
+};
+
+
+/*
+** Open math library
+*/
+LUAMOD_API int luaopen_math (lua_State *L) {
+ luaL_newlib(L, mathlib);
+ lua_pushnumber(L, PI);
+ lua_setfield(L, -2, "pi");
+ lua_pushnumber(L, HUGE_VAL);
+ lua_setfield(L, -2, "huge");
+ return 1;
+}
+
--- /dev/null
+/*
+** $Id: lmem.c,v 1.84 2012/05/23 15:41:53 roberto Exp $
+** Interface to Memory Manager
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stddef.h>
+
+#define lmem_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "ldebug.h"
+#include "ldo.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+
+
+
+/*
+** About the realloc function:
+** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
+** (`osize' is the old size, `nsize' is the new size)
+**
+** * frealloc(ud, NULL, x, s) creates a new block of size `s' (no
+** matter 'x').
+**
+** * frealloc(ud, p, x, 0) frees the block `p'
+** (in this specific case, frealloc must return NULL);
+** particularly, frealloc(ud, NULL, 0, 0) does nothing
+** (which is equivalent to free(NULL) in ANSI C)
+**
+** frealloc returns NULL if it cannot create or reallocate the area
+** (any reallocation to an equal or smaller size cannot fail!)
+*/
+
+
+
+#define MINSIZEARRAY 4
+
+
+void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,
+ int limit, const char *what) {
+ void *newblock;
+ int newsize;
+ if (*size >= limit/2) { /* cannot double it? */
+ if (*size >= limit) /* cannot grow even a little? */
+ luaG_runerror(L, "too many %s (limit is %d)", what, limit);
+ newsize = limit; /* still have at least one free place */
+ }
+ else {
+ newsize = (*size)*2;
+ if (newsize < MINSIZEARRAY)
+ newsize = MINSIZEARRAY; /* minimum size */
+ }
+ newblock = luaM_reallocv(L, block, *size, newsize, size_elems);
+ *size = newsize; /* update only when everything else is OK */
+ return newblock;
+}
+
+
+l_noret luaM_toobig (lua_State *L) {
+ luaG_runerror(L, "memory allocation error: block too big");
+}
+
+
+
+/*
+** generic allocation routine.
+*/
+void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
+ void *newblock;
+ global_State *g = G(L);
+ size_t realosize = (block) ? osize : 0;
+ lua_assert((realosize == 0) == (block == NULL));
+#if defined(HARDMEMTESTS)
+ if (nsize > realosize && g->gcrunning)
+ luaC_fullgc(L, 1); /* force a GC whenever possible */
+#endif
+ newblock = (*g->frealloc)(g->ud, block, osize, nsize);
+ if (newblock == NULL && nsize > 0) {
+ api_check(L, nsize > realosize,
+ "realloc cannot fail when shrinking a block");
+ if (g->gcrunning) {
+ luaC_fullgc(L, 1); /* try to free some memory... */
+ newblock = (*g->frealloc)(g->ud, block, osize, nsize); /* try again */
+ }
+ if (newblock == NULL)
+ luaD_throw(L, LUA_ERRMEM);
+ }
+ lua_assert((nsize == 0) == (newblock == NULL));
+ g->GCdebt = (g->GCdebt + nsize) - realosize;
+ return newblock;
+}
+
--- /dev/null
+/*
+** $Id: lmem.h,v 1.40 2013/02/20 14:08:21 roberto 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"
+
+
+/*
+** This macro avoids the runtime division MAX_SIZET/(e), as 'e' is
+** always constant.
+** The macro is somewhat complex to avoid warnings:
+** +1 avoids warnings of "comparison has constant result";
+** cast to 'void' avoids warnings of "value unused".
+*/
+#define luaM_reallocv(L,b,on,n,e) \
+ (cast(void, \
+ (cast(size_t, (n)+1) > MAX_SIZET/(e)) ? (luaM_toobig(L), 0) : 0), \
+ luaM_realloc_(L, (b), (on)*(e), (n)*(e)))
+
+#define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0)
+#define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0)
+#define luaM_freearray(L, b, n) luaM_reallocv(L, (b), n, 0, sizeof((b)[0]))
+
+#define luaM_malloc(L,s) luaM_realloc_(L, NULL, 0, (s))
+#define luaM_new(L,t) cast(t *, luaM_malloc(L, sizeof(t)))
+#define luaM_newvector(L,n,t) \
+ cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t)))
+
+#define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s))
+
+#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_reallocv(L, v, oldn, n, sizeof(t))))
+
+LUAI_FUNC l_noret luaM_toobig (lua_State *L);
+
+/* not to be called directly */
+LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
+ size_t size);
+LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size,
+ size_t size_elem, int limit,
+ const char *what);
+
+#endif
+
--- /dev/null
+/*
+** $Id: loadlib.c,v 1.111 2012/05/30 12:33:44 roberto Exp $
+** Dynamic library loader for Lua
+** See Copyright Notice in lua.h
+**
+** This module contains an implementation of loadlib for Unix systems
+** that have dlfcn, an implementation for Windows, and a stub for other
+** systems.
+*/
+
+
+/*
+** if needed, includes windows header before everything else
+*/
+#if defined(_WIN32)
+#include <windows.h>
+#endif
+
+
+#include <stdlib.h>
+#include <string.h>
+
+
+#define loadlib_c
+#define LUA_LIB
+
+#include "lua.h"
+
+#include "lauxlib.h"
+#include "lualib.h"
+
+
+/*
+** LUA_PATH and LUA_CPATH are the names of the environment
+** variables that Lua check to set its paths.
+*/
+#if !defined(LUA_PATH)
+#define LUA_PATH "LUA_PATH"
+#endif
+
+#if !defined(LUA_CPATH)
+#define LUA_CPATH "LUA_CPATH"
+#endif
+
+#define LUA_PATHSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
+
+#define LUA_PATHVERSION LUA_PATH LUA_PATHSUFFIX
+#define LUA_CPATHVERSION LUA_CPATH LUA_PATHSUFFIX
+
+/*
+** LUA_PATH_SEP is the character that separates templates in a path.
+** LUA_PATH_MARK is the string that marks the substitution points in a
+** template.
+** LUA_EXEC_DIR in a Windows path is replaced by the executable's
+** directory.
+** LUA_IGMARK is a mark to ignore all before it when building the
+** luaopen_ function name.
+*/
+#if !defined (LUA_PATH_SEP)
+#define LUA_PATH_SEP ";"
+#endif
+#if !defined (LUA_PATH_MARK)
+#define LUA_PATH_MARK "?"
+#endif
+#if !defined (LUA_EXEC_DIR)
+#define LUA_EXEC_DIR "!"
+#endif
+#if !defined (LUA_IGMARK)
+#define LUA_IGMARK "-"
+#endif
+
+
+/*
+** LUA_CSUBSEP is the character that replaces dots in submodule names
+** when searching for a C loader.
+** LUA_LSUBSEP is the character that replaces dots in submodule names
+** when searching for a Lua loader.
+*/
+#if !defined(LUA_CSUBSEP)
+#define LUA_CSUBSEP LUA_DIRSEP
+#endif
+
+#if !defined(LUA_LSUBSEP)
+#define LUA_LSUBSEP LUA_DIRSEP
+#endif
+
+
+/* prefix for open functions in C libraries */
+#define LUA_POF "luaopen_"
+
+/* separator for open functions in C libraries */
+#define LUA_OFSEP "_"
+
+
+/* table (in the registry) that keeps handles for all loaded C libraries */
+#define CLIBS "_CLIBS"
+
+#define LIB_FAIL "open"
+
+
+/* error codes for ll_loadfunc */
+#define ERRLIB 1
+#define ERRFUNC 2
+
+#define setprogdir(L) ((void)0)
+
+
+/*
+** system-dependent functions
+*/
+static void ll_unloadlib (void *lib);
+static void *ll_load (lua_State *L, const char *path, int seeglb);
+static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym);
+
+
+
+#if defined(LUA_USE_DLOPEN)
+/*
+** {========================================================================
+** This is an implementation of loadlib based on the dlfcn interface.
+** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
+** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
+** as an emulation layer on top of native functions.
+** =========================================================================
+*/
+
+#include <dlfcn.h>
+
+static void ll_unloadlib (void *lib) {
+ dlclose(lib);
+}
+
+
+static void *ll_load (lua_State *L, const char *path, int seeglb) {
+ void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
+ if (lib == NULL) lua_pushstring(L, dlerror());
+ return lib;
+}
+
+
+static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
+ lua_CFunction f = (lua_CFunction)dlsym(lib, sym);
+ if (f == NULL) lua_pushstring(L, dlerror());
+ return f;
+}
+
+/* }====================================================== */
+
+
+
+#elif defined(LUA_DL_DLL)
+/*
+** {======================================================================
+** This is an implementation of loadlib for Windows using native functions.
+** =======================================================================
+*/
+
+#undef setprogdir
+
+/*
+** optional flags for LoadLibraryEx
+*/
+#if !defined(LUA_LLE_FLAGS)
+#define LUA_LLE_FLAGS 0
+#endif
+
+
+static void setprogdir (lua_State *L) {
+ char buff[MAX_PATH + 1];
+ char *lb;
+ DWORD nsize = sizeof(buff)/sizeof(char);
+ DWORD n = GetModuleFileNameA(NULL, buff, nsize);
+ if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
+ luaL_error(L, "unable to get ModuleFileName");
+ else {
+ *lb = '\0';
+ luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
+ lua_remove(L, -2); /* remove original string */
+ }
+}
+
+
+static void pusherror (lua_State *L) {
+ int error = GetLastError();
+ char buffer[128];
+ if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
+ lua_pushstring(L, buffer);
+ else
+ lua_pushfstring(L, "system error %d\n", error);
+}
+
+static void ll_unloadlib (void *lib) {
+ FreeLibrary((HMODULE)lib);
+}
+
+
+static void *ll_load (lua_State *L, const char *path, int seeglb) {
+ HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
+ (void)(seeglb); /* not used: symbols are 'global' by default */
+ if (lib == NULL) pusherror(L);
+ return lib;
+}
+
+
+static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
+ lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym);
+ if (f == NULL) pusherror(L);
+ return f;
+}
+
+/* }====================================================== */
+
+
+#else
+/*
+** {======================================================
+** Fallback for other systems
+** =======================================================
+*/
+
+#undef LIB_FAIL
+#define LIB_FAIL "absent"
+
+
+#define DLMSG "dynamic libraries not enabled; check your Lua installation"
+
+
+static void ll_unloadlib (void *lib) {
+ (void)(lib); /* not used */
+}
+
+
+static void *ll_load (lua_State *L, const char *path, int seeglb) {
+ (void)(path); (void)(seeglb); /* not used */
+ lua_pushliteral(L, DLMSG);
+ return NULL;
+}
+
+
+static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
+ (void)(lib); (void)(sym); /* not used */
+ lua_pushliteral(L, DLMSG);
+ return NULL;
+}
+
+/* }====================================================== */
+#endif
+
+
+static void *ll_checkclib (lua_State *L, const char *path) {
+ void *plib;
+ lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
+ lua_getfield(L, -1, path);
+ plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */
+ lua_pop(L, 2); /* pop CLIBS table and 'plib' */
+ return plib;
+}
+
+
+static void ll_addtoclib (lua_State *L, const char *path, void *plib) {
+ lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
+ lua_pushlightuserdata(L, plib);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -3, path); /* CLIBS[path] = plib */
+ lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */
+ lua_pop(L, 1); /* pop CLIBS table */
+}
+
+
+/*
+** __gc tag method for CLIBS table: calls 'll_unloadlib' for all lib
+** handles in list CLIBS
+*/
+static int gctm (lua_State *L) {
+ int n = luaL_len(L, 1);
+ for (; n >= 1; n--) { /* for each handle, in reverse order */
+ lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */
+ ll_unloadlib(lua_touserdata(L, -1));
+ lua_pop(L, 1); /* pop handle */
+ }
+ return 0;
+}
+
+
+static int ll_loadfunc (lua_State *L, const char *path, const char *sym) {
+ void *reg = ll_checkclib(L, path); /* check loaded C libraries */
+ if (reg == NULL) { /* must load library? */
+ reg = ll_load(L, path, *sym == '*');
+ if (reg == NULL) return ERRLIB; /* unable to load library */
+ ll_addtoclib(L, path, reg);
+ }
+ if (*sym == '*') { /* loading only library (no function)? */
+ lua_pushboolean(L, 1); /* return 'true' */
+ return 0; /* no errors */
+ }
+ else {
+ lua_CFunction f = ll_sym(L, reg, sym);
+ if (f == NULL)
+ return ERRFUNC; /* unable to find function */
+ lua_pushcfunction(L, f); /* else create new function */
+ return 0; /* no errors */
+ }
+}
+
+
+static int ll_loadlib (lua_State *L) {
+ const char *path = luaL_checkstring(L, 1);
+ const char *init = luaL_checkstring(L, 2);
+ int stat = ll_loadfunc(L, path, init);
+ if (stat == 0) /* no errors? */
+ return 1; /* return the loaded function */
+ else { /* error; error message is on stack top */
+ lua_pushnil(L);
+ lua_insert(L, -2);
+ lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
+ return 3; /* return nil, error message, and where */
+ }
+}
+
+
+
+/*
+** {======================================================
+** 'require' function
+** =======================================================
+*/
+
+
+static int readable (const char *filename) {
+ FILE *f = fopen(filename, "r"); /* try to open file */
+ if (f == NULL) return 0; /* open failed */
+ fclose(f);
+ return 1;
+}
+
+
+static const char *pushnexttemplate (lua_State *L, const char *path) {
+ const char *l;
+ while (*path == *LUA_PATH_SEP) path++; /* skip separators */
+ if (*path == '\0') return NULL; /* no more templates */
+ l = strchr(path, *LUA_PATH_SEP); /* find next separator */
+ if (l == NULL) l = path + strlen(path);
+ lua_pushlstring(L, path, l - path); /* template */
+ return l;
+}
+
+
+static const char *searchpath (lua_State *L, const char *name,
+ const char *path,
+ const char *sep,
+ const char *dirsep) {
+ luaL_Buffer msg; /* to build error message */
+ luaL_buffinit(L, &msg);
+ if (*sep != '\0') /* non-empty separator? */
+ name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */
+ while ((path = pushnexttemplate(L, path)) != NULL) {
+ const char *filename = luaL_gsub(L, lua_tostring(L, -1),
+ LUA_PATH_MARK, name);
+ lua_remove(L, -2); /* remove path template */
+ if (readable(filename)) /* does file exist and is readable? */
+ return filename; /* return that file name */
+ lua_pushfstring(L, "\n\tno file " LUA_QS, filename);
+ lua_remove(L, -2); /* remove file name */
+ luaL_addvalue(&msg); /* concatenate error msg. entry */
+ }
+ luaL_pushresult(&msg); /* create error message */
+ return NULL; /* not found */
+}
+
+
+static int ll_searchpath (lua_State *L) {
+ const char *f = searchpath(L, luaL_checkstring(L, 1),
+ luaL_checkstring(L, 2),
+ luaL_optstring(L, 3, "."),
+ luaL_optstring(L, 4, LUA_DIRSEP));
+ if (f != NULL) return 1;
+ else { /* error message is on top of the stack */
+ lua_pushnil(L);
+ lua_insert(L, -2);
+ return 2; /* return nil + error message */
+ }
+}
+
+
+static const char *findfile (lua_State *L, const char *name,
+ const char *pname,
+ const char *dirsep) {
+ const char *path;
+ lua_getfield(L, lua_upvalueindex(1), pname);
+ path = lua_tostring(L, -1);
+ if (path == NULL)
+ luaL_error(L, LUA_QL("package.%s") " must be a string", pname);
+ return searchpath(L, name, path, ".", dirsep);
+}
+
+
+static int checkload (lua_State *L, int stat, const char *filename) {
+ if (stat) { /* module loaded successfully? */
+ lua_pushstring(L, filename); /* will be 2nd argument to module */
+ return 2; /* return open function and file name */
+ }
+ else
+ return luaL_error(L, "error loading module " LUA_QS
+ " from file " LUA_QS ":\n\t%s",
+ lua_tostring(L, 1), filename, lua_tostring(L, -1));
+}
+
+
+static int searcher_Lua (lua_State *L) {
+ const char *filename;
+ const char *name = luaL_checkstring(L, 1);
+ filename = findfile(L, name, "path", LUA_LSUBSEP);
+ if (filename == NULL) return 1; /* module not found in this path */
+ return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
+}
+
+
+static int loadfunc (lua_State *L, const char *filename, const char *modname) {
+ const char *funcname;
+ const char *mark;
+ modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
+ mark = strchr(modname, *LUA_IGMARK);
+ if (mark) {
+ int stat;
+ funcname = lua_pushlstring(L, modname, mark - modname);
+ funcname = lua_pushfstring(L, LUA_POF"%s", funcname);
+ stat = ll_loadfunc(L, filename, funcname);
+ if (stat != ERRFUNC) return stat;
+ modname = mark + 1; /* else go ahead and try old-style name */
+ }
+ funcname = lua_pushfstring(L, LUA_POF"%s", modname);
+ return ll_loadfunc(L, filename, funcname);
+}
+
+
+static int searcher_C (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
+ if (filename == NULL) return 1; /* module not found in this path */
+ return checkload(L, (loadfunc(L, filename, name) == 0), filename);
+}
+
+
+static int searcher_Croot (lua_State *L) {
+ const char *filename;
+ const char *name = luaL_checkstring(L, 1);
+ const char *p = strchr(name, '.');
+ int stat;
+ if (p == NULL) return 0; /* is root */
+ lua_pushlstring(L, name, p - name);
+ filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
+ if (filename == NULL) return 1; /* root not found */
+ if ((stat = loadfunc(L, filename, name)) != 0) {
+ if (stat != ERRFUNC)
+ return checkload(L, 0, filename); /* real error */
+ else { /* open function not found */
+ lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS,
+ name, filename);
+ return 1;
+ }
+ }
+ lua_pushstring(L, filename); /* will be 2nd argument to module */
+ return 2;
+}
+
+
+static int searcher_preload (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ lua_getfield(L, LUA_REGISTRYINDEX, "_PRELOAD");
+ lua_getfield(L, -1, name);
+ if (lua_isnil(L, -1)) /* not found? */
+ lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
+ return 1;
+}
+
+
+static void findloader (lua_State *L, const char *name) {
+ int i;
+ luaL_Buffer msg; /* to build error message */
+ luaL_buffinit(L, &msg);
+ lua_getfield(L, lua_upvalueindex(1), "searchers"); /* will be at index 3 */
+ if (!lua_istable(L, 3))
+ luaL_error(L, LUA_QL("package.searchers") " must be a table");
+ /* iterate over available searchers to find a loader */
+ for (i = 1; ; i++) {
+ lua_rawgeti(L, 3, i); /* get a searcher */
+ if (lua_isnil(L, -1)) { /* no more searchers? */
+ lua_pop(L, 1); /* remove nil */
+ luaL_pushresult(&msg); /* create error message */
+ luaL_error(L, "module " LUA_QS " not found:%s",
+ name, lua_tostring(L, -1));
+ }
+ lua_pushstring(L, name);
+ lua_call(L, 1, 2); /* call it */
+ if (lua_isfunction(L, -2)) /* did it find a loader? */
+ return; /* module loader found */
+ else if (lua_isstring(L, -2)) { /* searcher returned error message? */
+ lua_pop(L, 1); /* remove extra return */
+ luaL_addvalue(&msg); /* concatenate error message */
+ }
+ else
+ lua_pop(L, 2); /* remove both returns */
+ }
+}
+
+
+static int ll_require (lua_State *L) {
+ const char *name = luaL_checkstring(L, 1);
+ lua_settop(L, 1); /* _LOADED table will be at index 2 */
+ lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
+ lua_getfield(L, 2, name); /* _LOADED[name] */
+ if (lua_toboolean(L, -1)) /* is it there? */
+ return 1; /* package is already loaded */
+ /* else must load package */
+ lua_pop(L, 1); /* remove 'getfield' result */
+ findloader(L, name);
+ lua_pushstring(L, name); /* pass name as argument to module loader */
+ lua_insert(L, -2); /* name is 1st argument (before search data) */
+ lua_call(L, 2, 1); /* run loader to load module */
+ if (!lua_isnil(L, -1)) /* non-nil return? */
+ lua_setfield(L, 2, name); /* _LOADED[name] = returned value */
+ lua_getfield(L, 2, name);
+ if (lua_isnil(L, -1)) { /* module did not set a value? */
+ lua_pushboolean(L, 1); /* use true as result */
+ lua_pushvalue(L, -1); /* extra copy to be returned */
+ lua_setfield(L, 2, name); /* _LOADED[name] = true */
+ }
+ return 1;
+}
+
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** 'module' function
+** =======================================================
+*/
+#if defined(LUA_COMPAT_MODULE)
+
+/*
+** changes the environment variable of calling function
+*/
+static void set_env (lua_State *L) {
+ lua_Debug ar;
+ if (lua_getstack(L, 1, &ar) == 0 ||
+ lua_getinfo(L, "f", &ar) == 0 || /* get calling function */
+ lua_iscfunction(L, -1))
+ luaL_error(L, LUA_QL("module") " not called from a Lua function");
+ lua_pushvalue(L, -2); /* copy new environment table to top */
+ lua_setupvalue(L, -2, 1);
+ lua_pop(L, 1); /* remove function */
+}
+
+
+static void dooptions (lua_State *L, int n) {
+ int i;
+ for (i = 2; i <= n; i++) {
+ if (lua_isfunction(L, i)) { /* avoid 'calling' extra info. */
+ lua_pushvalue(L, i); /* get option (a function) */
+ lua_pushvalue(L, -2); /* module */
+ lua_call(L, 1, 0);
+ }
+ }
+}
+
+
+static void modinit (lua_State *L, const char *modname) {
+ const char *dot;
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -2, "_M"); /* module._M = module */
+ lua_pushstring(L, modname);
+ lua_setfield(L, -2, "_NAME");
+ dot = strrchr(modname, '.'); /* look for last dot in module name */
+ if (dot == NULL) dot = modname;
+ else dot++;
+ /* set _PACKAGE as package name (full module name minus last part) */
+ lua_pushlstring(L, modname, dot - modname);
+ lua_setfield(L, -2, "_PACKAGE");
+}
+
+
+static int ll_module (lua_State *L) {
+ const char *modname = luaL_checkstring(L, 1);
+ int lastarg = lua_gettop(L); /* last parameter */
+ luaL_pushmodule(L, modname, 1); /* get/create module table */
+ /* check whether table already has a _NAME field */
+ lua_getfield(L, -1, "_NAME");
+ if (!lua_isnil(L, -1)) /* is table an initialized module? */
+ lua_pop(L, 1);
+ else { /* no; initialize it */
+ lua_pop(L, 1);
+ modinit(L, modname);
+ }
+ lua_pushvalue(L, -1);
+ set_env(L);
+ dooptions(L, lastarg);
+ return 1;
+}
+
+
+static int ll_seeall (lua_State *L) {
+ luaL_checktype(L, 1, LUA_TTABLE);
+ if (!lua_getmetatable(L, 1)) {
+ lua_createtable(L, 0, 1); /* create new metatable */
+ lua_pushvalue(L, -1);
+ lua_setmetatable(L, 1);
+ }
+ lua_pushglobaltable(L);
+ lua_setfield(L, -2, "__index"); /* mt.__index = _G */
+ return 0;
+}
+
+#endif
+/* }====================================================== */
+
+
+
+/* auxiliary mark (for internal use) */
+#define AUXMARK "\1"
+
+
+/*
+** return registry.LUA_NOENV as a boolean
+*/
+static int noenv (lua_State *L) {
+ int b;
+ lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
+ b = lua_toboolean(L, -1);
+ lua_pop(L, 1); /* remove value */
+ return b;
+}
+
+
+static void setpath (lua_State *L, const char *fieldname, const char *envname1,
+ const char *envname2, const char *def) {
+ const char *path = getenv(envname1);
+ if (path == NULL) /* no environment variable? */
+ path = getenv(envname2); /* try alternative name */
+ if (path == NULL || noenv(L)) /* no environment variable? */
+ lua_pushstring(L, def); /* use default */
+ else {
+ /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */
+ path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP,
+ LUA_PATH_SEP AUXMARK LUA_PATH_SEP);
+ luaL_gsub(L, path, AUXMARK, def);
+ lua_remove(L, -2);
+ }
+ setprogdir(L);
+ lua_setfield(L, -2, fieldname);
+}
+
+
+static const luaL_Reg pk_funcs[] = {
+ {"loadlib", ll_loadlib},
+ {"searchpath", ll_searchpath},
+#if defined(LUA_COMPAT_MODULE)
+ {"seeall", ll_seeall},
+#endif
+ {NULL, NULL}
+};
+
+
+static const luaL_Reg ll_funcs[] = {
+#if defined(LUA_COMPAT_MODULE)
+ {"module", ll_module},
+#endif
+ {"require", ll_require},
+ {NULL, NULL}
+};
+
+
+static void createsearcherstable (lua_State *L) {
+ static const lua_CFunction searchers[] =
+ {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};
+ int i;
+ /* create 'searchers' table */
+ lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
+ /* fill it with pre-defined searchers */
+ for (i=0; searchers[i] != NULL; i++) {
+ lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */
+ lua_pushcclosure(L, searchers[i], 1);
+ lua_rawseti(L, -2, i+1);
+ }
+}
+
+
+LUAMOD_API int luaopen_package (lua_State *L) {
+ /* create table CLIBS to keep track of loaded C libraries */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS);
+ lua_createtable(L, 0, 1); /* metatable for CLIBS */
+ lua_pushcfunction(L, gctm);
+ lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */
+ lua_setmetatable(L, -2);
+ /* create `package' table */
+ luaL_newlib(L, pk_funcs);
+ createsearcherstable(L);
+#if defined(LUA_COMPAT_LOADERS)
+ lua_pushvalue(L, -1); /* make a copy of 'searchers' table */
+ lua_setfield(L, -3, "loaders"); /* put it in field `loaders' */
+#endif
+ lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */
+ /* set field 'path' */
+ setpath(L, "path", LUA_PATHVERSION, LUA_PATH, LUA_PATH_DEFAULT);
+ /* set field 'cpath' */
+ setpath(L, "cpath", LUA_CPATHVERSION, LUA_CPATH, LUA_CPATH_DEFAULT);
+ /* store config information */
+ lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
+ LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
+ lua_setfield(L, -2, "config");
+ /* set field `loaded' */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED");
+ lua_setfield(L, -2, "loaded");
+ /* set field `preload' */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD");
+ lua_setfield(L, -2, "preload");
+ lua_pushglobaltable(L);
+ lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */
+ luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */
+ lua_pop(L, 1); /* pop global table */
+ return 1; /* return 'package' table */
+}
+
--- /dev/null
+/*
+** $Id: lobject.c,v 2.58 2013/02/20 14:08:56 roberto Exp $
+** Some generic functions over Lua objects
+** See Copyright Notice in lua.h
+*/
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define lobject_c
+#define LUA_CORE
+
+#include "lua.h"
+
+#include "lctype.h"
+#include "ldebug.h"
+#include "ldo.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "lvm.h"
+
+
+
+LUAI_DDEF const TValue luaO_nilobject_ = {NILCONSTANT};
+
+
+/*
+** converts an integer to a "floating point byte", represented as
+** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if
+** eeeee != 0 and (xxx) otherwise.
+*/
+int luaO_int2fb (unsigned int x) {
+ int e = 0; /* exponent */
+ if (x < 8) return x;
+ while (x >= 0x10) {
+ x = (x+1) >> 1;
+ e++;
+ }
+ return ((e+1) << 3) | (cast_int(x) - 8);
+}
+
+
+/* converts back */
+int luaO_fb2int (int x) {
+ int e = (x >> 3) & 0x1f;
+ if (e == 0) return x;
+ else return ((x & 7) + 8) << (e - 1);
+}
+
+
+int luaO_ceillog2 (unsigned int x) {
+ static const lu_byte log_2[256] = {
+ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
+ 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+ 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
+ };
+ int l = 0;
+ x--;
+ while (x >= 256) { l += 8; x >>= 8; }
+ return l + log_2[x];
+}
+
+
+lua_Number luaO_arith (int op, lua_Number v1, lua_Number v2) {
+ switch (op) {
+ case LUA_OPADD: return luai_numadd(NULL, v1, v2);
+ case LUA_OPSUB: return luai_numsub(NULL, v1, v2);
+ case LUA_OPMUL: return luai_nummul(NULL, v1, v2);
+ case LUA_OPDIV: return luai_numdiv(NULL, v1, v2);
+ case LUA_OPMOD: return luai_nummod(NULL, v1, v2);
+ case LUA_OPPOW: return luai_numpow(NULL, v1, v2);
+ case LUA_OPUNM: return luai_numunm(NULL, v1);
+ default: lua_assert(0); return 0;
+ }
+}
+
+
+int luaO_hexavalue (int c) {
+ if (lisdigit(c)) return c - '0';
+ else return ltolower(c) - 'a' + 10;
+}
+
+
+#if !defined(lua_strx2number)
+
+#include <math.h>
+
+
+static int isneg (const char **s) {
+ if (**s == '-') { (*s)++; return 1; }
+ else if (**s == '+') (*s)++;
+ return 0;
+}
+
+
+static lua_Number readhexa (const char **s, lua_Number r, int *count) {
+ for (; lisxdigit(cast_uchar(**s)); (*s)++) { /* read integer part */
+ r = (r * cast_num(16.0)) + cast_num(luaO_hexavalue(cast_uchar(**s)));
+ (*count)++;
+ }
+ return r;
+}
+
+
+/*
+** convert an hexadecimal numeric string to a number, following
+** C99 specification for 'strtod'
+*/
+static lua_Number lua_strx2number (const char *s, char **endptr) {
+ lua_Number r = 0.0;
+ int e = 0, i = 0;
+ int neg = 0; /* 1 if number is negative */
+ *endptr = cast(char *, s); /* nothing is valid yet */
+ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
+ neg = isneg(&s); /* check signal */
+ if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */
+ return 0.0; /* invalid format (no '0x') */
+ s += 2; /* skip '0x' */
+ r = readhexa(&s, r, &i); /* read integer part */
+ if (*s == '.') {
+ s++; /* skip dot */
+ r = readhexa(&s, r, &e); /* read fractional part */
+ }
+ if (i == 0 && e == 0)
+ return 0.0; /* invalid format (no digit) */
+ e *= -4; /* each fractional digit divides value by 2^-4 */
+ *endptr = cast(char *, s); /* valid up to here */
+ if (*s == 'p' || *s == 'P') { /* exponent part? */
+ int exp1 = 0;
+ int neg1;
+ s++; /* skip 'p' */
+ neg1 = isneg(&s); /* signal */
+ if (!lisdigit(cast_uchar(*s)))
+ goto ret; /* must have at least one digit */
+ while (lisdigit(cast_uchar(*s))) /* read exponent */
+ exp1 = exp1 * 10 + *(s++) - '0';
+ if (neg1) exp1 = -exp1;
+ e += exp1;
+ }
+ *endptr = cast(char *, s); /* valid up to here */
+ ret:
+ if (neg) r = -r;
+ return l_mathop(ldexp)(r, e);
+}
+
+#endif
+
+
+int luaO_str2d (const char *s, size_t len, lua_Number *result) {
+ char *endptr;
+ if (strpbrk(s, "nN")) /* reject 'inf' and 'nan' */
+ return 0;
+ else if (strpbrk(s, "xX")) /* hexa? */
+ *result = lua_strx2number(s, &endptr);
+ else
+ *result = lua_str2number(s, &endptr);
+ if (endptr == s) return 0; /* nothing recognized */
+ while (lisspace(cast_uchar(*endptr))) endptr++;
+ return (endptr == s + len); /* OK if no trailing characters */
+}
+
+
+
+static void pushstr (lua_State *L, const char *str, size_t l) {
+ setsvalue2s(L, L->top++, luaS_newlstr(L, str, l));
+}
+
+
+/* this function handles only `%d', `%c', %f, %p, and `%s' formats */
+const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
+ int n = 0;
+ for (;;) {
+ const char *e = strchr(fmt, '%');
+ if (e == NULL) break;
+ luaD_checkstack(L, 2); /* fmt + item */
+ pushstr(L, fmt, e - fmt);
+ switch (*(e+1)) {
+ case 's': {
+ const char *s = va_arg(argp, char *);
+ if (s == NULL) s = "(null)";
+ pushstr(L, s, strlen(s));
+ break;
+ }
+ case 'c': {
+ char buff;
+ buff = cast(char, va_arg(argp, int));
+ pushstr(L, &buff, 1);
+ break;
+ }
+ case 'd': {
+ setnvalue(L->top++, cast_num(va_arg(argp, int)));
+ break;
+ }
+ case 'f': {
+ setnvalue(L->top++, cast_num(va_arg(argp, l_uacNumber)));
+ break;
+ }
+ case 'p': {
+ char buff[4*sizeof(void *) + 8]; /* should be enough space for a `%p' */
+ int l = sprintf(buff, "%p", va_arg(argp, void *));
+ pushstr(L, buff, l);
+ break;
+ }
+ case '%': {
+ pushstr(L, "%", 1);
+ break;
+ }
+ default: {
+ luaG_runerror(L,
+ "invalid option " LUA_QL("%%%c") " to " LUA_QL("lua_pushfstring"),
+ *(e + 1));
+ }
+ }
+ n += 2;
+ fmt = e+2;
+ }
+ luaD_checkstack(L, 1);
+ pushstr(L, fmt, strlen(fmt));
+ if (n > 0) luaV_concat(L, n + 1);
+ return svalue(L->top - 1);
+}
+
+
+const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
+ const char *msg;
+ va_list argp;
+ va_start(argp, fmt);
+ msg = luaO_pushvfstring(L, fmt, argp);
+ va_end(argp);
+ return msg;
+}
+
+
+/* number of chars of a literal string without the ending \0 */
+#define LL(x) (sizeof(x)/sizeof(char) - 1)
+
+#define RETS "..."
+#define PRE "[string \""
+#define POS "\"]"
+
+#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )
+
+void luaO_chunkid (char *out, const char *source, size_t bufflen) {
+ size_t l = strlen(source);
+ if (*source == '=') { /* 'literal' source */
+ if (l <= bufflen) /* small enough? */
+ memcpy(out, source + 1, l * sizeof(char));
+ else { /* truncate it */
+ addstr(out, source + 1, bufflen - 1);
+ *out = '\0';
+ }
+ }
+ else if (*source == '@') { /* file name */
+ if (l <= bufflen) /* small enough? */
+ memcpy(out, source + 1, l * sizeof(char));
+ else { /* add '...' before rest of name */
+ addstr(out, RETS, LL(RETS));
+ bufflen -= LL(RETS);
+ memcpy(out, source + 1 + l - bufflen, bufflen * sizeof(char));
+ }
+ }
+ else { /* string; format as [string "source"] */
+ const char *nl = strchr(source, '\n'); /* find first new line (if any) */
+ addstr(out, PRE, LL(PRE)); /* add prefix */
+ bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */
+ if (l < bufflen && nl == NULL) { /* small one-line source? */
+ addstr(out, source, l); /* keep it */
+ }
+ else {
+ if (nl != NULL) l = nl - source; /* stop at first newline */
+ if (l > bufflen) l = bufflen;
+ addstr(out, source, l);
+ addstr(out, RETS, LL(RETS));
+ }
+ memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
+ }
+}
+
--- /dev/null
+/*
+** $Id: lobject.h,v 2.71 2012/09/11 18:21:44 roberto Exp $
+** Type definitions for Lua objects
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lobject_h
+#define lobject_h
+
+
+#include <stdarg.h>
+
+
+#include "llimits.h"
+#include "lua.h"
+
+
+/*
+** Extra tags for non-values
+*/
+#define LUA_TPROTO LUA_NUMTAGS
+#define LUA_TUPVAL (LUA_NUMTAGS+1)
+#define LUA_TDEADKEY (LUA_NUMTAGS+2)
+
+/*
+** number of all possible tags (including LUA_TNONE but excluding DEADKEY)
+*/
+#define LUA_TOTALTAGS (LUA_TUPVAL+2)
+
+
+/*
+** tags for Tagged Values have the following use of bits:
+** bits 0-3: actual tag (a LUA_T* value)
+** bits 4-5: variant bits
+** bit 6: whether value is collectable
+*/
+
+#define VARBITS (3 << 4)
+
+
+/*
+** LUA_TFUNCTION variants:
+** 0 - Lua function
+** 1 - light C function
+** 2 - regular C function (closure)
+*/
+
+/* Variant tags for functions */
+#define LUA_TLCL (LUA_TFUNCTION | (0 << 4)) /* Lua closure */
+#define LUA_TLCF (LUA_TFUNCTION | (1 << 4)) /* light C function */
+#define LUA_TCCL (LUA_TFUNCTION | (2 << 4)) /* C closure */
+
+
+/* Variant tags for strings */
+#define LUA_TSHRSTR (LUA_TSTRING | (0 << 4)) /* short strings */
+#define LUA_TLNGSTR (LUA_TSTRING | (1 << 4)) /* long strings */
+
+
+/* Bit mark for collectable types */
+#define BIT_ISCOLLECTABLE (1 << 6)
+
+/* mark a tag as collectable */
+#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
+
+
+/*
+** 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 Value Value;
+
+
+#define numfield lua_Number n; /* numbers */
+
+
+
+/*
+** Tagged Values. This is the basic representation of values in Lua,
+** an actual value plus a tag with its type.
+*/
+
+#define TValuefields Value value_; int tt_
+
+typedef struct lua_TValue TValue;
+
+
+/* macro defining a nil value */
+#define NILCONSTANT {NULL}, LUA_TNIL
+
+
+#define val_(o) ((o)->value_)
+#define num_(o) (val_(o).n)
+
+
+/* raw type tag of a TValue */
+#define rttype(o) ((o)->tt_)
+
+/* tag with no variants (bits 0-3) */
+#define novariant(x) ((x) & 0x0F)
+
+/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */
+#define ttype(o) (rttype(o) & 0x3F)
+
+/* type tag of a TValue with no variants (bits 0-3) */
+#define ttypenv(o) (novariant(rttype(o)))
+
+
+/* Macros to test type */
+#define checktag(o,t) (rttype(o) == (t))
+#define checktype(o,t) (ttypenv(o) == (t))
+#define ttisnumber(o) checktag((o), LUA_TNUMBER)
+#define ttisnil(o) checktag((o), LUA_TNIL)
+#define ttisboolean(o) checktag((o), LUA_TBOOLEAN)
+#define ttislightuserdata(o) checktag((o), LUA_TLIGHTUSERDATA)
+#define ttisstring(o) checktype((o), LUA_TSTRING)
+#define ttisshrstring(o) checktag((o), ctb(LUA_TSHRSTR))
+#define ttislngstring(o) checktag((o), ctb(LUA_TLNGSTR))
+#define ttistable(o) checktag((o), ctb(LUA_TTABLE))
+#define ttisfunction(o) checktype(o, LUA_TFUNCTION)
+#define ttisclosure(o) ((rttype(o) & 0x1F) == LUA_TFUNCTION)
+#define ttisCclosure(o) checktag((o), ctb(LUA_TCCL))
+#define ttisLclosure(o) checktag((o), ctb(LUA_TLCL))
+#define ttislcf(o) checktag((o), LUA_TLCF)
+#define ttisuserdata(o) checktag((o), ctb(LUA_TUSERDATA))
+#define ttisthread(o) checktag((o), ctb(LUA_TTHREAD))
+#define ttisdeadkey(o) checktag((o), LUA_TDEADKEY)
+
+#define ttisequal(o1,o2) (rttype(o1) == rttype(o2))
+
+/* Macros to access values */
+#define nvalue(o) check_exp(ttisnumber(o), num_(o))
+#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
+#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
+#define rawtsvalue(o) check_exp(ttisstring(o), &val_(o).gc->ts)
+#define tsvalue(o) (&rawtsvalue(o)->tsv)
+#define rawuvalue(o) check_exp(ttisuserdata(o), &val_(o).gc->u)
+#define uvalue(o) (&rawuvalue(o)->uv)
+#define clvalue(o) check_exp(ttisclosure(o), &val_(o).gc->cl)
+#define clLvalue(o) check_exp(ttisLclosure(o), &val_(o).gc->cl.l)
+#define clCvalue(o) check_exp(ttisCclosure(o), &val_(o).gc->cl.c)
+#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
+#define hvalue(o) check_exp(ttistable(o), &val_(o).gc->h)
+#define bvalue(o) check_exp(ttisboolean(o), val_(o).b)
+#define thvalue(o) check_exp(ttisthread(o), &val_(o).gc->th)
+/* a dead value may get the 'gc' field, but cannot access its contents */
+#define deadvalue(o) check_exp(ttisdeadkey(o), cast(void *, val_(o).gc))
+
+#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
+
+
+#define iscollectable(o) (rttype(o) & BIT_ISCOLLECTABLE)
+
+
+/* Macros for internal tests */
+#define righttt(obj) (ttype(obj) == gcvalue(obj)->gch.tt)
+
+#define checkliveness(g,obj) \
+ lua_longassert(!iscollectable(obj) || \
+ (righttt(obj) && !isdead(g,gcvalue(obj))))
+
+
+/* Macros to set values */
+#define settt_(o,t) ((o)->tt_=(t))
+
+#define setnvalue(obj,x) \
+ { TValue *io=(obj); num_(io)=(x); settt_(io, LUA_TNUMBER); }
+
+#define setnilvalue(obj) settt_(obj, LUA_TNIL)
+
+#define setfvalue(obj,x) \
+ { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_TLCF); }
+
+#define setpvalue(obj,x) \
+ { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_TLIGHTUSERDATA); }
+
+#define setbvalue(obj,x) \
+ { TValue *io=(obj); val_(io).b=(x); settt_(io, LUA_TBOOLEAN); }
+
+#define setgcovalue(L,obj,x) \
+ { TValue *io=(obj); GCObject *i_g=(x); \
+ val_(io).gc=i_g; settt_(io, ctb(gch(i_g)->tt)); }
+
+#define setsvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ TString *x_ = (x); \
+ val_(io).gc=cast(GCObject *, x_); settt_(io, ctb(x_->tsv.tt)); \
+ checkliveness(G(L),io); }
+
+#define setuvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TUSERDATA)); \
+ checkliveness(G(L),io); }
+
+#define setthvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TTHREAD)); \
+ checkliveness(G(L),io); }
+
+#define setclLvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TLCL)); \
+ checkliveness(G(L),io); }
+
+#define setclCvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TCCL)); \
+ checkliveness(G(L),io); }
+
+#define sethvalue(L,obj,x) \
+ { TValue *io=(obj); \
+ val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TTABLE)); \
+ checkliveness(G(L),io); }
+
+#define setdeadvalue(obj) settt_(obj, LUA_TDEADKEY)
+
+
+
+#define setobj(L,obj1,obj2) \
+ { const TValue *io2=(obj2); TValue *io1=(obj1); \
+ io1->value_ = io2->value_; io1->tt_ = io2->tt_; \
+ checkliveness(G(L),io1); }
+
+
+/*
+** different types of assignments, according to destination
+*/
+
+/* from stack to (same) stack */
+#define setobjs2s setobj
+/* to stack (not from same stack) */
+#define setobj2s setobj
+#define setsvalue2s setsvalue
+#define sethvalue2s sethvalue
+#define setptvalue2s setptvalue
+/* from table to same table */
+#define setobjt2t setobj
+/* to table */
+#define setobj2t setobj
+/* to new object */
+#define setobj2n setobj
+#define setsvalue2n setsvalue
+
+
+/* check whether a number is valid (useful only for NaN trick) */
+#define luai_checknum(L,o,c) { /* empty */ }
+
+
+/*
+** {======================================================
+** NaN Trick
+** =======================================================
+*/
+#if defined(LUA_NANTRICK)
+
+/*
+** numbers are represented in the 'd_' field. All other values have the
+** value (NNMARK | tag) in 'tt__'. A number with such pattern would be
+** a "signaled NaN", which is never generated by regular operations by
+** the CPU (nor by 'strtod')
+*/
+
+/* allows for external implementation for part of the trick */
+#if !defined(NNMARK) /* { */
+
+
+#if !defined(LUA_IEEEENDIAN)
+#error option 'LUA_NANTRICK' needs 'LUA_IEEEENDIAN'
+#endif
+
+
+#define NNMARK 0x7FF7A500
+#define NNMASK 0x7FFFFF00
+
+#undef TValuefields
+#undef NILCONSTANT
+
+#if (LUA_IEEEENDIAN == 0) /* { */
+
+/* little endian */
+#define TValuefields \
+ union { struct { Value v__; int tt__; } i; double d__; } u
+#define NILCONSTANT {{{NULL}, tag2tt(LUA_TNIL)}}
+/* field-access macros */
+#define v_(o) ((o)->u.i.v__)
+#define d_(o) ((o)->u.d__)
+#define tt_(o) ((o)->u.i.tt__)
+
+#else /* }{ */
+
+/* big endian */
+#define TValuefields \
+ union { struct { int tt__; Value v__; } i; double d__; } u
+#define NILCONSTANT {{tag2tt(LUA_TNIL), {NULL}}}
+/* field-access macros */
+#define v_(o) ((o)->u.i.v__)
+#define d_(o) ((o)->u.d__)
+#define tt_(o) ((o)->u.i.tt__)
+
+#endif /* } */
+
+#endif /* } */
+
+
+/* correspondence with standard representation */
+#undef val_
+#define val_(o) v_(o)
+#undef num_
+#define num_(o) d_(o)
+
+
+#undef numfield
+#define numfield /* no such field; numbers are the entire struct */
+
+/* basic check to distinguish numbers from non-numbers */
+#undef ttisnumber
+#define ttisnumber(o) ((tt_(o) & NNMASK) != NNMARK)
+
+#define tag2tt(t) (NNMARK | (t))
+
+#undef rttype
+#define rttype(o) (ttisnumber(o) ? LUA_TNUMBER : tt_(o) & 0xff)
+
+#undef settt_
+#define settt_(o,t) (tt_(o) = tag2tt(t))
+
+#undef setnvalue
+#define setnvalue(obj,x) \
+ { TValue *io_=(obj); num_(io_)=(x); lua_assert(ttisnumber(io_)); }
+
+#undef setobj
+#define setobj(L,obj1,obj2) \
+ { const TValue *o2_=(obj2); TValue *o1_=(obj1); \
+ o1_->u = o2_->u; \
+ checkliveness(G(L),o1_); }
+
+
+/*
+** these redefinitions are not mandatory, but these forms are more efficient
+*/
+
+#undef checktag
+#undef checktype
+#define checktag(o,t) (tt_(o) == tag2tt(t))
+#define checktype(o,t) (ctb(tt_(o) | VARBITS) == ctb(tag2tt(t) | VARBITS))
+
+#undef ttisequal
+#define ttisequal(o1,o2) \
+ (ttisnumber(o1) ? ttisnumber(o2) : (tt_(o1) == tt_(o2)))
+
+
+#undef luai_checknum
+#define luai_checknum(L,o,c) { if (!ttisnumber(o)) c; }
+
+#endif
+/* }====================================================== */
+
+
+
+/*
+** {======================================================
+** types and prototypes
+** =======================================================
+*/
+
+
+union Value {
+ GCObject *gc; /* collectable&
projects / proxmark3-svn / commitdiff