Upgrade to lua 5.4.0.
Test: treehugger
Change-Id: I14a181b5f9633b6d59b2d3f891aa97aa67a1cd21
diff --git a/src/Makefile b/src/Makefile
index 64c78f7..514593d 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -4,16 +4,17 @@
# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
# Your platform. See PLATS for possible values.
-PLAT= none
+PLAT= guess
CC= gcc -std=gnu99
-CFLAGS= -O2 -Wall -Wextra -DLUA_COMPAT_5_2 $(SYSCFLAGS) $(MYCFLAGS)
+CFLAGS= -O2 -Wall -Wextra -DLUA_COMPAT_5_3 $(SYSCFLAGS) $(MYCFLAGS)
LDFLAGS= $(SYSLDFLAGS) $(MYLDFLAGS)
LIBS= -lm $(SYSLIBS) $(MYLIBS)
AR= ar rcu
RANLIB= ranlib
RM= rm -f
+UNAME= uname
SYSCFLAGS=
SYSLDFLAGS=
@@ -24,16 +25,16 @@
MYLIBS=
MYOBJS=
+# Special flags for compiler modules; -Os reduces code size.
+CMCFLAGS= -Os
+
# == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE =======
-PLATS= aix bsd c89 freebsd generic linux macosx mingw posix solaris
+PLATS= guess aix bsd c89 freebsd generic linux linux-readline 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 lutf8lib.o loadlib.o linit.o
+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 lcorolib.o ldblib.o liolib.o lmathlib.o loadlib.o loslib.o lstrlib.o ltablib.o lutf8lib.o linit.o
BASE_O= $(CORE_O) $(LIB_O) $(MYOBJS)
LUA_T= lua
@@ -65,6 +66,9 @@
$(LUAC_T): $(LUAC_O) $(LUA_A)
$(CC) -o $@ $(LDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS)
+test:
+ ./lua -v
+
clean:
$(RM) $(ALL_T) $(ALL_O)
@@ -80,15 +84,21 @@
@echo "AR= $(AR)"
@echo "RANLIB= $(RANLIB)"
@echo "RM= $(RM)"
+ @echo "UNAME= $(UNAME)"
-# Convenience targets for popular platforms
+# Convenience targets for popular platforms.
ALL= all
-none:
- @echo "Please do 'make PLATFORM' where PLATFORM is one of these:"
+help:
+ @echo "Do 'make PLATFORM' where PLATFORM is one of these:"
@echo " $(PLATS)"
+ @echo "See doc/readme.html for complete instructions."
-aix:
+guess:
+ @echo Guessing `$(UNAME)`
+ @$(MAKE) `$(UNAME)`
+
+AIX aix:
$(MAKE) $(ALL) CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl" SYSLDFLAGS="-brtl -bexpall"
bsd:
@@ -100,20 +110,24 @@
@echo '*** C89 does not guarantee 64-bit integers for Lua.'
@echo ''
-
-freebsd:
+FreeBSD NetBSD OpenBSD freebsd:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE -I/usr/include/edit" SYSLIBS="-Wl,-E -ledit" CC="cc"
generic: $(ALL)
-linux:
- $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl -lreadline"
+Linux linux: linux-noreadline
-macosx:
- $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX" SYSLIBS="-lreadline"
+linux-noreadline:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl"
+
+linux-readline:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE" SYSLIBS="-Wl,-E -ldl -lreadline"
+
+Darwin macos macosx:
+ $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX -DLUA_USE_READLINE" SYSLIBS="-lreadline"
mingw:
- $(MAKE) "LUA_A=lua53.dll" "LUA_T=lua.exe" \
+ $(MAKE) "LUA_A=lua54.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
@@ -121,11 +135,21 @@
posix:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX"
-solaris:
+SunOS solaris:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN -D_REENTRANT" 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
+# Targets that do not create files (not all makes understand .PHONY).
+.PHONY: all $(PLATS) help test clean default o a depend echo
+
+# Compiler modules may use special flags.
+llex.o:
+ $(CC) $(CFLAGS) $(CMCFLAGS) -c llex.c
+
+lparser.o:
+ $(CC) $(CFLAGS) $(CMCFLAGS) -c lparser.c
+
+lcode.o:
+ $(CC) $(CFLAGS) $(CMCFLAGS) -c lcode.c
# DO NOT DELETE
@@ -134,7 +158,6 @@
ltable.h lundump.h lvm.h
lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h
lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
-lbitlib.o: lbitlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
lcode.o: lcode.c lprefix.h 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
@@ -149,8 +172,8 @@
lparser.h lstring.h ltable.h lundump.h lvm.h
ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \
ltm.h lzio.h lmem.h lundump.h
-lfunc.o: lfunc.c lprefix.h lua.h luaconf.h lfunc.h lobject.h llimits.h \
- lgc.h lstate.h ltm.h lzio.h lmem.h
+lfunc.o: lfunc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
+ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h
lgc.o: lgc.c lprefix.h 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 lprefix.h lua.h luaconf.h lualib.h lauxlib.h
@@ -180,17 +203,17 @@
llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
- llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h ltable.h lvm.h
+ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
-luac.o: luac.c lprefix.h lua.h luaconf.h lauxlib.h lobject.h llimits.h \
- lstate.h ltm.h lzio.h lmem.h lundump.h ldebug.h lopcodes.h
+luac.o: luac.c lprefix.h lua.h luaconf.h lauxlib.h ldebug.h lstate.h \
+ lobject.h llimits.h ltm.h lzio.h lmem.h lopcodes.h lopnames.h lundump.h
lundump.o: lundump.c lprefix.h 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
lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
lvm.o: lvm.c lprefix.h 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
+ ltable.h lvm.h ljumptab.h
lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \
lobject.h ltm.h lzio.h
diff --git a/src/lapi.c b/src/lapi.c
index 02b7fab..3e24781 100644
--- a/src/lapi.c
+++ b/src/lapi.c
@@ -1,5 +1,5 @@
/*
-** $Id: lapi.c,v 2.259.1.2 2017/12/06 18:35:12 roberto Exp $
+** $Id: lapi.c $
** Lua API
** See Copyright Notice in lua.h
*/
@@ -10,6 +10,7 @@
#include "lprefix.h"
+#include <limits.h>
#include <stdarg.h>
#include <string.h>
@@ -36,11 +37,14 @@
"$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 a valid index.
+** '!ttisnil(o)' implies 'o != &G(L)->nilvalue', so it is not needed.
+** However, it covers the most common cases in a faster way.
+*/
+#define isvalid(L, o) (!ttisnil(o) || o != &G(L)->nilvalue)
+
/* test for pseudo index */
#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)
@@ -48,49 +52,46 @@
/* test for upvalue */
#define isupvalue(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) {
+static TValue *index2value (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;
+ StkId o = ci->func + idx;
+ api_check(L, idx <= L->ci->top - (ci->func + 1), "unacceptable index");
+ if (o >= L->top) return &G(L)->nilvalue;
+ else return s2v(o);
}
else if (!ispseudo(idx)) { /* negative index */
api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
- return L->top + idx;
+ return s2v(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 */
+ if (ttislcf(s2v(ci->func))) /* light C function? */
+ return &G(L)->nilvalue; /* it has no upvalues */
else {
- CClosure *func = clCvalue(ci->func);
- return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : NONVALIDVALUE;
+ CClosure *func = clCvalue(s2v(ci->func));
+ return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : &G(L)->nilvalue;
}
}
}
-/*
-** 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);
+static StkId index2stack (lua_State *L, int idx) {
+ CallInfo *ci = L->ci;
+ if (idx > 0) {
+ StkId o = ci->func + idx;
+ api_check(L, o < L->top, "unacceptable index");
+ return o;
+ }
+ else { /* non-positive index */
+ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
+ api_check(L, !ispseudo(idx), "invalid index");
+ return L->top + idx;
+ }
}
@@ -106,7 +107,7 @@
if (inuse > LUAI_MAXSTACK - n) /* can grow without overflow? */
res = 0; /* no */
else /* try to grow stack */
- res = (luaD_rawrunprotected(L, &growstack, &n) == LUA_OK);
+ res = luaD_growstack(L, n, 0);
}
if (res && ci->top < L->top + n)
ci->top = L->top + n; /* adjust frame top */
@@ -124,7 +125,7 @@
api_check(from, to->ci->top - to->top >= n, "stack overflow");
from->top -= n;
for (i = 0; i < n; i++) {
- setobj2s(to, to->top, from->top + i);
+ setobjs2s(to, to->top, from->top + i);
to->top++; /* stack already checked by previous 'api_check' */
}
lua_unlock(to);
@@ -141,10 +142,9 @@
}
-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;
+LUA_API lua_Number lua_version (lua_State *L) {
+ UNUSED(L);
+ return LUA_VERSION_NUM;
}
@@ -170,18 +170,23 @@
LUA_API void lua_settop (lua_State *L, int idx) {
- StkId func = L->ci->func;
+ CallInfo *ci = L->ci;
+ StkId func = ci->func;
+ ptrdiff_t diff; /* difference for new top */
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;
+ api_check(L, idx <= ci->top - (func + 1), "new top too large");
+ diff = ((func + 1) + idx) - L->top;
+ for (; diff > 0; diff--)
+ setnilvalue(s2v(L->top++)); /* clear new slots */
}
else {
api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");
- L->top += idx+1; /* 'subtract' index (index is negative) */
+ diff = idx + 1; /* will "subtract" index (as it is negative) */
}
+ if (diff < 0 && hastocloseCfunc(ci->nresults))
+ luaF_close(L, L->top + diff, LUA_OK);
+ L->top += diff; /* correct top only after closing any upvalue */
lua_unlock(L);
}
@@ -189,11 +194,13 @@
/*
** Reverse the stack segment from 'from' to 'to'
** (auxiliary to 'lua_rotate')
+** Note that we move(copy) only the value inside the stack.
+** (We do not move additional fields that may exist.)
*/
static void reverse (lua_State *L, StkId from, StkId to) {
for (; from < to; from++, to--) {
TValue temp;
- setobj(L, &temp, from);
+ setobj(L, &temp, s2v(from));
setobjs2s(L, from, to);
setobj2s(L, to, &temp);
}
@@ -208,8 +215,7 @@
StkId p, t, m;
lua_lock(L);
t = L->top - 1; /* end of stack segment being rotated */
- p = index2addr(L, idx); /* start of segment */
- api_checkstackindex(L, idx, p);
+ p = index2stack(L, idx); /* start of segment */
api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'");
m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */
reverse(L, p, m); /* reverse the prefix with length 'n' */
@@ -222,12 +228,12 @@
LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {
TValue *fr, *to;
lua_lock(L);
- fr = index2addr(L, fromidx);
- to = index2addr(L, toidx);
- api_checkvalidindex(L, to);
+ fr = index2value(L, fromidx);
+ to = index2value(L, toidx);
+ api_check(L, isvalid(L, to), "invalid index");
setobj(L, to, fr);
if (isupvalue(toidx)) /* function upvalue? */
- luaC_barrier(L, clCvalue(L->ci->func), fr);
+ luaC_barrier(L, clCvalue(s2v(L->ci->func)), fr);
/* LUA_REGISTRYINDEX does not need gc barrier
(collector revisits it before finishing collection) */
lua_unlock(L);
@@ -236,7 +242,7 @@
LUA_API void lua_pushvalue (lua_State *L, int idx) {
lua_lock(L);
- setobj2s(L, L->top, index2addr(L, idx));
+ setobj2s(L, L->top, index2value(L, idx));
api_incr_top(L);
lua_unlock(L);
}
@@ -249,53 +255,53 @@
LUA_API int lua_type (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
- return (isvalid(o) ? ttnov(o) : LUA_TNONE);
+ const TValue *o = index2value(L, idx);
+ return (isvalid(L, o) ? ttype(o) : LUA_TNONE);
}
LUA_API const char *lua_typename (lua_State *L, int t) {
UNUSED(L);
- api_check(L, LUA_TNONE <= t && t < LUA_NUMTAGS, "invalid tag");
+ api_check(L, LUA_TNONE <= t && t < LUA_NUMTYPES, "invalid type");
return ttypename(t);
}
LUA_API int lua_iscfunction (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return (ttislcf(o) || (ttisCclosure(o)));
}
LUA_API int lua_isinteger (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return ttisinteger(o);
}
LUA_API int lua_isnumber (lua_State *L, int idx) {
lua_Number n;
- const TValue *o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return tonumber(o, &n);
}
LUA_API int lua_isstring (lua_State *L, int idx) {
- const TValue *o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return (ttisstring(o) || cvt2str(o));
}
LUA_API int lua_isuserdata (lua_State *L, int idx) {
- const TValue *o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return (ttisfulluserdata(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;
+ const TValue *o1 = index2value(L, index1);
+ const TValue *o2 = index2value(L, index2);
+ return (isvalid(L, o1) && isvalid(L, o2)) ? luaV_rawequalobj(o1, o2) : 0;
}
@@ -309,19 +315,20 @@
api_incr_top(L);
}
/* first operand at top - 2, second at top - 1; result go to top - 2 */
- luaO_arith(L, op, L->top - 2, L->top - 1, L->top - 2);
+ luaO_arith(L, op, s2v(L->top - 2), s2v(L->top - 1), L->top - 2);
L->top--; /* remove second operand */
lua_unlock(L);
}
LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {
- StkId o1, o2;
+ const TValue *o1;
+ const TValue *o2;
int i = 0;
lua_lock(L); /* may call tag method */
- o1 = index2addr(L, index1);
- o2 = index2addr(L, index2);
- if (isvalid(o1) && isvalid(o2)) {
+ o1 = index2value(L, index1);
+ o2 = index2value(L, index2);
+ if (isvalid(L, o1) && isvalid(L, o2)) {
switch (op) {
case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break;
case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;
@@ -335,7 +342,7 @@
LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) {
- size_t sz = luaO_str2num(s, L->top);
+ size_t sz = luaO_str2num(s, s2v(L->top));
if (sz != 0)
api_incr_top(L);
return sz;
@@ -343,35 +350,33 @@
LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) {
- lua_Number n;
- const TValue *o = index2addr(L, idx);
+ lua_Number n = 0;
+ const TValue *o = index2value(L, idx);
int isnum = tonumber(o, &n);
- if (!isnum)
- n = 0; /* call to 'tonumber' may change 'n' even if it fails */
- if (pisnum) *pisnum = isnum;
+ if (pisnum)
+ *pisnum = isnum;
return n;
}
LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) {
- lua_Integer res;
- const TValue *o = index2addr(L, idx);
+ lua_Integer res = 0;
+ const TValue *o = index2value(L, idx);
int isnum = tointeger(o, &res);
- if (!isnum)
- res = 0; /* call to 'tointeger' may change 'n' even if it fails */
- if (pisnum) *pisnum = isnum;
+ if (pisnum)
+ *pisnum = isnum;
return res;
}
LUA_API int lua_toboolean (lua_State *L, int idx) {
- const TValue *o = index2addr(L, idx);
+ const TValue *o = index2value(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);
+ TValue *o = index2value(L, idx);
if (!ttisstring(o)) {
if (!cvt2str(o)) { /* not convertible? */
if (len != NULL) *len = 0;
@@ -380,7 +385,7 @@
lua_lock(L); /* 'luaO_tostring' may create a new string */
luaO_tostring(L, o);
luaC_checkGC(L);
- o = index2addr(L, idx); /* previous call may reallocate the stack */
+ o = index2value(L, idx); /* previous call may reallocate the stack */
lua_unlock(L);
}
if (len != NULL)
@@ -389,20 +394,20 @@
}
-LUA_API size_t lua_rawlen (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
- switch (ttype(o)) {
- case LUA_TSHRSTR: return tsvalue(o)->shrlen;
- case LUA_TLNGSTR: return tsvalue(o)->u.lnglen;
- case LUA_TUSERDATA: return uvalue(o)->len;
- case LUA_TTABLE: return luaH_getn(hvalue(o));
+LUA_API lua_Unsigned lua_rawlen (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ switch (ttypetag(o)) {
+ case LUA_VSHRSTR: return tsvalue(o)->shrlen;
+ case LUA_VLNGSTR: return tsvalue(o)->u.lnglen;
+ case LUA_VUSERDATA: return uvalue(o)->len;
+ case LUA_VTABLE: return luaH_getn(hvalue(o));
default: return 0;
}
}
LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
if (ttislcf(o)) return fvalue(o);
else if (ttisCclosure(o))
return clCvalue(o)->f;
@@ -410,9 +415,8 @@
}
-LUA_API void *lua_touserdata (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
- switch (ttnov(o)) {
+static void *touserdata (const TValue *o) {
+ switch (ttype(o)) {
case LUA_TUSERDATA: return getudatamem(uvalue(o));
case LUA_TLIGHTUSERDATA: return pvalue(o);
default: return NULL;
@@ -420,23 +424,37 @@
}
+LUA_API void *lua_touserdata (lua_State *L, int idx) {
+ const TValue *o = index2value(L, idx);
+ return touserdata(o);
+}
+
+
LUA_API lua_State *lua_tothread (lua_State *L, int idx) {
- StkId o = index2addr(L, idx);
+ const TValue *o = index2value(L, idx);
return (!ttisthread(o)) ? NULL : thvalue(o);
}
+/*
+** Returns a pointer to the internal representation of an object.
+** Note that ANSI C does not allow the conversion of a pointer to
+** function to a 'void*', so the conversion here goes through
+** a 'size_t'. (As the returned pointer is only informative, this
+** conversion should not be a problem.)
+*/
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: return getudatamem(uvalue(o));
- case LUA_TLIGHTUSERDATA: return pvalue(o);
- default: return NULL;
+ const TValue *o = index2value(L, idx);
+ switch (ttypetag(o)) {
+ case LUA_VLCF: return cast_voidp(cast_sizet(fvalue(o)));
+ case LUA_VUSERDATA: case LUA_VLIGHTUSERDATA:
+ return touserdata(o);
+ default: {
+ if (iscollectable(o))
+ return gcvalue(o);
+ else
+ return NULL;
+ }
}
}
@@ -449,7 +467,7 @@
LUA_API void lua_pushnil (lua_State *L) {
lua_lock(L);
- setnilvalue(L->top);
+ setnilvalue(s2v(L->top));
api_incr_top(L);
lua_unlock(L);
}
@@ -457,7 +475,7 @@
LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
lua_lock(L);
- setfltvalue(L->top, n);
+ setfltvalue(s2v(L->top), n);
api_incr_top(L);
lua_unlock(L);
}
@@ -465,7 +483,7 @@
LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {
lua_lock(L);
- setivalue(L->top, n);
+ setivalue(s2v(L->top), n);
api_incr_top(L);
lua_unlock(L);
}
@@ -491,7 +509,7 @@
LUA_API const char *lua_pushstring (lua_State *L, const char *s) {
lua_lock(L);
if (s == NULL)
- setnilvalue(L->top);
+ setnilvalue(s2v(L->top));
else {
TString *ts;
ts = luaS_new(L, s);
@@ -532,7 +550,7 @@
LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
lua_lock(L);
if (n == 0) {
- setfvalue(L->top, fn);
+ setfvalue(s2v(L->top), fn);
api_incr_top(L);
}
else {
@@ -543,10 +561,10 @@
cl->f = fn;
L->top -= n;
while (n--) {
- setobj2n(L, &cl->upvalue[n], L->top + n);
+ setobj2n(L, &cl->upvalue[n], s2v(L->top + n));
/* does not need barrier because closure is white */
}
- setclCvalue(L, L->top, cl);
+ setclCvalue(L, s2v(L->top), cl);
api_incr_top(L);
luaC_checkGC(L);
}
@@ -556,7 +574,10 @@
LUA_API void lua_pushboolean (lua_State *L, int b) {
lua_lock(L);
- setbvalue(L->top, (b != 0)); /* ensure that true is 1 */
+ if (b)
+ setbtvalue(s2v(L->top));
+ else
+ setbfvalue(s2v(L->top));
api_incr_top(L);
lua_unlock(L);
}
@@ -564,7 +585,7 @@
LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {
lua_lock(L);
- setpvalue(L->top, p);
+ setpvalue(s2v(L->top), p);
api_incr_top(L);
lua_unlock(L);
}
@@ -572,7 +593,7 @@
LUA_API int lua_pushthread (lua_State *L) {
lua_lock(L);
- setthvalue(L, L->top, L);
+ setthvalue(L, s2v(L->top), L);
api_incr_top(L);
lua_unlock(L);
return (G(L)->mainthread == L);
@@ -595,10 +616,10 @@
else {
setsvalue2s(L, L->top, str);
api_incr_top(L);
- luaV_finishget(L, t, L->top - 1, L->top - 1, slot);
+ luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
}
lua_unlock(L);
- return ttnov(L->top - 1);
+ return ttype(s2v(L->top - 1));
}
@@ -610,74 +631,90 @@
LUA_API int lua_gettable (lua_State *L, int idx) {
- StkId t;
+ const TValue *slot;
+ TValue *t;
lua_lock(L);
- t = index2addr(L, idx);
- luaV_gettable(L, t, L->top - 1, L->top - 1);
+ t = index2value(L, idx);
+ if (luaV_fastget(L, t, s2v(L->top - 1), slot, luaH_get)) {
+ setobj2s(L, L->top - 1, slot);
+ }
+ else
+ luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
lua_unlock(L);
- return ttnov(L->top - 1);
+ return ttype(s2v(L->top - 1));
}
LUA_API int lua_getfield (lua_State *L, int idx, const char *k) {
lua_lock(L);
- return auxgetstr(L, index2addr(L, idx), k);
+ return auxgetstr(L, index2value(L, idx), k);
}
LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) {
- StkId t;
+ TValue *t;
const TValue *slot;
lua_lock(L);
- t = index2addr(L, idx);
- if (luaV_fastget(L, t, n, slot, luaH_getint)) {
+ t = index2value(L, idx);
+ if (luaV_fastgeti(L, t, n, slot)) {
setobj2s(L, L->top, slot);
- api_incr_top(L);
}
else {
- setivalue(L->top, n);
- api_incr_top(L);
- luaV_finishget(L, t, L->top - 1, L->top - 1, slot);
+ TValue aux;
+ setivalue(&aux, n);
+ luaV_finishget(L, t, &aux, L->top, slot);
}
+ api_incr_top(L);
lua_unlock(L);
- return ttnov(L->top - 1);
+ return ttype(s2v(L->top - 1));
+}
+
+
+static int finishrawget (lua_State *L, const TValue *val) {
+ if (isempty(val)) /* avoid copying empty items to the stack */
+ setnilvalue(s2v(L->top));
+ else
+ setobj2s(L, L->top, val);
+ api_incr_top(L);
+ lua_unlock(L);
+ return ttype(s2v(L->top - 1));
+}
+
+
+static Table *gettable (lua_State *L, int idx) {
+ TValue *t = index2value(L, idx);
+ api_check(L, ttistable(t), "table expected");
+ return hvalue(t);
}
LUA_API int lua_rawget (lua_State *L, int idx) {
- StkId t;
+ Table *t;
+ const TValue *val;
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);
- return ttnov(L->top - 1);
+ api_checknelems(L, 1);
+ t = gettable(L, idx);
+ val = luaH_get(t, s2v(L->top - 1));
+ L->top--; /* remove key */
+ return finishrawget(L, val);
}
LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {
- StkId t;
+ Table *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);
- return ttnov(L->top - 1);
+ t = gettable(L, idx);
+ return finishrawget(L, luaH_getint(t, n));
}
LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) {
- StkId t;
+ Table *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);
- return ttnov(L->top - 1);
+ t = gettable(L, idx);
+ setpvalue(&k, cast_voidp(p));
+ return finishrawget(L, luaH_get(t, &k));
}
@@ -685,7 +722,7 @@
Table *t;
lua_lock(L);
t = luaH_new(L);
- sethvalue(L, L->top, t);
+ sethvalue2s(L, L->top, t);
api_incr_top(L);
if (narray > 0 || nrec > 0)
luaH_resize(L, t, narray, nrec);
@@ -699,8 +736,8 @@
Table *mt;
int res = 0;
lua_lock(L);
- obj = index2addr(L, objindex);
- switch (ttnov(obj)) {
+ obj = index2value(L, objindex);
+ switch (ttype(obj)) {
case LUA_TTABLE:
mt = hvalue(obj)->metatable;
break;
@@ -708,11 +745,11 @@
mt = uvalue(obj)->metatable;
break;
default:
- mt = G(L)->mt[ttnov(obj)];
+ mt = G(L)->mt[ttype(obj)];
break;
}
if (mt != NULL) {
- sethvalue(L, L->top, mt);
+ sethvalue2s(L, L->top, mt);
api_incr_top(L);
res = 1;
}
@@ -721,15 +758,23 @@
}
-LUA_API int lua_getuservalue (lua_State *L, int idx) {
- StkId o;
+LUA_API int lua_getiuservalue (lua_State *L, int idx, int n) {
+ TValue *o;
+ int t;
lua_lock(L);
- o = index2addr(L, idx);
+ o = index2value(L, idx);
api_check(L, ttisfulluserdata(o), "full userdata expected");
- getuservalue(L, uvalue(o), L->top);
+ if (n <= 0 || n > uvalue(o)->nuvalue) {
+ setnilvalue(s2v(L->top));
+ t = LUA_TNONE;
+ }
+ else {
+ setobj2s(L, L->top, &uvalue(o)->uv[n - 1].uv);
+ t = ttype(s2v(L->top));
+ }
api_incr_top(L);
lua_unlock(L);
- return ttnov(L->top - 1);
+ return t;
}
@@ -744,12 +789,14 @@
const TValue *slot;
TString *str = luaS_new(L, k);
api_checknelems(L, 1);
- if (luaV_fastset(L, t, str, slot, luaH_getstr, L->top - 1))
+ if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
L->top--; /* pop value */
+ }
else {
setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */
api_incr_top(L);
- luaV_finishset(L, t, L->top - 1, L->top - 2, slot);
+ luaV_finishset(L, t, s2v(L->top - 1), s2v(L->top - 2), slot);
L->top -= 2; /* pop value and key */
}
lua_unlock(L); /* lock done by caller */
@@ -764,11 +811,16 @@
LUA_API void lua_settable (lua_State *L, int idx) {
- StkId t;
+ TValue *t;
+ const TValue *slot;
lua_lock(L);
api_checknelems(L, 2);
- t = index2addr(L, idx);
- luaV_settable(L, t, L->top - 2, L->top - 1);
+ t = index2value(L, idx);
+ if (luaV_fastget(L, t, s2v(L->top - 2), slot, luaH_get)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
+ }
+ else
+ luaV_finishset(L, t, s2v(L->top - 2), s2v(L->top - 1), slot);
L->top -= 2; /* pop index and value */
lua_unlock(L);
}
@@ -776,68 +828,63 @@
LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
lua_lock(L); /* unlock done in 'auxsetstr' */
- auxsetstr(L, index2addr(L, idx), k);
+ auxsetstr(L, index2value(L, idx), k);
}
LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) {
- StkId t;
+ TValue *t;
const TValue *slot;
lua_lock(L);
api_checknelems(L, 1);
- t = index2addr(L, idx);
- if (luaV_fastset(L, t, n, slot, luaH_getint, L->top - 1))
- L->top--; /* pop value */
- else {
- setivalue(L->top, n);
- api_incr_top(L);
- luaV_finishset(L, t, L->top - 1, L->top - 2, slot);
- L->top -= 2; /* pop value and key */
+ t = index2value(L, idx);
+ if (luaV_fastgeti(L, t, n, slot)) {
+ luaV_finishfastset(L, t, slot, s2v(L->top - 1));
}
+ else {
+ TValue aux;
+ setivalue(&aux, n);
+ luaV_finishset(L, t, &aux, s2v(L->top - 1), slot);
+ }
+ L->top--; /* pop value */
+ lua_unlock(L);
+}
+
+
+static void aux_rawset (lua_State *L, int idx, TValue *key, int n) {
+ Table *t;
+ TValue *slot;
+ lua_lock(L);
+ api_checknelems(L, n);
+ t = gettable(L, idx);
+ slot = luaH_set(L, t, key);
+ setobj2t(L, slot, s2v(L->top - 1));
+ invalidateTMcache(t);
+ luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
+ L->top -= n;
lua_unlock(L);
}
LUA_API void lua_rawset (lua_State *L, int idx) {
- StkId o;
- TValue *slot;
- lua_lock(L);
- api_checknelems(L, 2);
- o = index2addr(L, idx);
- api_check(L, ttistable(o), "table expected");
- slot = luaH_set(L, hvalue(o), L->top - 2);
- setobj2t(L, slot, L->top - 1);
- invalidateTMcache(hvalue(o));
- luaC_barrierback(L, hvalue(o), L->top-1);
- L->top -= 2;
- lua_unlock(L);
-}
-
-
-LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {
- StkId o;
- lua_lock(L);
- api_checknelems(L, 1);
- o = index2addr(L, idx);
- api_check(L, ttistable(o), "table expected");
- luaH_setint(L, hvalue(o), n, L->top - 1);
- luaC_barrierback(L, hvalue(o), L->top-1);
- L->top--;
- lua_unlock(L);
+ aux_rawset(L, idx, s2v(L->top - 2), 2);
}
LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {
- StkId o;
- TValue k, *slot;
+ TValue k;
+ setpvalue(&k, cast_voidp(p));
+ aux_rawset(L, idx, &k, 1);
+}
+
+
+LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {
+ Table *t;
lua_lock(L);
api_checknelems(L, 1);
- o = index2addr(L, idx);
- api_check(L, ttistable(o), "table expected");
- setpvalue(&k, cast(void *, p));
- slot = luaH_set(L, hvalue(o), &k);
- setobj2t(L, slot, L->top - 1);
- luaC_barrierback(L, hvalue(o), L->top - 1);
+ t = gettable(L, idx);
+ luaH_setint(L, t, n, s2v(L->top - 1));
+ luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
L->top--;
lua_unlock(L);
}
@@ -848,14 +895,14 @@
Table *mt;
lua_lock(L);
api_checknelems(L, 1);
- obj = index2addr(L, objindex);
- if (ttisnil(L->top - 1))
+ obj = index2value(L, objindex);
+ if (ttisnil(s2v(L->top - 1)))
mt = NULL;
else {
- api_check(L, ttistable(L->top - 1), "table expected");
- mt = hvalue(L->top - 1);
+ api_check(L, ttistable(s2v(L->top - 1)), "table expected");
+ mt = hvalue(s2v(L->top - 1));
}
- switch (ttnov(obj)) {
+ switch (ttype(obj)) {
case LUA_TTABLE: {
hvalue(obj)->metatable = mt;
if (mt) {
@@ -873,7 +920,7 @@
break;
}
default: {
- G(L)->mt[ttnov(obj)] = mt;
+ G(L)->mt[ttype(obj)] = mt;
break;
}
}
@@ -883,16 +930,23 @@
}
-LUA_API void lua_setuservalue (lua_State *L, int idx) {
- StkId o;
+LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) {
+ TValue *o;
+ int res;
lua_lock(L);
api_checknelems(L, 1);
- o = index2addr(L, idx);
+ o = index2value(L, idx);
api_check(L, ttisfulluserdata(o), "full userdata expected");
- setuservalue(L, uvalue(o), L->top - 1);
- luaC_barrier(L, gcvalue(o), L->top - 1);
+ if (!(cast_uint(n) - 1u < cast_uint(uvalue(o)->nuvalue)))
+ res = 0; /* 'n' not in [1, uvalue(o)->nuvalue] */
+ else {
+ setobj(L, &uvalue(o)->uv[n - 1].uv, s2v(L->top - 1));
+ luaC_barrierback(L, gcvalue(o), s2v(L->top - 1));
+ res = 1;
+ }
L->top--;
lua_unlock(L);
+ return res;
}
@@ -916,7 +970,7 @@
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? */
+ if (k != NULL && yieldable(L)) { /* 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); /* do the call */
@@ -959,12 +1013,12 @@
if (errfunc == 0)
func = 0;
else {
- StkId o = index2addr(L, errfunc);
- api_checkstackindex(L, errfunc, o);
+ StkId o = index2stack(L, errfunc);
+ api_check(L, ttisfunction(s2v(o)), "error handler must be a function");
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? */
+ if (k == NULL || !yieldable(L)) { /* 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);
}
@@ -973,7 +1027,7 @@
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->u2.funcidx = cast_int(savestack(L, c.func));
ci->u.c.old_errfunc = L->errfunc;
L->errfunc = func;
setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */
@@ -998,14 +1052,14 @@
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 */
+ LClosure *f = clLvalue(s2v(L->top - 1)); /* get newly created function */
if (f->nupvalues >= 1) { /* does it have an 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_upvalbarrier(L, f->upvals[0]);
+ luaC_barrier(L, f->upvals[0], gt);
}
}
lua_unlock(L);
@@ -1018,7 +1072,7 @@
TValue *o;
lua_lock(L);
api_checknelems(L, 1);
- o = L->top - 1;
+ o = s2v(L->top - 1);
if (isLfunction(o))
status = luaU_dump(L, getproto(o), writer, data, strip);
else
@@ -1036,12 +1090,12 @@
/*
** Garbage-collection function
*/
-
-LUA_API int lua_gc (lua_State *L, int what, int data) {
+LUA_API int lua_gc (lua_State *L, int what, ...) {
+ va_list argp;
int res = 0;
- global_State *g;
+ global_State *g = G(L);
lua_lock(L);
- g = G(L);
+ va_start(argp, what);
switch (what) {
case LUA_GCSTOP: {
g->gcrunning = 0;
@@ -1066,11 +1120,12 @@
break;
}
case LUA_GCSTEP: {
+ int data = va_arg(argp, int);
l_mem debt = 1; /* =1 to signal that it did an actual step */
lu_byte oldrunning = g->gcrunning;
g->gcrunning = 1; /* allow GC to run */
if (data == 0) {
- luaE_setdebt(g, -GCSTEPSIZE); /* to do a "small" step */
+ luaE_setdebt(g, 0); /* do a basic step */
luaC_step(L);
}
else { /* add 'data' to total debt */
@@ -1084,22 +1139,49 @@
break;
}
case LUA_GCSETPAUSE: {
- res = g->gcpause;
- g->gcpause = data;
+ int data = va_arg(argp, int);
+ res = getgcparam(g->gcpause);
+ setgcparam(g->gcpause, data);
break;
}
case LUA_GCSETSTEPMUL: {
- res = g->gcstepmul;
- if (data < 40) data = 40; /* avoid ridiculous low values (and 0) */
- g->gcstepmul = data;
+ int data = va_arg(argp, int);
+ res = getgcparam(g->gcstepmul);
+ setgcparam(g->gcstepmul, data);
break;
}
case LUA_GCISRUNNING: {
res = g->gcrunning;
break;
}
+ case LUA_GCGEN: {
+ int minormul = va_arg(argp, int);
+ int majormul = va_arg(argp, int);
+ res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
+ if (minormul != 0)
+ g->genminormul = minormul;
+ if (majormul != 0)
+ setgcparam(g->genmajormul, majormul);
+ luaC_changemode(L, KGC_GEN);
+ break;
+ }
+ case LUA_GCINC: {
+ int pause = va_arg(argp, int);
+ int stepmul = va_arg(argp, int);
+ int stepsize = va_arg(argp, int);
+ res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
+ if (pause != 0)
+ setgcparam(g->gcpause, pause);
+ if (stepmul != 0)
+ setgcparam(g->gcstepmul, stepmul);
+ if (stepsize != 0)
+ g->gcstepsize = stepsize;
+ luaC_changemode(L, KGC_INC);
+ break;
+ }
default: res = -1; /* invalid option */
}
+ va_end(argp);
lua_unlock(L);
return res;
}
@@ -1121,12 +1203,12 @@
LUA_API int lua_next (lua_State *L, int idx) {
- StkId t;
+ Table *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);
+ api_checknelems(L, 1);
+ t = gettable(L, idx);
+ more = luaH_next(L, t, L->top - 1);
if (more) {
api_incr_top(L);
}
@@ -1137,6 +1219,22 @@
}
+LUA_API void lua_toclose (lua_State *L, int idx) {
+ int nresults;
+ StkId o;
+ lua_lock(L);
+ o = index2stack(L, idx);
+ nresults = L->ci->nresults;
+ api_check(L, L->openupval == NULL || uplevel(L->openupval) <= o,
+ "marked index below or equal new one");
+ luaF_newtbcupval(L, o); /* create new to-be-closed upvalue */
+ if (!hastocloseCfunc(nresults)) /* function not marked yet? */
+ L->ci->nresults = codeNresults(nresults); /* mark it */
+ lua_assert(hastocloseCfunc(L->ci->nresults));
+ lua_unlock(L);
+}
+
+
LUA_API void lua_concat (lua_State *L, int n) {
lua_lock(L);
api_checknelems(L, n);
@@ -1154,9 +1252,9 @@
LUA_API void lua_len (lua_State *L, int idx) {
- StkId t;
+ TValue *t;
lua_lock(L);
- t = index2addr(L, idx);
+ t = index2value(L, idx);
luaV_objlen(L, L->top, t);
api_incr_top(L);
lua_unlock(L);
@@ -1181,11 +1279,28 @@
}
-LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
+void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud) {
+ lua_lock(L);
+ G(L)->ud_warn = ud;
+ G(L)->warnf = f;
+ lua_unlock(L);
+}
+
+
+void lua_warning (lua_State *L, const char *msg, int tocont) {
+ lua_lock(L);
+ luaE_warning(L, msg, tocont);
+ lua_unlock(L);
+}
+
+
+
+LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) {
Udata *u;
lua_lock(L);
- u = luaS_newudata(L, size);
- setuvalue(L, L->top, u);
+ api_check(L, 0 <= nuvalue && nuvalue < USHRT_MAX, "invalid value");
+ u = luaS_newudata(L, size, nuvalue);
+ setuvalue(L, s2v(L->top), u);
api_incr_top(L);
luaC_checkGC(L);
lua_unlock(L);
@@ -1194,25 +1309,27 @@
-static const char *aux_upvalue (StkId fi, int n, TValue **val,
- CClosure **owner, UpVal **uv) {
- switch (ttype(fi)) {
- case LUA_TCCL: { /* C closure */
+static const char *aux_upvalue (TValue *fi, int n, TValue **val,
+ GCObject **owner) {
+ switch (ttypetag(fi)) {
+ case LUA_VCCL: { /* C closure */
CClosure *f = clCvalue(fi);
- if (!(1 <= n && n <= f->nupvalues)) return NULL;
+ if (!(cast_uint(n) - 1u < cast_uint(f->nupvalues)))
+ return NULL; /* 'n' not in [1, f->nupvalues] */
*val = &f->upvalue[n-1];
- if (owner) *owner = f;
+ if (owner) *owner = obj2gco(f);
return "";
}
- case LUA_TLCL: { /* Lua closure */
+ case LUA_VLCL: { /* Lua closure */
LClosure *f = clLvalue(fi);
TString *name;
Proto *p = f->p;
- if (!(1 <= n && n <= p->sizeupvalues)) return NULL;
+ if (!(cast_uint(n) - 1u < cast_uint(p->sizeupvalues)))
+ return NULL; /* 'n' not in [1, p->sizeupvalues] */
*val = f->upvals[n-1]->v;
- if (uv) *uv = f->upvals[n - 1];
+ if (owner) *owner = obj2gco(f->upvals[n - 1]);
name = p->upvalues[n-1].name;
- return (name == NULL) ? "(*no name)" : getstr(name);
+ return (name == NULL) ? "(no name)" : getstr(name);
}
default: return NULL; /* not a closure */
}
@@ -1223,7 +1340,7 @@
const char *name;
TValue *val = NULL; /* to avoid warnings */
lua_lock(L);
- name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL, NULL);
+ name = aux_upvalue(index2value(L, funcindex), n, &val, NULL);
if (name) {
setobj2s(L, L->top, val);
api_incr_top(L);
@@ -1236,18 +1353,16 @@
LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
const char *name;
TValue *val = NULL; /* to avoid warnings */
- CClosure *owner = NULL;
- UpVal *uv = NULL;
- StkId fi;
+ GCObject *owner = NULL; /* to avoid warnings */
+ TValue *fi;
lua_lock(L);
- fi = index2addr(L, funcindex);
+ fi = index2value(L, funcindex);
api_checknelems(L, 1);
- name = aux_upvalue(fi, n, &val, &owner, &uv);
+ name = aux_upvalue(fi, n, &val, &owner);
if (name) {
L->top--;
- setobj(L, val, L->top);
- if (owner) { luaC_barrier(L, owner, L->top); }
- else if (uv) { luaC_upvalbarrier(L, uv); }
+ setobj(L, val, s2v(L->top));
+ luaC_barrier(L, owner, val);
}
lua_unlock(L);
return name;
@@ -1256,7 +1371,7 @@
static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
LClosure *f;
- StkId fi = index2addr(L, fidx);
+ TValue *fi = index2value(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");
@@ -1266,12 +1381,12 @@
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 */
+ TValue *fi = index2value(L, fidx);
+ switch (ttypetag(fi)) {
+ case LUA_VLCL: { /* lua closure */
return *getupvalref(L, fidx, n, NULL);
}
- case LUA_TCCL: { /* C closure */
+ case LUA_VCCL: { /* C closure */
CClosure *f = clCvalue(fi);
api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index");
return &f->upvalue[n - 1];
@@ -1289,11 +1404,8 @@
LClosure *f1;
UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
- luaC_upvdeccount(L, *up1);
*up1 = *up2;
- (*up1)->refcount++;
- if (upisopen(*up1)) (*up1)->u.open.touched = 1;
- luaC_upvalbarrier(L, *up1);
+ luaC_objbarrier(L, f1, *up1);
}
diff --git a/src/lapi.h b/src/lapi.h
index 8e16ad5..41216b2 100644
--- a/src/lapi.h
+++ b/src/lapi.h
@@ -1,5 +1,5 @@
/*
-** $Id: lapi.h,v 2.9.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lapi.h $
** Auxiliary functions from Lua API
** See Copyright Notice in lua.h
*/
@@ -11,14 +11,37 @@
#include "llimits.h"
#include "lstate.h"
+
+/* Increments 'L->top', checking for stack overflows */
#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; }
+/*
+** If a call returns too many multiple returns, the callee may not have
+** stack space to accommodate all results. In this case, this macro
+** increases its stack space ('L->ci->top').
+*/
+#define adjustresults(L,nres) \
+ { if ((nres) <= LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; }
+
+
+/* Ensure the stack has at least 'n' elements */
#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \
"not enough elements in the stack")
+/*
+** To reduce the overhead of returning from C functions, the presence of
+** to-be-closed variables in these functions is coded in the CallInfo's
+** field 'nresults', in a way that functions with no to-be-closed variables
+** with zero, one, or "all" wanted results have no overhead. Functions
+** with other number of wanted results, as well as functions with
+** variables to be closed, have an extra check.
+*/
+
+#define hastocloseCfunc(n) ((n) < LUA_MULTRET)
+
+#define codeNresults(n) (-(n) - 3)
+
#endif
diff --git a/src/lauxlib.c b/src/lauxlib.c
index 8bdada5..e3d9be3 100644
--- a/src/lauxlib.c
+++ b/src/lauxlib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lauxlib.c,v 1.289.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lauxlib.c $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
@@ -27,6 +27,12 @@
#include "lauxlib.h"
+#if !defined(MAX_SIZET)
+/* maximum value for size_t */
+#define MAX_SIZET ((size_t)(~(size_t)0))
+#endif
+
+
/*
** {======================================================
** Traceback
@@ -40,8 +46,8 @@
/*
-** search for 'objidx' in table at index -1.
-** return 1 + string at top if find a good name.
+** Search for 'objidx' in table at index -1. ('objidx' must be an
+** absolute index.) Return 1 + string at top if it found a good name.
*/
static int findfield (lua_State *L, int objidx, int level) {
if (level == 0 || !lua_istable(L, -1))
@@ -54,10 +60,10 @@
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);
+ /* stack: lib_name, lib_table, field_name (top) */
+ lua_pushliteral(L, "."); /* place '.' between the two names */
+ lua_replace(L, -3); /* (in the slot occupied by table) */
+ lua_concat(L, 3); /* lib_name.field_name */
return 1;
}
}
@@ -76,12 +82,12 @@
lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
if (findfield(L, top + 1, 2)) {
const char *name = lua_tostring(L, -1);
- if (strncmp(name, "_G.", 3) == 0) { /* name start with '_G.'? */
+ if (strncmp(name, LUA_GNAME ".", 3) == 0) { /* name start with '_G.'? */
lua_pushstring(L, name + 3); /* push name without prefix */
lua_remove(L, -2); /* remove original name */
}
- lua_copy(L, -1, top + 1); /* move name to proper place */
- lua_pop(L, 2); /* remove pushed values */
+ lua_copy(L, -1, top + 1); /* copy name to proper place */
+ lua_settop(L, top + 1); /* remove table "loaded" and name copy */
return 1;
}
else {
@@ -124,32 +130,37 @@
LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,
const char *msg, int level) {
+ luaL_Buffer b;
lua_Debug ar;
- int top = lua_gettop(L);
int last = lastlevel(L1);
- int n1 = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;
- if (msg)
- lua_pushfstring(L, "%s\n", msg);
- luaL_checkstack(L, 10, NULL);
- lua_pushliteral(L, "stack traceback:");
+ int limit2show = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;
+ luaL_buffinit(L, &b);
+ if (msg) {
+ luaL_addstring(&b, msg);
+ luaL_addchar(&b, '\n');
+ }
+ luaL_addstring(&b, "stack traceback:");
while (lua_getstack(L1, level++, &ar)) {
- if (n1-- == 0) { /* too many levels? */
- lua_pushliteral(L, "\n\t..."); /* add a '...' */
- level = last - LEVELS2 + 1; /* and skip to last ones */
+ if (limit2show-- == 0) { /* too many levels? */
+ int n = last - level - LEVELS2 + 1; /* number of levels to skip */
+ lua_pushfstring(L, "\n\t...\t(skipping %d levels)", n);
+ luaL_addvalue(&b); /* add warning about skip */
+ level += n; /* and skip to last levels */
}
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 ");
+ if (ar.currentline <= 0)
+ lua_pushfstring(L, "\n\t%s: in ", ar.short_src);
+ else
+ lua_pushfstring(L, "\n\t%s:%d: in ", ar.short_src, ar.currentline);
+ luaL_addvalue(&b);
pushfuncname(L, &ar);
+ luaL_addvalue(&b);
if (ar.istailcall)
- lua_pushliteral(L, "\n\t(...tail calls...)");
- lua_concat(L, lua_gettop(L) - top);
+ luaL_addstring(&b, "\n\t(...tail calls...)");
}
}
- lua_concat(L, lua_gettop(L) - top);
+ luaL_pushresult(&b);
}
/* }====================================================== */
@@ -179,7 +190,7 @@
}
-static int typeerror (lua_State *L, int arg, const char *tname) {
+int luaL_typeerror (lua_State *L, int arg, const char *tname) {
const char *msg;
const char *typearg; /* name for the type of the actual argument */
if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING)
@@ -194,7 +205,7 @@
static void tag_error (lua_State *L, int arg, int tag) {
- typeerror(L, arg, lua_typename(L, tag));
+ luaL_typeerror(L, arg, lua_typename(L, tag));
}
@@ -238,7 +249,7 @@
return 1;
}
else {
- lua_pushnil(L);
+ luaL_pushfail(L);
if (fname)
lua_pushfstring(L, "%s: %s", fname, strerror(en));
else
@@ -273,23 +284,24 @@
LUALIB_API int luaL_execresult (lua_State *L, int stat) {
const char *what = "exit"; /* type of termination */
- if (stat == -1) /* error? */
+ if (stat != 0 && errno != 0) /* error with an 'errno'? */
return luaL_fileresult(L, 0, NULL);
else {
l_inspectstat(stat, what); /* interpret result */
if (*what == 'e' && stat == 0) /* successful termination? */
lua_pushboolean(L, 1);
else
- lua_pushnil(L);
+ luaL_pushfail(L);
lua_pushstring(L, what);
lua_pushinteger(L, stat);
- return 3; /* return true/nil,what,code */
+ return 3; /* return true/fail,what,code */
}
}
/* }====================================================== */
+
/*
** {======================================================
** Userdata's metatable manipulation
@@ -332,7 +344,7 @@
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);
+ luaL_argexpected(L, p != NULL, ud, tname);
return p;
}
@@ -463,10 +475,8 @@
lua_Alloc allocf = lua_getallocf(L, &ud);
UBox *box = (UBox *)lua_touserdata(L, idx);
void *temp = allocf(ud, box->box, box->bsize, newsize);
- if (temp == NULL && newsize > 0) { /* allocation error? */
- resizebox(L, idx, 0); /* free buffer */
- luaL_error(L, "not enough memory for buffer allocation");
- }
+ if (temp == NULL && newsize > 0) /* allocation error? */
+ luaL_error(L, "not enough memory");
box->box = temp;
box->bsize = newsize;
return temp;
@@ -479,16 +489,20 @@
}
-static void *newbox (lua_State *L, size_t newsize) {
- UBox *box = (UBox *)lua_newuserdata(L, sizeof(UBox));
+static const luaL_Reg boxmt[] = { /* box metamethods */
+ {"__gc", boxgc},
+ {"__close", boxgc},
+ {NULL, NULL}
+};
+
+
+static void newbox (lua_State *L) {
+ UBox *box = (UBox *)lua_newuserdatauv(L, sizeof(UBox), 0);
box->box = NULL;
box->bsize = 0;
- if (luaL_newmetatable(L, "LUABOX")) { /* creating metatable? */
- lua_pushcfunction(L, boxgc);
- lua_setfield(L, -2, "__gc"); /* metatable.__gc = boxgc */
- }
+ if (luaL_newmetatable(L, "_UBOX*")) /* creating metatable? */
+ luaL_setfuncs(L, boxmt, 0); /* set its metamethods */
lua_setmetatable(L, -2);
- return resizebox(L, -1, newsize);
}
@@ -496,38 +510,64 @@
** check whether buffer is using a userdata on the stack as a temporary
** buffer
*/
-#define buffonstack(B) ((B)->b != (B)->initb)
+#define buffonstack(B) ((B)->b != (B)->init.b)
/*
+** Compute new size for buffer 'B', enough to accommodate extra 'sz'
+** bytes.
+*/
+static size_t newbuffsize (luaL_Buffer *B, size_t sz) {
+ size_t newsize = B->size * 2; /* double buffer size */
+ if (MAX_SIZET - sz < B->n) /* overflow in (B->n + sz)? */
+ return luaL_error(B->L, "buffer too large");
+ if (newsize < B->n + sz) /* double is not big enough? */
+ newsize = B->n + sz;
+ return newsize;
+}
+
+
+/*
+** Returns a pointer to a free area with at least 'sz' bytes in buffer
+** 'B'. 'boxidx' is the relative position in the stack where the
+** buffer's box is or should be.
+*/
+static char *prepbuffsize (luaL_Buffer *B, size_t sz, int boxidx) {
+ if (B->size - B->n >= sz) /* enough space? */
+ return B->b + B->n;
+ else {
+ lua_State *L = B->L;
+ char *newbuff;
+ size_t newsize = newbuffsize(B, sz);
+ /* create larger buffer */
+ if (buffonstack(B)) /* buffer already has a box? */
+ newbuff = (char *)resizebox(L, boxidx, newsize); /* resize it */
+ else { /* no box yet */
+ lua_pushnil(L); /* reserve slot for final result */
+ newbox(L); /* create a new box */
+ /* move box (and slot) to its intended position */
+ lua_rotate(L, boxidx - 1, 2);
+ lua_toclose(L, boxidx);
+ newbuff = (char *)resizebox(L, boxidx, newsize);
+ memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */
+ }
+ B->b = newbuff;
+ B->size = newsize;
+ return newbuff + B->n;
+ }
+}
+
+/*
** 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 */
- if (buffonstack(B))
- newbuff = (char *)resizebox(L, -1, newsize);
- else { /* no buffer yet */
- newbuff = (char *)newbox(L, newsize);
- memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */
- }
- B->b = newbuff;
- B->size = newsize;
- }
- return &B->b[B->n];
+ return prepbuffsize(B, sz, -1);
}
LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */
- char *b = luaL_prepbuffsize(B, l);
+ char *b = prepbuffsize(B, l, -1);
memcpy(b, s, l * sizeof(char));
luaL_addsize(B, l);
}
@@ -543,8 +583,8 @@
lua_State *L = B->L;
lua_pushlstring(L, B->b, B->n);
if (buffonstack(B)) {
- resizebox(L, -2, 0); /* delete old buffer */
- lua_remove(L, -2); /* remove its header from the stack */
+ lua_copy(L, -1, -3); /* move string to reserved slot */
+ lua_pop(L, 2); /* pop string and box (closing the box) */
}
}
@@ -555,20 +595,29 @@
}
+/*
+** 'luaL_addvalue' is the only function in the Buffer system where the
+** box (if existent) is not on the top of the stack. So, instead of
+** calling 'luaL_addlstring', it replicates the code using -2 as the
+** last argument to 'prepbuffsize', signaling that the box is (or will
+** be) bellow the string being added to the buffer. (Box creation can
+** trigger an emergency GC, so we should not remove the string from the
+** stack before we have the space guaranteed.)
+*/
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 */
+ size_t len;
+ const char *s = lua_tolstring(L, -1, &len);
+ char *b = prepbuffsize(B, len, -2);
+ memcpy(b, s, len * sizeof(char));
+ luaL_addsize(B, len);
+ lua_pop(L, 1); /* pop string */
}
LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
B->L = L;
- B->b = B->initb;
+ B->b = B->init.b;
B->n = 0;
B->size = LUAL_BUFFERSIZE;
}
@@ -576,7 +625,7 @@
LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
luaL_buffinit(L, B);
- return luaL_prepbuffsize(B, sz);
+ return prepbuffsize(B, sz, -1);
}
/* }====================================================== */
@@ -846,87 +895,6 @@
/*
-** {======================================================
-** 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);
- if (lua_rawget(L, -2) == LUA_TNIL) { /* 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, LUA_LOADED_TABLE, 1);
- if (lua_getfield(L, -1, modname) != LUA_TTABLE) { /* no LOADED[modname]? */
- 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 '%s'", 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.
@@ -934,10 +902,14 @@
LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
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 */
+ if (l->func == NULL) /* place holder? */
+ lua_pushboolean(L, 0);
+ else {
+ 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 */
@@ -988,18 +960,24 @@
}
-LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,
- const char *r) {
+LUALIB_API void luaL_addgsub (luaL_Buffer *b, 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 */
+ 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_addstring(b, s); /* push last suffix */
+}
+
+
+LUALIB_API const char *luaL_gsub (lua_State *L, const char *s,
+ const char *p, const char *r) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ luaL_addgsub(&b, s, p, r);
luaL_pushresult(&b);
return lua_tostring(L, -1);
}
@@ -1017,27 +995,63 @@
static int panic (lua_State *L) {
+ const char *msg = lua_tostring(L, -1);
+ if (msg == NULL) msg = "error object is not a string";
lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
- lua_tostring(L, -1));
+ msg);
return 0; /* return to Lua to abort */
}
+/*
+** Emit a warning. '*warnstate' means:
+** 0 - warning system is off;
+** 1 - ready to start a new message;
+** 2 - previous message is to be continued.
+*/
+static void warnf (void *ud, const char *message, int tocont) {
+ int *warnstate = (int *)ud;
+ if (*warnstate != 2 && !tocont && *message == '@') { /* control message? */
+ if (strcmp(message, "@off") == 0)
+ *warnstate = 0;
+ else if (strcmp(message, "@on") == 0)
+ *warnstate = 1;
+ return;
+ }
+ else if (*warnstate == 0) /* warnings off? */
+ return;
+ if (*warnstate == 1) /* previous message was the last? */
+ lua_writestringerror("%s", "Lua warning: "); /* start a new warning */
+ lua_writestringerror("%s", message); /* write message */
+ if (tocont) /* not the last part? */
+ *warnstate = 2; /* to be continued */
+ else { /* last part */
+ lua_writestringerror("%s", "\n"); /* finish message with end-of-line */
+ *warnstate = 1; /* ready to start a new message */
+ }
+}
+
+
LUALIB_API lua_State *luaL_newstate (void) {
lua_State *L = lua_newstate(l_alloc, NULL);
- if (L) lua_atpanic(L, &panic);
+ if (L) {
+ int *warnstate; /* space for warning state */
+ lua_atpanic(L, &panic);
+ warnstate = (int *)lua_newuserdatauv(L, sizeof(int), 0);
+ luaL_ref(L, LUA_REGISTRYINDEX); /* make sure it won't be collected */
+ *warnstate = 0; /* default is warnings off */
+ lua_setwarnf(L, warnf, warnstate);
+ }
return L;
}
LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {
- const lua_Number *v = lua_version(L);
+ lua_Number v = lua_version(L);
if (sz != LUAL_NUMSIZES) /* check numeric types */
luaL_error(L, "core and library have incompatible numeric types");
- if (v != lua_version(NULL))
- luaL_error(L, "multiple Lua VMs detected");
- else if (*v != ver)
+ else if (v != ver)
luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
- (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)*v);
+ (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)v);
}
diff --git a/src/lauxlib.h b/src/lauxlib.h
index 9857d3a..59fef6a 100644
--- a/src/lauxlib.h
+++ b/src/lauxlib.h
@@ -1,5 +1,5 @@
/*
-** $Id: lauxlib.h,v 1.131.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lauxlib.h $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
@@ -15,6 +15,12 @@
#include "lua.h"
+/* global table */
+#define LUA_GNAME "_G"
+
+
+typedef struct luaL_Buffer luaL_Buffer;
+
/* extra error code for 'luaL_loadfilex' */
#define LUA_ERRFILE (LUA_ERRERR+1)
@@ -44,6 +50,7 @@
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 arg, const char *extramsg);
+LUALIB_API int (luaL_typeerror) (lua_State *L, int arg, const char *tname);
LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,
size_t *l);
LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,
@@ -73,6 +80,7 @@
LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
+
/* predefined references */
#define LUA_NOREF (-2)
#define LUA_REFNIL (-1)
@@ -93,8 +101,10 @@
LUALIB_API lua_Integer (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_addgsub (luaL_Buffer *b, const char *s,
+ const char *p, const char *r);
+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);
@@ -121,6 +131,10 @@
#define luaL_argcheck(L, cond,arg,extramsg) \
((void)((cond) || luaL_argerror(L, (arg), (extramsg))))
+
+#define luaL_argexpected(L,cond,arg,tname) \
+ ((void)((cond) || luaL_typeerror(L, (arg), (tname))))
+
#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
@@ -139,19 +153,30 @@
#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
+/* push the value used to represent failure/error */
+#define luaL_pushfail(L) lua_pushnil(L)
+
+
/*
** {======================================================
** Generic Buffer manipulation
** =======================================================
*/
-typedef struct luaL_Buffer {
+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;
+ union {
+ LUAI_MAXALIGN; /* ensure maximum alignment for buffer */
+ char b[LUAL_BUFFERSIZE]; /* initial buffer */
+ } init;
+};
+
+
+#define luaL_bufflen(bf) ((bf)->n)
+#define luaL_buffaddr(bf) ((bf)->b)
#define luaL_addchar(B,c) \
@@ -160,6 +185,8 @@
#define luaL_addsize(B,s) ((B)->n += (s))
+#define luaL_buffsub(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);
@@ -197,21 +224,6 @@
/* }====================================================== */
-
-
-/* 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
-
-
/*
** {==================================================================
** "Abstraction Layer" for basic report of messages and errors
diff --git a/src/lbaselib.c b/src/lbaselib.c
index 6460e4f..747fd45 100644
--- a/src/lbaselib.c
+++ b/src/lbaselib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lbaselib.c,v 1.314.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lbaselib.c $
** Basic library
** See Copyright Notice in lua.h
*/
@@ -24,18 +24,12 @@
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;
+ for (i = 1; i <= n; i++) { /* for each argument */
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, "'tostring' must return a string to 'print'");
- if (i>1) lua_writestring("\t", 1);
- lua_writestring(s, l);
+ const char *s = luaL_tolstring(L, i, &l); /* convert it to string */
+ if (i > 1) /* not the first element? */
+ lua_writestring("\t", 1); /* add a tab before it */
+ lua_writestring(s, l); /* print it */
lua_pop(L, 1); /* pop result */
}
lua_writeline();
@@ -43,13 +37,31 @@
}
+/*
+** Creates a warning with all given arguments.
+** Check first for errors; otherwise an error may interrupt
+** the composition of a warning, leaving it unfinished.
+*/
+static int luaB_warn (lua_State *L) {
+ int n = lua_gettop(L); /* number of arguments */
+ int i;
+ luaL_checkstring(L, 1); /* at least one argument */
+ for (i = 2; i <= n; i++)
+ luaL_checkstring(L, i); /* make sure all arguments are strings */
+ for (i = 1; i < n; i++) /* compose warning */
+ lua_warning(L, lua_tostring(L, i), 1);
+ lua_warning(L, lua_tostring(L, n), 0); /* close warning */
+ return 0;
+}
+
+
#define SPACECHARS " \f\n\r\t\v"
static const char *b_str2int (const char *s, int base, lua_Integer *pn) {
lua_Unsigned n = 0;
int neg = 0;
s += strspn(s, SPACECHARS); /* skip initial spaces */
- if (*s == '-') { s++; neg = 1; } /* handle signal */
+ if (*s == '-') { s++; neg = 1; } /* handle sign */
else if (*s == '+') s++;
if (!isalnum((unsigned char)*s)) /* no digit? */
return NULL;
@@ -68,7 +80,6 @@
static int luaB_tonumber (lua_State *L) {
if (lua_isnoneornil(L, 2)) { /* standard conversion? */
- luaL_checkany(L, 1);
if (lua_type(L, 1) == LUA_TNUMBER) { /* already a number? */
lua_settop(L, 1); /* yes; return it */
return 1;
@@ -79,6 +90,7 @@
if (s != NULL && lua_stringtonumber(L, s) == l + 1)
return 1; /* successful conversion to number */
/* else not a number */
+ luaL_checkany(L, 1); /* (but there must be some parameter) */
}
}
else {
@@ -94,7 +106,7 @@
return 1;
} /* else not a number */
} /* else not a number */
- lua_pushnil(L); /* not a number */
+ luaL_pushfail(L); /* not a number */
return 1;
}
@@ -125,8 +137,7 @@
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");
+ luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
if (luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL)
return luaL_error(L, "cannot change a protected metatable");
lua_settop(L, 2);
@@ -145,8 +156,8 @@
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");
+ luaL_argexpected(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
+ "table or string");
lua_pushinteger(L, lua_rawlen(L, 1));
return 1;
}
@@ -170,27 +181,58 @@
}
+static int pushmode (lua_State *L, int oldmode) {
+ lua_pushstring(L, (oldmode == LUA_GCINC) ? "incremental" : "generational");
+ return 1;
+}
+
+
static int luaB_collectgarbage (lua_State *L) {
static const char *const opts[] = {"stop", "restart", "collect",
"count", "step", "setpause", "setstepmul",
- "isrunning", NULL};
+ "isrunning", "generational", "incremental", NULL};
static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
- LUA_GCISRUNNING};
+ LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC};
int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
- int ex = (int)luaL_optinteger(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, (lua_Number)res + ((lua_Number)b/1024));
+ int k = lua_gc(L, o);
+ int b = lua_gc(L, LUA_GCCOUNTB);
+ lua_pushnumber(L, (lua_Number)k + ((lua_Number)b/1024));
return 1;
}
- case LUA_GCSTEP: case LUA_GCISRUNNING: {
+ case LUA_GCSTEP: {
+ int step = (int)luaL_optinteger(L, 2, 0);
+ int res = lua_gc(L, o, step);
lua_pushboolean(L, res);
return 1;
}
+ case LUA_GCSETPAUSE:
+ case LUA_GCSETSTEPMUL: {
+ int p = (int)luaL_optinteger(L, 2, 0);
+ int previous = lua_gc(L, o, p);
+ lua_pushinteger(L, previous);
+ return 1;
+ }
+ case LUA_GCISRUNNING: {
+ int res = lua_gc(L, o);
+ lua_pushboolean(L, res);
+ return 1;
+ }
+ case LUA_GCGEN: {
+ int minormul = (int)luaL_optinteger(L, 2, 0);
+ int majormul = (int)luaL_optinteger(L, 3, 0);
+ return pushmode(L, lua_gc(L, o, minormul, majormul));
+ }
+ case LUA_GCINC: {
+ int pause = (int)luaL_optinteger(L, 2, 0);
+ int stepmul = (int)luaL_optinteger(L, 3, 0);
+ int stepsize = (int)luaL_optinteger(L, 4, 0);
+ return pushmode(L, lua_gc(L, o, pause, stepmul, stepsize));
+ }
default: {
+ int res = lua_gc(L, o);
lua_pushinteger(L, res);
return 1;
}
@@ -206,23 +248,6 @@
}
-static int pairsmeta (lua_State *L, const char *method, int iszero,
- lua_CFunction iter) {
- luaL_checkany(L, 1);
- if (luaL_getmetafield(L, 1, method) == LUA_TNIL) { /* no metamethod? */
- 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 */
@@ -236,7 +261,17 @@
static int luaB_pairs (lua_State *L) {
- return pairsmeta(L, "__pairs", 0, luaB_next);
+ luaL_checkany(L, 1);
+ if (luaL_getmetafield(L, 1, "__pairs") == LUA_TNIL) { /* no metamethod? */
+ lua_pushcfunction(L, luaB_next); /* will return generator, */
+ lua_pushvalue(L, 1); /* state, */
+ lua_pushnil(L); /* and initial value */
+ }
+ else {
+ lua_pushvalue(L, 1); /* argument 'self' to metamethod */
+ lua_call(L, 1, 3); /* get 3 values from metamethod */
+ }
+ return 3;
}
@@ -255,15 +290,11 @@
** (The given "table" may not be a table.)
*/
static int luaB_ipairs (lua_State *L) {
-#if defined(LUA_COMPAT_IPAIRS)
- return pairsmeta(L, "__ipairs", 1, ipairsaux);
-#else
luaL_checkany(L, 1);
lua_pushcfunction(L, ipairsaux); /* iteration function */
lua_pushvalue(L, 1); /* state */
lua_pushinteger(L, 0); /* initial value */
return 3;
-#endif
}
@@ -277,9 +308,9 @@
return 1;
}
else { /* error (message is on top of the stack) */
- lua_pushnil(L);
+ luaL_pushfail(L);
lua_insert(L, -2); /* put before error message */
- return 2; /* return nil plus error message */
+ return 2; /* return fail plus error message */
}
}
@@ -459,13 +490,11 @@
{"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},
+ {"warn", luaB_warn},
{"rawequal", luaB_rawequal},
{"rawlen", luaB_rawlen},
{"rawget", luaB_rawget},
@@ -477,7 +506,7 @@
{"type", luaB_type},
{"xpcall", luaB_xpcall},
/* placeholders */
- {"_G", NULL},
+ {LUA_GNAME, NULL},
{"_VERSION", NULL},
{NULL, NULL}
};
@@ -489,7 +518,7 @@
luaL_setfuncs(L, base_funcs, 0);
/* set global _G */
lua_pushvalue(L, -1);
- lua_setfield(L, -2, "_G");
+ lua_setfield(L, -2, LUA_GNAME);
/* set global _VERSION */
lua_pushliteral(L, LUA_VERSION);
lua_setfield(L, -2, "_VERSION");
diff --git a/src/lbitlib.c b/src/lbitlib.c
deleted file mode 100644
index 4786c0d..0000000
--- a/src/lbitlib.c
+++ /dev/null
@@ -1,233 +0,0 @@
-/*
-** $Id: lbitlib.c,v 1.30.1.1 2017/04/19 17:20:42 roberto Exp $
-** Standard library for bitwise operations
-** See Copyright Notice in lua.h
-*/
-
-#define lbitlib_c
-#define LUA_LIB
-
-#include "lprefix.h"
-
-
-#include "lua.h"
-
-#include "lauxlib.h"
-#include "lualib.h"
-
-
-#if defined(LUA_COMPAT_BITLIB) /* { */
-
-
-#define pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))
-#define checkunsigned(L,i) ((lua_Unsigned)luaL_checkinteger(L,i))
-
-
-/* number of bits to consider in a number */
-#if !defined(LUA_NBITS)
-#define LUA_NBITS 32
-#endif
-
-
-/*
-** a lua_Unsigned with its first LUA_NBITS bits equal to 1. (Shift must
-** be made in two parts to avoid problems when LUA_NBITS is equal to the
-** number of bits in a lua_Unsigned.)
-*/
-#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)))
-
-
-
-static lua_Unsigned andaux (lua_State *L) {
- int i, n = lua_gettop(L);
- lua_Unsigned r = ~(lua_Unsigned)0;
- for (i = 1; i <= n; i++)
- r &= checkunsigned(L, i);
- return trim(r);
-}
-
-
-static int b_and (lua_State *L) {
- lua_Unsigned r = andaux(L);
- pushunsigned(L, r);
- return 1;
-}
-
-
-static int b_test (lua_State *L) {
- lua_Unsigned r = andaux(L);
- lua_pushboolean(L, r != 0);
- return 1;
-}
-
-
-static int b_or (lua_State *L) {
- int i, n = lua_gettop(L);
- lua_Unsigned r = 0;
- for (i = 1; i <= n; i++)
- r |= checkunsigned(L, i);
- pushunsigned(L, trim(r));
- return 1;
-}
-
-
-static int b_xor (lua_State *L) {
- int i, n = lua_gettop(L);
- lua_Unsigned r = 0;
- for (i = 1; i <= n; i++)
- r ^= checkunsigned(L, i);
- pushunsigned(L, trim(r));
- return 1;
-}
-
-
-static int b_not (lua_State *L) {
- lua_Unsigned r = ~checkunsigned(L, 1);
- pushunsigned(L, trim(r));
- return 1;
-}
-
-
-static int b_shift (lua_State *L, lua_Unsigned r, lua_Integer 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);
- }
- pushunsigned(L, r);
- return 1;
-}
-
-
-static int b_lshift (lua_State *L) {
- return b_shift(L, checkunsigned(L, 1), luaL_checkinteger(L, 2));
-}
-
-
-static int b_rshift (lua_State *L) {
- return b_shift(L, checkunsigned(L, 1), -luaL_checkinteger(L, 2));
-}
-
-
-static int b_arshift (lua_State *L) {
- lua_Unsigned r = checkunsigned(L, 1);
- lua_Integer i = luaL_checkinteger(L, 2);
- if (i < 0 || !(r & ((lua_Unsigned)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) | ~(trim(~(lua_Unsigned)0) >> i)); /* add signal bit */
- pushunsigned(L, r);
- return 1;
- }
-}
-
-
-static int b_rot (lua_State *L, lua_Integer d) {
- lua_Unsigned r = checkunsigned(L, 1);
- int i = d & (LUA_NBITS - 1); /* i = d % NBITS */
- r = trim(r);
- if (i != 0) /* avoid undefined shift of LUA_NBITS when i == 0 */
- r = (r << i) | (r >> (LUA_NBITS - i));
- pushunsigned(L, trim(r));
- return 1;
-}
-
-
-static int b_lrot (lua_State *L) {
- return b_rot(L, luaL_checkinteger(L, 2));
-}
-
-
-static int b_rrot (lua_State *L) {
- return b_rot(L, -luaL_checkinteger(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) {
- lua_Integer f = luaL_checkinteger(L, farg);
- lua_Integer w = luaL_optinteger(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 = (int)w;
- return (int)f;
-}
-
-
-static int b_extract (lua_State *L) {
- int w;
- lua_Unsigned r = trim(checkunsigned(L, 1));
- int f = fieldargs(L, 2, &w);
- r = (r >> f) & mask(w);
- pushunsigned(L, r);
- return 1;
-}
-
-
-static int b_replace (lua_State *L) {
- int w;
- lua_Unsigned r = trim(checkunsigned(L, 1));
- lua_Unsigned v = trim(checkunsigned(L, 2));
- int f = fieldargs(L, 3, &w);
- lua_Unsigned m = mask(w);
- r = (r & ~(m << f)) | ((v & m) << f);
- 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;
-}
-
-
-#else /* }{ */
-
-
-LUAMOD_API int luaopen_bit32 (lua_State *L) {
- return luaL_error(L, "library 'bit32' has been deprecated");
-}
-
-#endif /* } */
diff --git a/src/lcode.c b/src/lcode.c
index 12619f5..6f241c9 100644
--- a/src/lcode.c
+++ b/src/lcode.c
@@ -1,5 +1,5 @@
/*
-** $Id: lcode.c,v 2.112.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lcode.c $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
@@ -10,6 +10,7 @@
#include "lprefix.h"
+#include <limits.h>
#include <math.h>
#include <stdlib.h>
@@ -36,11 +37,22 @@
#define hasjumps(e) ((e)->t != (e)->f)
+static int codesJ (FuncState *fs, OpCode o, int sj, int k);
+
+
+
+/* semantic error */
+l_noret luaK_semerror (LexState *ls, const char *msg) {
+ ls->t.token = 0; /* remove "near <token>" from final message */
+ luaX_syntaxerror(ls, msg);
+}
+
+
/*
** If expression is a numeric constant, fills 'v' with its value
** and returns 1. Otherwise, returns 0.
*/
-static int tonumeral(const expdesc *e, TValue *v) {
+static int tonumeral (const expdesc *e, TValue *v) {
if (hasjumps(e))
return 0; /* not a numeral */
switch (e->k) {
@@ -56,27 +68,78 @@
/*
+** Get the constant value from a constant expression
+*/
+static TValue *const2val (FuncState *fs, const expdesc *e) {
+ lua_assert(e->k == VCONST);
+ return &fs->ls->dyd->actvar.arr[e->u.info].k;
+}
+
+
+/*
+** If expression is a constant, fills 'v' with its value
+** and returns 1. Otherwise, returns 0.
+*/
+int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v) {
+ if (hasjumps(e))
+ return 0; /* not a constant */
+ switch (e->k) {
+ case VFALSE:
+ setbfvalue(v);
+ return 1;
+ case VTRUE:
+ setbtvalue(v);
+ return 1;
+ case VNIL:
+ setnilvalue(v);
+ return 1;
+ case VKSTR: {
+ setsvalue(fs->ls->L, v, e->u.strval);
+ return 1;
+ }
+ case VCONST: {
+ setobj(fs->ls->L, v, const2val(fs, e));
+ return 1;
+ }
+ default: return tonumeral(e, v);
+ }
+}
+
+
+/*
+** Return the previous instruction of the current code. If there
+** may be a jump target between the current instruction and the
+** previous one, return an invalid instruction (to avoid wrong
+** optimizations).
+*/
+static Instruction *previousinstruction (FuncState *fs) {
+ static const Instruction invalidinstruction = ~(Instruction)0;
+ if (fs->pc > fs->lasttarget)
+ return &fs->f->code[fs->pc - 1]; /* previous instruction */
+ else
+ return cast(Instruction*, &invalidinstruction);
+}
+
+
+/*
** Create a OP_LOADNIL instruction, but try to optimize: if the previous
** instruction is also OP_LOADNIL and ranges are compatible, adjust
** range of previous instruction instead of emitting a new one. (For
** instance, 'local a; local b' will generate a single opcode.)
*/
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) { /* previous is LOADNIL? */
- int pfrom = GETARG_A(*previous); /* get previous range */
- 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;
- }
+ Instruction *previous = previousinstruction(fs);
+ if (GET_OPCODE(*previous) == OP_LOADNIL) { /* previous is LOADNIL? */
+ int pfrom = GETARG_A(*previous); /* get previous range */
+ 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 */
@@ -88,7 +151,7 @@
** a list of jumps.
*/
static int getjump (FuncState *fs, int pc) {
- int offset = GETARG_sBx(fs->f->code[pc]);
+ int offset = GETARG_sJ(fs->f->code[pc]);
if (offset == NO_JUMP) /* point to itself represents end of list */
return NO_JUMP; /* end of list */
else
@@ -104,9 +167,10 @@
Instruction *jmp = &fs->f->code[pc];
int offset = dest - (pc + 1);
lua_assert(dest != NO_JUMP);
- if (abs(offset) > MAXARG_sBx)
+ if (!(-OFFSET_sJ <= offset && offset <= MAXARG_sJ - OFFSET_sJ))
luaX_syntaxerror(fs->ls, "control structure too long");
- SETARG_sBx(*jmp, offset);
+ lua_assert(GET_OPCODE(*jmp) == OP_JMP);
+ SETARG_sJ(*jmp, offset);
}
@@ -129,17 +193,10 @@
/*
** Create a jump instruction and return its position, so its destination
-** can be fixed later (with 'fixjump'). If there are jumps to
-** this position (kept in 'jpc'), link them all together so that
-** 'patchlistaux' will fix all them directly to the final destination.
+** can be fixed later (with 'fixjump').
*/
int luaK_jump (FuncState *fs) {
- int jpc = fs->jpc; /* save list of jumps to here */
- int j;
- fs->jpc = NO_JUMP; /* no more jumps to here */
- j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP);
- luaK_concat(fs, &j, jpc); /* keep them on hold */
- return j;
+ return codesJ(fs, OP_JMP, NO_JUMP, 0);
}
@@ -147,7 +204,13 @@
** Code a 'return' instruction
*/
void luaK_ret (FuncState *fs, int first, int nret) {
- luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);
+ OpCode op;
+ switch (nret) {
+ case 0: op = OP_RETURN0; break;
+ case 1: op = OP_RETURN1; break;
+ default: op = OP_RETURN; break;
+ }
+ luaK_codeABC(fs, op, first, nret + 1, 0);
}
@@ -155,8 +218,8 @@
** Code a "conditional jump", that is, a test or comparison opcode
** followed by a jump. Return jump position.
*/
-static int condjump (FuncState *fs, OpCode op, int A, int B, int C) {
- luaK_codeABC(fs, op, A, B, C);
+static int condjump (FuncState *fs, OpCode op, int A, int B, int C, int k) {
+ luaK_codeABCk(fs, op, A, B, C, k);
return luaK_jump(fs);
}
@@ -201,7 +264,7 @@
else {
/* no register to put value or register already has the value;
change instruction to simple test */
- *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i));
+ *i = CREATE_ABCk(OP_TEST, GETARG_B(*i), 0, 0, GETARG_k(*i));
}
return 1;
}
@@ -235,54 +298,88 @@
/*
-** Ensure all pending jumps to current position are fixed (jumping
-** to current position with no values) and reset list of pending
-** jumps
-*/
-static void dischargejpc (FuncState *fs) {
- patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc);
- fs->jpc = NO_JUMP;
-}
-
-
-/*
-** Add elements in 'list' to list of pending jumps to "here"
-** (current position)
-*/
-void luaK_patchtohere (FuncState *fs, int list) {
- luaK_getlabel(fs); /* mark "here" as a jump target */
- luaK_concat(fs, &fs->jpc, list);
-}
-
-
-/*
** Path all jumps in 'list' to jump to 'target'.
** (The assert means that we cannot fix a jump to a forward address
** because we only know addresses once code is generated.)
*/
void luaK_patchlist (FuncState *fs, int list, int target) {
- if (target == fs->pc) /* 'target' is current position? */
- luaK_patchtohere(fs, list); /* add list to pending jumps */
- else {
- lua_assert(target < fs->pc);
- patchlistaux(fs, list, target, NO_REG, target);
+ lua_assert(target <= fs->pc);
+ patchlistaux(fs, list, target, NO_REG, target);
+}
+
+
+void luaK_patchtohere (FuncState *fs, int list) {
+ int hr = luaK_getlabel(fs); /* mark "here" as a jump target */
+ luaK_patchlist(fs, list, hr);
+}
+
+
+/*
+** MAXimum number of successive Instructions WiTHout ABSolute line
+** information.
+*/
+#if !defined(MAXIWTHABS)
+#define MAXIWTHABS 120
+#endif
+
+
+/* limit for difference between lines in relative line info. */
+#define LIMLINEDIFF 0x80
+
+
+/*
+** Save line info for a new instruction. If difference from last line
+** does not fit in a byte, of after that many instructions, save a new
+** absolute line info; (in that case, the special value 'ABSLINEINFO'
+** in 'lineinfo' signals the existence of this absolute information.)
+** Otherwise, store the difference from last line in 'lineinfo'.
+*/
+static void savelineinfo (FuncState *fs, Proto *f, int line) {
+ int linedif = line - fs->previousline;
+ int pc = fs->pc - 1; /* last instruction coded */
+ if (abs(linedif) >= LIMLINEDIFF || fs->iwthabs++ > MAXIWTHABS) {
+ luaM_growvector(fs->ls->L, f->abslineinfo, fs->nabslineinfo,
+ f->sizeabslineinfo, AbsLineInfo, MAX_INT, "lines");
+ f->abslineinfo[fs->nabslineinfo].pc = pc;
+ f->abslineinfo[fs->nabslineinfo++].line = line;
+ linedif = ABSLINEINFO; /* signal that there is absolute information */
+ fs->iwthabs = 0; /* restart counter */
+ }
+ luaM_growvector(fs->ls->L, f->lineinfo, pc, f->sizelineinfo, ls_byte,
+ MAX_INT, "opcodes");
+ f->lineinfo[pc] = linedif;
+ fs->previousline = line; /* last line saved */
+}
+
+
+/*
+** Remove line information from the last instruction.
+** If line information for that instruction is absolute, set 'iwthabs'
+** above its max to force the new (replacing) instruction to have
+** absolute line info, too.
+*/
+static void removelastlineinfo (FuncState *fs) {
+ Proto *f = fs->f;
+ int pc = fs->pc - 1; /* last instruction coded */
+ if (f->lineinfo[pc] != ABSLINEINFO) { /* relative line info? */
+ fs->previousline -= f->lineinfo[pc]; /* correct last line saved */
+ fs->iwthabs--; /* undo previous increment */
+ }
+ else { /* absolute line information */
+ lua_assert(f->abslineinfo[fs->nabslineinfo - 1].pc == pc);
+ fs->nabslineinfo--; /* remove it */
+ fs->iwthabs = MAXIWTHABS + 1; /* force next line info to be absolute */
}
}
/*
-** Path all jumps in 'list' to close upvalues up to given 'level'
-** (The assertion checks that jumps either were closing nothing
-** or were closing higher levels, from inner blocks.)
+** Remove the last instruction created, correcting line information
+** accordingly.
*/
-void luaK_patchclose (FuncState *fs, int list, int level) {
- level++; /* argument is +1 to reserve 0 as non-op */
- for (; list != NO_JUMP; list = 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);
- }
+static void removelastinstruction (FuncState *fs) {
+ removelastlineinfo(fs);
+ fs->pc--;
}
@@ -290,18 +387,14 @@
** Emit instruction 'i', checking for array sizes and saving also its
** line information. Return 'i' position.
*/
-static int luaK_code (FuncState *fs, Instruction i) {
+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++;
+ f->code[fs->pc++] = i;
+ savelineinfo(fs, f, fs->ls->lastline);
+ return fs->pc - 1; /* index of new instruction */
}
@@ -309,12 +402,11 @@
** Format and emit an 'iABC' instruction. (Assertions check consistency
** of parameters versus opcode.)
*/
-int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {
+int luaK_codeABCk (FuncState *fs, OpCode o, int a, int b, int c, int k) {
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));
+ lua_assert(a <= MAXARG_A && b <= MAXARG_B &&
+ c <= MAXARG_C && (k & ~1) == 0);
+ return luaK_code(fs, CREATE_ABCk(o, a, b, c, k));
}
@@ -322,14 +414,35 @@
** Format and emit an 'iABx' instruction.
*/
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(getOpMode(o) == iABx);
lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);
return luaK_code(fs, CREATE_ABx(o, a, bc));
}
/*
+** Format and emit an 'iAsBx' instruction.
+*/
+int luaK_codeAsBx (FuncState *fs, OpCode o, int a, int bc) {
+ unsigned int b = bc + OFFSET_sBx;
+ lua_assert(getOpMode(o) == iAsBx);
+ lua_assert(a <= MAXARG_A && b <= MAXARG_Bx);
+ return luaK_code(fs, CREATE_ABx(o, a, b));
+}
+
+
+/*
+** Format and emit an 'isJ' instruction.
+*/
+static int codesJ (FuncState *fs, OpCode o, int sj, int k) {
+ unsigned int j = sj + OFFSET_sJ;
+ lua_assert(getOpMode(o) == isJ);
+ lua_assert(j <= MAXARG_sJ && (k & ~1) == 0);
+ return luaK_code(fs, CREATE_sJ(o, j, k));
+}
+
+
+/*
** Emit an "extra argument" instruction (format 'iAx')
*/
static int codeextraarg (FuncState *fs, int a) {
@@ -343,7 +456,7 @@
** (if constant index 'k' fits in 18 bits) or an 'OP_LOADKX'
** instruction with "extra argument".
*/
-int luaK_codek (FuncState *fs, int reg, int k) {
+static int luaK_codek (FuncState *fs, int reg, int k) {
if (k <= MAXARG_Bx)
return luaK_codeABx(fs, OP_LOADK, reg, k);
else {
@@ -384,7 +497,7 @@
)
*/
static void freereg (FuncState *fs, int reg) {
- if (!ISK(reg) && reg >= fs->nactvar) {
+ if (reg >= luaY_nvarstack(fs)) {
fs->freereg--;
lua_assert(reg == fs->freereg);
}
@@ -392,6 +505,21 @@
/*
+** Free two registers in proper order
+*/
+static void freeregs (FuncState *fs, int r1, int r2) {
+ if (r1 > r2) {
+ freereg(fs, r1);
+ freereg(fs, r2);
+ }
+ else {
+ freereg(fs, r2);
+ freereg(fs, r1);
+ }
+}
+
+
+/*
** Free register used by expression 'e' (if any)
*/
static void freeexp (FuncState *fs, expdesc *e) {
@@ -407,14 +535,7 @@
static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) {
int r1 = (e1->k == VNONRELOC) ? e1->u.info : -1;
int r2 = (e2->k == VNONRELOC) ? e2->u.info : -1;
- if (r1 > r2) {
- freereg(fs, r1);
- freereg(fs, r2);
- }
- else {
- freereg(fs, r2);
- freereg(fs, r1);
- }
+ freeregs(fs, r1, r2);
}
@@ -433,7 +554,7 @@
if (ttisinteger(idx)) { /* is there an index there? */
k = cast_int(ivalue(idx));
/* correct value? (warning: must distinguish floats from integers!) */
- if (k < fs->nk && ttype(&f->k[k]) == ttype(v) &&
+ if (k < fs->nk && ttypetag(&f->k[k]) == ttypetag(v) &&
luaV_rawequalobj(&f->k[k], v))
return k; /* reuse index */
}
@@ -455,7 +576,7 @@
/*
** Add a string to list of constants and return its index.
*/
-int luaK_stringK (FuncState *fs, TString *s) {
+static int stringK (FuncState *fs, TString *s) {
TValue o;
setsvalue(fs->ls->L, &o, s);
return addk(fs, &o, &o); /* use string itself as key */
@@ -468,9 +589,9 @@
** same value; conversion to 'void*' is used only for hashing, so there
** are no "precision" problems.
*/
-int luaK_intK (FuncState *fs, lua_Integer n) {
+static int luaK_intK (FuncState *fs, lua_Integer n) {
TValue k, o;
- setpvalue(&k, cast(void*, cast(size_t, n)));
+ setpvalue(&k, cast_voidp(cast_sizet(n)));
setivalue(&o, n);
return addk(fs, &k, &o);
}
@@ -486,11 +607,21 @@
/*
-** Add a boolean to list of constants and return its index.
+** Add a false to list of constants and return its index.
*/
-static int boolK (FuncState *fs, int b) {
+static int boolF (FuncState *fs) {
TValue o;
- setbvalue(&o, b);
+ setbfvalue(&o);
+ return addk(fs, &o, &o); /* use boolean itself as key */
+}
+
+
+/*
+** Add a true to list of constants and return its index.
+*/
+static int boolT (FuncState *fs) {
+ TValue o;
+ setbtvalue(&o);
return addk(fs, &o, &o); /* use boolean itself as key */
}
@@ -508,21 +639,92 @@
/*
+** Check whether 'i' can be stored in an 'sC' operand. Equivalent to
+** (0 <= int2sC(i) && int2sC(i) <= MAXARG_C) but without risk of
+** overflows in the hidden addition inside 'int2sC'.
+*/
+static int fitsC (lua_Integer i) {
+ return (l_castS2U(i) + OFFSET_sC <= cast_uint(MAXARG_C));
+}
+
+
+/*
+** Check whether 'i' can be stored in an 'sBx' operand.
+*/
+static int fitsBx (lua_Integer i) {
+ return (-OFFSET_sBx <= i && i <= MAXARG_Bx - OFFSET_sBx);
+}
+
+
+void luaK_int (FuncState *fs, int reg, lua_Integer i) {
+ if (fitsBx(i))
+ luaK_codeAsBx(fs, OP_LOADI, reg, cast_int(i));
+ else
+ luaK_codek(fs, reg, luaK_intK(fs, i));
+}
+
+
+static void luaK_float (FuncState *fs, int reg, lua_Number f) {
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ieq) && fitsBx(fi))
+ luaK_codeAsBx(fs, OP_LOADF, reg, cast_int(fi));
+ else
+ luaK_codek(fs, reg, luaK_numberK(fs, f));
+}
+
+
+/*
+** Convert a constant in 'v' into an expression description 'e'
+*/
+static void const2exp (TValue *v, expdesc *e) {
+ switch (ttypetag(v)) {
+ case LUA_VNUMINT:
+ e->k = VKINT; e->u.ival = ivalue(v);
+ break;
+ case LUA_VNUMFLT:
+ e->k = VKFLT; e->u.nval = fltvalue(v);
+ break;
+ case LUA_VFALSE:
+ e->k = VFALSE;
+ break;
+ case LUA_VTRUE:
+ e->k = VTRUE;
+ break;
+ case LUA_VNIL:
+ e->k = VNIL;
+ break;
+ case LUA_VSHRSTR: case LUA_VLNGSTR:
+ e->k = VKSTR; e->u.strval = tsvalue(v);
+ break;
+ default: lua_assert(0);
+ }
+}
+
+
+/*
** Fix an expression to return the number of results 'nresults'.
-** Either 'e' is a multi-ret expression (function call or vararg)
-** or 'nresults' is LUA_MULTRET (as any expression can satisfy that).
+** 'e' must be a multi-ret expression (function call or vararg).
*/
void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
- if (e->k == VCALL) { /* expression is an open function call? */
- SETARG_C(getinstruction(fs, e), nresults + 1);
- }
- else if (e->k == VVARARG) {
- Instruction *pc = &getinstruction(fs, e);
- SETARG_B(*pc, nresults + 1);
+ Instruction *pc = &getinstruction(fs, e);
+ if (e->k == VCALL) /* expression is an open function call? */
+ SETARG_C(*pc, nresults + 1);
+ else {
+ lua_assert(e->k == VVARARG);
+ SETARG_C(*pc, nresults + 1);
SETARG_A(*pc, fs->freereg);
luaK_reserveregs(fs, 1);
}
- else lua_assert(nresults == LUA_MULTRET);
+}
+
+
+/*
+** Convert a VKSTR to a VK
+*/
+static void str2K (FuncState *fs, expdesc *e) {
+ lua_assert(e->k == VKSTR);
+ e->u.info = stringK(fs, e->u.strval);
+ e->k = VK;
}
@@ -532,7 +734,7 @@
** vararg), it already returns one result, so nothing needs to be done.
** Function calls become VNONRELOC expressions (as its result comes
** fixed in the base register of the call), while vararg expressions
-** become VRELOCABLE (as OP_VARARG puts its results where it wants).
+** become VRELOC (as OP_VARARG puts its results where it wants).
** (Calls are created returning one result, so that does not need
** to be fixed.)
*/
@@ -544,39 +746,53 @@
e->u.info = GETARG_A(getinstruction(fs, e));
}
else if (e->k == VVARARG) {
- SETARG_B(getinstruction(fs, e), 2);
- e->k = VRELOCABLE; /* can relocate its simple result */
+ SETARG_C(getinstruction(fs, e), 2);
+ e->k = VRELOC; /* can relocate its simple result */
}
}
/*
-** Ensure that expression 'e' is not a variable.
+** Ensure that expression 'e' is not a variable (nor a constant).
+** (Expression still may have jump lists.)
*/
void luaK_dischargevars (FuncState *fs, expdesc *e) {
switch (e->k) {
+ case VCONST: {
+ const2exp(const2val(fs, e), e);
+ break;
+ }
case VLOCAL: { /* already in a register */
+ e->u.info = e->u.var.sidx;
e->k = VNONRELOC; /* becomes a non-relocatable value */
break;
}
case VUPVAL: { /* move value to some (pending) register */
e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);
- e->k = VRELOCABLE;
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXUP: {
+ e->u.info = luaK_codeABC(fs, OP_GETTABUP, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXI: {
+ freereg(fs, e->u.ind.t);
+ e->u.info = luaK_codeABC(fs, OP_GETI, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
+ break;
+ }
+ case VINDEXSTR: {
+ freereg(fs, e->u.ind.t);
+ e->u.info = luaK_codeABC(fs, OP_GETFIELD, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
break;
}
case VINDEXED: {
- OpCode op;
- freereg(fs, e->u.ind.idx);
- if (e->u.ind.vt == VLOCAL) { /* is 't' in a register? */
- freereg(fs, e->u.ind.t);
- op = OP_GETTABLE;
- }
- else {
- lua_assert(e->u.ind.vt == VUPVAL);
- op = OP_GETTABUP; /* 't' is in an upvalue */
- }
- e->u.info = luaK_codeABC(fs, op, 0, e->u.ind.t, e->u.ind.idx);
- e->k = VRELOCABLE;
+ freeregs(fs, e->u.ind.t, e->u.ind.idx);
+ e->u.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.ind.t, e->u.ind.idx);
+ e->k = VRELOC;
break;
}
case VVARARG: case VCALL: {
@@ -591,6 +807,7 @@
/*
** Ensures expression value is in register 'reg' (and therefore
** 'e' will become a non-relocatable expression).
+** (Expression still may have jump lists.)
*/
static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
luaK_dischargevars(fs, e);
@@ -599,23 +816,30 @@
luaK_nil(fs, reg, 1);
break;
}
- case VFALSE: case VTRUE: {
- luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0);
+ case VFALSE: {
+ luaK_codeABC(fs, OP_LOADFALSE, reg, 0, 0);
break;
}
+ case VTRUE: {
+ luaK_codeABC(fs, OP_LOADTRUE, reg, 0, 0);
+ break;
+ }
+ case VKSTR: {
+ str2K(fs, e);
+ } /* FALLTHROUGH */
case VK: {
luaK_codek(fs, reg, e->u.info);
break;
}
case VKFLT: {
- luaK_codek(fs, reg, luaK_numberK(fs, e->u.nval));
+ luaK_float(fs, reg, e->u.nval);
break;
}
case VKINT: {
- luaK_codek(fs, reg, luaK_intK(fs, e->u.ival));
+ luaK_int(fs, reg, e->u.ival);
break;
}
- case VRELOCABLE: {
+ case VRELOC: {
Instruction *pc = &getinstruction(fs, e);
SETARG_A(*pc, reg); /* instruction will put result in 'reg' */
break;
@@ -637,6 +861,7 @@
/*
** Ensures expression value is in any register.
+** (Expression still may have jump lists.)
*/
static void discharge2anyreg (FuncState *fs, expdesc *e) {
if (e->k != VNONRELOC) { /* no fixed register yet? */
@@ -646,9 +871,9 @@
}
-static int code_loadbool (FuncState *fs, int A, int b, int jump) {
+static int code_loadbool (FuncState *fs, int A, OpCode op) {
luaK_getlabel(fs); /* those instructions may be jump targets */
- return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump);
+ return luaK_codeABC(fs, op, A, 0, 0);
}
@@ -666,8 +891,8 @@
/*
-** Ensures final expression result (including results from its jump
-** lists) is in register 'reg'.
+** Ensures final expression result (which includes results from its
+** jump lists) is in register 'reg'.
** If expression has jumps, need to patch these jumps either to
** its final position or to "load" instructions (for those tests
** that do not produce values).
@@ -682,8 +907,9 @@
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_loadbool(fs, reg, 0, 1);
- p_t = code_loadbool(fs, reg, 1, 0);
+ p_f = code_loadbool(fs, reg, OP_LFALSESKIP); /* skip next inst. */
+ p_t = code_loadbool(fs, reg, OP_LOADTRUE);
+ /* jump around these booleans if 'e' is not a test */
luaK_patchtohere(fs, fj);
}
final = luaK_getlabel(fs);
@@ -697,8 +923,7 @@
/*
-** Ensures final expression result (including results from its jump
-** lists) is in next available register.
+** Ensures final expression result is in next available register.
*/
void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
luaK_dischargevars(fs, e);
@@ -709,15 +934,15 @@
/*
-** Ensures final expression result (including results from its jump
-** lists) is in some (any) register and return that register.
+** Ensures final expression result is in some (any) register
+** and return that register.
*/
int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
luaK_dischargevars(fs, e);
if (e->k == VNONRELOC) { /* expression already has a register? */
if (!hasjumps(e)) /* no jumps? */
return e->u.info; /* result is already in a register */
- if (e->u.info >= fs->nactvar) { /* reg. is not a local? */
+ if (e->u.info >= luaY_nvarstack(fs)) { /* reg. is not a local? */
exp2reg(fs, e, e->u.info); /* put final result in it */
return e->u.info;
}
@@ -728,8 +953,8 @@
/*
-** Ensures final expression result is either in a register or in an
-** upvalue.
+** Ensures final expression result is either in a register
+** or in an upvalue.
*/
void luaK_exp2anyregup (FuncState *fs, expdesc *e) {
if (e->k != VUPVAL || hasjumps(e))
@@ -738,8 +963,8 @@
/*
-** Ensures final expression result is either in a register or it is
-** a constant.
+** Ensures final expression result is either in a register
+** or it is a constant.
*/
void luaK_exp2val (FuncState *fs, expdesc *e) {
if (hasjumps(e))
@@ -750,29 +975,53 @@
/*
+** Try to make 'e' a K expression with an index in the range of R/K
+** indices. Return true iff succeeded.
+*/
+static int luaK_exp2K (FuncState *fs, expdesc *e) {
+ if (!hasjumps(e)) {
+ int info;
+ switch (e->k) { /* move constants to 'k' */
+ case VTRUE: info = boolT(fs); break;
+ case VFALSE: info = boolF(fs); break;
+ case VNIL: info = nilK(fs); break;
+ case VKINT: info = luaK_intK(fs, e->u.ival); break;
+ case VKFLT: info = luaK_numberK(fs, e->u.nval); break;
+ case VKSTR: info = stringK(fs, e->u.strval); break;
+ case VK: info = e->u.info; break;
+ default: return 0; /* not a constant */
+ }
+ if (info <= MAXINDEXRK) { /* does constant fit in 'argC'? */
+ e->k = VK; /* make expression a 'K' expression */
+ e->u.info = info;
+ return 1;
+ }
+ }
+ /* else, expression doesn't fit; leave it unchanged */
+ return 0;
+}
+
+
+/*
** Ensures final expression result is in a valid R/K index
** (that is, it is either in a register or in 'k' with an index
** in the range of R/K indices).
-** Returns R/K index.
+** Returns 1 iff expression is K.
*/
int luaK_exp2RK (FuncState *fs, expdesc *e) {
- luaK_exp2val(fs, e);
- switch (e->k) { /* move constants to 'k' */
- case VTRUE: e->u.info = boolK(fs, 1); goto vk;
- case VFALSE: e->u.info = boolK(fs, 0); goto vk;
- case VNIL: e->u.info = nilK(fs); goto vk;
- case VKINT: e->u.info = luaK_intK(fs, e->u.ival); goto vk;
- case VKFLT: e->u.info = luaK_numberK(fs, e->u.nval); goto vk;
- case VK:
- vk:
- e->k = VK;
- if (e->u.info <= MAXINDEXRK) /* constant fits in 'argC'? */
- return RKASK(e->u.info);
- else break;
- default: break;
+ if (luaK_exp2K(fs, e))
+ return 1;
+ else { /* not a constant in the right range: put it in a register */
+ luaK_exp2anyreg(fs, e);
+ return 0;
}
- /* not a constant in the right range: put it in a register */
- return luaK_exp2anyreg(fs, e);
+}
+
+
+static void codeABRK (FuncState *fs, OpCode o, int a, int b,
+ expdesc *ec) {
+ int k = luaK_exp2RK(fs, ec);
+ luaK_codeABCk(fs, o, a, b, ec->u.info, k);
}
@@ -783,7 +1032,7 @@
switch (var->k) {
case VLOCAL: {
freeexp(fs, ex);
- exp2reg(fs, ex, var->u.info); /* compute 'ex' into proper place */
+ exp2reg(fs, ex, var->u.var.sidx); /* compute 'ex' into proper place */
return;
}
case VUPVAL: {
@@ -791,10 +1040,20 @@
luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);
break;
}
+ case VINDEXUP: {
+ codeABRK(fs, OP_SETTABUP, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ case VINDEXI: {
+ codeABRK(fs, OP_SETI, var->u.ind.t, var->u.ind.idx, ex);
+ break;
+ }
+ case VINDEXSTR: {
+ codeABRK(fs, OP_SETFIELD, var->u.ind.t, var->u.ind.idx, ex);
+ 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);
+ codeABRK(fs, OP_SETTABLE, var->u.ind.t, var->u.ind.idx, ex);
break;
}
default: lua_assert(0); /* invalid var kind to store */
@@ -814,7 +1073,7 @@
e->u.info = fs->freereg; /* base register for op_self */
e->k = VNONRELOC; /* self expression has a fixed register */
luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */
- luaK_codeABC(fs, OP_SELF, e->u.info, ereg, luaK_exp2RK(fs, key));
+ codeABRK(fs, OP_SELF, e->u.info, ereg, key);
freeexp(fs, key);
}
@@ -826,7 +1085,7 @@
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)));
+ SETARG_k(*pc, (GETARG_k(*pc) ^ 1));
}
@@ -837,17 +1096,17 @@
** and removing the 'not'.
*/
static int jumponcond (FuncState *fs, expdesc *e, int cond) {
- if (e->k == VRELOCABLE) {
+ if (e->k == VRELOC) {
Instruction ie = getinstruction(fs, e);
if (GET_OPCODE(ie) == OP_NOT) {
- fs->pc--; /* remove previous OP_NOT */
- return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond);
+ removelastinstruction(fs); /* remove previous OP_NOT */
+ return condjump(fs, OP_TEST, GETARG_B(ie), 0, 0, !cond);
}
/* else go through */
}
discharge2anyreg(fs, e);
freeexp(fs, e);
- return condjump(fs, OP_TESTSET, NO_REG, e->u.info, cond);
+ return condjump(fs, OP_TESTSET, NO_REG, e->u.info, 0, cond);
}
@@ -863,7 +1122,7 @@
pc = e->u.info; /* save jump position */
break;
}
- case VK: case VKFLT: case VKINT: case VTRUE: {
+ case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
pc = NO_JUMP; /* always true; do nothing */
break;
}
@@ -908,13 +1167,12 @@
** Code 'not e', doing constant folding.
*/
static void codenot (FuncState *fs, expdesc *e) {
- luaK_dischargevars(fs, e);
switch (e->k) {
case VNIL: case VFALSE: {
e->k = VTRUE; /* true == not nil == not false */
break;
}
- case VK: case VKFLT: case VKINT: case VTRUE: {
+ case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
e->k = VFALSE; /* false == not "x" == not 0.5 == not 1 == not true */
break;
}
@@ -922,12 +1180,12 @@
negatecondition(fs, e);
break;
}
- case VRELOCABLE:
+ case VRELOC:
case VNONRELOC: {
discharge2anyreg(fs, e);
freeexp(fs, e);
e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);
- e->k = VRELOCABLE;
+ e->k = VRELOC;
break;
}
default: lua_assert(0); /* cannot happen */
@@ -940,15 +1198,94 @@
/*
+** Check whether expression 'e' is a small literal string
+*/
+static int isKstr (FuncState *fs, expdesc *e) {
+ return (e->k == VK && !hasjumps(e) && e->u.info <= MAXARG_B &&
+ ttisshrstring(&fs->f->k[e->u.info]));
+}
+
+/*
+** Check whether expression 'e' is a literal integer.
+*/
+int luaK_isKint (expdesc *e) {
+ return (e->k == VKINT && !hasjumps(e));
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer in
+** proper range to fit in register C
+*/
+static int isCint (expdesc *e) {
+ return luaK_isKint(e) && (l_castS2U(e->u.ival) <= l_castS2U(MAXARG_C));
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer in
+** proper range to fit in register sC
+*/
+static int isSCint (expdesc *e) {
+ return luaK_isKint(e) && fitsC(e->u.ival);
+}
+
+
+/*
+** Check whether expression 'e' is a literal integer or float in
+** proper range to fit in a register (sB or sC).
+*/
+static int isSCnumber (expdesc *e, int *pi, int *isfloat) {
+ lua_Integer i;
+ if (e->k == VKINT)
+ i = e->u.ival;
+ else if (e->k == VKFLT && luaV_flttointeger(e->u.nval, &i, F2Ieq))
+ *isfloat = 1;
+ else
+ return 0; /* not a number */
+ if (!hasjumps(e) && fitsC(i)) {
+ *pi = int2sC(cast_int(i));
+ return 1;
+ }
+ else
+ return 0;
+}
+
+
+/*
** Create expression 't[k]'. 't' must have its final result already in a
-** register or upvalue.
+** register or upvalue. Upvalues can only be indexed by literal strings.
+** Keys can be literal strings in the constant table or arbitrary
+** values in registers.
*/
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
- lua_assert(!hasjumps(t) && (vkisinreg(t->k) || t->k == VUPVAL));
- t->u.ind.t = t->u.info; /* register or upvalue index */
- t->u.ind.idx = luaK_exp2RK(fs, k); /* R/K index for key */
- t->u.ind.vt = (t->k == VUPVAL) ? VUPVAL : VLOCAL;
- t->k = VINDEXED;
+ if (k->k == VKSTR)
+ str2K(fs, k);
+ lua_assert(!hasjumps(t) &&
+ (t->k == VLOCAL || t->k == VNONRELOC || t->k == VUPVAL));
+ if (t->k == VUPVAL && !isKstr(fs, k)) /* upvalue indexed by non 'Kstr'? */
+ luaK_exp2anyreg(fs, t); /* put it in a register */
+ if (t->k == VUPVAL) {
+ t->u.ind.t = t->u.info; /* upvalue index */
+ t->u.ind.idx = k->u.info; /* literal string */
+ t->k = VINDEXUP;
+ }
+ else {
+ /* register index of the table */
+ t->u.ind.t = (t->k == VLOCAL) ? t->u.var.sidx: t->u.info;
+ if (isKstr(fs, k)) {
+ t->u.ind.idx = k->u.info; /* literal string */
+ t->k = VINDEXSTR;
+ }
+ else if (isCint(k)) {
+ t->u.ind.idx = cast_int(k->u.ival); /* int. constant in proper range */
+ t->k = VINDEXI;
+ }
+ else {
+ t->u.ind.idx = luaK_exp2anyreg(fs, k); /* register */
+ t->k = VINDEXED;
+ }
+ }
}
@@ -962,7 +1299,7 @@
case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */
lua_Integer i;
- return (tointeger(v1, &i) && tointeger(v2, &i));
+ return (tointegerns(v1, &i) && tointegerns(v2, &i));
}
case LUA_OPDIV: case LUA_OPIDIV: case LUA_OPMOD: /* division by 0 */
return (nvalue(v2) != 0);
@@ -976,11 +1313,11 @@
** (In this case, 'e1' has the final result.)
*/
static int constfolding (FuncState *fs, int op, expdesc *e1,
- const expdesc *e2) {
+ const expdesc *e2) {
TValue v1, v2, res;
if (!tonumeral(e1, &v1) || !tonumeral(e2, &v2) || !validop(op, &v1, &v2))
return 0; /* non-numeric operands or not safe to fold */
- luaO_arith(fs->ls->L, op, &v1, &v2, &res); /* does operation */
+ luaO_rawarith(fs->ls->L, op, &v1, &v2, &res); /* does operation */
if (ttisinteger(&res)) {
e1->k = VKINT;
e1->u.ival = ivalue(&res);
@@ -1005,7 +1342,7 @@
int r = luaK_exp2anyreg(fs, e); /* opcodes operate only on registers */
freeexp(fs, e);
e->u.info = luaK_codeABC(fs, op, 0, r, 0); /* generate opcode */
- e->k = VRELOCABLE; /* all those operations are relocatable */
+ e->k = VRELOC; /* all those operations are relocatable */
luaK_fixline(fs, line);
}
@@ -1015,61 +1352,212 @@
** (everything but logical operators 'and'/'or' and comparison
** operators).
** Expression to produce final result will be encoded in 'e1'.
-** Because 'luaK_exp2RK' can free registers, its calls must be
-** in "stack order" (that is, first on 'e2', which may have more
-** recent registers to be released).
*/
-static void codebinexpval (FuncState *fs, OpCode op,
- expdesc *e1, expdesc *e2, int line) {
- int rk2 = luaK_exp2RK(fs, e2); /* both operands are "RK" */
- int rk1 = luaK_exp2RK(fs, e1);
+static void finishbinexpval (FuncState *fs, expdesc *e1, expdesc *e2,
+ OpCode op, int v2, int flip, int line,
+ OpCode mmop, TMS event) {
+ int v1 = luaK_exp2anyreg(fs, e1);
+ int pc = luaK_codeABCk(fs, op, 0, v1, v2, 0);
freeexps(fs, e1, e2);
- e1->u.info = luaK_codeABC(fs, op, 0, rk1, rk2); /* generate opcode */
- e1->k = VRELOCABLE; /* all those operations are relocatable */
+ e1->u.info = pc;
+ e1->k = VRELOC; /* all those operations are relocatable */
+ luaK_fixline(fs, line);
+ luaK_codeABCk(fs, mmop, v1, v2, event, flip); /* to call metamethod */
luaK_fixline(fs, line);
}
/*
-** Emit code for comparisons.
-** 'e1' was already put in R/K form by 'luaK_infix'.
+** Emit code for binary expressions that "produce values" over
+** two registers.
*/
-static void codecomp (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) {
- int rk1 = (e1->k == VK) ? RKASK(e1->u.info)
- : check_exp(e1->k == VNONRELOC, e1->u.info);
- int rk2 = luaK_exp2RK(fs, e2);
- freeexps(fs, e1, e2);
- switch (opr) {
- case OPR_NE: { /* '(a ~= b)' ==> 'not (a == b)' */
- e1->u.info = condjump(fs, OP_EQ, 0, rk1, rk2);
- break;
- }
- case OPR_GT: case OPR_GE: {
- /* '(a > b)' ==> '(b < a)'; '(a >= b)' ==> '(b <= a)' */
- OpCode op = cast(OpCode, (opr - OPR_NE) + OP_EQ);
- e1->u.info = condjump(fs, op, 1, rk2, rk1); /* invert operands */
- break;
- }
- default: { /* '==', '<', '<=' use their own opcodes */
- OpCode op = cast(OpCode, (opr - OPR_EQ) + OP_EQ);
- e1->u.info = condjump(fs, op, 1, rk1, rk2);
- break;
+static void codebinexpval (FuncState *fs, OpCode op,
+ expdesc *e1, expdesc *e2, int line) {
+ int v2 = luaK_exp2anyreg(fs, e2); /* both operands are in registers */
+ lua_assert(OP_ADD <= op && op <= OP_SHR);
+ finishbinexpval(fs, e1, e2, op, v2, 0, line, OP_MMBIN,
+ cast(TMS, (op - OP_ADD) + TM_ADD));
+}
+
+
+/*
+** Code binary operators with immediate operands.
+*/
+static void codebini (FuncState *fs, OpCode op,
+ expdesc *e1, expdesc *e2, int flip, int line,
+ TMS event) {
+ int v2 = int2sC(cast_int(e2->u.ival)); /* immediate operand */
+ lua_assert(e2->k == VKINT);
+ finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINI, event);
+}
+
+
+/* Try to code a binary operator negating its second operand.
+** For the metamethod, 2nd operand must keep its original value.
+*/
+static int finishbinexpneg (FuncState *fs, expdesc *e1, expdesc *e2,
+ OpCode op, int line, TMS event) {
+ if (!luaK_isKint(e2))
+ return 0; /* not an integer constant */
+ else {
+ lua_Integer i2 = e2->u.ival;
+ if (!(fitsC(i2) && fitsC(-i2)))
+ return 0; /* not in the proper range */
+ else { /* operating a small integer constant */
+ int v2 = cast_int(i2);
+ finishbinexpval(fs, e1, e2, op, int2sC(-v2), 0, line, OP_MMBINI, event);
+ /* correct metamethod argument */
+ SETARG_B(fs->f->code[fs->pc - 1], int2sC(v2));
+ return 1; /* successfully coded */
}
}
+}
+
+
+static void swapexps (expdesc *e1, expdesc *e2) {
+ expdesc temp = *e1; *e1 = *e2; *e2 = temp; /* swap 'e1' and 'e2' */
+}
+
+
+/*
+** Code arithmetic operators ('+', '-', ...). If second operand is a
+** constant in the proper range, use variant opcodes with K operands.
+*/
+static void codearith (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int flip, int line) {
+ TMS event = cast(TMS, opr + TM_ADD);
+ if (tonumeral(e2, NULL) && luaK_exp2K(fs, e2)) { /* K operand? */
+ int v2 = e2->u.info; /* K index */
+ OpCode op = cast(OpCode, opr + OP_ADDK);
+ finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK, event);
+ }
+ else { /* 'e2' is neither an immediate nor a K operand */
+ OpCode op = cast(OpCode, opr + OP_ADD);
+ if (flip)
+ swapexps(e1, e2); /* back to original order */
+ codebinexpval(fs, op, e1, e2, line); /* use standard operators */
+ }
+}
+
+
+/*
+** Code commutative operators ('+', '*'). If first operand is a
+** numeric constant, change order of operands to try to use an
+** immediate or K operator.
+*/
+static void codecommutative (FuncState *fs, BinOpr op,
+ expdesc *e1, expdesc *e2, int line) {
+ int flip = 0;
+ if (tonumeral(e1, NULL)) { /* is first operand a numeric constant? */
+ swapexps(e1, e2); /* change order */
+ flip = 1;
+ }
+ if (op == OPR_ADD && isSCint(e2)) /* immediate operand? */
+ codebini(fs, cast(OpCode, OP_ADDI), e1, e2, flip, line, TM_ADD);
+ else
+ codearith(fs, op, e1, e2, flip, line);
+}
+
+
+/*
+** Code bitwise operations; they are all associative, so the function
+** tries to put an integer constant as the 2nd operand (a K operand).
+*/
+static void codebitwise (FuncState *fs, BinOpr opr,
+ expdesc *e1, expdesc *e2, int line) {
+ int flip = 0;
+ int v2;
+ OpCode op;
+ if (e1->k == VKINT && luaK_exp2RK(fs, e1)) {
+ swapexps(e1, e2); /* 'e2' will be the constant operand */
+ flip = 1;
+ }
+ else if (!(e2->k == VKINT && luaK_exp2RK(fs, e2))) { /* no constants? */
+ op = cast(OpCode, opr + OP_ADD);
+ codebinexpval(fs, op, e1, e2, line); /* all-register opcodes */
+ return;
+ }
+ v2 = e2->u.info; /* index in K array */
+ op = cast(OpCode, opr + OP_ADDK);
+ lua_assert(ttisinteger(&fs->f->k[v2]));
+ finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK,
+ cast(TMS, opr + TM_ADD));
+}
+
+
+/*
+** Emit code for order comparisons. When using an immediate operand,
+** 'isfloat' tells whether the original value was a float.
+*/
+static void codeorder (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2) {
+ int r1, r2;
+ int im;
+ int isfloat = 0;
+ if (isSCnumber(e2, &im, &isfloat)) {
+ /* use immediate operand */
+ r1 = luaK_exp2anyreg(fs, e1);
+ r2 = im;
+ op = cast(OpCode, (op - OP_LT) + OP_LTI);
+ }
+ else if (isSCnumber(e1, &im, &isfloat)) {
+ /* transform (A < B) to (B > A) and (A <= B) to (B >= A) */
+ r1 = luaK_exp2anyreg(fs, e2);
+ r2 = im;
+ op = (op == OP_LT) ? OP_GTI : OP_GEI;
+ }
+ else { /* regular case, compare two registers */
+ r1 = luaK_exp2anyreg(fs, e1);
+ r2 = luaK_exp2anyreg(fs, e2);
+ }
+ freeexps(fs, e1, e2);
+ e1->u.info = condjump(fs, op, r1, r2, isfloat, 1);
e1->k = VJMP;
}
/*
-** Aplly prefix operation 'op' to expression 'e'.
+** Emit code for equality comparisons ('==', '~=').
+** 'e1' was already put as RK by 'luaK_infix'.
+*/
+static void codeeq (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) {
+ int r1, r2;
+ int im;
+ int isfloat = 0; /* not needed here, but kept for symmetry */
+ OpCode op;
+ if (e1->k != VNONRELOC) {
+ lua_assert(e1->k == VK || e1->k == VKINT || e1->k == VKFLT);
+ swapexps(e1, e2);
+ }
+ r1 = luaK_exp2anyreg(fs, e1); /* 1st expression must be in register */
+ if (isSCnumber(e2, &im, &isfloat)) {
+ op = OP_EQI;
+ r2 = im; /* immediate operand */
+ }
+ else if (luaK_exp2RK(fs, e2)) { /* 1st expression is constant? */
+ op = OP_EQK;
+ r2 = e2->u.info; /* constant index */
+ }
+ else {
+ op = OP_EQ; /* will compare two registers */
+ r2 = luaK_exp2anyreg(fs, e2);
+ }
+ freeexps(fs, e1, e2);
+ e1->u.info = condjump(fs, op, r1, r2, isfloat, (opr == OPR_EQ));
+ e1->k = VJMP;
+}
+
+
+/*
+** Apply prefix operation 'op' to expression 'e'.
*/
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) {
static const expdesc ef = {VKINT, {0}, NO_JUMP, NO_JUMP};
+ luaK_dischargevars(fs, e);
switch (op) {
case OPR_MINUS: case OPR_BNOT: /* use 'ef' as fake 2nd operand */
if (constfolding(fs, op + LUA_OPUNM, e, &ef))
break;
- /* FALLTHROUGH */
+ /* else */ /* FALLTHROUGH */
case OPR_LEN:
codeunexpval(fs, cast(OpCode, op + OP_UNM), e, line);
break;
@@ -1084,6 +1572,7 @@
** 2nd operand.
*/
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
+ luaK_dischargevars(fs, v);
switch (op) {
case OPR_AND: {
luaK_goiftrue(fs, v); /* go ahead only if 'v' is true */
@@ -1094,7 +1583,7 @@
break;
}
case OPR_CONCAT: {
- luaK_exp2nextreg(fs, v); /* operand must be on the 'stack' */
+ luaK_exp2nextreg(fs, v); /* operand must be on the stack */
break;
}
case OPR_ADD: case OPR_SUB:
@@ -1103,67 +1592,126 @@
case OPR_BAND: case OPR_BOR: case OPR_BXOR:
case OPR_SHL: case OPR_SHR: {
if (!tonumeral(v, NULL))
- luaK_exp2RK(fs, v);
+ luaK_exp2anyreg(fs, v);
/* else keep numeral, which may be folded with 2nd operand */
break;
}
- default: {
- luaK_exp2RK(fs, v);
+ case OPR_EQ: case OPR_NE: {
+ if (!tonumeral(v, NULL))
+ luaK_exp2RK(fs, v);
+ /* else keep numeral, which may be an immediate operand */
break;
}
+ case OPR_LT: case OPR_LE:
+ case OPR_GT: case OPR_GE: {
+ int dummy, dummy2;
+ if (!isSCnumber(v, &dummy, &dummy2))
+ luaK_exp2anyreg(fs, v);
+ /* else keep numeral, which may be an immediate operand */
+ break;
+ }
+ default: lua_assert(0);
+ }
+}
+
+/*
+** Create code for '(e1 .. e2)'.
+** For '(e1 .. e2.1 .. e2.2)' (which is '(e1 .. (e2.1 .. e2.2))',
+** because concatenation is right associative), merge both CONCATs.
+*/
+static void codeconcat (FuncState *fs, expdesc *e1, expdesc *e2, int line) {
+ Instruction *ie2 = previousinstruction(fs);
+ if (GET_OPCODE(*ie2) == OP_CONCAT) { /* is 'e2' a concatenation? */
+ int n = GETARG_B(*ie2); /* # of elements concatenated in 'e2' */
+ lua_assert(e1->u.info + 1 == GETARG_A(*ie2));
+ freeexp(fs, e2);
+ SETARG_A(*ie2, e1->u.info); /* correct first element ('e1') */
+ SETARG_B(*ie2, n + 1); /* will concatenate one more element */
+ }
+ else { /* 'e2' is not a concatenation */
+ luaK_codeABC(fs, OP_CONCAT, e1->u.info, 2, 0); /* new concat opcode */
+ freeexp(fs, e2);
+ luaK_fixline(fs, line);
}
}
/*
** Finalize code for binary operation, after reading 2nd operand.
-** For '(a .. b .. c)' (which is '(a .. (b .. c))', because
-** concatenation is right associative), merge second CONCAT into first
-** one.
*/
-void luaK_posfix (FuncState *fs, BinOpr op,
+void luaK_posfix (FuncState *fs, BinOpr opr,
expdesc *e1, expdesc *e2, int line) {
- switch (op) {
+ luaK_dischargevars(fs, e2);
+ if (foldbinop(opr) && constfolding(fs, opr + LUA_OPADD, e1, e2))
+ return; /* done by folding */
+ switch (opr) {
case OPR_AND: {
- lua_assert(e1->t == NO_JUMP); /* list closed by 'luK_infix' */
- luaK_dischargevars(fs, e2);
+ lua_assert(e1->t == NO_JUMP); /* list closed by 'luaK_infix' */
luaK_concat(fs, &e2->f, e1->f);
*e1 = *e2;
break;
}
case OPR_OR: {
- lua_assert(e1->f == NO_JUMP); /* list closed by 'luK_infix' */
- luaK_dischargevars(fs, e2);
+ lua_assert(e1->f == NO_JUMP); /* list closed by 'luaK_infix' */
luaK_concat(fs, &e2->t, e1->t);
*e1 = *e2;
break;
}
- case OPR_CONCAT: {
- luaK_exp2val(fs, e2);
- if (e2->k == VRELOCABLE &&
- GET_OPCODE(getinstruction(fs, e2)) == OP_CONCAT) {
- lua_assert(e1->u.info == GETARG_B(getinstruction(fs, e2))-1);
- freeexp(fs, e1);
- SETARG_B(getinstruction(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' */
- codebinexpval(fs, OP_CONCAT, e1, e2, line);
- }
+ case OPR_CONCAT: { /* e1 .. e2 */
+ luaK_exp2nextreg(fs, e2);
+ codeconcat(fs, e1, e2, line);
break;
}
- case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
- case OPR_IDIV: case OPR_MOD: case OPR_POW:
- case OPR_BAND: case OPR_BOR: case OPR_BXOR:
- case OPR_SHL: case OPR_SHR: {
- if (!constfolding(fs, op + LUA_OPADD, e1, e2))
- codebinexpval(fs, cast(OpCode, op + OP_ADD), e1, e2, line);
+ case OPR_ADD: case OPR_MUL: {
+ codecommutative(fs, opr, e1, e2, line);
break;
}
- case OPR_EQ: case OPR_LT: case OPR_LE:
- case OPR_NE: case OPR_GT: case OPR_GE: {
- codecomp(fs, op, e1, e2);
+ case OPR_SUB: {
+ if (finishbinexpneg(fs, e1, e2, OP_ADDI, line, TM_SUB))
+ break; /* coded as (r1 + -I) */
+ /* ELSE */
+ } /* FALLTHROUGH */
+ case OPR_DIV: case OPR_IDIV: case OPR_MOD: case OPR_POW: {
+ codearith(fs, opr, e1, e2, 0, line);
+ break;
+ }
+ case OPR_BAND: case OPR_BOR: case OPR_BXOR: {
+ codebitwise(fs, opr, e1, e2, line);
+ break;
+ }
+ case OPR_SHL: {
+ if (isSCint(e1)) {
+ swapexps(e1, e2);
+ codebini(fs, OP_SHLI, e1, e2, 1, line, TM_SHL); /* I << r2 */
+ }
+ else if (finishbinexpneg(fs, e1, e2, OP_SHRI, line, TM_SHL)) {
+ /* coded as (r1 >> -I) */;
+ }
+ else /* regular case (two registers) */
+ codebinexpval(fs, OP_SHL, e1, e2, line);
+ break;
+ }
+ case OPR_SHR: {
+ if (isSCint(e2))
+ codebini(fs, OP_SHRI, e1, e2, 0, line, TM_SHR); /* r1 >> I */
+ else /* regular case (two registers) */
+ codebinexpval(fs, OP_SHR, e1, e2, line);
+ break;
+ }
+ case OPR_EQ: case OPR_NE: {
+ codeeq(fs, opr, e1, e2);
+ break;
+ }
+ case OPR_LT: case OPR_LE: {
+ OpCode op = cast(OpCode, (opr - OPR_EQ) + OP_EQ);
+ codeorder(fs, op, e1, e2);
+ break;
+ }
+ case OPR_GT: case OPR_GE: {
+ /* '(a > b)' <=> '(b < a)'; '(a >= b)' <=> '(b <= a)' */
+ OpCode op = cast(OpCode, (opr - OPR_NE) + OP_EQ);
+ swapexps(e1, e2);
+ codeorder(fs, op, e1, e2);
break;
}
default: lua_assert(0);
@@ -1172,10 +1720,23 @@
/*
-** Change line information associated with current position.
+** Change line information associated with current position, by removing
+** previous info and adding it again with new line.
*/
void luaK_fixline (FuncState *fs, int line) {
- fs->f->lineinfo[fs->pc - 1] = line;
+ removelastlineinfo(fs);
+ savelineinfo(fs, fs->f, line);
+}
+
+
+void luaK_settablesize (FuncState *fs, int pc, int ra, int asize, int hsize) {
+ Instruction *inst = &fs->f->code[pc];
+ int rb = (hsize != 0) ? luaO_ceillog2(hsize) + 1 : 0; /* hash size */
+ int extra = asize / (MAXARG_C + 1); /* higher bits of array size */
+ int rc = asize % (MAXARG_C + 1); /* lower bits of array size */
+ int k = (extra > 0); /* true iff needs extra argument */
+ *inst = CREATE_ABCk(OP_NEWTABLE, ra, rb, rc, k);
+ *(inst + 1) = CREATE_Ax(OP_EXTRAARG, extra);
}
@@ -1187,17 +1748,67 @@
** table (or LUA_MULTRET to add up to stack top).
*/
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 && tostore <= LFIELDS_PER_FLUSH);
- 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);
+ if (tostore == LUA_MULTRET)
+ tostore = 0;
+ if (nelems <= MAXARG_C)
+ luaK_codeABC(fs, OP_SETLIST, base, tostore, nelems);
+ else {
+ int extra = nelems / (MAXARG_C + 1);
+ nelems %= (MAXARG_C + 1);
+ luaK_codeABCk(fs, OP_SETLIST, base, tostore, nelems, 1);
+ codeextraarg(fs, extra);
}
- else
- luaX_syntaxerror(fs->ls, "constructor too long");
fs->freereg = base + 1; /* free registers with list values */
}
+
+/*
+** return the final target of a jump (skipping jumps to jumps)
+*/
+static int finaltarget (Instruction *code, int i) {
+ int count;
+ for (count = 0; count < 100; count++) { /* avoid infinite loops */
+ Instruction pc = code[i];
+ if (GET_OPCODE(pc) != OP_JMP)
+ break;
+ else
+ i += GETARG_sJ(pc) + 1;
+ }
+ return i;
+}
+
+
+/*
+** Do a final pass over the code of a function, doing small peephole
+** optimizations and adjustments.
+*/
+void luaK_finish (FuncState *fs) {
+ int i;
+ Proto *p = fs->f;
+ for (i = 0; i < fs->pc; i++) {
+ Instruction *pc = &p->code[i];
+ lua_assert(i == 0 || isOT(*(pc - 1)) == isIT(*pc));
+ switch (GET_OPCODE(*pc)) {
+ case OP_RETURN0: case OP_RETURN1: {
+ if (!(fs->needclose || p->is_vararg))
+ break; /* no extra work */
+ /* else use OP_RETURN to do the extra work */
+ SET_OPCODE(*pc, OP_RETURN);
+ } /* FALLTHROUGH */
+ case OP_RETURN: case OP_TAILCALL: {
+ if (fs->needclose)
+ SETARG_k(*pc, 1); /* signal that it needs to close */
+ if (p->is_vararg)
+ SETARG_C(*pc, p->numparams + 1); /* signal that it is vararg */
+ break;
+ }
+ case OP_JMP: {
+ int target = finaltarget(p->code, i);
+ fixjump(fs, i, target);
+ break;
+ }
+ default: break;
+ }
+ }
+}
diff --git a/src/lcode.h b/src/lcode.h
index 882dc9c..3265824 100644
--- a/src/lcode.h
+++ b/src/lcode.h
@@ -1,5 +1,5 @@
/*
-** $Id: lcode.h,v 1.64.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lcode.h $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
@@ -24,40 +24,53 @@
** grep "ORDER OPR" if you change these enums (ORDER OP)
*/
typedef enum BinOpr {
+ /* arithmetic operators */
OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW,
- OPR_DIV,
- OPR_IDIV,
+ OPR_DIV, OPR_IDIV,
+ /* bitwise operators */
OPR_BAND, OPR_BOR, OPR_BXOR,
OPR_SHL, OPR_SHR,
+ /* string operator */
OPR_CONCAT,
+ /* comparison operators */
OPR_EQ, OPR_LT, OPR_LE,
OPR_NE, OPR_GT, OPR_GE,
+ /* logical operators */
OPR_AND, OPR_OR,
OPR_NOBINOPR
} BinOpr;
+/* true if operation is foldable (that is, it is arithmetic or bitwise) */
+#define foldbinop(op) ((op) <= OPR_SHR)
+
+
+#define luaK_codeABC(fs,o,a,b,c) luaK_codeABCk(fs,o,a,b,c,0)
+
+
typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
/* get (pointer to) instruction of given 'expdesc' */
#define getinstruction(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_code (FuncState *fs, Instruction i);
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 int luaK_codeAsBx (FuncState *fs, OpCode o, int A, int Bx);
+LUAI_FUNC int luaK_codeABCk (FuncState *fs, OpCode o, int A,
+ int B, int C, int k);
+LUAI_FUNC int luaK_isKint (expdesc *e);
+LUAI_FUNC int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v);
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_intK (FuncState *fs, lua_Integer n);
+LUAI_FUNC void luaK_int (FuncState *fs, int reg, lua_Integer n);
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);
@@ -75,14 +88,17 @@
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_settablesize (FuncState *fs, int pc,
+ int ra, int asize, int hsize);
LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
+LUAI_FUNC void luaK_finish (FuncState *fs);
+LUAI_FUNC l_noret luaK_semerror (LexState *ls, const char *msg);
#endif
diff --git a/src/lcorolib.c b/src/lcorolib.c
index 0b17af9..7d6e585 100644
--- a/src/lcorolib.c
+++ b/src/lcorolib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lcorolib.c,v 1.10.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lcorolib.c $
** Coroutine Library
** See Copyright Notice in lua.h
*/
@@ -20,25 +20,24 @@
static lua_State *getco (lua_State *L) {
lua_State *co = lua_tothread(L, 1);
- luaL_argcheck(L, co, 1, "thread expected");
+ luaL_argexpected(L, co, 1, "thread");
return co;
}
+/*
+** Resumes a coroutine. Returns the number of results for non-error
+** cases or -1 for errors.
+*/
static int auxresume (lua_State *L, lua_State *co, int narg) {
- int status;
+ int status, nres;
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);
+ status = lua_resume(co, L, narg, &nres);
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");
@@ -75,8 +74,11 @@
lua_State *co = lua_tothread(L, lua_upvalueindex(1));
int r = auxresume(L, co, lua_gettop(L));
if (r < 0) {
+ int stat = lua_status(co);
+ if (stat != LUA_OK && stat != LUA_YIELD)
+ lua_resetthread(co); /* close variables in case of errors */
if (lua_type(L, -1) == LUA_TSTRING) { /* error object is a string? */
- luaL_where(L, 1); /* add extra info */
+ luaL_where(L, 1); /* add extra info, if available */
lua_insert(L, -2);
lua_concat(L, 2);
}
@@ -108,35 +110,48 @@
}
-static int luaB_costatus (lua_State *L) {
- lua_State *co = getco(L);
- if (L == co) lua_pushliteral(L, "running");
+#define COS_RUN 0
+#define COS_DEAD 1
+#define COS_YIELD 2
+#define COS_NORM 3
+
+
+static const char *const statname[] =
+ {"running", "dead", "suspended", "normal"};
+
+
+static int auxstatus (lua_State *L, lua_State *co) {
+ if (L == co) return COS_RUN;
else {
switch (lua_status(co)) {
case LUA_YIELD:
- lua_pushliteral(L, "suspended");
- break;
+ return COS_YIELD;
case LUA_OK: {
lua_Debug ar;
- if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */
- lua_pushliteral(L, "normal"); /* it is running */
+ if (lua_getstack(co, 0, &ar)) /* does it have frames? */
+ return COS_NORM; /* it is running */
else if (lua_gettop(co) == 0)
- lua_pushliteral(L, "dead");
+ return COS_DEAD;
else
- lua_pushliteral(L, "suspended"); /* initial state */
- break;
+ return COS_YIELD; /* initial state */
}
default: /* some error occurred */
- lua_pushliteral(L, "dead");
- break;
+ return COS_DEAD;
}
}
+}
+
+
+static int luaB_costatus (lua_State *L) {
+ lua_State *co = getco(L);
+ lua_pushstring(L, statname[auxstatus(L, co)]);
return 1;
}
static int luaB_yieldable (lua_State *L) {
- lua_pushboolean(L, lua_isyieldable(L));
+ lua_State *co = lua_isnone(L, 1) ? L : getco(L);
+ lua_pushboolean(L, lua_isyieldable(co));
return 1;
}
@@ -148,6 +163,28 @@
}
+static int luaB_close (lua_State *L) {
+ lua_State *co = getco(L);
+ int status = auxstatus(L, co);
+ switch (status) {
+ case COS_DEAD: case COS_YIELD: {
+ status = lua_resetthread(co);
+ if (status == LUA_OK) {
+ lua_pushboolean(L, 1);
+ return 1;
+ }
+ else {
+ lua_pushboolean(L, 0);
+ lua_xmove(co, L, 1); /* copy error message */
+ return 2;
+ }
+ }
+ default: /* normal or running coroutine */
+ return luaL_error(L, "cannot close a %s coroutine", statname[status]);
+ }
+}
+
+
static const luaL_Reg co_funcs[] = {
{"create", luaB_cocreate},
{"resume", luaB_coresume},
@@ -156,6 +193,7 @@
{"wrap", luaB_cowrap},
{"yield", luaB_yield},
{"isyieldable", luaB_yieldable},
+ {"close", luaB_close},
{NULL, NULL}
};
diff --git a/src/lctype.c b/src/lctype.c
index f8ad7a2..9542280 100644
--- a/src/lctype.c
+++ b/src/lctype.c
@@ -1,5 +1,5 @@
/*
-** $Id: lctype.c,v 1.12.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lctype.c $
** 'ctype' functions for Lua
** See Copyright Notice in lua.h
*/
@@ -16,6 +16,15 @@
#include <limits.h>
+
+#if defined (LUA_UCID) /* accept UniCode IDentifiers? */
+/* consider all non-ascii codepoints to be alphabetic */
+#define NONA 0x01
+#else
+#define NONA 0x00 /* default */
+#endif
+
+
LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {
0x00, /* EOZ */
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */
@@ -34,22 +43,22 @@
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,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 8. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 9. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* a. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* b. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ 0x00, 0x00, NONA, NONA, NONA, NONA, NONA, NONA, /* c. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* d. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* e. */
+ NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
+ NONA, NONA, NONA, NONA, NONA, 0x00, 0x00, 0x00, /* f. */
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
#endif /* } */
diff --git a/src/lctype.h b/src/lctype.h
index b09b21a..cbff4d7 100644
--- a/src/lctype.h
+++ b/src/lctype.h
@@ -1,5 +1,5 @@
/*
-** $Id: lctype.h,v 1.12.1.1 2013/04/12 18:48:47 roberto Exp $
+** $Id: lctype.h $
** 'ctype' functions for Lua
** See Copyright Notice in lua.h
*/
@@ -68,7 +68,7 @@
/* two more entries for 0 and -1 (EOZ) */
-LUAI_DDEC const lu_byte luai_ctype_[UCHAR_MAX + 2];
+LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
#else /* }{ */
diff --git a/src/ldblib.c b/src/ldblib.c
index 9d29afb..59eb8f0 100644
--- a/src/ldblib.c
+++ b/src/ldblib.c
@@ -1,5 +1,5 @@
/*
-** $Id: ldblib.c,v 1.151.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ldblib.c $
** Interface from Lua to its debug API
** See Copyright Notice in lua.h
*/
@@ -21,10 +21,10 @@
/*
-** The hook table at registry[&HOOKKEY] maps threads to their current
-** hook function. (We only need the unique address of 'HOOKKEY'.)
+** The hook table at registry[HOOKKEY] maps threads to their current
+** hook function.
*/
-static const int HOOKKEY = 0;
+static const char *const HOOKKEY = "_HOOKKEY";
/*
@@ -55,8 +55,7 @@
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");
+ luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
lua_settop(L, 2);
lua_setmetatable(L, 1);
return 1; /* return 1st argument */
@@ -64,19 +63,24 @@
static int db_getuservalue (lua_State *L) {
+ int n = (int)luaL_optinteger(L, 2, 1);
if (lua_type(L, 1) != LUA_TUSERDATA)
- lua_pushnil(L);
- else
- lua_getuservalue(L, 1);
+ luaL_pushfail(L);
+ else if (lua_getiuservalue(L, 1, n) != LUA_TNONE) {
+ lua_pushboolean(L, 1);
+ return 2;
+ }
return 1;
}
static int db_setuservalue (lua_State *L) {
+ int n = (int)luaL_optinteger(L, 3, 1);
luaL_checktype(L, 1, LUA_TUSERDATA);
luaL_checkany(L, 2);
lua_settop(L, 2);
- lua_setuservalue(L, 1);
+ if (!lua_setiuservalue(L, 1, n))
+ luaL_pushfail(L);
return 1;
}
@@ -146,7 +150,7 @@
lua_Debug ar;
int arg;
lua_State *L1 = getthread(L, &arg);
- const char *options = luaL_optstring(L, arg+2, "flnStu");
+ const char *options = luaL_optstring(L, arg+2, "flnSrtu");
checkstack(L, L1, 3);
if (lua_isfunction(L, arg + 1)) { /* info about a function? */
options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */
@@ -155,7 +159,7 @@
}
else { /* stack level */
if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {
- lua_pushnil(L); /* level out of range */
+ luaL_pushfail(L); /* level out of range */
return 1;
}
}
@@ -163,7 +167,8 @@
return luaL_argerror(L, arg+2, "invalid option");
lua_newtable(L); /* table to collect results */
if (strchr(options, 'S')) {
- settabss(L, "source", ar.source);
+ lua_pushlstring(L, ar.source, ar.srclen);
+ lua_setfield(L, -2, "source");
settabss(L, "short_src", ar.short_src);
settabsi(L, "linedefined", ar.linedefined);
settabsi(L, "lastlinedefined", ar.lastlinedefined);
@@ -180,6 +185,10 @@
settabss(L, "name", ar.name);
settabss(L, "namewhat", ar.namewhat);
}
+ if (strchr(options, 'r')) {
+ settabsi(L, "ftransfer", ar.ftransfer);
+ settabsi(L, "ntransfer", ar.ntransfer);
+ }
if (strchr(options, 't'))
settabsb(L, "istailcall", ar.istailcall);
if (strchr(options, 'L'))
@@ -193,8 +202,6 @@
static int db_getlocal (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
- lua_Debug ar;
- const char *name;
int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */
if (lua_isfunction(L, arg + 1)) { /* function argument? */
lua_pushvalue(L, arg + 1); /* push function */
@@ -202,6 +209,8 @@
return 1; /* return only name (there is no value) */
}
else { /* stack-level argument */
+ lua_Debug ar;
+ const char *name;
int level = (int)luaL_checkinteger(L, arg + 1);
if (!lua_getstack(L1, level, &ar)) /* out of range? */
return luaL_argerror(L, arg+1, "level out of range");
@@ -214,7 +223,7 @@
return 2;
}
else {
- lua_pushnil(L); /* no name (nor value) */
+ luaL_pushfail(L); /* no name (nor value) */
return 1;
}
}
@@ -305,7 +314,7 @@
static void hookf (lua_State *L, lua_Debug *ar) {
static const char *const hooknames[] =
{"call", "return", "line", "count", "tail call"};
- lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY);
+ lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
lua_pushthread(L);
if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */
lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */
@@ -358,14 +367,12 @@
count = (int)luaL_optinteger(L, arg + 3, 0);
func = hookf; mask = makemask(smask, count);
}
- if (lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY) == LUA_TNIL) {
- lua_createtable(L, 0, 2); /* create a hook table */
- lua_pushvalue(L, -1);
- lua_rawsetp(L, LUA_REGISTRYINDEX, &HOOKKEY); /* set it in position */
+ if (!luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)) {
+ /* table just created; initialize it */
lua_pushstring(L, "k");
lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
lua_pushvalue(L, -1);
- lua_setmetatable(L, -2); /* setmetatable(hooktable) = hooktable */
+ lua_setmetatable(L, -2); /* metatable(hooktable) = hooktable */
}
checkstack(L, L1, 1);
lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */
@@ -382,12 +389,14 @@
char buff[5];
int mask = lua_gethookmask(L1);
lua_Hook hook = lua_gethook(L1);
- if (hook == NULL) /* no hook? */
- lua_pushnil(L);
+ if (hook == NULL) { /* no hook? */
+ luaL_pushfail(L);
+ return 1;
+ }
else if (hook != hookf) /* external hook? */
lua_pushliteral(L, "external hook");
else { /* hook table must exist */
- lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY);
+ lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
checkstack(L, L1, 1);
lua_pushthread(L1); lua_xmove(L1, L, 1);
lua_rawget(L, -2); /* 1st result = hooktable[L1] */
@@ -408,7 +417,7 @@
return 0;
if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
lua_pcall(L, 0, 0, 0))
- lua_writestringerror("%s\n", lua_tostring(L, -1));
+ lua_writestringerror("%s\n", luaL_tolstring(L, -1, NULL));
lua_settop(L, 0); /* remove eventual returns */
}
}
@@ -428,6 +437,17 @@
}
+static int db_setcstacklimit (lua_State *L) {
+ int limit = (int)luaL_checkinteger(L, 1);
+ int res = lua_setcstacklimit(L, limit);
+ if (res == 0)
+ lua_pushboolean(L, 0);
+ else
+ lua_pushinteger(L, res);
+ return 1;
+}
+
+
static const luaL_Reg dblib[] = {
{"debug", db_debug},
{"getuservalue", db_getuservalue},
@@ -445,6 +465,7 @@
{"setmetatable", db_setmetatable},
{"setupvalue", db_setupvalue},
{"traceback", db_traceback},
+ {"setcstacklimit", db_setcstacklimit},
{NULL, NULL}
};
diff --git a/src/ldebug.c b/src/ldebug.c
index e138929..afdc2b7 100644
--- a/src/ldebug.c
+++ b/src/ldebug.c
@@ -1,5 +1,5 @@
/*
-** $Id: ldebug.c,v 2.121.1.2 2017/07/10 17:21:50 roberto Exp $
+** $Id: ldebug.c $
** Debug Interface
** See Copyright Notice in lua.h
*/
@@ -31,11 +31,11 @@
-#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL)
+#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_VCCL)
/* Active Lua function (given call info) */
-#define ci_func(ci) (clLvalue((ci)->func))
+#define ci_func(ci) (clLvalue(s2v((ci)->func)))
static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
@@ -48,29 +48,85 @@
}
-static int currentline (CallInfo *ci) {
- return getfuncline(ci_func(ci)->p, currentpc(ci));
-}
-
-
/*
-** If function yielded, its 'func' can be in the 'extra' field. The
-** next function restores 'func' to its correct value for debugging
-** purposes. (It exchanges 'func' and 'extra'; so, when called again,
-** after debugging, it also "re-restores" ** 'func' to its altered value.
+** Get a "base line" to find the line corresponding to an instruction.
+** For that, search the array of absolute line info for the largest saved
+** instruction smaller or equal to the wanted instruction. A special
+** case is when there is no absolute info or the instruction is before
+** the first absolute one.
*/
-static void swapextra (lua_State *L) {
- if (L->status == LUA_YIELD) {
- CallInfo *ci = L->ci; /* get function that yielded */
- StkId temp = ci->func; /* exchange its 'func' and 'extra' values */
- ci->func = restorestack(L, ci->extra);
- ci->extra = savestack(L, temp);
+static int getbaseline (const Proto *f, int pc, int *basepc) {
+ if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
+ *basepc = -1; /* start from the beginning */
+ return f->linedefined;
+ }
+ else {
+ unsigned int i;
+ if (pc >= f->abslineinfo[f->sizeabslineinfo - 1].pc)
+ i = f->sizeabslineinfo - 1; /* instruction is after last saved one */
+ else { /* binary search */
+ unsigned int j = f->sizeabslineinfo - 1; /* pc < anchorlines[j] */
+ i = 0; /* abslineinfo[i] <= pc */
+ while (i < j - 1) {
+ unsigned int m = (j + i) / 2;
+ if (pc >= f->abslineinfo[m].pc)
+ i = m;
+ else
+ j = m;
+ }
+ }
+ *basepc = f->abslineinfo[i].pc;
+ return f->abslineinfo[i].line;
}
}
/*
-** This function can be called asynchronously (e.g. during a signal).
+** Get the line corresponding to instruction 'pc' in function 'f';
+** first gets a base line and from there does the increments until
+** the desired instruction.
+*/
+int luaG_getfuncline (const Proto *f, int pc) {
+ if (f->lineinfo == NULL) /* no debug information? */
+ return -1;
+ else {
+ int basepc;
+ int baseline = getbaseline(f, pc, &basepc);
+ while (basepc++ < pc) { /* walk until given instruction */
+ lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
+ baseline += f->lineinfo[basepc]; /* correct line */
+ }
+ return baseline;
+ }
+}
+
+
+static int getcurrentline (CallInfo *ci) {
+ return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
+}
+
+
+/*
+** Set 'trap' for all active Lua frames.
+** This function can be called during a signal, under "reasonable"
+** assumptions. A new 'ci' is completely linked in the list before it
+** becomes part of the "active" list, and we assume that pointers are
+** atomic; see comment in next function.
+** (A compiler doing interprocedural optimizations could, theoretically,
+** reorder memory writes in such a way that the list could be
+** temporarily broken while inserting a new element. We simply assume it
+** has no good reasons to do that.)
+*/
+static void settraps (CallInfo *ci) {
+ for (; ci != NULL; ci = ci->previous)
+ if (isLua(ci))
+ ci->u.l.trap = 1;
+}
+
+
+/*
+** This function can be called during a signal, under "reasonable"
+** assumptions.
** Fields 'oldpc', 'basehookcount', and 'hookcount' (set by
** 'resethookcount') are for debug only, and it is no problem if they
** get arbitrary values (causes at most one wrong hook call). 'hookmask'
@@ -89,6 +145,8 @@
L->basehookcount = count;
resethookcount(L);
L->hookmask = cast_byte(mask);
+ if (mask)
+ settraps(L->ci); /* to trace inside 'luaV_execute' */
}
@@ -124,7 +182,7 @@
}
-static const char *upvalname (Proto *p, int uv) {
+static const char *upvalname (const Proto *p, int uv) {
TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
if (s == NULL) return "?";
else return getstr(s);
@@ -132,38 +190,37 @@
static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
- int nparams = clLvalue(ci->func)->p->numparams;
- if (n >= cast_int(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 */
+ if (clLvalue(s2v(ci->func))->p->is_vararg) {
+ int nextra = ci->u.l.nextraargs;
+ if (n <= nextra) {
+ *pos = ci->func - nextra + (n - 1);
+ return "(vararg)"; /* generic name for any vararg */
+ }
}
+ return NULL; /* no such vararg */
}
-static const char *findlocal (lua_State *L, CallInfo *ci, int n,
- StkId *pos) {
+const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
+ StkId base = ci->func + 1;
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;
+ else
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 */
+ if (limit - base >= n && n > 0) { /* is 'n' inside 'ci' stack? */
+ /* generic name for any valid slot */
+ name = isLua(ci) ? "(temporary)" : "(C temporary)";
+ }
else
return NULL; /* no name */
}
- *pos = base + (n - 1);
+ if (pos)
+ *pos = base + (n - 1);
return name;
}
@@ -171,22 +228,20 @@
LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
const char *name;
lua_lock(L);
- swapextra(L);
if (ar == NULL) { /* information about non-active function? */
- if (!isLfunction(L->top - 1)) /* not a Lua function? */
+ if (!isLfunction(s2v(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);
+ name = luaF_getlocalname(clLvalue(s2v(L->top - 1))->p, n, 0);
}
else { /* active function; get information through 'ar' */
StkId pos = NULL; /* to avoid warnings */
- name = findlocal(L, ar->i_ci, n, &pos);
+ name = luaG_findlocal(L, ar->i_ci, n, &pos);
if (name) {
- setobj2s(L, L->top, pos);
+ setobjs2s(L, L->top, pos);
api_incr_top(L);
}
}
- swapextra(L);
lua_unlock(L);
return name;
}
@@ -196,13 +251,11 @@
StkId pos = NULL; /* to avoid warnings */
const char *name;
lua_lock(L);
- swapextra(L);
- name = findlocal(L, ar->i_ci, n, &pos);
+ name = luaG_findlocal(L, ar->i_ci, n, &pos);
if (name) {
setobjs2s(L, pos, L->top - 1);
L->top--; /* pop value */
}
- swapextra(L);
lua_unlock(L);
return name;
}
@@ -211,36 +264,55 @@
static void funcinfo (lua_Debug *ar, Closure *cl) {
if (noLuaClosure(cl)) {
ar->source = "=[C]";
+ ar->srclen = LL("=[C]");
ar->linedefined = -1;
ar->lastlinedefined = -1;
ar->what = "C";
}
else {
- Proto *p = cl->l.p;
- ar->source = p->source ? getstr(p->source) : "=?";
+ const Proto *p = cl->l.p;
+ if (p->source) {
+ ar->source = getstr(p->source);
+ ar->srclen = tsslen(p->source);
+ }
+ else {
+ ar->source = "=?";
+ ar->srclen = LL("=?");
+ }
ar->linedefined = p->linedefined;
ar->lastlinedefined = p->lastlinedefined;
ar->what = (ar->linedefined == 0) ? "main" : "Lua";
}
- luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
+ luaO_chunkid(ar->short_src, ar->source, ar->srclen);
+}
+
+
+static int nextline (const Proto *p, int currentline, int pc) {
+ if (p->lineinfo[pc] != ABSLINEINFO)
+ return currentline + p->lineinfo[pc];
+ else
+ return luaG_getfuncline(p, pc);
}
static void collectvalidlines (lua_State *L, Closure *f) {
if (noLuaClosure(f)) {
- setnilvalue(L->top);
+ setnilvalue(s2v(L->top));
api_incr_top(L);
}
else {
int i;
TValue v;
- int *lineinfo = f->l.p->lineinfo;
+ const Proto *p = f->l.p;
+ int currentline = p->linedefined;
Table *t = luaH_new(L); /* new table to store active lines */
- sethvalue(L, L->top, t); /* push it on stack */
+ sethvalue2s(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 */
+ setbtvalue(&v); /* boolean 'true' to be the value of all indices */
+ for (i = 0; i < p->sizelineinfo; i++) { /* for all lines with code */
+ currentline = nextline(p, currentline, i);
+ luaH_setint(L, t, currentline, &v); /* table[line] = true */
+ }
}
}
@@ -269,7 +341,7 @@
break;
}
case 'l': {
- ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;
+ ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
break;
}
case 'u': {
@@ -296,6 +368,15 @@
}
break;
}
+ case 'r': {
+ if (ci == NULL || !(ci->callstatus & CIST_TRAN))
+ ar->ftransfer = ar->ntransfer = 0;
+ else {
+ ar->ftransfer = ci->u2.transferinfo.ftransfer;
+ ar->ntransfer = ci->u2.transferinfo.ntransfer;
+ }
+ break;
+ }
case 'L':
case 'f': /* handled by lua_getinfo */
break;
@@ -310,28 +391,26 @@
int status;
Closure *cl;
CallInfo *ci;
- StkId func;
+ TValue *func;
lua_lock(L);
- swapextra(L);
if (*what == '>') {
ci = NULL;
- func = L->top - 1;
+ func = s2v(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));
+ func = s2v(ci->func);
+ lua_assert(ttisfunction(func));
}
cl = ttisclosure(func) ? clvalue(func) : NULL;
status = auxgetinfo(L, what, ar, cl, ci);
if (strchr(what, 'f')) {
- setobjs2s(L, L->top, func);
+ setobj2s(L, L->top, func);
api_incr_top(L);
}
- swapextra(L); /* correct before option 'L', which can raise a mem. error */
if (strchr(what, 'L'))
collectvalidlines(L, cl);
lua_unlock(L);
@@ -345,30 +424,38 @@
** =======================================================
*/
-static const char *getobjname (Proto *p, int lastpc, int reg,
+static const char *getobjname (const Proto *p, int lastpc, int reg,
const char **name);
/*
-** find a "name" for the RK value 'c'
+** Find a "name" for the constant '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 */
+static void kname (const Proto *p, int c, const char **name) {
+ TValue *kvalue = &p->k[c];
+ *name = (ttisstring(kvalue)) ? svalue(kvalue) : "?";
+}
+
+
+/*
+** Find a "name" for the register 'c'.
+*/
+static void rname (const Proto *p, int pc, int c, const char **name) {
+ const char *what = getobjname(p, pc, c, name); /* search for 'c' */
+ if (!(what && *what == 'c')) /* did not find a constant name? */
+ *name = "?";
+}
+
+
+/*
+** Find a "name" for a 'C' value in an RK instruction.
+*/
+static void rkname (const Proto *p, int pc, Instruction i, const char **name) {
+ int c = GETARG_C(i); /* key index */
+ if (GETARG_k(i)) /* is 'c' a constant? */
+ kname(p, c, name);
+ else /* 'c' is a register */
+ rname(p, pc, c, name);
}
@@ -380,55 +467,70 @@
/*
-** try to find last instruction before 'lastpc' that modified register 'reg'
+** Try to find last instruction before 'lastpc' that modified register 'reg'.
*/
-static int findsetreg (Proto *p, int lastpc, int reg) {
+static int findsetreg (const Proto *p, int lastpc, int reg) {
int pc;
int setreg = -1; /* keep last instruction that changed 'reg' */
int jmptarget = 0; /* any code before this address is conditional */
+ if (testMMMode(GET_OPCODE(p->code[lastpc])))
+ lastpc--; /* previous instruction was not actually executed */
for (pc = 0; pc < lastpc; pc++) {
Instruction i = p->code[pc];
OpCode op = GET_OPCODE(i);
int a = GETARG_A(i);
+ int change; /* true if current instruction changed 'reg' */
switch (op) {
- case OP_LOADNIL: {
+ case OP_LOADNIL: { /* set registers from 'a' to 'a+b' */
int b = GETARG_B(i);
- if (a <= reg && reg <= a + b) /* set registers from 'a' to 'a+b' */
- setreg = filterpc(pc, jmptarget);
+ change = (a <= reg && reg <= a + b);
break;
}
- case OP_TFORCALL: {
- if (reg >= a + 2) /* affect all regs above its base */
- setreg = filterpc(pc, jmptarget);
+ case OP_TFORCALL: { /* affect all regs above its base */
+ change = (reg >= a + 2);
break;
}
case OP_CALL:
- case OP_TAILCALL: {
- if (reg >= a) /* affect all registers above base */
- setreg = filterpc(pc, jmptarget);
+ case OP_TAILCALL: { /* affect all registers above base */
+ change = (reg >= a);
break;
}
- case OP_JMP: {
- int b = GETARG_sBx(i);
+ case OP_JMP: { /* doesn't change registers, but changes 'jmptarget' */
+ int b = GETARG_sJ(i);
int dest = pc + 1 + b;
- /* jump is forward and do not skip 'lastpc'? */
- if (pc < dest && dest <= lastpc) {
- if (dest > jmptarget)
- jmptarget = dest; /* update 'jmptarget' */
- }
+ /* jump does not skip 'lastpc' and is larger than current one? */
+ if (dest <= lastpc && dest > jmptarget)
+ jmptarget = dest; /* update 'jmptarget' */
+ change = 0;
break;
}
- default:
- if (testAMode(op) && reg == a) /* any instruction that set A */
- setreg = filterpc(pc, jmptarget);
+ default: /* any instruction that sets A */
+ change = (testAMode(op) && reg == a);
break;
}
+ if (change)
+ setreg = filterpc(pc, jmptarget);
}
return setreg;
}
-static const char *getobjname (Proto *p, int lastpc, int reg,
+/*
+** Check whether table being indexed by instruction 'i' is the
+** environment '_ENV'
+*/
+static const char *gxf (const Proto *p, int pc, Instruction i, int isup) {
+ int t = GETARG_B(i); /* table index */
+ const char *name; /* name of indexed variable */
+ if (isup) /* is an upvalue? */
+ name = upvalname(p, t);
+ else
+ getobjname(p, pc, t, &name);
+ return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
+}
+
+
+static const char *getobjname (const Proto *p, int lastpc, int reg,
const char **name) {
int pc;
*name = luaF_getlocalname(p, reg + 1, lastpc);
@@ -446,15 +548,24 @@
return getobjname(p, pc, b, name); /* get name for 'b' */
break;
}
- case OP_GETTABUP:
+ case OP_GETTABUP: {
+ int k = GETARG_C(i); /* key index */
+ kname(p, k, name);
+ return gxf(p, pc, i, 1);
+ }
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";
+ rname(p, pc, k, name);
+ return gxf(p, pc, i, 0);
+ }
+ case OP_GETI: {
+ *name = "integer index";
+ return "field";
+ }
+ case OP_GETFIELD: {
+ int k = GETARG_C(i); /* key index */
+ kname(p, k, name);
+ return gxf(p, pc, i, 0);
}
case OP_GETUPVAL: {
*name = upvalname(p, GETARG_B(i));
@@ -471,8 +582,7 @@
break;
}
case OP_SELF: {
- int k = GETARG_C(i); /* key index */
- kname(p, pc, k, name);
+ rkname(p, pc, i, name);
return "method";
}
default: break; /* go through to return NULL */
@@ -491,7 +601,7 @@
static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
const char **name) {
TMS tm = (TMS)0; /* (initial value avoids warnings) */
- Proto *p = ci_func(ci)->p; /* calling function */
+ const Proto *p = ci_func(ci)->p; /* calling function */
int pc = currentpc(ci); /* calling instruction index */
Instruction i = p->code[pc]; /* calling instruction */
if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */
@@ -508,16 +618,14 @@
}
/* other instructions can do calls through metamethods */
case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
+ case OP_GETI: case OP_GETFIELD:
tm = TM_INDEX;
break;
- case OP_SETTABUP: case OP_SETTABLE:
+ case OP_SETTABUP: case OP_SETTABLE: case OP_SETI: case OP_SETFIELD:
tm = TM_NEWINDEX;
break;
- case OP_ADD: case OP_SUB: case OP_MUL: case OP_MOD:
- case OP_POW: case OP_DIV: case OP_IDIV: case OP_BAND:
- case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: {
- int offset = cast_int(GET_OPCODE(i)) - cast_int(OP_ADD); /* ORDER OP */
- tm = cast(TMS, offset + cast_int(TM_ADD)); /* ORDER TM */
+ case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
+ tm = cast(TMS, GETARG_C(i));
break;
}
case OP_UNM: tm = TM_UNM; break;
@@ -525,12 +633,16 @@
case OP_LEN: tm = TM_LEN; break;
case OP_CONCAT: tm = TM_CONCAT; break;
case OP_EQ: tm = TM_EQ; break;
- case OP_LT: tm = TM_LT; break;
- case OP_LE: tm = TM_LE; break;
+ case OP_LT: case OP_LE: case OP_LTI: case OP_LEI:
+ *name = "order"; /* '<=' can call '__lt', etc. */
+ return "metamethod";
+ case OP_CLOSE: case OP_RETURN:
+ *name = "close";
+ return "metamethod";
default:
return NULL; /* cannot find a reasonable name */
}
- *name = getstr(G(L)->tmname[tm]);
+ *name = getstr(G(L)->tmname[tm]) + 2;
return "metamethod";
}
@@ -544,8 +656,9 @@
** checks are ISO C and ensure a correct result.
*/
static int isinstack (CallInfo *ci, const TValue *o) {
- ptrdiff_t i = o - ci->u.l.base;
- return (0 <= i && i < (ci->top - ci->u.l.base) && ci->u.l.base + i == o);
+ StkId base = ci->func + 1;
+ ptrdiff_t i = cast(StkId, o) - base;
+ return (0 <= i && i < (ci->top - base) && s2v(base + i) == o);
}
@@ -576,7 +689,7 @@
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);
+ cast_int(cast(StkId, o) - (ci->func + 1)), &name);
}
return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : "";
}
@@ -588,6 +701,12 @@
}
+l_noret luaG_forerror (lua_State *L, const TValue *o, const char *what) {
+ luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
+ what, luaT_objtypename(L, o));
+}
+
+
l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
luaG_typeerror(L, p1, "concatenate");
@@ -596,8 +715,7 @@
l_noret luaG_opinterror (lua_State *L, const TValue *p1,
const TValue *p2, const char *msg) {
- lua_Number temp;
- if (!tonumber(p1, &temp)) /* first operand is wrong? */
+ if (!ttisnumber(p1)) /* first operand is wrong? */
p2 = p1; /* now second is wrong */
luaG_typeerror(L, p2, msg);
}
@@ -608,7 +726,7 @@
*/
l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
lua_Integer temp;
- if (!tointeger(p1, &temp))
+ if (!tointegerns(p1, &temp))
p2 = p1;
luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
}
@@ -629,7 +747,7 @@
int line) {
char buff[LUA_IDSIZE];
if (src)
- luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
+ luaO_chunkid(buff, getstr(src), tsslen(src));
else { /* no source available; use "?" instead */
buff[0] = '?'; buff[1] = '\0';
}
@@ -640,6 +758,7 @@
l_noret luaG_errormsg (lua_State *L) {
if (L->errfunc != 0) { /* is there an error handling function? */
StkId errfunc = restorestack(L, L->errfunc);
+ lua_assert(ttisfunction(s2v(errfunc)));
setobjs2s(L, L->top, L->top - 1); /* move argument */
setobjs2s(L, L->top - 1, errfunc); /* push function */
L->top++; /* assume EXTRA_STACK */
@@ -658,42 +777,65 @@
msg = luaO_pushvfstring(L, fmt, argp); /* format message */
va_end(argp);
if (isLua(ci)) /* if Lua function, add source:line information */
- luaG_addinfo(L, msg, ci_func(ci)->p->source, currentline(ci));
+ luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
luaG_errormsg(L);
}
-void luaG_traceexec (lua_State *L) {
+/*
+** Check whether new instruction 'newpc' is in a different line from
+** previous instruction 'oldpc'.
+*/
+static int changedline (const Proto *p, int oldpc, int newpc) {
+ while (oldpc++ < newpc) {
+ if (p->lineinfo[oldpc] != 0)
+ return (luaG_getfuncline(p, oldpc - 1) != luaG_getfuncline(p, newpc));
+ }
+ return 0; /* no line changes in the way */
+}
+
+
+int luaG_traceexec (lua_State *L, const Instruction *pc) {
CallInfo *ci = L->ci;
lu_byte mask = L->hookmask;
- int counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
+ int counthook;
+ if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */
+ ci->u.l.trap = 0; /* don't need to stop again */
+ return 0; /* turn off 'trap' */
+ }
+ pc++; /* reference is always next instruction */
+ ci->u.l.savedpc = pc; /* save 'pc' */
+ counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
if (counthook)
resethookcount(L); /* reset count */
else if (!(mask & LUA_MASKLINE))
- return; /* no line hook and count != 0; nothing to be done */
+ return 1; /* no line hook and count != 0; nothing to be done now */
if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */
ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */
- return; /* do not call hook again (VM yielded, so it did not move) */
+ return 1; /* do not call hook again (VM yielded, so it did not move) */
}
+ if (!isIT(*(ci->u.l.savedpc - 1)))
+ L->top = ci->top; /* prepare top */
if (counthook)
- luaD_hook(L, LUA_HOOKCOUNT, -1); /* call count hook */
+ luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */
if (mask & LUA_MASKLINE) {
- Proto *p = ci_func(ci)->p;
- int npc = pcRel(ci->u.l.savedpc, p);
- int newline = getfuncline(p, npc);
- if (npc == 0 || /* call linehook when enter a new function, */
- ci->u.l.savedpc <= L->oldpc || /* when jump back (loop), or when */
- newline != getfuncline(p, pcRel(L->oldpc, p))) /* enter a new line */
- luaD_hook(L, LUA_HOOKLINE, newline); /* call line hook */
+ const Proto *p = ci_func(ci)->p;
+ int npci = pcRel(pc, p);
+ if (npci == 0 || /* call linehook when enter a new function, */
+ pc <= L->oldpc || /* when jump back (loop), or when */
+ changedline(p, pcRel(L->oldpc, p), npci)) { /* enter new line */
+ int newline = luaG_getfuncline(p, npci);
+ luaD_hook(L, LUA_HOOKLINE, newline, 0, 0); /* call line hook */
+ }
+ L->oldpc = pc; /* 'pc' of last call to line hook */
}
- L->oldpc = ci->u.l.savedpc;
if (L->status == LUA_YIELD) { /* did hook yield? */
if (counthook)
L->hookcount = 1; /* undo decrement to zero */
ci->u.l.savedpc--; /* undo increment (resume will increment it again) */
ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */
- ci->func = L->top - 1; /* protect stack below results */
luaD_throw(L, LUA_YIELD);
}
+ return 1; /* keep 'trap' on */
}
diff --git a/src/ldebug.h b/src/ldebug.h
index 8cea0ee..1fe0efa 100644
--- a/src/ldebug.h
+++ b/src/ldebug.h
@@ -1,5 +1,5 @@
/*
-** $Id: ldebug.h,v 2.14.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ldebug.h $
** Auxiliary functions from Debug Interface module
** See Copyright Notice in lua.h
*/
@@ -11,15 +11,23 @@
#include "lstate.h"
-#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1)
-
-#define getfuncline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : -1)
+#define pcRel(pc, p) (cast_int((pc) - (p)->code) - 1)
#define resethookcount(L) (L->hookcount = L->basehookcount)
+/*
+** mark for entries in 'lineinfo' array that has absolute information in
+** 'abslineinfo' array
+*/
+#define ABSLINEINFO (-0x80)
+LUAI_FUNC int luaG_getfuncline (const Proto *f, int pc);
+LUAI_FUNC const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n,
+ StkId *pos);
LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
const char *opname);
+LUAI_FUNC l_noret luaG_forerror (lua_State *L, const TValue *o,
+ const char *what);
LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,
@@ -33,7 +41,7 @@
LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,
TString *src, int line);
LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
-LUAI_FUNC void luaG_traceexec (lua_State *L);
+LUAI_FUNC int luaG_traceexec (lua_State *L, const Instruction *pc);
#endif
diff --git a/src/ldo.c b/src/ldo.c
index 316e45c..c563b1d 100644
--- a/src/ldo.c
+++ b/src/ldo.c
@@ -1,5 +1,5 @@
/*
-** $Id: ldo.c,v 2.157.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ldo.c $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
@@ -88,7 +88,7 @@
};
-static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
+void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) {
switch (errcode) {
case LUA_ERRMEM: { /* memory error? */
setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
@@ -98,6 +98,10 @@
setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));
break;
}
+ case CLOSEPROTECT: {
+ setnilvalue(s2v(oldtop)); /* no error message */
+ break;
+ }
default: {
setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
break;
@@ -114,6 +118,7 @@
}
else { /* thread has no error handler */
global_State *g = G(L);
+ errcode = luaF_close(L, L->stack, errcode); /* close all upvalues */
L->status = cast_byte(errcode); /* mark it as dead */
if (g->mainthread->errorJmp) { /* main thread has a handler? */
setobjs2s(L, g->mainthread->top++, L->top - 1); /* copy error obj. */
@@ -121,7 +126,7 @@
}
else { /* no handler at all; abort */
if (g->panic) { /* panic function? */
- seterrorobj(L, errcode, L->top); /* assume EXTRA_STACK */
+ luaD_seterrorobj(L, errcode, L->top); /* assume EXTRA_STACK */
if (L->ci->top < L->top)
L->ci->top = L->top; /* pushing msg. can break this invariant */
lua_unlock(L);
@@ -134,7 +139,8 @@
int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
- unsigned short oldnCcalls = L->nCcalls;
+ global_State *g = G(L);
+ l_uint32 oldnCcalls = g->Cstacklimit - (L->nCcalls + L->nci);
struct lua_longjmp lj;
lj.status = LUA_OK;
lj.previous = L->errorJmp; /* chain new error handler */
@@ -143,7 +149,7 @@
(*f)(L, ud);
);
L->errorJmp = lj.previous; /* restore old error handler */
- L->nCcalls = oldnCcalls;
+ L->nCcalls = g->Cstacklimit - oldnCcalls - L->nci;
return lj.status;
}
@@ -155,17 +161,19 @@
** Stack reallocation
** ===================================================================
*/
-static void correctstack (lua_State *L, TValue *oldstack) {
+static void correctstack (lua_State *L, StkId oldstack, StkId newstack) {
CallInfo *ci;
UpVal *up;
- L->top = (L->top - oldstack) + L->stack;
+ if (oldstack == newstack)
+ return; /* stack address did not change */
+ L->top = (L->top - oldstack) + newstack;
for (up = L->openupval; up != NULL; up = up->u.open.next)
- up->v = (up->v - oldstack) + L->stack;
+ up->v = s2v((uplevel(up) - oldstack) + newstack);
for (ci = L->ci; ci != NULL; ci = ci->previous) {
- ci->top = (ci->top - oldstack) + L->stack;
- ci->func = (ci->func - oldstack) + L->stack;
+ ci->top = (ci->top - oldstack) + newstack;
+ ci->func = (ci->func - oldstack) + newstack;
if (isLua(ci))
- ci->u.l.base = (ci->u.l.base - oldstack) + L->stack;
+ ci->u.l.trap = 1; /* signal to update 'trap' in 'luaV_execute' */
}
}
@@ -174,36 +182,53 @@
#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)
-void luaD_reallocstack (lua_State *L, int newsize) {
- TValue *oldstack = L->stack;
+int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
int lim = L->stacksize;
+ StkId newstack = luaM_reallocvector(L, L->stack, lim, newsize, StackValue);
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);
+ if (unlikely(newstack == NULL)) { /* reallocation failed? */
+ if (raiseerror)
+ luaM_error(L);
+ else return 0; /* do not raise an error */
+ }
for (; lim < newsize; lim++)
- setnilvalue(L->stack + lim); /* erase new segment */
+ setnilvalue(s2v(newstack + lim)); /* erase new segment */
+ correctstack(L, L->stack, newstack);
+ L->stack = newstack;
L->stacksize = newsize;
L->stack_last = L->stack + newsize - EXTRA_STACK;
- correctstack(L, oldstack);
+ return 1;
}
-void luaD_growstack (lua_State *L, int n) {
+/*
+** Try to grow the stack by at least 'n' elements. when 'raiseerror'
+** is true, raises any error; otherwise, return 0 in case of errors.
+*/
+int luaD_growstack (lua_State *L, int n, int raiseerror) {
int size = L->stacksize;
- if (size > LUAI_MAXSTACK) /* error after extra size? */
- luaD_throw(L, LUA_ERRERR);
+ int newsize = 2 * size; /* tentative new size */
+ if (unlikely(size > LUAI_MAXSTACK)) { /* need more space after extra size? */
+ if (raiseerror)
+ luaD_throw(L, LUA_ERRERR); /* error inside message handler */
+ else return 0;
+ }
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");
+ if (newsize > LUAI_MAXSTACK) /* cannot cross the limit */
+ newsize = LUAI_MAXSTACK;
+ if (newsize < needed) /* but must respect what was asked for */
+ newsize = needed;
+ if (unlikely(newsize > LUAI_MAXSTACK)) { /* stack overflow? */
+ /* add extra size to be able to handle the error message */
+ luaD_reallocstack(L, ERRORSTACKSIZE, raiseerror);
+ if (raiseerror)
+ luaG_runerror(L, "stack overflow");
+ else return 0;
}
- else
- luaD_reallocstack(L, newsize);
- }
+ } /* else no errors */
+ return luaD_reallocstack(L, newsize, raiseerror);
}
@@ -223,17 +248,14 @@
int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK;
if (goodsize > LUAI_MAXSTACK)
goodsize = LUAI_MAXSTACK; /* respect stack limit */
- if (L->stacksize > LUAI_MAXSTACK) /* had been handling stack overflow? */
- luaE_freeCI(L); /* free all CIs (list grew because of an error) */
- else
- luaE_shrinkCI(L); /* shrink list */
/* if thread is currently not handling a stack overflow and its
good size is smaller than current size, shrink its stack */
if (inuse <= (LUAI_MAXSTACK - EXTRA_STACK) &&
goodsize < L->stacksize)
- luaD_reallocstack(L, goodsize);
+ luaD_reallocstack(L, goodsize, 0); /* ok if that fails */
else /* don't change stack */
condmovestack(L,{},{}); /* (change only for debugging) */
+ luaE_shrinkCI(L); /* shrink CI list */
}
@@ -247,12 +269,14 @@
/*
** Call a hook for the given event. Make sure there is a hook to be
-** called. (Both 'L->hook' and 'L->hookmask', which triggers this
+** called. (Both 'L->hook' and 'L->hookmask', which trigger this
** function, can be changed asynchronously by signals.)
*/
-void luaD_hook (lua_State *L, int event, int line) {
+void luaD_hook (lua_State *L, int event, int line,
+ int ftransfer, int ntransfer) {
lua_Hook hook = L->hook;
if (hook && L->allowhook) { /* make sure there is a hook */
+ int mask = CIST_HOOKED;
CallInfo *ci = L->ci;
ptrdiff_t top = savestack(L, L->top);
ptrdiff_t ci_top = savestack(L, ci->top);
@@ -260,11 +284,16 @@
ar.event = event;
ar.currentline = line;
ar.i_ci = ci;
+ if (ntransfer != 0) {
+ mask |= CIST_TRAN; /* 'ci' has transfer information */
+ ci->u2.transferinfo.ftransfer = ftransfer;
+ ci->u2.transferinfo.ntransfer = ntransfer;
+ }
luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
- ci->top = L->top + LUA_MINSTACK;
- lua_assert(ci->top <= L->stack_last);
+ if (L->top + LUA_MINSTACK > ci->top)
+ ci->top = L->top + LUA_MINSTACK;
L->allowhook = 0; /* cannot call hooks inside a hook */
- ci->callstatus |= CIST_HOOKED;
+ ci->callstatus |= mask;
lua_unlock(L);
(*hook)(L, &ar);
lua_lock(L);
@@ -272,56 +301,66 @@
L->allowhook = 1;
ci->top = restorestack(L, ci_top);
L->top = restorestack(L, top);
- ci->callstatus &= ~CIST_HOOKED;
+ ci->callstatus &= ~mask;
}
}
-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;
- /* 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 < actual; i++) {
- setobjs2s(L, L->top++, fixed + i);
- setnilvalue(fixed + i); /* erase original copy (for GC) */
- }
- for (; i < nfixargs; i++)
- setnilvalue(L->top++); /* complete missing arguments */
- return base;
-}
-
-
/*
-** Check whether __call metafield of 'func' is a function. If so, put
-** it in stack below original 'func' so that 'luaD_precall' can call
-** it. Raise an error if __call metafield is not a function.
+** Executes a call hook for Lua functions. This function is called
+** whenever 'hookmask' is not zero, so it checks whether call hooks are
+** active.
*/
-static void tryfuncTM (lua_State *L, StkId func) {
- const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL);
+void luaD_hookcall (lua_State *L, CallInfo *ci) {
+ int hook = (ci->callstatus & CIST_TAIL) ? LUA_HOOKTAILCALL : LUA_HOOKCALL;
+ Proto *p;
+ if (!(L->hookmask & LUA_MASKCALL)) /* some other hook? */
+ return; /* don't call hook */
+ p = clLvalue(s2v(ci->func))->p;
+ L->top = ci->top; /* prepare top */
+ ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */
+ luaD_hook(L, hook, -1, 1, p->numparams);
+ ci->u.l.savedpc--; /* correct 'pc' */
+}
+
+
+static StkId rethook (lua_State *L, CallInfo *ci, StkId firstres, int nres) {
+ ptrdiff_t oldtop = savestack(L, L->top); /* hook may change top */
+ int delta = 0;
+ if (isLuacode(ci)) {
+ Proto *p = clLvalue(s2v(ci->func))->p;
+ if (p->is_vararg)
+ delta = ci->u.l.nextraargs + p->numparams + 1;
+ if (L->top < ci->top)
+ L->top = ci->top; /* correct top to run hook */
+ }
+ if (L->hookmask & LUA_MASKRET) { /* is return hook on? */
+ int ftransfer;
+ ci->func += delta; /* if vararg, back to virtual 'func' */
+ ftransfer = cast(unsigned short, firstres - ci->func);
+ luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres); /* call it */
+ ci->func -= delta;
+ }
+ if (isLua(ci->previous))
+ L->oldpc = ci->previous->u.l.savedpc; /* update 'oldpc' */
+ return restorestack(L, oldtop);
+}
+
+
+/*
+** Check whether 'func' has a '__call' metafield. If so, put it in the
+** stack, below original 'func', so that 'luaD_call' can call it. Raise
+** an error if there is no '__call' metafield.
+*/
+void luaD_tryfuncTM (lua_State *L, StkId func) {
+ const TValue *tm = luaT_gettmbyobj(L, s2v(func), TM_CALL);
StkId p;
- if (!ttisfunction(tm))
- luaG_typeerror(L, func, "call");
- /* Open a hole inside the stack at 'func' */
- for (p = L->top; p > func; p--)
+ if (unlikely(ttisnil(tm)))
+ luaG_typeerror(L, s2v(func), "call"); /* nothing to call */
+ for (p = L->top; p > func; p--) /* open space for metamethod */
setobjs2s(L, p, p-1);
- L->top++; /* slot ensured by caller */
- setobj2s(L, func, tm); /* tag method is the new function to be called */
+ L->top++; /* stack space pre-allocated by the caller */
+ setobj2s(L, func, tm); /* metamethod is the new function to be called */
}
@@ -331,158 +370,82 @@
** expressions, multiple results for tail calls/single parameters)
** separated.
*/
-static int moveresults (lua_State *L, const TValue *firstResult, StkId res,
- int nres, int wanted) {
+static void moveresults (lua_State *L, StkId res, int nres, int wanted) {
+ StkId firstresult;
+ int i;
switch (wanted) { /* handle typical cases separately */
- case 0: break; /* nothing to move */
- case 1: { /* one result needed */
+ case 0: /* no values needed */
+ L->top = res;
+ return;
+ case 1: /* one value needed */
if (nres == 0) /* no results? */
- firstResult = luaO_nilobject; /* adjust with nil */
- setobjs2s(L, res, firstResult); /* move it to proper place */
+ setnilvalue(s2v(res)); /* adjust with nil */
+ else
+ setobjs2s(L, res, L->top - nres); /* move it to proper place */
+ L->top = res + 1;
+ return;
+ case LUA_MULTRET:
+ wanted = nres; /* we want all results */
break;
- }
- case LUA_MULTRET: {
- int i;
- for (i = 0; i < nres; i++) /* move all results to correct place */
- setobjs2s(L, res + i, firstResult + i);
- L->top = res + nres;
- return 0; /* wanted == LUA_MULTRET */
- }
- default: {
- int i;
- if (wanted <= nres) { /* enough results? */
- for (i = 0; i < wanted; i++) /* move wanted results to correct place */
- setobjs2s(L, res + i, firstResult + i);
- }
- else { /* not enough results; use all of them plus nils */
- for (i = 0; i < nres; i++) /* move all results to correct place */
- setobjs2s(L, res + i, firstResult + i);
- for (; i < wanted; i++) /* complete wanted number of results */
- setnilvalue(res + i);
+ default: /* multiple results (or to-be-closed variables) */
+ if (hastocloseCfunc(wanted)) { /* to-be-closed variables? */
+ ptrdiff_t savedres = savestack(L, res);
+ luaF_close(L, res, LUA_OK); /* may change the stack */
+ res = restorestack(L, savedres);
+ wanted = codeNresults(wanted); /* correct value */
+ if (wanted == LUA_MULTRET)
+ wanted = nres;
}
break;
- }
}
+ firstresult = L->top - nres; /* index of first result */
+ /* move all results to correct place */
+ for (i = 0; i < nres && i < wanted; i++)
+ setobjs2s(L, res + i, firstresult + i);
+ for (; i < wanted; i++) /* complete wanted number of results */
+ setnilvalue(s2v(res + i));
L->top = res + wanted; /* top points after the last result */
- return 1;
}
/*
** Finishes a function call: calls hook if necessary, removes CallInfo,
-** moves current number of results to proper place; returns 0 iff call
-** wanted multiple (variable number of) results.
+** moves current number of results to proper place.
*/
-int luaD_poscall (lua_State *L, CallInfo *ci, StkId firstResult, int nres) {
- StkId res;
- int wanted = ci->nresults;
- 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 */
+void luaD_poscall (lua_State *L, CallInfo *ci, int nres) {
+ if (L->hookmask)
+ L->top = rethook(L, ci, L->top - nres, nres);
L->ci = ci->previous; /* back to caller */
/* move results to proper place */
- return moveresults(L, firstResult, res, nres, wanted);
+ moveresults(L, ci->func, nres, ci->nresults);
}
-#define next_ci(L) (L->ci = (L->ci->next ? L->ci->next : luaE_extendCI(L)))
-
-
-/* macro to check stack size, preserving 'p' */
-#define checkstackp(L,n,p) \
- luaD_checkstackaux(L, n, \
- ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \
- luaC_checkGC(L), /* stack grow uses memory */ \
- p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
+#define next_ci(L) (L->ci->next ? L->ci->next : luaE_extendCI(L))
/*
-** Prepares a function call: checks the stack, creates a new CallInfo
-** entry, fills in the relevant information, calls hook if needed.
-** If function is a C function, does the call, too. (Otherwise, leave
-** the execution ('luaV_execute') to the caller, to allow stackless
-** calls.) Returns true iff function has been executed (C function).
+** Prepare a function for a tail call, building its call info on top
+** of the current call info. 'narg1' is the number of arguments plus 1
+** (so that it includes the function itself).
*/
-int luaD_precall (lua_State *L, StkId func, int nresults) {
- lua_CFunction f;
- CallInfo *ci;
- switch (ttype(func)) {
- case LUA_TCCL: /* C closure */
- f = clCvalue(func)->f;
- goto Cfunc;
- case LUA_TLCF: /* light C function */
- f = fvalue(func);
- Cfunc: {
- int n; /* number of returns */
- checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */
- ci = next_ci(L); /* now 'enter' new function */
- ci->nresults = nresults;
- ci->func = func;
- ci->top = L->top + LUA_MINSTACK;
- lua_assert(ci->top <= L->stack_last);
- ci->callstatus = 0;
- 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, ci, L->top - n, n);
- return 1;
- }
- case LUA_TLCL: { /* Lua function: prepare its call */
- StkId base;
- Proto *p = clLvalue(func)->p;
- int n = cast_int(L->top - func) - 1; /* number of real arguments */
- int fsize = p->maxstacksize; /* frame size */
- checkstackp(L, fsize, func);
- if (p->is_vararg)
- base = adjust_varargs(L, p, n);
- else { /* non vararg function */
- for (; n < p->numparams; n++)
- setnilvalue(L->top++); /* complete missing arguments */
- base = func + 1;
- }
- ci = next_ci(L); /* now 'enter' new function */
- ci->nresults = nresults;
- ci->func = func;
- ci->u.l.base = base;
- L->top = ci->top = base + fsize;
- lua_assert(ci->top <= L->stack_last);
- ci->u.l.savedpc = p->code; /* starting point */
- ci->callstatus = CIST_LUA;
- if (L->hookmask & LUA_MASKCALL)
- callhook(L, ci);
- return 0;
- }
- default: { /* not a function */
- checkstackp(L, 1, func); /* ensure space for metamethod */
- tryfuncTM(L, func); /* try to get '__call' metamethod */
- return luaD_precall(L, func, nresults); /* now it must be a function */
- }
- }
-}
-
-
-/*
-** Check appropriate error for stack overflow ("regular" overflow or
-** overflow while handling stack overflow). If 'nCalls' is larger than
-** LUAI_MAXCCALLS (which means it is handling a "regular" overflow) but
-** smaller than 9/8 of LUAI_MAXCCALLS, does not report an error (to
-** allow overflow handling to work)
-*/
-static void stackerror (lua_State *L) {
- 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 */
+void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int narg1) {
+ Proto *p = clLvalue(s2v(func))->p;
+ int fsize = p->maxstacksize; /* frame size */
+ int nfixparams = p->numparams;
+ int i;
+ for (i = 0; i < narg1; i++) /* move down function and arguments */
+ setobjs2s(L, ci->func + i, func + i);
+ checkstackGC(L, fsize);
+ func = ci->func; /* moved-down function */
+ for (; narg1 <= nfixparams; narg1++)
+ setnilvalue(s2v(func + narg1)); /* complete missing arguments */
+ ci->top = func + 1 + fsize; /* top for new function */
+ lua_assert(ci->top <= L->stack_last);
+ ci->u.l.savedpc = p->code; /* starting point */
+ ci->callstatus |= CIST_TAIL;
+ L->top = func + narg1; /* set top */
}
@@ -492,22 +455,76 @@
** 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) {
- if (++L->nCcalls >= LUAI_MAXCCALLS)
- stackerror(L);
- if (!luaD_precall(L, func, nResults)) /* is a Lua function? */
- luaV_execute(L); /* call it */
- L->nCcalls--;
+void luaD_call (lua_State *L, StkId func, int nresults) {
+ lua_CFunction f;
+ retry:
+ switch (ttypetag(s2v(func))) {
+ case LUA_VCCL: /* C closure */
+ f = clCvalue(s2v(func))->f;
+ goto Cfunc;
+ case LUA_VLCF: /* light C function */
+ f = fvalue(s2v(func));
+ Cfunc: {
+ int n; /* number of returns */
+ CallInfo *ci = next_ci(L);
+ checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */
+ ci->nresults = nresults;
+ ci->callstatus = CIST_C;
+ ci->top = L->top + LUA_MINSTACK;
+ ci->func = func;
+ L->ci = ci;
+ lua_assert(ci->top <= L->stack_last);
+ if (L->hookmask & LUA_MASKCALL) {
+ int narg = cast_int(L->top - func) - 1;
+ luaD_hook(L, LUA_HOOKCALL, -1, 1, narg);
+ }
+ lua_unlock(L);
+ n = (*f)(L); /* do the actual call */
+ lua_lock(L);
+ api_checknelems(L, n);
+ luaD_poscall(L, ci, n);
+ break;
+ }
+ case LUA_VLCL: { /* Lua function */
+ CallInfo *ci = next_ci(L);
+ Proto *p = clLvalue(s2v(func))->p;
+ int narg = cast_int(L->top - func) - 1; /* number of real arguments */
+ int nfixparams = p->numparams;
+ int fsize = p->maxstacksize; /* frame size */
+ checkstackp(L, fsize, func);
+ ci->nresults = nresults;
+ ci->u.l.savedpc = p->code; /* starting point */
+ ci->callstatus = 0;
+ ci->top = func + 1 + fsize;
+ ci->func = func;
+ L->ci = ci;
+ for (; narg < nfixparams; narg++)
+ setnilvalue(s2v(L->top++)); /* complete missing arguments */
+ lua_assert(ci->top <= L->stack_last);
+ luaV_execute(L, ci); /* run the function */
+ break;
+ }
+ default: { /* not a function */
+ checkstackp(L, 1, func); /* space for metamethod */
+ luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */
+ goto retry; /* try again with metamethod */
+ }
+ }
}
/*
-** Similar to 'luaD_call', but does not allow yields during the call
+** Similar to 'luaD_call', but does not allow yields during the call.
+** If there is a stack overflow, freeing all CI structures will
+** force the subsequent call to invoke 'luaE_extendCI', which then
+** will raise any errors.
*/
void luaD_callnoyield (lua_State *L, StkId func, int nResults) {
- L->nny++;
+ incXCcalls(L);
+ if (getCcalls(L) <= CSTACKERR) /* possible stack overflow? */
+ luaE_freeCI(L);
luaD_call(L, func, nResults);
- L->nny--;
+ decXCcalls(L);
}
@@ -519,7 +536,7 @@
CallInfo *ci = L->ci;
int n;
/* must have a continuation and must be able to call it */
- lua_assert(ci->u.c.k != NULL && L->nny == 0);
+ lua_assert(ci->u.c.k != NULL && yieldable(L));
/* error status can only happen in a protected call */
lua_assert((ci->callstatus & CIST_YPCALL) || status == LUA_YIELD);
if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */
@@ -533,7 +550,7 @@
n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation function */
lua_lock(L);
api_checknelems(L, n);
- luaD_poscall(L, ci, L->top - n, n); /* finish 'luaD_precall' */
+ luaD_poscall(L, ci, n); /* finish 'luaD_call' */
}
@@ -546,14 +563,15 @@
** status is LUA_YIELD).
*/
static void unroll (lua_State *L, void *ud) {
+ CallInfo *ci;
if (ud != NULL) /* error status? */
finishCcall(L, *(int *)ud); /* finish 'lua_pcallk' callee */
- while (L->ci != &L->base_ci) { /* something in the stack */
- if (!isLua(L->ci)) /* C function? */
+ while ((ci = L->ci) != &L->base_ci) { /* something in the stack */
+ if (!isLua(ci)) /* C function? */
finishCcall(L, LUA_YIELD); /* complete its execution */
else { /* Lua function */
luaV_finishOp(L); /* finish interrupted instruction */
- luaV_execute(L); /* execute down to higher C 'boundary' */
+ luaV_execute(L, ci); /* execute down to higher C 'boundary' */
}
}
}
@@ -583,12 +601,12 @@
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);
+ oldtop = restorestack(L, ci->u2.funcidx);
+ luaF_close(L, oldtop, status); /* may change the stack */
+ oldtop = restorestack(L, ci->u2.funcidx);
+ luaD_seterrorobj(L, status, oldtop);
L->ci = ci;
L->allowhook = getoah(ci->callstatus); /* restore original 'allowhook' */
- L->nny = 0; /* should be zero to be yieldable */
luaD_shrinkstack(L);
L->errfunc = ci->u.c.old_errfunc;
return 1; /* continue running the coroutine */
@@ -621,71 +639,68 @@
StkId firstArg = L->top - n; /* first argument */
CallInfo *ci = L->ci;
if (L->status == LUA_OK) { /* starting a coroutine? */
- if (!luaD_precall(L, firstArg - 1, LUA_MULTRET)) /* Lua function? */
- luaV_execute(L); /* call it */
+ luaD_call(L, firstArg - 1, LUA_MULTRET);
}
else { /* resuming from previous yield */
lua_assert(L->status == LUA_YIELD);
L->status = LUA_OK; /* mark that it is running (again) */
- ci->func = restorestack(L, ci->extra);
if (isLua(ci)) /* yielded inside a hook? */
- luaV_execute(L); /* just continue running Lua code */
+ luaV_execute(L, ci); /* just continue running Lua code */
else { /* 'common' yield */
if (ci->u.c.k != NULL) { /* does it have a continuation function? */
lua_unlock(L);
n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */
lua_lock(L);
api_checknelems(L, n);
- firstArg = L->top - n; /* yield results come from continuation */
}
- luaD_poscall(L, ci, firstArg, n); /* finish 'luaD_precall' */
+ luaD_poscall(L, ci, n); /* finish 'luaD_call' */
}
unroll(L, NULL); /* run continuation */
}
}
-
-LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs) {
+LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs,
+ int *nresults) {
int status;
- unsigned short oldnny = L->nny; /* save "number of non-yieldable" calls */
lua_lock(L);
if (L->status == LUA_OK) { /* may be starting a coroutine */
if (L->ci != &L->base_ci) /* not in base level? */
return resume_error(L, "cannot resume non-suspended coroutine", nargs);
+ else if (L->top - (L->ci->func + 1) == nargs) /* no function? */
+ return resume_error(L, "cannot resume dead coroutine", nargs);
}
- else if (L->status != LUA_YIELD)
+ else if (L->status != LUA_YIELD) /* ended with errors? */
return resume_error(L, "cannot resume dead coroutine", nargs);
- L->nCcalls = (from) ? from->nCcalls + 1 : 1;
- if (L->nCcalls >= LUAI_MAXCCALLS)
+ if (from == NULL)
+ L->nCcalls = CSTACKTHREAD;
+ else /* correct 'nCcalls' for this thread */
+ L->nCcalls = getCcalls(from) + from->nci - L->nci - CSTACKCF;
+ if (L->nCcalls <= CSTACKERR)
return resume_error(L, "C stack overflow", nargs);
luai_userstateresume(L, nargs);
- L->nny = 0; /* allow yields */
api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
status = luaD_rawrunprotected(L, resume, &nargs);
- if (status == -1) /* error calling 'lua_resume'? */
- status = LUA_ERRRUN;
- else { /* continue running after recoverable errors */
- while (errorstatus(status) && recover(L, status)) {
- /* unroll continuation */
- status = luaD_rawrunprotected(L, unroll, &status);
- }
- if (errorstatus(status)) { /* unrecoverable error? */
- L->status = cast_byte(status); /* mark thread as 'dead' */
- seterrorobj(L, status, L->top); /* push error message */
- L->ci->top = L->top;
- }
- else lua_assert(status == L->status); /* normal end or yield */
+ /* continue running after recoverable errors */
+ while (errorstatus(status) && recover(L, status)) {
+ /* unroll continuation */
+ status = luaD_rawrunprotected(L, unroll, &status);
}
- L->nny = oldnny; /* restore 'nny' */
- L->nCcalls--;
- lua_assert(L->nCcalls == ((from) ? from->nCcalls : 0));
+ if (likely(!errorstatus(status)))
+ lua_assert(status == L->status); /* normal end or yield */
+ else { /* unrecoverable error */
+ L->status = cast_byte(status); /* mark thread as 'dead' */
+ luaD_seterrorobj(L, status, L->top); /* push error message */
+ L->ci->top = L->top;
+ }
+ *nresults = (status == LUA_YIELD) ? L->ci->u2.nyield
+ : cast_int(L->top - (L->ci->func + 1));
lua_unlock(L);
return status;
}
LUA_API int lua_isyieldable (lua_State *L) {
- return (L->nny == 0);
+ return yieldable(L);
}
@@ -695,21 +710,22 @@
luai_userstateyield(L, nresults);
lua_lock(L);
api_checknelems(L, nresults);
- if (L->nny > 0) {
+ if (unlikely(!yieldable(L))) {
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? */
+ lua_assert(!isLuacode(ci));
api_check(L, k == NULL, "hooks cannot continue after yielding");
+ ci->u2.nyield = 0; /* no results */
}
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 */
+ ci->u2.nyield = nresults; /* save number of results */
luaD_throw(L, LUA_YIELD);
}
lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */
@@ -718,22 +734,26 @@
}
+/*
+** Call the C function 'func' in protected mode, restoring basic
+** thread information ('allowhook', etc.) and in particular
+** its stack level in case of errors.
+*/
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? */
+ if (unlikely(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;
+ status = luaF_close(L, oldtop, status);
+ oldtop = restorestack(L, old_top); /* previous call may change stack */
+ luaD_seterrorobj(L, status, oldtop);
luaD_shrinkstack(L);
}
L->errfunc = old_errfunc;
@@ -784,7 +804,7 @@
const char *mode) {
struct SParser p;
int status;
- L->nny++; /* cannot yield during parsing */
+ incnny(L); /* 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;
@@ -795,7 +815,7 @@
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--;
+ decnny(L);
return status;
}
diff --git a/src/ldo.h b/src/ldo.h
index 3b2983a..7760f85 100644
--- a/src/ldo.h
+++ b/src/ldo.h
@@ -1,5 +1,5 @@
/*
-** $Id: ldo.h,v 2.29.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ldo.h $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
@@ -22,7 +22,8 @@
*/
#define luaD_checkstackaux(L,n,pre,pos) \
if (L->stack_last - L->top <= (n)) \
- { pre; luaD_growstack(L, n); pos; } else { condmovestack(L,pre,pos); }
+ { pre; luaD_growstack(L, n, 1); pos; } \
+ else { condmovestack(L,pre,pos); }
/* In general, 'pre'/'pos' are empty (nothing to save) */
#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)
@@ -30,24 +31,40 @@
#define savestack(L,p) ((char *)(p) - (char *)L->stack)
-#define restorestack(L,n) ((TValue *)((char *)L->stack + (n)))
+#define restorestack(L,n) ((StkId)((char *)L->stack + (n)))
+
+
+/* macro to check stack size, preserving 'p' */
+#define checkstackp(L,n,p) \
+ luaD_checkstackaux(L, n, \
+ ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \
+ luaC_checkGC(L), /* stack grow uses memory */ \
+ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
+
+
+/* macro to check stack size and GC */
+#define checkstackGC(L,fsize) \
+ luaD_checkstackaux(L, (fsize), (void)0, luaC_checkGC(L))
/* type of protected functions, to be ran by 'runprotected' */
typedef void (*Pfunc) (lua_State *L, void *ud);
+LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop);
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_hook (lua_State *L, int event, int line,
+ int fTransfer, int nTransfer);
+LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
+LUAI_FUNC void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int n);
LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);
+LUAI_FUNC void luaD_tryfuncTM (lua_State *L, StkId func);
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, CallInfo *ci, StkId firstResult,
- int nres);
-LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize);
-LUAI_FUNC void luaD_growstack (lua_State *L, int n);
+LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres);
+LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror);
+LUAI_FUNC int luaD_growstack (lua_State *L, int n, int raiseerror);
LUAI_FUNC void luaD_shrinkstack (lua_State *L);
LUAI_FUNC void luaD_inctop (lua_State *L);
diff --git a/src/ldump.c b/src/ldump.c
index f025aca..f848b66 100644
--- a/src/ldump.c
+++ b/src/ldump.c
@@ -1,5 +1,5 @@
/*
-** $Id: ldump.c,v 2.37.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ldump.c $
** save precompiled Lua chunks
** See Copyright Notice in lua.h
*/
@@ -29,15 +29,15 @@
/*
-** All high-level dumps go through DumpVector; you can change it to
+** All high-level dumps go through dumpVector; you can change it to
** change the endianness of the result
*/
-#define DumpVector(v,n,D) DumpBlock(v,(n)*sizeof((v)[0]),D)
+#define dumpVector(D,v,n) dumpBlock(D,v,(n)*sizeof((v)[0]))
-#define DumpLiteral(s,D) DumpBlock(s, sizeof(s) - sizeof(char), D)
+#define dumpLiteral(D, s) dumpBlock(D,s,sizeof(s) - sizeof(char))
-static void DumpBlock (const void *b, size_t size, DumpState *D) {
+static void dumpBlock (DumpState *D, const void *b, size_t size) {
if (D->status == 0 && size > 0) {
lua_unlock(D->L);
D->status = (*D->writer)(D->L, b, size, D->data);
@@ -46,153 +46,164 @@
}
-#define DumpVar(x,D) DumpVector(&x,1,D)
+#define dumpVar(D,x) dumpVector(D,&x,1)
-static void DumpByte (int y, DumpState *D) {
+static void dumpByte (DumpState *D, int y) {
lu_byte x = (lu_byte)y;
- DumpVar(x, D);
+ dumpVar(D, x);
}
-static void DumpInt (int x, DumpState *D) {
- DumpVar(x, D);
+/* dumpInt Buff Size */
+#define DIBS ((sizeof(size_t) * 8 / 7) + 1)
+
+static void dumpSize (DumpState *D, size_t x) {
+ lu_byte buff[DIBS];
+ int n = 0;
+ do {
+ buff[DIBS - (++n)] = x & 0x7f; /* fill buffer in reverse order */
+ x >>= 7;
+ } while (x != 0);
+ buff[DIBS - 1] |= 0x80; /* mark last byte */
+ dumpVector(D, buff + DIBS - n, n);
}
-static void DumpNumber (lua_Number x, DumpState *D) {
- DumpVar(x, D);
+static void dumpInt (DumpState *D, int x) {
+ dumpSize(D, x);
}
-static void DumpInteger (lua_Integer x, DumpState *D) {
- DumpVar(x, D);
+static void dumpNumber (DumpState *D, lua_Number x) {
+ dumpVar(D, x);
}
-static void DumpString (const TString *s, DumpState *D) {
+static void dumpInteger (DumpState *D, lua_Integer x) {
+ dumpVar(D, x);
+}
+
+
+static void dumpString (DumpState *D, const TString *s) {
if (s == NULL)
- DumpByte(0, D);
+ dumpSize(D, 0);
else {
- size_t size = tsslen(s) + 1; /* include trailing '\0' */
+ size_t size = tsslen(s);
const char *str = getstr(s);
- if (size < 0xFF)
- DumpByte(cast_int(size), D);
- else {
- DumpByte(0xFF, D);
- DumpVar(size, D);
- }
- DumpVector(str, size - 1, D); /* no need to save '\0' */
+ dumpSize(D, size + 1);
+ dumpVector(D, str, size);
}
}
-static void DumpCode (const Proto *f, DumpState *D) {
- DumpInt(f->sizecode, D);
- DumpVector(f->code, f->sizecode, D);
+static void dumpCode (DumpState *D, const Proto *f) {
+ dumpInt(D, f->sizecode);
+ dumpVector(D, f->code, f->sizecode);
}
-static void DumpFunction(const Proto *f, TString *psource, DumpState *D);
+static void dumpFunction(DumpState *D, const Proto *f, TString *psource);
-static void DumpConstants (const Proto *f, DumpState *D) {
+static void dumpConstants (DumpState *D, const Proto *f) {
int i;
int n = f->sizek;
- DumpInt(n, D);
+ dumpInt(D, n);
for (i = 0; i < n; i++) {
const TValue *o = &f->k[i];
- DumpByte(ttype(o), D);
- switch (ttype(o)) {
- case LUA_TNIL:
- break;
- case LUA_TBOOLEAN:
- DumpByte(bvalue(o), D);
- break;
- case LUA_TNUMFLT:
- DumpNumber(fltvalue(o), D);
- break;
- case LUA_TNUMINT:
- DumpInteger(ivalue(o), D);
- break;
- case LUA_TSHRSTR:
- case LUA_TLNGSTR:
- DumpString(tsvalue(o), D);
- break;
- default:
- lua_assert(0);
+ int tt = ttypetag(o);
+ dumpByte(D, tt);
+ switch (tt) {
+ case LUA_VNUMFLT:
+ dumpNumber(D, fltvalue(o));
+ break;
+ case LUA_VNUMINT:
+ dumpInteger(D, ivalue(o));
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ dumpString(D, tsvalue(o));
+ break;
+ default:
+ lua_assert(tt == LUA_VNIL || tt == LUA_VFALSE || tt == LUA_VTRUE);
}
}
}
-static void DumpProtos (const Proto *f, DumpState *D) {
+static void dumpProtos (DumpState *D, const Proto *f) {
int i;
int n = f->sizep;
- DumpInt(n, D);
+ dumpInt(D, n);
for (i = 0; i < n; i++)
- DumpFunction(f->p[i], f->source, D);
+ dumpFunction(D, f->p[i], f->source);
}
-static void DumpUpvalues (const Proto *f, DumpState *D) {
+static void dumpUpvalues (DumpState *D, const Proto *f) {
int i, n = f->sizeupvalues;
- DumpInt(n, D);
+ dumpInt(D, n);
for (i = 0; i < n; i++) {
- DumpByte(f->upvalues[i].instack, D);
- DumpByte(f->upvalues[i].idx, D);
+ dumpByte(D, f->upvalues[i].instack);
+ dumpByte(D, f->upvalues[i].idx);
+ dumpByte(D, f->upvalues[i].kind);
}
}
-static void DumpDebug (const Proto *f, DumpState *D) {
+static void dumpDebug (DumpState *D, const Proto *f) {
int i, n;
n = (D->strip) ? 0 : f->sizelineinfo;
- DumpInt(n, D);
- DumpVector(f->lineinfo, n, D);
- n = (D->strip) ? 0 : f->sizelocvars;
- DumpInt(n, D);
+ dumpInt(D, n);
+ dumpVector(D, f->lineinfo, n);
+ n = (D->strip) ? 0 : f->sizeabslineinfo;
+ dumpInt(D, n);
for (i = 0; i < n; i++) {
- DumpString(f->locvars[i].varname, D);
- DumpInt(f->locvars[i].startpc, D);
- DumpInt(f->locvars[i].endpc, D);
+ dumpInt(D, f->abslineinfo[i].pc);
+ dumpInt(D, f->abslineinfo[i].line);
+ }
+ n = (D->strip) ? 0 : f->sizelocvars;
+ dumpInt(D, n);
+ for (i = 0; i < n; i++) {
+ dumpString(D, f->locvars[i].varname);
+ dumpInt(D, f->locvars[i].startpc);
+ dumpInt(D, f->locvars[i].endpc);
}
n = (D->strip) ? 0 : f->sizeupvalues;
- DumpInt(n, D);
+ dumpInt(D, n);
for (i = 0; i < n; i++)
- DumpString(f->upvalues[i].name, D);
+ dumpString(D, f->upvalues[i].name);
}
-static void DumpFunction (const Proto *f, TString *psource, DumpState *D) {
+static void dumpFunction (DumpState *D, const Proto *f, TString *psource) {
if (D->strip || f->source == psource)
- DumpString(NULL, D); /* no debug info or same source as its parent */
+ dumpString(D, NULL); /* no debug info or same source as its parent */
else
- DumpString(f->source, D);
- DumpInt(f->linedefined, D);
- DumpInt(f->lastlinedefined, D);
- DumpByte(f->numparams, D);
- DumpByte(f->is_vararg, D);
- DumpByte(f->maxstacksize, D);
- DumpCode(f, D);
- DumpConstants(f, D);
- DumpUpvalues(f, D);
- DumpProtos(f, D);
- DumpDebug(f, D);
+ dumpString(D, f->source);
+ dumpInt(D, f->linedefined);
+ dumpInt(D, f->lastlinedefined);
+ dumpByte(D, f->numparams);
+ dumpByte(D, f->is_vararg);
+ dumpByte(D, f->maxstacksize);
+ dumpCode(D, f);
+ dumpConstants(D, f);
+ dumpUpvalues(D, f);
+ dumpProtos(D, f);
+ dumpDebug(D, f);
}
-static void DumpHeader (DumpState *D) {
- DumpLiteral(LUA_SIGNATURE, D);
- DumpByte(LUAC_VERSION, D);
- DumpByte(LUAC_FORMAT, D);
- DumpLiteral(LUAC_DATA, D);
- DumpByte(sizeof(int), D);
- DumpByte(sizeof(size_t), D);
- DumpByte(sizeof(Instruction), D);
- DumpByte(sizeof(lua_Integer), D);
- DumpByte(sizeof(lua_Number), D);
- DumpInteger(LUAC_INT, D);
- DumpNumber(LUAC_NUM, D);
+static void dumpHeader (DumpState *D) {
+ dumpLiteral(D, LUA_SIGNATURE);
+ dumpByte(D, LUAC_VERSION);
+ dumpByte(D, LUAC_FORMAT);
+ dumpLiteral(D, LUAC_DATA);
+ dumpByte(D, sizeof(Instruction));
+ dumpByte(D, sizeof(lua_Integer));
+ dumpByte(D, sizeof(lua_Number));
+ dumpInteger(D, LUAC_INT);
+ dumpNumber(D, LUAC_NUM);
}
@@ -207,9 +218,9 @@
D.data = data;
D.strip = strip;
D.status = 0;
- DumpHeader(&D);
- DumpByte(f->sizeupvalues, &D);
- DumpFunction(f, NULL, &D);
+ dumpHeader(&D);
+ dumpByte(&D, f->sizeupvalues);
+ dumpFunction(&D, f, NULL);
return D.status;
}
diff --git a/src/lfunc.c b/src/lfunc.c
index ccafbb8..10100e5 100644
--- a/src/lfunc.c
+++ b/src/lfunc.c
@@ -1,5 +1,5 @@
/*
-** $Id: lfunc.c,v 2.45.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lfunc.c $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
@@ -14,6 +14,8 @@
#include "lua.h"
+#include "ldebug.h"
+#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
@@ -22,56 +24,55 @@
-CClosure *luaF_newCclosure (lua_State *L, int n) {
- GCObject *o = luaC_newobj(L, LUA_TCCL, sizeCclosure(n));
+CClosure *luaF_newCclosure (lua_State *L, int nupvals) {
+ GCObject *o = luaC_newobj(L, LUA_VCCL, sizeCclosure(nupvals));
CClosure *c = gco2ccl(o);
- c->nupvalues = cast_byte(n);
+ c->nupvalues = cast_byte(nupvals);
return c;
}
-LClosure *luaF_newLclosure (lua_State *L, int n) {
- GCObject *o = luaC_newobj(L, LUA_TLCL, sizeLclosure(n));
+LClosure *luaF_newLclosure (lua_State *L, int nupvals) {
+ GCObject *o = luaC_newobj(L, LUA_VLCL, sizeLclosure(nupvals));
LClosure *c = gco2lcl(o);
c->p = NULL;
- c->nupvalues = cast_byte(n);
- while (n--) c->upvals[n] = NULL;
+ c->nupvalues = cast_byte(nupvals);
+ while (nupvals--) c->upvals[nupvals] = NULL;
return c;
}
+
/*
** fill a closure with new closed upvalues
*/
void luaF_initupvals (lua_State *L, LClosure *cl) {
int i;
for (i = 0; i < cl->nupvalues; i++) {
- UpVal *uv = luaM_new(L, UpVal);
- uv->refcount = 1;
+ GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
+ UpVal *uv = gco2upv(o);
uv->v = &uv->u.value; /* make it closed */
setnilvalue(uv->v);
cl->upvals[i] = uv;
+ luaC_objbarrier(L, cl, o);
}
}
-UpVal *luaF_findupval (lua_State *L, StkId level) {
- UpVal **pp = &L->openupval;
- UpVal *p;
- UpVal *uv;
- lua_assert(isintwups(L) || L->openupval == NULL);
- while (*pp != NULL && (p = *pp)->v >= level) {
- lua_assert(upisopen(p));
- if (p->v == level) /* found a corresponding upvalue? */
- return p; /* return it */
- pp = &p->u.open.next;
- }
- /* not found: create a new upvalue */
- uv = luaM_new(L, UpVal);
- uv->refcount = 0;
- uv->u.open.next = *pp; /* link it to list of open upvalues */
- uv->u.open.touched = 1;
- *pp = uv;
- uv->v = level; /* current value lives in the stack */
+/*
+** Create a new upvalue at the given level, and link it to the list of
+** open upvalues of 'L' after entry 'prev'.
+**/
+static UpVal *newupval (lua_State *L, int tbc, StkId level, UpVal **prev) {
+ GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
+ UpVal *uv = gco2upv(o);
+ UpVal *next = *prev;
+ uv->v = s2v(level); /* current value lives in the stack */
+ uv->tbc = tbc;
+ uv->u.open.next = next; /* link it to list of open upvalues */
+ uv->u.open.previous = prev;
+ if (next)
+ next->u.open.previous = &uv->u.open.next;
+ *prev = uv;
if (!isintwups(L)) { /* thread not in list of threads with upvalues? */
L->twups = G(L)->twups; /* link it to the list */
G(L)->twups = L;
@@ -80,34 +81,180 @@
}
-void luaF_close (lua_State *L, StkId level) {
- UpVal *uv;
- while (L->openupval != NULL && (uv = L->openupval)->v >= level) {
- lua_assert(upisopen(uv));
- L->openupval = uv->u.open.next; /* remove from 'open' list */
- if (uv->refcount == 0) /* no references? */
- luaM_free(L, uv); /* free upvalue */
- else {
- setobj(L, &uv->u.value, uv->v); /* move value to upvalue slot */
- uv->v = &uv->u.value; /* now current value lives here */
- luaC_upvalbarrier(L, uv);
+/*
+** Find and reuse, or create if it does not exist, an upvalue
+** at the given level.
+*/
+UpVal *luaF_findupval (lua_State *L, StkId level) {
+ UpVal **pp = &L->openupval;
+ UpVal *p;
+ lua_assert(isintwups(L) || L->openupval == NULL);
+ while ((p = *pp) != NULL && uplevel(p) >= level) { /* search for it */
+ lua_assert(!isdead(G(L), p));
+ if (uplevel(p) == level) /* corresponding upvalue? */
+ return p; /* return it */
+ pp = &p->u.open.next;
+ }
+ /* not found: create a new upvalue after 'pp' */
+ return newupval(L, 0, level, pp);
+}
+
+
+static void callclose (lua_State *L, void *ud) {
+ UNUSED(ud);
+ luaD_callnoyield(L, L->top - 3, 0);
+}
+
+
+/*
+** Prepare closing method plus its arguments for object 'obj' with
+** error message 'err'. (This function assumes EXTRA_STACK.)
+*/
+static int prepclosingmethod (lua_State *L, TValue *obj, TValue *err) {
+ StkId top = L->top;
+ const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
+ if (ttisnil(tm)) /* no metamethod? */
+ return 0; /* nothing to call */
+ setobj2s(L, top, tm); /* will call metamethod... */
+ setobj2s(L, top + 1, obj); /* with 'self' as the 1st argument */
+ setobj2s(L, top + 2, err); /* and error msg. as 2nd argument */
+ L->top = top + 3; /* add function and arguments */
+ return 1;
+}
+
+
+/*
+** Raise an error with message 'msg', inserting the name of the
+** local variable at position 'level' in the stack.
+*/
+static void varerror (lua_State *L, StkId level, const char *msg) {
+ int idx = cast_int(level - L->ci->func);
+ const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
+ if (vname == NULL) vname = "?";
+ luaG_runerror(L, msg, vname);
+}
+
+
+/*
+** Prepare and call a closing method. If status is OK, code is still
+** inside the original protected call, and so any error will be handled
+** there. Otherwise, a previous error already activated the original
+** protected call, and so the call to the closing method must be
+** protected here. (A status == CLOSEPROTECT behaves like a previous
+** error, to also run the closing method in protected mode).
+** If status is OK, the call to the closing method will be pushed
+** at the top of the stack. Otherwise, values are pushed after
+** the 'level' of the upvalue being closed, as everything after
+** that won't be used again.
+*/
+static int callclosemth (lua_State *L, StkId level, int status) {
+ TValue *uv = s2v(level); /* value being closed */
+ if (likely(status == LUA_OK)) {
+ if (prepclosingmethod(L, uv, &G(L)->nilvalue)) /* something to call? */
+ callclose(L, NULL); /* call closing method */
+ else if (!l_isfalse(uv)) /* non-closable non-false value? */
+ varerror(L, level, "attempt to close non-closable variable '%s'");
+ }
+ else { /* must close the object in protected mode */
+ ptrdiff_t oldtop;
+ level++; /* space for error message */
+ oldtop = savestack(L, level + 1); /* top will be after that */
+ luaD_seterrorobj(L, status, level); /* set error message */
+ if (prepclosingmethod(L, uv, s2v(level))) { /* something to call? */
+ int newstatus = luaD_pcall(L, callclose, NULL, oldtop, 0);
+ if (newstatus != LUA_OK && status == CLOSEPROTECT) /* first error? */
+ status = newstatus; /* this will be the new error */
+ else {
+ if (newstatus != LUA_OK) /* suppressed error? */
+ luaE_warnerror(L, "__close metamethod");
+ /* leave original error (or nil) on top */
+ L->top = restorestack(L, oldtop);
+ }
+ }
+ /* else no metamethod; ignore this case and keep original error */
+ }
+ return status;
+}
+
+
+/*
+** Try to create a to-be-closed upvalue
+** (can raise a memory-allocation error)
+*/
+static void trynewtbcupval (lua_State *L, void *ud) {
+ newupval(L, 1, cast(StkId, ud), &L->openupval);
+}
+
+
+/*
+** Create a to-be-closed upvalue. If there is a memory error
+** when creating the upvalue, the closing method must be called here,
+** as there is no upvalue to call it later.
+*/
+void luaF_newtbcupval (lua_State *L, StkId level) {
+ TValue *obj = s2v(level);
+ lua_assert(L->openupval == NULL || uplevel(L->openupval) < level);
+ if (!l_isfalse(obj)) { /* false doesn't need to be closed */
+ int status;
+ const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
+ if (ttisnil(tm)) /* no metamethod? */
+ varerror(L, level, "variable '%s' got a non-closable value");
+ status = luaD_rawrunprotected(L, trynewtbcupval, level);
+ if (unlikely(status != LUA_OK)) { /* memory error creating upvalue? */
+ lua_assert(status == LUA_ERRMEM);
+ luaD_seterrorobj(L, LUA_ERRMEM, level + 1); /* save error message */
+ /* next call must succeed, as object is closable */
+ prepclosingmethod(L, s2v(level), s2v(level + 1));
+ callclose(L, NULL); /* call closing method */
+ luaD_throw(L, LUA_ERRMEM); /* throw memory error */
}
}
}
+void luaF_unlinkupval (UpVal *uv) {
+ lua_assert(upisopen(uv));
+ *uv->u.open.previous = uv->u.open.next;
+ if (uv->u.open.next)
+ uv->u.open.next->u.open.previous = uv->u.open.previous;
+}
+
+
+int luaF_close (lua_State *L, StkId level, int status) {
+ UpVal *uv;
+ while ((uv = L->openupval) != NULL && uplevel(uv) >= level) {
+ TValue *slot = &uv->u.value; /* new position for value */
+ lua_assert(uplevel(uv) < L->top);
+ if (uv->tbc && status != NOCLOSINGMETH) {
+ /* must run closing method, which may change the stack */
+ ptrdiff_t levelrel = savestack(L, level);
+ status = callclosemth(L, uplevel(uv), status);
+ level = restorestack(L, levelrel);
+ }
+ luaF_unlinkupval(uv);
+ setobj(L, slot, uv->v); /* move value to upvalue slot */
+ uv->v = slot; /* now current value lives here */
+ if (!iswhite(uv))
+ gray2black(uv); /* closed upvalues cannot be gray */
+ luaC_barrier(L, uv, slot);
+ }
+ return status;
+}
+
+
Proto *luaF_newproto (lua_State *L) {
- GCObject *o = luaC_newobj(L, LUA_TPROTO, sizeof(Proto));
+ GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
Proto *f = gco2p(o);
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->abslineinfo = NULL;
+ f->sizeabslineinfo = 0;
f->upvalues = NULL;
f->sizeupvalues = 0;
f->numparams = 0;
@@ -127,6 +274,7 @@
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->abslineinfo, f->sizeabslineinfo);
luaM_freearray(L, f->locvars, f->sizelocvars);
luaM_freearray(L, f->upvalues, f->sizeupvalues);
luaM_free(L, f);
diff --git a/src/lfunc.h b/src/lfunc.h
index c916e98..8d6f965 100644
--- a/src/lfunc.h
+++ b/src/lfunc.h
@@ -1,5 +1,5 @@
/*
-** $Id: lfunc.h,v 2.15.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lfunc.h $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
@@ -11,11 +11,11 @@
#include "lobject.h"
-#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \
- cast(int, sizeof(TValue)*((n)-1)))
+#define sizeCclosure(n) (cast_int(offsetof(CClosure, upvalue)) + \
+ cast_int(sizeof(TValue)) * (n))
-#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \
- cast(int, sizeof(TValue *)*((n)-1)))
+#define sizeLclosure(n) (cast_int(offsetof(LClosure, upvals)) + \
+ cast_int(sizeof(TValue *)) * (n))
/* test whether thread is in 'twups' list */
@@ -29,30 +29,38 @@
#define MAXUPVAL 255
-/*
-** Upvalues for Lua closures
-*/
-struct UpVal {
- TValue *v; /* points to stack or to its own value */
- lu_mem refcount; /* reference counter */
- union {
- struct { /* (when open) */
- UpVal *next; /* linked list */
- int touched; /* mark to avoid cycles with dead threads */
- } open;
- TValue value; /* the value (when closed) */
- } u;
-};
-
#define upisopen(up) ((up)->v != &(up)->u.value)
+#define uplevel(up) check_exp(upisopen(up), cast(StkId, (up)->v))
+
+
+/*
+** maximum number of misses before giving up the cache of closures
+** in prototypes
+*/
+#define MAXMISS 10
+
+
+/*
+** Special "status" for 'luaF_close'
+*/
+
+/* close upvalues without running their closing methods */
+#define NOCLOSINGMETH (-1)
+
+/* close upvalues running all closing methods in protected mode */
+#define CLOSEPROTECT (-2)
+
+
LUAI_FUNC Proto *luaF_newproto (lua_State *L);
-LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nelems);
-LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nelems);
+LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nupvals);
+LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nupvals);
LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);
LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
-LUAI_FUNC void luaF_close (lua_State *L, StkId level);
+LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level);
+LUAI_FUNC int luaF_close (lua_State *L, StkId level, int status);
+LUAI_FUNC void luaF_unlinkupval (UpVal *uv);
LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
int pc);
diff --git a/src/lgc.c b/src/lgc.c
index db4df82..f26c921 100644
--- a/src/lgc.c
+++ b/src/lgc.c
@@ -1,5 +1,5 @@
/*
-** $Id: lgc.c,v 2.215.1.2 2017/08/31 16:15:27 roberto Exp $
+** $Id: lgc.c $
** Garbage Collector
** See Copyright Notice in lua.h
*/
@@ -9,9 +9,10 @@
#include "lprefix.h"
-
+#include <stdio.h>
#include <string.h>
+
#include "lua.h"
#include "ldebug.h"
@@ -27,29 +28,29 @@
/*
-** internal state for collector while inside the atomic phase. The
-** collector should never be in this state while running regular code.
+** Maximum number of elements to sweep in each single step.
+** (Large enough to dissipate fixed overheads but small enough
+** to allow small steps for the collector.)
*/
-#define GCSinsideatomic (GCSpause + 1)
+#define GCSWEEPMAX 100
/*
-** cost of sweeping one element (the size of a small object divided
-** by some adjust for the sweep speed)
+** Maximum number of finalizers to call in each single step.
*/
-#define GCSWEEPCOST ((sizeof(TString) + 4) / 4)
-
-/* maximum number of elements to sweep in each single step */
-#define GCSWEEPMAX (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4))
-
-/* cost of calling one finalizer */
-#define GCFINALIZECOST GCSWEEPCOST
+#define GCFINMAX 10
/*
-** macro to adjust 'stepmul': 'stepmul' is actually used like
-** 'stepmul / STEPMULADJ' (value chosen by tests)
+** Cost of calling one finalizer.
*/
-#define STEPMULADJ 200
+#define GCFINALIZECOST 50
+
+
+/*
+** The equivalent, in bytes, of one unit of "work" (visiting a slot,
+** sweeping an object, etc.)
+*/
+#define WORK2MEM sizeof(TValue)
/*
@@ -59,11 +60,11 @@
#define PAUSEADJ 100
-/*
-** 'makewhite' erases all color bits then sets only the current white
-** bit
-*/
-#define maskcolors (~(bitmask(BLACKBIT) | WHITEBITS))
+/* mask to erase all color bits (plus gen. related stuff) */
+#define maskcolors (~(bitmask(BLACKBIT) | WHITEBITS | AGEBITS))
+
+
+/* macro to erase all color bits then sets only the current white bit */
#define makewhite(g,x) \
(x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g)))
@@ -73,16 +74,23 @@
#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
-#define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n)))
+#define keyiswhite(n) (keyiscollectable(n) && iswhite(gckey(n)))
#define checkconsistency(obj) \
lua_longassert(!iscollectable(obj) || righttt(obj))
+/*
+** Protected access to objects in values
+*/
+#define gcvalueN(o) (iscollectable(o) ? gcvalue(o) : NULL)
+
#define markvalue(g,o) { checkconsistency(o); \
if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
+#define markkey(g, n) { if keyiswhite(n) reallymarkobject(g,gckey(n)); }
+
#define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }
/*
@@ -92,6 +100,8 @@
#define markobjectN(g,t) { if (t) markobject(g,t); }
static void reallymarkobject (global_State *g, GCObject *o);
+static lu_mem atomic (lua_State *L);
+static void entersweep (lua_State *L);
/*
@@ -104,28 +114,52 @@
/*
** one after last element in a hash array
*/
-#define gnodelast(h) gnode(h, cast(size_t, sizenode(h)))
+#define gnodelast(h) gnode(h, cast_sizet(sizenode(h)))
+
+
+static GCObject **getgclist (GCObject *o) {
+ switch (o->tt) {
+ case LUA_VTABLE: return &gco2t(o)->gclist;
+ case LUA_VLCL: return &gco2lcl(o)->gclist;
+ case LUA_VCCL: return &gco2ccl(o)->gclist;
+ case LUA_VTHREAD: return &gco2th(o)->gclist;
+ case LUA_VPROTO: return &gco2p(o)->gclist;
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ lua_assert(u->nuvalue > 0);
+ return &u->gclist;
+ }
+ default: lua_assert(0); return 0;
+ }
+}
/*
-** link collectable object 'o' into list pointed by 'p'
+** Link a collectable object 'o' with a known type into list pointed by 'p'.
*/
#define linkgclist(o,p) ((o)->gclist = (p), (p) = obj2gco(o))
/*
-** If key is not marked, mark its entry as dead. This allows key to be
-** collected, but keeps its entry in the table. A dead node is needed
-** when Lua looks up for a key (it may be part of a chain) and when
-** traversing a weak table (key might be removed from the table during
-** traversal). Other places never manipulate dead keys, because its
-** associated nil value is enough to signal that the entry is logically
-** empty.
+** Link a generic collectable object 'o' into list pointed by 'p'.
*/
-static void removeentry (Node *n) {
- lua_assert(ttisnil(gval(n)));
- if (valiswhite(gkey(n)))
- setdeadvalue(wgkey(n)); /* unused and unmarked key; remove it */
+#define linkobjgclist(o,p) (*getgclist(o) = (p), (p) = obj2gco(o))
+
+
+
+/*
+** Clear keys for empty entries in tables. If entry is empty
+** and its key is not marked, mark its entry as dead. This allows the
+** collection of the key, but keeps its entry in the table (its removal
+** could break a chain). The main feature of a dead key is that it must
+** be different from any other value, to do not disturb searches.
+** Other places never manipulate dead keys, because its associated empty
+** value is enough to signal that the entry is logically empty.
+*/
+static void clearkey (Node *n) {
+ lua_assert(isempty(gval(n)));
+ if (keyiswhite(n))
+ setdeadkey(n); /* unused and unmarked key; remove it */
}
@@ -136,27 +170,36 @@
** 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, tsvalue(o)); /* strings are 'values', so are never weak */
+static int iscleared (global_State *g, const GCObject *o) {
+ if (o == NULL) return 0; /* non-collectable value */
+ else if (novariant(o->tt) == LUA_TSTRING) {
+ markobject(g, o); /* strings are 'values', so are never weak */
return 0;
}
- else return iswhite(gcvalue(o));
+ else return iswhite(o);
}
/*
** barrier that moves collector forward, that is, mark the white object
-** being pointed by a black object. (If in sweep phase, clear the black
-** object to white [sweep it] to avoid other barrier calls for this
-** same object.)
+** 'v' being pointed by the black object 'o'. (If in sweep phase, clear
+** the black object to white [sweep it] to avoid other barrier calls for
+** this same object.) In the generational mode, 'v' must also become
+** old, if 'o' is old; however, it cannot be changed directly to OLD,
+** because it may still point to non-old objects. So, it is marked as
+** OLD0. In the next cycle it will become OLD1, and in the next it
+** will finally become OLD (regular old).
*/
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));
- if (keepinvariant(g)) /* must keep invariant? */
+ if (keepinvariant(g)) { /* must keep invariant? */
reallymarkobject(g, v); /* restore invariant */
+ if (isold(o)) {
+ lua_assert(!isold(v)); /* white object could not be old */
+ setage(v, G_OLD0); /* restore generational invariant */
+ }
+ }
else { /* sweep phase */
lua_assert(issweepphase(g));
makewhite(g, o); /* mark main obj. as white to avoid other barriers */
@@ -168,26 +211,14 @@
** barrier that moves collector backward, that is, mark the black object
** pointing to a white object as gray again.
*/
-void luaC_barrierback_ (lua_State *L, Table *t) {
+void luaC_barrierback_ (lua_State *L, GCObject *o) {
global_State *g = G(L);
- lua_assert(isblack(t) && !isdead(g, t));
- black2gray(t); /* make table gray (again) */
- linkgclist(t, g->grayagain);
-}
-
-
-/*
-** barrier for assignments to closed upvalues. Because upvalues are
-** shared among closures, it is impossible to know the color of all
-** closures pointing to it. So, we assume that the object being assigned
-** must be marked.
-*/
-void luaC_upvalbarrier_ (lua_State *L, UpVal *uv) {
- global_State *g = G(L);
- GCObject *o = gcvalue(uv->v);
- lua_assert(!upisopen(uv)); /* ensured by macro luaC_upvalbarrier */
- if (keepinvariant(g))
- markobject(g, o);
+ lua_assert(isblack(o) && !isdead(g, o));
+ lua_assert(g->gckind != KGC_GEN || (isold(o) && getage(o) != G_TOUCHED1));
+ if (getage(o) != G_TOUCHED2) /* not already in gray list? */
+ linkobjgclist(o, g->grayagain); /* link it in 'grayagain' */
+ black2gray(o); /* make object gray (again) */
+ setage(o, G_TOUCHED1); /* touched in current cycle */
}
@@ -195,6 +226,7 @@
global_State *g = G(L);
lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */
white2gray(o); /* they will be gray forever */
+ setage(o, G_OLD); /* and old forever */
g->allgc = o->next; /* remove object from 'allgc' list */
o->next = g->fixedgc; /* link it to 'fixedgc' list */
g->fixedgc = o;
@@ -227,55 +259,39 @@
/*
-** mark an object. Userdata, strings, and closed upvalues are visited
+** 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.)
+** upvalues are already linked in 'headuv' list. They are kept gray
+** to avoid barriers, as their values will be revisited by the thread.)
*/
static void reallymarkobject (global_State *g, GCObject *o) {
- reentry:
white2gray(o);
switch (o->tt) {
- case LUA_TSHRSTR: {
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR: {
gray2black(o);
- g->GCmemtrav += sizelstring(gco2ts(o)->shrlen);
break;
}
- case LUA_TLNGSTR: {
- gray2black(o);
- g->GCmemtrav += sizelstring(gco2ts(o)->u.lnglen);
+ case LUA_VUPVAL: {
+ UpVal *uv = gco2upv(o);
+ if (!upisopen(uv)) /* open upvalues are kept gray */
+ gray2black(o);
+ markvalue(g, uv->v); /* mark its content */
break;
}
- case LUA_TUSERDATA: {
- TValue uvalue;
- markobjectN(g, gco2u(o)->metatable); /* mark its metatable */
- gray2black(o);
- g->GCmemtrav += sizeudata(gco2u(o));
- getuservalue(g->mainthread, gco2u(o), &uvalue);
- if (valiswhite(&uvalue)) { /* markvalue(g, &uvalue); */
- o = gcvalue(&uvalue);
- goto reentry;
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ if (u->nuvalue == 0) { /* no user values? */
+ markobjectN(g, u->metatable); /* mark its metatable */
+ gray2black(o); /* nothing else to mark */
+ break;
}
- break;
- }
- case LUA_TLCL: {
- linkgclist(gco2lcl(o), g->gray);
- break;
- }
- case LUA_TCCL: {
- linkgclist(gco2ccl(o), g->gray);
- break;
- }
- case LUA_TTABLE: {
- linkgclist(gco2t(o), g->gray);
- break;
- }
- case LUA_TTHREAD: {
- linkgclist(gco2th(o), g->gray);
- break;
- }
- case LUA_TPROTO: {
- linkgclist(gco2p(o), g->gray);
+ /* else... */
+ } /* FALLTHROUGH */
+ case LUA_VLCL: case LUA_VCCL: case LUA_VTABLE:
+ case LUA_VTHREAD: case LUA_VPROTO: {
+ linkobjgclist(o, g->gray);
break;
}
default: lua_assert(0); break;
@@ -296,10 +312,14 @@
/*
** mark all objects in list of being-finalized
*/
-static void markbeingfnz (global_State *g) {
+static lu_mem markbeingfnz (global_State *g) {
GCObject *o;
- for (o = g->tobefnz; o != NULL; o = o->next)
+ lu_mem count = 0;
+ for (o = g->tobefnz; o != NULL; o = o->next) {
+ count++;
markobject(g, o);
+ }
+ return count;
}
@@ -309,10 +329,12 @@
** thread.) Remove from the list threads that no longer have upvalues and
** not-marked threads.
*/
-static void remarkupvals (global_State *g) {
+static int remarkupvals (global_State *g) {
lua_State *thread;
lua_State **p = &g->twups;
+ int work = 0;
while ((thread = *p) != NULL) {
+ work++;
lua_assert(!isblack(thread)); /* threads are never black */
if (isgray(thread) && thread->openupval != NULL)
p = &thread->twups; /* keep marked thread with upvalues in the list */
@@ -321,13 +343,13 @@
*p = thread->twups; /* remove thread from the list */
thread->twups = thread; /* mark that it is out of list */
for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
- if (uv->u.open.touched) {
- markvalue(g, uv->v); /* remark upvalue's value */
- uv->u.open.touched = 0;
- }
+ work++;
+ if (!iswhite(uv)) /* upvalue already visited? */
+ markvalue(g, uv->v); /* mark its value */
}
}
}
+ return work;
}
@@ -362,22 +384,21 @@
Node *n, *limit = gnodelast(h);
/* if there is array part, assume it may have white values (it is not
worth traversing it now just to check) */
- int hasclears = (h->sizearray > 0);
+ int hasclears = (h->alimit > 0);
for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
- checkdeadkey(n);
- if (ttisnil(gval(n))) /* entry is empty? */
- removeentry(n); /* remove it */
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
else {
- lua_assert(!ttisnil(gkey(n)));
- markvalue(g, gkey(n)); /* mark key */
- if (!hasclears && iscleared(g, gval(n))) /* is there a white value? */
+ lua_assert(!keyisnil(n));
+ markkey(g, n);
+ if (!hasclears && iscleared(g, gcvalueN(gval(n)))) /* a white value? */
hasclears = 1; /* table will have to be cleared */
}
}
- if (g->gcstate == GCSpropagate)
- linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
- else if (hasclears)
+ if (g->gcstate == GCSatomic && hasclears)
linkgclist(h, g->weak); /* has to be cleared later */
+ else
+ linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
}
@@ -389,27 +410,30 @@
** the atomic phase, if table has any white->white entry, it has to
** be revisited during ephemeron convergence (as that key may turn
** black). Otherwise, if it has any white key, table has to be cleared
-** (in the atomic phase).
+** (in the atomic phase). In generational mode, it (like all visited
+** tables) must be kept in some gray list for post-processing.
*/
-static int traverseephemeron (global_State *g, Table *h) {
+static int traverseephemeron (global_State *g, Table *h, int inv) {
int marked = 0; /* true if an object is marked in this traversal */
int hasclears = 0; /* true if table has white keys */
int hasww = 0; /* true if table has entry "white-key -> white-value" */
- Node *n, *limit = gnodelast(h);
unsigned int i;
+ unsigned int asize = luaH_realasize(h);
+ unsigned int nsize = sizenode(h);
/* traverse array part */
- for (i = 0; i < h->sizearray; i++) {
+ for (i = 0; i < asize; 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)? */
+ /* traverse hash part; if 'inv', traverse descending
+ (see 'convergeephemerons') */
+ for (i = 0; i < nsize; i++) {
+ Node *n = inv ? gnode(h, nsize - 1 - i) : gnode(h, i);
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
+ else if (iscleared(g, gckeyN(n))) { /* key is not marked (yet)? */
hasclears = 1; /* table must be cleared */
if (valiswhite(gval(n))) /* value not marked yet? */
hasww = 1; /* white-white entry */
@@ -426,6 +450,10 @@
linkgclist(h, g->ephemeron); /* have to propagate again */
else if (hasclears) /* table has white keys? */
linkgclist(h, g->allweak); /* may have to clean white keys */
+ else if (g->gckind == KGC_GEN)
+ linkgclist(h, g->grayagain); /* keep it in some list */
+ else
+ gray2black(h);
return marked;
}
@@ -433,18 +461,22 @@
static void traversestrongtable (global_State *g, Table *h) {
Node *n, *limit = gnodelast(h);
unsigned int i;
- for (i = 0; i < h->sizearray; i++) /* traverse array part */
+ unsigned int asize = luaH_realasize(h);
+ for (i = 0; i < asize; 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 */
+ if (isempty(gval(n))) /* entry is empty? */
+ clearkey(n); /* clear its key */
else {
- lua_assert(!ttisnil(gkey(n)));
- markvalue(g, gkey(n)); /* mark key */
- markvalue(g, gval(n)); /* mark value */
+ lua_assert(!keyisnil(n));
+ markkey(g, n);
+ markvalue(g, gval(n));
}
}
+ if (g->gckind == KGC_GEN) {
+ linkgclist(h, g->grayagain); /* keep it in some gray list */
+ black2gray(h);
+ }
}
@@ -453,21 +485,33 @@
const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
markobjectN(g, h->metatable);
if (mode && ttisstring(mode) && /* is there a weak mode? */
- ((weakkey = strchr(svalue(mode), 'k')),
- (weakvalue = strchr(svalue(mode), 'v')),
+ (cast_void(weakkey = strchr(svalue(mode), 'k')),
+ cast_void(weakvalue = strchr(svalue(mode), 'v')),
(weakkey || weakvalue))) { /* is really weak? */
black2gray(h); /* keep table gray */
if (!weakkey) /* strong keys? */
traverseweakvalue(g, h);
else if (!weakvalue) /* strong values? */
- traverseephemeron(g, h);
+ traverseephemeron(g, h, 0);
else /* all weak */
linkgclist(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, allocsizenode(h));
+ return 1 + h->alimit + 2 * allocsizenode(h);
+}
+
+
+static int traverseudata (global_State *g, Udata *u) {
+ int i;
+ markobjectN(g, u->metatable); /* mark its metatable */
+ for (i = 0; i < u->nuvalue; i++)
+ markvalue(g, &u->uv[i].uv);
+ if (g->gckind == KGC_GEN) {
+ linkgclist(u, g->grayagain); /* keep it in some gray list */
+ black2gray(u);
+ }
+ return 1 + u->nuvalue;
}
@@ -478,8 +522,6 @@
*/
static int traverseproto (global_State *g, Proto *f) {
int i;
- if (f->cache && iswhite(f->cache))
- f->cache = NULL; /* allow cache to be collected */
markobjectN(g, f->source);
for (i = 0; i < f->sizek; i++) /* mark literals */
markvalue(g, &f->k[i]);
@@ -489,66 +531,61 @@
markobjectN(g, f->p[i]);
for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */
markobjectN(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;
+ return 1 + f->sizek + f->sizeupvalues + f->sizep + f->sizelocvars;
}
-static lu_mem traverseCclosure (global_State *g, CClosure *cl) {
+static int 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);
+ return 1 + cl->nupvalues;
}
/*
-** open upvalues point to values in a thread, so those values should
-** be marked when the thread is traversed except in the atomic phase
-** (because then the value cannot be changed by the thread and the
-** thread may not be traversed again)
+** Traverse a Lua closure, marking its prototype and its upvalues.
+** (Both can be NULL while closure is being created.)
*/
-static lu_mem traverseLclosure (global_State *g, LClosure *cl) {
+static int traverseLclosure (global_State *g, LClosure *cl) {
int i;
markobjectN(g, cl->p); /* mark its prototype */
- for (i = 0; i < cl->nupvalues; i++) { /* mark its upvalues */
+ for (i = 0; i < cl->nupvalues; i++) { /* visit its upvalues */
UpVal *uv = cl->upvals[i];
- if (uv != NULL) {
- if (upisopen(uv) && g->gcstate != GCSinsideatomic)
- uv->u.open.touched = 1; /* can be marked in 'remarkupvals' */
- else
- markvalue(g, uv->v);
- }
+ markobjectN(g, uv); /* mark upvalue */
}
- return sizeLclosure(cl->nupvalues);
+ return 1 + cl->nupvalues;
}
-static lu_mem traversethread (global_State *g, lua_State *th) {
+/*
+** Traverse a thread, marking the elements in the stack up to its top
+** and cleaning the rest of the stack in the final traversal.
+** That ensures that the entire stack have valid (non-dead) objects.
+*/
+static int traversethread (global_State *g, lua_State *th) {
+ UpVal *uv;
StkId o = th->stack;
if (o == NULL)
return 1; /* stack not completely built yet */
- lua_assert(g->gcstate == GCSinsideatomic ||
+ lua_assert(g->gcstate == GCSatomic ||
th->openupval == NULL || isintwups(th));
for (; o < th->top; o++) /* mark live elements in the stack */
- markvalue(g, o);
- if (g->gcstate == GCSinsideatomic) { /* final traversal? */
+ markvalue(g, s2v(o));
+ for (uv = th->openupval; uv != NULL; uv = uv->u.open.next)
+ markobject(g, uv); /* open upvalues cannot be collected */
+ 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);
+ setnilvalue(s2v(o));
/* 'remarkupvals' may have removed thread from 'twups' list */
if (!isintwups(th) && th->openupval != NULL) {
th->twups = g->twups; /* link it back to the list */
g->twups = th;
}
}
- else if (g->gckind != KGC_EMERGENCY)
+ else if (!g->gcemergency)
luaD_shrinkstack(th); /* do not change stack in emergency cycle */
- return (sizeof(lua_State) + sizeof(TValue) * th->stacksize +
- sizeof(CallInfo) * th->nci);
+ return 1 + th->stacksize;
}
@@ -556,70 +593,59 @@
** traverse one gray object, turning it to black (except for threads,
** which are always gray).
*/
-static void propagatemark (global_State *g) {
- lu_mem size;
+static lu_mem propagatemark (global_State *g) {
GCObject *o = g->gray;
- lua_assert(isgray(o));
gray2black(o);
+ g->gray = *getgclist(o); /* remove from 'gray' list */
switch (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: {
+ case LUA_VTABLE: return traversetable(g, gco2t(o));
+ case LUA_VUSERDATA: return traverseudata(g, gco2u(o));
+ case LUA_VLCL: return traverseLclosure(g, gco2lcl(o));
+ case LUA_VCCL: return traverseCclosure(g, gco2ccl(o));
+ case LUA_VPROTO: return traverseproto(g, gco2p(o));
+ case LUA_VTHREAD: {
lua_State *th = gco2th(o);
- g->gray = th->gclist; /* remove from 'gray' list */
linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
black2gray(o);
- size = traversethread(g, th);
- break;
+ return traversethread(g, th);
}
- 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;
+ default: lua_assert(0); return 0;
}
- g->GCmemtrav += size;
}
-static void propagateall (global_State *g) {
- while (g->gray) propagatemark(g);
+static lu_mem propagateall (global_State *g) {
+ lu_mem tot = 0;
+ while (g->gray)
+ tot += propagatemark(g);
+ return tot;
}
+/*
+** Traverse all ephemeron tables propagating marks from keys to values.
+** Repeat until it converges, that is, nothing new is marked. 'dir'
+** inverts the direction of the traversals, trying to speed up
+** convergence on chains in the same table.
+**
+*/
static void convergeephemerons (global_State *g) {
int changed;
+ int dir = 0;
do {
GCObject *w;
GCObject *next = g->ephemeron; /* get ephemeron list */
g->ephemeron = NULL; /* tables may 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? */
+ while ((w = next) != NULL) { /* for each ephemeron table */
+ next = gco2t(w)->gclist; /* list is rebuilt during loop */
+ if (traverseephemeron(g, gco2t(w), dir)) { /* marked some value? */
propagateall(g); /* propagate changes */
changed = 1; /* will have to revisit all ephemeron tables */
}
}
- } while (changed);
+ dir = !dir; /* invert direction next time */
+ } while (changed); /* repeat until no more changes */
}
/* }====================================================== */
@@ -633,19 +659,18 @@
/*
-** clear entries with unmarked keys from all weaktables in list 'l' up
-** to element 'f'
+** clear entries with unmarked keys from all weaktables in list 'l'
*/
-static void clearkeys (global_State *g, GCObject *l, GCObject *f) {
- for (; l != f; l = gco2t(l)->gclist) {
+static void clearbykeys (global_State *g, GCObject *l) {
+ for (; l; l = gco2t(l)->gclist) {
Table *h = gco2t(l);
- Node *n, *limit = gnodelast(h);
+ Node *limit = gnodelast(h);
+ Node *n;
for (n = gnode(h, 0); n < limit; n++) {
- if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) {
- setnilvalue(gval(n)); /* remove value ... */
- }
- if (ttisnil(gval(n))) /* is entry empty? */
- removeentry(n); /* remove entry from table */
+ if (iscleared(g, gckeyN(n))) /* unmarked key? */
+ setempty(gval(n)); /* remove entry */
+ if (isempty(gval(n))) /* is entry empty? */
+ clearkey(n); /* clear its key */
}
}
}
@@ -655,88 +680,85 @@
** 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) {
+static void clearbyvalues (global_State *g, GCObject *l, GCObject *f) {
for (; l != f; l = gco2t(l)->gclist) {
Table *h = gco2t(l);
Node *n, *limit = gnodelast(h);
unsigned int i;
- for (i = 0; i < h->sizearray; i++) {
+ unsigned int asize = luaH_realasize(h);
+ for (i = 0; i < asize; i++) {
TValue *o = &h->array[i];
- if (iscleared(g, o)) /* value was collected? */
- setnilvalue(o); /* remove value */
+ if (iscleared(g, gcvalueN(o))) /* value was collected? */
+ setempty(o); /* remove entry */
}
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 */
- }
+ if (iscleared(g, gcvalueN(gval(n)))) /* unmarked value? */
+ setempty(gval(n)); /* remove entry */
+ if (isempty(gval(n))) /* is entry empty? */
+ clearkey(n); /* clear its key */
}
}
}
-void luaC_upvdeccount (lua_State *L, UpVal *uv) {
- lua_assert(uv->refcount > 0);
- uv->refcount--;
- if (uv->refcount == 0 && !upisopen(uv))
- luaM_free(L, uv);
-}
-
-
-static void freeLclosure (lua_State *L, LClosure *cl) {
- int i;
- for (i = 0; i < cl->nupvalues; i++) {
- UpVal *uv = cl->upvals[i];
- if (uv)
- luaC_upvdeccount(L, uv);
- }
- luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));
+static void freeupval (lua_State *L, UpVal *uv) {
+ if (upisopen(uv))
+ luaF_unlinkupval(uv);
+ luaM_free(L, uv);
}
static void freeobj (lua_State *L, GCObject *o) {
switch (o->tt) {
- case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break;
- case LUA_TLCL: {
- freeLclosure(L, gco2lcl(o));
+ case LUA_VPROTO:
+ luaF_freeproto(L, gco2p(o));
break;
- }
- case LUA_TCCL: {
+ case LUA_VUPVAL:
+ freeupval(L, gco2upv(o));
+ break;
+ case LUA_VLCL:
+ luaM_freemem(L, o, sizeLclosure(gco2lcl(o)->nupvalues));
+ break;
+ case LUA_VCCL:
luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));
break;
+ case LUA_VTABLE:
+ luaH_free(L, gco2t(o));
+ break;
+ case LUA_VTHREAD:
+ luaE_freethread(L, gco2th(o));
+ break;
+ case LUA_VUSERDATA: {
+ Udata *u = gco2u(o);
+ luaM_freemem(L, o, sizeudata(u->nuvalue, u->len));
+ 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:
+ case LUA_VSHRSTR:
luaS_remove(L, gco2ts(o)); /* remove it from hash table */
luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen));
break;
- case LUA_TLNGSTR: {
+ case LUA_VLNGSTR:
luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen));
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 at most 'count' elements from a list of GCObjects erasing dead
+** sweep at most 'countin' elements from a list of GCObjects erasing dead
** objects, where a dead object is one marked with the old (non current)
** white; change all non-dead objects back to white, preparing for next
** collection cycle. Return where to continue the traversal or NULL if
-** list is finished.
+** list is finished. ('*countout' gets the number of elements traversed.)
*/
-static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {
+static GCObject **sweeplist (lua_State *L, GCObject **p, int countin,
+ int *countout) {
global_State *g = G(L);
int ow = otherwhite(g);
+ int i;
int white = luaC_white(g); /* current white */
- while (*p != NULL && count-- > 0) {
+ for (i = 0; *p != NULL && i < countin; i++) {
GCObject *curr = *p;
int marked = curr->marked;
if (isdeadm(ow, marked)) { /* is 'curr' dead? */
@@ -748,6 +770,8 @@
p = &curr->next; /* go to next element */
}
}
+ if (countout)
+ *countout = i; /* number of elements traversed */
return (*p == NULL) ? NULL : p;
}
@@ -758,7 +782,7 @@
static GCObject **sweeptolive (lua_State *L, GCObject **p) {
GCObject **old = p;
do {
- p = sweeplist(L, p, 1);
+ p = sweeplist(L, p, 1, NULL);
} while (p == old);
return p;
}
@@ -773,18 +797,23 @@
*/
/*
-** If possible, shrink string table
+** If possible, shrink string table.
*/
static void checkSizes (lua_State *L, global_State *g) {
- if (g->gckind != KGC_EMERGENCY) {
- l_mem olddebt = g->GCdebt;
- if (g->strt.nuse < g->strt.size / 4) /* string table too big? */
- luaS_resize(L, g->strt.size / 2); /* shrink it a little */
- g->GCestimate += g->GCdebt - olddebt; /* update estimate */
+ if (!g->gcemergency) {
+ if (g->strt.nuse < g->strt.size / 4) { /* string table too big? */
+ l_mem olddebt = g->GCdebt;
+ luaS_resize(L, g->strt.size / 2);
+ g->GCestimate += g->GCdebt - olddebt; /* correct estimate */
+ }
}
}
+/*
+** Get the next udata to be finalized from the 'tobefnz' list, and
+** link it back into the 'allgc' list.
+*/
static GCObject *udata2finalize (global_State *g) {
GCObject *o = g->tobefnz; /* get first element */
lua_assert(tofinalize(o));
@@ -804,51 +833,42 @@
}
-static void GCTM (lua_State *L, int propagateerrors) {
+static void GCTM (lua_State *L) {
global_State *g = G(L);
const TValue *tm;
TValue v;
+ lua_assert(!g->gcemergency);
setgcovalue(L, &v, udata2finalize(g));
tm = luaT_gettmbyobj(L, &v, TM_GC);
- if (tm != NULL && ttisfunction(tm)) { /* is there a finalizer? */
+ if (!notm(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 */
+ setobj2s(L, L->top++, tm); /* push finalizer... */
+ setobj2s(L, L->top++, &v); /* ... and its argument */
L->ci->callstatus |= CIST_FIN; /* will run a finalizer */
status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
L->ci->callstatus &= ~CIST_FIN; /* not running a finalizer anymore */
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 */
+ if (unlikely(status != LUA_OK)) { /* error while running __gc? */
+ luaE_warnerror(L, "__gc metamethod");
+ L->top--; /* pops error object */
}
}
}
/*
-** call a few (up to 'g->gcfinnum') finalizers
+** Call a few finalizers
*/
-static int runafewfinalizers (lua_State *L) {
+static int runafewfinalizers (lua_State *L, int n) {
global_State *g = G(L);
- unsigned int i;
- lua_assert(!g->tobefnz || g->gcfinnum > 0);
- for (i = 0; g->tobefnz && i < g->gcfinnum; i++)
- GCTM(L, 1); /* call one finalizer */
- g->gcfinnum = (!g->tobefnz) ? 0 /* nothing more to finalize? */
- : g->gcfinnum * 2; /* else call a few more next time */
+ int i;
+ for (i = 0; i < n && g->tobefnz; i++)
+ GCTM(L); /* call one finalizer */
return i;
}
@@ -859,7 +879,7 @@
static void callallpendingfinalizers (lua_State *L) {
global_State *g = G(L);
while (g->tobefnz)
- GCTM(L, 0);
+ GCTM(L);
}
@@ -874,18 +894,23 @@
/*
-** move all unreachable objects (or 'all' objects) that need
-** finalization from list 'finobj' to list 'tobefnz' (to be finalized)
+** Move all unreachable objects (or 'all' objects) that need
+** finalization from list 'finobj' to list 'tobefnz' (to be finalized).
+** (Note that objects after 'finobjold' cannot be white, so they
+** don't need to be traversed. In incremental mode, 'finobjold' is NULL,
+** so the whole list is traversed.)
*/
static void separatetobefnz (global_State *g, int all) {
GCObject *curr;
GCObject **p = &g->finobj;
GCObject **lastnext = findlast(&g->tobefnz);
- while ((curr = *p) != NULL) { /* traverse all finalizable objects */
+ while ((curr = *p) != g->finobjold) { /* traverse all finalizable objects */
lua_assert(tofinalize(curr));
if (!(iswhite(curr) || all)) /* not being collected? */
p = &curr->next; /* don't bother with it */
else {
+ if (curr == g->finobjsur) /* removing 'finobjsur'? */
+ g->finobjsur = curr->next; /* correct it */
*p = curr->next; /* remove 'curr' from 'finobj' list */
curr->next = *lastnext; /* link at the end of 'tobefnz' list */
*lastnext = curr;
@@ -911,6 +936,14 @@
if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */
g->sweepgc = sweeptolive(L, g->sweepgc); /* change 'sweepgc' */
}
+ else { /* correct pointers into 'allgc' list, if needed */
+ if (o == g->survival)
+ g->survival = o->next;
+ if (o == g->old)
+ g->old = o->next;
+ if (o == g->reallyold)
+ g->reallyold = o->next;
+ }
/* search for pointer pointing to 'o' */
for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
*p = o->next; /* remove 'o' from 'allgc' list */
@@ -923,6 +956,390 @@
/* }====================================================== */
+/*
+** {======================================================
+** Generational Collector
+** =======================================================
+*/
+
+static void setpause (global_State *g);
+
+
+/* mask to erase all color bits, not changing gen-related stuff */
+#define maskgencolors (~(bitmask(BLACKBIT) | WHITEBITS))
+
+
+/*
+** Sweep a list of objects, deleting dead ones and turning
+** the non dead to old (without changing their colors).
+*/
+static void sweep2old (lua_State *L, GCObject **p) {
+ GCObject *curr;
+ while ((curr = *p) != NULL) {
+ if (iswhite(curr)) { /* is 'curr' dead? */
+ lua_assert(isdead(G(L), curr));
+ *p = curr->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else { /* all surviving objects become old */
+ setage(curr, G_OLD);
+ p = &curr->next; /* go to next element */
+ }
+ }
+}
+
+
+/*
+** Sweep for generational mode. Delete dead objects. (Because the
+** collection is not incremental, there are no "new white" objects
+** during the sweep. So, any white object must be dead.) For
+** non-dead objects, advance their ages and clear the color of
+** new objects. (Old objects keep their colors.)
+*/
+static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
+ GCObject *limit) {
+ static const lu_byte nextage[] = {
+ G_SURVIVAL, /* from G_NEW */
+ G_OLD1, /* from G_SURVIVAL */
+ G_OLD1, /* from G_OLD0 */
+ G_OLD, /* from G_OLD1 */
+ G_OLD, /* from G_OLD (do not change) */
+ G_TOUCHED1, /* from G_TOUCHED1 (do not change) */
+ G_TOUCHED2 /* from G_TOUCHED2 (do not change) */
+ };
+ int white = luaC_white(g);
+ GCObject *curr;
+ while ((curr = *p) != limit) {
+ if (iswhite(curr)) { /* is 'curr' dead? */
+ lua_assert(!isold(curr) && isdead(g, curr));
+ *p = curr->next; /* remove 'curr' from list */
+ freeobj(L, curr); /* erase 'curr' */
+ }
+ else { /* correct mark and age */
+ if (getage(curr) == G_NEW)
+ curr->marked = cast_byte((curr->marked & maskgencolors) | white);
+ setage(curr, nextage[getage(curr)]);
+ p = &curr->next; /* go to next element */
+ }
+ }
+ return p;
+}
+
+
+/*
+** Traverse a list making all its elements white and clearing their
+** age.
+*/
+static void whitelist (global_State *g, GCObject *p) {
+ int white = luaC_white(g);
+ for (; p != NULL; p = p->next)
+ p->marked = cast_byte((p->marked & maskcolors) | white);
+}
+
+
+/*
+** Correct a list of gray objects.
+** Because this correction is done after sweeping, young objects might
+** be turned white and still be in the list. They are only removed.
+** For tables and userdata, advance 'touched1' to 'touched2'; 'touched2'
+** objects become regular old and are removed from the list.
+** For threads, just remove white ones from the list.
+*/
+static GCObject **correctgraylist (GCObject **p) {
+ GCObject *curr;
+ while ((curr = *p) != NULL) {
+ switch (curr->tt) {
+ case LUA_VTABLE: case LUA_VUSERDATA: {
+ GCObject **next = getgclist(curr);
+ if (getage(curr) == G_TOUCHED1) { /* touched in this cycle? */
+ lua_assert(isgray(curr));
+ gray2black(curr); /* make it black, for next barrier */
+ changeage(curr, G_TOUCHED1, G_TOUCHED2);
+ p = next; /* go to next element */
+ }
+ else { /* not touched in this cycle */
+ if (!iswhite(curr)) { /* not white? */
+ lua_assert(isold(curr));
+ if (getage(curr) == G_TOUCHED2) /* advance from G_TOUCHED2... */
+ changeage(curr, G_TOUCHED2, G_OLD); /* ... to G_OLD */
+ gray2black(curr); /* make it black */
+ }
+ /* else, object is white: just remove it from this list */
+ *p = *next; /* remove 'curr' from gray list */
+ }
+ break;
+ }
+ case LUA_VTHREAD: {
+ lua_State *th = gco2th(curr);
+ lua_assert(!isblack(th));
+ if (iswhite(th)) /* new object? */
+ *p = th->gclist; /* remove from gray list */
+ else /* old threads remain gray */
+ p = &th->gclist; /* go to next element */
+ break;
+ }
+ default: lua_assert(0); /* nothing more could be gray here */
+ }
+ }
+ return p;
+}
+
+
+/*
+** Correct all gray lists, coalescing them into 'grayagain'.
+*/
+static void correctgraylists (global_State *g) {
+ GCObject **list = correctgraylist(&g->grayagain);
+ *list = g->weak; g->weak = NULL;
+ list = correctgraylist(list);
+ *list = g->allweak; g->allweak = NULL;
+ list = correctgraylist(list);
+ *list = g->ephemeron; g->ephemeron = NULL;
+ correctgraylist(list);
+}
+
+
+/*
+** Mark 'OLD1' objects when starting a new young collection.
+** Gray objects are already in some gray list, and so will be visited
+** in the atomic step.
+*/
+static void markold (global_State *g, GCObject *from, GCObject *to) {
+ GCObject *p;
+ for (p = from; p != to; p = p->next) {
+ if (getage(p) == G_OLD1) {
+ lua_assert(!iswhite(p));
+ if (isblack(p)) {
+ black2gray(p); /* should be '2white', but gray works too */
+ reallymarkobject(g, p);
+ }
+ }
+ }
+}
+
+
+/*
+** Finish a young-generation collection.
+*/
+static void finishgencycle (lua_State *L, global_State *g) {
+ correctgraylists(g);
+ checkSizes(L, g);
+ g->gcstate = GCSpropagate; /* skip restart */
+ if (!g->gcemergency)
+ callallpendingfinalizers(L);
+}
+
+
+/*
+** Does a young collection. First, mark 'OLD1' objects. (Only survival
+** and "recent old" lists can contain 'OLD1' objects. New lists cannot
+** contain 'OLD1' objects, at most 'OLD0' objects that were already
+** visited when marked old.) Then does the atomic step. Then,
+** sweep all lists and advance pointers. Finally, finish the collection.
+*/
+static void youngcollection (lua_State *L, global_State *g) {
+ GCObject **psurvival; /* to point to first non-dead survival object */
+ lua_assert(g->gcstate == GCSpropagate);
+ markold(g, g->survival, g->reallyold);
+ markold(g, g->finobj, g->finobjrold);
+ atomic(L);
+
+ /* sweep nursery and get a pointer to its last live element */
+ psurvival = sweepgen(L, g, &g->allgc, g->survival);
+ /* sweep 'survival' and 'old' */
+ sweepgen(L, g, psurvival, g->reallyold);
+ g->reallyold = g->old;
+ g->old = *psurvival; /* 'survival' survivals are old now */
+ g->survival = g->allgc; /* all news are survivals */
+
+ /* repeat for 'finobj' lists */
+ psurvival = sweepgen(L, g, &g->finobj, g->finobjsur);
+ /* sweep 'survival' and 'old' */
+ sweepgen(L, g, psurvival, g->finobjrold);
+ g->finobjrold = g->finobjold;
+ g->finobjold = *psurvival; /* 'survival' survivals are old now */
+ g->finobjsur = g->finobj; /* all news are survivals */
+
+ sweepgen(L, g, &g->tobefnz, NULL);
+
+ finishgencycle(L, g);
+}
+
+
+static void atomic2gen (lua_State *L, global_State *g) {
+ /* sweep all elements making them old */
+ sweep2old(L, &g->allgc);
+ /* everything alive now is old */
+ g->reallyold = g->old = g->survival = g->allgc;
+
+ /* repeat for 'finobj' lists */
+ sweep2old(L, &g->finobj);
+ g->finobjrold = g->finobjold = g->finobjsur = g->finobj;
+
+ sweep2old(L, &g->tobefnz);
+
+ g->gckind = KGC_GEN;
+ g->lastatomic = 0;
+ g->GCestimate = gettotalbytes(g); /* base for memory control */
+ finishgencycle(L, g);
+}
+
+
+/*
+** Enter generational mode. Must go until the end of an atomic cycle
+** to ensure that all threads and weak tables are in the gray lists.
+** Then, turn all objects into old and finishes the collection.
+*/
+static lu_mem entergen (lua_State *L, global_State *g) {
+ lu_mem numobjs;
+ luaC_runtilstate(L, bitmask(GCSpause)); /* prepare to start a new cycle */
+ luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
+ numobjs = atomic(L); /* propagates all and then do the atomic stuff */
+ atomic2gen(L, g);
+ return numobjs;
+}
+
+
+/*
+** Enter incremental mode. Turn all objects white, make all
+** intermediate lists point to NULL (to avoid invalid pointers),
+** and go to the pause state.
+*/
+static void enterinc (global_State *g) {
+ whitelist(g, g->allgc);
+ g->reallyold = g->old = g->survival = NULL;
+ whitelist(g, g->finobj);
+ whitelist(g, g->tobefnz);
+ g->finobjrold = g->finobjold = g->finobjsur = NULL;
+ g->gcstate = GCSpause;
+ g->gckind = KGC_INC;
+ g->lastatomic = 0;
+}
+
+
+/*
+** Change collector mode to 'newmode'.
+*/
+void luaC_changemode (lua_State *L, int newmode) {
+ global_State *g = G(L);
+ if (newmode != g->gckind) {
+ if (newmode == KGC_GEN) /* entering generational mode? */
+ entergen(L, g);
+ else
+ enterinc(g); /* entering incremental mode */
+ }
+ g->lastatomic = 0;
+}
+
+
+/*
+** Does a full collection in generational mode.
+*/
+static lu_mem fullgen (lua_State *L, global_State *g) {
+ enterinc(g);
+ return entergen(L, g);
+}
+
+
+/*
+** Set debt for the next minor collection, which will happen when
+** memory grows 'genminormul'%.
+*/
+static void setminordebt (global_State *g) {
+ luaE_setdebt(g, -(cast(l_mem, (gettotalbytes(g) / 100)) * g->genminormul));
+}
+
+
+/*
+** Does a major collection after last collection was a "bad collection".
+**
+** When the program is building a big structure, it allocates lots of
+** memory but generates very little garbage. In those scenarios,
+** the generational mode just wastes time doing small collections, and
+** major collections are frequently what we call a "bad collection", a
+** collection that frees too few objects. To avoid the cost of switching
+** between generational mode and the incremental mode needed for full
+** (major) collections, the collector tries to stay in incremental mode
+** after a bad collection, and to switch back to generational mode only
+** after a "good" collection (one that traverses less than 9/8 objects
+** of the previous one).
+** The collector must choose whether to stay in incremental mode or to
+** switch back to generational mode before sweeping. At this point, it
+** does not know the real memory in use, so it cannot use memory to
+** decide whether to return to generational mode. Instead, it uses the
+** number of objects traversed (returned by 'atomic') as a proxy. The
+** field 'g->lastatomic' keeps this count from the last collection.
+** ('g->lastatomic != 0' also means that the last collection was bad.)
+*/
+static void stepgenfull (lua_State *L, global_State *g) {
+ lu_mem newatomic; /* count of traversed objects */
+ lu_mem lastatomic = g->lastatomic; /* count from last collection */
+ if (g->gckind == KGC_GEN) /* still in generational mode? */
+ enterinc(g); /* enter incremental mode */
+ luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
+ newatomic = atomic(L); /* mark everybody */
+ if (newatomic < lastatomic + (lastatomic >> 3)) { /* good collection? */
+ atomic2gen(L, g); /* return to generational mode */
+ setminordebt(g);
+ }
+ else { /* another bad collection; stay in incremental mode */
+ g->GCestimate = gettotalbytes(g); /* first estimate */;
+ entersweep(L);
+ luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
+ setpause(g);
+ g->lastatomic = newatomic;
+ }
+}
+
+
+/*
+** Does a generational "step".
+** Usually, this means doing a minor collection and setting the debt to
+** make another collection when memory grows 'genminormul'% larger.
+**
+** However, there are exceptions. If memory grows 'genmajormul'%
+** larger than it was at the end of the last major collection (kept
+** in 'g->GCestimate'), the function does a major collection. At the
+** end, it checks whether the major collection was able to free a
+** decent amount of memory (at least half the growth in memory since
+** previous major collection). If so, the collector keeps its state,
+** and the next collection will probably be minor again. Otherwise,
+** we have what we call a "bad collection". In that case, set the field
+** 'g->lastatomic' to signal that fact, so that the next collection will
+** go to 'stepgenfull'.
+**
+** 'GCdebt <= 0' means an explicit call to GC step with "size" zero;
+** in that case, do a minor collection.
+*/
+static void genstep (lua_State *L, global_State *g) {
+ if (g->lastatomic != 0) /* last collection was a bad one? */
+ stepgenfull(L, g); /* do a full step */
+ else {
+ lu_mem majorbase = g->GCestimate; /* memory after last major collection */
+ lu_mem majorinc = (majorbase / 100) * getgcparam(g->genmajormul);
+ if (g->GCdebt > 0 && gettotalbytes(g) > majorbase + majorinc) {
+ lu_mem numobjs = fullgen(L, g); /* do a major collection */
+ if (gettotalbytes(g) < majorbase + (majorinc / 2)) {
+ /* collected at least half of memory growth since last major
+ collection; keep doing minor collections */
+ setminordebt(g);
+ }
+ else { /* bad collection */
+ g->lastatomic = numobjs; /* signal that last collection was bad */
+ setpause(g); /* do a long wait for next (major) collection */
+ }
+ }
+ else { /* regular case; do a minor collection */
+ youngcollection(L, g);
+ setminordebt(g);
+ g->GCestimate = majorbase; /* preserve base value */
+ }
+ }
+ lua_assert(isdecGCmodegen(g));
+}
+
+/* }====================================================== */
+
/*
** {======================================================
@@ -932,26 +1349,28 @@
/*
-** Set a reasonable "time" to wait before starting a new GC cycle; cycle
-** will start when memory use hits threshold. (Division by 'estimate'
-** should be OK: it cannot be zero (because Lua cannot even start with
-** less than PAUSEADJ bytes).
+** Set the "time" to wait before starting a new GC cycle; cycle will
+** start when memory use hits the threshold of ('estimate' * pause /
+** PAUSEADJ). (Division by 'estimate' should be OK: it cannot be zero,
+** because Lua cannot even start with less than PAUSEADJ bytes).
*/
static void setpause (global_State *g) {
l_mem threshold, debt;
+ int pause = getgcparam(g->gcpause);
l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */
lua_assert(estimate > 0);
- threshold = (g->gcpause < MAX_LMEM / estimate) /* overflow? */
- ? estimate * g->gcpause /* no overflow */
+ threshold = (pause < MAX_LMEM / estimate) /* overflow? */
+ ? estimate * pause /* no overflow */
: MAX_LMEM; /* overflow; truncate to maximum */
debt = gettotalbytes(g) - threshold;
+ if (debt > 0) debt = 0;
luaE_setdebt(g, debt);
}
/*
** Enter first sweep phase.
-** The call to 'sweeplist' tries to make pointer point to an object
+** The call to 'sweeptolive' makes the pointer 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.
@@ -960,85 +1379,97 @@
global_State *g = G(L);
g->gcstate = GCSswpallgc;
lua_assert(g->sweepgc == NULL);
- g->sweepgc = sweeplist(L, &g->allgc, 1);
+ g->sweepgc = sweeptolive(L, &g->allgc);
}
+/*
+** Delete all objects in list 'p' until (but not including) object
+** 'limit'.
+*/
+static void deletelist (lua_State *L, GCObject *p, GCObject *limit) {
+ while (p != limit) {
+ GCObject *next = p->next;
+ freeobj(L, p);
+ p = next;
+ }
+}
+
+
+/*
+** Call all finalizers of the objects in the given Lua state, and
+** then free all objects, except for the main thread.
+*/
void luaC_freeallobjects (lua_State *L) {
global_State *g = G(L);
+ luaC_changemode(L, KGC_INC);
separatetobefnz(g, 1); /* separate all objects with finalizers */
lua_assert(g->finobj == NULL);
callallpendingfinalizers(L);
- lua_assert(g->tobefnz == NULL);
- g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */
- g->gckind = KGC_NORMAL;
- sweepwholelist(L, &g->finobj);
- sweepwholelist(L, &g->allgc);
- sweepwholelist(L, &g->fixedgc); /* collect fixed objects */
+ deletelist(L, g->allgc, obj2gco(g->mainthread));
+ deletelist(L, g->finobj, NULL);
+ deletelist(L, g->fixedgc, NULL); /* collect fixed objects */
lua_assert(g->strt.nuse == 0);
}
-static l_mem atomic (lua_State *L) {
+static lu_mem atomic (lua_State *L) {
global_State *g = G(L);
- l_mem work;
+ lu_mem work = 0;
GCObject *origweak, *origall;
GCObject *grayagain = g->grayagain; /* save original list */
+ g->grayagain = NULL;
lua_assert(g->ephemeron == NULL && g->weak == NULL);
lua_assert(!iswhite(g->mainthread));
- g->gcstate = GCSinsideatomic;
- g->GCmemtrav = 0; /* start counting work */
+ g->gcstate = GCSatomic;
markobject(g, L); /* mark running thread */
/* registry and global metatables may be changed by API */
markvalue(g, &g->l_registry);
markmt(g); /* mark global metatables */
+ work += propagateall(g); /* empties 'gray' list */
/* remark occasional upvalues of (maybe) dead threads */
- remarkupvals(g);
- propagateall(g); /* propagate changes */
- work = g->GCmemtrav; /* stop counting (do not recount 'grayagain') */
+ work += remarkupvals(g);
+ work += propagateall(g); /* propagate changes */
g->gray = grayagain;
- propagateall(g); /* traverse 'grayagain' list */
- g->GCmemtrav = 0; /* restart counting */
+ work += propagateall(g); /* traverse 'grayagain' list */
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);
+ clearbyvalues(g, g->weak, NULL);
+ clearbyvalues(g, g->allweak, NULL);
origweak = g->weak; origall = g->allweak;
- work += g->GCmemtrav; /* stop counting (objects being finalized) */
separatetobefnz(g, 0); /* separate objects to be finalized */
- g->gcfinnum = 1; /* there may be objects to be finalized */
- markbeingfnz(g); /* mark objects that will be finalized */
- propagateall(g); /* remark, to propagate 'resurrection' */
- g->GCmemtrav = 0; /* restart counting */
+ work += markbeingfnz(g); /* mark objects that will be finalized */
+ work += propagateall(g); /* remark, to propagate 'resurrection' */
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 */
+ clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron tables */
+ clearbykeys(g, g->allweak); /* clear keys from all 'allweak' tables */
/* clear values from resurrected weak tables */
- clearvalues(g, g->weak, origweak);
- clearvalues(g, g->allweak, origall);
+ clearbyvalues(g, g->weak, origweak);
+ clearbyvalues(g, g->allweak, origall);
luaS_clearcache(g);
g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */
- work += g->GCmemtrav; /* complete counting */
- return work; /* estimate of memory marked by 'atomic' */
+ lua_assert(g->gray == NULL);
+ return work; /* estimate of slots marked by 'atomic' */
}
-static lu_mem sweepstep (lua_State *L, global_State *g,
- int nextstate, GCObject **nextlist) {
+static int sweepstep (lua_State *L, global_State *g,
+ int nextstate, GCObject **nextlist) {
if (g->sweepgc) {
l_mem olddebt = g->GCdebt;
- g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);
+ int count;
+ g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX, &count);
g->GCestimate += g->GCdebt - olddebt; /* update estimate */
- if (g->sweepgc) /* is there still something to sweep? */
- return (GCSWEEPMAX * GCSWEEPCOST);
+ return count;
}
- /* else enter next state */
- g->gcstate = nextstate;
- g->sweepgc = nextlist;
- return 0;
+ else { /* enter next state */
+ g->gcstate = nextstate;
+ g->sweepgc = nextlist;
+ return 0; /* no work done */
+ }
}
@@ -1046,23 +1477,20 @@
global_State *g = G(L);
switch (g->gcstate) {
case GCSpause: {
- g->GCmemtrav = g->strt.size * sizeof(GCObject*);
restartcollection(g);
g->gcstate = GCSpropagate;
- return g->GCmemtrav;
+ return 1;
}
case GCSpropagate: {
- g->GCmemtrav = 0;
- lua_assert(g->gray);
- propagatemark(g);
- if (g->gray == NULL) /* no more gray objects? */
- g->gcstate = GCSatomic; /* finish propagate phase */
- return g->GCmemtrav; /* memory traversed in this step */
+ if (g->gray == NULL) { /* no more gray objects? */
+ g->gcstate = GCSenteratomic; /* finish propagate phase */
+ return 0;
+ }
+ else
+ return propagatemark(g); /* traverse one gray object */
}
- case GCSatomic: {
- lu_mem work;
- propagateall(g); /* make sure gray list is empty */
- work = atomic(L); /* work is what was traversed by 'atomic' */
+ case GCSenteratomic: {
+ lu_mem work = atomic(L); /* work is what was traversed by 'atomic' */
entersweep(L);
g->GCestimate = gettotalbytes(g); /* first estimate */;
return work;
@@ -1077,15 +1505,14 @@
return sweepstep(L, g, GCSswpend, NULL);
}
case GCSswpend: { /* finish sweeps */
- makewhite(g, g->mainthread); /* sweep main thread */
checkSizes(L, g);
g->gcstate = GCScallfin;
return 0;
}
case GCScallfin: { /* call remaining finalizers */
- if (g->tobefnz && g->gckind != KGC_EMERGENCY) {
- int n = runafewfinalizers(L);
- return (n * GCFINALIZECOST);
+ if (g->tobefnz && !g->gcemergency) {
+ int n = runafewfinalizers(L, GCFINMAX);
+ return n * GCFINALIZECOST;
}
else { /* emergency mode or no more finalizers */
g->gcstate = GCSpause; /* finish collection */
@@ -1109,41 +1536,62 @@
/*
-** get GC debt and convert it from Kb to 'work units' (avoid zero debt
-** and overflows)
+** Performs a basic incremental step. The debt and step size are
+** converted from bytes to "units of work"; then the function loops
+** running single steps until adding that many units of work or
+** finishing a cycle (pause state). Finally, it sets the debt that
+** controls when next step will be performed.
*/
-static l_mem getdebt (global_State *g) {
- l_mem debt = g->GCdebt;
- int stepmul = g->gcstepmul;
- if (debt <= 0) return 0; /* minimal debt */
+static void incstep (lua_State *L, global_State *g) {
+ int stepmul = (getgcparam(g->gcstepmul) | 1); /* avoid division by 0 */
+ l_mem debt = (g->GCdebt / WORK2MEM) * stepmul;
+ l_mem stepsize = (g->gcstepsize <= log2maxs(l_mem))
+ ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
+ : MAX_LMEM; /* overflow; keep maximum value */
+ do { /* repeat until pause or enough "credit" (negative debt) */
+ lu_mem work = singlestep(L); /* perform one single step */
+ debt -= work;
+ } while (debt > -stepsize && g->gcstate != GCSpause);
+ if (g->gcstate == GCSpause)
+ setpause(g); /* pause until next cycle */
else {
- debt = (debt / STEPMULADJ) + 1;
- debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM;
- return debt;
+ debt = (debt / stepmul) * WORK2MEM; /* convert 'work units' to bytes */
+ luaE_setdebt(g, debt);
}
}
/*
-** performs a basic GC step when collector is running
+** performs a basic GC step if collector is running
*/
void luaC_step (lua_State *L) {
global_State *g = G(L);
- l_mem debt = getdebt(g); /* GC deficit (be paid now) */
- if (!g->gcrunning) { /* not running? */
- luaE_setdebt(g, -GCSTEPSIZE * 10); /* avoid being called too often */
- return;
+ lua_assert(!g->gcemergency);
+ if (g->gcrunning) { /* running? */
+ if(isdecGCmodegen(g))
+ genstep(L, g);
+ else
+ incstep(L, g);
}
- do { /* repeat until pause or enough "credit" (negative debt) */
- lu_mem work = singlestep(L); /* perform one single step */
- debt -= work;
- } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause);
- if (g->gcstate == GCSpause)
- setpause(g); /* pause until next cycle */
- else {
- debt = (debt / g->gcstepmul) * STEPMULADJ; /* convert 'work units' to Kb */
- luaE_setdebt(g, debt);
- runafewfinalizers(L);
- }
+}
+
+
+/*
+** Perform a full collection in incremental mode.
+** Before running the collection, check 'keepinvariant'; if it is true,
+** there may be some objects marked as black, so the collector has
+** to sweep all objects to turn them back to white (as white has not
+** changed, nothing will be collected).
+*/
+static void fullinc (lua_State *L, global_State *g) {
+ if (keepinvariant(g)) /* black objects? */
+ entersweep(L); /* sweep everything to turn them back to white */
+ /* finish any pending sweep phase to start a new cycle */
+ luaC_runtilstate(L, bitmask(GCSpause));
+ luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */
+ /* estimate must be correct after a full GC cycle */
+ lua_assert(g->GCestimate == gettotalbytes(g));
+ luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
+ setpause(g);
}
@@ -1151,27 +1599,16 @@
** Performs a full GC cycle; if 'isemergency', set a flag to avoid
** some operations which could change the interpreter state in some
** unexpected ways (running finalizers and shrinking some structures).
-** Before running the collection, check 'keepinvariant'; if it is true,
-** there may be some objects marked as black, so the collector has
-** to sweep all objects to turn them back to white (as white has not
-** changed, nothing will be collected).
*/
void luaC_fullgc (lua_State *L, int isemergency) {
global_State *g = G(L);
- lua_assert(g->gckind == KGC_NORMAL);
- if (isemergency) g->gckind = KGC_EMERGENCY; /* set flag */
- if (keepinvariant(g)) { /* black objects? */
- entersweep(L); /* sweep everything to turn them back to white */
- }
- /* 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(GCScallfin)); /* run up to finalizers */
- /* estimate must be correct after a full GC cycle */
- lua_assert(g->GCestimate == gettotalbytes(g));
- luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
- g->gckind = KGC_NORMAL;
- setpause(g);
+ lua_assert(!g->gcemergency);
+ g->gcemergency = isemergency; /* set flag */
+ if (g->gckind == KGC_INC)
+ fullinc(L, g);
+ else
+ fullgen(L, g);
+ g->gcemergency = 0;
}
/* }====================================================== */
diff --git a/src/lgc.h b/src/lgc.h
index 425cd7c..b972472 100644
--- a/src/lgc.h
+++ b/src/lgc.h
@@ -1,5 +1,5 @@
/*
-** $Id: lgc.h,v 2.91.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lgc.h $
** Garbage Collector
** See Copyright Notice in lua.h
*/
@@ -25,25 +25,18 @@
*/
-
-/* 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 GCSswpallgc 2
-#define GCSswpfinobj 3
-#define GCSswptobefnz 4
-#define GCSswpend 5
-#define GCScallfin 6
-#define GCSpause 7
+#define GCSenteratomic 1
+#define GCSatomic 2
+#define GCSswpallgc 3
+#define GCSswpfinobj 4
+#define GCSswptobefnz 5
+#define GCSswpend 6
+#define GCScallfin 7
+#define GCSpause 8
#define issweepphase(g) \
@@ -64,7 +57,7 @@
/*
** some useful bit tricks
*/
-#define resetbits(x,m) ((x) &= cast(lu_byte, ~(m)))
+#define resetbits(x,m) ((x) &= cast_byte(~(m)))
#define setbits(x,m) ((x) |= (m))
#define testbits(x,m) ((x) & (m))
#define bitmask(b) (1<<(b))
@@ -74,12 +67,17 @@
#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 marked for finalization */
-/* bit 7 is currently used by tests (luaL_checkmemory) */
+/*
+** Layout for bit use in 'marked' field. First three bits are
+** used for object "age" in generational mode. Last bit is free
+** to be used by respective objects.
+*/
+#define WHITE0BIT 3 /* object is white (type 0) */
+#define WHITE1BIT 4 /* object is white (type 1) */
+#define BLACKBIT 5 /* object is black */
+#define FINALIZEDBIT 6 /* object has been marked for finalization */
+
+
#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
@@ -92,15 +90,61 @@
#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)
#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)
-#define isdeadm(ow,m) (!(((m) ^ WHITEBITS) & (ow)))
+#define isdeadm(ow,m) ((m) & (ow))
#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)
#define changewhite(x) ((x)->marked ^= WHITEBITS)
#define gray2black(x) l_setbit((x)->marked, BLACKBIT)
-#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS)
+#define luaC_white(g) cast_byte((g)->currentwhite & WHITEBITS)
+/* object age in generational mode */
+#define G_NEW 0 /* created in current cycle */
+#define G_SURVIVAL 1 /* created in previous cycle */
+#define G_OLD0 2 /* marked old by frw. barrier in this cycle */
+#define G_OLD1 3 /* first full cycle as old */
+#define G_OLD 4 /* really old object (not to be visited) */
+#define G_TOUCHED1 5 /* old object touched this cycle */
+#define G_TOUCHED2 6 /* old object touched in previous cycle */
+
+#define AGEBITS 7 /* all age bits (111) */
+
+#define getage(o) ((o)->marked & AGEBITS)
+#define setage(o,a) ((o)->marked = cast_byte(((o)->marked & (~AGEBITS)) | a))
+#define isold(o) (getage(o) > G_SURVIVAL)
+
+#define changeage(o,f,t) \
+ check_exp(getage(o) == (f), (o)->marked ^= ((f)^(t)))
+
+
+/* Default Values for GC parameters */
+#define LUAI_GENMAJORMUL 100
+#define LUAI_GENMINORMUL 20
+
+/* wait memory to double before starting new cycle */
+#define LUAI_GCPAUSE 200
+
+/*
+** some gc parameters are stored divided by 4 to allow a maximum value
+** up to 1023 in a 'lu_byte'.
+*/
+#define getgcparam(p) ((p) * 4)
+#define setgcparam(p,v) ((p) = (v) / 4)
+
+#define LUAI_GCMUL 100
+
+/* how much to allocate before next GC step (log2) */
+#define LUAI_GCSTEPSIZE 13 /* 8 KB */
+
+
+/*
+** Check whether the declared GC mode is generational. While in
+** generational mode, the collector can go temporarily to incremental
+** mode to improve performance. This is signaled by 'g->lastatomic != 0'.
+*/
+#define isdecGCmodegen(g) (g->gckind == KGC_GEN || g->lastatomic != 0)
+
/*
** Does one step of collection when debt becomes positive. 'pre'/'pos'
** allows some adjustments to be done only when needed. macro
@@ -127,10 +171,6 @@
(isblack(p) && iswhite(o)) ? \
luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))
-#define luaC_upvalbarrier(L,uv) ( \
- (iscollectable((uv)->v) && !upisopen(uv)) ? \
- luaC_upvalbarrier_(L,uv) : cast_void(0))
-
LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);
LUAI_FUNC void luaC_freeallobjects (lua_State *L);
LUAI_FUNC void luaC_step (lua_State *L);
@@ -138,10 +178,9 @@
LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz);
LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
-LUAI_FUNC void luaC_barrierback_ (lua_State *L, Table *o);
-LUAI_FUNC void luaC_upvalbarrier_ (lua_State *L, UpVal *uv);
+LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
-LUAI_FUNC void luaC_upvdeccount (lua_State *L, UpVal *uv);
+LUAI_FUNC void luaC_changemode (lua_State *L, int newmode);
#endif
diff --git a/src/linit.c b/src/linit.c
index 480da52..69808f8 100644
--- a/src/linit.c
+++ b/src/linit.c
@@ -1,5 +1,5 @@
/*
-** $Id: linit.c,v 1.39.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: linit.c $
** Initialization of libraries for lua.c and other clients
** See Copyright Notice in lua.h
*/
@@ -40,7 +40,7 @@
** program
*/
static const luaL_Reg loadedlibs[] = {
- {"_G", luaopen_base},
+ {LUA_GNAME, luaopen_base},
{LUA_LOADLIBNAME, luaopen_package},
{LUA_COLIBNAME, luaopen_coroutine},
{LUA_TABLIBNAME, luaopen_table},
@@ -50,9 +50,6 @@
{LUA_MATHLIBNAME, luaopen_math},
{LUA_UTF8LIBNAME, luaopen_utf8},
{LUA_DBLIBNAME, luaopen_debug},
-#if defined(LUA_COMPAT_BITLIB)
- {LUA_BITLIBNAME, luaopen_bit32},
-#endif
{NULL, NULL}
};
diff --git a/src/liolib.c b/src/liolib.c
index 8a9e75c..7ac3444 100644
--- a/src/liolib.c
+++ b/src/liolib.c
@@ -1,5 +1,5 @@
/*
-** $Id: liolib.c,v 2.151.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: liolib.c $
** Standard I/O (and system) library
** See Copyright Notice in lua.h
*/
@@ -39,7 +39,7 @@
/* Check whether 'mode' matches '[rwa]%+?[L_MODEEXT]*' */
static int l_checkmode (const char *mode) {
return (*mode != '\0' && strchr("rwa", *(mode++)) != NULL &&
- (*mode != '+' || (++mode, 1)) && /* skip if char is '+' */
+ (*mode != '+' || ((void)(++mode), 1)) && /* skip if char is '+' */
(strspn(mode, L_MODEEXT) == strlen(mode))); /* check extensions */
}
@@ -68,7 +68,7 @@
/* ISO C definitions */
#define l_popen(L,c,m) \
- ((void)((void)c, m), \
+ ((void)c, (void)m, \
luaL_error(L, "'popen' not supported"), \
(FILE*)0)
#define l_pclose(L,file) ((void)L, (void)file, -1)
@@ -133,6 +133,7 @@
/* }====================================================== */
+
#define IO_PREFIX "_IO_"
#define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1)
#define IO_INPUT (IO_PREFIX "input")
@@ -152,7 +153,7 @@
luaL_checkany(L, 1);
p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);
if (p == NULL)
- lua_pushnil(L); /* not a file */
+ luaL_pushfail(L); /* not a file */
else if (isclosed(p))
lua_pushliteral(L, "closed file");
else
@@ -186,7 +187,7 @@
** handle is in a consistent state.
*/
static LStream *newprefile (lua_State *L) {
- LStream *p = (LStream *)lua_newuserdata(L, sizeof(LStream));
+ LStream *p = (LStream *)lua_newuserdatauv(L, sizeof(LStream), 0);
p->closef = NULL; /* mark file handle as 'closed' */
luaL_setmetatable(L, LUA_FILEHANDLE);
return p;
@@ -214,7 +215,7 @@
static int io_close (lua_State *L) {
if (lua_isnone(L, 1)) /* no argument? */
- lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use standard output */
+ lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use default output */
return f_close(L);
}
@@ -269,6 +270,7 @@
*/
static int io_pclose (lua_State *L) {
LStream *p = tolstream(L);
+ errno = 0;
return luaL_execresult(L, l_pclose(L, p->f));
}
@@ -295,7 +297,7 @@
lua_getfield(L, LUA_REGISTRYINDEX, findex);
p = (LStream *)lua_touserdata(L, -1);
if (isclosed(p))
- luaL_error(L, "standard %s file is closed", findex + IOPREF_LEN);
+ luaL_error(L, "default %s file is closed", findex + IOPREF_LEN);
return p->f;
}
@@ -336,12 +338,22 @@
*/
#define MAXARGLINE 250
+/*
+** Auxiliary function to create the iteration function for 'lines'.
+** The iteration function is a closure over 'io_readline', with
+** the following upvalues:
+** 1) The file being read (first value in the stack)
+** 2) the number of arguments to read
+** 3) a boolean, true iff file has to be closed when finished ('toclose')
+** *) a variable number of format arguments (rest of the stack)
+*/
static void aux_lines (lua_State *L, int toclose) {
int n = lua_gettop(L) - 1; /* number of arguments to read */
luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments");
+ lua_pushvalue(L, 1); /* file */
lua_pushinteger(L, n); /* number of arguments to read */
lua_pushboolean(L, toclose); /* close/not close file when finished */
- lua_rotate(L, 2, 2); /* move 'n' and 'toclose' to their positions */
+ lua_rotate(L, 2, 3); /* move the three values to their positions */
lua_pushcclosure(L, io_readline, 3 + n);
}
@@ -353,6 +365,11 @@
}
+/*
+** Return an iteration function for 'io.lines'. If file has to be
+** closed, also returns the file itself as a second result (to be
+** closed as the state at the exit of a generic for).
+*/
static int io_lines (lua_State *L) {
int toclose;
if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */
@@ -368,8 +385,15 @@
lua_replace(L, 1); /* put file at index 1 */
toclose = 1; /* close it after iteration */
}
- aux_lines(L, toclose);
- return 1;
+ aux_lines(L, toclose); /* push iteration function */
+ if (toclose) {
+ lua_pushnil(L); /* state */
+ lua_pushnil(L); /* control */
+ lua_pushvalue(L, 1); /* file is the to-be-closed variable (4th result) */
+ return 4;
+ }
+ else
+ return 1;
}
@@ -435,7 +459,7 @@
/*
** Read a number: first reads a valid prefix of a numeral into a buffer.
** Then it calls 'lua_stringtonumber' to check whether the format is
-** correct and to convert it to a Lua number
+** correct and to convert it to a Lua number.
*/
static int read_number (lua_State *L, FILE *f) {
RN rn;
@@ -447,7 +471,7 @@
decp[1] = '.'; /* always accept a dot */
l_lockfile(rn.f);
do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */
- test2(&rn, "-+"); /* optional signal */
+ test2(&rn, "-+"); /* optional sign */
if (test2(&rn, "00")) {
if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */
else count = 1; /* count initial '0' as a valid digit */
@@ -456,7 +480,7 @@
if (test2(&rn, decp)) /* decimal point? */
count += readdigits(&rn, hex); /* fractional part */
if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */
- test2(&rn, "-+"); /* exponent signal */
+ test2(&rn, "-+"); /* exponent sign */
readdigits(&rn, 0); /* exponent digits */
}
ungetc(rn.c, rn.f); /* unread look-ahead char */
@@ -481,17 +505,17 @@
static int read_line (lua_State *L, FILE *f, int chop) {
luaL_Buffer b;
- int c = '\0';
+ int c;
luaL_buffinit(L, &b);
- while (c != EOF && c != '\n') { /* repeat until end of line */
- char *buff = luaL_prepbuffer(&b); /* preallocate buffer */
+ do { /* may need to read several chunks to get whole line */
+ char *buff = luaL_prepbuffer(&b); /* preallocate buffer space */
int i = 0;
l_lockfile(f); /* no memory errors can happen inside the lock */
while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n')
- buff[i++] = c;
+ buff[i++] = c; /* read up to end of line or buffer limit */
l_unlockfile(f);
luaL_addsize(&b, i);
- }
+ } while (c != EOF && c != '\n'); /* repeat until end of line */
if (!chop && c == '\n') /* want a newline and have one? */
luaL_addchar(&b, c); /* add ending newline to result */
luaL_pushresult(&b); /* close buffer */
@@ -528,14 +552,14 @@
static int g_read (lua_State *L, FILE *f, int first) {
int nargs = lua_gettop(L) - 1;
- int success;
- int n;
+ int n, success;
clearerr(f);
if (nargs == 0) { /* no arguments? */
success = read_line(L, f, 1);
- n = first+1; /* to return 1 result */
+ n = first + 1; /* to return 1 result */
}
- else { /* ensure stack space for all results and for auxlib's buffer */
+ 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++) {
@@ -570,7 +594,7 @@
return luaL_fileresult(L, 0, NULL);
if (!success) {
lua_pop(L, 1); /* remove last result */
- lua_pushnil(L); /* push nil instead */
+ luaL_pushfail(L); /* push nil instead */
}
return n - first;
}
@@ -586,6 +610,9 @@
}
+/*
+** Iteration function for 'lines'.
+*/
static int io_readline (lua_State *L) {
LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));
int i;
@@ -600,14 +627,14 @@
lua_assert(n > 0); /* should return at least a nil */
if (lua_toboolean(L, -n)) /* read at least one value? */
return n; /* return them */
- else { /* first result is nil: EOF or error */
+ else { /* first result is false: 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));
+ lua_settop(L, 0); /* clear stack */
+ lua_pushvalue(L, lua_upvalueindex(1)); /* push file at index 1 */
aux_close(L); /* close it */
}
return 0;
@@ -716,26 +743,37 @@
/*
** methods for file handles
*/
-static const luaL_Reg flib[] = {
- {"close", f_close},
- {"flush", f_flush},
- {"lines", f_lines},
+static const luaL_Reg meth[] = {
{"read", f_read},
- {"seek", f_seek},
- {"setvbuf", f_setvbuf},
{"write", f_write},
+ {"lines", f_lines},
+ {"flush", f_flush},
+ {"seek", f_seek},
+ {"close", f_close},
+ {"setvbuf", f_setvbuf},
+ {NULL, NULL}
+};
+
+
+/*
+** metamethods for file handles
+*/
+static const luaL_Reg metameth[] = {
+ {"__index", NULL}, /* place holder */
{"__gc", f_gc},
+ {"__close", 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 */
+ luaL_newmetatable(L, LUA_FILEHANDLE); /* metatable for file handles */
+ luaL_setfuncs(L, metameth, 0); /* add metamethods to new metatable */
+ luaL_newlibtable(L, meth); /* create method table */
+ luaL_setfuncs(L, meth, 0); /* add file methods to method table */
+ lua_setfield(L, -2, "__index"); /* metatable.__index = method table */
+ lua_pop(L, 1); /* pop metatable */
}
@@ -745,7 +783,7 @@
static int io_noclose (lua_State *L) {
LStream *p = tolstream(L);
p->closef = &io_noclose; /* keep file opened */
- lua_pushnil(L);
+ luaL_pushfail(L);
lua_pushliteral(L, "cannot close standard file");
return 2;
}
diff --git a/src/ljumptab.h b/src/ljumptab.h
new file mode 100644
index 0000000..8306f25
--- /dev/null
+++ b/src/ljumptab.h
@@ -0,0 +1,112 @@
+/*
+** $Id: ljumptab.h $
+** Jump Table for the Lua interpreter
+** See Copyright Notice in lua.h
+*/
+
+
+#undef vmdispatch
+#undef vmcase
+#undef vmbreak
+
+#define vmdispatch(x) goto *disptab[x];
+
+#define vmcase(l) L_##l:
+
+#define vmbreak vmfetch(); vmdispatch(GET_OPCODE(i));
+
+
+static const void *const disptab[NUM_OPCODES] = {
+
+#if 0
+** you can update the following list with this command:
+**
+** sed -n '/^OP_/\!d; s/OP_/\&\&L_OP_/ ; s/,.*/,/ ; s/\/.*// ; p' lopcodes.h
+**
+#endif
+
+&&L_OP_MOVE,
+&&L_OP_LOADI,
+&&L_OP_LOADF,
+&&L_OP_LOADK,
+&&L_OP_LOADKX,
+&&L_OP_LOADFALSE,
+&&L_OP_LFALSESKIP,
+&&L_OP_LOADTRUE,
+&&L_OP_LOADNIL,
+&&L_OP_GETUPVAL,
+&&L_OP_SETUPVAL,
+&&L_OP_GETTABUP,
+&&L_OP_GETTABLE,
+&&L_OP_GETI,
+&&L_OP_GETFIELD,
+&&L_OP_SETTABUP,
+&&L_OP_SETTABLE,
+&&L_OP_SETI,
+&&L_OP_SETFIELD,
+&&L_OP_NEWTABLE,
+&&L_OP_SELF,
+&&L_OP_ADDI,
+&&L_OP_ADDK,
+&&L_OP_SUBK,
+&&L_OP_MULK,
+&&L_OP_MODK,
+&&L_OP_POWK,
+&&L_OP_DIVK,
+&&L_OP_IDIVK,
+&&L_OP_BANDK,
+&&L_OP_BORK,
+&&L_OP_BXORK,
+&&L_OP_SHRI,
+&&L_OP_SHLI,
+&&L_OP_ADD,
+&&L_OP_SUB,
+&&L_OP_MUL,
+&&L_OP_MOD,
+&&L_OP_POW,
+&&L_OP_DIV,
+&&L_OP_IDIV,
+&&L_OP_BAND,
+&&L_OP_BOR,
+&&L_OP_BXOR,
+&&L_OP_SHL,
+&&L_OP_SHR,
+&&L_OP_MMBIN,
+&&L_OP_MMBINI,
+&&L_OP_MMBINK,
+&&L_OP_UNM,
+&&L_OP_BNOT,
+&&L_OP_NOT,
+&&L_OP_LEN,
+&&L_OP_CONCAT,
+&&L_OP_CLOSE,
+&&L_OP_TBC,
+&&L_OP_JMP,
+&&L_OP_EQ,
+&&L_OP_LT,
+&&L_OP_LE,
+&&L_OP_EQK,
+&&L_OP_EQI,
+&&L_OP_LTI,
+&&L_OP_LEI,
+&&L_OP_GTI,
+&&L_OP_GEI,
+&&L_OP_TEST,
+&&L_OP_TESTSET,
+&&L_OP_CALL,
+&&L_OP_TAILCALL,
+&&L_OP_RETURN,
+&&L_OP_RETURN0,
+&&L_OP_RETURN1,
+&&L_OP_FORLOOP,
+&&L_OP_FORPREP,
+&&L_OP_TFORPREP,
+&&L_OP_TFORCALL,
+&&L_OP_TFORLOOP,
+&&L_OP_SETLIST,
+&&L_OP_CLOSURE,
+&&L_OP_VARARG,
+&&L_OP_VARARGPREP,
+&&L_OP_EXTRAARG
+
+};
diff --git a/src/llex.c b/src/llex.c
index 66fd411..90a7951 100644
--- a/src/llex.c
+++ b/src/llex.c
@@ -1,5 +1,5 @@
/*
-** $Id: llex.c,v 2.96.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: llex.c $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
@@ -29,7 +29,7 @@
-#define next(ls) (ls->current = zgetc(ls->z))
+#define next(ls) (ls->current = zgetc(ls->z))
@@ -63,7 +63,7 @@
newsize = luaZ_sizebuffer(b) * 2;
luaZ_resizebuffer(ls->L, b, newsize);
}
- b->buffer[luaZ_bufflen(b)++] = cast(char, c);
+ b->buffer[luaZ_bufflen(b)++] = cast_char(c);
}
@@ -82,7 +82,10 @@
const char *luaX_token2str (LexState *ls, int token) {
if (token < FIRST_RESERVED) { /* single-byte symbols? */
lua_assert(token == cast_uchar(token));
- return luaO_pushfstring(ls->L, "'%c'", token);
+ if (lisprint(token))
+ return luaO_pushfstring(ls->L, "'%c'", token);
+ else /* control character */
+ return luaO_pushfstring(ls->L, "'<\\%d>'", token);
}
else {
const char *s = luaX_tokens[token - FIRST_RESERVED];
@@ -129,15 +132,15 @@
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->h, L->top - 1);
- if (ttisnil(o)) { /* not in use yet? */
+ o = luaH_set(L, ls->h, s2v(L->top - 1));
+ if (isempty(o)) { /* not in use yet? */
/* 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 */
+ table is not a metatable, so it does not need to invalidate cache */
+ setbtvalue(o); /* t[string] = true */
luaC_checkGC(L);
}
else { /* string already present */
- ts = tsvalue(keyfromval(o)); /* re-use value previously stored */
+ ts = keystrval(nodefromval(o)); /* re-use value previously stored */
}
L->top--; /* remove string from stack */
return ts;
@@ -208,8 +211,16 @@
/* LUA_NUMBER */
/*
-** this function is quite liberal in what it accepts, as 'luaO_str2num'
-** will reject ill-formed numerals.
+** This function is quite liberal in what it accepts, as 'luaO_str2num'
+** will reject ill-formed numerals. Roughly, it accepts the following
+** pattern:
+**
+** %d(%x|%.|([Ee][+-]?))* | 0[Xx](%x|%.|([Pp][+-]?))*
+**
+** The only tricky part is to accept [+-] only after a valid exponent
+** mark, to avoid reading '3-4' or '0xe+1' as a single number.
+**
+** The caller might have already read an initial dot.
*/
static int read_numeral (LexState *ls, SemInfo *seminfo) {
TValue obj;
@@ -220,14 +231,14 @@
if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */
expo = "Pp";
for (;;) {
- if (check_next2(ls, expo)) /* exponent part? */
+ if (check_next2(ls, expo)) /* exponent mark? */
check_next2(ls, "-+"); /* optional exponent sign */
- if (lisxdigit(ls->current))
- save_and_next(ls);
- else if (ls->current == '.')
+ else if (lisxdigit(ls->current) || ls->current == '.') /* '%x|%.' */
save_and_next(ls);
else break;
}
+ if (lislalpha(ls->current)) /* is numeral touching a letter? */
+ save_and_next(ls); /* force an error */
save(ls, '\0');
if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */
lexerror(ls, "malformed number", TK_FLT);
@@ -244,12 +255,12 @@
/*
-** skip a sequence '[=*[' or ']=*]'; if sequence is well formed, return
-** its number of '='s; otherwise, return a negative number (-1 iff there
-** are no '='s after initial bracket)
+** reads a sequence '[=*[' or ']=*]', leaving the last bracket.
+** If sequence is well formed, return its number of '='s + 2; otherwise,
+** return 1 if there is no '='s or 0 otherwise (an unfinished '[==...').
*/
-static int skip_sep (LexState *ls) {
- int count = 0;
+static size_t skip_sep (LexState *ls) {
+ size_t count = 0;
int s = ls->current;
lua_assert(s == '[' || s == ']');
save_and_next(ls);
@@ -257,11 +268,13 @@
save_and_next(ls);
count++;
}
- return (ls->current == s) ? count : (-count) - 1;
+ return (ls->current == s) ? count + 2
+ : (count == 0) ? 1
+ : 0;
}
-static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) {
+static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {
int line = ls->linenumber; /* initial line (for error message) */
save_and_next(ls); /* skip 2nd '[' */
if (currIsNewline(ls)) /* string starts with a newline? */
@@ -295,8 +308,8 @@
}
} endloop:
if (seminfo)
- seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep),
- luaZ_bufflen(ls->buff) - 2*(2 + sep));
+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,
+ luaZ_bufflen(ls->buff) - 2 * sep);
}
@@ -330,10 +343,10 @@
save_and_next(ls); /* skip 'u' */
esccheck(ls, ls->current == '{', "missing '{'");
r = gethexa(ls); /* must have at least one digit */
- while ((save_and_next(ls), lisxdigit(ls->current))) {
+ while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) {
i++;
+ esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large");
r = (r << 4) + luaO_hexavalue(ls->current);
- esccheck(ls, r <= 0x10FFFF, "UTF-8 value too large");
}
esccheck(ls, ls->current == '}', "missing '}'");
next(ls); /* skip '}' */
@@ -444,9 +457,9 @@
/* else is a comment */
next(ls);
if (ls->current == '[') { /* long comment? */
- int sep = skip_sep(ls);
+ size_t sep = skip_sep(ls);
luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */
- if (sep >= 0) {
+ if (sep >= 2) {
read_long_string(ls, NULL, sep); /* skip long comment */
luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
break;
@@ -458,12 +471,12 @@
break;
}
case '[': { /* long string or simply '[' */
- int sep = skip_sep(ls);
- if (sep >= 0) {
+ size_t sep = skip_sep(ls);
+ if (sep >= 2) {
read_long_string(ls, seminfo, sep);
return TK_STRING;
}
- else if (sep != -1) /* '[=...' missing second bracket */
+ else if (sep == 0) /* '[=...' missing second bracket? */
lexerror(ls, "invalid long string delimiter", TK_STRING);
return '[';
}
diff --git a/src/llex.h b/src/llex.h
index 2ed0af6..d1a4cba 100644
--- a/src/llex.h
+++ b/src/llex.h
@@ -1,5 +1,5 @@
/*
-** $Id: llex.h,v 1.79.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: llex.h $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
@@ -37,7 +37,7 @@
};
/* number of reserved words */
-#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1))
+#define NUM_RESERVED (cast_int(TK_WHILE-FIRST_RESERVED + 1))
typedef union {
diff --git a/src/llimits.h b/src/llimits.h
index d1036f6..b86d345 100644
--- a/src/llimits.h
+++ b/src/llimits.h
@@ -1,5 +1,5 @@
/*
-** $Id: llimits.h,v 1.141.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: llimits.h $
** Limits, basic types, and some other 'installation-dependent' definitions
** See Copyright Notice in lua.h
*/
@@ -14,6 +14,7 @@
#include "lua.h"
+
/*
** 'lu_mem' and 'l_mem' are unsigned/signed integers big enough to count
** the total memory used by Lua (in bytes). Usually, 'size_t' and
@@ -22,7 +23,7 @@
#if defined(LUAI_MEM) /* { external definitions? */
typedef LUAI_UMEM lu_mem;
typedef LUAI_MEM l_mem;
-#elif LUAI_BITSINT >= 32 /* }{ */
+#elif LUAI_IS32INT /* }{ */
typedef size_t lu_mem;
typedef ptrdiff_t l_mem;
#else /* 16-bit ints */ /* }{ */
@@ -33,12 +34,13 @@
/* chars used as small naturals (so that 'char' is reserved for characters) */
typedef unsigned char lu_byte;
+typedef signed char ls_byte;
/* maximum value for size_t */
#define MAX_SIZET ((size_t)(~(size_t)0))
-/* maximum size visible for Lua (must be representable in a lua_Integer */
+/* maximum size visible for Lua (must be representable in a lua_Integer) */
#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \
: (size_t)(LUA_MAXINTEGER))
@@ -52,6 +54,23 @@
/*
+** floor of the log2 of the maximum signed value for integral type 't'.
+** (That is, maximum 'n' such that '2^n' fits in the given signed type.)
+*/
+#define log2maxs(t) (sizeof(t) * 8 - 2)
+
+
+/*
+** test whether an unsigned value is a power of 2 (or zero)
+*/
+#define ispow2(x) (((x) & ((x) - 1)) == 0)
+
+
+/* number of chars of a literal string without the ending \0 */
+#define LL(x) (sizeof(x)/sizeof(char) - 1)
+
+
+/*
** conversion of pointer to unsigned integer:
** this is for hashing only; there is no problem if the integer
** cannot hold the whole pointer value
@@ -60,21 +79,6 @@
-/* type to ensure maximum alignment */
-#if defined(LUAI_USER_ALIGNMENT_T)
-typedef LUAI_USER_ALIGNMENT_T L_Umaxalign;
-#else
-typedef union {
- lua_Number n;
- double u;
- void *s;
- lua_Integer i;
- long l;
-} L_Umaxalign;
-#endif
-
-
-
/* types of 'usual argument conversions' for lua_Number and lua_Integer */
typedef LUAI_UACNUMBER l_uacNumber;
typedef LUAI_UACINT l_uacInt;
@@ -95,7 +99,7 @@
** assertion for checking API calls
*/
#if !defined(luai_apicheck)
-#define luai_apicheck(l,e) lua_assert(e)
+#define luai_apicheck(l,e) ((void)l, lua_assert(e))
#endif
#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)
@@ -111,10 +115,15 @@
#define cast(t, exp) ((t)(exp))
#define cast_void(i) cast(void, (i))
-#define cast_byte(i) cast(lu_byte, (i))
+#define cast_voidp(i) cast(void *, (i))
#define cast_num(i) cast(lua_Number, (i))
#define cast_int(i) cast(int, (i))
+#define cast_uint(i) cast(unsigned int, (i))
+#define cast_byte(i) cast(lu_byte, (i))
#define cast_uchar(i) cast(unsigned char, (i))
+#define cast_char(i) cast(char, (i))
+#define cast_charp(i) cast(char *, (i))
+#define cast_sizet(i) cast(size_t, (i))
/* cast a signed lua_Integer to lua_Unsigned */
@@ -133,8 +142,26 @@
/*
+** macros to improve jump prediction (used mainly for error handling)
+*/
+#if !defined(likely)
+
+#if defined(__GNUC__)
+#define likely(x) (__builtin_expect(((x) != 0), 1))
+#define unlikely(x) (__builtin_expect(((x) != 0), 0))
+#else
+#define likely(x) (x)
+#define unlikely(x) (x)
+#endif
+
+#endif
+
+
+/*
** non-return type
*/
+#if !defined(l_noret)
+
#if defined(__GNUC__)
#define l_noret void __attribute__((noreturn))
#elif defined(_MSC_VER) && _MSC_VER >= 1200
@@ -143,28 +170,21 @@
#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
-
/*
** type for virtual-machine instructions;
** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
*/
-#if LUAI_BITSINT >= 32
-typedef unsigned int Instruction;
+#if LUAI_IS32INT
+typedef unsigned int l_uint32;
#else
-typedef unsigned long Instruction;
+typedef unsigned long l_uint32;
#endif
+typedef l_uint32 Instruction;
+
/*
@@ -225,8 +245,7 @@
/*
-** these macros allow user-specific actions on threads when you defined
-** LUAI_EXTRASPACE and need to do something extra when a thread is
+** these macros allow user-specific actions when a thread is
** created/deleted/resumed/yielded.
*/
#if !defined(luai_userstateopen)
@@ -270,15 +289,20 @@
#endif
/*
-** modulo: defined as 'a - floor(a/b)*b'; this definition gives NaN when
-** 'b' is huge, but the result should be 'a'. 'fmod' gives the result of
-** 'a - trunc(a/b)*b', and therefore must be corrected when 'trunc(a/b)
-** ~= floor(a/b)'. That happens when the division has a non-integer
-** negative result, which is equivalent to the test below.
+** modulo: defined as 'a - floor(a/b)*b'; the direct computation
+** using this definition has several problems with rounding errors,
+** so it is better to use 'fmod'. 'fmod' gives the result of
+** 'a - trunc(a/b)*b', and therefore must be corrected when
+** 'trunc(a/b) ~= floor(a/b)'. That happens when the division has a
+** non-integer negative result: non-integer result is equivalent to
+** a non-zero remainder 'm'; negative result is equivalent to 'a' and
+** 'b' with different signs, or 'm' and 'b' with different signs
+** (as the result 'm' of 'fmod' has the same sign of 'a').
*/
#if !defined(luai_nummod)
#define luai_nummod(L,a,b,m) \
- { (m) = l_mathop(fmod)(a,b); if ((m)*(b) < 0) (m) += (b); }
+ { (void)L; (m) = l_mathop(fmod)(a,b); \
+ if (((m) > 0) ? (b) < 0 : ((m) < 0 && (b) > 0)) (m) += (b); }
#endif
/* exponentiation */
@@ -295,6 +319,8 @@
#define luai_numeq(a,b) ((a)==(b))
#define luai_numlt(a,b) ((a)<(b))
#define luai_numle(a,b) ((a)<=(b))
+#define luai_numgt(a,b) ((a)>(b))
+#define luai_numge(a,b) ((a)>=(b))
#define luai_numisnan(a) (!luai_numeq((a), (a)))
#endif
@@ -310,7 +336,7 @@
#else
/* realloc stack keeping its size */
#define condmovestack(L,pre,pos) \
- { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_); pos; }
+ { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_, 0); pos; }
#endif
#if !defined(HARDMEMTESTS)
diff --git a/src/lmathlib.c b/src/lmathlib.c
index 7ef7e59..86def47 100644
--- a/src/lmathlib.c
+++ b/src/lmathlib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lmathlib.c,v 1.119.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lmathlib.c $
** Standard mathematical library
** See Copyright Notice in lua.h
*/
@@ -10,8 +10,11 @@
#include "lprefix.h"
-#include <stdlib.h>
+#include <float.h>
+#include <limits.h>
#include <math.h>
+#include <stdlib.h>
+#include <time.h>
#include "lua.h"
@@ -23,19 +26,6 @@
#define PI (l_mathop(3.141592653589793238462643383279502884))
-#if !defined(l_rand) /* { */
-#if defined(LUA_USE_POSIX)
-#define l_rand() random()
-#define l_srand(x) srandom(x)
-#define L_RANDMAX 2147483647 /* (2^31 - 1), following POSIX */
-#else
-#define l_rand() rand()
-#define l_srand(x) srand(x)
-#define L_RANDMAX RAND_MAX
-#endif
-#endif /* } */
-
-
static int math_abs (lua_State *L) {
if (lua_isinteger(L, 1)) {
lua_Integer n = lua_tointeger(L, 1);
@@ -87,7 +77,7 @@
lua_pushinteger(L, n);
else {
luaL_checkany(L, 1);
- lua_pushnil(L); /* value is not convertible to integer */
+ luaL_pushfail(L); /* value is not convertible to integer */
}
return 1;
}
@@ -239,22 +229,347 @@
return 1;
}
+
+static int math_type (lua_State *L) {
+ if (lua_type(L, 1) == LUA_TNUMBER)
+ lua_pushstring(L, (lua_isinteger(L, 1)) ? "integer" : "float");
+ else {
+ luaL_checkany(L, 1);
+ luaL_pushfail(L);
+ }
+ return 1;
+}
+
+
+
/*
-** This function uses 'double' (instead of 'lua_Number') to ensure that
-** all bits from 'l_rand' can be represented, and that 'RANDMAX + 1.0'
-** will keep full precision (ensuring that 'r' is always less than 1.0.)
+** {==================================================================
+** Pseudo-Random Number Generator based on 'xoshiro256**'.
+** ===================================================================
*/
+
+/* number of binary digits in the mantissa of a float */
+#define FIGS l_floatatt(MANT_DIG)
+
+#if FIGS > 64
+/* there are only 64 random bits; use them all */
+#undef FIGS
+#define FIGS 64
+#endif
+
+
+/*
+** LUA_RAND32 forces the use of 32-bit integers in the implementation
+** of the PRN generator (mainly for testing).
+*/
+#if !defined(LUA_RAND32) && !defined(Rand64)
+
+/* try to find an integer type with at least 64 bits */
+
+#if (ULONG_MAX >> 31 >> 31) >= 3
+
+/* 'long' has at least 64 bits */
+#define Rand64 unsigned long
+
+#elif !defined(LUA_USE_C89) && defined(LLONG_MAX)
+
+/* there is a 'long long' type (which must have at least 64 bits) */
+#define Rand64 unsigned long long
+
+#elif (LUA_MAXUNSIGNED >> 31 >> 31) >= 3
+
+/* 'lua_Integer' has at least 64 bits */
+#define Rand64 lua_Unsigned
+
+#endif
+
+#endif
+
+
+#if defined(Rand64) /* { */
+
+/*
+** Standard implementation, using 64-bit integers.
+** If 'Rand64' has more than 64 bits, the extra bits do not interfere
+** with the 64 initial bits, except in a right shift. Moreover, the
+** final result has to discard the extra bits.
+*/
+
+/* avoid using extra bits when needed */
+#define trim64(x) ((x) & 0xffffffffffffffffu)
+
+
+/* rotate left 'x' by 'n' bits */
+static Rand64 rotl (Rand64 x, int n) {
+ return (x << n) | (trim64(x) >> (64 - n));
+}
+
+static Rand64 nextrand (Rand64 *state) {
+ Rand64 state0 = state[0];
+ Rand64 state1 = state[1];
+ Rand64 state2 = state[2] ^ state0;
+ Rand64 state3 = state[3] ^ state1;
+ Rand64 res = rotl(state1 * 5, 7) * 9;
+ state[0] = state0 ^ state3;
+ state[1] = state1 ^ state2;
+ state[2] = state2 ^ (state1 << 17);
+ state[3] = rotl(state3, 45);
+ return res;
+}
+
+
+/* must take care to not shift stuff by more than 63 slots */
+
+
+/*
+** Convert bits from a random integer into a float in the
+** interval [0,1), getting the higher FIG bits from the
+** random unsigned integer and converting that to a float.
+*/
+
+/* must throw out the extra (64 - FIGS) bits */
+#define shift64_FIG (64 - FIGS)
+
+/* to scale to [0, 1), multiply by scaleFIG = 2^(-FIGS) */
+#define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1)))
+
+static lua_Number I2d (Rand64 x) {
+ return (lua_Number)(trim64(x) >> shift64_FIG) * scaleFIG;
+}
+
+/* convert a 'Rand64' to a 'lua_Unsigned' */
+#define I2UInt(x) ((lua_Unsigned)trim64(x))
+
+/* convert a 'lua_Unsigned' to a 'Rand64' */
+#define Int2I(x) ((Rand64)(x))
+
+
+#else /* no 'Rand64' }{ */
+
+/* get an integer with at least 32 bits */
+#if LUAI_IS32INT
+typedef unsigned int lu_int32;
+#else
+typedef unsigned long lu_int32;
+#endif
+
+
+/*
+** Use two 32-bit integers to represent a 64-bit quantity.
+*/
+typedef struct Rand64 {
+ lu_int32 h; /* higher half */
+ lu_int32 l; /* lower half */
+} Rand64;
+
+
+/*
+** If 'lu_int32' has more than 32 bits, the extra bits do not interfere
+** with the 32 initial bits, except in a right shift and comparisons.
+** Moreover, the final result has to discard the extra bits.
+*/
+
+/* avoid using extra bits when needed */
+#define trim32(x) ((x) & 0xffffffffu)
+
+
+/*
+** basic operations on 'Rand64' values
+*/
+
+/* build a new Rand64 value */
+static Rand64 packI (lu_int32 h, lu_int32 l) {
+ Rand64 result;
+ result.h = h;
+ result.l = l;
+ return result;
+}
+
+/* return i << n */
+static Rand64 Ishl (Rand64 i, int n) {
+ lua_assert(n > 0 && n < 32);
+ return packI((i.h << n) | (trim32(i.l) >> (32 - n)), i.l << n);
+}
+
+/* i1 ^= i2 */
+static void Ixor (Rand64 *i1, Rand64 i2) {
+ i1->h ^= i2.h;
+ i1->l ^= i2.l;
+}
+
+/* return i1 + i2 */
+static Rand64 Iadd (Rand64 i1, Rand64 i2) {
+ Rand64 result = packI(i1.h + i2.h, i1.l + i2.l);
+ if (trim32(result.l) < trim32(i1.l)) /* carry? */
+ result.h++;
+ return result;
+}
+
+/* return i * 5 */
+static Rand64 times5 (Rand64 i) {
+ return Iadd(Ishl(i, 2), i); /* i * 5 == (i << 2) + i */
+}
+
+/* return i * 9 */
+static Rand64 times9 (Rand64 i) {
+ return Iadd(Ishl(i, 3), i); /* i * 9 == (i << 3) + i */
+}
+
+/* return 'i' rotated left 'n' bits */
+static Rand64 rotl (Rand64 i, int n) {
+ lua_assert(n > 0 && n < 32);
+ return packI((i.h << n) | (trim32(i.l) >> (32 - n)),
+ (trim32(i.h) >> (32 - n)) | (i.l << n));
+}
+
+/* for offsets larger than 32, rotate right by 64 - offset */
+static Rand64 rotl1 (Rand64 i, int n) {
+ lua_assert(n > 32 && n < 64);
+ n = 64 - n;
+ return packI((trim32(i.h) >> n) | (i.l << (32 - n)),
+ (i.h << (32 - n)) | (trim32(i.l) >> n));
+}
+
+/*
+** implementation of 'xoshiro256**' algorithm on 'Rand64' values
+*/
+static Rand64 nextrand (Rand64 *state) {
+ Rand64 res = times9(rotl(times5(state[1]), 7));
+ Rand64 t = Ishl(state[1], 17);
+ Ixor(&state[2], state[0]);
+ Ixor(&state[3], state[1]);
+ Ixor(&state[1], state[2]);
+ Ixor(&state[0], state[3]);
+ Ixor(&state[2], t);
+ state[3] = rotl1(state[3], 45);
+ return res;
+}
+
+
+/*
+** Converts a 'Rand64' into a float.
+*/
+
+/* an unsigned 1 with proper type */
+#define UONE ((lu_int32)1)
+
+
+#if FIGS <= 32
+
+/* 2^(-FIGS) */
+#define scaleFIG (l_mathop(0.5) / (UONE << (FIGS - 1)))
+
+/*
+** get up to 32 bits from higher half, shifting right to
+** throw out the extra bits.
+*/
+static lua_Number I2d (Rand64 x) {
+ lua_Number h = (lua_Number)(trim32(x.h) >> (32 - FIGS));
+ return h * scaleFIG;
+}
+
+#else /* 32 < FIGS <= 64 */
+
+/* must take care to not shift stuff by more than 31 slots */
+
+/* 2^(-FIGS) = 1.0 / 2^30 / 2^3 / 2^(FIGS-33) */
+#define scaleFIG \
+ ((lua_Number)1.0 / (UONE << 30) / 8.0 / (UONE << (FIGS - 33)))
+
+/*
+** use FIGS - 32 bits from lower half, throwing out the other
+** (32 - (FIGS - 32)) = (64 - FIGS) bits
+*/
+#define shiftLOW (64 - FIGS)
+
+/*
+** higher 32 bits go after those (FIGS - 32) bits: shiftHI = 2^(FIGS - 32)
+*/
+#define shiftHI ((lua_Number)(UONE << (FIGS - 33)) * 2.0)
+
+
+static lua_Number I2d (Rand64 x) {
+ lua_Number h = (lua_Number)trim32(x.h) * shiftHI;
+ lua_Number l = (lua_Number)(trim32(x.l) >> shiftLOW);
+ return (h + l) * scaleFIG;
+}
+
+#endif
+
+
+/* convert a 'Rand64' to a 'lua_Unsigned' */
+static lua_Unsigned I2UInt (Rand64 x) {
+ return ((lua_Unsigned)trim32(x.h) << 31 << 1) | (lua_Unsigned)trim32(x.l);
+}
+
+/* convert a 'lua_Unsigned' to a 'Rand64' */
+static Rand64 Int2I (lua_Unsigned n) {
+ return packI((lu_int32)(n >> 31 >> 1), (lu_int32)n);
+}
+
+#endif /* } */
+
+
+/*
+** A state uses four 'Rand64' values.
+*/
+typedef struct {
+ Rand64 s[4];
+} RanState;
+
+
+/*
+** Project the random integer 'ran' into the interval [0, n].
+** Because 'ran' has 2^B possible values, the projection can only be
+** uniform when the size of the interval is a power of 2 (exact
+** division). Otherwise, to get a uniform projection into [0, n], we
+** first compute 'lim', the smallest Mersenne number not smaller than
+** 'n'. We then project 'ran' into the interval [0, lim]. If the result
+** is inside [0, n], we are done. Otherwise, we try with another 'ran',
+** until we have a result inside the interval.
+*/
+static lua_Unsigned project (lua_Unsigned ran, lua_Unsigned n,
+ RanState *state) {
+ if ((n & (n + 1)) == 0) /* is 'n + 1' a power of 2? */
+ return ran & n; /* no bias */
+ else {
+ lua_Unsigned lim = n;
+ /* compute the smallest (2^b - 1) not smaller than 'n' */
+ lim |= (lim >> 1);
+ lim |= (lim >> 2);
+ lim |= (lim >> 4);
+ lim |= (lim >> 8);
+ lim |= (lim >> 16);
+#if (LUA_MAXUNSIGNED >> 31) >= 3
+ lim |= (lim >> 32); /* integer type has more than 32 bits */
+#endif
+ lua_assert((lim & (lim + 1)) == 0 /* 'lim + 1' is a power of 2, */
+ && lim >= n /* not smaller than 'n', */
+ && (lim >> 1) < n); /* and it is the smallest one */
+ while ((ran &= lim) > n) /* project 'ran' into [0..lim] */
+ ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */
+ return ran;
+ }
+}
+
+
static int math_random (lua_State *L) {
lua_Integer low, up;
- double r = (double)l_rand() * (1.0 / ((double)L_RANDMAX + 1.0));
+ lua_Unsigned p;
+ RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
+ Rand64 rv = nextrand(state->s); /* next pseudo-random value */
switch (lua_gettop(L)) { /* check number of arguments */
case 0: { /* no arguments */
- lua_pushnumber(L, (lua_Number)r); /* Number between 0 and 1 */
+ lua_pushnumber(L, I2d(rv)); /* float between 0 and 1 */
return 1;
}
case 1: { /* only upper limit */
low = 1;
up = luaL_checkinteger(L, 1);
+ if (up == 0) { /* single 0 as argument? */
+ lua_pushinteger(L, I2UInt(rv)); /* full random integer */
+ return 1;
+ }
break;
}
case 2: { /* lower and upper limits */
@@ -266,36 +581,73 @@
}
/* random integer in the interval [low, up] */
luaL_argcheck(L, low <= up, 1, "interval is empty");
- luaL_argcheck(L, low >= 0 || up <= LUA_MAXINTEGER + low, 1,
- "interval too large");
- r *= (double)(up - low) + 1.0;
- lua_pushinteger(L, (lua_Integer)r + low);
+ /* project random integer into the interval [0, up - low] */
+ p = project(I2UInt(rv), (lua_Unsigned)up - (lua_Unsigned)low, state);
+ lua_pushinteger(L, p + (lua_Unsigned)low);
return 1;
}
+static void setseed (lua_State *L, Rand64 *state,
+ lua_Unsigned n1, lua_Unsigned n2) {
+ int i;
+ state[0] = Int2I(n1);
+ state[1] = Int2I(0xff); /* avoid a zero state */
+ state[2] = Int2I(n2);
+ state[3] = Int2I(0);
+ for (i = 0; i < 16; i++)
+ nextrand(state); /* discard initial values to "spread" seed */
+ lua_pushinteger(L, n1);
+ lua_pushinteger(L, n2);
+}
+
+
+/*
+** Set a "random" seed. To get some randomness, use the current time
+** and the address of 'L' (in case the machine does address space layout
+** randomization).
+*/
+static void randseed (lua_State *L, RanState *state) {
+ lua_Unsigned seed1 = (lua_Unsigned)time(NULL);
+ lua_Unsigned seed2 = (lua_Unsigned)(size_t)L;
+ setseed(L, state->s, seed1, seed2);
+}
+
+
static int math_randomseed (lua_State *L) {
- l_srand((unsigned int)(lua_Integer)luaL_checknumber(L, 1));
- (void)l_rand(); /* discard first value to avoid undesirable correlations */
- return 0;
-}
-
-
-static int math_type (lua_State *L) {
- if (lua_type(L, 1) == LUA_TNUMBER) {
- if (lua_isinteger(L, 1))
- lua_pushliteral(L, "integer");
- else
- lua_pushliteral(L, "float");
+ RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
+ if (lua_isnone(L, 1)) {
+ randseed(L, state);
}
else {
- luaL_checkany(L, 1);
- lua_pushnil(L);
+ lua_Integer n1 = luaL_checkinteger(L, 1);
+ lua_Integer n2 = luaL_optinteger(L, 2, 0);
+ setseed(L, state->s, n1, n2);
}
- return 1;
+ return 2; /* return seeds */
}
+static const luaL_Reg randfuncs[] = {
+ {"random", math_random},
+ {"randomseed", math_randomseed},
+ {NULL, NULL}
+};
+
+
+/*
+** Register the random functions and initialize their state.
+*/
+static void setrandfunc (lua_State *L) {
+ RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0);
+ randseed(L, state); /* initialize with a "random" seed */
+ lua_pop(L, 2); /* remove pushed seeds */
+ luaL_setfuncs(L, randfuncs, 1);
+}
+
+/* }================================================================== */
+
+
/*
** {==================================================================
** Deprecated functions (for compatibility only)
@@ -367,8 +719,6 @@
{"min", math_min},
{"modf", math_modf},
{"rad", math_rad},
- {"random", math_random},
- {"randomseed", math_randomseed},
{"sin", math_sin},
{"sqrt", math_sqrt},
{"tan", math_tan},
@@ -384,6 +734,8 @@
{"log10", math_log10},
#endif
/* placeholders */
+ {"random", NULL},
+ {"randomseed", NULL},
{"pi", NULL},
{"huge", NULL},
{"maxinteger", NULL},
@@ -405,6 +757,7 @@
lua_setfield(L, -2, "maxinteger");
lua_pushinteger(L, LUA_MININTEGER);
lua_setfield(L, -2, "mininteger");
+ setrandfunc(L);
return 1;
}
diff --git a/src/lmem.c b/src/lmem.c
index 0241cc3..65bfa52 100644
--- a/src/lmem.c
+++ b/src/lmem.c
@@ -1,5 +1,5 @@
/*
-** $Id: lmem.c,v 1.91.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lmem.c $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
@@ -22,79 +22,181 @@
#include "lstate.h"
+#if defined(HARDMEMTESTS)
+/*
+** First allocation will fail whenever not building initial state
+** and not shrinking a block. (This fail will trigger 'tryagain' and
+** a full GC cycle at every allocation.)
+*/
+static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
+ if (ttisnil(&g->nilvalue) && ns > os)
+ return NULL; /* fail */
+ else /* normal allocation */
+ return (*g->frealloc)(g->ud, block, os, ns);
+}
+#else
+#define firsttry(g,block,os,ns) ((*g->frealloc)(g->ud, block, os, ns))
+#endif
+
+
+
+
/*
** About the realloc function:
-** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
+** 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' and returns NULL.
+** Particularly, frealloc(ud, NULL, 0, 0) does nothing,
+** which is equivalent to free(NULL) in ISO C.
**
-** * 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 ISO C)
+** - frealloc(ud, NULL, x, s) creates a new block of size 's'
+** (no matter 'x'). Returns NULL if it cannot create the new block.
**
-** frealloc returns NULL if it cannot create or reallocate the area
-** (any reallocation to an equal or smaller size cannot fail!)
+** - otherwise, frealloc(ud, b, x, y) reallocates the block 'b' from
+** size 'x' to size 'y'. Returns NULL if it cannot reallocate the
+** block to the new size.
*/
+
+/*
+** {==================================================================
+** Functions to allocate/deallocate arrays for the Parser
+** ===================================================================
+*/
+
+/*
+** Minimum size for arrays during parsing, to avoid overhead of
+** reallocating to size 1, then 2, and then 4. All these arrays
+** will be reallocated to exact sizes or erased when parsing ends.
+*/
#define MINSIZEARRAY 4
-void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,
- int limit, const char *what) {
+void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize,
+ int 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? */
+ int size = *psize;
+ if (nelems + 1 <= size) /* does one extra element still fit? */
+ return block; /* nothing to be done */
+ if (size >= limit / 2) { /* cannot double it? */
+ if (unlikely(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 */
+ size = limit; /* still have at least one free place */
}
else {
- newsize = (*size)*2;
- if (newsize < MINSIZEARRAY)
- newsize = MINSIZEARRAY; /* minimum size */
+ size *= 2;
+ if (size < MINSIZEARRAY)
+ size = MINSIZEARRAY; /* minimum size */
}
- newblock = luaM_reallocv(L, block, *size, newsize, size_elems);
- *size = newsize; /* update only when everything else is OK */
+ lua_assert(nelems + 1 <= size && size <= limit);
+ /* 'limit' ensures that multiplication will not overflow */
+ newblock = luaM_saferealloc_(L, block, cast_sizet(*psize) * size_elems,
+ cast_sizet(size) * size_elems);
+ *psize = size; /* update only when everything else is OK */
return newblock;
}
+/*
+** In prototypes, the size of the array is also its number of
+** elements (to save memory). So, if it cannot shrink an array
+** to its number of elements, the only option is to raise an
+** error.
+*/
+void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
+ int final_n, int size_elem) {
+ void *newblock;
+ size_t oldsize = cast_sizet((*size) * size_elem);
+ size_t newsize = cast_sizet(final_n * size_elem);
+ lua_assert(newsize <= oldsize);
+ newblock = luaM_saferealloc_(L, block, oldsize, newsize);
+ *size = final_n;
+ return newblock;
+}
+
+/* }================================================================== */
+
+
l_noret luaM_toobig (lua_State *L) {
luaG_runerror(L, "memory allocation error: block too big");
}
+/*
+** Free memory
+*/
+void luaM_free_ (lua_State *L, void *block, size_t osize) {
+ global_State *g = G(L);
+ lua_assert((osize == 0) == (block == NULL));
+ (*g->frealloc)(g->ud, block, osize, 0);
+ g->GCdebt -= osize;
+}
+
/*
-** generic allocation routine.
+** In case of allocation fail, this function will call the GC to try
+** to free some memory and then try the allocation again.
+** (It should not be called when shrinking a block, because then the
+** interpreter may be in the middle of a collection step.)
+*/
+static void *tryagain (lua_State *L, void *block,
+ size_t osize, size_t nsize) {
+ global_State *g = G(L);
+ if (ttisnil(&g->nilvalue)) { /* is state fully build? */
+ luaC_fullgc(L, 1); /* try to free some memory... */
+ return (*g->frealloc)(g->ud, block, osize, nsize); /* try again */
+ }
+ else return NULL; /* cannot free any memory without a full state */
+}
+
+
+/*
+** Generic allocation routine.
+** If allocation fails while shrinking a block, do not try again; the
+** GC shrinks some blocks and it is not reentrant.
*/
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) {
- lua_assert(nsize > realosize); /* cannot fail when shrinking a block */
- if (g->version) { /* is state fully built? */
- 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((osize == 0) == (block == NULL));
+ newblock = firsttry(g, block, osize, nsize);
+ if (unlikely(newblock == NULL && nsize > 0)) {
+ if (nsize > osize) /* not shrinking a block? */
+ newblock = tryagain(L, block, osize, nsize);
+ if (newblock == NULL) /* still no memory? */
+ return NULL; /* do not update 'GCdebt' */
}
lua_assert((nsize == 0) == (newblock == NULL));
- g->GCdebt = (g->GCdebt + nsize) - realosize;
+ g->GCdebt = (g->GCdebt + nsize) - osize;
return newblock;
}
+
+void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
+ size_t nsize) {
+ void *newblock = luaM_realloc_(L, block, osize, nsize);
+ if (unlikely(newblock == NULL && nsize > 0)) /* allocation failed? */
+ luaM_error(L);
+ return newblock;
+}
+
+
+void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
+ if (size == 0)
+ return NULL; /* that's all */
+ else {
+ global_State *g = G(L);
+ void *newblock = firsttry(g, NULL, tag, size);
+ if (unlikely(newblock == NULL)) {
+ newblock = tryagain(L, NULL, tag, size);
+ if (newblock == NULL)
+ luaM_error(L);
+ }
+ g->GCdebt += size;
+ return newblock;
+ }
+}
diff --git a/src/lmem.h b/src/lmem.h
index 357b1e4..8c75a44 100644
--- a/src/lmem.h
+++ b/src/lmem.h
@@ -1,5 +1,5 @@
/*
-** $Id: lmem.h,v 1.43.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lmem.h $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
@@ -14,12 +14,13 @@
#include "lua.h"
+#define luaM_error(L) luaD_throw(L, LUA_ERRMEM)
+
+
/*
-** This macro reallocs a vector 'b' from 'on' to 'n' elements, where
-** each element has size 'e'. In case of arithmetic overflow of the
-** product 'n'*'e', it raises an error (calling 'luaM_toobig'). Because
-** 'e' is always constant, it avoids the runtime division MAX_SIZET/(e).
-**
+** This macro tests whether it is safe to multiply 'n' by the size of
+** type 't' without overflows. Because 'e' is always constant, it avoids
+** the runtime division MAX_SIZET/(e).
** (The macro is somewhat complex to avoid warnings: The 'sizeof'
** comparison avoids a runtime comparison when overflow cannot occur.
** The compiler should be able to optimize the real test by itself, but
@@ -27,43 +28,66 @@
** false due to limited range of data type"; the +1 tricks the compiler,
** avoiding this warning but also this optimization.)
*/
-#define luaM_reallocv(L,b,on,n,e) \
- (((sizeof(n) >= sizeof(size_t) && cast(size_t, (n)) + 1 > MAX_SIZET/(e)) \
- ? luaM_toobig(L) : cast_void(0)) , \
- luaM_realloc_(L, (b), (on)*(e), (n)*(e)))
+#define luaM_testsize(n,e) \
+ (sizeof(n) >= sizeof(size_t) && cast_sizet((n)) + 1 > MAX_SIZET/(e))
+
+#define luaM_checksize(L,n,e) \
+ (luaM_testsize(n,e) ? luaM_toobig(L) : cast_void(0))
+
+
+/*
+** Computes the minimum between 'n' and 'MAX_SIZET/sizeof(t)', so that
+** the result is not larger than 'n' and cannot overflow a 'size_t'
+** when multiplied by the size of type 't'. (Assumes that 'n' is an
+** 'int' or 'unsigned int' and that 'int' is not larger than 'size_t'.)
+*/
+#define luaM_limitN(n,t) \
+ ((cast_sizet(n) <= MAX_SIZET/sizeof(t)) ? (n) : \
+ cast_uint((MAX_SIZET/sizeof(t))))
+
/*
** Arrays of chars do not need any test
*/
#define luaM_reallocvchar(L,b,on,n) \
- cast(char *, luaM_realloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
+ cast_charp(luaM_saferealloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
-#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_realloc_(L, (b), (n)*sizeof(*(b)), 0)
+#define luaM_freemem(L, b, s) luaM_free_(L, (b), (s))
+#define luaM_free(L, b) luaM_free_(L, (b), sizeof(*(b)))
+#define luaM_freearray(L, b, n) luaM_free_(L, (b), (n)*sizeof(*(b)))
-#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_new(L,t) cast(t*, luaM_malloc_(L, sizeof(t), 0))
+#define luaM_newvector(L,n,t) cast(t*, luaM_malloc_(L, (n)*sizeof(t), 0))
+#define luaM_newvectorchecked(L,n,t) \
+ (luaM_checksize(L,n,sizeof(t)), luaM_newvector(L,n,t))
-#define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s))
+#define luaM_newobject(L,tag,s) luaM_malloc_(L, (s), tag)
#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)))
+ ((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t), \
+ luaM_limitN(limit,t),e)))
#define luaM_reallocvector(L, v,oldn,n,t) \
- ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t))))
+ (cast(t *, luaM_realloc_(L, v, cast_sizet(oldn) * sizeof(t), \
+ cast_sizet(n) * sizeof(t))))
+
+#define luaM_shrinkvector(L,v,size,fs,t) \
+ ((v)=cast(t *, luaM_shrinkvector_(L, v, &(size), fs, 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,
+LUAI_FUNC void *luaM_saferealloc_ (lua_State *L, void *block, size_t oldsize,
+ size_t size);
+LUAI_FUNC void luaM_free_ (lua_State *L, void *block, size_t osize);
+LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int nelems,
+ int *size, int size_elem, int limit,
const char *what);
+LUAI_FUNC void *luaM_shrinkvector_ (lua_State *L, void *block, int *nelem,
+ int final_n, int size_elem);
+LUAI_FUNC void *luaM_malloc_ (lua_State *L, size_t size, int tag);
#endif
diff --git a/src/loadlib.c b/src/loadlib.c
index 45f44d3..c0ec9a1 100644
--- a/src/loadlib.c
+++ b/src/loadlib.c
@@ -1,5 +1,5 @@
/*
-** $Id: loadlib.c,v 1.130.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: loadlib.c $
** Dynamic library loader for Lua
** See Copyright Notice in lua.h
**
@@ -56,10 +56,10 @@
/*
-** unique key for table in the registry that keeps handles
+** key for table in the registry that keeps handles
** for all loaded C libraries
*/
-static const int CLIBS = 0;
+static const char *const CLIBS = "_CLIBS";
#define LIB_FAIL "open"
@@ -68,6 +68,13 @@
/*
+** Special type equivalent to '(void*)' for functions in gcc
+** (to suppress warnings when converting function pointers)
+*/
+typedef void (*voidf)(void);
+
+
+/*
** system-dependent functions
*/
@@ -206,7 +213,7 @@
static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
- lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym);
+ lua_CFunction f = (lua_CFunction)(voidf)GetProcAddress((HMODULE)lib, sym);
if (f == NULL) pusherror(L);
return f;
}
@@ -269,8 +276,6 @@
#endif
-#define AUXMARK "\1" /* auxiliary mark */
-
/*
** return registry.LUA_NOENV as a boolean
@@ -290,22 +295,33 @@
static void setpath (lua_State *L, const char *fieldname,
const char *envname,
const char *dft) {
+ const char *dftmark;
const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);
- const char *path = getenv(nver); /* use versioned name */
- if (path == NULL) /* no environment variable? */
+ const char *path = getenv(nver); /* try versioned name */
+ if (path == NULL) /* no versioned environment variable? */
path = getenv(envname); /* try unversioned name */
if (path == NULL || noenv(L)) /* no environment variable? */
lua_pushstring(L, dft); /* 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, dft);
- lua_remove(L, -2); /* remove result from 1st 'gsub' */
+ else if ((dftmark = strstr(path, LUA_PATH_SEP LUA_PATH_SEP)) == NULL)
+ lua_pushstring(L, path); /* nothing to change */
+ else { /* path contains a ";;": insert default path in its place */
+ size_t len = strlen(path);
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ if (path < dftmark) { /* is there a prefix before ';;'? */
+ luaL_addlstring(&b, path, dftmark - path); /* add it */
+ luaL_addchar(&b, *LUA_PATH_SEP);
+ }
+ luaL_addstring(&b, dft); /* add default */
+ if (dftmark < path + len - 2) { /* is there a suffix after ';;'? */
+ luaL_addchar(&b, *LUA_PATH_SEP);
+ luaL_addlstring(&b, dftmark + 2, (path + len - 2) - dftmark);
+ }
+ luaL_pushresult(&b);
}
setprogdir(L);
lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */
- lua_pop(L, 1); /* pop versioned variable name */
+ lua_pop(L, 1); /* pop versioned variable name ('nver') */
}
/* }================================================================== */
@@ -316,7 +332,7 @@
*/
static void *checkclib (lua_State *L, const char *path) {
void *plib;
- lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
+ 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' */
@@ -329,7 +345,7 @@
** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries
*/
static void addtoclib (lua_State *L, const char *path, void *plib) {
- lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
+ lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
lua_pushlightuserdata(L, plib);
lua_pushvalue(L, -1);
lua_setfield(L, -3, path); /* CLIBS[path] = plib */
@@ -397,10 +413,10 @@
if (stat == 0) /* no errors? */
return 1; /* return the loaded function */
else { /* error; error message is on stack top */
- lua_pushnil(L);
+ luaL_pushfail(L);
lua_insert(L, -2);
lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
- return 3; /* return nil, error message, and where */
+ return 3; /* return fail, error message, and where */
}
}
@@ -421,14 +437,42 @@
}
-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;
+/*
+** Get the next name in '*path' = 'name1;name2;name3;...', changing
+** the ending ';' to '\0' to create a zero-terminated string. Return
+** NULL when list ends.
+*/
+static const char *getnextfilename (char **path, char *end) {
+ char *sep;
+ char *name = *path;
+ if (name == end)
+ return NULL; /* no more names */
+ else if (*name == '\0') { /* from previous iteration? */
+ *name = *LUA_PATH_SEP; /* restore separator */
+ name++; /* skip it */
+ }
+ sep = strchr(name, *LUA_PATH_SEP); /* find next separator */
+ if (sep == NULL) /* separator not found? */
+ sep = end; /* name goes until the end */
+ *sep = '\0'; /* finish file name */
+ *path = sep; /* will start next search from here */
+ return name;
+}
+
+
+/*
+** Given a path such as ";blabla.so;blublu.so", pushes the string
+**
+** no file 'blabla.so'
+** no file 'blublu.so'
+*/
+static void pusherrornotfound (lua_State *L, const char *path) {
+ luaL_Buffer b;
+ luaL_buffinit(L, &b);
+ luaL_addstring(&b, "no file '");
+ luaL_addgsub(&b, path, LUA_PATH_SEP, "'\n\tno file '");
+ luaL_addstring(&b, "'");
+ luaL_pushresult(&b);
}
@@ -436,21 +480,25 @@
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? */
+ luaL_Buffer buff;
+ char *pathname; /* path with name inserted */
+ char *endpathname; /* its end */
+ const char *filename;
+ /* separator is non-empty and appears in 'name'? */
+ if (*sep != '\0' && strchr(name, *sep) != NULL)
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 */
+ luaL_buffinit(L, &buff);
+ /* add path to the buffer, replacing marks ('?') with the file name */
+ luaL_addgsub(&buff, path, LUA_PATH_MARK, name);
+ luaL_addchar(&buff, '\0');
+ pathname = luaL_buffaddr(&buff); /* writable list of file names */
+ endpathname = pathname + luaL_bufflen(&buff) - 1;
+ while ((filename = getnextfilename(&pathname, endpathname)) != NULL) {
if (readable(filename)) /* does file exist and is readable? */
- return filename; /* return that file name */
- lua_pushfstring(L, "\n\tno file '%s'", filename);
- lua_remove(L, -2); /* remove file name */
- luaL_addvalue(&msg); /* concatenate error msg. entry */
+ return lua_pushstring(L, filename); /* save and return name */
}
- luaL_pushresult(&msg); /* create error message */
+ luaL_pushresult(&buff); /* push path to create error message */
+ pusherrornotfound(L, lua_tostring(L, -1)); /* create error message */
return NULL; /* not found */
}
@@ -462,9 +510,9 @@
luaL_optstring(L, 4, LUA_DIRSEP));
if (f != NULL) return 1;
else { /* error message is on top of the stack */
- lua_pushnil(L);
+ luaL_pushfail(L);
lua_insert(L, -2);
- return 2; /* return nil + error message */
+ return 2; /* return fail + error message */
}
}
@@ -548,7 +596,7 @@
if (stat != ERRFUNC)
return checkload(L, 0, filename); /* real error */
else { /* open function not found */
- lua_pushfstring(L, "\n\tno module '%s' in file '%s'", name, filename);
+ lua_pushfstring(L, "no module '%s' in file '%s'", name, filename);
return 1;
}
}
@@ -560,23 +608,30 @@
static int searcher_preload (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
- if (lua_getfield(L, -1, name) == LUA_TNIL) /* not found? */
- lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
- return 1;
+ if (lua_getfield(L, -1, name) == LUA_TNIL) { /* not found? */
+ lua_pushfstring(L, "no field package.preload['%s']", name);
+ return 1;
+ }
+ else {
+ lua_pushliteral(L, ":preload:");
+ return 2;
+ }
}
static void findloader (lua_State *L, const char *name) {
int i;
luaL_Buffer msg; /* to build error message */
- luaL_buffinit(L, &msg);
/* push 'package.searchers' to index 3 in the stack */
if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE)
luaL_error(L, "'package.searchers' must be a table");
+ luaL_buffinit(L, &msg);
/* iterate over available searchers to find a loader */
for (i = 1; ; i++) {
+ luaL_addstring(&msg, "\n\t"); /* error-message prefix */
if (lua_rawgeti(L, 3, i) == LUA_TNIL) { /* no more searchers? */
lua_pop(L, 1); /* remove nil */
+ luaL_buffsub(&msg, 2); /* remove prefix */
luaL_pushresult(&msg); /* create error message */
luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
}
@@ -588,8 +643,10 @@
lua_pop(L, 1); /* remove extra return */
luaL_addvalue(&msg); /* concatenate error message */
}
- else
+ else { /* no error message */
lua_pop(L, 2); /* remove both returns */
+ luaL_buffsub(&msg, 2); /* remove prefix */
+ }
}
}
@@ -604,113 +661,33 @@
/* 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_rotate(L, -2, 1); /* function <-> loader data */
+ lua_pushvalue(L, 1); /* name is 1st argument to module loader */
+ lua_pushvalue(L, -3); /* loader data is 2nd argument */
+ /* stack: ...; loader data; loader function; mod. name; loader data */
lua_call(L, 2, 1); /* run loader to load module */
+ /* stack: ...; loader data; result from loader */
if (!lua_isnil(L, -1)) /* non-nil return? */
lua_setfield(L, 2, name); /* LOADED[name] = returned value */
+ else
+ lua_pop(L, 1); /* pop nil */
if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */
lua_pushboolean(L, 1); /* use true as result */
- lua_pushvalue(L, -1); /* extra copy to be returned */
+ lua_copy(L, -1, -2); /* replace loader result */
lua_setfield(L, 2, name); /* LOADED[name] = true */
}
- return 1;
+ lua_rotate(L, -2, 1); /* loader data <-> module result */
+ return 2; /* return module result and loader data */
}
/* }====================================================== */
-/*
-** {======================================================
-** '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, "'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 */
- if (lua_getfield(L, -1, "_NAME") != LUA_TNIL)
- lua_pop(L, 1); /* table is an initialized module */
- 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
-/* }====================================================== */
-
-
static const luaL_Reg pk_funcs[] = {
{"loadlib", ll_loadlib},
{"searchpath", ll_searchpath},
-#if defined(LUA_COMPAT_MODULE)
- {"seeall", ll_seeall},
-#endif
/* placeholders */
{"preload", NULL},
{"cpath", NULL},
@@ -722,9 +699,6 @@
static const luaL_Reg ll_funcs[] = {
-#if defined(LUA_COMPAT_MODULE)
- {"module", ll_module},
-#endif
{"require", ll_require},
{NULL, NULL}
};
@@ -742,10 +716,6 @@
lua_pushcclosure(L, searchers[i], 1);
lua_rawseti(L, -2, i+1);
}
-#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' */
}
@@ -755,12 +725,11 @@
** setting a finalizer to close all libraries when closing state.
*/
static void createclibstable (lua_State *L) {
- lua_newtable(L); /* create CLIBS table */
+ luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */
lua_createtable(L, 0, 1); /* create metatable for CLIBS */
lua_pushcfunction(L, gctm);
lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */
lua_setmetatable(L, -2);
- lua_rawsetp(L, LUA_REGISTRYINDEX, &CLIBS); /* set CLIBS table in registry */
}
diff --git a/src/lobject.c b/src/lobject.c
index 2218c8c..b4efae4 100644
--- a/src/lobject.c
+++ b/src/lobject.c
@@ -1,5 +1,5 @@
/*
-** $Id: lobject.c,v 2.113.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: lobject.c $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
@@ -29,36 +29,6 @@
#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 >= (8 << 4)) { /* coarse steps */
- x = (x + 0xf) >> 4; /* x = ceil(x / 16) */
- e += 4;
- }
- while (x >= (8 << 1)) { /* fine steps */
- x = (x + 1) >> 1; /* x = ceil(x / 2) */
- e++;
- }
- return ((e+1) << 3) | (cast_int(x) - 8);
-}
-
-
-/* converts back */
-int luaO_fb2int (int x) {
- return (x < 8) ? x : ((x & 7) + 8) << ((x >> 3) - 1);
-}
-
-
/*
** Computes ceil(log2(x))
*/
@@ -87,7 +57,7 @@
case LUA_OPSUB:return intop(-, v1, v2);
case LUA_OPMUL:return intop(*, v1, v2);
case LUA_OPMOD: return luaV_mod(L, v1, v2);
- case LUA_OPIDIV: return luaV_div(L, v1, v2);
+ case LUA_OPIDIV: return luaV_idiv(L, v1, v2);
case LUA_OPBAND: return intop(&, v1, v2);
case LUA_OPBOR: return intop(|, v1, v2);
case LUA_OPBXOR: return intop(^, v1, v2);
@@ -110,53 +80,55 @@
case LUA_OPPOW: return luai_numpow(L, v1, v2);
case LUA_OPIDIV: return luai_numidiv(L, v1, v2);
case LUA_OPUNM: return luai_numunm(L, v1);
- case LUA_OPMOD: {
- lua_Number m;
- luai_nummod(L, v1, v2, m);
- return m;
- }
+ case LUA_OPMOD: return luaV_modf(L, v1, v2);
default: lua_assert(0); return 0;
}
}
-void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,
- TValue *res) {
+int luaO_rawarith (lua_State *L, int op, const TValue *p1, const TValue *p2,
+ TValue *res) {
switch (op) {
case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
case LUA_OPSHL: case LUA_OPSHR:
case LUA_OPBNOT: { /* operate only on integers */
lua_Integer i1; lua_Integer i2;
- if (tointeger(p1, &i1) && tointeger(p2, &i2)) {
+ if (tointegerns(p1, &i1) && tointegerns(p2, &i2)) {
setivalue(res, intarith(L, op, i1, i2));
- return;
+ return 1;
}
- else break; /* go to the end */
+ else return 0; /* fail */
}
case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */
lua_Number n1; lua_Number n2;
- if (tonumber(p1, &n1) && tonumber(p2, &n2)) {
+ if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
setfltvalue(res, numarith(L, op, n1, n2));
- return;
+ return 1;
}
- else break; /* go to the end */
+ else return 0; /* fail */
}
default: { /* other operations */
lua_Number n1; lua_Number n2;
if (ttisinteger(p1) && ttisinteger(p2)) {
setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2)));
- return;
+ return 1;
}
- else if (tonumber(p1, &n1) && tonumber(p2, &n2)) {
+ else if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
setfltvalue(res, numarith(L, op, n1, n2));
- return;
+ return 1;
}
- else break; /* go to the end */
+ else return 0; /* fail */
}
}
- /* could not perform raw operation; try metamethod */
- lua_assert(L != NULL); /* should not fail when folding (compile time) */
- luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));
+}
+
+
+void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,
+ StkId res) {
+ if (!luaO_rawarith(L, op, p1, p2, s2v(res))) {
+ /* could not perform raw operation; try metamethod */
+ luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));
+ }
}
@@ -187,7 +159,7 @@
#define MAXSIGDIG 30
/*
-** convert an hexadecimal numeric string to a number, following
+** convert a hexadecimal numeric string to a number, following
** C99 specification for 'strtod'
*/
static lua_Number lua_strx2number (const char *s, char **endptr) {
@@ -198,9 +170,9 @@
int e = 0; /* exponent correction */
int neg; /* 1 if number is negative */
int hasdot = 0; /* true after seen a dot */
- *endptr = cast(char *, s); /* nothing is valid yet */
+ *endptr = cast_charp(s); /* nothing is valid yet */
while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
- neg = isneg(&s); /* check signal */
+ neg = isneg(&s); /* check sign */
if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */
return 0.0; /* invalid format (no '0x') */
for (s += 2; ; s++) { /* skip '0x' and read numeral */
@@ -220,20 +192,20 @@
}
if (nosigdig + sigdig == 0) /* no digits? */
return 0.0; /* invalid format */
- *endptr = cast(char *, s); /* valid up to here */
+ *endptr = cast_charp(s); /* valid up to here */
e *= 4; /* each digit multiplies/divides value by 2^4 */
if (*s == 'p' || *s == 'P') { /* exponent part? */
int exp1 = 0; /* exponent value */
- int neg1; /* exponent signal */
+ int neg1; /* exponent sign */
s++; /* skip 'p' */
- neg1 = isneg(&s); /* signal */
+ neg1 = isneg(&s); /* sign */
if (!lisdigit(cast_uchar(*s)))
return 0.0; /* invalid; 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 */
+ *endptr = cast_charp(s); /* valid up to here */
}
if (neg) r = -r;
return l_mathop(ldexp)(r, e);
@@ -262,11 +234,11 @@
** Convert string 's' to a Lua number (put in 'result'). Return NULL
** on fail or the address of the ending '\0' on success.
** 'pmode' points to (and 'mode' contains) special things in the string:
-** - 'x'/'X' means an hexadecimal numeral
+** - 'x'/'X' means a hexadecimal numeral
** - 'n'/'N' means 'inf' or 'nan' (which should be rejected)
** - '.' just optimizes the search for the common case (nothing special)
** This function accepts both the current locale or a dot as the radix
-** mark. If the convertion fails, it may mean number has a dot but
+** mark. If the conversion fails, it may mean number has a dot but
** locale accepts something else. In that case, the code copies 's'
** to a buffer (because 's' is read-only), changes the dot to the
** current locale radix mark, and tries to convert again.
@@ -345,17 +317,17 @@
int luaO_utf8esc (char *buff, unsigned long x) {
int n = 1; /* number of bytes put in buffer (backwards) */
- lua_assert(x <= 0x10FFFF);
+ lua_assert(x <= 0x7FFFFFFFu);
if (x < 0x80) /* ascii? */
- buff[UTF8BUFFSZ - 1] = cast(char, x);
+ buff[UTF8BUFFSZ - 1] = cast_char(x);
else { /* need continuation bytes */
unsigned int mfb = 0x3f; /* maximum that fits in first byte */
do { /* add continuation bytes */
- buff[UTF8BUFFSZ - (n++)] = cast(char, 0x80 | (x & 0x3f));
+ buff[UTF8BUFFSZ - (n++)] = cast_char(0x80 | (x & 0x3f));
x >>= 6; /* remove added bits */
mfb >>= 1; /* now there is one less bit available in first byte */
} while (x > mfb); /* still needs continuation byte? */
- buff[UTF8BUFFSZ - n] = cast(char, (~mfb << 1) | x); /* add first byte */
+ buff[UTF8BUFFSZ - n] = cast_char((~mfb << 1) | x); /* add first byte */
}
return n;
}
@@ -366,88 +338,178 @@
/*
-** Convert a number object to a string
+** Convert a number object to a string, adding it to a buffer
*/
-void luaO_tostring (lua_State *L, StkId obj) {
- char buff[MAXNUMBER2STR];
- size_t len;
+static int tostringbuff (TValue *obj, char *buff) {
+ int len;
lua_assert(ttisnumber(obj));
if (ttisinteger(obj))
- len = lua_integer2str(buff, sizeof(buff), ivalue(obj));
+ len = lua_integer2str(buff, MAXNUMBER2STR, ivalue(obj));
else {
- len = lua_number2str(buff, sizeof(buff), fltvalue(obj));
-#if !defined(LUA_COMPAT_FLOATSTRING)
+ len = lua_number2str(buff, MAXNUMBER2STR, fltvalue(obj));
if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */
buff[len++] = lua_getlocaledecpoint();
buff[len++] = '0'; /* adds '.0' to result */
}
-#endif
}
- setsvalue2s(L, obj, luaS_newlstr(L, buff, len));
-}
-
-
-static void pushstr (lua_State *L, const char *str, size_t l) {
- setsvalue2s(L, L->top, luaS_newlstr(L, str, l));
- luaD_inctop(L);
+ return len;
}
/*
-** this function handles only '%d', '%c', '%f', '%p', and '%s'
+** Convert a number object to a Lua string, replacing the value at 'obj'
+*/
+void luaO_tostring (lua_State *L, TValue *obj) {
+ char buff[MAXNUMBER2STR];
+ int len = tostringbuff(obj, buff);
+ setsvalue(L, obj, luaS_newlstr(L, buff, len));
+}
+
+
+
+
+/*
+** {==================================================================
+** 'luaO_pushvfstring'
+** ===================================================================
+*/
+
+/* size for buffer space used by 'luaO_pushvfstring' */
+#define BUFVFS 400
+
+/* buffer used by 'luaO_pushvfstring' */
+typedef struct BuffFS {
+ lua_State *L;
+ int pushed; /* number of string pieces already on the stack */
+ int blen; /* length of partial string in 'space' */
+ char space[BUFVFS]; /* holds last part of the result */
+} BuffFS;
+
+
+/*
+** Push given string to the stack, as part of the buffer. If the stack
+** is almost full, join all partial strings in the stack into one.
+*/
+static void pushstr (BuffFS *buff, const char *str, size_t l) {
+ lua_State *L = buff->L;
+ setsvalue2s(L, L->top, luaS_newlstr(L, str, l));
+ L->top++; /* may use one extra slot */
+ buff->pushed++;
+ if (buff->pushed > 1 && L->top + 1 >= L->stack_last) {
+ luaV_concat(L, buff->pushed); /* join all partial results into one */
+ buff->pushed = 1;
+ }
+}
+
+
+/*
+** empty the buffer space into the stack
+*/
+static void clearbuff (BuffFS *buff) {
+ pushstr(buff, buff->space, buff->blen); /* push buffer contents */
+ buff->blen = 0; /* space now is empty */
+}
+
+
+/*
+** Get a space of size 'sz' in the buffer. If buffer has not enough
+** space, empty it. 'sz' must fit in an empty buffer.
+*/
+static char *getbuff (BuffFS *buff, int sz) {
+ lua_assert(buff->blen <= BUFVFS); lua_assert(sz <= BUFVFS);
+ if (sz > BUFVFS - buff->blen) /* not enough space? */
+ clearbuff(buff);
+ return buff->space + buff->blen;
+}
+
+
+#define addsize(b,sz) ((b)->blen += (sz))
+
+
+/*
+** Add 'str' to the buffer. If string is larger than the buffer space,
+** push the string directly to the stack.
+*/
+static void addstr2buff (BuffFS *buff, const char *str, size_t slen) {
+ if (slen <= BUFVFS) { /* does string fit into buffer? */
+ char *bf = getbuff(buff, cast_int(slen));
+ memcpy(bf, str, slen); /* add string to buffer */
+ addsize(buff, cast_int(slen));
+ }
+ else { /* string larger than buffer */
+ clearbuff(buff); /* string comes after buffer's content */
+ pushstr(buff, str, slen); /* push string */
+ }
+}
+
+
+/*
+** Add a number to the buffer.
+*/
+static void addnum2buff (BuffFS *buff, TValue *num) {
+ char *numbuff = getbuff(buff, MAXNUMBER2STR);
+ int len = tostringbuff(num, numbuff); /* format number into 'numbuff' */
+ addsize(buff, len);
+}
+
+
+/*
+** this function handles only '%d', '%c', '%f', '%p', '%s', and '%%'
conventional formats, plus Lua-specific '%I' and '%U'
*/
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;
- pushstr(L, fmt, e - fmt);
- switch (*(e+1)) {
+ BuffFS buff; /* holds last part of the result */
+ const char *e; /* points to next '%' */
+ buff.pushed = buff.blen = 0;
+ buff.L = L;
+ while ((e = strchr(fmt, '%')) != NULL) {
+ addstr2buff(&buff, fmt, e - fmt); /* add 'fmt' up to '%' */
+ switch (*(e + 1)) { /* conversion specifier */
case 's': { /* zero-terminated string */
const char *s = va_arg(argp, char *);
if (s == NULL) s = "(null)";
- pushstr(L, s, strlen(s));
+ addstr2buff(&buff, s, strlen(s));
break;
}
case 'c': { /* an 'int' as a character */
- char buff = cast(char, va_arg(argp, int));
- if (lisprint(cast_uchar(buff)))
- pushstr(L, &buff, 1);
- else /* non-printable character; print its code */
- luaO_pushfstring(L, "<\\%d>", cast_uchar(buff));
+ char c = cast_uchar(va_arg(argp, int));
+ addstr2buff(&buff, &c, sizeof(char));
break;
}
case 'd': { /* an 'int' */
- setivalue(L->top, va_arg(argp, int));
- goto top2str;
+ TValue num;
+ setivalue(&num, va_arg(argp, int));
+ addnum2buff(&buff, &num);
+ break;
}
case 'I': { /* a 'lua_Integer' */
- setivalue(L->top, cast(lua_Integer, va_arg(argp, l_uacInt)));
- goto top2str;
+ TValue num;
+ setivalue(&num, cast(lua_Integer, va_arg(argp, l_uacInt)));
+ addnum2buff(&buff, &num);
+ break;
}
case 'f': { /* a 'lua_Number' */
- setfltvalue(L->top, cast_num(va_arg(argp, l_uacNumber)));
- top2str: /* convert the top element to a string */
- luaD_inctop(L);
- luaO_tostring(L, L->top - 1);
+ TValue num;
+ setfltvalue(&num, cast_num(va_arg(argp, l_uacNumber)));
+ addnum2buff(&buff, &num);
break;
}
case 'p': { /* a pointer */
- char buff[4*sizeof(void *) + 8]; /* should be enough space for a '%p' */
+ const int sz = 3 * sizeof(void*) + 8; /* enough space for '%p' */
+ char *bf = getbuff(&buff, sz);
void *p = va_arg(argp, void *);
- int l = lua_pointer2str(buff, sizeof(buff), p);
- pushstr(L, buff, l);
+ int len = lua_pointer2str(bf, sz, p);
+ addsize(&buff, len);
break;
}
- case 'U': { /* an 'int' as a UTF-8 sequence */
- char buff[UTF8BUFFSZ];
- int l = luaO_utf8esc(buff, cast(long, va_arg(argp, long)));
- pushstr(L, buff + UTF8BUFFSZ - l, l);
+ case 'U': { /* a 'long' as a UTF-8 sequence */
+ char bf[UTF8BUFFSZ];
+ int len = luaO_utf8esc(bf, va_arg(argp, long));
+ addstr2buff(&buff, bf + UTF8BUFFSZ - len, len);
break;
}
case '%': {
- pushstr(L, "%", 1);
+ addstr2buff(&buff, "%", 1);
break;
}
default: {
@@ -455,13 +517,13 @@
*(e + 1));
}
}
- n += 2;
- fmt = e+2;
+ fmt = e + 2; /* skip '%' and the specifier */
}
- luaD_checkstack(L, 1);
- pushstr(L, fmt, strlen(fmt));
- if (n > 0) luaV_concat(L, n + 1);
- return svalue(L->top - 1);
+ addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */
+ clearbuff(&buff); /* empty buffer into the stack */
+ if (buff.pushed > 1)
+ luaV_concat(L, buff.pushed); /* join all partial results */
+ return svalue(s2v(L->top - 1));
}
@@ -474,9 +536,8 @@
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 \""
@@ -484,36 +545,36 @@
#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);
+void luaO_chunkid (char *out, const char *source, size_t srclen) {
+ size_t bufflen = LUA_IDSIZE; /* free space in buffer */
if (*source == '=') { /* 'literal' source */
- if (l <= bufflen) /* small enough? */
- memcpy(out, source + 1, l * sizeof(char));
+ if (srclen <= bufflen) /* small enough? */
+ memcpy(out, source + 1, srclen * 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));
+ if (srclen <= bufflen) /* small enough? */
+ memcpy(out, source + 1, srclen * 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));
+ memcpy(out, source + 1 + srclen - 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 */
+ if (srclen < bufflen && nl == NULL) { /* small one-line source? */
+ addstr(out, source, srclen); /* keep it */
}
else {
- if (nl != NULL) l = nl - source; /* stop at first newline */
- if (l > bufflen) l = bufflen;
- addstr(out, source, l);
+ if (nl != NULL) srclen = nl - source; /* stop at first newline */
+ if (srclen > bufflen) srclen = bufflen;
+ addstr(out, source, srclen);
addstr(out, RETS, LL(RETS));
}
memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
diff --git a/src/lobject.h b/src/lobject.h
index 2408861..04a81d3 100644
--- a/src/lobject.h
+++ b/src/lobject.h
@@ -1,5 +1,5 @@
/*
-** $Id: lobject.h,v 2.117.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lobject.h $
** Type definitions for Lua objects
** See Copyright Notice in lua.h
*/
@@ -17,288 +17,346 @@
/*
-** Extra tags for non-values
+** Extra types for collectable non-values
*/
-#define LUA_TPROTO LUA_NUMTAGS /* function prototypes */
-#define LUA_TDEADKEY (LUA_NUMTAGS+1) /* removed keys in tables */
+#define LUA_TUPVAL LUA_NUMTYPES /* upvalues */
+#define LUA_TPROTO (LUA_NUMTYPES+1) /* function prototypes */
+
/*
-** number of all possible tags (including LUA_TNONE but excluding DEADKEY)
+** number of all possible types (including LUA_TNONE)
*/
-#define LUA_TOTALTAGS (LUA_TPROTO + 2)
+#define LUA_TOTALTYPES (LUA_TPROTO + 2)
/*
** tags for Tagged Values have the following use of bits:
-** bits 0-3: actual tag (a LUA_T* value)
+** bits 0-3: actual tag (a LUA_T* constant)
** bits 4-5: variant bits
** bit 6: whether value is collectable
*/
-
-/*
-** 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 */
+/* add variant bits to a type */
+#define makevariant(t,v) ((t) | ((v) << 4))
-/* Variant tags for strings */
-#define LUA_TSHRSTR (LUA_TSTRING | (0 << 4)) /* short strings */
-#define LUA_TLNGSTR (LUA_TSTRING | (1 << 4)) /* long strings */
-
-
-/* Variant tags for numbers */
-#define LUA_TNUMFLT (LUA_TNUMBER | (0 << 4)) /* float numbers */
-#define LUA_TNUMINT (LUA_TNUMBER | (1 << 4)) /* integer numbers */
-
-
-/* Bit mark for collectable types */
-#define BIT_ISCOLLECTABLE (1 << 6)
-
-/* mark a tag as collectable */
-#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
-
-
-/*
-** Common type for all collectable objects
-*/
-typedef struct 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 type has only the common header
-*/
-struct GCObject {
- CommonHeader;
-};
-
-
-
-
-/*
-** Tagged Values. This is the basic representation of values in Lua,
-** an actual value plus a tag with its type.
-*/
/*
** Union of all Lua values
*/
typedef union Value {
- GCObject *gc; /* collectable objects */
+ struct GCObject *gc; /* collectable objects */
void *p; /* light userdata */
- int b; /* booleans */
lua_CFunction f; /* light C functions */
lua_Integer i; /* integer numbers */
lua_Number n; /* float numbers */
} Value;
-#define TValuefields Value value_; int tt_
+/*
+** Tagged Values. This is the basic representation of values in Lua:
+** an actual value plus a tag with its type.
+*/
+#define TValuefields Value value_; lu_byte tt_
-typedef struct lua_TValue {
+typedef struct TValue {
TValuefields;
} TValue;
-
-/* macro defining a nil value */
-#define NILCONSTANT {NULL}, LUA_TNIL
-
-
#define val_(o) ((o)->value_)
+#define valraw(o) (&val_(o))
/* raw type tag of a TValue */
-#define rttype(o) ((o)->tt_)
+#define rawtt(o) ((o)->tt_)
/* tag with no variants (bits 0-3) */
-#define novariant(x) ((x) & 0x0F)
+#define novariant(t) ((t) & 0x0F)
/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */
-#define ttype(o) (rttype(o) & 0x3F)
+#define withvariant(t) ((t) & 0x3F)
+#define ttypetag(o) withvariant(rawtt(o))
-/* type tag of a TValue with no variants (bits 0-3) */
-#define ttnov(o) (novariant(rttype(o)))
+/* type of a TValue */
+#define ttype(o) (novariant(rawtt(o)))
/* Macros to test type */
-#define checktag(o,t) (rttype(o) == (t))
-#define checktype(o,t) (ttnov(o) == (t))
-#define ttisnumber(o) checktype((o), LUA_TNUMBER)
-#define ttisfloat(o) checktag((o), LUA_TNUMFLT)
-#define ttisinteger(o) checktag((o), LUA_TNUMINT)
-#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 ttisfulluserdata(o) checktag((o), ctb(LUA_TUSERDATA))
-#define ttisthread(o) checktag((o), ctb(LUA_TTHREAD))
-#define ttisdeadkey(o) checktag((o), LUA_TDEADKEY)
-
-
-/* Macros to access values */
-#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)
-#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)
-#define nvalue(o) check_exp(ttisnumber(o), \
- (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))
-#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
-#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
-#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))
-#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))
-#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))
-#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))
-#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))
-#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
-#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))
-#define bvalue(o) check_exp(ttisboolean(o), val_(o).b)
-#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))
-/* 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)
+#define checktag(o,t) (rawtt(o) == (t))
+#define checktype(o,t) (ttype(o) == (t))
/* Macros for internal tests */
-#define righttt(obj) (ttype(obj) == gcvalue(obj)->tt)
+/* collectable object has the same tag as the original value */
+#define righttt(obj) (ttypetag(obj) == gcvalue(obj)->tt)
+
+/*
+** Any value being manipulated by the program either is non
+** collectable, or the collectable object has the right tag
+** and it is not dead.
+*/
#define checkliveness(L,obj) \
- lua_longassert(!iscollectable(obj) || \
- (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj)))))
+ ((void)L, lua_longassert(!iscollectable(obj) || \
+ (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj))))))
/* Macros to set values */
+
+/* set a value's tag */
#define settt_(o,t) ((o)->tt_=(t))
+
+/* main macro to copy values (from 'obj1' to 'obj2') */
+#define setobj(L,obj1,obj2) \
+ { TValue *io1=(obj1); const TValue *io2=(obj2); \
+ io1->value_ = io2->value_; settt_(io1, io2->tt_); \
+ checkliveness(L,io1); lua_assert(!isnonstrictnil(io1)); }
+
+/*
+** Different types of assignments, according to source and destination.
+** (They are mostly equal now, but may be different in the future.)
+*/
+
+/* from stack to stack */
+#define setobjs2s(L,o1,o2) setobj(L,s2v(o1),s2v(o2))
+/* to stack (not from same stack) */
+#define setobj2s(L,o1,o2) setobj(L,s2v(o1),o2)
+/* from table to same table */
+#define setobjt2t setobj
+/* to new object */
+#define setobj2n setobj
+/* to table */
+#define setobj2t setobj
+
+
+/*
+** Entries in the Lua stack
+*/
+typedef union StackValue {
+ TValue val;
+} StackValue;
+
+
+/* index to stack elements */
+typedef StackValue *StkId;
+
+/* convert a 'StackValue' to a 'TValue' */
+#define s2v(o) (&(o)->val)
+
+
+
+/*
+** {==================================================================
+** Nil
+** ===================================================================
+*/
+
+/* Standard nil */
+#define LUA_VNIL makevariant(LUA_TNIL, 0)
+
+/* Empty slot (which might be different from a slot containing nil) */
+#define LUA_VEMPTY makevariant(LUA_TNIL, 1)
+
+/* Value returned for a key not found in a table (absent key) */
+#define LUA_VABSTKEY makevariant(LUA_TNIL, 2)
+
+
+/* macro to test for (any kind of) nil */
+#define ttisnil(v) checktype((v), LUA_TNIL)
+
+
+/* macro to test for a standard nil */
+#define ttisstrictnil(o) checktag((o), LUA_VNIL)
+
+
+#define setnilvalue(obj) settt_(obj, LUA_VNIL)
+
+
+#define isabstkey(v) checktag((v), LUA_VABSTKEY)
+
+
+/*
+** macro to detect non-standard nils (used only in assertions)
+*/
+#define isnonstrictnil(v) (ttisnil(v) && !ttisstrictnil(v))
+
+
+/*
+** By default, entries with any kind of nil are considered empty.
+** (In any definition, values associated with absent keys must also
+** be accepted as empty.)
+*/
+#define isempty(v) ttisnil(v)
+
+
+/* macro defining a value corresponding to an absent key */
+#define ABSTKEYCONSTANT {NULL}, LUA_VABSTKEY
+
+
+/* mark an entry as empty */
+#define setempty(v) settt_(v, LUA_VEMPTY)
+
+
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Booleans
+** ===================================================================
+*/
+
+
+#define LUA_VFALSE makevariant(LUA_TBOOLEAN, 0)
+#define LUA_VTRUE makevariant(LUA_TBOOLEAN, 1)
+
+#define ttisboolean(o) checktype((o), LUA_TBOOLEAN)
+#define ttisfalse(o) checktag((o), LUA_VFALSE)
+#define ttistrue(o) checktag((o), LUA_VTRUE)
+
+
+#define l_isfalse(o) (ttisfalse(o) || ttisnil(o))
+
+
+#define setbfvalue(obj) settt_(obj, LUA_VFALSE)
+#define setbtvalue(obj) settt_(obj, LUA_VTRUE)
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Threads
+** ===================================================================
+*/
+
+#define LUA_VTHREAD makevariant(LUA_TTHREAD, 0)
+
+#define ttisthread(o) checktag((o), ctb(LUA_VTHREAD))
+
+#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))
+
+#define setthvalue(L,obj,x) \
+ { TValue *io = (obj); lua_State *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTHREAD)); \
+ checkliveness(L,io); }
+
+#define setthvalue2s(L,o,t) setthvalue(L,s2v(o),t)
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Collectable Objects
+** ===================================================================
+*/
+
+/*
+** Common Header for all collectable objects (in macro form, to be
+** included in other objects)
+*/
+#define CommonHeader struct GCObject *next; lu_byte tt; lu_byte marked
+
+
+/* Common type for all collectable objects */
+typedef struct GCObject {
+ CommonHeader;
+} GCObject;
+
+
+/* Bit mark for collectable types */
+#define BIT_ISCOLLECTABLE (1 << 6)
+
+#define iscollectable(o) (rawtt(o) & BIT_ISCOLLECTABLE)
+
+/* mark a tag as collectable */
+#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
+
+#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
+
+#define gcvalueraw(v) ((v).gc)
+
+#define setgcovalue(L,obj,x) \
+ { TValue *io = (obj); GCObject *i_g=(x); \
+ val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Numbers
+** ===================================================================
+*/
+
+/* Variant tags for numbers */
+#define LUA_VNUMINT makevariant(LUA_TNUMBER, 0) /* integer numbers */
+#define LUA_VNUMFLT makevariant(LUA_TNUMBER, 1) /* float numbers */
+
+#define ttisnumber(o) checktype((o), LUA_TNUMBER)
+#define ttisfloat(o) checktag((o), LUA_VNUMFLT)
+#define ttisinteger(o) checktag((o), LUA_VNUMINT)
+
+#define nvalue(o) check_exp(ttisnumber(o), \
+ (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))
+#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)
+#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)
+
+#define fltvalueraw(v) ((v).n)
+#define ivalueraw(v) ((v).i)
+
#define setfltvalue(obj,x) \
- { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_TNUMFLT); }
+ { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_VNUMFLT); }
#define chgfltvalue(obj,x) \
{ TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); }
#define setivalue(obj,x) \
- { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_TNUMINT); }
+ { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_VNUMINT); }
#define chgivalue(obj,x) \
{ TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); }
-#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); }
+/*
+** {==================================================================
+** Strings
+** ===================================================================
+*/
-#define setbvalue(obj,x) \
- { TValue *io=(obj); val_(io).b=(x); settt_(io, LUA_TBOOLEAN); }
+/* Variant tags for strings */
+#define LUA_VSHRSTR makevariant(LUA_TSTRING, 0) /* short strings */
+#define LUA_VLNGSTR makevariant(LUA_TSTRING, 1) /* long strings */
-#define setgcovalue(L,obj,x) \
- { TValue *io = (obj); GCObject *i_g=(x); \
- val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }
+#define ttisstring(o) checktype((o), LUA_TSTRING)
+#define ttisshrstring(o) checktag((o), ctb(LUA_VSHRSTR))
+#define ttislngstring(o) checktag((o), ctb(LUA_VLNGSTR))
+
+#define tsvalueraw(v) (gco2ts((v).gc))
+
+#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))
#define setsvalue(L,obj,x) \
{ TValue *io = (obj); TString *x_ = (x); \
val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \
checkliveness(L,io); }
-#define setuvalue(L,obj,x) \
- { TValue *io = (obj); Udata *x_ = (x); \
- val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TUSERDATA)); \
- checkliveness(L,io); }
+/* set a string to the stack */
+#define setsvalue2s(L,o,s) setsvalue(L,s2v(o),s)
-#define setthvalue(L,obj,x) \
- { TValue *io = (obj); lua_State *x_ = (x); \
- val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTHREAD)); \
- checkliveness(L,io); }
-
-#define setclLvalue(L,obj,x) \
- { TValue *io = (obj); LClosure *x_ = (x); \
- val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TLCL)); \
- checkliveness(L,io); }
-
-#define setclCvalue(L,obj,x) \
- { TValue *io = (obj); CClosure *x_ = (x); \
- val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TCCL)); \
- checkliveness(L,io); }
-
-#define sethvalue(L,obj,x) \
- { TValue *io = (obj); Table *x_ = (x); \
- val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTABLE)); \
- checkliveness(L,io); }
-
-#define setdeadvalue(obj) settt_(obj, LUA_TDEADKEY)
-
-
-
-#define setobj(L,obj1,obj2) \
- { TValue *io1=(obj1); *io1 = *(obj2); \
- (void)L; checkliveness(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 new object */
-#define setobj2n setobj
+/* set a string to a new object */
#define setsvalue2n setsvalue
-/* to table (define it as an expression to be used in macros) */
-#define setobj2t(L,o1,o2) ((void)L, *(o1)=*(o2), checkliveness(L,(o1)))
-
-
-
/*
-** {======================================================
-** types and prototypes
-** =======================================================
-*/
-
-
-typedef TValue *StkId; /* index to stack elements */
-
-
-
-
-/*
-** Header for string value; string bytes follow the end of this structure
-** (aligned according to 'UTString'; see next).
+** Header for a string value.
*/
typedef struct TString {
CommonHeader;
@@ -309,75 +367,121 @@
size_t lnglen; /* length for long strings */
struct TString *hnext; /* linked list for hash table */
} u;
+ char contents[1];
} TString;
-/*
-** Ensures that address after this type is always fully aligned.
-*/
-typedef union UTString {
- L_Umaxalign dummy; /* ensures maximum alignment for strings */
- TString tsv;
-} UTString;
-
/*
** Get the actual string (array of bytes) from a 'TString'.
-** (Access to 'extra' ensures that value is really a 'TString'.)
*/
-#define getstr(ts) \
- check_exp(sizeof((ts)->extra), cast(char *, (ts)) + sizeof(UTString))
+#define getstr(ts) ((ts)->contents)
/* get the actual string (array of bytes) from a Lua value */
#define svalue(o) getstr(tsvalue(o))
/* get string length from 'TString *s' */
-#define tsslen(s) ((s)->tt == LUA_TSHRSTR ? (s)->shrlen : (s)->u.lnglen)
+#define tsslen(s) ((s)->tt == LUA_VSHRSTR ? (s)->shrlen : (s)->u.lnglen)
/* get string length from 'TValue *o' */
#define vslen(o) tsslen(tsvalue(o))
+/* }================================================================== */
+
/*
-** Header for userdata; memory area follows the end of this structure
-** (aligned according to 'UUdata'; see next).
+** {==================================================================
+** Userdata
+** ===================================================================
+*/
+
+
+/*
+** Light userdata should be a variant of userdata, but for compatibility
+** reasons they are also different types.
+*/
+#define LUA_VLIGHTUSERDATA makevariant(LUA_TLIGHTUSERDATA, 0)
+
+#define LUA_VUSERDATA makevariant(LUA_TUSERDATA, 0)
+
+#define ttislightuserdata(o) checktag((o), LUA_VLIGHTUSERDATA)
+#define ttisfulluserdata(o) checktag((o), ctb(LUA_VUSERDATA))
+
+#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
+#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))
+
+#define pvalueraw(v) ((v).p)
+
+#define setpvalue(obj,x) \
+ { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_VLIGHTUSERDATA); }
+
+#define setuvalue(L,obj,x) \
+ { TValue *io = (obj); Udata *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VUSERDATA)); \
+ checkliveness(L,io); }
+
+
+/* Ensures that addresses after this type are always fully aligned. */
+typedef union UValue {
+ TValue uv;
+ LUAI_MAXALIGN; /* ensures maximum alignment for udata bytes */
+} UValue;
+
+
+/*
+** Header for userdata with user values;
+** memory area follows the end of this structure.
*/
typedef struct Udata {
CommonHeader;
- lu_byte ttuv_; /* user value's tag */
- struct Table *metatable;
+ unsigned short nuvalue; /* number of user values */
size_t len; /* number of bytes */
- union Value user_; /* user value */
+ struct Table *metatable;
+ GCObject *gclist;
+ UValue uv[1]; /* user values */
} Udata;
/*
-** Ensures that address after this type is always fully aligned.
+** Header for userdata with no user values. These userdata do not need
+** to be gray during GC, and therefore do not need a 'gclist' field.
+** To simplify, the code always use 'Udata' for both kinds of userdata,
+** making sure it never accesses 'gclist' on userdata with no user values.
+** This structure here is used only to compute the correct size for
+** this representation. (The 'bindata' field in its end ensures correct
+** alignment for binary data following this header.)
*/
-typedef union UUdata {
- L_Umaxalign dummy; /* ensures maximum alignment for 'local' udata */
- Udata uv;
-} UUdata;
+typedef struct Udata0 {
+ CommonHeader;
+ unsigned short nuvalue; /* number of user values */
+ size_t len; /* number of bytes */
+ struct Table *metatable;
+ union {LUAI_MAXALIGN;} bindata;
+} Udata0;
+
+
+/* compute the offset of the memory area of a userdata */
+#define udatamemoffset(nuv) \
+ ((nuv) == 0 ? offsetof(Udata0, bindata) \
+ : offsetof(Udata, uv) + (sizeof(UValue) * (nuv)))
+
+/* get the address of the memory block inside 'Udata' */
+#define getudatamem(u) (cast_charp(u) + udatamemoffset((u)->nuvalue))
+
+/* compute the size of a userdata */
+#define sizeudata(nuv,nb) (udatamemoffset(nuv) + (nb))
+
+/* }================================================================== */
/*
-** Get the address of memory block inside 'Udata'.
-** (Access to 'ttuv_' ensures that value is really a 'Udata'.)
+** {==================================================================
+** Prototypes
+** ===================================================================
*/
-#define getudatamem(u) \
- check_exp(sizeof((u)->ttuv_), (cast(char*, (u)) + sizeof(UUdata)))
-#define setuservalue(L,u,o) \
- { const TValue *io=(o); Udata *iu = (u); \
- iu->user_ = io->value_; iu->ttuv_ = rttype(io); \
- checkliveness(L,io); }
-
-
-#define getuservalue(L,u,o) \
- { TValue *io=(o); const Udata *iu = (u); \
- io->value_ = iu->user_; settt_(io, iu->ttuv_); \
- checkliveness(L,io); }
+#define LUA_VPROTO makevariant(LUA_TPROTO, 0)
/*
@@ -387,6 +491,7 @@
TString *name; /* upvalue name (for debug information) */
lu_byte instack; /* whether it is in stack (register) */
lu_byte idx; /* index of upvalue (in stack or in outer function's list) */
+ lu_byte kind; /* kind of corresponding variable */
} Upvaldesc;
@@ -402,11 +507,26 @@
/*
+** Associates the absolute line source for a given instruction ('pc').
+** The array 'lineinfo' gives, for each instruction, the difference in
+** lines from the previous instruction. When that difference does not
+** fit into a byte, Lua saves the absolute line for that instruction.
+** (Lua also saves the absolute line periodically, to speed up the
+** computation of a line number: we can use binary search in the
+** absolute-line array, but we must traverse the 'lineinfo' array
+** linearly to compute a line.)
+*/
+typedef struct AbsLineInfo {
+ int pc;
+ int line;
+} AbsLineInfo;
+
+/*
** Function Prototypes
*/
typedef struct Proto {
CommonHeader;
- lu_byte numparams; /* number of fixed parameters */
+ lu_byte numparams; /* number of fixed (named) parameters */
lu_byte is_vararg;
lu_byte maxstacksize; /* number of registers needed by this function */
int sizeupvalues; /* size of 'upvalues' */
@@ -415,31 +535,86 @@
int sizelineinfo;
int sizep; /* size of 'p' */
int sizelocvars;
+ int sizeabslineinfo; /* size of 'abslineinfo' */
int linedefined; /* debug information */
int lastlinedefined; /* debug information */
TValue *k; /* constants used by the function */
Instruction *code; /* opcodes */
struct Proto **p; /* functions defined inside the function */
- int *lineinfo; /* map from opcodes to source lines (debug information) */
- LocVar *locvars; /* information about local variables (debug information) */
Upvaldesc *upvalues; /* upvalue information */
- struct LClosure *cache; /* last-created closure with this prototype */
+ ls_byte *lineinfo; /* information about source lines (debug information) */
+ AbsLineInfo *abslineinfo; /* idem */
+ LocVar *locvars; /* information about local variables (debug information) */
TString *source; /* used for debug information */
GCObject *gclist;
} Proto;
+/* }================================================================== */
/*
-** Lua Upvalues
-*/
-typedef struct UpVal UpVal;
-
-
-/*
+** {==================================================================
** Closures
+** ===================================================================
*/
+#define LUA_VUPVAL makevariant(LUA_TUPVAL, 0)
+
+
+/* Variant tags for functions */
+#define LUA_VLCL makevariant(LUA_TFUNCTION, 0) /* Lua closure */
+#define LUA_VLCF makevariant(LUA_TFUNCTION, 1) /* light C function */
+#define LUA_VCCL makevariant(LUA_TFUNCTION, 2) /* C closure */
+
+#define ttisfunction(o) checktype(o, LUA_TFUNCTION)
+#define ttisclosure(o) ((rawtt(o) & 0x1F) == LUA_VLCL)
+#define ttisLclosure(o) checktag((o), ctb(LUA_VLCL))
+#define ttislcf(o) checktag((o), LUA_VLCF)
+#define ttisCclosure(o) checktag((o), ctb(LUA_VCCL))
+
+#define isLfunction(o) ttisLclosure(o)
+
+#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))
+#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))
+#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
+#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))
+
+#define fvalueraw(v) ((v).f)
+
+#define setclLvalue(L,obj,x) \
+ { TValue *io = (obj); LClosure *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VLCL)); \
+ checkliveness(L,io); }
+
+#define setclLvalue2s(L,o,cl) setclLvalue(L,s2v(o),cl)
+
+#define setfvalue(obj,x) \
+ { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_VLCF); }
+
+#define setclCvalue(L,obj,x) \
+ { TValue *io = (obj); CClosure *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VCCL)); \
+ checkliveness(L,io); }
+
+
+/*
+** Upvalues for Lua closures
+*/
+typedef struct UpVal {
+ CommonHeader;
+ lu_byte tbc; /* true if it represents a to-be-closed variable */
+ TValue *v; /* points to stack or to its own value */
+ union {
+ struct { /* (when open) */
+ struct UpVal *next; /* linked list */
+ struct UpVal **previous;
+ } open;
+ TValue value; /* the value (when closed) */
+ } u;
+} UpVal;
+
+
+
#define ClosureHeader \
CommonHeader; lu_byte nupvalues; GCObject *gclist
@@ -463,42 +638,81 @@
} Closure;
-#define isLfunction(o) ttisLclosure(o)
-
#define getproto(o) (clLvalue(o)->p)
+/* }================================================================== */
+
/*
+** {==================================================================
** Tables
+** ===================================================================
*/
-typedef union TKey {
- struct {
- TValuefields;
- int next; /* for chaining (offset for next node) */
- } nk;
- TValue tvk;
-} TKey;
+#define LUA_VTABLE makevariant(LUA_TTABLE, 0)
+
+#define ttistable(o) checktag((o), ctb(LUA_VTABLE))
+
+#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))
+
+#define sethvalue(L,obj,x) \
+ { TValue *io = (obj); Table *x_ = (x); \
+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTABLE)); \
+ checkliveness(L,io); }
+
+#define sethvalue2s(L,o,h) sethvalue(L,s2v(o),h)
-/* copy a value into a key without messing up field 'next' */
-#define setnodekey(L,key,obj) \
- { TKey *k_=(key); const TValue *io_=(obj); \
- k_->nk.value_ = io_->value_; k_->nk.tt_ = io_->tt_; \
- (void)L; checkliveness(L,io_); }
-
-
-typedef struct Node {
- TValue i_val;
- TKey i_key;
+/*
+** Nodes for Hash tables: A pack of two TValue's (key-value pairs)
+** plus a 'next' field to link colliding entries. The distribution
+** of the key's fields ('key_tt' and 'key_val') not forming a proper
+** 'TValue' allows for a smaller size for 'Node' both in 4-byte
+** and 8-byte alignments.
+*/
+typedef union Node {
+ struct NodeKey {
+ TValuefields; /* fields for value */
+ lu_byte key_tt; /* key type */
+ int next; /* for chaining */
+ Value key_val; /* key value */
+ } u;
+ TValue i_val; /* direct access to node's value as a proper 'TValue' */
} Node;
+/* copy a value into a key */
+#define setnodekey(L,node,obj) \
+ { Node *n_=(node); const TValue *io_=(obj); \
+ n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; \
+ checkliveness(L,io_); }
+
+
+/* copy a value from a key */
+#define getnodekey(L,obj,node) \
+ { TValue *io_=(obj); const Node *n_=(node); \
+ io_->value_ = n_->u.key_val; io_->tt_ = n_->u.key_tt; \
+ checkliveness(L,io_); }
+
+
+/*
+** About 'alimit': if 'isrealasize(t)' is true, then 'alimit' is the
+** real size of 'array'. Otherwise, the real size of 'array' is the
+** smallest power of two not smaller than 'alimit' (or zero iff 'alimit'
+** is zero); 'alimit' is then used as a hint for #t.
+*/
+
+#define BITRAS (1 << 7)
+#define isrealasize(t) (!((t)->marked & BITRAS))
+#define setrealasize(t) ((t)->marked &= cast_byte(~BITRAS))
+#define setnorealasize(t) ((t)->marked |= BITRAS)
+
+
typedef struct Table {
CommonHeader;
lu_byte flags; /* 1<<p means tagmethod(p) is not present */
lu_byte lsizenode; /* log2 of size of 'node' array */
- unsigned int sizearray; /* size of 'array' array */
+ unsigned int alimit; /* "limit" of 'array' array */
TValue *array; /* array part */
Node *node;
Node *lastfree; /* any free position is before this position */
@@ -507,42 +721,66 @@
} Table;
+/*
+** Macros to manipulate keys inserted in nodes
+*/
+#define keytt(node) ((node)->u.key_tt)
+#define keyval(node) ((node)->u.key_val)
+
+#define keyisnil(node) (keytt(node) == LUA_TNIL)
+#define keyisinteger(node) (keytt(node) == LUA_VNUMINT)
+#define keyival(node) (keyval(node).i)
+#define keyisshrstr(node) (keytt(node) == ctb(LUA_VSHRSTR))
+#define keystrval(node) (gco2ts(keyval(node).gc))
+
+#define setnilkey(node) (keytt(node) = LUA_TNIL)
+
+#define keyiscollectable(n) (keytt(n) & BIT_ISCOLLECTABLE)
+
+#define gckey(n) (keyval(n).gc)
+#define gckeyN(n) (keyiscollectable(n) ? gckey(n) : NULL)
+
+
+/*
+** Use a "nil table" to mark dead keys in a table. Those keys serve
+** to keep space for removed entries, which may still be part of
+** chains. Note that the 'keytt' does not have the BIT_ISCOLLECTABLE
+** set, so these values are considered not collectable and are different
+** from any valid value.
+*/
+#define setdeadkey(n) (keytt(n) = LUA_TTABLE, gckey(n) = NULL)
+
+/* }================================================================== */
+
+
/*
** 'module' operation for hashing (size is always a power of 2)
*/
#define lmod(s,size) \
- (check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1)))))
+ (check_exp((size&(size-1))==0, (cast_int((s) & ((size)-1)))))
#define twoto(x) (1<<(x))
#define sizenode(t) (twoto((t)->lsizenode))
-/*
-** (address of) a fixed nil value
-*/
-#define luaO_nilobject (&luaO_nilobject_)
-
-
-LUAI_DDEC const TValue luaO_nilobject_;
-
/* size of buffer for 'luaO_utf8esc' function */
#define UTF8BUFFSZ 8
-LUAI_FUNC int luaO_int2fb (unsigned int x);
-LUAI_FUNC int luaO_fb2int (int x);
LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);
LUAI_FUNC int luaO_ceillog2 (unsigned int x);
+LUAI_FUNC int luaO_rawarith (lua_State *L, int op, const TValue *p1,
+ const TValue *p2, TValue *res);
LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,
- const TValue *p2, TValue *res);
+ const TValue *p2, StkId res);
LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o);
LUAI_FUNC int luaO_hexavalue (int c);
-LUAI_FUNC void luaO_tostring (lua_State *L, StkId obj);
+LUAI_FUNC void luaO_tostring (lua_State *L, TValue *obj);
LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,
va_list argp);
LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);
-LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len);
+LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t srclen);
#endif
diff --git a/src/lopcodes.c b/src/lopcodes.c
index 5ca3eb2..c67aa22 100644
--- a/src/lopcodes.c
+++ b/src/lopcodes.c
@@ -1,5 +1,5 @@
/*
-** $Id: lopcodes.c,v 1.55.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lopcodes.c $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
@@ -10,115 +10,95 @@
#include "lprefix.h"
-#include <stddef.h>
-
#include "lopcodes.h"
/* ORDER OP */
-LUAI_DDEF const char *const luaP_opnames[NUM_OPCODES+1] = {
- "MOVE",
- "LOADK",
- "LOADKX",
- "LOADBOOL",
- "LOADNIL",
- "GETUPVAL",
- "GETTABUP",
- "GETTABLE",
- "SETTABUP",
- "SETUPVAL",
- "SETTABLE",
- "NEWTABLE",
- "SELF",
- "ADD",
- "SUB",
- "MUL",
- "MOD",
- "POW",
- "DIV",
- "IDIV",
- "BAND",
- "BOR",
- "BXOR",
- "SHL",
- "SHR",
- "UNM",
- "BNOT",
- "NOT",
- "LEN",
- "CONCAT",
- "JMP",
- "EQ",
- "LT",
- "LE",
- "TEST",
- "TESTSET",
- "CALL",
- "TAILCALL",
- "RETURN",
- "FORLOOP",
- "FORPREP",
- "TFORCALL",
- "TFORLOOP",
- "SETLIST",
- "CLOSURE",
- "VARARG",
- "EXTRAARG",
- NULL
-};
-
-
-#define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m))
-
LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
-/* T A B C mode opcode */
- opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */
- ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */
- ,opmode(0, 1, OpArgN, OpArgN, iABx) /* OP_LOADKX */
- ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */
- ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_LOADNIL */
- ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */
- ,opmode(0, 1, OpArgU, OpArgK, iABC) /* OP_GETTABUP */
- ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */
- ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABUP */
- ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */
- ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */
- ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */
- ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_IDIV */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BAND */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BOR */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BXOR */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHL */
- ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHR */
- ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */
- ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_BNOT */
- ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */
- ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */
- ,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */
- ,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */
- ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */
- ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */
- ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */
- ,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TEST */
- ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */
- ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */
- ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */
- ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */
- ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */
- ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */
- ,opmode(0, 0, OpArgN, OpArgU, iABC) /* OP_TFORCALL */
- ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_TFORLOOP */
- ,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */
- ,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */
- ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */
- ,opmode(0, 0, OpArgU, OpArgU, iAx) /* OP_EXTRAARG */
+/* MM OT IT T A mode opcode */
+ opmode(0, 0, 0, 0, 1, iABC) /* OP_MOVE */
+ ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADI */
+ ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADF */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADK */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADKX */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADFALSE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LFALSESKIP */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADTRUE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADNIL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETUPVAL */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABUP */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABLE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETFIELD */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABUP */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABLE */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETI */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETFIELD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NEWTABLE */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SELF */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUBK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MULK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MODK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POWK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIVK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIVK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BANDK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BORK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXORK */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHRI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHLI */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUB */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MUL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MOD */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POW */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIV */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIV */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BAND */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BOR */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXOR */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHL */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHR */
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBIN */
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINI*/
+ ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINK*/
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_UNM */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BNOT */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NOT */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LEN */
+ ,opmode(0, 0, 0, 0, 1, iABC) /* OP_CONCAT */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TBC */
+ ,opmode(0, 0, 0, 0, 0, isJ) /* OP_JMP */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQ */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LT */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LE */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQK */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LTI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LEI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GTI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GEI */
+ ,opmode(0, 0, 0, 1, 0, iABC) /* OP_TEST */
+ ,opmode(0, 0, 0, 1, 1, iABC) /* OP_TESTSET */
+ ,opmode(0, 1, 1, 0, 1, iABC) /* OP_CALL */
+ ,opmode(0, 1, 1, 0, 1, iABC) /* OP_TAILCALL */
+ ,opmode(0, 0, 1, 0, 0, iABC) /* OP_RETURN */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN0 */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN1 */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORLOOP */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORPREP */
+ ,opmode(0, 0, 0, 0, 0, iABx) /* OP_TFORPREP */
+ ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TFORCALL */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_TFORLOOP */
+ ,opmode(0, 0, 1, 0, 0, iABC) /* OP_SETLIST */
+ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_CLOSURE */
+ ,opmode(0, 1, 0, 0, 1, iABC) /* OP_VARARG */
+ ,opmode(0, 0, 1, 0, 1, iABC) /* OP_VARARGPREP */
+ ,opmode(0, 0, 0, 0, 0, iAx) /* OP_EXTRAARG */
};
diff --git a/src/lopcodes.h b/src/lopcodes.h
index 6feaa1c..122e5d2 100644
--- a/src/lopcodes.h
+++ b/src/lopcodes.h
@@ -1,5 +1,5 @@
/*
-** $Id: lopcodes.h,v 1.149.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lopcodes.h $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
@@ -11,69 +11,94 @@
/*===========================================================================
- We assume that instructions are unsigned numbers.
- All instructions have an opcode in the first 6 bits.
- Instructions can have the following fields:
- 'A' : 8 bits
- 'B' : 9 bits
- 'C' : 9 bits
- 'Ax' : 26 bits ('A', 'B', and 'C' together)
- 'Bx' : 18 bits ('B' and 'C' together)
- 'sBx' : signed Bx
+ We assume that instructions are unsigned 32-bit integers.
+ All instructions have an opcode in the first 7 bits.
+ Instructions can have the following formats:
- A signed argument is represented in excess K; that is, the number
- value is the unsigned value minus K. K is exactly the maximum value
- for that argument (so that -max is represented by 0, and +max is
- represented by 2*max), which is half the maximum for the corresponding
- unsigned argument.
+ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
+ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+iABC C(8) | B(8) |k| A(8) | Op(7) |
+iABx Bx(17) | A(8) | Op(7) |
+iAsBx sBx (signed)(17) | A(8) | Op(7) |
+iAx Ax(25) | Op(7) |
+isJ sJ(25) | Op(7) |
+
+ A signed argument is represented in excess K: the represented value is
+ the written unsigned value minus K, where K is half the maximum for the
+ corresponding unsigned argument.
===========================================================================*/
-enum OpMode {iABC, iABx, iAsBx, iAx}; /* basic instruction format */
+enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */
/*
** size and position of opcode arguments.
*/
-#define SIZE_C 9
-#define SIZE_B 9
-#define SIZE_Bx (SIZE_C + SIZE_B)
+#define SIZE_C 8
+#define SIZE_B 8
+#define SIZE_Bx (SIZE_C + SIZE_B + 1)
#define SIZE_A 8
-#define SIZE_Ax (SIZE_C + SIZE_B + SIZE_A)
+#define SIZE_Ax (SIZE_Bx + SIZE_A)
+#define SIZE_sJ (SIZE_Bx + SIZE_A)
-#define SIZE_OP 6
+#define SIZE_OP 7
#define POS_OP 0
+
#define POS_A (POS_OP + SIZE_OP)
-#define POS_C (POS_A + SIZE_A)
-#define POS_B (POS_C + SIZE_C)
-#define POS_Bx POS_C
+#define POS_k (POS_A + SIZE_A)
+#define POS_B (POS_k + 1)
+#define POS_C (POS_B + SIZE_B)
+
+#define POS_Bx POS_k
+
#define POS_Ax POS_A
+#define POS_sJ POS_A
+
/*
** limits for opcode arguments.
-** we use (signed) int to manipulate most arguments,
-** so they must fit in LUAI_BITSINT-1 bits (-1 for sign)
+** we use (signed) 'int' to manipulate most arguments,
+** so they must fit in ints.
*/
-#if SIZE_Bx < LUAI_BITSINT-1
-#define MAXARG_Bx ((1<<SIZE_Bx)-1)
-#define MAXARG_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */
+
+/* Check whether type 'int' has at least 'b' bits ('b' < 32) */
+#define L_INTHASBITS(b) ((UINT_MAX >> ((b) - 1)) >= 1)
+
+
+#if L_INTHASBITS(SIZE_Bx)
+#define MAXARG_Bx ((1<<SIZE_Bx)-1)
#else
-#define MAXARG_Bx MAX_INT
-#define MAXARG_sBx MAX_INT
+#define MAXARG_Bx MAX_INT
#endif
-#if SIZE_Ax < LUAI_BITSINT-1
+#define OFFSET_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */
+
+
+#if L_INTHASBITS(SIZE_Ax)
#define MAXARG_Ax ((1<<SIZE_Ax)-1)
#else
#define MAXARG_Ax MAX_INT
#endif
+#if L_INTHASBITS(SIZE_sJ)
+#define MAXARG_sJ ((1 << SIZE_sJ) - 1)
+#else
+#define MAXARG_sJ MAX_INT
+#endif
-#define MAXARG_A ((1<<SIZE_A)-1)
-#define MAXARG_B ((1<<SIZE_B)-1)
-#define MAXARG_C ((1<<SIZE_C)-1)
+#define OFFSET_sJ (MAXARG_sJ >> 1)
+
+
+#define MAXARG_A ((1<<SIZE_A)-1)
+#define MAXARG_B ((1<<SIZE_B)-1)
+#define MAXARG_C ((1<<SIZE_C)-1)
+#define OFFSET_sC (MAXARG_C >> 1)
+
+#define int2sC(i) ((i) + OFFSET_sC)
+#define sC2int(i) ((i) - OFFSET_sC)
/* creates a mask with 'n' 1 bits at position 'p' */
@@ -90,33 +115,49 @@
#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \
((cast(Instruction, o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))
-#define getarg(i,pos,size) (cast(int, ((i)>>pos) & MASK1(size,0)))
+#define checkopm(i,m) (getOpMode(GET_OPCODE(i)) == m)
+
+
+#define getarg(i,pos,size) (cast_int(((i)>>(pos)) & MASK1(size,0)))
#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \
((cast(Instruction, v)<<pos)&MASK1(size,pos))))
#define GETARG_A(i) getarg(i, POS_A, SIZE_A)
#define SETARG_A(i,v) setarg(i, v, POS_A, SIZE_A)
-#define GETARG_B(i) getarg(i, POS_B, SIZE_B)
+#define GETARG_B(i) check_exp(checkopm(i, iABC), getarg(i, POS_B, SIZE_B))
+#define GETARG_sB(i) sC2int(GETARG_B(i))
#define SETARG_B(i,v) setarg(i, v, POS_B, SIZE_B)
-#define GETARG_C(i) getarg(i, POS_C, SIZE_C)
+#define GETARG_C(i) check_exp(checkopm(i, iABC), getarg(i, POS_C, SIZE_C))
+#define GETARG_sC(i) sC2int(GETARG_C(i))
#define SETARG_C(i,v) setarg(i, v, POS_C, SIZE_C)
-#define GETARG_Bx(i) getarg(i, POS_Bx, SIZE_Bx)
+#define TESTARG_k(i) check_exp(checkopm(i, iABC), (cast_int(((i) & (1u << POS_k)))))
+#define GETARG_k(i) check_exp(checkopm(i, iABC), getarg(i, POS_k, 1))
+#define SETARG_k(i,v) setarg(i, v, POS_k, 1)
+
+#define GETARG_Bx(i) check_exp(checkopm(i, iABx), getarg(i, POS_Bx, SIZE_Bx))
#define SETARG_Bx(i,v) setarg(i, v, POS_Bx, SIZE_Bx)
-#define GETARG_Ax(i) getarg(i, POS_Ax, SIZE_Ax)
+#define GETARG_Ax(i) check_exp(checkopm(i, iAx), getarg(i, POS_Ax, SIZE_Ax))
#define SETARG_Ax(i,v) setarg(i, v, POS_Ax, SIZE_Ax)
-#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx)
-#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx))
+#define GETARG_sBx(i) \
+ check_exp(checkopm(i, iAsBx), getarg(i, POS_Bx, SIZE_Bx) - OFFSET_sBx)
+#define SETARG_sBx(i,b) SETARG_Bx((i),cast_uint((b)+OFFSET_sBx))
+
+#define GETARG_sJ(i) \
+ check_exp(checkopm(i, isJ), getarg(i, POS_sJ, SIZE_sJ) - OFFSET_sJ)
+#define SETARG_sJ(i,j) \
+ setarg(i, cast_uint((j)+OFFSET_sJ), POS_sJ, SIZE_sJ)
-#define CREATE_ABC(o,a,b,c) ((cast(Instruction, o)<<POS_OP) \
+#define CREATE_ABCk(o,a,b,c,k) ((cast(Instruction, o)<<POS_OP) \
| (cast(Instruction, a)<<POS_A) \
| (cast(Instruction, b)<<POS_B) \
- | (cast(Instruction, c)<<POS_C))
+ | (cast(Instruction, c)<<POS_C) \
+ | (cast(Instruction, k)<<POS_k))
#define CREATE_ABx(o,a,bc) ((cast(Instruction, o)<<POS_OP) \
| (cast(Instruction, a)<<POS_A) \
@@ -125,27 +166,15 @@
#define CREATE_Ax(o,a) ((cast(Instruction, o)<<POS_OP) \
| (cast(Instruction, a)<<POS_Ax))
+#define CREATE_sJ(o,j,k) ((cast(Instruction, o) << POS_OP) \
+ | (cast(Instruction, j) << POS_sJ) \
+ | (cast(Instruction, k) << POS_k))
-/*
-** Macros to operate RK indices
-*/
-
-/* this bit 1 means constant (0 means register) */
-#define BITRK (1 << (SIZE_B - 1))
-
-/* test whether value is a constant */
-#define ISK(x) ((x) & BITRK)
-
-/* gets the index of the constant */
-#define INDEXK(r) ((int)(r) & ~BITRK)
#if !defined(MAXINDEXRK) /* (for debugging only) */
-#define MAXINDEXRK (BITRK - 1)
+#define MAXINDEXRK MAXARG_B
#endif
-/* code a constant index as a RK value */
-#define RKASK(x) ((x) | BITRK)
-
/*
** invalid register that fits in 8 bits
@@ -154,9 +183,9 @@
/*
-** R(x) - register
-** Kst(x) - constant (in constant table)
-** RK(x) == if ISK(x) then Kst(INDEXK(x)) else R(x)
+** R[x] - register
+** K[x] - constant (in constant table)
+** RK(x) == if k(i) then K[x] else R[x]
*/
@@ -166,132 +195,198 @@
typedef enum {
/*----------------------------------------------------------------------
-name args description
+ name args description
------------------------------------------------------------------------*/
-OP_MOVE,/* A B R(A) := R(B) */
-OP_LOADK,/* A Bx R(A) := Kst(Bx) */
-OP_LOADKX,/* A R(A) := Kst(extra arg) */
-OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) pc++ */
-OP_LOADNIL,/* A B R(A), R(A+1), ..., R(A+B) := nil */
-OP_GETUPVAL,/* A B R(A) := UpValue[B] */
+OP_MOVE,/* A B R[A] := R[B] */
+OP_LOADI,/* A sBx R[A] := sBx */
+OP_LOADF,/* A sBx R[A] := (lua_Number)sBx */
+OP_LOADK,/* A Bx R[A] := K[Bx] */
+OP_LOADKX,/* A R[A] := K[extra arg] */
+OP_LOADFALSE,/* A R[A] := false */
+OP_LFALSESKIP,/*A R[A] := false; pc++ */
+OP_LOADTRUE,/* A R[A] := true */
+OP_LOADNIL,/* A B R[A], R[A+1], ..., R[A+B] := nil */
+OP_GETUPVAL,/* A B R[A] := UpValue[B] */
+OP_SETUPVAL,/* A B UpValue[B] := R[A] */
-OP_GETTABUP,/* A B C R(A) := UpValue[B][RK(C)] */
-OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */
+OP_GETTABUP,/* A B C R[A] := UpValue[B][K[C]:string] */
+OP_GETTABLE,/* A B C R[A] := R[B][R[C]] */
+OP_GETI,/* A B C R[A] := R[B][C] */
+OP_GETFIELD,/* A B C R[A] := R[B][K[C]:string] */
-OP_SETTABUP,/* A B C UpValue[A][RK(B)] := RK(C) */
-OP_SETUPVAL,/* A B UpValue[B] := R(A) */
-OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */
+OP_SETTABUP,/* A B C UpValue[A][K[B]:string] := RK(C) */
+OP_SETTABLE,/* A B C R[A][R[B]] := RK(C) */
+OP_SETI,/* A B C R[A][B] := RK(C) */
+OP_SETFIELD,/* A B C R[A][K[B]:string] := RK(C) */
-OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */
+OP_NEWTABLE,/* A B C k R[A] := {} */
-OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */
+OP_SELF,/* A B C R[A+1] := R[B]; R[A] := R[B][RK(C):string] */
-OP_ADD,/* A B C R(A) := RK(B) + RK(C) */
-OP_SUB,/* A B C R(A) := RK(B) - RK(C) */
-OP_MUL,/* A B C R(A) := RK(B) * RK(C) */
-OP_MOD,/* A B C R(A) := RK(B) % RK(C) */
-OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */
-OP_DIV,/* A B C R(A) := RK(B) / RK(C) */
-OP_IDIV,/* A B C R(A) := RK(B) // RK(C) */
-OP_BAND,/* A B C R(A) := RK(B) & RK(C) */
-OP_BOR,/* A B C R(A) := RK(B) | RK(C) */
-OP_BXOR,/* A B C R(A) := RK(B) ~ RK(C) */
-OP_SHL,/* A B C R(A) := RK(B) << RK(C) */
-OP_SHR,/* A B C R(A) := RK(B) >> RK(C) */
-OP_UNM,/* A B R(A) := -R(B) */
-OP_BNOT,/* A B R(A) := ~R(B) */
-OP_NOT,/* A B R(A) := not R(B) */
-OP_LEN,/* A B R(A) := length of R(B) */
+OP_ADDI,/* A B sC R[A] := R[B] + sC */
-OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
+OP_ADDK,/* A B C R[A] := R[B] + K[C] */
+OP_SUBK,/* A B C R[A] := R[B] - K[C] */
+OP_MULK,/* A B C R[A] := R[B] * K[C] */
+OP_MODK,/* A B C R[A] := R[B] % K[C] */
+OP_POWK,/* A B C R[A] := R[B] ^ K[C] */
+OP_DIVK,/* A B C R[A] := R[B] / K[C] */
+OP_IDIVK,/* A B C R[A] := R[B] // K[C] */
-OP_JMP,/* A sBx pc+=sBx; if (A) close all upvalues >= R(A - 1) */
-OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */
-OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */
-OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */
+OP_BANDK,/* A B C R[A] := R[B] & K[C]:integer */
+OP_BORK,/* A B C R[A] := R[B] | K[C]:integer */
+OP_BXORK,/* A B C R[A] := R[B] ~ K[C]:integer */
-OP_TEST,/* A C if not (R(A) <=> C) then pc++ */
-OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */
+OP_SHRI,/* A B sC R[A] := R[B] >> sC */
+OP_SHLI,/* A B sC R[A] := sC << R[B] */
-OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */
-OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */
-OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */
+OP_ADD,/* A B C R[A] := R[B] + R[C] */
+OP_SUB,/* A B C R[A] := R[B] - R[C] */
+OP_MUL,/* A B C R[A] := R[B] * R[C] */
+OP_MOD,/* A B C R[A] := R[B] % R[C] */
+OP_POW,/* A B C R[A] := R[B] ^ R[C] */
+OP_DIV,/* A B C R[A] := R[B] / R[C] */
+OP_IDIV,/* A B C R[A] := R[B] // R[C] */
-OP_FORLOOP,/* A sBx R(A)+=R(A+2);
- if R(A) <?= R(A+1) then { pc+=sBx; R(A+3)=R(A) }*/
-OP_FORPREP,/* A sBx R(A)-=R(A+2); pc+=sBx */
+OP_BAND,/* A B C R[A] := R[B] & R[C] */
+OP_BOR,/* A B C R[A] := R[B] | R[C] */
+OP_BXOR,/* A B C R[A] := R[B] ~ R[C] */
+OP_SHL,/* A B C R[A] := R[B] << R[C] */
+OP_SHR,/* A B C R[A] := R[B] >> R[C] */
-OP_TFORCALL,/* A C R(A+3), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2)); */
-OP_TFORLOOP,/* A sBx if R(A+1) ~= nil then { R(A)=R(A+1); pc += sBx }*/
+OP_MMBIN,/* A B C call C metamethod over R[A] and R[B] */
+OP_MMBINI,/* A sB C k call C metamethod over R[A] and sB */
+OP_MMBINK,/* A B C k call C metamethod over R[A] and K[B] */
-OP_SETLIST,/* A B C R(A)[(C-1)*FPF+i] := R(A+i), 1 <= i <= B */
+OP_UNM,/* A B R[A] := -R[B] */
+OP_BNOT,/* A B R[A] := ~R[B] */
+OP_NOT,/* A B R[A] := not R[B] */
+OP_LEN,/* A B R[A] := length of R[B] */
-OP_CLOSURE,/* A Bx R(A) := closure(KPROTO[Bx]) */
+OP_CONCAT,/* A B R[A] := R[A].. ... ..R[A + B - 1] */
-OP_VARARG,/* A B R(A), R(A+1), ..., R(A+B-2) = vararg */
+OP_CLOSE,/* A close all upvalues >= R[A] */
+OP_TBC,/* A mark variable A "to be closed" */
+OP_JMP,/* sJ pc += sJ */
+OP_EQ,/* A B k if ((R[A] == R[B]) ~= k) then pc++ */
+OP_LT,/* A B k if ((R[A] < R[B]) ~= k) then pc++ */
+OP_LE,/* A B k if ((R[A] <= R[B]) ~= k) then pc++ */
+
+OP_EQK,/* A B k if ((R[A] == K[B]) ~= k) then pc++ */
+OP_EQI,/* A sB k if ((R[A] == sB) ~= k) then pc++ */
+OP_LTI,/* A sB k if ((R[A] < sB) ~= k) then pc++ */
+OP_LEI,/* A sB k if ((R[A] <= sB) ~= k) then pc++ */
+OP_GTI,/* A sB k if ((R[A] > sB) ~= k) then pc++ */
+OP_GEI,/* A sB k if ((R[A] >= sB) ~= k) then pc++ */
+
+OP_TEST,/* A k if (not R[A] == k) then pc++ */
+OP_TESTSET,/* A B k if (not R[B] == k) then pc++ else R[A] := R[B] */
+
+OP_CALL,/* A B C R[A], ... ,R[A+C-2] := R[A](R[A+1], ... ,R[A+B-1]) */
+OP_TAILCALL,/* A B C k return R[A](R[A+1], ... ,R[A+B-1]) */
+
+OP_RETURN,/* A B C k return R[A], ... ,R[A+B-2] (see note) */
+OP_RETURN0,/* return */
+OP_RETURN1,/* A return R[A] */
+
+OP_FORLOOP,/* A Bx update counters; if loop continues then pc-=Bx; */
+OP_FORPREP,/* A Bx <check values and prepare counters>;
+ if not to run then pc+=Bx+1; */
+
+OP_TFORPREP,/* A Bx create upvalue for R[A + 3]; pc+=Bx */
+OP_TFORCALL,/* A C R[A+4], ... ,R[A+3+C] := R[A](R[A+1], R[A+2]); */
+OP_TFORLOOP,/* A Bx if R[A+2] ~= nil then { R[A]=R[A+2]; pc -= Bx } */
+
+OP_SETLIST,/* A B C k R[A][(C-1)*FPF+i] := R[A+i], 1 <= i <= B */
+
+OP_CLOSURE,/* A Bx R[A] := closure(KPROTO[Bx]) */
+
+OP_VARARG,/* A C R[A], R[A+1], ..., R[A+C-2] = vararg */
+
+OP_VARARGPREP,/*A (adjust vararg parameters) */
OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */
} OpCode;
-#define NUM_OPCODES (cast(int, OP_EXTRAARG) + 1)
+#define NUM_OPCODES ((int)(OP_EXTRAARG) + 1)
/*===========================================================================
Notes:
- (*) In OP_CALL, if (B == 0) then B = top. If (C == 0), then 'top' is
- set to last_result+1, so next open instruction (OP_CALL, OP_RETURN,
- OP_SETLIST) may use 'top'.
+ (*) In OP_CALL, if (B == 0) then B = top - A. If (C == 0), then
+ 'top' is set to last_result+1, so next open instruction (OP_CALL,
+ OP_RETURN*, OP_SETLIST) may use 'top'.
- (*) In OP_VARARG, if (B == 0) then use actual number of varargs and
+ (*) In OP_VARARG, if (C == 0) then use actual number of varargs and
set top (like in OP_CALL with C == 0).
(*) In OP_RETURN, if (B == 0) then return up to 'top'.
- (*) In OP_SETLIST, if (B == 0) then B = 'top'; if (C == 0) then next
- 'instruction' is EXTRAARG(real C).
+ (*) In OP_LOADKX and OP_NEWTABLE, the next instruction is always
+ OP_EXTRAARG.
- (*) In OP_LOADKX, the next 'instruction' is always EXTRAARG.
+ (*) In OP_SETLIST, if (B == 0) then real B = 'top'; if k, then
+ real C = EXTRAARG _ C (the bits of EXTRAARG concatenated with the
+ bits of C).
- (*) For comparisons, A specifies what condition the test should accept
+ (*) In OP_NEWTABLE, B is log2 of the hash size (which is always a
+ power of 2) plus 1, or zero for size zero. If not k, the array size
+ is C. Otherwise, the array size is EXTRAARG _ C.
+
+ (*) For comparisons, k specifies what condition the test should accept
(true or false).
+ (*) In OP_MMBINI/OP_MMBINK, k means the arguments were flipped
+ (the constant is the first operand).
+
(*) All 'skips' (pc++) assume that next instruction is a jump.
+ (*) In instructions OP_RETURN/OP_TAILCALL, 'k' specifies that the
+ function builds upvalues, which may need to be closed. C > 0 means
+ the function is vararg, so that its 'func' must be corrected before
+ returning; in this case, (C - 1) is its number of fixed parameters.
+
+ (*) In comparisons with an immediate operand, C signals whether the
+ original operand was a float. (It must be corrected in case of
+ metamethods.)
+
===========================================================================*/
/*
** masks for instruction properties. The format is:
-** bits 0-1: op mode
-** bits 2-3: C arg mode
-** bits 4-5: B arg mode
-** bit 6: instruction set register A
-** bit 7: operator is a test (next instruction must be a jump)
+** bits 0-2: op mode
+** bit 3: instruction set register A
+** bit 4: operator is a test (next instruction must be a jump)
+** bit 5: instruction uses 'L->top' set by previous instruction (when B == 0)
+** bit 6: instruction sets 'L->top' for next instruction (when C == 0)
+** bit 7: instruction is an MM instruction (call a metamethod)
*/
-enum OpArgMask {
- OpArgN, /* argument is not used */
- OpArgU, /* argument is used */
- OpArgR, /* argument is a register or a jump offset */
- OpArgK /* argument is a constant or register/constant */
-};
+LUAI_DDEC(const lu_byte luaP_opmodes[NUM_OPCODES];)
-LUAI_DDEC const lu_byte luaP_opmodes[NUM_OPCODES];
+#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 7))
+#define testAMode(m) (luaP_opmodes[m] & (1 << 3))
+#define testTMode(m) (luaP_opmodes[m] & (1 << 4))
+#define testITMode(m) (luaP_opmodes[m] & (1 << 5))
+#define testOTMode(m) (luaP_opmodes[m] & (1 << 6))
+#define testMMMode(m) (luaP_opmodes[m] & (1 << 7))
-#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3))
-#define getBMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 4) & 3))
-#define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3))
-#define testAMode(m) (luaP_opmodes[m] & (1 << 6))
-#define testTMode(m) (luaP_opmodes[m] & (1 << 7))
+/* "out top" (set top for next instruction) */
+#define isOT(i) \
+ ((testOTMode(GET_OPCODE(i)) && GETARG_C(i) == 0) || \
+ GET_OPCODE(i) == OP_TAILCALL)
+/* "in top" (uses top from previous instruction) */
+#define isIT(i) (testITMode(GET_OPCODE(i)) && GETARG_B(i) == 0)
-LUAI_DDEC const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */
+#define opmode(mm,ot,it,t,a,m) \
+ (((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m))
/* number of list items to accumulate before a SETLIST instruction */
#define LFIELDS_PER_FLUSH 50
-
#endif
diff --git a/src/lopnames.h b/src/lopnames.h
new file mode 100644
index 0000000..965cec9
--- /dev/null
+++ b/src/lopnames.h
@@ -0,0 +1,103 @@
+/*
+** $Id: lopnames.h $
+** Opcode names
+** See Copyright Notice in lua.h
+*/
+
+#if !defined(lopnames_h)
+#define lopnames_h
+
+#include <stddef.h>
+
+
+/* ORDER OP */
+
+static const char *const opnames[] = {
+ "MOVE",
+ "LOADI",
+ "LOADF",
+ "LOADK",
+ "LOADKX",
+ "LOADFALSE",
+ "LFALSESKIP",
+ "LOADTRUE",
+ "LOADNIL",
+ "GETUPVAL",
+ "SETUPVAL",
+ "GETTABUP",
+ "GETTABLE",
+ "GETI",
+ "GETFIELD",
+ "SETTABUP",
+ "SETTABLE",
+ "SETI",
+ "SETFIELD",
+ "NEWTABLE",
+ "SELF",
+ "ADDI",
+ "ADDK",
+ "SUBK",
+ "MULK",
+ "MODK",
+ "POWK",
+ "DIVK",
+ "IDIVK",
+ "BANDK",
+ "BORK",
+ "BXORK",
+ "SHRI",
+ "SHLI",
+ "ADD",
+ "SUB",
+ "MUL",
+ "MOD",
+ "POW",
+ "DIV",
+ "IDIV",
+ "BAND",
+ "BOR",
+ "BXOR",
+ "SHL",
+ "SHR",
+ "MMBIN",
+ "MMBINI",
+ "MMBINK",
+ "UNM",
+ "BNOT",
+ "NOT",
+ "LEN",
+ "CONCAT",
+ "CLOSE",
+ "TBC",
+ "JMP",
+ "EQ",
+ "LT",
+ "LE",
+ "EQK",
+ "EQI",
+ "LTI",
+ "LEI",
+ "GTI",
+ "GEI",
+ "TEST",
+ "TESTSET",
+ "CALL",
+ "TAILCALL",
+ "RETURN",
+ "RETURN0",
+ "RETURN1",
+ "FORLOOP",
+ "FORPREP",
+ "TFORPREP",
+ "TFORCALL",
+ "TFORLOOP",
+ "SETLIST",
+ "CLOSURE",
+ "VARARG",
+ "VARARGPREP",
+ "EXTRAARG",
+ NULL
+};
+
+#endif
+
diff --git a/src/loslib.c b/src/loslib.c
index de590c6..e65e188 100644
--- a/src/loslib.c
+++ b/src/loslib.c
@@ -1,5 +1,5 @@
/*
-** $Id: loslib.c,v 1.65.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: loslib.c $
** Standard Operating System library
** See Copyright Notice in lua.h
*/
@@ -59,18 +59,20 @@
** ===================================================================
*/
-#if !defined(l_time_t) /* { */
/*
** type to represent time_t in Lua
*/
+#if !defined(LUA_NUMTIME) /* { */
+
#define l_timet lua_Integer
#define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t))
+#define l_gettime(L,arg) luaL_checkinteger(L, arg)
-static time_t l_checktime (lua_State *L, int arg) {
- lua_Integer t = luaL_checkinteger(L, arg);
- luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");
- return (time_t)t;
-}
+#else /* }{ */
+
+#define l_timet lua_Number
+#define l_pushtime(L,t) lua_pushnumber(L,(lua_Number)(t))
+#define l_gettime(L,arg) luaL_checknumber(L, arg)
#endif /* } */
@@ -90,7 +92,7 @@
/* ISO C definitions */
#define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t))
-#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))
+#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))
#endif /* } */
@@ -137,10 +139,11 @@
-
static int os_execute (lua_State *L) {
const char *cmd = luaL_optstring(L, 1, NULL);
- int stat = system(cmd);
+ int stat;
+ errno = 0;
+ stat = system(cmd);
if (cmd != NULL)
return luaL_execresult(L, stat);
else {
@@ -194,11 +197,25 @@
** =======================================================
*/
-static void setfield (lua_State *L, const char *key, int value) {
- lua_pushinteger(L, value);
+/*
+** About the overflow check: an overflow cannot occur when time
+** is represented by a lua_Integer, because either lua_Integer is
+** large enough to represent all int fields or it is not large enough
+** to represent a time that cause a field to overflow. However, if
+** times are represented as doubles and lua_Integer is int, then the
+** time 0x1.e1853b0d184f6p+55 would cause an overflow when adding 1900
+** to compute the year.
+*/
+static void setfield (lua_State *L, const char *key, int value, int delta) {
+ #if (defined(LUA_NUMTIME) && LUA_MAXINTEGER <= INT_MAX)
+ if (value > LUA_MAXINTEGER - delta)
+ luaL_error(L, "field '%s' is out-of-bound", key);
+ #endif
+ lua_pushinteger(L, (lua_Integer)value + delta);
lua_setfield(L, -2, key);
}
+
static void setboolfield (lua_State *L, const char *key, int value) {
if (value < 0) /* undefined? */
return; /* does not set field */
@@ -211,14 +228,14 @@
** Set all fields from structure 'tm' in the table on top of the stack
*/
static void setallfields (lua_State *L, struct tm *stm) {
- setfield(L, "sec", stm->tm_sec);
- setfield(L, "min", stm->tm_min);
- setfield(L, "hour", stm->tm_hour);
- setfield(L, "day", stm->tm_mday);
- setfield(L, "month", stm->tm_mon + 1);
- setfield(L, "year", stm->tm_year + 1900);
- setfield(L, "wday", stm->tm_wday + 1);
- setfield(L, "yday", stm->tm_yday + 1);
+ setfield(L, "year", stm->tm_year, 1900);
+ setfield(L, "month", stm->tm_mon, 1);
+ setfield(L, "day", stm->tm_mday, 0);
+ setfield(L, "hour", stm->tm_hour, 0);
+ setfield(L, "min", stm->tm_min, 0);
+ setfield(L, "sec", stm->tm_sec, 0);
+ setfield(L, "yday", stm->tm_yday, 1);
+ setfield(L, "wday", stm->tm_wday, 1);
setboolfield(L, "isdst", stm->tm_isdst);
}
@@ -231,11 +248,6 @@
}
-/* maximum value for date fields (to avoid arithmetic overflows with 'int') */
-#if !defined(L_MAXDATEFIELD)
-#define L_MAXDATEFIELD (INT_MAX / 2)
-#endif
-
static int getfield (lua_State *L, const char *key, int d, int delta) {
int isnum;
int t = lua_getfield(L, -1, key); /* get field and its type */
@@ -248,7 +260,9 @@
res = d;
}
else {
- if (!(-L_MAXDATEFIELD <= res && res <= L_MAXDATEFIELD))
+ /* unsigned avoids overflow when lua_Integer has 32 bits */
+ if (!(res >= 0 ? (lua_Unsigned)res <= (lua_Unsigned)INT_MAX + delta
+ : (lua_Integer)INT_MIN + delta <= res))
return luaL_error(L, "field '%s' is out-of-bound", key);
res -= delta;
}
@@ -276,6 +290,13 @@
}
+static time_t l_checktime (lua_State *L, int arg) {
+ l_timet t = l_gettime(L, arg);
+ luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");
+ return (time_t)t;
+}
+
+
/* maximum size for an individual 'strftime' item */
#define SIZETIMEFMT 250
@@ -294,7 +315,7 @@
stm = l_localtime(&t, &tmr);
if (stm == NULL) /* invalid date? */
return luaL_error(L,
- "time result cannot be represented in this installation");
+ "date result cannot be represented in this installation");
if (strcmp(s, "*t") == 0) {
lua_createtable(L, 0, 9); /* 9 = number of fields */
setallfields(L, stm);
@@ -330,12 +351,12 @@
struct tm ts;
luaL_checktype(L, 1, LUA_TTABLE);
lua_settop(L, 1); /* make sure table is at the top */
- ts.tm_sec = getfield(L, "sec", 0, 0);
- ts.tm_min = getfield(L, "min", 0, 0);
- ts.tm_hour = getfield(L, "hour", 12, 0);
- ts.tm_mday = getfield(L, "day", -1, 0);
- ts.tm_mon = getfield(L, "month", -1, 1);
ts.tm_year = getfield(L, "year", -1, 1900);
+ ts.tm_mon = getfield(L, "month", -1, 1);
+ ts.tm_mday = getfield(L, "day", -1, 0);
+ ts.tm_hour = getfield(L, "hour", 12, 0);
+ ts.tm_min = getfield(L, "min", 0, 0);
+ ts.tm_sec = getfield(L, "sec", 0, 0);
ts.tm_isdst = getboolfield(L, "isdst");
t = mktime(&ts);
setallfields(L, &ts); /* update fields with normalized values */
diff --git a/src/lparser.c b/src/lparser.c
index cc54de4..bc7d9a4 100644
--- a/src/lparser.c
+++ b/src/lparser.c
@@ -1,5 +1,5 @@
/*
-** $Id: lparser.c,v 2.155.1.2 2017/04/29 18:11:40 roberto Exp $
+** $Id: lparser.c $
** Lua Parser
** See Copyright Notice in lua.h
*/
@@ -10,6 +10,7 @@
#include "lprefix.h"
+#include <limits.h>
#include <string.h>
#include "lua.h"
@@ -52,6 +53,7 @@
lu_byte nactvar; /* # active locals outside the block */
lu_byte upval; /* true if some variable in the block is an upvalue */
lu_byte isloop; /* true if 'block' is a loop */
+ lu_byte insidetbc; /* true if inside the scope of a to-be-closed var. */
} BlockCnt;
@@ -63,13 +65,6 @@
static void expr (LexState *ls, expdesc *v);
-/* semantic error */
-static l_noret semerror (LexState *ls, const char *msg) {
- ls->t.token = 0; /* remove "near <token>" from final message */
- luaX_syntaxerror(ls, msg);
-}
-
-
static l_noret error_expected (LexState *ls, int token) {
luaX_syntaxerror(ls,
luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token)));
@@ -94,6 +89,9 @@
}
+/*
+** Test whether next token is 'c'; if so, skip it.
+*/
static int testnext (LexState *ls, int c) {
if (ls->t.token == c) {
luaX_next(ls);
@@ -103,12 +101,18 @@
}
+/*
+** Check that next token is 'c'.
+*/
static void check (LexState *ls, int c) {
if (ls->t.token != c)
error_expected(ls, c);
}
+/*
+** Check that next token is 'c' and skip it.
+*/
static void checknext (LexState *ls, int c) {
check(ls, c);
luaX_next(ls);
@@ -118,11 +122,15 @@
#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); }
-
+/*
+** Check that next token is 'what' and skip it. In case of error,
+** raise an error that the expected 'what' should match a 'who'
+** in line 'where' (if that is not the current line).
+*/
static void check_match (LexState *ls, int what, int who, int where) {
- if (!testnext(ls, what)) {
- if (where == ls->linenumber)
- error_expected(ls, what);
+ if (unlikely(!testnext(ls, what))) {
+ if (where == ls->linenumber) /* all in the same line? */
+ error_expected(ls, what); /* do not need a complex message */
else {
luaX_syntaxerror(ls, luaO_pushfstring(ls->L,
"%s expected (to close %s at line %d)",
@@ -148,73 +156,189 @@
}
-static void codestring (LexState *ls, expdesc *e, TString *s) {
- init_exp(e, VK, luaK_stringK(ls->fs, s));
+static void codestring (expdesc *e, TString *s) {
+ e->f = e->t = NO_JUMP;
+ e->k = VKSTR;
+ e->u.strval = s;
}
-static void checkname (LexState *ls, expdesc *e) {
- codestring(ls, e, str_checkname(ls));
+static void codename (LexState *ls, expdesc *e) {
+ codestring(e, str_checkname(ls));
}
-static int registerlocalvar (LexState *ls, TString *varname) {
- FuncState *fs = ls->fs;
+/*
+** Register a new local variable in the active 'Proto' (for debug
+** information).
+*/
+static int registerlocalvar (LexState *ls, FuncState *fs, TString *varname) {
Proto *f = fs->f;
int oldsize = f->sizelocvars;
- luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars,
+ luaM_growvector(ls->L, f->locvars, fs->ndebugvars, f->sizelocvars,
LocVar, SHRT_MAX, "local variables");
while (oldsize < f->sizelocvars)
f->locvars[oldsize++].varname = NULL;
- f->locvars[fs->nlocvars].varname = varname;
+ f->locvars[fs->ndebugvars].varname = varname;
+ f->locvars[fs->ndebugvars].startpc = fs->pc;
luaC_objbarrier(ls->L, f, varname);
- return fs->nlocvars++;
+ return fs->ndebugvars++;
}
-static void new_localvar (LexState *ls, TString *name) {
+/*
+** Create a new local variable with the given 'name'. Return its index
+** in the function.
+*/
+static int new_localvar (LexState *ls, TString *name) {
+ lua_State *L = ls->L;
FuncState *fs = ls->fs;
Dyndata *dyd = ls->dyd;
- int reg = registerlocalvar(ls, name);
+ Vardesc *var;
checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal,
- MAXVARS, "local variables");
- luaM_growvector(ls->L, dyd->actvar.arr, dyd->actvar.n + 1,
- dyd->actvar.size, Vardesc, MAX_INT, "local variables");
- dyd->actvar.arr[dyd->actvar.n++].idx = cast(short, reg);
-}
-
-
-static void new_localvarliteral_ (LexState *ls, const char *name, size_t sz) {
- new_localvar(ls, luaX_newstring(ls, name, sz));
+ MAXVARS, "local variables");
+ luaM_growvector(L, dyd->actvar.arr, dyd->actvar.n + 1,
+ dyd->actvar.size, Vardesc, USHRT_MAX, "local variables");
+ var = &dyd->actvar.arr[dyd->actvar.n++];
+ var->vd.kind = VDKREG; /* default */
+ var->vd.name = name;
+ return dyd->actvar.n - 1 - fs->firstlocal;
}
#define new_localvarliteral(ls,v) \
- new_localvarliteral_(ls, "" v, (sizeof(v)/sizeof(char))-1)
+ new_localvar(ls, \
+ luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char)) - 1));
-static LocVar *getlocvar (FuncState *fs, int i) {
- int idx = fs->ls->dyd->actvar.arr[fs->firstlocal + i].idx;
- lua_assert(idx < fs->nlocvars);
- return &fs->f->locvars[idx];
+
+/*
+** Return the "variable description" (Vardesc) of a given variable.
+** (Unless noted otherwise, all variables are referred to by their
+** compiler indices.)
+*/
+static Vardesc *getlocalvardesc (FuncState *fs, int vidx) {
+ return &fs->ls->dyd->actvar.arr[fs->firstlocal + vidx];
}
-static void adjustlocalvars (LexState *ls, int nvars) {
- FuncState *fs = ls->fs;
- fs->nactvar = cast_byte(fs->nactvar + nvars);
- for (; nvars; nvars--) {
- getlocvar(fs, fs->nactvar - nvars)->startpc = fs->pc;
+/*
+** Convert 'nvar', a compiler index level, to it corresponding
+** stack index level. For that, search for the highest variable
+** below that level that is in the stack and uses its stack
+** index ('sidx').
+*/
+static int stacklevel (FuncState *fs, int nvar) {
+ while (nvar-- > 0) {
+ Vardesc *vd = getlocalvardesc(fs, nvar); /* get variable */
+ if (vd->vd.kind != RDKCTC) /* is in the stack? */
+ return vd->vd.sidx + 1;
+ }
+ return 0; /* no variables in the stack */
+}
+
+
+/*
+** Return the number of variables in the stack for function 'fs'
+*/
+int luaY_nvarstack (FuncState *fs) {
+ return stacklevel(fs, fs->nactvar);
+}
+
+
+/*
+** Get the debug-information entry for current variable 'vidx'.
+*/
+static LocVar *localdebuginfo (FuncState *fs, int vidx) {
+ Vardesc *vd = getlocalvardesc(fs, vidx);
+ if (vd->vd.kind == RDKCTC)
+ return NULL; /* no debug info. for constants */
+ else {
+ int idx = vd->vd.pidx;
+ lua_assert(idx < fs->ndebugvars);
+ return &fs->f->locvars[idx];
}
}
-static void removevars (FuncState *fs, int tolevel) {
- fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel);
- while (fs->nactvar > tolevel)
- getlocvar(fs, --fs->nactvar)->endpc = fs->pc;
+/*
+** Create an expression representing variable 'vidx'
+*/
+static void init_var (FuncState *fs, expdesc *e, int vidx) {
+ e->f = e->t = NO_JUMP;
+ e->k = VLOCAL;
+ e->u.var.vidx = vidx;
+ e->u.var.sidx = getlocalvardesc(fs, vidx)->vd.sidx;
}
+/*
+** Raises an error if variable described by 'e' is read only
+*/
+static void check_readonly (LexState *ls, expdesc *e) {
+ FuncState *fs = ls->fs;
+ TString *varname = NULL; /* to be set if variable is const */
+ switch (e->k) {
+ case VCONST: {
+ varname = ls->dyd->actvar.arr[e->u.info].vd.name;
+ break;
+ }
+ case VLOCAL: {
+ Vardesc *vardesc = getlocalvardesc(fs, e->u.var.vidx);
+ if (vardesc->vd.kind != VDKREG) /* not a regular variable? */
+ varname = vardesc->vd.name;
+ break;
+ }
+ case VUPVAL: {
+ Upvaldesc *up = &fs->f->upvalues[e->u.info];
+ if (up->kind != VDKREG)
+ varname = up->name;
+ break;
+ }
+ default:
+ return; /* other cases cannot be read-only */
+ }
+ if (varname) {
+ const char *msg = luaO_pushfstring(ls->L,
+ "attempt to assign to const variable '%s'", getstr(varname));
+ luaK_semerror(ls, msg); /* error */
+ }
+}
+
+
+/*
+** Start the scope for the last 'nvars' created variables.
+*/
+static void adjustlocalvars (LexState *ls, int nvars) {
+ FuncState *fs = ls->fs;
+ int stklevel = luaY_nvarstack(fs);
+ int i;
+ for (i = 0; i < nvars; i++) {
+ int vidx = fs->nactvar++;
+ Vardesc *var = getlocalvardesc(fs, vidx);
+ var->vd.sidx = stklevel++;
+ var->vd.pidx = registerlocalvar(ls, fs, var->vd.name);
+ }
+}
+
+
+/*
+** Close the scope for all variables up to level 'tolevel'.
+** (debug info.)
+*/
+static void removevars (FuncState *fs, int tolevel) {
+ fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel);
+ while (fs->nactvar > tolevel) {
+ LocVar *var = localdebuginfo(fs, --fs->nactvar);
+ if (var) /* does it have debug information? */
+ var->endpc = fs->pc;
+ }
+}
+
+
+/*
+** Search the upvalues of the function 'fs' for one
+** with the given 'name'.
+*/
static int searchupvalue (FuncState *fs, TString *name) {
int i;
Upvaldesc *up = fs->f->upvalues;
@@ -225,7 +349,7 @@
}
-static int newupvalue (FuncState *fs, TString *name, expdesc *v) {
+static Upvaldesc *allocupvalue (FuncState *fs) {
Proto *f = fs->f;
int oldsize = f->sizeupvalues;
checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues");
@@ -233,58 +357,87 @@
Upvaldesc, MAXUPVAL, "upvalues");
while (oldsize < f->sizeupvalues)
f->upvalues[oldsize++].name = NULL;
- f->upvalues[fs->nups].instack = (v->k == VLOCAL);
- f->upvalues[fs->nups].idx = cast_byte(v->u.info);
- f->upvalues[fs->nups].name = name;
- luaC_objbarrier(fs->ls->L, f, name);
- return fs->nups++;
+ return &f->upvalues[fs->nups++];
}
-static int searchvar (FuncState *fs, TString *n) {
+static int newupvalue (FuncState *fs, TString *name, expdesc *v) {
+ Upvaldesc *up = allocupvalue(fs);
+ FuncState *prev = fs->prev;
+ if (v->k == VLOCAL) {
+ up->instack = 1;
+ up->idx = v->u.var.sidx;
+ up->kind = getlocalvardesc(prev, v->u.var.vidx)->vd.kind;
+ lua_assert(eqstr(name, getlocalvardesc(prev, v->u.var.vidx)->vd.name));
+ }
+ else {
+ up->instack = 0;
+ up->idx = cast_byte(v->u.info);
+ up->kind = prev->f->upvalues[v->u.info].kind;
+ lua_assert(eqstr(name, prev->f->upvalues[v->u.info].name));
+ }
+ up->name = name;
+ luaC_objbarrier(fs->ls->L, fs->f, name);
+ return fs->nups - 1;
+}
+
+
+/*
+** Look for an active local variable with the name 'n' in the
+** function 'fs'. If found, initialize 'var' with it and return
+** its expression kind; otherwise return -1.
+*/
+static int searchvar (FuncState *fs, TString *n, expdesc *var) {
int i;
for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) {
- if (eqstr(n, getlocvar(fs, i)->varname))
- return i;
+ Vardesc *vd = getlocalvardesc(fs, i);
+ if (eqstr(n, vd->vd.name)) { /* found? */
+ if (vd->vd.kind == RDKCTC) /* compile-time constant? */
+ init_exp(var, VCONST, fs->firstlocal + i);
+ else /* real variable */
+ init_var(fs, var, i);
+ return var->k;
+ }
}
return -1; /* not found */
}
/*
- Mark block where variable at given level was defined
- (to emit close instructions later).
+** Mark block where variable at given level was defined
+** (to emit close instructions later).
*/
static void markupval (FuncState *fs, int level) {
BlockCnt *bl = fs->bl;
while (bl->nactvar > level)
bl = bl->previous;
bl->upval = 1;
+ fs->needclose = 1;
}
/*
- Find variable with given name 'n'. If it is an upvalue, add this
- upvalue into all intermediate functions.
+** Find a variable with the given name 'n'. If it is an upvalue, add
+** this upvalue into all intermediate functions. If it is a global, set
+** 'var' as 'void' as a flag.
*/
static void singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) {
if (fs == NULL) /* no more levels? */
init_exp(var, VVOID, 0); /* default is global */
else {
- int v = searchvar(fs, n); /* look up locals at current level */
+ int v = searchvar(fs, n, var); /* look up locals at current level */
if (v >= 0) { /* found? */
- init_exp(var, VLOCAL, v); /* variable is local */
- if (!base)
- markupval(fs, v); /* local will be used as an upval */
+ if (v == VLOCAL && !base)
+ markupval(fs, var->u.var.vidx); /* local will be used as an upval */
}
else { /* not found as local at current level; try upvalues */
int idx = searchupvalue(fs, n); /* try existing upvalues */
if (idx < 0) { /* not found? */
singlevaraux(fs->prev, n, var, 0); /* try upper levels */
- if (var->k == VVOID) /* not found? */
- return; /* it is a global */
- /* else was LOCAL or UPVAL */
- idx = newupvalue(fs, n, var); /* will be a new upvalue */
+ if (var->k == VLOCAL || var->k == VUPVAL) /* local or upvalue? */
+ idx = newupvalue(fs, n, var); /* will be a new upvalue */
+ else /* it is a global or a constant */
+ return; /* don't need to do anything at this level */
}
init_exp(var, VUPVAL, idx); /* new or old upvalue */
}
@@ -292,6 +445,10 @@
}
+/*
+** Find a variable with the given name 'n', handling global variables
+** too.
+*/
static void singlevar (LexState *ls, expdesc *var) {
TString *varname = str_checkname(ls);
FuncState *fs = ls->fs;
@@ -300,88 +457,96 @@
expdesc key;
singlevaraux(fs, ls->envn, var, 1); /* get environment variable */
lua_assert(var->k != VVOID); /* this one must exist */
- codestring(ls, &key, varname); /* key is variable name */
+ codestring(&key, varname); /* key is variable name */
luaK_indexed(fs, var, &key); /* env[varname] */
}
}
+/*
+** Adjust the number of results from an expression list 'e' with 'nexps'
+** expressions to 'nvars' values.
+*/
static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {
FuncState *fs = ls->fs;
- int extra = nvars - nexps;
- if (hasmultret(e->k)) {
- extra++; /* includes call itself */
- if (extra < 0) extra = 0;
+ int needed = nvars - nexps; /* extra values needed */
+ if (hasmultret(e->k)) { /* last expression has multiple returns? */
+ int extra = needed + 1; /* discount last expression itself */
+ if (extra < 0)
+ extra = 0;
luaK_setreturns(fs, e, extra); /* last exp. provides the difference */
- if (extra > 1) luaK_reserveregs(fs, extra-1);
}
else {
- if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */
- if (extra > 0) {
- int reg = fs->freereg;
- luaK_reserveregs(fs, extra);
- luaK_nil(fs, reg, extra);
- }
+ if (e->k != VVOID) /* at least one expression? */
+ luaK_exp2nextreg(fs, e); /* close last expression */
+ if (needed > 0) /* missing values? */
+ luaK_nil(fs, fs->freereg, needed); /* complete with nils */
}
- if (nexps > nvars)
- ls->fs->freereg -= nexps - nvars; /* remove extra values */
+ if (needed > 0)
+ luaK_reserveregs(fs, needed); /* registers for extra values */
+ else /* adding 'needed' is actually a subtraction */
+ fs->freereg += needed; /* remove extra values */
}
-static void enterlevel (LexState *ls) {
- lua_State *L = ls->L;
- ++L->nCcalls;
- checklimit(ls->fs, L->nCcalls, LUAI_MAXCCALLS, "C levels");
+/*
+** Macros to limit the maximum recursion depth while parsing
+*/
+#define enterlevel(ls) luaE_enterCcall((ls)->L)
+
+#define leavelevel(ls) luaE_exitCcall((ls)->L)
+
+
+/*
+** Generates an error that a goto jumps into the scope of some
+** local variable.
+*/
+static l_noret jumpscopeerror (LexState *ls, Labeldesc *gt) {
+ const char *varname = getstr(getlocalvardesc(ls->fs, gt->nactvar)->vd.name);
+ const char *msg = "<goto %s> at line %d jumps into the scope of local '%s'";
+ msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line, varname);
+ luaK_semerror(ls, msg); /* raise the error */
}
-#define leavelevel(ls) ((ls)->L->nCcalls--)
-
-
-static void closegoto (LexState *ls, int g, Labeldesc *label) {
+/*
+** Solves the goto at index 'g' to given 'label' and removes it
+** from the list of pending goto's.
+** If it jumps into the scope of some variable, raises an error.
+*/
+static void solvegoto (LexState *ls, int g, Labeldesc *label) {
int i;
- FuncState *fs = ls->fs;
- Labellist *gl = &ls->dyd->gt;
- Labeldesc *gt = &gl->arr[g];
+ Labellist *gl = &ls->dyd->gt; /* list of goto's */
+ Labeldesc *gt = &gl->arr[g]; /* goto to be resolved */
lua_assert(eqstr(gt->name, label->name));
- if (gt->nactvar < label->nactvar) {
- TString *vname = getlocvar(fs, gt->nactvar)->varname;
- const char *msg = luaO_pushfstring(ls->L,
- "<goto %s> at line %d jumps into the scope of local '%s'",
- getstr(gt->name), gt->line, getstr(vname));
- semerror(ls, msg);
- }
- luaK_patchlist(fs, gt->pc, label->pc);
- /* remove goto from pending list */
- for (i = g; i < gl->n - 1; i++)
+ if (unlikely(gt->nactvar < label->nactvar)) /* enter some scope? */
+ jumpscopeerror(ls, gt);
+ luaK_patchlist(ls->fs, gt->pc, label->pc);
+ for (i = g; i < gl->n - 1; i++) /* remove goto from pending list */
gl->arr[i] = gl->arr[i + 1];
gl->n--;
}
/*
-** try to close a goto with existing labels; this solves backward jumps
+** Search for an active label with the given name.
*/
-static int findlabel (LexState *ls, int g) {
+static Labeldesc *findlabel (LexState *ls, TString *name) {
int i;
- BlockCnt *bl = ls->fs->bl;
Dyndata *dyd = ls->dyd;
- Labeldesc *gt = &dyd->gt.arr[g];
- /* check labels in current block for a match */
- for (i = bl->firstlabel; i < dyd->label.n; i++) {
+ /* check labels in current function for a match */
+ for (i = ls->fs->firstlabel; i < dyd->label.n; i++) {
Labeldesc *lb = &dyd->label.arr[i];
- if (eqstr(lb->name, gt->name)) { /* correct label? */
- if (gt->nactvar > lb->nactvar &&
- (bl->upval || dyd->label.n > bl->firstlabel))
- luaK_patchclose(ls->fs, gt->pc, lb->nactvar);
- closegoto(ls, g, lb); /* close it */
- return 1;
- }
+ if (eqstr(lb->name, name)) /* correct label? */
+ return lb;
}
- return 0; /* label not found; cannot close goto */
+ return NULL; /* label not found */
}
+/*
+** Adds a new label/goto in the corresponding list.
+*/
static int newlabelentry (LexState *ls, Labellist *l, TString *name,
int line, int pc) {
int n = l->n;
@@ -390,48 +555,76 @@
l->arr[n].name = name;
l->arr[n].line = line;
l->arr[n].nactvar = ls->fs->nactvar;
+ l->arr[n].close = 0;
l->arr[n].pc = pc;
l->n = n + 1;
return n;
}
-/*
-** check whether new label 'lb' matches any pending gotos in current
-** block; solves forward jumps
-*/
-static void findgotos (LexState *ls, Labeldesc *lb) {
- Labellist *gl = &ls->dyd->gt;
- int i = ls->fs->bl->firstgoto;
- while (i < gl->n) {
- if (eqstr(gl->arr[i].name, lb->name))
- closegoto(ls, i, lb);
- else
- i++;
- }
+static int newgotoentry (LexState *ls, TString *name, int line, int pc) {
+ return newlabelentry(ls, &ls->dyd->gt, name, line, pc);
}
/*
-** export pending gotos to outer level, to check them against
-** outer labels; if the block being exited has upvalues, and
-** the goto exits the scope of any variable (which can be the
-** upvalue), close those variables being exited.
+** Solves forward jumps. Check whether new label 'lb' matches any
+** pending gotos in current block and solves them. Return true
+** if any of the goto's need to close upvalues.
+*/
+static int solvegotos (LexState *ls, Labeldesc *lb) {
+ Labellist *gl = &ls->dyd->gt;
+ int i = ls->fs->bl->firstgoto;
+ int needsclose = 0;
+ while (i < gl->n) {
+ if (eqstr(gl->arr[i].name, lb->name)) {
+ needsclose |= gl->arr[i].close;
+ solvegoto(ls, i, lb); /* will remove 'i' from the list */
+ }
+ else
+ i++;
+ }
+ return needsclose;
+}
+
+
+/*
+** Create a new label with the given 'name' at the given 'line'.
+** 'last' tells whether label is the last non-op statement in its
+** block. Solves all pending goto's to this new label and adds
+** a close instruction if necessary.
+** Returns true iff it added a close instruction.
+*/
+static int createlabel (LexState *ls, TString *name, int line,
+ int last) {
+ FuncState *fs = ls->fs;
+ Labellist *ll = &ls->dyd->label;
+ int l = newlabelentry(ls, ll, name, line, luaK_getlabel(fs));
+ if (last) { /* label is last no-op statement in the block? */
+ /* assume that locals are already out of scope */
+ ll->arr[l].nactvar = fs->bl->nactvar;
+ }
+ if (solvegotos(ls, &ll->arr[l])) { /* need close? */
+ luaK_codeABC(fs, OP_CLOSE, luaY_nvarstack(fs), 0, 0);
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+** Adjust pending gotos to outer level of a block.
*/
static void movegotosout (FuncState *fs, BlockCnt *bl) {
- int i = bl->firstgoto;
+ int i;
Labellist *gl = &fs->ls->dyd->gt;
- /* correct pending gotos to current block and try to close it
- with visible labels */
- while (i < gl->n) {
+ /* correct pending gotos to current block */
+ for (i = bl->firstgoto; i < gl->n; i++) { /* for each pending goto */
Labeldesc *gt = &gl->arr[i];
- if (gt->nactvar > bl->nactvar) {
- if (bl->upval)
- luaK_patchclose(fs, gt->pc, bl->nactvar);
- gt->nactvar = bl->nactvar;
- }
- if (!findlabel(fs->ls, i))
- i++; /* move to next one */
+ /* leaving a variable scope? */
+ if (stacklevel(fs, gt->nactvar) > stacklevel(fs, bl->nactvar))
+ gt->close |= bl->upval; /* jump may need a close */
+ gt->nactvar = bl->nactvar; /* update goto level */
}
}
@@ -442,54 +635,50 @@
bl->firstlabel = fs->ls->dyd->label.n;
bl->firstgoto = fs->ls->dyd->gt.n;
bl->upval = 0;
+ bl->insidetbc = (fs->bl != NULL && fs->bl->insidetbc);
bl->previous = fs->bl;
fs->bl = bl;
- lua_assert(fs->freereg == fs->nactvar);
+ lua_assert(fs->freereg == luaY_nvarstack(fs));
}
/*
-** create a label named 'break' to resolve break statements
-*/
-static void breaklabel (LexState *ls) {
- TString *n = luaS_new(ls->L, "break");
- int l = newlabelentry(ls, &ls->dyd->label, n, 0, ls->fs->pc);
- findgotos(ls, &ls->dyd->label.arr[l]);
-}
-
-/*
-** generates an error for an undefined 'goto'; choose appropriate
-** message when label name is a reserved word (which can only be 'break')
+** generates an error for an undefined 'goto'.
*/
static l_noret undefgoto (LexState *ls, Labeldesc *gt) {
- const char *msg = isreserved(gt->name)
- ? "<%s> at line %d not inside a loop"
- : "no visible label '%s' for <goto> at line %d";
- msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
- semerror(ls, msg);
+ const char *msg;
+ if (eqstr(gt->name, luaS_newliteral(ls->L, "break"))) {
+ msg = "break outside loop at line %d";
+ msg = luaO_pushfstring(ls->L, msg, gt->line);
+ }
+ else {
+ msg = "no visible label '%s' for <goto> at line %d";
+ msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
+ }
+ luaK_semerror(ls, msg);
}
static void leaveblock (FuncState *fs) {
BlockCnt *bl = fs->bl;
LexState *ls = fs->ls;
- if (bl->previous && bl->upval) {
- /* create a 'jump to here' to close upvalues */
- int j = luaK_jump(fs);
- luaK_patchclose(fs, j, bl->nactvar);
- luaK_patchtohere(fs, j);
- }
- if (bl->isloop)
- breaklabel(ls); /* close pending breaks */
+ int hasclose = 0;
+ int stklevel = stacklevel(fs, bl->nactvar); /* level outside the block */
+ if (bl->isloop) /* fix pending breaks? */
+ hasclose = createlabel(ls, luaS_newliteral(ls->L, "break"), 0, 0);
+ if (!hasclose && bl->previous && bl->upval)
+ luaK_codeABC(fs, OP_CLOSE, stklevel, 0, 0);
fs->bl = bl->previous;
removevars(fs, bl->nactvar);
lua_assert(bl->nactvar == fs->nactvar);
- fs->freereg = fs->nactvar; /* free registers */
+ fs->freereg = stklevel; /* free registers */
ls->dyd->label.n = bl->firstlabel; /* remove local labels */
if (bl->previous) /* inner block? */
movegotosout(fs, bl); /* update pending gotos to outer block */
- else if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */
- undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */
+ else {
+ if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */
+ undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */
+ }
}
@@ -515,35 +704,40 @@
/*
** codes instruction to create new closure in parent function.
-** The OP_CLOSURE instruction must use the last available register,
+** The OP_CLOSURE instruction uses the last available register,
** so that, if it invokes the GC, the GC knows which registers
** are in use at that time.
+
*/
static void codeclosure (LexState *ls, expdesc *v) {
FuncState *fs = ls->fs->prev;
- init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));
+ init_exp(v, VRELOC, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));
luaK_exp2nextreg(fs, v); /* fix it at the last register */
}
static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {
- Proto *f;
+ Proto *f = fs->f;
fs->prev = ls->fs; /* linked list of funcstates */
fs->ls = ls;
ls->fs = fs;
fs->pc = 0;
+ fs->previousline = f->linedefined;
+ fs->iwthabs = 0;
fs->lasttarget = 0;
- fs->jpc = NO_JUMP;
fs->freereg = 0;
fs->nk = 0;
+ fs->nabslineinfo = 0;
fs->np = 0;
fs->nups = 0;
- fs->nlocvars = 0;
+ fs->ndebugvars = 0;
fs->nactvar = 0;
+ fs->needclose = 0;
fs->firstlocal = ls->dyd->actvar.n;
+ fs->firstlabel = ls->dyd->label.n;
fs->bl = NULL;
- f = fs->f;
f->source = ls->source;
+ luaC_objbarrier(ls->L, f, f->source);
f->maxstacksize = 2; /* registers 0/1 are always valid */
enterblock(fs, bl, 0);
}
@@ -553,21 +747,18 @@
lua_State *L = ls->L;
FuncState *fs = ls->fs;
Proto *f = fs->f;
- luaK_ret(fs, 0, 0); /* final return */
+ luaK_ret(fs, luaY_nvarstack(fs), 0); /* final return */
leaveblock(fs);
- luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);
- f->sizecode = fs->pc;
- luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int);
- f->sizelineinfo = fs->pc;
- luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue);
- f->sizek = fs->nk;
- luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *);
- f->sizep = fs->np;
- luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);
- f->sizelocvars = fs->nlocvars;
- luaM_reallocvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
- f->sizeupvalues = fs->nups;
lua_assert(fs->bl == NULL);
+ luaK_finish(fs);
+ luaM_shrinkvector(L, f->code, f->sizecode, fs->pc, Instruction);
+ luaM_shrinkvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
+ luaM_shrinkvector(L, f->abslineinfo, f->sizeabslineinfo,
+ fs->nabslineinfo, AbsLineInfo);
+ luaM_shrinkvector(L, f->k, f->sizek, fs->nk, TValue);
+ luaM_shrinkvector(L, f->p, f->sizep, fs->np, Proto *);
+ luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->ndebugvars, LocVar);
+ luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
ls->fs = fs->prev;
luaC_checkGC(L);
}
@@ -613,7 +804,7 @@
expdesc key;
luaK_exp2anyregup(fs, v);
luaX_next(ls); /* skip the dot or colon */
- checkname(ls, &key);
+ codename(ls, &key);
luaK_indexed(fs, v, &key);
}
@@ -634,48 +825,49 @@
*/
-struct ConsControl {
+typedef struct ConsControl {
expdesc v; /* last list item read */
expdesc *t; /* table descriptor */
int nh; /* total number of 'record' elements */
- int na; /* total number of array elements */
+ int na; /* number of array elements already stored */
int tostore; /* number of array elements pending to be stored */
-};
+} ConsControl;
-static void recfield (LexState *ls, struct ConsControl *cc) {
- /* recfield -> (NAME | '['exp1']') = exp1 */
+static void recfield (LexState *ls, ConsControl *cc) {
+ /* recfield -> (NAME | '['exp']') = exp */
FuncState *fs = ls->fs;
int reg = ls->fs->freereg;
- expdesc key, val;
- int rkkey;
+ expdesc tab, key, val;
if (ls->t.token == TK_NAME) {
checklimit(fs, cc->nh, MAX_INT, "items in a constructor");
- checkname(ls, &key);
+ codename(ls, &key);
}
else /* ls->t.token == '[' */
yindex(ls, &key);
cc->nh++;
checknext(ls, '=');
- rkkey = luaK_exp2RK(fs, &key);
+ tab = *cc->t;
+ luaK_indexed(fs, &tab, &key);
expr(ls, &val);
- luaK_codeABC(fs, OP_SETTABLE, cc->t->u.info, rkkey, luaK_exp2RK(fs, &val));
+ luaK_storevar(fs, &tab, &val);
fs->freereg = reg; /* free registers */
}
-static void closelistfield (FuncState *fs, struct ConsControl *cc) {
+static void closelistfield (FuncState *fs, ConsControl *cc) {
if (cc->v.k == VVOID) return; /* there is no list item */
luaK_exp2nextreg(fs, &cc->v);
cc->v.k = VVOID;
if (cc->tostore == LFIELDS_PER_FLUSH) {
luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */
+ cc->na += cc->tostore;
cc->tostore = 0; /* no more items pending */
}
}
-static void lastlistfield (FuncState *fs, struct ConsControl *cc) {
+static void lastlistfield (FuncState *fs, ConsControl *cc) {
if (cc->tostore == 0) return;
if (hasmultret(cc->v.k)) {
luaK_setmultret(fs, &cc->v);
@@ -687,19 +879,18 @@
luaK_exp2nextreg(fs, &cc->v);
luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore);
}
+ cc->na += cc->tostore;
}
-static void listfield (LexState *ls, struct ConsControl *cc) {
+static void listfield (LexState *ls, ConsControl *cc) {
/* listfield -> exp */
expr(ls, &cc->v);
- checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor");
- cc->na++;
cc->tostore++;
}
-static void field (LexState *ls, struct ConsControl *cc) {
+static void field (LexState *ls, ConsControl *cc) {
/* field -> listfield | recfield */
switch(ls->t.token) {
case TK_NAME: { /* may be 'listfield' or 'recfield' */
@@ -727,12 +918,13 @@
FuncState *fs = ls->fs;
int line = ls->linenumber;
int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);
- struct ConsControl cc;
+ ConsControl cc;
+ luaK_code(fs, 0); /* space for extra arg. */
cc.na = cc.nh = cc.tostore = 0;
cc.t = t;
- init_exp(t, VRELOCABLE, pc);
+ init_exp(t, VNONRELOC, fs->freereg); /* table will be at stack top */
+ luaK_reserveregs(fs, 1);
init_exp(&cc.v, VVOID, 0); /* no value (yet) */
- luaK_exp2nextreg(ls->fs, t); /* fix it at stack top */
checknext(ls, '{');
do {
lua_assert(cc.v.k == VVOID || cc.tostore > 0);
@@ -742,20 +934,24 @@
} while (testnext(ls, ',') || testnext(ls, ';'));
check_match(ls, '}', '{', line);
lastlistfield(fs, &cc);
- SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */
- SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh)); /* set initial table size */
+ luaK_settablesize(fs, pc, t->u.info, cc.na, cc.nh);
}
/* }====================================================================== */
+static void setvararg (FuncState *fs, int nparams) {
+ fs->f->is_vararg = 1;
+ luaK_codeABC(fs, OP_VARARGPREP, nparams, 0, 0);
+}
+
static void parlist (LexState *ls) {
/* parlist -> [ param { ',' param } ] */
FuncState *fs = ls->fs;
Proto *f = fs->f;
int nparams = 0;
- f->is_vararg = 0;
+ int isvararg = 0;
if (ls->t.token != ')') { /* is 'parlist' not empty? */
do {
switch (ls->t.token) {
@@ -766,16 +962,18 @@
}
case TK_DOTS: { /* param -> '...' */
luaX_next(ls);
- f->is_vararg = 1; /* declared vararg */
+ isvararg = 1;
break;
}
default: luaX_syntaxerror(ls, "<name> or '...' expected");
}
- } while (!f->is_vararg && testnext(ls, ','));
+ } while (!isvararg && testnext(ls, ','));
}
adjustlocalvars(ls, nparams);
f->numparams = cast_byte(fs->nactvar);
- luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */
+ if (isvararg)
+ setvararg(fs, f->numparams); /* declared vararg */
+ luaK_reserveregs(fs, fs->nactvar); /* reserve registers for parameters */
}
@@ -825,7 +1023,8 @@
args.k = VVOID;
else {
explist(ls, &args);
- luaK_setmultret(fs, &args);
+ if (hasmultret(args.k))
+ luaK_setmultret(fs, &args);
}
check_match(ls, ')', '(', line);
break;
@@ -835,7 +1034,7 @@
break;
}
case TK_STRING: { /* funcargs -> STRING */
- codestring(ls, &args, ls->t.seminfo.ts);
+ codestring(&args, ls->t.seminfo.ts);
luaX_next(ls); /* must use 'seminfo' before 'next' */
break;
}
@@ -902,7 +1101,7 @@
fieldsel(ls, v);
break;
}
- case '[': { /* '[' exp1 ']' */
+ case '[': { /* '[' exp ']' */
expdesc key;
luaK_exp2anyregup(fs, v);
yindex(ls, &key);
@@ -912,7 +1111,7 @@
case ':': { /* ':' NAME funcargs */
expdesc key;
luaX_next(ls);
- checkname(ls, &key);
+ codename(ls, &key);
luaK_self(fs, v, &key);
funcargs(ls, v, line);
break;
@@ -943,7 +1142,7 @@
break;
}
case TK_STRING: {
- codestring(ls, v, ls->t.seminfo.ts);
+ codestring(v, ls->t.seminfo.ts);
break;
}
case TK_NIL: {
@@ -962,7 +1161,7 @@
FuncState *fs = ls->fs;
check_condition(ls, fs->f->is_vararg,
"cannot use '...' outside a vararg function");
- init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0));
+ init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 0, 1));
break;
}
case '{': { /* constructor */
@@ -1022,6 +1221,9 @@
}
+/*
+** Priority table for binary operators.
+*/
static const struct {
lu_byte left; /* left priority for each binary operator */
lu_byte right; /* right priority */
@@ -1050,9 +1252,9 @@
UnOpr uop;
enterlevel(ls);
uop = getunopr(ls->t.token);
- if (uop != OPR_NOUNOPR) {
+ if (uop != OPR_NOUNOPR) { /* prefix (unary) operator? */
int line = ls->linenumber;
- luaX_next(ls);
+ luaX_next(ls); /* skip operator */
subexpr(ls, v, UNARY_PRIORITY);
luaK_prefix(ls->fs, uop, v, line);
}
@@ -1063,7 +1265,7 @@
expdesc v2;
BinOpr nextop;
int line = ls->linenumber;
- luaX_next(ls);
+ luaX_next(ls); /* skip operator */
luaK_infix(ls->fs, op, v);
/* read sub-expression with higher priority */
nextop = subexpr(ls, &v2, priority[op].right);
@@ -1121,43 +1323,60 @@
int extra = fs->freereg; /* eventual position to save local variable */
int conflict = 0;
for (; lh; lh = lh->prev) { /* check all previous assignments */
- if (lh->v.k == VINDEXED) { /* assigning to a table? */
- /* table is the upvalue/local being assigned now? */
- if (lh->v.u.ind.vt == v->k && lh->v.u.ind.t == v->u.info) {
- conflict = 1;
- lh->v.u.ind.vt = VLOCAL;
- lh->v.u.ind.t = extra; /* previous assignment will use safe copy */
+ if (vkisindexed(lh->v.k)) { /* assignment to table field? */
+ if (lh->v.k == VINDEXUP) { /* is table an upvalue? */
+ if (v->k == VUPVAL && lh->v.u.ind.t == v->u.info) {
+ conflict = 1; /* table is the upvalue being assigned now */
+ lh->v.k = VINDEXSTR;
+ lh->v.u.ind.t = extra; /* assignment will use safe copy */
+ }
}
- /* index is the local being assigned? (index cannot be upvalue) */
- if (v->k == VLOCAL && lh->v.u.ind.idx == v->u.info) {
- conflict = 1;
- lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */
+ else { /* table is a register */
+ if (v->k == VLOCAL && lh->v.u.ind.t == v->u.var.sidx) {
+ conflict = 1; /* table is the local being assigned now */
+ lh->v.u.ind.t = extra; /* assignment will use safe copy */
+ }
+ /* is index the local being assigned? */
+ if (lh->v.k == VINDEXED && v->k == VLOCAL &&
+ lh->v.u.ind.idx == v->u.var.sidx) {
+ conflict = 1;
+ lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */
+ }
}
}
}
if (conflict) {
/* copy upvalue/local value to a temporary (in position 'extra') */
- OpCode op = (v->k == VLOCAL) ? OP_MOVE : OP_GETUPVAL;
- luaK_codeABC(fs, op, extra, v->u.info, 0);
+ if (v->k == VLOCAL)
+ luaK_codeABC(fs, OP_MOVE, extra, v->u.var.sidx, 0);
+ else
+ luaK_codeABC(fs, OP_GETUPVAL, extra, v->u.info, 0);
luaK_reserveregs(fs, 1);
}
}
-
-static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) {
+/*
+** Parse and compile a multiple assignment. The first "variable"
+** (a 'suffixedexp') was already read by the caller.
+**
+** assignment -> suffixedexp restassign
+** restassign -> ',' suffixedexp restassign | '=' explist
+*/
+static void restassign (LexState *ls, struct LHS_assign *lh, int nvars) {
expdesc e;
check_condition(ls, vkisvar(lh->v.k), "syntax error");
- if (testnext(ls, ',')) { /* assignment -> ',' suffixedexp assignment */
+ check_readonly(ls, &lh->v);
+ if (testnext(ls, ',')) { /* restassign -> ',' suffixedexp restassign */
struct LHS_assign nv;
nv.prev = lh;
suffixedexp(ls, &nv.v);
- if (nv.v.k != VINDEXED)
+ if (!vkisindexed(nv.v.k))
check_conflict(ls, lh, &nv.v);
- checklimit(ls->fs, nvars + ls->L->nCcalls, LUAI_MAXCCALLS,
- "C levels");
- assignment(ls, &nv, nvars+1);
+ enterlevel(ls); /* control recursion depth */
+ restassign(ls, &nv, nvars+1);
+ leavelevel(ls);
}
- else { /* assignment -> '=' explist */
+ else { /* restassign -> '=' explist */
int nexps;
checknext(ls, '=');
nexps = explist(ls, &e);
@@ -1184,57 +1403,55 @@
}
-static void gotostat (LexState *ls, int pc) {
- int line = ls->linenumber;
- TString *label;
- int g;
- if (testnext(ls, TK_GOTO))
- label = str_checkname(ls);
- else {
- luaX_next(ls); /* skip break */
- label = luaS_new(ls->L, "break");
- }
- g = newlabelentry(ls, &ls->dyd->gt, label, line, pc);
- findlabel(ls, g); /* close it if label already defined */
-}
-
-
-/* check for repeated labels on the same block */
-static void checkrepeated (FuncState *fs, Labellist *ll, TString *label) {
- int i;
- for (i = fs->bl->firstlabel; i < ll->n; i++) {
- if (eqstr(label, ll->arr[i].name)) {
- const char *msg = luaO_pushfstring(fs->ls->L,
- "label '%s' already defined on line %d",
- getstr(label), ll->arr[i].line);
- semerror(fs->ls, msg);
- }
- }
-}
-
-
-/* skip no-op statements */
-static void skipnoopstat (LexState *ls) {
- while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)
- statement(ls);
-}
-
-
-static void labelstat (LexState *ls, TString *label, int line) {
- /* label -> '::' NAME '::' */
+static void gotostat (LexState *ls) {
FuncState *fs = ls->fs;
- Labellist *ll = &ls->dyd->label;
- int l; /* index of new label being created */
- checkrepeated(fs, ll, label); /* check for repeated labels */
- checknext(ls, TK_DBCOLON); /* skip double colon */
- /* create new entry for this label */
- l = newlabelentry(ls, ll, label, line, luaK_getlabel(fs));
- skipnoopstat(ls); /* skip other no-op statements */
- if (block_follow(ls, 0)) { /* label is last no-op statement in the block? */
- /* assume that locals are already out of scope */
- ll->arr[l].nactvar = fs->bl->nactvar;
+ int line = ls->linenumber;
+ TString *name = str_checkname(ls); /* label's name */
+ Labeldesc *lb = findlabel(ls, name);
+ if (lb == NULL) /* no label? */
+ /* forward jump; will be resolved when the label is declared */
+ newgotoentry(ls, name, line, luaK_jump(fs));
+ else { /* found a label */
+ /* backward jump; will be resolved here */
+ int lblevel = stacklevel(fs, lb->nactvar); /* label level */
+ if (luaY_nvarstack(fs) > lblevel) /* leaving the scope of a variable? */
+ luaK_codeABC(fs, OP_CLOSE, lblevel, 0, 0);
+ /* create jump and link it to the label */
+ luaK_patchlist(fs, luaK_jump(fs), lb->pc);
}
- findgotos(ls, &ll->arr[l]);
+}
+
+
+/*
+** Break statement. Semantically equivalent to "goto break".
+*/
+static void breakstat (LexState *ls) {
+ int line = ls->linenumber;
+ luaX_next(ls); /* skip break */
+ newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, luaK_jump(ls->fs));
+}
+
+
+/*
+** Check whether there is already a label with the given 'name'.
+*/
+static void checkrepeated (LexState *ls, TString *name) {
+ Labeldesc *lb = findlabel(ls, name);
+ if (unlikely(lb != NULL)) { /* already defined? */
+ const char *msg = "label '%s' already defined on line %d";
+ msg = luaO_pushfstring(ls->L, msg, getstr(name), lb->line);
+ luaK_semerror(ls, msg); /* error */
+ }
+}
+
+
+static void labelstat (LexState *ls, TString *name, int line) {
+ /* label -> '::' NAME '::' */
+ checknext(ls, TK_DBCOLON); /* skip double colon */
+ while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)
+ statement(ls); /* skip other no-op statements */
+ checkrepeated(ls, name); /* check for repeated labels */
+ createlabel(ls, name, line, block_follow(ls, 0));
}
@@ -1269,58 +1486,83 @@
statlist(ls);
check_match(ls, TK_UNTIL, TK_REPEAT, line);
condexit = cond(ls); /* read condition (inside scope block) */
- if (bl2.upval) /* upvalues? */
- luaK_patchclose(fs, condexit, bl2.nactvar);
leaveblock(fs); /* finish scope */
+ if (bl2.upval) { /* upvalues? */
+ int exit = luaK_jump(fs); /* normal exit must jump over fix */
+ luaK_patchtohere(fs, condexit); /* repetition must close upvalues */
+ luaK_codeABC(fs, OP_CLOSE, stacklevel(fs, bl2.nactvar), 0, 0);
+ condexit = luaK_jump(fs); /* repeat after closing upvalues */
+ luaK_patchtohere(fs, exit); /* normal exit comes to here */
+ }
luaK_patchlist(fs, condexit, repeat_init); /* close the loop */
leaveblock(fs); /* finish loop */
}
-static int exp1 (LexState *ls) {
+/*
+** Read an expression and generate code to put its results in next
+** stack slot.
+**
+*/
+static void exp1 (LexState *ls) {
expdesc e;
- int reg;
expr(ls, &e);
luaK_exp2nextreg(ls->fs, &e);
lua_assert(e.k == VNONRELOC);
- reg = e.u.info;
- return reg;
}
-static void forbody (LexState *ls, int base, int line, int nvars, int isnum) {
+/*
+** Fix for instruction at position 'pc' to jump to 'dest'.
+** (Jump addresses are relative in Lua). 'back' true means
+** a back jump.
+*/
+static void fixforjump (FuncState *fs, int pc, int dest, int back) {
+ Instruction *jmp = &fs->f->code[pc];
+ int offset = dest - (pc + 1);
+ if (back)
+ offset = -offset;
+ if (unlikely(offset > MAXARG_Bx))
+ luaX_syntaxerror(fs->ls, "control structure too long");
+ SETARG_Bx(*jmp, offset);
+}
+
+
+/*
+** Generate code for a 'for' loop.
+*/
+static void forbody (LexState *ls, int base, int line, int nvars, int isgen) {
/* forbody -> DO block */
+ static const OpCode forprep[2] = {OP_FORPREP, OP_TFORPREP};
+ static const OpCode forloop[2] = {OP_FORLOOP, OP_TFORLOOP};
BlockCnt bl;
FuncState *fs = ls->fs;
int prep, endfor;
- adjustlocalvars(ls, 3); /* control variables */
checknext(ls, TK_DO);
- prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs);
+ prep = luaK_codeABx(fs, forprep[isgen], base, 0);
enterblock(fs, &bl, 0); /* scope for declared variables */
adjustlocalvars(ls, nvars);
luaK_reserveregs(fs, nvars);
block(ls);
leaveblock(fs); /* end of scope for declared variables */
- luaK_patchtohere(fs, prep);
- if (isnum) /* numeric for? */
- endfor = luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP);
- else { /* generic for */
+ fixforjump(fs, prep, luaK_getlabel(fs), 0);
+ if (isgen) { /* generic for? */
luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars);
luaK_fixline(fs, line);
- endfor = luaK_codeAsBx(fs, OP_TFORLOOP, base + 2, NO_JUMP);
}
- luaK_patchlist(fs, endfor, prep + 1);
+ endfor = luaK_codeABx(fs, forloop[isgen], base, 0);
+ fixforjump(fs, endfor, prep + 1, 1);
luaK_fixline(fs, line);
}
static void fornum (LexState *ls, TString *varname, int line) {
- /* fornum -> NAME = exp1,exp1[,exp1] forbody */
+ /* fornum -> NAME = exp,exp[,exp] forbody */
FuncState *fs = ls->fs;
int base = fs->freereg;
- new_localvarliteral(ls, "(for index)");
- new_localvarliteral(ls, "(for limit)");
- new_localvarliteral(ls, "(for step)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
new_localvar(ls, varname);
checknext(ls, '=');
exp1(ls); /* initial value */
@@ -1329,10 +1571,11 @@
if (testnext(ls, ','))
exp1(ls); /* optional step */
else { /* default step = 1 */
- luaK_codek(fs, fs->freereg, luaK_intK(fs, 1));
+ luaK_int(fs, fs->freereg, 1);
luaK_reserveregs(fs, 1);
}
- forbody(ls, base, line, 1, 1);
+ adjustlocalvars(ls, 3); /* control variables */
+ forbody(ls, base, line, 1, 0);
}
@@ -1340,13 +1583,14 @@
/* forlist -> NAME {,NAME} IN explist forbody */
FuncState *fs = ls->fs;
expdesc e;
- int nvars = 4; /* gen, state, control, plus at least one declared var */
+ int nvars = 5; /* gen, state, control, toclose, 'indexname' */
int line;
int base = fs->freereg;
/* create control variables */
- new_localvarliteral(ls, "(for generator)");
new_localvarliteral(ls, "(for state)");
- new_localvarliteral(ls, "(for control)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
+ new_localvarliteral(ls, "(for state)");
/* create declared variables */
new_localvar(ls, indexname);
while (testnext(ls, ',')) {
@@ -1355,9 +1599,11 @@
}
checknext(ls, TK_IN);
line = ls->linenumber;
- adjust_assign(ls, 3, explist(ls, &e), &e);
+ adjust_assign(ls, 4, explist(ls, &e), &e);
+ adjustlocalvars(ls, 4); /* control variables */
+ markupval(fs, fs->nactvar); /* last control var. must be closed */
luaK_checkstack(fs, 3); /* extra space to call generator */
- forbody(ls, base, line, nvars - 3, 0);
+ forbody(ls, base, line, nvars - 4, 1);
}
@@ -1379,28 +1625,68 @@
}
+/*
+** Check whether next instruction is a single jump (a 'break', a 'goto'
+** to a forward label, or a 'goto' to a backward label with no variable
+** to close). If so, set the name of the 'label' it is jumping to
+** ("break" for a 'break') or to where it is jumping to ('target') and
+** return true. If not a single jump, leave input unchanged, to be
+** handled as a regular statement.
+*/
+static int issinglejump (LexState *ls, TString **label, int *target) {
+ if (testnext(ls, TK_BREAK)) { /* a break? */
+ *label = luaS_newliteral(ls->L, "break");
+ return 1;
+ }
+ else if (ls->t.token != TK_GOTO || luaX_lookahead(ls) != TK_NAME)
+ return 0; /* not a valid goto */
+ else {
+ TString *lname = ls->lookahead.seminfo.ts; /* label's id */
+ Labeldesc *lb = findlabel(ls, lname);
+ if (lb) { /* a backward jump? */
+ /* does it need to close variables? */
+ if (luaY_nvarstack(ls->fs) > stacklevel(ls->fs, lb->nactvar))
+ return 0; /* not a single jump; cannot optimize */
+ *target = lb->pc;
+ }
+ else /* jump forward */
+ *label = lname;
+ luaX_next(ls); /* skip goto */
+ luaX_next(ls); /* skip name */
+ return 1;
+ }
+}
+
+
static void test_then_block (LexState *ls, int *escapelist) {
/* test_then_block -> [IF | ELSEIF] cond THEN block */
BlockCnt bl;
+ int line;
FuncState *fs = ls->fs;
+ TString *jlb = NULL;
+ int target = NO_JUMP;
expdesc v;
int jf; /* instruction to skip 'then' code (if condition is false) */
luaX_next(ls); /* skip IF or ELSEIF */
expr(ls, &v); /* read condition */
checknext(ls, TK_THEN);
- if (ls->t.token == TK_GOTO || ls->t.token == TK_BREAK) {
+ line = ls->linenumber;
+ if (issinglejump(ls, &jlb, &target)) { /* 'if x then goto' ? */
luaK_goiffalse(ls->fs, &v); /* will jump to label if condition is true */
enterblock(fs, &bl, 0); /* must enter block before 'goto' */
- gotostat(ls, v.t); /* handle goto/break */
- while (testnext(ls, ';')) {} /* skip colons */
- if (block_follow(ls, 0)) { /* 'goto' is the entire block? */
+ if (jlb != NULL) /* forward jump? */
+ newgotoentry(ls, jlb, line, v.t); /* will be resolved later */
+ else /* backward jump */
+ luaK_patchlist(fs, v.t, target); /* jump directly to 'target' */
+ while (testnext(ls, ';')) {} /* skip semicolons */
+ if (block_follow(ls, 0)) { /* jump is the entire block? */
leaveblock(fs);
return; /* and that is it */
}
else /* must skip over 'then' part if condition is false */
jf = luaK_jump(fs);
}
- else { /* regular case (not goto/break) */
+ else { /* regular case (not a jump) */
luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */
enterblock(fs, &bl, 0);
jf = v.f;
@@ -1431,21 +1717,60 @@
static void localfunc (LexState *ls) {
expdesc b;
FuncState *fs = ls->fs;
+ int fvar = fs->nactvar; /* function's variable index */
new_localvar(ls, str_checkname(ls)); /* new local variable */
adjustlocalvars(ls, 1); /* enter its scope */
body(ls, &b, 0, ls->linenumber); /* function created in next register */
/* debug information will only see the variable after this point! */
- getlocvar(fs, b.u.info)->startpc = fs->pc;
+ localdebuginfo(fs, fvar)->startpc = fs->pc;
+}
+
+
+static int getlocalattribute (LexState *ls) {
+ /* ATTRIB -> ['<' Name '>'] */
+ if (testnext(ls, '<')) {
+ const char *attr = getstr(str_checkname(ls));
+ checknext(ls, '>');
+ if (strcmp(attr, "const") == 0)
+ return RDKCONST; /* read-only variable */
+ else if (strcmp(attr, "close") == 0)
+ return RDKTOCLOSE; /* to-be-closed variable */
+ else
+ luaK_semerror(ls,
+ luaO_pushfstring(ls->L, "unknown attribute '%s'", attr));
+ }
+ return VDKREG; /* regular variable */
+}
+
+
+static void checktoclose (LexState *ls, int level) {
+ if (level != -1) { /* is there a to-be-closed variable? */
+ FuncState *fs = ls->fs;
+ markupval(fs, level + 1);
+ fs->bl->insidetbc = 1; /* in the scope of a to-be-closed variable */
+ luaK_codeABC(fs, OP_TBC, stacklevel(fs, level), 0, 0);
+ }
}
static void localstat (LexState *ls) {
- /* stat -> LOCAL NAME {',' NAME} ['=' explist] */
+ /* stat -> LOCAL ATTRIB NAME {',' ATTRIB NAME} ['=' explist] */
+ FuncState *fs = ls->fs;
+ int toclose = -1; /* index of to-be-closed variable (if any) */
+ Vardesc *var; /* last variable */
+ int vidx, kind; /* index and kind of last variable */
int nvars = 0;
int nexps;
expdesc e;
do {
- new_localvar(ls, str_checkname(ls));
+ vidx = new_localvar(ls, str_checkname(ls));
+ kind = getlocalattribute(ls);
+ getlocalvardesc(fs, vidx)->vd.kind = kind;
+ if (kind == RDKTOCLOSE) { /* to-be-closed? */
+ if (toclose != -1) /* one already present? */
+ luaK_semerror(ls, "multiple to-be-closed variables in local list");
+ toclose = fs->nactvar + nvars;
+ }
nvars++;
} while (testnext(ls, ','));
if (testnext(ls, '='))
@@ -1454,8 +1779,19 @@
e.k = VVOID;
nexps = 0;
}
- adjust_assign(ls, nvars, nexps, &e);
- adjustlocalvars(ls, nvars);
+ var = getlocalvardesc(fs, vidx); /* get last variable */
+ if (nvars == nexps && /* no adjustments? */
+ var->vd.kind == RDKCONST && /* last variable is const? */
+ luaK_exp2const(fs, &e, &var->k)) { /* compile-time constant? */
+ var->vd.kind = RDKCTC; /* variable is a compile-time constant */
+ adjustlocalvars(ls, nvars - 1); /* exclude last variable */
+ fs->nactvar++; /* but count it */
+ }
+ else {
+ adjust_assign(ls, nvars, nexps, &e);
+ adjustlocalvars(ls, nvars);
+ }
+ checktoclose(ls, toclose);
}
@@ -1492,11 +1828,13 @@
suffixedexp(ls, &v.v);
if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */
v.prev = NULL;
- assignment(ls, &v, 1);
+ restassign(ls, &v, 1);
}
else { /* stat -> func */
+ Instruction *inst;
check_condition(ls, v.v.k == VCALL, "syntax error");
- SETARG_C(getinstruction(fs, &v.v), 1); /* call statement uses no results */
+ inst = &getinstruction(fs, &v.v);
+ SETARG_C(*inst, 1); /* call statement uses no results */
}
}
@@ -1505,26 +1843,25 @@
/* stat -> RETURN [explist] [';'] */
FuncState *fs = ls->fs;
expdesc e;
- int first, nret; /* registers with returned values */
+ int nret; /* number of values being returned */
+ int first = luaY_nvarstack(fs); /* first slot to be returned */
if (block_follow(ls, 1) || ls->t.token == ';')
- first = nret = 0; /* return no values */
+ nret = 0; /* return no values */
else {
nret = explist(ls, &e); /* optional return values */
if (hasmultret(e.k)) {
luaK_setmultret(fs, &e);
- if (e.k == VCALL && nret == 1) { /* tail call? */
+ if (e.k == VCALL && nret == 1 && !fs->bl->insidetbc) { /* tail call? */
SET_OPCODE(getinstruction(fs,&e), OP_TAILCALL);
- lua_assert(GETARG_A(getinstruction(fs,&e)) == fs->nactvar);
+ lua_assert(GETARG_A(getinstruction(fs,&e)) == luaY_nvarstack(fs));
}
- first = fs->nactvar;
nret = LUA_MULTRET; /* return all values */
}
else {
if (nret == 1) /* only one single value? */
- first = luaK_exp2anyreg(fs, &e);
- else {
- luaK_exp2nextreg(fs, &e); /* values must go to the stack */
- first = fs->nactvar; /* return all active values */
+ first = luaK_exp2anyreg(fs, &e); /* can use original slot */
+ else { /* values must go to the top of the stack */
+ luaK_exp2nextreg(fs, &e);
lua_assert(nret == fs->freereg - first);
}
}
@@ -1586,9 +1923,13 @@
retstat(ls);
break;
}
- case TK_BREAK: /* stat -> breakstat */
+ case TK_BREAK: { /* stat -> breakstat */
+ breakstat(ls);
+ break;
+ }
case TK_GOTO: { /* stat -> 'goto' NAME */
- gotostat(ls, luaK_jump(ls->fs));
+ luaX_next(ls); /* skip 'goto' */
+ gotostat(ls);
break;
}
default: { /* stat -> func | assignment */
@@ -1597,8 +1938,8 @@
}
}
lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&
- ls->fs->freereg >= ls->fs->nactvar);
- ls->fs->freereg = ls->fs->nactvar; /* free registers */
+ ls->fs->freereg >= luaY_nvarstack(ls->fs));
+ ls->fs->freereg = luaY_nvarstack(ls->fs); /* free registers */
leavelevel(ls);
}
@@ -1611,11 +1952,15 @@
*/
static void mainfunc (LexState *ls, FuncState *fs) {
BlockCnt bl;
- expdesc v;
+ Upvaldesc *env;
open_func(ls, fs, &bl);
- fs->f->is_vararg = 1; /* main function is always declared vararg */
- init_exp(&v, VLOCAL, 0); /* create and... */
- newupvalue(fs, ls->envn, &v); /* ...set environment upvalue */
+ setvararg(fs, 0); /* main function is always declared vararg */
+ env = allocupvalue(fs); /* ...set environment upvalue */
+ env->instack = 1;
+ env->idx = 0;
+ env->kind = VDKREG;
+ env->name = ls->envn;
+ luaC_objbarrier(ls->L, fs->f, env->name);
luaX_next(ls); /* read first token */
statlist(ls); /* parse main body */
check(ls, TK_EOS);
@@ -1628,14 +1973,15 @@
LexState lexstate;
FuncState funcstate;
LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */
- setclLvalue(L, L->top, cl); /* anchor it (to avoid being collected) */
+ setclLvalue2s(L, L->top, cl); /* anchor it (to avoid being collected) */
luaD_inctop(L);
lexstate.h = luaH_new(L); /* create table for scanner */
- sethvalue(L, L->top, lexstate.h); /* anchor it */
+ sethvalue2s(L, L->top, lexstate.h); /* anchor it */
luaD_inctop(L);
funcstate.f = cl->p = luaF_newproto(L);
+ luaC_objbarrier(L, cl, cl->p);
funcstate.f->source = luaS_new(L, name); /* create and anchor TString */
- lua_assert(iswhite(funcstate.f)); /* do not need barrier here */
+ luaC_objbarrier(L, funcstate.f, funcstate.f->source);
lexstate.buff = buff;
lexstate.dyd = dyd;
dyd->actvar.n = dyd->gt.n = dyd->label.n = 0;
diff --git a/src/lparser.h b/src/lparser.h
index f45b23c..618cb01 100644
--- a/src/lparser.h
+++ b/src/lparser.h
@@ -1,5 +1,5 @@
/*
-** $Id: lparser.h,v 1.76.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lparser.h $
** Lua Parser
** See Copyright Notice in lua.h
*/
@@ -30,56 +30,88 @@
VFALSE, /* constant false */
VK, /* constant in 'k'; info = index of constant in 'k' */
VKFLT, /* floating constant; nval = numerical float value */
- VKINT, /* integer constant; nval = numerical integer value */
+ VKINT, /* integer constant; ival = numerical integer value */
+ VKSTR, /* string constant; strval = TString address;
+ (string is fixed by the lexer) */
VNONRELOC, /* expression has its value in a fixed register;
info = result register */
- VLOCAL, /* local variable; info = local register */
+ VLOCAL, /* local variable; var.sidx = stack index (local register);
+ var.vidx = relative index in 'actvar.arr' */
VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */
+ VCONST, /* compile-time constant; info = absolute index in 'actvar.arr' */
VINDEXED, /* indexed variable;
- ind.vt = whether 't' is register or upvalue;
- ind.t = table register or upvalue;
- ind.idx = key's R/K index */
+ ind.t = table register;
+ ind.idx = key's R index */
+ VINDEXUP, /* indexed upvalue;
+ ind.t = table upvalue;
+ ind.idx = key's K index */
+ VINDEXI, /* indexed variable with constant integer;
+ ind.t = table register;
+ ind.idx = key's value */
+ VINDEXSTR, /* indexed variable with literal string;
+ ind.t = table register;
+ ind.idx = key's K index */
VJMP, /* expression is a test/comparison;
info = pc of corresponding jump instruction */
- VRELOCABLE, /* expression can put result in any register;
- info = instruction pc */
+ VRELOC, /* expression can put result in any register;
+ info = instruction pc */
VCALL, /* expression is a function call; info = instruction pc */
VVARARG /* vararg expression; info = instruction pc */
} expkind;
-#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXED)
-#define vkisinreg(k) ((k) == VNONRELOC || (k) == VLOCAL)
+#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXSTR)
+#define vkisindexed(k) (VINDEXED <= (k) && (k) <= VINDEXSTR)
+
typedef struct expdesc {
expkind k;
union {
lua_Integer ival; /* for VKINT */
lua_Number nval; /* for VKFLT */
+ TString *strval; /* for VKSTR */
int info; /* for generic use */
- struct { /* for indexed variables (VINDEXED) */
- short idx; /* index (R/K) */
+ struct { /* for indexed variables */
+ short idx; /* index (R or "long" K) */
lu_byte t; /* table (register or upvalue) */
- lu_byte vt; /* whether 't' is register (VLOCAL) or upvalue (VUPVAL) */
} ind;
+ struct { /* for local variables */
+ lu_byte sidx; /* index in the stack */
+ unsigned short vidx; /* compiler index (in 'actvar.arr') */
+ } var;
} u;
int t; /* patch list of 'exit when true' */
int f; /* patch list of 'exit when false' */
} expdesc;
-/* description of active local variable */
-typedef struct Vardesc {
- short idx; /* variable index in stack */
+/* kinds of variables */
+#define VDKREG 0 /* regular */
+#define RDKCONST 1 /* constant */
+#define RDKTOCLOSE 2 /* to-be-closed */
+#define RDKCTC 3 /* compile-time constant */
+
+/* description of an active local variable */
+typedef union Vardesc {
+ struct {
+ TValuefields; /* constant value (if it is a compile-time constant) */
+ lu_byte kind;
+ lu_byte sidx; /* index of the variable in the stack */
+ short pidx; /* index of the variable in the Proto's 'locvars' array */
+ TString *name; /* variable name */
+ } vd;
+ TValue k; /* constant value (if any) */
} Vardesc;
+
/* description of pending goto statements and label statements */
typedef struct Labeldesc {
TString *name; /* label identifier */
int pc; /* position in code */
int line; /* line where it appeared */
- lu_byte nactvar; /* local level where it appears in current block */
+ lu_byte nactvar; /* number of active variables in that position */
+ lu_byte close; /* goto that escapes upvalues */
} Labeldesc;
@@ -93,7 +125,7 @@
/* dynamic structures used by the parser */
typedef struct Dyndata {
- struct { /* list of active local variables */
+ struct { /* list of all active local variables */
Vardesc *arr;
int n;
int size;
@@ -115,17 +147,22 @@
struct BlockCnt *bl; /* chain of current blocks */
int pc; /* next position to code (equivalent to 'ncode') */
int lasttarget; /* 'label' of last 'jump label' */
- int jpc; /* list of pending jumps to 'pc' */
+ int previousline; /* last line that was saved in 'lineinfo' */
int nk; /* number of elements in 'k' */
int np; /* number of elements in 'p' */
+ int nabslineinfo; /* number of elements in 'abslineinfo' */
int firstlocal; /* index of first local var (in Dyndata array) */
- short nlocvars; /* number of elements in 'f->locvars' */
+ int firstlabel; /* index of first label (in 'dyd->label->arr') */
+ short ndebugvars; /* number of elements in 'f->locvars' */
lu_byte nactvar; /* number of active local variables */
lu_byte nups; /* number of upvalues */
lu_byte freereg; /* first free register */
+ lu_byte iwthabs; /* instructions issued since last absolute line info */
+ lu_byte needclose; /* function needs to close upvalues when returning */
} FuncState;
+LUAI_FUNC int luaY_nvarstack (FuncState *fs);
LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
Dyndata *dyd, const char *name, int firstchar);
diff --git a/src/lprefix.h b/src/lprefix.h
index 9a749a3..484f2ad 100644
--- a/src/lprefix.h
+++ b/src/lprefix.h
@@ -1,5 +1,5 @@
/*
-** $Id: lprefix.h,v 1.2.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lprefix.h $
** Definitions for Lua code that must come before any other header file
** See Copyright Notice in lua.h
*/
@@ -33,7 +33,7 @@
/*
** Windows stuff
*/
-#if defined(_WIN32) /* { */
+#if defined(_WIN32) /* { */
#if !defined(_CRT_SECURE_NO_WARNINGS)
#define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */
diff --git a/src/lstate.c b/src/lstate.c
index c1a7664..4434211 100644
--- a/src/lstate.c
+++ b/src/lstate.c
@@ -1,5 +1,5 @@
/*
-** $Id: lstate.c,v 2.133.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lstate.c $
** Global State
** See Copyright Notice in lua.h
*/
@@ -28,25 +28,6 @@
#include "ltm.h"
-#if !defined(LUAI_GCPAUSE)
-#define LUAI_GCPAUSE 200 /* 200% */
-#endif
-
-#if !defined(LUAI_GCMUL)
-#define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */
-#endif
-
-
-/*
-** a macro to help the creation of a unique random seed when a state is
-** created; the seed is used to randomize hashes.
-*/
-#if !defined(luai_makeseed)
-#include <time.h>
-#define luai_makeseed() cast(unsigned int, time(NULL))
-#endif
-
-
/*
** thread state + extra space
@@ -71,25 +52,35 @@
/*
-** Compute an initial seed as random as possible. Rely on Address Space
-** Layout Randomization (if present) to increase randomness..
+** A macro to create a "random" seed when a state is created;
+** the seed is used to randomize string hashes.
+*/
+#if !defined(luai_makeseed)
+
+#include <time.h>
+
+/*
+** Compute an initial seed with some level of randomness.
+** Rely on Address Space Layout Randomization (if present) and
+** current time.
*/
#define addbuff(b,p,e) \
- { size_t t = cast(size_t, e); \
+ { size_t t = cast_sizet(e); \
memcpy(b + p, &t, sizeof(t)); p += sizeof(t); }
-static unsigned int makeseed (lua_State *L) {
- char buff[4 * sizeof(size_t)];
- unsigned int h = luai_makeseed();
+static unsigned int luai_makeseed (lua_State *L) {
+ char buff[3 * sizeof(size_t)];
+ unsigned int h = cast_uint(time(NULL));
int p = 0;
addbuff(buff, p, L); /* heap variable */
addbuff(buff, p, &h); /* local variable */
- addbuff(buff, p, luaO_nilobject); /* global variable */
addbuff(buff, p, &lua_newstate); /* public function */
lua_assert(p == sizeof(buff));
- return luaS_hash(buff, p, h);
+ return luaS_hash(buff, p, h, 1);
}
+#endif
+
/*
** set GCdebt to a new value keeping the value (totalbytes + GCdebt)
@@ -105,12 +96,73 @@
}
+LUA_API int lua_setcstacklimit (lua_State *L, unsigned int limit) {
+ global_State *g = G(L);
+ int ccalls;
+ luaE_freeCI(L); /* release unused CIs */
+ ccalls = getCcalls(L);
+ if (limit >= 40000)
+ return 0; /* out of bounds */
+ limit += CSTACKERR;
+ if (L != g-> mainthread)
+ return 0; /* only main thread can change the C stack */
+ else if (ccalls <= CSTACKERR)
+ return 0; /* handling overflow */
+ else {
+ int diff = limit - g->Cstacklimit;
+ if (ccalls + diff <= CSTACKERR)
+ return 0; /* new limit would cause an overflow */
+ g->Cstacklimit = limit; /* set new limit */
+ L->nCcalls += diff; /* correct 'nCcalls' */
+ return limit - diff - CSTACKERR; /* success; return previous limit */
+ }
+}
+
+
+/*
+** Decrement count of "C calls" and check for overflows. In case of
+** a stack overflow, check appropriate error ("regular" overflow or
+** overflow while handling stack overflow). If 'nCcalls' is smaller
+** than CSTACKERR but larger than CSTACKMARK, it means it has just
+** entered the "overflow zone", so the function raises an overflow
+** error. If 'nCcalls' is smaller than CSTACKMARK (which means it is
+** already handling an overflow) but larger than CSTACKERRMARK, does
+** not report an error (to allow message handling to work). Otherwise,
+** report a stack overflow while handling a stack overflow (probably
+** caused by a repeating error in the message handling function).
+*/
+
+void luaE_enterCcall (lua_State *L) {
+ int ncalls = getCcalls(L);
+ L->nCcalls--;
+ if (ncalls <= CSTACKERR) { /* possible overflow? */
+ luaE_freeCI(L); /* release unused CIs */
+ ncalls = getCcalls(L); /* update call count */
+ if (ncalls <= CSTACKERR) { /* still overflow? */
+ if (ncalls <= CSTACKERRMARK) /* below error-handling zone? */
+ luaD_throw(L, LUA_ERRERR); /* error while handling stack error */
+ else if (ncalls >= CSTACKMARK) {
+ /* not in error-handling zone; raise the error now */
+ L->nCcalls = (CSTACKMARK - 1); /* enter error-handling zone */
+ luaG_runerror(L, "C stack overflow");
+ }
+ /* else stack is in the error-handling zone;
+ allow message handler to work */
+ }
+ }
+}
+
+
CallInfo *luaE_extendCI (lua_State *L) {
- CallInfo *ci = luaM_new(L, CallInfo);
+ CallInfo *ci;
+ lua_assert(L->ci->next == NULL);
+ luaE_enterCcall(L);
+ ci = luaM_new(L, CallInfo);
lua_assert(L->ci->next == NULL);
L->ci->next = ci;
ci->previous = L->ci;
ci->next = NULL;
+ ci->u.l.trap = 0;
L->nci++;
return ci;
}
@@ -123,46 +175,60 @@
CallInfo *ci = L->ci;
CallInfo *next = ci->next;
ci->next = NULL;
+ L->nCcalls += L->nci; /* add removed elements back to 'nCcalls' */
while ((ci = next) != NULL) {
next = ci->next;
luaM_free(L, ci);
L->nci--;
}
+ L->nCcalls -= L->nci; /* adjust result */
}
/*
-** free half of the CallInfo structures not in use by a thread
+** free half of the CallInfo structures not in use by a thread,
+** keeping the first one.
*/
void luaE_shrinkCI (lua_State *L) {
- CallInfo *ci = L->ci;
- CallInfo *next2; /* next's next */
- /* while there are two nexts */
- while (ci->next != NULL && (next2 = ci->next->next) != NULL) {
- luaM_free(L, ci->next); /* free next */
+ CallInfo *ci = L->ci->next; /* first free CallInfo */
+ CallInfo *next;
+ if (ci == NULL)
+ return; /* no extra elements */
+ L->nCcalls += L->nci; /* add removed elements back to 'nCcalls' */
+ while ((next = ci->next) != NULL) { /* two extra elements? */
+ CallInfo *next2 = next->next; /* next's next */
+ ci->next = next2; /* remove next from the list */
L->nci--;
- ci->next = next2; /* remove 'next' from the list */
- next2->previous = ci;
- ci = next2; /* keep next's next */
+ luaM_free(L, next); /* free next */
+ if (next2 == NULL)
+ break; /* no more elements */
+ else {
+ next2->previous = ci;
+ ci = next2; /* continue */
+ }
}
+ L->nCcalls -= L->nci; /* adjust result */
}
static void stack_init (lua_State *L1, lua_State *L) {
int i; CallInfo *ci;
/* initialize stack array */
- L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, TValue);
+ L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, StackValue);
L1->stacksize = BASIC_STACK_SIZE;
for (i = 0; i < BASIC_STACK_SIZE; i++)
- setnilvalue(L1->stack + i); /* erase new stack */
+ setnilvalue(s2v(L1->stack + i)); /* erase new stack */
L1->top = L1->stack;
L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK;
/* initialize first ci */
ci = &L1->base_ci;
ci->next = ci->previous = NULL;
- ci->callstatus = 0;
+ ci->callstatus = CIST_C;
ci->func = L1->top;
- setnilvalue(L1->top++); /* 'function' entry for this 'ci' */
+ ci->u.c.k = NULL;
+ ci->nresults = 0;
+ setnilvalue(s2v(L1->top)); /* 'function' entry for this 'ci' */
+ L1->top++;
ci->top = L1->top + LUA_MINSTACK;
L1->ci = ci;
}
@@ -198,7 +264,8 @@
/*
** open parts of the state that may cause memory-allocation errors.
-** ('g->version' != NULL flags that the state was completely build)
+** ('g->nilvalue' being a nil value flags that the state was completely
+** build.)
*/
static void f_luaopen (lua_State *L, void *ud) {
global_State *g = G(L);
@@ -209,7 +276,7 @@
luaT_init(L);
luaX_init(L);
g->gcrunning = 1; /* allow gc */
- g->version = lua_version(NULL);
+ setnilvalue(&g->nilvalue);
luai_userstateopen(L);
}
@@ -226,14 +293,12 @@
L->stacksize = 0;
L->twups = L; /* thread has no upvalues */
L->errorJmp = NULL;
- L->nCcalls = 0;
L->hook = NULL;
L->hookmask = 0;
L->basehookcount = 0;
L->allowhook = 1;
resethookcount(L);
L->openupval = NULL;
- L->nny = 1;
L->status = LUA_OK;
L->errfunc = 0;
}
@@ -241,9 +306,9 @@
static void close_state (lua_State *L) {
global_State *g = G(L);
- luaF_close(L, L->stack); /* close all upvalues for this thread */
+ luaF_close(L, L->stack, CLOSEPROTECT); /* close all upvalues */
luaC_freeallobjects(L); /* collect all objects */
- if (g->version) /* closing a fully built state? */
+ if (ttisnil(&g->nilvalue)) /* closing a fully built state? */
luai_userstateclose(L);
luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size);
freestack(L);
@@ -260,14 +325,15 @@
/* create new thread */
L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;
L1->marked = luaC_white(g);
- L1->tt = LUA_TTHREAD;
+ L1->tt = LUA_VTHREAD;
/* link it on list 'allgc' */
L1->next = g->allgc;
g->allgc = obj2gco(L1);
/* anchor it on L stack */
- setthvalue(L, L->top, L1);
+ setthvalue2s(L, L->top, L1);
api_incr_top(L);
preinit_thread(L1, g);
+ L1->nCcalls = getCcalls(L);
L1->hookmask = L->hookmask;
L1->basehookcount = L->basehookcount;
L1->hook = L->hook;
@@ -284,7 +350,7 @@
void luaE_freethread (lua_State *L, lua_State *L1) {
LX *l = fromstate(L1);
- luaF_close(L1, L1->stack); /* close all upvalues for this thread */
+ luaF_close(L1, L1->stack, NOCLOSINGMETH); /* close all upvalues */
lua_assert(L1->openupval == NULL);
luai_userstatefree(L, L1);
freestack(L1);
@@ -292,6 +358,28 @@
}
+int lua_resetthread (lua_State *L) {
+ CallInfo *ci;
+ int status;
+ lua_lock(L);
+ L->ci = ci = &L->base_ci; /* unwind CallInfo list */
+ setnilvalue(s2v(L->stack)); /* 'function' entry for basic 'ci' */
+ ci->func = L->stack;
+ ci->callstatus = CIST_C;
+ status = luaF_close(L, L->stack, CLOSEPROTECT);
+ if (status != CLOSEPROTECT) /* real errors? */
+ luaD_seterrorobj(L, status, L->stack + 1);
+ else {
+ status = LUA_OK;
+ L->top = L->stack + 1;
+ }
+ ci->top = L->top + LUA_MINSTACK;
+ L->status = status;
+ lua_unlock(L);
+ return status;
+}
+
+
LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
int i;
lua_State *L;
@@ -300,34 +388,43 @@
if (l == NULL) return NULL;
L = &l->l.l;
g = &l->g;
- L->next = NULL;
- L->tt = LUA_TTHREAD;
+ L->tt = LUA_VTHREAD;
g->currentwhite = bitmask(WHITE0BIT);
L->marked = luaC_white(g);
preinit_thread(L, g);
+ g->allgc = obj2gco(L); /* by now, only object is the main thread */
+ L->next = NULL;
+ g->Cstacklimit = L->nCcalls = LUAI_MAXCSTACK + CSTACKERR;
g->frealloc = f;
g->ud = ud;
+ g->warnf = NULL;
+ g->ud_warn = NULL;
g->mainthread = L;
- g->seed = makeseed(L);
+ g->seed = luai_makeseed(L);
g->gcrunning = 0; /* no GC while building state */
- g->GCestimate = 0;
g->strt.size = g->strt.nuse = 0;
g->strt.hash = NULL;
setnilvalue(&g->l_registry);
g->panic = NULL;
- g->version = NULL;
g->gcstate = GCSpause;
- g->gckind = KGC_NORMAL;
- g->allgc = g->finobj = g->tobefnz = g->fixedgc = NULL;
+ g->gckind = KGC_INC;
+ g->gcemergency = 0;
+ g->finobj = g->tobefnz = g->fixedgc = NULL;
+ g->survival = g->old = g->reallyold = NULL;
+ g->finobjsur = g->finobjold = g->finobjrold = NULL;
g->sweepgc = NULL;
g->gray = g->grayagain = NULL;
g->weak = g->ephemeron = g->allweak = NULL;
g->twups = NULL;
g->totalbytes = sizeof(LG);
g->GCdebt = 0;
- g->gcfinnum = 0;
- g->gcpause = LUAI_GCPAUSE;
- g->gcstepmul = LUAI_GCMUL;
+ g->lastatomic = 0;
+ setivalue(&g->nilvalue, 0); /* to signal that state is not yet built */
+ setgcparam(g->gcpause, LUAI_GCPAUSE);
+ setgcparam(g->gcstepmul, LUAI_GCMUL);
+ g->gcstepsize = LUAI_GCSTEPSIZE;
+ setgcparam(g->genmajormul, LUAI_GENMAJORMUL);
+ g->genminormul = LUAI_GENMINORMUL;
for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;
if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
/* memory allocation error: free partial state */
@@ -345,3 +442,26 @@
}
+void luaE_warning (lua_State *L, const char *msg, int tocont) {
+ lua_WarnFunction wf = G(L)->warnf;
+ if (wf != NULL)
+ wf(G(L)->ud_warn, msg, tocont);
+}
+
+
+/*
+** Generate a warning from an error message
+*/
+void luaE_warnerror (lua_State *L, const char *where) {
+ TValue *errobj = s2v(L->top - 1); /* error object */
+ const char *msg = (ttisstring(errobj))
+ ? svalue(errobj)
+ : "error object is not a string";
+ /* produce warning "error in %s (%s)" (where, msg) */
+ luaE_warning(L, "error in ", 1);
+ luaE_warning(L, where, 1);
+ luaE_warning(L, " (", 1);
+ luaE_warning(L, msg, 1);
+ luaE_warning(L, ")", 0);
+}
+
diff --git a/src/lstate.h b/src/lstate.h
index 56b3741..2e8bd6c 100644
--- a/src/lstate.h
+++ b/src/lstate.h
@@ -1,5 +1,5 @@
/*
-** $Id: lstate.h,v 2.133.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lstate.h $
** Global State
** See Copyright Notice in lua.h
*/
@@ -15,7 +15,6 @@
/*
-
** Some notes about garbage-collected objects: All objects in Lua must
** be kept somehow accessible until being freed, so all objects always
** belong to one (and only one) of these lists, using field 'next' of
@@ -27,6 +26,22 @@
** 'fixedgc': all objects that are not to be collected (currently
** only small strings, such as reserved words).
**
+** For the generational collector, some of these lists have marks for
+** generations. Each mark points to the first element in the list for
+** that particular generation; that generation goes until the next mark.
+**
+** 'allgc' -> 'survival': new objects;
+** 'survival' -> 'old': objects that survived one collection;
+** 'old' -> 'reallyold': objects that became old in last collection;
+** 'reallyold' -> NULL: objects old for more than one cycle.
+**
+** 'finobj' -> 'finobjsur': new objects marked for finalization;
+** 'finobjsur' -> 'finobjold': survived """";
+** 'finobjold' -> 'finobjrold': just old """";
+** 'finobjrold' -> NULL: really old """".
+*/
+
+/*
** Moreover, there is another set of lists that control gray objects.
** These lists are linked by fields 'gclist'. (All objects that
** can become gray have such a field. The field is not the same
@@ -43,11 +58,79 @@
** 'weak': tables with weak values to be cleared;
** 'ephemeron': ephemeron tables with white->white entries;
** 'allweak': tables with weak keys and/or weak values to be cleared.
-** The last three lists are used only during the atomic phase.
-
*/
+
+/*
+** About 'nCcalls': each thread in Lua (a lua_State) keeps a count of
+** how many "C calls" it still can do in the C stack, to avoid C-stack
+** overflow. This count is very rough approximation; it considers only
+** recursive functions inside the interpreter, as non-recursive calls
+** can be considered using a fixed (although unknown) amount of stack
+** space.
+**
+** The count has two parts: the lower part is the count itself; the
+** higher part counts the number of non-yieldable calls in the stack.
+** (They are together so that we can change both with one instruction.)
+**
+** Because calls to external C functions can use an unknown amount
+** of space (e.g., functions using an auxiliary buffer), calls
+** to these functions add more than one to the count (see CSTACKCF).
+**
+** The proper count excludes the number of CallInfo structures allocated
+** by Lua, as a kind of "potential" calls. So, when Lua calls a function
+** (and "consumes" one CallInfo), it needs neither to decrement nor to
+** check 'nCcalls', as its use of C stack is already accounted for.
+*/
+
+/* number of "C stack slots" used by an external C function */
+#define CSTACKCF 10
+
+
+/*
+** The C-stack size is sliced in the following zones:
+** - larger than CSTACKERR: normal stack;
+** - [CSTACKMARK, CSTACKERR]: buffer zone to signal a stack overflow;
+** - [CSTACKCF, CSTACKERRMARK]: error-handling zone;
+** - below CSTACKERRMARK: buffer zone to signal overflow during overflow;
+** (Because the counter can be decremented CSTACKCF at once, we need
+** the so called "buffer zones", with at least that size, to properly
+** detect a change from one zone to the next.)
+*/
+#define CSTACKERR (8 * CSTACKCF)
+#define CSTACKMARK (CSTACKERR - (CSTACKCF + 2))
+#define CSTACKERRMARK (CSTACKCF + 2)
+
+
+/* initial limit for the C-stack of threads */
+#define CSTACKTHREAD (2 * CSTACKERR)
+
+
+/* true if this thread does not have non-yieldable calls in the stack */
+#define yieldable(L) (((L)->nCcalls & 0xffff0000) == 0)
+
+/* real number of C calls */
+#define getCcalls(L) ((L)->nCcalls & 0xffff)
+
+
+/* Increment the number of non-yieldable calls */
+#define incnny(L) ((L)->nCcalls += 0x10000)
+
+/* Decrement the number of non-yieldable calls */
+#define decnny(L) ((L)->nCcalls -= 0x10000)
+
+/* Increment the number of non-yieldable calls and decrement nCcalls */
+#define incXCcalls(L) ((L)->nCcalls += 0x10000 - CSTACKCF)
+
+/* Decrement the number of non-yieldable calls and increment nCcalls */
+#define decXCcalls(L) ((L)->nCcalls -= 0x10000 - CSTACKCF)
+
+
+
+
+
+
struct lua_longjmp; /* defined in ldo.c */
@@ -69,8 +152,8 @@
/* kinds of Garbage Collection */
-#define KGC_NORMAL 0
-#define KGC_EMERGENCY 1 /* gc was forced by an allocation failure */
+#define KGC_INC 0 /* incremental gc */
+#define KGC_GEN 1 /* generational gc */
typedef struct stringtable {
@@ -82,12 +165,6 @@
/*
** Information about a call.
-** When a thread yields, 'func' is adjusted to pretend that the
-** top function has only the yielded values in its stack; in that
-** case, the actual 'func' value is saved in field 'extra'.
-** When a function calls another with a continuation, 'extra' keeps
-** the function index so that, in case of errors, the continuation
-** function can be called with the correct top.
*/
typedef struct CallInfo {
StkId func; /* function index in the stack */
@@ -95,8 +172,9 @@
struct CallInfo *previous, *next; /* dynamic call link */
union {
struct { /* only for Lua functions */
- StkId base; /* base for this function */
const Instruction *savedpc;
+ volatile l_signalT trap;
+ int nextraargs; /* # of extra arguments in vararg functions */
} l;
struct { /* only for C functions */
lua_KFunction k; /* continuation in case of yields */
@@ -104,7 +182,14 @@
lua_KContext ctx; /* context info. in case of yields */
} c;
} u;
- ptrdiff_t extra;
+ union {
+ int funcidx; /* called-function index */
+ int nyield; /* number of values yielded */
+ struct { /* info about transferred values (for call/return hooks) */
+ unsigned short ftransfer; /* offset of first value transferred */
+ unsigned short ntransfer; /* number of values transferred */
+ } transferinfo;
+ } u2;
short nresults; /* expected number of results from this function */
unsigned short callstatus;
} CallInfo;
@@ -114,17 +199,22 @@
** Bits in CallInfo status
*/
#define CIST_OAH (1<<0) /* original value of 'allowhook' */
-#define CIST_LUA (1<<1) /* call is running a Lua function */
+#define CIST_C (1<<1) /* call is running a C function */
#define CIST_HOOKED (1<<2) /* call is running a debug hook */
-#define CIST_FRESH (1<<3) /* call is running on a fresh invocation
- of luaV_execute */
-#define CIST_YPCALL (1<<4) /* call is a yieldable protected call */
-#define CIST_TAIL (1<<5) /* call was tail called */
-#define CIST_HOOKYIELD (1<<6) /* last hook called yielded */
-#define CIST_LEQ (1<<7) /* using __lt for __le */
-#define CIST_FIN (1<<8) /* call is running a finalizer */
+#define CIST_YPCALL (1<<3) /* call is a yieldable protected call */
+#define CIST_TAIL (1<<4) /* call was tail called */
+#define CIST_HOOKYIELD (1<<5) /* last hook called yielded */
+#define CIST_FIN (1<<6) /* call is running a finalizer */
+#define CIST_TRAN (1<<7) /* 'ci' has transfer information */
+#if defined(LUA_COMPAT_LT_LE)
+#define CIST_LEQ (1<<8) /* using __lt for __le */
+#endif
-#define isLua(ci) ((ci)->callstatus & CIST_LUA)
+/* active function is a Lua function */
+#define isLua(ci) (!((ci)->callstatus & CIST_C))
+
+/* call is running Lua code (not a hook) */
+#define isLuacode(ci) (!((ci)->callstatus & (CIST_C | CIST_HOOKED)))
/* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */
#define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v))
@@ -139,15 +229,22 @@
void *ud; /* auxiliary data to 'frealloc' */
l_mem totalbytes; /* number of bytes currently allocated - GCdebt */
l_mem GCdebt; /* bytes allocated not yet compensated by the collector */
- lu_mem GCmemtrav; /* memory traversed by the GC */
lu_mem GCestimate; /* an estimate of the non-garbage memory in use */
+ lu_mem lastatomic; /* see function 'genstep' in file 'lgc.c' */
stringtable strt; /* hash table for strings */
TValue l_registry;
+ TValue nilvalue; /* a nil value */
unsigned int seed; /* randomized seed for hashes */
lu_byte currentwhite;
lu_byte gcstate; /* state of garbage collector */
lu_byte gckind; /* kind of GC running */
+ lu_byte genminormul; /* control for minor generational collections */
+ lu_byte genmajormul; /* control for major generational collections */
lu_byte gcrunning; /* true if GC is running */
+ lu_byte gcemergency; /* true if this is an emergency collection */
+ lu_byte gcpause; /* size of pause between successive GCs */
+ lu_byte gcstepmul; /* GC "speed" */
+ lu_byte gcstepsize; /* (log2 of) GC granularity */
GCObject *allgc; /* list of all collectable objects */
GCObject **sweepgc; /* current position of sweep in list */
GCObject *finobj; /* list of collectable objects with finalizers */
@@ -158,17 +255,23 @@
GCObject *allweak; /* list of all-weak tables */
GCObject *tobefnz; /* list of userdata to be GC */
GCObject *fixedgc; /* list of objects not to be collected */
+ /* fields for generational collector */
+ GCObject *survival; /* start of objects that survived one GC cycle */
+ GCObject *old; /* start of old objects */
+ GCObject *reallyold; /* old objects with more than one cycle */
+ GCObject *finobjsur; /* list of survival objects with finalizers */
+ GCObject *finobjold; /* list of old objects with finalizers */
+ GCObject *finobjrold; /* list of really old objects with finalizers */
struct lua_State *twups; /* list of threads with open upvalues */
- unsigned int gcfinnum; /* number of finalizers to call in each GC step */
- int gcpause; /* size of pause between successive GCs */
- int gcstepmul; /* GC 'granularity' */
lua_CFunction panic; /* to be called in unprotected errors */
struct lua_State *mainthread;
- const lua_Number *version; /* pointer to version number */
- TString *memerrmsg; /* memory-error message */
+ TString *memerrmsg; /* message for memory-allocation errors */
TString *tmname[TM_N]; /* array with tag-method names */
struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */
TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */
+ lua_WarnFunction warnf; /* warning function */
+ void *ud_warn; /* auxiliary data to 'warnf' */
+ unsigned int Cstacklimit; /* current limit for the C stack */
} global_State;
@@ -177,8 +280,9 @@
*/
struct lua_State {
CommonHeader;
- unsigned short nci; /* number of items in 'ci' list */
lu_byte status;
+ lu_byte allowhook;
+ unsigned short nci; /* number of items in 'ci' list */
StkId top; /* first free slot in the stack */
global_State *l_G;
CallInfo *ci; /* call info for current function */
@@ -192,13 +296,11 @@
CallInfo base_ci; /* CallInfo for first level (C calling Lua) */
volatile lua_Hook hook;
ptrdiff_t errfunc; /* current error handling function (stack index) */
+ l_uint32 nCcalls; /* number of allowed nested C calls - 'nci' */
int stacksize;
int basehookcount;
int hookcount;
- unsigned short nny; /* number of non-yieldable calls in stack */
- unsigned short nCcalls; /* number of nested C calls */
- l_signalT hookmask;
- lu_byte allowhook;
+ volatile l_signalT hookmask;
};
@@ -216,6 +318,7 @@
struct Table h;
struct Proto p;
struct lua_State th; /* thread */
+ struct UpVal upv;
};
@@ -224,19 +327,22 @@
/* macros to convert a GCObject into a specific value */
#define gco2ts(o) \
check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts))
-#define gco2u(o) check_exp((o)->tt == LUA_TUSERDATA, &((cast_u(o))->u))
-#define gco2lcl(o) check_exp((o)->tt == LUA_TLCL, &((cast_u(o))->cl.l))
-#define gco2ccl(o) check_exp((o)->tt == LUA_TCCL, &((cast_u(o))->cl.c))
+#define gco2u(o) check_exp((o)->tt == LUA_VUSERDATA, &((cast_u(o))->u))
+#define gco2lcl(o) check_exp((o)->tt == LUA_VLCL, &((cast_u(o))->cl.l))
+#define gco2ccl(o) check_exp((o)->tt == LUA_VCCL, &((cast_u(o))->cl.c))
#define gco2cl(o) \
check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl))
-#define gco2t(o) check_exp((o)->tt == LUA_TTABLE, &((cast_u(o))->h))
-#define gco2p(o) check_exp((o)->tt == LUA_TPROTO, &((cast_u(o))->p))
-#define gco2th(o) check_exp((o)->tt == LUA_TTHREAD, &((cast_u(o))->th))
+#define gco2t(o) check_exp((o)->tt == LUA_VTABLE, &((cast_u(o))->h))
+#define gco2p(o) check_exp((o)->tt == LUA_VPROTO, &((cast_u(o))->p))
+#define gco2th(o) check_exp((o)->tt == LUA_VTHREAD, &((cast_u(o))->th))
+#define gco2upv(o) check_exp((o)->tt == LUA_VUPVAL, &((cast_u(o))->upv))
-/* macro to convert a Lua object into a GCObject */
-#define obj2gco(v) \
- check_exp(novariant((v)->tt) < LUA_TDEADKEY, (&(cast_u(v)->gc)))
+/*
+** macro to convert a Lua object into a GCObject
+** (The access to 'tt' tries to ensure that 'v' is actually a Lua object.)
+*/
+#define obj2gco(v) check_exp((v)->tt >= LUA_TSTRING, &(cast_u(v)->gc))
/* actual number of total bytes allocated */
@@ -247,7 +353,12 @@
LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);
LUAI_FUNC void luaE_freeCI (lua_State *L);
LUAI_FUNC void luaE_shrinkCI (lua_State *L);
+LUAI_FUNC void luaE_enterCcall (lua_State *L);
+LUAI_FUNC void luaE_warning (lua_State *L, const char *msg, int tocont);
+LUAI_FUNC void luaE_warnerror (lua_State *L, const char *where);
+#define luaE_exitCcall(L) ((L)->nCcalls++)
+
#endif
diff --git a/src/lstring.c b/src/lstring.c
index 6257f21..6f15747 100644
--- a/src/lstring.c
+++ b/src/lstring.c
@@ -1,5 +1,5 @@
/*
-** $Id: lstring.c,v 2.56.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lstring.c $
** String table (keeps all strings handled by Lua)
** See Copyright Notice in lua.h
*/
@@ -22,11 +22,8 @@
#include "lstring.h"
-#define MEMERRMSG "not enough memory"
-
-
/*
-** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a string to
+** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a long string to
** compute its hash
*/
#if !defined(LUAI_HASHLIMIT)
@@ -34,21 +31,28 @@
#endif
+
+/*
+** Maximum size for string table.
+*/
+#define MAXSTRTB cast_int(luaM_limitN(MAX_INT, TString*))
+
+
/*
** equality for long strings
*/
int luaS_eqlngstr (TString *a, TString *b) {
size_t len = a->u.lnglen;
- lua_assert(a->tt == LUA_TLNGSTR && b->tt == LUA_TLNGSTR);
+ lua_assert(a->tt == LUA_VLNGSTR && b->tt == LUA_VLNGSTR);
return (a == b) || /* same instance or... */
((len == b->u.lnglen) && /* equal length and ... */
(memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */
}
-unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) {
- unsigned int h = seed ^ cast(unsigned int, l);
- size_t step = (l >> LUAI_HASHLIMIT) + 1;
+unsigned int luaS_hash (const char *str, size_t l, unsigned int seed,
+ size_t step) {
+ unsigned int h = seed ^ cast_uint(l);
for (; l >= step; l -= step)
h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
return h;
@@ -56,43 +60,58 @@
unsigned int luaS_hashlongstr (TString *ts) {
- lua_assert(ts->tt == LUA_TLNGSTR);
+ lua_assert(ts->tt == LUA_VLNGSTR);
if (ts->extra == 0) { /* no hash? */
- ts->hash = luaS_hash(getstr(ts), ts->u.lnglen, ts->hash);
+ size_t len = ts->u.lnglen;
+ size_t step = (len >> LUAI_HASHLIMIT) + 1;
+ ts->hash = luaS_hash(getstr(ts), len, ts->hash, step);
ts->extra = 1; /* now it has its hash */
}
return ts->hash;
}
-/*
-** resizes the string table
-*/
-void luaS_resize (lua_State *L, int newsize) {
+static void tablerehash (TString **vect, int osize, int nsize) {
int i;
- stringtable *tb = &G(L)->strt;
- if (newsize > tb->size) { /* grow table if needed */
- luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *);
- for (i = tb->size; i < newsize; i++)
- tb->hash[i] = NULL;
- }
- for (i = 0; i < tb->size; i++) { /* rehash */
- TString *p = tb->hash[i];
- tb->hash[i] = NULL;
- while (p) { /* for each node in the list */
+ for (i = osize; i < nsize; i++) /* clear new elements */
+ vect[i] = NULL;
+ for (i = 0; i < osize; i++) { /* rehash old part of the array */
+ TString *p = vect[i];
+ vect[i] = NULL;
+ while (p) { /* for each string in the list */
TString *hnext = p->u.hnext; /* save next */
- unsigned int h = lmod(p->hash, newsize); /* new position */
- p->u.hnext = tb->hash[h]; /* chain it */
- tb->hash[h] = p;
+ unsigned int h = lmod(p->hash, nsize); /* new position */
+ p->u.hnext = vect[h]; /* chain it into array */
+ vect[h] = p;
p = hnext;
}
}
- if (newsize < tb->size) { /* shrink table if needed */
- /* vanishing slice should be empty */
- lua_assert(tb->hash[newsize] == NULL && tb->hash[tb->size - 1] == NULL);
- luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *);
+}
+
+
+/*
+** Resize the string table. If allocation fails, keep the current size.
+** (This can degrade performance, but any non-zero size should work
+** correctly.)
+*/
+void luaS_resize (lua_State *L, int nsize) {
+ stringtable *tb = &G(L)->strt;
+ int osize = tb->size;
+ TString **newvect;
+ if (nsize < osize) /* shrinking table? */
+ tablerehash(tb->hash, osize, nsize); /* depopulate shrinking part */
+ newvect = luaM_reallocvector(L, tb->hash, osize, nsize, TString*);
+ if (unlikely(newvect == NULL)) { /* reallocation failed? */
+ if (nsize < osize) /* was it shrinking table? */
+ tablerehash(tb->hash, nsize, osize); /* restore to original size */
+ /* leave table as it was */
}
- tb->size = newsize;
+ else { /* allocation succeeded */
+ tb->hash = newvect;
+ tb->size = nsize;
+ if (nsize > osize)
+ tablerehash(newvect, osize, nsize); /* rehash for new size */
+ }
}
@@ -104,8 +123,8 @@
int i, j;
for (i = 0; i < STRCACHE_N; i++)
for (j = 0; j < STRCACHE_M; j++) {
- if (iswhite(g->strcache[i][j])) /* will entry be collected? */
- g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
+ if (iswhite(g->strcache[i][j])) /* will entry be collected? */
+ g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
}
}
@@ -116,7 +135,10 @@
void luaS_init (lua_State *L) {
global_State *g = G(L);
int i, j;
- luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */
+ stringtable *tb = &G(L)->strt;
+ tb->hash = luaM_newvector(L, MINSTRTABSIZE, TString*);
+ tablerehash(tb->hash, 0, MINSTRTABSIZE); /* clear array */
+ tb->size = MINSTRTABSIZE;
/* pre-create memory-error message */
g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */
@@ -145,7 +167,7 @@
TString *luaS_createlngstrobj (lua_State *L, size_t l) {
- TString *ts = createstrobj(L, l, LUA_TLNGSTR, G(L)->seed);
+ TString *ts = createstrobj(L, l, LUA_VLNGSTR, G(L)->seed);
ts->u.lnglen = l;
return ts;
}
@@ -161,34 +183,46 @@
}
+static void growstrtab (lua_State *L, stringtable *tb) {
+ if (unlikely(tb->nuse == MAX_INT)) { /* too many strings? */
+ luaC_fullgc(L, 1); /* try to free some... */
+ if (tb->nuse == MAX_INT) /* still too many? */
+ luaM_error(L); /* cannot even create a message... */
+ }
+ if (tb->size <= MAXSTRTB / 2) /* can grow string table? */
+ luaS_resize(L, tb->size * 2);
+}
+
+
/*
-** checks whether short string exists and reuses it or creates a new one
+** Checks whether short string exists and reuses it or creates a new one.
*/
static TString *internshrstr (lua_State *L, const char *str, size_t l) {
TString *ts;
global_State *g = G(L);
- unsigned int h = luaS_hash(str, l, g->seed);
- TString **list = &g->strt.hash[lmod(h, g->strt.size)];
+ stringtable *tb = &g->strt;
+ unsigned int h = luaS_hash(str, l, g->seed, 1);
+ TString **list = &tb->hash[lmod(h, tb->size)];
lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */
for (ts = *list; ts != NULL; ts = ts->u.hnext) {
- if (l == ts->shrlen &&
- (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {
+ if (l == ts->shrlen && (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {
/* found! */
if (isdead(g, ts)) /* dead (but not collected yet)? */
changewhite(ts); /* resurrect it */
return ts;
}
}
- if (g->strt.nuse >= g->strt.size && g->strt.size <= MAX_INT/2) {
- luaS_resize(L, g->strt.size * 2);
- list = &g->strt.hash[lmod(h, g->strt.size)]; /* recompute with new size */
+ /* else must create a new string */
+ if (tb->nuse >= tb->size) { /* need to grow string table? */
+ growstrtab(L, tb);
+ list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */
}
- ts = createstrobj(L, l, LUA_TSHRSTR, h);
+ ts = createstrobj(L, l, LUA_VSHRSTR, h);
memcpy(getstr(ts), str, l * sizeof(char));
ts->shrlen = cast_byte(l);
ts->u.hnext = *list;
*list = ts;
- g->strt.nuse++;
+ tb->nuse++;
return ts;
}
@@ -201,7 +235,7 @@
return internshrstr(L, str, l);
else {
TString *ts;
- if (l >= (MAX_SIZE - sizeof(TString))/sizeof(char))
+ if (unlikely(l >= (MAX_SIZE - sizeof(TString))/sizeof(char)))
luaM_toobig(L);
ts = luaS_createlngstrobj(L, l);
memcpy(getstr(ts), str, l * sizeof(char));
@@ -233,16 +267,19 @@
}
-Udata *luaS_newudata (lua_State *L, size_t s) {
+Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) {
Udata *u;
+ int i;
GCObject *o;
- if (s > MAX_SIZE - sizeof(Udata))
+ if (unlikely(s > MAX_SIZE - udatamemoffset(nuvalue)))
luaM_toobig(L);
- o = luaC_newobj(L, LUA_TUSERDATA, sizeludata(s));
+ o = luaC_newobj(L, LUA_VUSERDATA, sizeudata(nuvalue, s));
u = gco2u(o);
u->len = s;
+ u->nuvalue = nuvalue;
u->metatable = NULL;
- setuservalue(L, u, luaO_nilobject);
+ for (i = 0; i < nuvalue; i++)
+ setnilvalue(&u->uv[i].uv);
return u;
}
diff --git a/src/lstring.h b/src/lstring.h
index d612abd..a413a9d 100644
--- a/src/lstring.h
+++ b/src/lstring.h
@@ -1,5 +1,5 @@
/*
-** $Id: lstring.h,v 1.61.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lstring.h $
** String table (keep all strings handled by Lua)
** See Copyright Notice in lua.h
*/
@@ -12,10 +12,18 @@
#include "lstate.h"
-#define sizelstring(l) (sizeof(union UTString) + ((l) + 1) * sizeof(char))
+/*
+** Memory-allocation error message must be preallocated (it cannot
+** be created after memory is exhausted)
+*/
+#define MEMERRMSG "not enough memory"
-#define sizeludata(l) (sizeof(union UUdata) + (l))
-#define sizeudata(u) sizeludata((u)->len)
+
+/*
+** Size of a TString: Size of the header plus space for the string
+** itself (including final '\0').
+*/
+#define sizelstring(l) (offsetof(TString, contents) + ((l) + 1) * sizeof(char))
#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \
(sizeof(s)/sizeof(char))-1))
@@ -24,23 +32,24 @@
/*
** test whether a string is a reserved word
*/
-#define isreserved(s) ((s)->tt == LUA_TSHRSTR && (s)->extra > 0)
+#define isreserved(s) ((s)->tt == LUA_VSHRSTR && (s)->extra > 0)
/*
** equality for short strings, which are always internalized
*/
-#define eqshrstr(a,b) check_exp((a)->tt == LUA_TSHRSTR, (a) == (b))
+#define eqshrstr(a,b) check_exp((a)->tt == LUA_VSHRSTR, (a) == (b))
-LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l, unsigned int seed);
+LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l,
+ unsigned int seed, size_t step);
LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts);
LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b);
LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
LUAI_FUNC void luaS_clearcache (global_State *g);
LUAI_FUNC void luaS_init (lua_State *L);
LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);
-LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s);
+LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue);
LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);
diff --git a/src/lstrlib.c b/src/lstrlib.c
index b4bed7e..2ba8bde 100644
--- a/src/lstrlib.c
+++ b/src/lstrlib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lstrlib.c,v 1.254.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: lstrlib.c $
** Standard library for string operations and pattern-matching
** See Copyright Notice in lua.h
*/
@@ -14,6 +14,7 @@
#include <float.h>
#include <limits.h>
#include <locale.h>
+#include <math.h>
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
@@ -59,23 +60,50 @@
}
-/* translate a relative string position: negative means back from end */
-static lua_Integer posrelat (lua_Integer pos, size_t len) {
- if (pos >= 0) return pos;
- else if (0u - (size_t)pos > len) return 0;
- else return (lua_Integer)len + pos + 1;
+/*
+** translate a relative initial string position
+** (negative means back from end): clip result to [1, inf).
+** The length of any string in Lua must fit in a lua_Integer,
+** so there are no overflows in the casts.
+** The inverted comparison avoids a possible overflow
+** computing '-pos'.
+*/
+static size_t posrelatI (lua_Integer pos, size_t len) {
+ if (pos > 0)
+ return (size_t)pos;
+ else if (pos == 0)
+ return 1;
+ else if (pos < -(lua_Integer)len) /* inverted comparison */
+ return 1; /* clip to 1 */
+ else return len + (size_t)pos + 1;
+}
+
+
+/*
+** Gets an optional ending string position from argument 'arg',
+** with default value 'def'.
+** Negative means back from end: clip result to [0, len]
+*/
+static size_t getendpos (lua_State *L, int arg, lua_Integer def,
+ size_t len) {
+ lua_Integer pos = luaL_optinteger(L, arg, def);
+ if (pos > (lua_Integer)len)
+ return len;
+ else if (pos >= 0)
+ return (size_t)pos;
+ else if (pos < -(lua_Integer)len)
+ return 0;
+ else return len + (size_t)pos + 1;
}
static int str_sub (lua_State *L) {
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
- lua_Integer start = posrelat(luaL_checkinteger(L, 2), l);
- lua_Integer end = posrelat(luaL_optinteger(L, 3, -1), l);
- if (start < 1) start = 1;
- if (end > (lua_Integer)l) end = l;
+ size_t start = posrelatI(luaL_checkinteger(L, 2), l);
+ size_t end = getendpos(L, 3, -1, l);
if (start <= end)
- lua_pushlstring(L, s + start - 1, (size_t)(end - start) + 1);
+ lua_pushlstring(L, s + start - 1, (end - start) + 1);
else lua_pushliteral(L, "");
return 1;
}
@@ -148,13 +176,12 @@
static int str_byte (lua_State *L) {
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
- lua_Integer posi = posrelat(luaL_optinteger(L, 2, 1), l);
- lua_Integer pose = posrelat(luaL_optinteger(L, 3, posi), l);
+ lua_Integer pi = luaL_optinteger(L, 2, 1);
+ size_t posi = posrelatI(pi, l);
+ size_t pose = getendpos(L, 3, pi, l);
int n, i;
- if (posi < 1) posi = 1;
- if (pose > (lua_Integer)l) pose = l;
if (posi > pose) return 0; /* empty interval; return no values */
- if (pose - posi >= INT_MAX) /* arithmetic overflow? */
+ if (pose - posi >= (size_t)INT_MAX) /* arithmetic overflow? */
return luaL_error(L, "string slice too long");
n = (int)(pose - posi) + 1;
luaL_checkstack(L, n, "string slice too long");
@@ -170,8 +197,8 @@
luaL_Buffer b;
char *p = luaL_buffinitsize(L, &b, n);
for (i=1; i<=n; i++) {
- lua_Integer c = luaL_checkinteger(L, i);
- luaL_argcheck(L, uchar(c) == c, i, "value out of range");
+ lua_Unsigned c = (lua_Unsigned)luaL_checkinteger(L, i);
+ luaL_argcheck(L, c <= (lua_Unsigned)UCHAR_MAX, i, "value out of range");
p[i - 1] = uchar(c);
}
luaL_pushresultsize(&b, n);
@@ -179,22 +206,38 @@
}
-static int writer (lua_State *L, const void *b, size_t size, void *B) {
- (void)L;
- luaL_addlstring((luaL_Buffer *) B, (const char *)b, size);
+/*
+** Buffer to store the result of 'string.dump'. It must be initialized
+** after the call to 'lua_dump', to ensure that the function is on the
+** top of the stack when 'lua_dump' is called. ('luaL_buffinit' might
+** push stuff.)
+*/
+struct str_Writer {
+ int init; /* true iff buffer has been initialized */
+ luaL_Buffer B;
+};
+
+
+static int writer (lua_State *L, const void *b, size_t size, void *ud) {
+ struct str_Writer *state = (struct str_Writer *)ud;
+ if (!state->init) {
+ state->init = 1;
+ luaL_buffinit(L, &state->B);
+ }
+ luaL_addlstring(&state->B, (const char *)b, size);
return 0;
}
static int str_dump (lua_State *L) {
- luaL_Buffer b;
+ struct str_Writer state;
int strip = lua_toboolean(L, 2);
luaL_checktype(L, 1, LUA_TFUNCTION);
- lua_settop(L, 1);
- luaL_buffinit(L,&b);
- if (lua_dump(L, writer, &b, strip) != 0)
+ lua_settop(L, 1); /* ensure function is on the top of the stack */
+ state.init = 0;
+ if (lua_dump(L, writer, &state, strip) != 0)
return luaL_error(L, "unable to dump given function");
- luaL_pushresult(&b);
+ luaL_pushresult(&state.B);
return 1;
}
@@ -202,6 +245,105 @@
/*
** {======================================================
+** METAMETHODS
+** =======================================================
+*/
+
+#if defined(LUA_NOCVTS2N) /* { */
+
+/* no coercion from strings to numbers */
+
+static const luaL_Reg stringmetamethods[] = {
+ {"__index", NULL}, /* placeholder */
+ {NULL, NULL}
+};
+
+#else /* }{ */
+
+static int tonum (lua_State *L, int arg) {
+ if (lua_type(L, arg) == LUA_TNUMBER) { /* already a number? */
+ lua_pushvalue(L, arg);
+ return 1;
+ }
+ else { /* check whether it is a numerical string */
+ size_t len;
+ const char *s = lua_tolstring(L, arg, &len);
+ return (s != NULL && lua_stringtonumber(L, s) == len + 1);
+ }
+}
+
+
+static void trymt (lua_State *L, const char *mtname) {
+ lua_settop(L, 2); /* back to the original arguments */
+ if (lua_type(L, 2) == LUA_TSTRING || !luaL_getmetafield(L, 2, mtname))
+ luaL_error(L, "attempt to %s a '%s' with a '%s'", mtname + 2,
+ luaL_typename(L, -2), luaL_typename(L, -1));
+ lua_insert(L, -3); /* put metamethod before arguments */
+ lua_call(L, 2, 1); /* call metamethod */
+}
+
+
+static int arith (lua_State *L, int op, const char *mtname) {
+ if (tonum(L, 1) && tonum(L, 2))
+ lua_arith(L, op); /* result will be on the top */
+ else
+ trymt(L, mtname);
+ return 1;
+}
+
+
+static int arith_add (lua_State *L) {
+ return arith(L, LUA_OPADD, "__add");
+}
+
+static int arith_sub (lua_State *L) {
+ return arith(L, LUA_OPSUB, "__sub");
+}
+
+static int arith_mul (lua_State *L) {
+ return arith(L, LUA_OPMUL, "__mul");
+}
+
+static int arith_mod (lua_State *L) {
+ return arith(L, LUA_OPMOD, "__mod");
+}
+
+static int arith_pow (lua_State *L) {
+ return arith(L, LUA_OPPOW, "__pow");
+}
+
+static int arith_div (lua_State *L) {
+ return arith(L, LUA_OPDIV, "__div");
+}
+
+static int arith_idiv (lua_State *L) {
+ return arith(L, LUA_OPIDIV, "__idiv");
+}
+
+static int arith_unm (lua_State *L) {
+ return arith(L, LUA_OPUNM, "__unm");
+}
+
+
+static const luaL_Reg stringmetamethods[] = {
+ {"__add", arith_add},
+ {"__sub", arith_sub},
+ {"__mul", arith_mul},
+ {"__mod", arith_mod},
+ {"__pow", arith_pow},
+ {"__div", arith_div},
+ {"__idiv", arith_idiv},
+ {"__unm", arith_unm},
+ {"__index", NULL}, /* placeholder */
+ {NULL, NULL}
+};
+
+#endif /* } */
+
+/* }====================================================== */
+
+/*
+** {======================================================
** PATTERN MATCHING
** =======================================================
*/
@@ -547,25 +689,46 @@
}
-static void push_onecapture (MatchState *ms, int i, const char *s,
- const char *e) {
+/*
+** get information about the i-th capture. If there are no captures
+** and 'i==0', return information about the whole match, which
+** is the range 's'..'e'. If the capture is a string, return
+** its length and put its address in '*cap'. If it is an integer
+** (a position), push it on the stack and return CAP_POSITION.
+*/
+static size_t get_onecapture (MatchState *ms, int i, const char *s,
+ const char *e, const char **cap) {
if (i >= ms->level) {
- if (i == 0) /* ms->level == 0, too */
- lua_pushlstring(ms->L, s, e - s); /* add whole match */
- else
+ if (i != 0)
luaL_error(ms->L, "invalid capture index %%%d", i + 1);
+ *cap = s;
+ return e - s;
}
else {
- ptrdiff_t l = ms->capture[i].len;
- if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture");
- if (l == CAP_POSITION)
+ ptrdiff_t capl = ms->capture[i].len;
+ *cap = ms->capture[i].init;
+ if (capl == CAP_UNFINISHED)
+ luaL_error(ms->L, "unfinished capture");
+ else if (capl == CAP_POSITION)
lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1);
- else
- lua_pushlstring(ms->L, ms->capture[i].init, l);
+ return capl;
}
}
+/*
+** Push the i-th capture on the stack.
+*/
+static void push_onecapture (MatchState *ms, int i, const char *s,
+ const char *e) {
+ const char *cap;
+ ptrdiff_t l = get_onecapture(ms, i, s, e, &cap);
+ if (l != CAP_POSITION)
+ lua_pushlstring(ms->L, cap, l);
+ /* else position was already pushed */
+}
+
+
static int push_captures (MatchState *ms, const char *s, const char *e) {
int i;
int nlevels = (ms->level == 0 && s) ? 1 : ms->level;
@@ -608,16 +771,15 @@
size_t ls, lp;
const char *s = luaL_checklstring(L, 1, &ls);
const char *p = luaL_checklstring(L, 2, &lp);
- lua_Integer init = posrelat(luaL_optinteger(L, 3, 1), ls);
- if (init < 1) init = 1;
- else if (init > (lua_Integer)ls + 1) { /* start after string's end? */
- lua_pushnil(L); /* cannot find anything */
+ size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
+ if (init > ls) { /* start after string's end? */
+ luaL_pushfail(L); /* cannot find anything */
return 1;
}
/* explicit request or no special characters? */
if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) {
/* do a plain search */
- const char *s2 = lmemfind(s + init - 1, ls - (size_t)init + 1, p, lp);
+ const char *s2 = lmemfind(s + init, ls - init, p, lp);
if (s2) {
lua_pushinteger(L, (s2 - s) + 1);
lua_pushinteger(L, (s2 - s) + lp);
@@ -626,7 +788,7 @@
}
else {
MatchState ms;
- const char *s1 = s + init - 1;
+ const char *s1 = s + init;
int anchor = (*p == '^');
if (anchor) {
p++; lp--; /* skip anchor character */
@@ -646,7 +808,7 @@
}
} while (s1++ < ms.src_end && !anchor);
}
- lua_pushnil(L); /* not found */
+ luaL_pushfail(L); /* not found */
return 1;
}
@@ -690,11 +852,14 @@
size_t ls, lp;
const char *s = luaL_checklstring(L, 1, &ls);
const char *p = luaL_checklstring(L, 2, &lp);
+ size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
GMatchState *gm;
- lua_settop(L, 2); /* keep them on closure to avoid being collected */
- gm = (GMatchState *)lua_newuserdata(L, sizeof(GMatchState));
+ lua_settop(L, 2); /* keep strings on closure to avoid being collected */
+ gm = (GMatchState *)lua_newuserdatauv(L, sizeof(GMatchState), 0);
+ if (init > ls) /* start after string's end? */
+ init = ls + 1; /* avoid overflows in 's + init' */
prepstate(&gm->ms, L, s, ls, p, lp);
- gm->src = s; gm->p = p; gm->lastmatch = NULL;
+ gm->src = s + init; gm->p = p; gm->lastmatch = NULL;
lua_pushcclosure(L, gmatch_aux, 3);
return 1;
}
@@ -702,60 +867,72 @@
static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,
const char *e) {
- size_t l, i;
+ size_t l;
lua_State *L = ms->L;
const char *news = lua_tolstring(L, 3, &l);
- for (i = 0; i < l; i++) {
- if (news[i] != L_ESC)
- luaL_addchar(b, news[i]);
- else {
- i++; /* skip ESC */
- if (!isdigit(uchar(news[i]))) {
- if (news[i] != L_ESC)
- luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);
- luaL_addchar(b, news[i]);
- }
- else if (news[i] == '0')
- luaL_addlstring(b, s, e - s);
- else {
- push_onecapture(ms, news[i] - '1', s, e);
- luaL_tolstring(L, -1, NULL); /* if number, convert it to string */
- lua_remove(L, -2); /* remove original value */
- luaL_addvalue(b); /* add capture to accumulated result */
- }
+ const char *p;
+ while ((p = (char *)memchr(news, L_ESC, l)) != NULL) {
+ luaL_addlstring(b, news, p - news);
+ p++; /* skip ESC */
+ if (*p == L_ESC) /* '%%' */
+ luaL_addchar(b, *p);
+ else if (*p == '0') /* '%0' */
+ luaL_addlstring(b, s, e - s);
+ else if (isdigit(uchar(*p))) { /* '%n' */
+ const char *cap;
+ ptrdiff_t resl = get_onecapture(ms, *p - '1', s, e, &cap);
+ if (resl == CAP_POSITION)
+ luaL_addvalue(b); /* add position to accumulated result */
+ else
+ luaL_addlstring(b, cap, resl);
}
+ else
+ luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);
+ l -= p + 1 - news;
+ news = p + 1;
}
+ luaL_addlstring(b, news, l);
}
-static void add_value (MatchState *ms, luaL_Buffer *b, const char *s,
- const char *e, int tr) {
+/*
+** Add the replacement value to the string buffer 'b'.
+** Return true if the original string was changed. (Function calls and
+** table indexing resulting in nil or false do not change the subject.)
+*/
+static int add_value (MatchState *ms, luaL_Buffer *b, const char *s,
+ const char *e, int tr) {
lua_State *L = ms->L;
switch (tr) {
- case LUA_TFUNCTION: {
+ case LUA_TFUNCTION: { /* call the function */
int n;
- lua_pushvalue(L, 3);
- n = push_captures(ms, s, e);
- lua_call(L, n, 1);
+ lua_pushvalue(L, 3); /* push the function */
+ n = push_captures(ms, s, e); /* all captures as arguments */
+ lua_call(L, n, 1); /* call it */
break;
}
- case LUA_TTABLE: {
- push_onecapture(ms, 0, s, e);
+ case LUA_TTABLE: { /* index the table */
+ push_onecapture(ms, 0, s, e); /* first capture is the index */
lua_gettable(L, 3);
break;
}
default: { /* LUA_TNUMBER or LUA_TSTRING */
- add_s(ms, b, s, e);
- return;
+ add_s(ms, b, s, e); /* add value to the buffer */
+ return 1; /* something changed */
}
}
if (!lua_toboolean(L, -1)) { /* nil or false? */
- lua_pop(L, 1);
- lua_pushlstring(L, s, e - s); /* keep original text */
+ lua_pop(L, 1); /* remove value */
+ luaL_addlstring(b, s, e - s); /* keep original text */
+ return 0; /* no changes */
}
else if (!lua_isstring(L, -1))
- luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1));
- luaL_addvalue(b); /* add result to accumulator */
+ return luaL_error(L, "invalid replacement value (a %s)",
+ luaL_typename(L, -1));
+ else {
+ luaL_addvalue(b); /* add result to accumulator */
+ return 1; /* something changed */
+ }
}
@@ -768,11 +945,12 @@
lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */
int anchor = (*p == '^');
lua_Integer n = 0; /* replacement count */
+ int changed = 0; /* change flag */
MatchState ms;
luaL_Buffer b;
- luaL_argcheck(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
+ luaL_argexpected(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,
- "string/function/table expected");
+ "string/function/table");
luaL_buffinit(L, &b);
if (anchor) {
p++; lp--; /* skip anchor character */
@@ -783,7 +961,7 @@
reprepstate(&ms); /* (re)prepare state for new match */
if ((e = match(&ms, src, p)) != NULL && e != lastmatch) { /* match? */
n++;
- add_value(&ms, &b, src, e, tr); /* add replacement to buffer */
+ changed = add_value(&ms, &b, src, e, tr) | changed;
src = lastmatch = e;
}
else if (src < ms.src_end) /* otherwise, skip one character */
@@ -791,8 +969,12 @@
else break; /* end of subject */
if (anchor) break;
}
- luaL_addlstring(&b, src, ms.src_end-src);
- luaL_pushresult(&b);
+ if (!changed) /* no changes? */
+ lua_pushvalue(L, 1); /* return original string */
+ else { /* something changed */
+ luaL_addlstring(&b, src, ms.src_end-src);
+ luaL_pushresult(&b); /* create and return new string */
+ }
lua_pushinteger(L, n); /* number of substitutions */
return 2;
}
@@ -813,8 +995,6 @@
** Hexadecimal floating-point formatter
*/
-#include <math.h>
-
#define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char))
@@ -824,7 +1004,7 @@
** to nibble boundaries by making what is left after that first digit a
** multiple of 4.
*/
-#define L_NBFD ((l_mathlim(MANT_DIG) - 1)%4 + 1)
+#define L_NBFD ((l_floatatt(MANT_DIG) - 1)%4 + 1)
/*
@@ -851,7 +1031,7 @@
lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */
int n = 0; /* character count */
if (m < 0) { /* is number negative? */
- buff[n++] = '-'; /* add signal */
+ buff[n++] = '-'; /* add sign */
m = -m; /* make it positive */
}
buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */
@@ -887,17 +1067,30 @@
/*
-** Maximum size of each formatted item. This maximum size is produced
+** Maximum size for items formatted with '%f'. This size is produced
** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.',
** and '\0') + number of decimal digits to represent maxfloat (which
-** is maximum exponent + 1). (99+3+1 then rounded to 120 for "extra
-** expenses", such as locale-dependent stuff)
+** is maximum exponent + 1). (99+3+1, adding some extra, 110)
*/
-#define MAX_ITEM (120 + l_mathlim(MAX_10_EXP))
+#define MAX_ITEMF (110 + l_floatatt(MAX_10_EXP))
+
+
+/*
+** All formats except '%f' do not need that large limit. The other
+** float formats use exponents, so that they fit in the 99 limit for
+** significant digits; 's' for large strings and 'q' add items directly
+** to the buffer; all integer formats also fit in the 99 limit. The
+** worst case are floats: they may need 99 significant digits, plus
+** '0x', '-', '.', 'e+XXXX', and '\0'. Adding some extra, 120.
+*/
+#define MAX_ITEM 120
/* valid flags in a format specification */
-#define FLAGS "-+ #0"
+#if !defined(L_FMTFLAGS)
+#define L_FMTFLAGS "-+ #0"
+#endif
+
/*
** maximum size of each format specification (such as "%-099.99d")
@@ -929,14 +1122,32 @@
/*
-** Ensures the 'buff' string uses a dot as the radix character.
+** Serialize a floating-point number in such a way that it can be
+** scanned back by Lua. Use hexadecimal format for "common" numbers
+** (to preserve precision); inf, -inf, and NaN are handled separately.
+** (NaN cannot be expressed as a numeral, so we write '(0/0)' for it.)
*/
-static void checkdp (char *buff, int nb) {
- if (memchr(buff, '.', nb) == NULL) { /* no dot? */
- char point = lua_getlocaledecpoint(); /* try locale point */
- char *ppoint = (char *)memchr(buff, point, nb);
- if (ppoint) *ppoint = '.'; /* change it to a dot */
+static int quotefloat (lua_State *L, char *buff, lua_Number n) {
+ const char *s; /* for the fixed representations */
+ if (n == (lua_Number)HUGE_VAL) /* inf? */
+ s = "1e9999";
+ else if (n == -(lua_Number)HUGE_VAL) /* -inf? */
+ s = "-1e9999";
+ else if (n != n) /* NaN? */
+ s = "(0/0)";
+ else { /* format number as hexadecimal */
+ int nb = lua_number2strx(L, buff, MAX_ITEM,
+ "%" LUA_NUMBER_FRMLEN "a", n);
+ /* ensures that 'buff' string uses a dot as the radix character */
+ if (memchr(buff, '.', nb) == NULL) { /* no dot? */
+ char point = lua_getlocaledecpoint(); /* try locale point */
+ char *ppoint = (char *)memchr(buff, point, nb);
+ if (ppoint) *ppoint = '.'; /* change it to a dot */
+ }
+ return nb;
}
+ /* for the fixed representations */
+ return l_sprintf(buff, MAX_ITEM, "%s", s);
}
@@ -951,15 +1162,12 @@
case LUA_TNUMBER: {
char *buff = luaL_prepbuffsize(b, MAX_ITEM);
int nb;
- if (!lua_isinteger(L, arg)) { /* float? */
- lua_Number n = lua_tonumber(L, arg); /* write as hexa ('%a') */
- nb = lua_number2strx(L, buff, MAX_ITEM, "%" LUA_NUMBER_FRMLEN "a", n);
- checkdp(buff, nb); /* ensure it uses a dot */
- }
+ if (!lua_isinteger(L, arg)) /* float? */
+ nb = quotefloat(L, buff, lua_tonumber(L, arg));
else { /* integers */
lua_Integer n = lua_tointeger(L, arg);
const char *format = (n == LUA_MININTEGER) /* corner case? */
- ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hexa */
+ ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hex */
: LUA_INTEGER_FMT; /* else use default format */
nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n);
}
@@ -980,8 +1188,8 @@
static const char *scanformat (lua_State *L, const char *strfrmt, char *form) {
const char *p = strfrmt;
- while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */
- if ((size_t)(p - strfrmt) >= sizeof(FLAGS)/sizeof(char))
+ while (*p != '\0' && strchr(L_FMTFLAGS, *p) != NULL) p++; /* skip flags */
+ if ((size_t)(p - strfrmt) >= sizeof(L_FMTFLAGS)/sizeof(char))
luaL_error(L, "invalid format (repeated flags)");
if (isdigit(uchar(*p))) p++; /* skip width */
if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
@@ -1028,36 +1236,51 @@
luaL_addchar(&b, *strfrmt++); /* %% */
else { /* format item */
char form[MAX_FORMAT]; /* to store the format ('%...') */
- char *buff = luaL_prepbuffsize(&b, MAX_ITEM); /* to put formatted item */
+ int maxitem = MAX_ITEM;
+ char *buff = luaL_prepbuffsize(&b, maxitem); /* to put formatted item */
int nb = 0; /* number of bytes in added item */
if (++arg > top)
- luaL_argerror(L, arg, "no value");
+ return luaL_argerror(L, arg, "no value");
strfrmt = scanformat(L, strfrmt, form);
switch (*strfrmt++) {
case 'c': {
- nb = l_sprintf(buff, MAX_ITEM, form, (int)luaL_checkinteger(L, arg));
+ nb = l_sprintf(buff, maxitem, form, (int)luaL_checkinteger(L, arg));
break;
}
case 'd': case 'i':
case 'o': case 'u': case 'x': case 'X': {
lua_Integer n = luaL_checkinteger(L, arg);
addlenmod(form, LUA_INTEGER_FRMLEN);
- nb = l_sprintf(buff, MAX_ITEM, form, (LUAI_UACINT)n);
+ nb = l_sprintf(buff, maxitem, form, (LUAI_UACINT)n);
break;
}
case 'a': case 'A':
addlenmod(form, LUA_NUMBER_FRMLEN);
- nb = lua_number2strx(L, buff, MAX_ITEM, form,
+ nb = lua_number2strx(L, buff, maxitem, form,
luaL_checknumber(L, arg));
break;
- case 'e': case 'E': case 'f':
- case 'g': case 'G': {
+ case 'f':
+ maxitem = MAX_ITEMF; /* extra space for '%f' */
+ buff = luaL_prepbuffsize(&b, maxitem);
+ /* FALLTHROUGH */
+ case 'e': case 'E': case 'g': case 'G': {
lua_Number n = luaL_checknumber(L, arg);
addlenmod(form, LUA_NUMBER_FRMLEN);
- nb = l_sprintf(buff, MAX_ITEM, form, (LUAI_UACNUMBER)n);
+ nb = l_sprintf(buff, maxitem, form, (LUAI_UACNUMBER)n);
+ break;
+ }
+ case 'p': {
+ const void *p = lua_topointer(L, arg);
+ if (p == NULL) { /* avoid calling 'printf' with argument NULL */
+ p = "(null)"; /* result */
+ form[strlen(form) - 1] = 's'; /* format it as a string */
+ }
+ nb = l_sprintf(buff, maxitem, form, p);
break;
}
case 'q': {
+ if (form[2] != '\0') /* modifiers? */
+ return luaL_error(L, "specifier '%%q' cannot have modifiers");
addliteral(L, &b, arg);
break;
}
@@ -1073,18 +1296,17 @@
luaL_addvalue(&b); /* keep entire string */
}
else { /* format the string into 'buff' */
- nb = l_sprintf(buff, MAX_ITEM, form, s);
+ nb = l_sprintf(buff, maxitem, form, s);
lua_pop(L, 1); /* remove result from 'luaL_tolstring' */
}
}
break;
}
default: { /* also treat cases 'pnLlh' */
- return luaL_error(L, "invalid option '%%%c' to 'format'",
- *(strfrmt - 1));
+ return luaL_error(L, "invalid conversion '%s' to 'format'", form);
}
}
- lua_assert(nb < MAX_ITEM);
+ lua_assert(nb < maxitem);
luaL_addsize(&b, nb);
}
}
@@ -1422,17 +1644,12 @@
while (*fmt != '\0') {
int size, ntoalign;
KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
+ luaL_argcheck(L, opt != Kstring && opt != Kzstr, 1,
+ "variable-length format");
size += ntoalign; /* total space used by option */
luaL_argcheck(L, totalsize <= MAXSIZE - size, 1,
"format result too large");
totalsize += size;
- switch (opt) {
- case Kstring: /* strings with length count */
- case Kzstr: /* zero-terminated string */
- luaL_argerror(L, 1, "variable-length format");
- /* call never return, but to avoid warnings: *//* FALLTHROUGH */
- default: break;
- }
}
lua_pushinteger(L, (lua_Integer)totalsize);
return 1;
@@ -1478,15 +1695,15 @@
const char *fmt = luaL_checkstring(L, 1);
size_t ld;
const char *data = luaL_checklstring(L, 2, &ld);
- size_t pos = (size_t)posrelat(luaL_optinteger(L, 3, 1), ld) - 1;
+ size_t pos = posrelatI(luaL_optinteger(L, 3, 1), ld) - 1;
int n = 0; /* number of results */
luaL_argcheck(L, pos <= ld, 3, "initial position out of string");
initheader(L, &h);
while (*fmt != '\0') {
int size, ntoalign;
KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign);
- if ((size_t)ntoalign + size > ~pos || pos + ntoalign + size > ld)
- luaL_argerror(L, 2, "data string too short");
+ luaL_argcheck(L, (size_t)ntoalign + size <= ld - pos, 2,
+ "data string too short");
pos += ntoalign; /* skip alignment */
/* stack space for item + next position */
luaL_checkstack(L, 2, "too many results");
@@ -1515,13 +1732,15 @@
}
case Kstring: {
size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0);
- luaL_argcheck(L, pos + len + size <= ld, 2, "data string too short");
+ luaL_argcheck(L, len <= ld - pos - size, 2, "data string too short");
lua_pushlstring(L, data + pos + size, len);
pos += len; /* skip string */
break;
}
case Kzstr: {
size_t len = (int)strlen(data + pos);
+ luaL_argcheck(L, pos + len < ld, 2,
+ "unfinished string for format 'z'");
lua_pushlstring(L, data + pos, len);
pos += len + 1; /* skip string plus final '\0' */
break;
@@ -1562,7 +1781,9 @@
static void createmetatable (lua_State *L) {
- lua_createtable(L, 0, 1); /* table to be metatable for strings */
+ /* table to be metatable for strings */
+ luaL_newlibtable(L, stringmetamethods);
+ luaL_setfuncs(L, stringmetamethods, 0);
lua_pushliteral(L, ""); /* dummy string */
lua_pushvalue(L, -2); /* copy table */
lua_setmetatable(L, -2); /* set table as metatable for strings */
diff --git a/src/ltable.c b/src/ltable.c
index ea4fe7f..d7eb69a 100644
--- a/src/ltable.c
+++ b/src/ltable.c
@@ -1,5 +1,5 @@
/*
-** $Id: ltable.c,v 2.118.1.4 2018/06/08 16:22:51 roberto Exp $
+** $Id: ltable.c $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
@@ -40,21 +40,34 @@
/*
-** Maximum size of array part (MAXASIZE) is 2^MAXABITS. MAXABITS is
-** the largest integer such that MAXASIZE fits in an unsigned int.
+** MAXABITS is the largest integer such that MAXASIZE fits in an
+** unsigned int.
*/
#define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1)
-#define MAXASIZE (1u << MAXABITS)
+
/*
-** Maximum size of hash part is 2^MAXHBITS. MAXHBITS is the largest
-** integer such that 2^MAXHBITS fits in a signed int. (Note that the
-** maximum number of elements in a table, 2^MAXABITS + 2^MAXHBITS, still
-** fits comfortably in an unsigned int.)
+** MAXASIZE is the maximum size of the array part. It is the minimum
+** between 2^MAXABITS and the maximum size that, measured in bytes,
+** fits in a 'size_t'.
+*/
+#define MAXASIZE luaM_limitN(1u << MAXABITS, TValue)
+
+/*
+** MAXHBITS is the largest integer such that 2^MAXHBITS fits in a
+** signed int.
*/
#define MAXHBITS (MAXABITS - 1)
+/*
+** MAXHSIZE is the maximum size of the hash part. It is the minimum
+** between 2^MAXHBITS and the maximum size such that, measured in bytes,
+** it fits in a 'size_t'.
+*/
+#define MAXHSIZE luaM_limitN(1u << MAXHBITS, Node)
+
+
#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
#define hashstr(t,str) hashpow2(t, (str)->hash)
@@ -75,11 +88,15 @@
#define dummynode (&dummynode_)
static const Node dummynode_ = {
- {NILCONSTANT}, /* value */
- {{NILCONSTANT, 0}} /* key */
+ {{NULL}, LUA_VEMPTY, /* value's value and type */
+ LUA_VNIL, 0, {NULL}} /* key type, next, and key value */
};
+static const TValue absentkey = {ABSTKEYCONSTANT};
+
+
+
/*
** Hash for floating-point numbers.
** The main computation should be just
@@ -103,51 +120,162 @@
return 0;
}
else { /* normal case */
- unsigned int u = cast(unsigned int, i) + cast(unsigned int, ni);
- return cast_int(u <= cast(unsigned int, INT_MAX) ? u : ~u);
+ unsigned int u = cast_uint(i) + cast_uint(ni);
+ return cast_int(u <= cast_uint(INT_MAX) ? u : ~u);
}
}
#endif
/*
-** returns the 'main' position of an element in a table (that is, the index
-** of its hash value)
+** returns the 'main' position of an element in a table (that is,
+** the index of its hash value). The key comes broken (tag in 'ktt'
+** and value in 'vkl') so that we can call it on keys inserted into
+** nodes.
*/
-static Node *mainposition (const Table *t, const TValue *key) {
- switch (ttype(key)) {
- case LUA_TNUMINT:
- return hashint(t, ivalue(key));
- case LUA_TNUMFLT:
- return hashmod(t, l_hashfloat(fltvalue(key)));
- case LUA_TSHRSTR:
- return hashstr(t, tsvalue(key));
- case LUA_TLNGSTR:
- return hashpow2(t, luaS_hashlongstr(tsvalue(key)));
- case LUA_TBOOLEAN:
- return hashboolean(t, bvalue(key));
- case LUA_TLIGHTUSERDATA:
- return hashpointer(t, pvalue(key));
- case LUA_TLCF:
- return hashpointer(t, fvalue(key));
+static Node *mainposition (const Table *t, int ktt, const Value *kvl) {
+ switch (withvariant(ktt)) {
+ case LUA_VNUMINT:
+ return hashint(t, ivalueraw(*kvl));
+ case LUA_VNUMFLT:
+ return hashmod(t, l_hashfloat(fltvalueraw(*kvl)));
+ case LUA_VSHRSTR:
+ return hashstr(t, tsvalueraw(*kvl));
+ case LUA_VLNGSTR:
+ return hashpow2(t, luaS_hashlongstr(tsvalueraw(*kvl)));
+ case LUA_VFALSE:
+ return hashboolean(t, 0);
+ case LUA_VTRUE:
+ return hashboolean(t, 1);
+ case LUA_VLIGHTUSERDATA:
+ return hashpointer(t, pvalueraw(*kvl));
+ case LUA_VLCF:
+ return hashpointer(t, fvalueraw(*kvl));
default:
- lua_assert(!ttisdeadkey(key));
- return hashpointer(t, gcvalue(key));
+ return hashpointer(t, gcvalueraw(*kvl));
}
}
/*
-** returns the index for 'key' if 'key' is an appropriate key to live in
-** the array part of the table, 0 otherwise.
+** Returns the main position of an element given as a 'TValue'
*/
-static unsigned int arrayindex (const TValue *key) {
- if (ttisinteger(key)) {
- lua_Integer k = ivalue(key);
- if (0 < k && (lua_Unsigned)k <= MAXASIZE)
- return cast(unsigned int, k); /* 'key' is an appropriate array index */
+static Node *mainpositionTV (const Table *t, const TValue *key) {
+ return mainposition(t, rawtt(key), valraw(key));
+}
+
+
+/*
+** Check whether key 'k1' is equal to the key in node 'n2'.
+** This equality is raw, so there are no metamethods. Floats
+** with integer values have been normalized, so integers cannot
+** be equal to floats. It is assumed that 'eqshrstr' is simply
+** pointer equality, so that short strings are handled in the
+** default case.
+*/
+static int equalkey (const TValue *k1, const Node *n2) {
+ if (rawtt(k1) != keytt(n2)) /* not the same variants? */
+ return 0; /* cannot be same key */
+ switch (ttypetag(k1)) {
+ case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
+ return 1;
+ case LUA_VNUMINT:
+ return (ivalue(k1) == keyival(n2));
+ case LUA_VNUMFLT:
+ return luai_numeq(fltvalue(k1), fltvalueraw(keyval(n2)));
+ case LUA_VLIGHTUSERDATA:
+ return pvalue(k1) == pvalueraw(keyval(n2));
+ case LUA_VLCF:
+ return fvalue(k1) == fvalueraw(keyval(n2));
+ case LUA_VLNGSTR:
+ return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
+ default:
+ return gcvalue(k1) == gcvalueraw(keyval(n2));
}
- return 0; /* 'key' did not match some condition */
+}
+
+
+/*
+** True if value of 'alimit' is equal to the real size of the array
+** part of table 't'. (Otherwise, the array part must be larger than
+** 'alimit'.)
+*/
+#define limitequalsasize(t) (isrealasize(t) || ispow2((t)->alimit))
+
+
+/*
+** Returns the real size of the 'array' array
+*/
+LUAI_FUNC unsigned int luaH_realasize (const Table *t) {
+ if (limitequalsasize(t))
+ return t->alimit; /* this is the size */
+ else {
+ unsigned int size = t->alimit;
+ /* compute the smallest power of 2 not smaller than 'n' */
+ size |= (size >> 1);
+ size |= (size >> 2);
+ size |= (size >> 4);
+ size |= (size >> 8);
+ size |= (size >> 16);
+#if (UINT_MAX >> 30) > 3
+ size |= (size >> 32); /* unsigned int has more than 32 bits */
+#endif
+ size++;
+ lua_assert(ispow2(size) && size/2 < t->alimit && t->alimit < size);
+ return size;
+ }
+}
+
+
+/*
+** Check whether real size of the array is a power of 2.
+** (If it is not, 'alimit' cannot be changed to any other value
+** without changing the real size.)
+*/
+static int ispow2realasize (const Table *t) {
+ return (!isrealasize(t) || ispow2(t->alimit));
+}
+
+
+static unsigned int setlimittosize (Table *t) {
+ t->alimit = luaH_realasize(t);
+ setrealasize(t);
+ return t->alimit;
+}
+
+
+#define limitasasize(t) check_exp(isrealasize(t), t->alimit)
+
+
+
+/*
+** "Generic" get version. (Not that generic: not valid for integers,
+** which may be in array part, nor for floats with integral values.)
+*/
+static const TValue *getgeneric (Table *t, const TValue *key) {
+ Node *n = mainpositionTV(t, key);
+ for (;;) { /* check whether 'key' is somewhere in the chain */
+ if (equalkey(key, n))
+ return gval(n); /* that's it */
+ else {
+ int nx = gnext(n);
+ if (nx == 0)
+ return &absentkey; /* not found */
+ n += nx;
+ }
+ }
+}
+
+
+/*
+** returns the index for 'k' if 'k' is an appropriate key to live in
+** the array part of a table, 0 otherwise.
+*/
+static unsigned int arrayindex (lua_Integer k) {
+ if (l_castS2U(k) - 1u < MAXASIZE) /* 'k' in [1, MAXASIZE]? */
+ return cast_uint(k); /* 'key' is an appropriate array index */
+ else
+ return 0;
}
@@ -156,46 +284,39 @@
** elements in the array part, then elements in the hash part. The
** beginning of a traversal is signaled by 0.
*/
-static unsigned int findindex (lua_State *L, Table *t, StkId key) {
+static unsigned int findindex (lua_State *L, Table *t, TValue *key,
+ unsigned int asize) {
unsigned int i;
if (ttisnil(key)) return 0; /* first iteration */
- i = arrayindex(key);
- if (i != 0 && i <= t->sizearray) /* is 'key' inside array part? */
+ i = ttisinteger(key) ? arrayindex(ivalue(key)) : 0;
+ if (i - 1u < asize) /* is 'key' inside array part? */
return i; /* yes; that's the index */
else {
- int nx;
- Node *n = mainposition(t, key);
- for (;;) { /* check whether 'key' is somewhere in the chain */
- /* key may be dead already, but it is ok to use it in 'next' */
- if (luaV_rawequalobj(gkey(n), key) ||
- (ttisdeadkey(gkey(n)) && iscollectable(key) &&
- deadvalue(gkey(n)) == gcvalue(key))) {
- i = cast_int(n - gnode(t, 0)); /* key index in hash table */
- /* hash elements are numbered after array ones */
- return (i + 1) + t->sizearray;
- }
- nx = gnext(n);
- if (nx == 0)
- luaG_runerror(L, "invalid key to 'next'"); /* key not found */
- else n += nx;
- }
+ const TValue *n = getgeneric(t, key);
+ if (unlikely(isabstkey(n)))
+ luaG_runerror(L, "invalid key to 'next'"); /* key not found */
+ i = cast_int(nodefromval(n) - gnode(t, 0)); /* key index in hash table */
+ /* hash elements are numbered after array ones */
+ return (i + 1) + asize;
}
}
int luaH_next (lua_State *L, Table *t, StkId key) {
- unsigned int i = findindex(L, t, key); /* find original element */
- for (; i < t->sizearray; i++) { /* try first array part */
- if (!ttisnil(&t->array[i])) { /* a non-nil value? */
- setivalue(key, i + 1);
- setobj2s(L, key+1, &t->array[i]);
+ unsigned int asize = luaH_realasize(t);
+ unsigned int i = findindex(L, t, s2v(key), asize); /* find original key */
+ for (; i < asize; i++) { /* try first array part */
+ if (!isempty(&t->array[i])) { /* a non-empty entry? */
+ setivalue(s2v(key), i + 1);
+ setobj2s(L, key + 1, &t->array[i]);
return 1;
}
}
- for (i -= t->sizearray; cast_int(i) < sizenode(t); i++) { /* hash part */
- if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */
- setobj2s(L, key, gkey(gnode(t, i)));
- setobj2s(L, key+1, gval(gnode(t, i)));
+ for (i -= asize; cast_int(i) < sizenode(t); i++) { /* hash part */
+ if (!isempty(gval(gnode(t, i)))) { /* a non-empty entry? */
+ Node *n = gnode(t, i);
+ getnodekey(L, s2v(key), n);
+ setobj2s(L, key + 1, gval(n));
return 1;
}
}
@@ -203,6 +324,12 @@
}
+static void freehash (lua_State *L, Table *t) {
+ if (!isdummy(t))
+ luaM_freearray(L, t->node, cast_sizet(sizenode(t)));
+}
+
+
/*
** {=============================================================
** Rehash
@@ -214,7 +341,8 @@
** "count array" where 'nums[i]' is the number of integers in the table
** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of
** integer keys in the table and leaves with the number of keys that
-** will go to the array part; return the optimal size.
+** will go to the array part; return the optimal size. (The condition
+** 'twotoi > 0' in the for loop stops the loop if 'twotoi' overflows.)
*/
static unsigned int computesizes (unsigned int nums[], unsigned int *pna) {
int i;
@@ -226,12 +354,10 @@
for (i = 0, twotoi = 1;
twotoi > 0 && *pna > twotoi / 2;
i++, twotoi *= 2) {
- if (nums[i] > 0) {
- a += nums[i];
- if (a > twotoi/2) { /* more than half elements present? */
- optimal = twotoi; /* optimal size (till now) */
- na = a; /* all elements up to 'optimal' will go to array part */
- }
+ a += nums[i];
+ if (a > twotoi/2) { /* more than half elements present? */
+ optimal = twotoi; /* optimal size (till now) */
+ na = a; /* all elements up to 'optimal' will go to array part */
}
}
lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal);
@@ -240,7 +366,7 @@
}
-static int countint (const TValue *key, unsigned int *nums) {
+static int countint (lua_Integer key, unsigned int *nums) {
unsigned int k = arrayindex(key);
if (k != 0) { /* is 'key' an appropriate array index? */
nums[luaO_ceillog2(k)]++; /* count as such */
@@ -261,18 +387,19 @@
unsigned int ttlg; /* 2^lg */
unsigned int ause = 0; /* summation of 'nums' */
unsigned int i = 1; /* count to traverse all array keys */
+ unsigned int asize = limitasasize(t); /* real array size */
/* traverse each slice */
for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {
unsigned int lc = 0; /* counter */
unsigned int lim = ttlg;
- if (lim > t->sizearray) {
- lim = t->sizearray; /* adjust upper limit */
+ if (lim > asize) {
+ lim = asize; /* adjust upper limit */
if (i > lim)
break; /* no more elements to count */
}
/* count elements in range (2^(lg - 1), 2^lg] */
for (; i <= lim; i++) {
- if (!ttisnil(&t->array[i-1]))
+ if (!isempty(&t->array[i-1]))
lc++;
}
nums[lg] += lc;
@@ -288,8 +415,9 @@
int i = sizenode(t);
while (i--) {
Node *n = &t->node[i];
- if (!ttisnil(gval(n))) {
- ause += countint(gkey(n), nums);
+ if (!isempty(gval(n))) {
+ if (keyisinteger(n))
+ ause += countint(keyival(n), nums);
totaluse++;
}
}
@@ -298,15 +426,13 @@
}
-static void setarrayvector (lua_State *L, Table *t, unsigned int size) {
- unsigned int i;
- luaM_reallocvector(L, t->array, t->sizearray, size, TValue);
- for (i=t->sizearray; i<size; i++)
- setnilvalue(&t->array[i]);
- t->sizearray = size;
-}
-
-
+/*
+** Creates an array for the hash part of a table with the given
+** size, or reuses the dummy node if size is zero.
+** The computation for size overflow is in two steps: the first
+** comparison ensures that the shift in the second one does not
+** overflow.
+*/
static void setnodevector (lua_State *L, Table *t, unsigned int size) {
if (size == 0) { /* no elements to hash part? */
t->node = cast(Node *, dummynode); /* use common 'dummynode' */
@@ -316,15 +442,15 @@
else {
int i;
int lsize = luaO_ceillog2(size);
- if (lsize > MAXHBITS)
+ if (lsize > MAXHBITS || (1u << lsize) > MAXHSIZE)
luaG_runerror(L, "table overflow");
size = twoto(lsize);
t->node = luaM_newvector(L, size, Node);
for (i = 0; i < (int)size; i++) {
Node *n = gnode(t, i);
gnext(n) = 0;
- setnilvalue(wgkey(n));
- setnilvalue(gval(n));
+ setnilkey(n);
+ setempty(gval(n));
}
t->lsizenode = cast_byte(lsize);
t->lastfree = gnode(t, size); /* all positions are free */
@@ -332,55 +458,88 @@
}
-typedef struct {
- Table *t;
- unsigned int nhsize;
-} AuxsetnodeT;
-
-
-static void auxsetnode (lua_State *L, void *ud) {
- AuxsetnodeT *asn = cast(AuxsetnodeT *, ud);
- setnodevector(L, asn->t, asn->nhsize);
+/*
+** (Re)insert all elements from the hash part of 'ot' into table 't'.
+*/
+static void reinsert (lua_State *L, Table *ot, Table *t) {
+ int j;
+ int size = sizenode(ot);
+ for (j = 0; j < size; j++) {
+ Node *old = gnode(ot, j);
+ if (!isempty(gval(old))) {
+ /* doesn't need barrier/invalidate cache, as entry was
+ already present in the table */
+ TValue k;
+ getnodekey(L, &k, old);
+ setobjt2t(L, luaH_set(L, t, &k), gval(old));
+ }
+ }
}
-void luaH_resize (lua_State *L, Table *t, unsigned int nasize,
+/*
+** Exchange the hash part of 't1' and 't2'.
+*/
+static void exchangehashpart (Table *t1, Table *t2) {
+ lu_byte lsizenode = t1->lsizenode;
+ Node *node = t1->node;
+ Node *lastfree = t1->lastfree;
+ t1->lsizenode = t2->lsizenode;
+ t1->node = t2->node;
+ t1->lastfree = t2->lastfree;
+ t2->lsizenode = lsizenode;
+ t2->node = node;
+ t2->lastfree = lastfree;
+}
+
+
+/*
+** Resize table 't' for the new given sizes. Both allocations (for
+** the hash part and for the array part) can fail, which creates some
+** subtleties. If the first allocation, for the hash part, fails, an
+** error is raised and that is it. Otherwise, it copies the elements from
+** the shrinking part of the array (if it is shrinking) into the new
+** hash. Then it reallocates the array part. If that fails, the table
+** is in its original state; the function frees the new hash part and then
+** raises the allocation error. Otherwise, it sets the new hash part
+** into the table, initializes the new part of the array (if any) with
+** nils and reinserts the elements of the old hash back into the new
+** parts of the table.
+*/
+void luaH_resize (lua_State *L, Table *t, unsigned int newasize,
unsigned int nhsize) {
unsigned int i;
- int j;
- AuxsetnodeT asn;
- unsigned int oldasize = t->sizearray;
- int oldhsize = allocsizenode(t);
- Node *nold = t->node; /* save old hash ... */
- if (nasize > oldasize) /* array part must grow? */
- setarrayvector(L, t, nasize);
- /* create new hash part with appropriate size */
- asn.t = t; asn.nhsize = nhsize;
- if (luaD_rawrunprotected(L, auxsetnode, &asn) != LUA_OK) { /* mem. error? */
- setarrayvector(L, t, oldasize); /* array back to its original size */
- luaD_throw(L, LUA_ERRMEM); /* rethrow memory error */
- }
- if (nasize < oldasize) { /* array part must shrink? */
- t->sizearray = nasize;
- /* re-insert elements from vanishing slice */
- for (i=nasize; i<oldasize; i++) {
- if (!ttisnil(&t->array[i]))
+ Table newt; /* to keep the new hash part */
+ unsigned int oldasize = setlimittosize(t);
+ TValue *newarray;
+ /* create new hash part with appropriate size into 'newt' */
+ setnodevector(L, &newt, nhsize);
+ if (newasize < oldasize) { /* will array shrink? */
+ t->alimit = newasize; /* pretend array has new size... */
+ exchangehashpart(t, &newt); /* and new hash */
+ /* re-insert into the new hash the elements from vanishing slice */
+ for (i = newasize; i < oldasize; i++) {
+ if (!isempty(&t->array[i]))
luaH_setint(L, t, i + 1, &t->array[i]);
}
- /* shrink array */
- luaM_reallocvector(L, t->array, oldasize, nasize, TValue);
+ t->alimit = oldasize; /* restore current size... */
+ exchangehashpart(t, &newt); /* and hash (in case of errors) */
}
- /* re-insert elements from hash part */
- for (j = oldhsize - 1; j >= 0; j--) {
- Node *old = nold + j;
- if (!ttisnil(gval(old))) {
- /* doesn't need barrier/invalidate cache, as entry was
- already present in the table */
- setobjt2t(L, luaH_set(L, t, gkey(old)), gval(old));
- }
+ /* allocate new array */
+ newarray = luaM_reallocvector(L, t->array, oldasize, newasize, TValue);
+ if (unlikely(newarray == NULL && newasize > 0)) { /* allocation failed? */
+ freehash(L, &newt); /* release new hash part */
+ luaM_error(L); /* raise error (with array unchanged) */
}
- if (oldhsize > 0) /* not the dummy node? */
- luaM_freearray(L, nold, cast(size_t, oldhsize)); /* free old hash */
+ /* allocation ok; initialize new part of the array */
+ exchangehashpart(t, &newt); /* 't' has the new hash ('newt' has the old) */
+ t->array = newarray; /* set new array part */
+ t->alimit = newasize;
+ for (i = oldasize; i < newasize; i++) /* clear new slice of the array */
+ setempty(&t->array[i]);
+ /* re-insert elements from old hash part into new parts */
+ reinsert(L, &newt, t); /* 'newt' now has the old hash */
+ freehash(L, &newt); /* free old hash part */
}
@@ -399,11 +558,13 @@
int i;
int totaluse;
for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */
+ setlimittosize(t);
na = numusearray(t, nums); /* count keys in array part */
totaluse = na; /* all those keys are integer keys */
totaluse += numusehash(t, nums, &na); /* count keys in hash part */
/* count extra key */
- na += countint(ek, nums);
+ if (ttisinteger(ek))
+ na += countint(ivalue(ek), nums);
totaluse++;
/* compute new size for array part */
asize = computesizes(nums, &na);
@@ -419,21 +580,20 @@
Table *luaH_new (lua_State *L) {
- GCObject *o = luaC_newobj(L, LUA_TTABLE, sizeof(Table));
+ GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table));
Table *t = gco2t(o);
t->metatable = NULL;
t->flags = cast_byte(~0);
t->array = NULL;
- t->sizearray = 0;
+ t->alimit = 0;
setnodevector(L, t, 0);
return t;
}
void luaH_free (lua_State *L, Table *t) {
- if (!isdummy(t))
- luaM_freearray(L, t->node, cast(size_t, sizenode(t)));
- luaM_freearray(L, t->array, t->sizearray);
+ freehash(L, t);
+ luaM_freearray(L, t->array, luaH_realasize(t));
luaM_free(L, t);
}
@@ -442,7 +602,7 @@
if (!isdummy(t)) {
while (t->lastfree > t->node) {
t->lastfree--;
- if (ttisnil(gkey(t->lastfree)))
+ if (keyisnil(t->lastfree))
return t->lastfree;
}
}
@@ -461,18 +621,20 @@
TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key) {
Node *mp;
TValue aux;
- if (ttisnil(key)) luaG_runerror(L, "table index is nil");
+ if (unlikely(ttisnil(key)))
+ luaG_runerror(L, "table index is nil");
else if (ttisfloat(key)) {
+ lua_Number f = fltvalue(key);
lua_Integer k;
- if (luaV_tointeger(key, &k, 0)) { /* does index fit in an integer? */
+ if (luaV_flttointeger(f, &k, F2Ieq)) { /* does key fit in an integer? */
setivalue(&aux, k);
key = &aux; /* insert it as an integer */
}
- else if (luai_numisnan(fltvalue(key)))
+ else if (unlikely(luai_numisnan(f)))
luaG_runerror(L, "table index is NaN");
}
- mp = mainposition(t, key);
- if (!ttisnil(gval(mp)) || isdummy(t)) { /* main position is taken? */
+ mp = mainpositionTV(t, key);
+ if (!isempty(gval(mp)) || isdummy(t)) { /* main position is taken? */
Node *othern;
Node *f = getfreepos(t); /* get a free place */
if (f == NULL) { /* cannot find a free place? */
@@ -481,7 +643,7 @@
return luaH_set(L, t, key); /* insert key into grown table */
}
lua_assert(!isdummy(t));
- othern = mainposition(t, gkey(mp));
+ othern = mainposition(t, keytt(mp), &keyval(mp));
if (othern != mp) { /* is colliding node out of its main position? */
/* yes; move colliding node into free position */
while (othern + gnext(othern) != mp) /* find previous */
@@ -492,7 +654,7 @@
gnext(f) += cast_int(mp - f); /* correct 'next' */
gnext(mp) = 0; /* now 'mp' is free */
}
- setnilvalue(gval(mp));
+ setempty(gval(mp));
}
else { /* colliding node is in its own main position */
/* new node will go into free position */
@@ -503,24 +665,34 @@
mp = f;
}
}
- setnodekey(L, &mp->i_key, key);
- luaC_barrierback(L, t, key);
- lua_assert(ttisnil(gval(mp)));
+ setnodekey(L, mp, key);
+ luaC_barrierback(L, obj2gco(t), key);
+ lua_assert(isempty(gval(mp)));
return gval(mp);
}
/*
-** search function for integers
+** Search function for integers. If integer is inside 'alimit', get it
+** directly from the array part. Otherwise, if 'alimit' is not equal to
+** the real size of the array, key still can be in the array part. In
+** this case, try to avoid a call to 'luaH_realasize' when key is just
+** one more than the limit (so that it can be incremented without
+** changing the real size of the array).
*/
const TValue *luaH_getint (Table *t, lua_Integer key) {
- /* (1 <= key && key <= t->sizearray) */
- if (l_castS2U(key) - 1 < t->sizearray)
+ if (l_castS2U(key) - 1u < t->alimit) /* 'key' in [1, t->alimit]? */
return &t->array[key - 1];
+ else if (!limitequalsasize(t) && /* key still may be in the array part? */
+ (l_castS2U(key) == t->alimit + 1 ||
+ l_castS2U(key) - 1u < luaH_realasize(t))) {
+ t->alimit = cast_uint(key); /* probably '#t' is here now */
+ return &t->array[key - 1];
+ }
else {
Node *n = hashint(t, key);
for (;;) { /* check whether 'key' is somewhere in the chain */
- if (ttisinteger(gkey(n)) && ivalue(gkey(n)) == key)
+ if (keyisinteger(n) && keyival(n) == key)
return gval(n); /* that's it */
else {
int nx = gnext(n);
@@ -528,7 +700,7 @@
n += nx;
}
}
- return luaO_nilobject;
+ return &absentkey;
}
}
@@ -538,34 +710,14 @@
*/
const TValue *luaH_getshortstr (Table *t, TString *key) {
Node *n = hashstr(t, key);
- lua_assert(key->tt == LUA_TSHRSTR);
+ lua_assert(key->tt == LUA_VSHRSTR);
for (;;) { /* check whether 'key' is somewhere in the chain */
- const TValue *k = gkey(n);
- if (ttisshrstring(k) && eqshrstr(tsvalue(k), key))
+ if (keyisshrstr(n) && eqshrstr(keystrval(n), key))
return gval(n); /* that's it */
else {
int nx = gnext(n);
if (nx == 0)
- return luaO_nilobject; /* not found */
- n += nx;
- }
- }
-}
-
-
-/*
-** "Generic" get version. (Not that generic: not valid for integers,
-** which may be in array part, nor for floats with integral values.)
-*/
-static const TValue *getgeneric (Table *t, const TValue *key) {
- Node *n = mainposition(t, key);
- for (;;) { /* check whether 'key' is somewhere in the chain */
- if (luaV_rawequalobj(gkey(n), key))
- return gval(n); /* that's it */
- else {
- int nx = gnext(n);
- if (nx == 0)
- return luaO_nilobject; /* not found */
+ return &absentkey; /* not found */
n += nx;
}
}
@@ -573,7 +725,7 @@
const TValue *luaH_getstr (Table *t, TString *key) {
- if (key->tt == LUA_TSHRSTR)
+ if (key->tt == LUA_VSHRSTR)
return luaH_getshortstr(t, key);
else { /* for long strings, use generic case */
TValue ko;
@@ -587,13 +739,13 @@
** main search function
*/
const TValue *luaH_get (Table *t, const TValue *key) {
- switch (ttype(key)) {
- case LUA_TSHRSTR: return luaH_getshortstr(t, tsvalue(key));
- case LUA_TNUMINT: return luaH_getint(t, ivalue(key));
- case LUA_TNIL: return luaO_nilobject;
- case LUA_TNUMFLT: {
+ switch (ttypetag(key)) {
+ case LUA_VSHRSTR: return luaH_getshortstr(t, tsvalue(key));
+ case LUA_VNUMINT: return luaH_getint(t, ivalue(key));
+ case LUA_VNIL: return &absentkey;
+ case LUA_VNUMFLT: {
lua_Integer k;
- if (luaV_tointeger(key, &k, 0)) /* index is int? */
+ if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
return luaH_getint(t, k); /* use specialized version */
/* else... */
} /* FALLTHROUGH */
@@ -609,7 +761,7 @@
*/
TValue *luaH_set (lua_State *L, Table *t, const TValue *key) {
const TValue *p = luaH_get(t, key);
- if (p != luaO_nilobject)
+ if (!isabstkey(p))
return cast(TValue *, p);
else return luaH_newkey(L, t, key);
}
@@ -618,7 +770,7 @@
void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {
const TValue *p = luaH_getint(t, key);
TValue *cell;
- if (p != luaO_nilobject)
+ if (!isabstkey(p))
cell = cast(TValue *, p);
else {
TValue k;
@@ -629,24 +781,49 @@
}
-static lua_Unsigned unbound_search (Table *t, lua_Unsigned j) {
- lua_Unsigned i = j; /* i is zero or a present index */
- j++;
- /* find 'i' and 'j' such that i is present and j is not */
- while (!ttisnil(luaH_getint(t, j))) {
- i = j;
- if (j > l_castS2U(LUA_MAXINTEGER) / 2) { /* overflow? */
- /* table was built with bad purposes: resort to linear search */
- i = 1;
- while (!ttisnil(luaH_getint(t, i))) i++;
- return i - 1;
+/*
+** Try to find a boundary in the hash part of table 't'. From the
+** caller, we know that 'j' is zero or present and that 'j + 1' is
+** present. We want to find a larger key that is absent from the
+** table, so that we can do a binary search between the two keys to
+** find a boundary. We keep doubling 'j' until we get an absent index.
+** If the doubling would overflow, we try LUA_MAXINTEGER. If it is
+** absent, we are ready for the binary search. ('j', being max integer,
+** is larger or equal to 'i', but it cannot be equal because it is
+** absent while 'i' is present; so 'j > i'.) Otherwise, 'j' is a
+** boundary. ('j + 1' cannot be a present integer key because it is
+** not a valid integer in Lua.)
+*/
+static lua_Unsigned hash_search (Table *t, lua_Unsigned j) {
+ lua_Unsigned i;
+ if (j == 0) j++; /* the caller ensures 'j + 1' is present */
+ do {
+ i = j; /* 'i' is a present index */
+ if (j <= l_castS2U(LUA_MAXINTEGER) / 2)
+ j *= 2;
+ else {
+ j = LUA_MAXINTEGER;
+ if (isempty(luaH_getint(t, j))) /* t[j] not present? */
+ break; /* 'j' now is an absent index */
+ else /* weird case */
+ return j; /* well, max integer is a boundary... */
}
- j *= 2;
+ } while (!isempty(luaH_getint(t, j))); /* repeat until an absent t[j] */
+ /* i < j && t[i] present && t[j] absent */
+ while (j - i > 1u) { /* do a binary search between them */
+ lua_Unsigned m = (i + j) / 2;
+ if (isempty(luaH_getint(t, m))) j = m;
+ else i = m;
}
- /* now do a binary search between them */
- while (j - i > 1) {
- lua_Unsigned m = (i+j)/2;
- if (ttisnil(luaH_getint(t, m))) j = m;
+ return i;
+}
+
+
+static unsigned int binsearch (const TValue *array, unsigned int i,
+ unsigned int j) {
+ while (j - i > 1u) { /* binary search */
+ unsigned int m = (i + j) / 2;
+ if (isempty(&array[m - 1])) j = m;
else i = m;
}
return i;
@@ -654,33 +831,92 @@
/*
-** Try to find a boundary in table 't'. A 'boundary' is an integer index
-** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil).
+** Try to find a boundary in table 't'. (A 'boundary' is an integer index
+** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent
+** and 'maxinteger' if t[maxinteger] is present.)
+** (In the next explanation, we use Lua indices, that is, with base 1.
+** The code itself uses base 0 when indexing the array part of the table.)
+** The code starts with 'limit = t->alimit', a position in the array
+** part that may be a boundary.
+**
+** (1) If 't[limit]' is empty, there must be a boundary before it.
+** As a common case (e.g., after 't[#t]=nil'), check whether 'limit-1'
+** is present. If so, it is a boundary. Otherwise, do a binary search
+** between 0 and limit to find a boundary. In both cases, try to
+** use this boundary as the new 'alimit', as a hint for the next call.
+**
+** (2) If 't[limit]' is not empty and the array has more elements
+** after 'limit', try to find a boundary there. Again, try first
+** the special case (which should be quite frequent) where 'limit+1'
+** is empty, so that 'limit' is a boundary. Otherwise, check the
+** last element of the array part. If it is empty, there must be a
+** boundary between the old limit (present) and the last element
+** (absent), which is found with a binary search. (This boundary always
+** can be a new limit.)
+**
+** (3) The last case is when there are no elements in the array part
+** (limit == 0) or its last element (the new limit) is present.
+** In this case, must check the hash part. If there is no hash part
+** or 'limit+1' is absent, 'limit' is a boundary. Otherwise, call
+** 'hash_search' to find a boundary in the hash part of the table.
+** (In those cases, the boundary is not inside the array part, and
+** therefore cannot be used as a new limit.)
*/
lua_Unsigned luaH_getn (Table *t) {
- unsigned int j = t->sizearray;
- if (j > 0 && ttisnil(&t->array[j - 1])) {
- /* there is a boundary in the array part: (binary) search for it */
- unsigned int i = 0;
- while (j - i > 1) {
- unsigned int m = (i+j)/2;
- if (ttisnil(&t->array[m - 1])) j = m;
- else i = m;
+ unsigned int limit = t->alimit;
+ if (limit > 0 && isempty(&t->array[limit - 1])) { /* (1)? */
+ /* there must be a boundary before 'limit' */
+ if (limit >= 2 && !isempty(&t->array[limit - 2])) {
+ /* 'limit - 1' is a boundary; can it be a new limit? */
+ if (ispow2realasize(t) && !ispow2(limit - 1)) {
+ t->alimit = limit - 1;
+ setnorealasize(t); /* now 'alimit' is not the real size */
+ }
+ return limit - 1;
}
- return i;
+ else { /* must search for a boundary in [0, limit] */
+ unsigned int boundary = binsearch(t->array, 0, limit);
+ /* can this boundary represent the real size of the array? */
+ if (ispow2realasize(t) && boundary > luaH_realasize(t) / 2) {
+ t->alimit = boundary; /* use it as the new limit */
+ setnorealasize(t);
+ }
+ return boundary;
+ }
}
- /* else must find a boundary in hash part */
- else if (isdummy(t)) /* hash part is empty? */
- return j; /* that is easy... */
- else return unbound_search(t, j);
+ /* 'limit' is zero or present in table */
+ if (!limitequalsasize(t)) { /* (2)? */
+ /* 'limit' > 0 and array has more elements after 'limit' */
+ if (isempty(&t->array[limit])) /* 'limit + 1' is empty? */
+ return limit; /* this is the boundary */
+ /* else, try last element in the array */
+ limit = luaH_realasize(t);
+ if (isempty(&t->array[limit - 1])) { /* empty? */
+ /* there must be a boundary in the array after old limit,
+ and it must be a valid new limit */
+ unsigned int boundary = binsearch(t->array, t->alimit, limit);
+ t->alimit = boundary;
+ return boundary;
+ }
+ /* else, new limit is present in the table; check the hash part */
+ }
+ /* (3) 'limit' is the last element and either is zero or present in table */
+ lua_assert(limit == luaH_realasize(t) &&
+ (limit == 0 || !isempty(&t->array[limit - 1])));
+ if (isdummy(t) || isempty(luaH_getint(t, cast(lua_Integer, limit + 1))))
+ return limit; /* 'limit + 1' is absent */
+ else /* 'limit + 1' is also present */
+ return hash_search(t, limit);
}
#if defined(LUA_DEBUG)
+/* export these functions for the test library */
+
Node *luaH_mainposition (const Table *t, const TValue *key) {
- return mainposition(t, key);
+ return mainpositionTV(t, key);
}
int luaH_isdummy (const Table *t) { return isdummy(t); }
diff --git a/src/ltable.h b/src/ltable.h
index 92db0ac..ebd7f8e 100644
--- a/src/ltable.h
+++ b/src/ltable.h
@@ -1,5 +1,5 @@
/*
-** $Id: ltable.h,v 2.23.1.2 2018/05/24 19:39:05 roberto Exp $
+** $Id: ltable.h $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
@@ -12,18 +12,9 @@
#define gnode(t,i) (&(t)->node[i])
#define gval(n) (&(n)->i_val)
-#define gnext(n) ((n)->i_key.nk.next)
+#define gnext(n) ((n)->u.next)
-/* 'const' to avoid wrong writings that can mess up field 'next' */
-#define gkey(n) cast(const TValue*, (&(n)->i_key.tvk))
-
-/*
-** writable version of 'gkey'; allows updates to individual fields,
-** but not to the whole (which has incompatible type)
-*/
-#define wgkey(n) (&(n)->i_key.nk)
-
#define invalidateTMcache(t) ((t)->flags = 0)
@@ -35,9 +26,8 @@
#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))
-/* returns the key, given the value of a table entry */
-#define keyfromval(v) \
- (gkey(cast(Node *, cast(char *, (v)) - offsetof(Node, i_val))))
+/* returns the Node, given the value of a table entry */
+#define nodefromval(v) cast(Node *, (v))
LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key);
@@ -55,6 +45,7 @@
LUAI_FUNC void luaH_free (lua_State *L, Table *t);
LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
LUAI_FUNC lua_Unsigned luaH_getn (Table *t);
+LUAI_FUNC unsigned int luaH_realasize (const Table *t);
#if defined(LUA_DEBUG)
diff --git a/src/ltablib.c b/src/ltablib.c
index c534957..d344a47 100644
--- a/src/ltablib.c
+++ b/src/ltablib.c
@@ -1,5 +1,5 @@
/*
-** $Id: ltablib.c,v 1.93.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ltablib.c $
** Library for Table Manipulation
** See Copyright Notice in lua.h
*/
@@ -58,24 +58,6 @@
}
-#if defined(LUA_COMPAT_MAXN)
-static int maxn (lua_State *L) {
- lua_Number max = 0;
- luaL_checktype(L, 1, LUA_TTABLE);
- lua_pushnil(L); /* first key */
- while (lua_next(L, 1)) {
- lua_pop(L, 1); /* remove value */
- if (lua_type(L, -1) == LUA_TNUMBER) {
- lua_Number v = lua_tonumber(L, -1);
- if (v > max) max = v;
- }
- }
- lua_pushnumber(L, max);
- return 1;
-}
-#endif
-
-
static int tinsert (lua_State *L) {
lua_Integer e = aux_getn(L, 1, TAB_RW) + 1; /* first empty element */
lua_Integer pos; /* where to insert new element */
@@ -87,7 +69,9 @@
case 3: {
lua_Integer i;
pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */
- luaL_argcheck(L, 1 <= pos && pos <= e, 2, "position out of bounds");
+ /* check whether 'pos' is in [1, e] */
+ luaL_argcheck(L, (lua_Unsigned)pos - 1u < (lua_Unsigned)e, 2,
+ "position out of bounds");
for (i = e; i > pos; i--) { /* move up elements */
lua_geti(L, 1, i - 1);
lua_seti(L, 1, i); /* t[i] = t[i - 1] */
@@ -107,14 +91,16 @@
lua_Integer size = aux_getn(L, 1, TAB_RW);
lua_Integer pos = luaL_optinteger(L, 2, size);
if (pos != size) /* validate 'pos' if given */
- luaL_argcheck(L, 1 <= pos && pos <= size + 1, 1, "position out of bounds");
+ /* check whether 'pos' is in [1, size + 1] */
+ luaL_argcheck(L, (lua_Unsigned)pos - 1u <= (lua_Unsigned)size, 1,
+ "position out of bounds");
lua_geti(L, 1, pos); /* result = t[pos] */
for ( ; pos < size; pos++) {
lua_geti(L, 1, pos + 1);
lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */
}
lua_pushnil(L);
- lua_seti(L, 1, pos); /* t[pos] = nil */
+ lua_seti(L, 1, pos); /* remove entry t[pos] */
return 1;
}
@@ -191,7 +177,7 @@
** =======================================================
*/
-static int pack (lua_State *L) {
+static int tpack (lua_State *L) {
int i;
int n = lua_gettop(L); /* number of elements to pack */
lua_createtable(L, n, 1); /* create result table */
@@ -204,7 +190,7 @@
}
-static int unpack (lua_State *L) {
+static int tunpack (lua_State *L) {
lua_Unsigned n;
lua_Integer i = luaL_optinteger(L, 2, 1);
lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1));
@@ -313,14 +299,14 @@
/* loop invariant: a[lo .. i] <= P <= a[j .. up] */
for (;;) {
/* next loop: repeat ++i while a[i] < P */
- while (lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {
+ while ((void)lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {
if (i == up - 1) /* a[i] < P but a[up - 1] == P ?? */
luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[i] */
}
/* after the loop, a[i] >= P and a[lo .. i - 1] < P */
/* next loop: repeat --j while P < a[j] */
- while (lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {
+ while ((void)lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {
if (j < i) /* j < i but a[j] > P ?? */
luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[j] */
@@ -352,7 +338,7 @@
/*
-** QuickSort algorithm (recursive function)
+** Quicksort algorithm (recursive function)
*/
static void auxsort (lua_State *L, IdxT lo, IdxT up,
unsigned int rnd) {
@@ -425,12 +411,9 @@
static const luaL_Reg tab_funcs[] = {
{"concat", tconcat},
-#if defined(LUA_COMPAT_MAXN)
- {"maxn", maxn},
-#endif
{"insert", tinsert},
- {"pack", pack},
- {"unpack", unpack},
+ {"pack", tpack},
+ {"unpack", tunpack},
{"remove", tremove},
{"move", tmove},
{"sort", sort},
@@ -440,11 +423,6 @@
LUAMOD_API int luaopen_table (lua_State *L) {
luaL_newlib(L, tab_funcs);
-#if defined(LUA_COMPAT_UNPACK)
- /* _G.unpack = table.unpack */
- lua_getfield(L, -1, "unpack");
- lua_setglobal(L, "unpack");
-#endif
return 1;
}
diff --git a/src/ltm.c b/src/ltm.c
index 0e7c713..ae60983 100644
--- a/src/ltm.c
+++ b/src/ltm.c
@@ -1,5 +1,5 @@
/*
-** $Id: ltm.c,v 2.38.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: ltm.c $
** Tag methods
** See Copyright Notice in lua.h
*/
@@ -16,6 +16,7 @@
#include "ldebug.h"
#include "ldo.h"
+#include "lgc.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
@@ -26,11 +27,11 @@
static const char udatatypename[] = "userdata";
-LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTAGS] = {
+LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTYPES] = {
"no value",
"nil", "boolean", udatatypename, "number",
"string", "table", "function", udatatypename, "thread",
- "proto" /* this last case is used for tests only */
+ "upvalue", "proto" /* these last cases are used for tests only */
};
@@ -42,7 +43,7 @@
"__div", "__idiv",
"__band", "__bor", "__bxor", "__shl", "__shr",
"__unm", "__bnot", "__lt", "__le",
- "__concat", "__call"
+ "__concat", "__call", "__close"
};
int i;
for (i=0; i<TM_N; i++) {
@@ -59,7 +60,7 @@
const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
const TValue *tm = luaH_getshortstr(events, ename);
lua_assert(event <= TM_EQ);
- if (ttisnil(tm)) { /* no tag method? */
+ if (notm(tm)) { /* no tag method? */
events->flags |= cast_byte(1u<<event); /* cache this fact */
return NULL;
}
@@ -69,7 +70,7 @@
const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
Table *mt;
- switch (ttnov(o)) {
+ switch (ttype(o)) {
case LUA_TTABLE:
mt = hvalue(o)->metatable;
break;
@@ -77,9 +78,9 @@
mt = uvalue(o)->metatable;
break;
default:
- mt = G(L)->mt[ttnov(o)];
+ mt = G(L)->mt[ttype(o)];
}
- return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : luaO_nilobject);
+ return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue);
}
@@ -95,54 +96,62 @@
if (ttisstring(name)) /* is '__name' a string? */
return getstr(tsvalue(name)); /* use it as type name */
}
- return ttypename(ttnov(o)); /* else use standard type name */
+ return ttypename(ttype(o)); /* else use standard type name */
}
void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
- const TValue *p2, TValue *p3, int hasres) {
- ptrdiff_t result = savestack(L, p3);
+ const TValue *p2, const TValue *p3) {
+ StkId func = L->top;
+ setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
+ setobj2s(L, func + 1, p1); /* 1st argument */
+ setobj2s(L, func + 2, p2); /* 2nd argument */
+ setobj2s(L, func + 3, p3); /* 3rd argument */
+ L->top = func + 4;
+ /* metamethod may yield only when called from Lua code */
+ if (isLuacode(L->ci))
+ luaD_call(L, func, 0);
+ else
+ luaD_callnoyield(L, func, 0);
+}
+
+
+void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
+ const TValue *p2, StkId res) {
+ ptrdiff_t result = savestack(L, res);
StkId func = L->top;
setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
setobj2s(L, func + 1, p1); /* 1st argument */
setobj2s(L, func + 2, p2); /* 2nd argument */
L->top += 3;
- if (!hasres) /* no result? 'p3' is third argument */
- setobj2s(L, L->top++, p3); /* 3rd argument */
/* metamethod may yield only when called from Lua code */
- if (isLua(L->ci))
- luaD_call(L, func, hasres);
+ if (isLuacode(L->ci))
+ luaD_call(L, func, 1);
else
- luaD_callnoyield(L, func, hasres);
- if (hasres) { /* if has result, move it to its place */
- p3 = restorestack(L, result);
- setobjs2s(L, p3, --L->top);
- }
+ luaD_callnoyield(L, func, 1);
+ res = restorestack(L, result);
+ setobjs2s(L, res, --L->top); /* move result to its place */
}
-int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
- StkId res, TMS event) {
+static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
+ StkId res, TMS event) {
const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */
- if (ttisnil(tm))
+ if (notm(tm))
tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
- if (ttisnil(tm)) return 0;
- luaT_callTM(L, tm, p1, p2, res, 1);
+ if (notm(tm)) return 0;
+ luaT_callTMres(L, tm, p1, p2, res);
return 1;
}
void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
StkId res, TMS event) {
- if (!luaT_callbinTM(L, p1, p2, res, event)) {
+ if (!callbinTM(L, p1, p2, res, event)) {
switch (event) {
- case TM_CONCAT:
- luaG_concaterror(L, p1, p2);
- /* call never returns, but to avoid warnings: *//* FALLTHROUGH */
case TM_BAND: case TM_BOR: case TM_BXOR:
case TM_SHL: case TM_SHR: case TM_BNOT: {
- lua_Number dummy;
- if (tonumber(p1, &dummy) && tonumber(p2, &dummy))
+ if (ttisnumber(p1) && ttisnumber(p2))
luaG_tointerror(L, p1, p2);
else
luaG_opinterror(L, p1, p2, "perform bitwise operation on");
@@ -155,11 +164,107 @@
}
+void luaT_tryconcatTM (lua_State *L) {
+ StkId top = L->top;
+ if (!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2, TM_CONCAT))
+ luaG_concaterror(L, s2v(top - 2), s2v(top - 1));
+}
+
+
+void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
+ int flip, StkId res, TMS event) {
+ if (flip)
+ luaT_trybinTM(L, p2, p1, res, event);
+ else
+ luaT_trybinTM(L, p1, p2, res, event);
+}
+
+
+void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
+ int flip, StkId res, TMS event) {
+ TValue aux;
+ setivalue(&aux, i2);
+ luaT_trybinassocTM(L, p1, &aux, flip, res, event);
+}
+
+
+/*
+** Calls an order tag method.
+** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old
+** behavior: if there is no '__le', try '__lt', based on l <= r iff
+** !(r < l) (assuming a total order). If the metamethod yields during
+** this substitution, the continuation has to know about it (to negate
+** the result of r<l); bit CIST_LEQ in the call status keeps that
+** information.
+*/
int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
TMS event) {
- if (!luaT_callbinTM(L, p1, p2, L->top, event))
- return -1; /* no metamethod */
+ if (callbinTM(L, p1, p2, L->top, event)) /* try original event */
+ return !l_isfalse(s2v(L->top));
+#if defined(LUA_COMPAT_LT_LE)
+ else if (event == TM_LE) {
+ /* try '!(p2 < p1)' for '(p1 <= p2)' */
+ L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
+ if (callbinTM(L, p2, p1, L->top, TM_LT)) {
+ L->ci->callstatus ^= CIST_LEQ; /* clear mark */
+ return l_isfalse(s2v(L->top));
+ }
+ /* else error will remove this 'ci'; no need to clear mark */
+ }
+#endif
+ luaG_ordererror(L, p1, p2); /* no metamethod found */
+ return 0; /* to avoid warnings */
+}
+
+
+int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
+ int flip, int isfloat, TMS event) {
+ TValue aux; const TValue *p2;
+ if (isfloat) {
+ setfltvalue(&aux, cast_num(v2));
+ }
else
- return !l_isfalse(L->top);
+ setivalue(&aux, v2);
+ if (flip) { /* arguments were exchanged? */
+ p2 = p1; p1 = &aux; /* correct them */
+ }
+ else
+ p2 = &aux;
+ return luaT_callorderTM(L, p1, p2, event);
+}
+
+
+void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
+ const Proto *p) {
+ int i;
+ int actual = cast_int(L->top - ci->func) - 1; /* number of arguments */
+ int nextra = actual - nfixparams; /* number of extra arguments */
+ ci->u.l.nextraargs = nextra;
+ checkstackGC(L, p->maxstacksize + 1);
+ /* copy function to the top of the stack */
+ setobjs2s(L, L->top++, ci->func);
+ /* move fixed parameters to the top of the stack */
+ for (i = 1; i <= nfixparams; i++) {
+ setobjs2s(L, L->top++, ci->func + i);
+ setnilvalue(s2v(ci->func + i)); /* erase original parameter (for GC) */
+ }
+ ci->func += actual + 1;
+ ci->top += actual + 1;
+ lua_assert(L->top <= ci->top && ci->top <= L->stack_last);
+}
+
+
+void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
+ int i;
+ int nextra = ci->u.l.nextraargs;
+ if (wanted < 0) {
+ wanted = nextra; /* get all extra arguments available */
+ checkstackp(L, nextra, where); /* ensure stack space */
+ L->top = where + nextra; /* next instruction will need top */
+ }
+ for (i = 0; i < wanted && i < nextra; i++)
+ setobjs2s(L, where + i, ci->func - nextra + i);
+ for (; i < wanted; i++) /* complete required results with nil */
+ setnilvalue(s2v(where + i));
}
diff --git a/src/ltm.h b/src/ltm.h
index 8170688..99b545e 100644
--- a/src/ltm.h
+++ b/src/ltm.h
@@ -1,5 +1,5 @@
/*
-** $Id: ltm.h,v 2.22.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: ltm.h $
** Tag methods
** See Copyright Notice in lua.h
*/
@@ -40,10 +40,17 @@
TM_LE,
TM_CONCAT,
TM_CALL,
+ TM_CLOSE,
TM_N /* number of elements in the enum */
} TMS;
+/*
+** Test whether there is no tagmethod.
+** (Because tagmethods use raw accesses, the result may be an "empty" nil.)
+*/
+#define notm(tm) ttisnil(tm)
+
#define gfasttm(g,et,e) ((et) == NULL ? NULL : \
((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
@@ -52,7 +59,7 @@
#define ttypename(x) luaT_typenames_[(x) + 1]
-LUAI_DDEC const char *const luaT_typenames_[LUA_TOTALTAGS];
+LUAI_DDEC(const char *const luaT_typenames_[LUA_TOTALTYPES];)
LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);
@@ -63,14 +70,25 @@
LUAI_FUNC void luaT_init (lua_State *L);
LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
- const TValue *p2, TValue *p3, int hasres);
-LUAI_FUNC int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
- StkId res, TMS event);
+ const TValue *p2, const TValue *p3);
+LUAI_FUNC void luaT_callTMres (lua_State *L, const TValue *f,
+ const TValue *p1, const TValue *p2, StkId p3);
LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
StkId res, TMS event);
+LUAI_FUNC void luaT_tryconcatTM (lua_State *L);
+LUAI_FUNC void luaT_trybinassocTM (lua_State *L, const TValue *p1,
+ const TValue *p2, int inv, StkId res, TMS event);
+LUAI_FUNC void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
+ int inv, StkId res, TMS event);
LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,
const TValue *p2, TMS event);
+LUAI_FUNC int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
+ int inv, int isfloat, TMS event);
+LUAI_FUNC void luaT_adjustvarargs (lua_State *L, int nfixparams,
+ struct CallInfo *ci, const Proto *p);
+LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci,
+ StkId where, int wanted);
#endif
diff --git a/src/lua.c b/src/lua.c
index ca5b298..454ce12 100644
--- a/src/lua.c
+++ b/src/lua.c
@@ -1,5 +1,5 @@
/*
-** $Id: lua.c,v 1.230.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: lua.c $
** Lua stand-alone interpreter
** See Copyright Notice in lua.h
*/
@@ -9,31 +9,22 @@
#include "lprefix.h"
-#include <signal.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <signal.h>
+
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
-
-#if !defined(LUA_PROMPT)
-#define LUA_PROMPT "> "
-#define LUA_PROMPT2 ">> "
-#endif
-
#if !defined(LUA_PROGNAME)
#define LUA_PROGNAME "lua"
#endif
-#if !defined(LUA_MAXINPUT)
-#define LUA_MAXINPUT 512
-#endif
-
#if !defined(LUA_INIT_VAR)
#define LUA_INIT_VAR "LUA_INIT"
#endif
@@ -41,65 +32,6 @@
#define LUA_INITVARVERSION LUA_INIT_VAR LUA_VERSUFFIX
-/*
-** lua_stdin_is_tty detects whether the standard input is a 'tty' (that
-** is, whether we're running lua interactively).
-*/
-#if !defined(lua_stdin_is_tty) /* { */
-
-#if defined(LUA_USE_POSIX) /* { */
-
-#include <unistd.h>
-#define lua_stdin_is_tty() isatty(0)
-
-#elif defined(LUA_USE_WINDOWS) /* }{ */
-
-#include <io.h>
-#include <windows.h>
-
-#define lua_stdin_is_tty() _isatty(_fileno(stdin))
-
-#else /* }{ */
-
-/* ISO C definition */
-#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
-
-#endif /* } */
-
-#endif /* } */
-
-
-/*
-** lua_readline defines how to show a prompt and then read a line from
-** the standard input.
-** lua_saveline defines how to "save" a read line in a "history".
-** lua_freeline defines how to free a line read by lua_readline.
-*/
-#if !defined(lua_readline) /* { */
-
-#if defined(LUA_USE_READLINE) /* { */
-
-#include <readline/readline.h>
-#include <readline/history.h>
-#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL)
-#define lua_saveline(L,line) ((void)L, add_history(line))
-#define lua_freeline(L,b) ((void)L, free(b))
-
-#else /* }{ */
-
-#define lua_readline(L,b,p) \
- ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \
- fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */
-#define lua_saveline(L,line) { (void)L; (void)line; }
-#define lua_freeline(L,b) { (void)L; (void)b; }
-
-#endif /* } */
-
-#endif /* } */
-
-
-
-
static lua_State *globalL = NULL;
static const char *progname = LUA_PROGNAME;
@@ -122,8 +54,9 @@
** interpreter.
*/
static void laction (int i) {
+ int flag = LUA_MASKCALL | LUA_MASKRET | LUA_MASKLINE | LUA_MASKCOUNT;
signal(i, SIG_DFL); /* if another SIGINT happens, terminate process */
- lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1);
+ lua_sethook(globalL, lstop, flag, 1);
}
@@ -141,6 +74,7 @@
" -l name require library 'name' into global 'name'\n"
" -v show version information\n"
" -E ignore environment variables\n"
+ " -W turn warnings on\n"
" -- stop handling options\n"
" - stop handling options and execute stdin\n"
,
@@ -268,6 +202,220 @@
/*
+** Push on the stack the contents of table 'arg' from 1 to #arg
+*/
+static int pushargs (lua_State *L) {
+ int i, n;
+ if (lua_getglobal(L, "arg") != LUA_TTABLE)
+ luaL_error(L, "'arg' is not a table");
+ n = (int)luaL_len(L, -1);
+ luaL_checkstack(L, n + 3, "too many arguments to script");
+ for (i = 1; i <= n; i++)
+ lua_rawgeti(L, -i, i);
+ lua_remove(L, -i); /* remove table from the stack */
+ return n;
+}
+
+
+static int handle_script (lua_State *L, char **argv) {
+ int status;
+ const char *fname = argv[0];
+ if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
+ fname = NULL; /* stdin */
+ status = luaL_loadfile(L, fname);
+ if (status == LUA_OK) {
+ int n = pushargs(L); /* push arguments to script */
+ status = docall(L, n, LUA_MULTRET);
+ }
+ return report(L, status);
+}
+
+
+/* bits of various argument indicators in 'args' */
+#define has_error 1 /* bad option */
+#define has_i 2 /* -i */
+#define has_v 4 /* -v */
+#define has_e 8 /* -e */
+#define has_E 16 /* -E */
+
+
+/*
+** Traverses all arguments from 'argv', returning a mask with those
+** needed before running any Lua code (or an error code if it finds
+** any invalid argument). 'first' returns the first not-handled argument
+** (either the script name or a bad argument in case of error).
+*/
+static int collectargs (char **argv, int *first) {
+ int args = 0;
+ int i;
+ for (i = 1; argv[i] != NULL; i++) {
+ *first = i;
+ if (argv[i][0] != '-') /* not an option? */
+ return args; /* stop handling options */
+ switch (argv[i][1]) { /* else check option */
+ case '-': /* '--' */
+ if (argv[i][2] != '\0') /* extra characters after '--'? */
+ return has_error; /* invalid option */
+ *first = i + 1;
+ return args;
+ case '\0': /* '-' */
+ return args; /* script "name" is '-' */
+ case 'E':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ args |= has_E;
+ break;
+ case 'W':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ break;
+ case 'i':
+ args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */
+ case 'v':
+ if (argv[i][2] != '\0') /* extra characters? */
+ return has_error; /* invalid option */
+ args |= has_v;
+ break;
+ case 'e':
+ args |= has_e; /* FALLTHROUGH */
+ case 'l': /* both options need an argument */
+ if (argv[i][2] == '\0') { /* no concatenated argument? */
+ i++; /* try next 'argv' */
+ if (argv[i] == NULL || argv[i][0] == '-')
+ return has_error; /* no next argument or it is another option */
+ }
+ break;
+ default: /* invalid option */
+ return has_error;
+ }
+ }
+ *first = i; /* no script name */
+ return args;
+}
+
+
+/*
+** Processes options 'e' and 'l', which involve running Lua code, and
+** 'W', which also affects the state.
+** Returns 0 if some code raises an error.
+*/
+static int runargs (lua_State *L, char **argv, int n) {
+ int i;
+ for (i = 1; i < n; i++) {
+ int option = argv[i][1];
+ lua_assert(argv[i][0] == '-'); /* already checked */
+ switch (option) {
+ case 'e': case 'l': {
+ int status;
+ const char *extra = argv[i] + 2; /* both options need an argument */
+ if (*extra == '\0') extra = argv[++i];
+ lua_assert(extra != NULL);
+ status = (option == 'e')
+ ? dostring(L, extra, "=(command line)")
+ : dolibrary(L, extra);
+ if (status != LUA_OK) return 0;
+ break;
+ }
+ case 'W':
+ lua_warning(L, "@on", 0); /* warnings on */
+ break;
+ }
+ }
+ return 1;
+}
+
+
+static int handle_luainit (lua_State *L) {
+ const char *name = "=" LUA_INITVARVERSION;
+ const char *init = getenv(name + 1);
+ if (init == NULL) {
+ name = "=" LUA_INIT_VAR;
+ init = getenv(name + 1); /* try alternative name */
+ }
+ if (init == NULL) return LUA_OK;
+ else if (init[0] == '@')
+ return dofile(L, init+1);
+ else
+ return dostring(L, init, name);
+}
+
+
+/*
+** {==================================================================
+** Read-Eval-Print Loop (REPL)
+** ===================================================================
+*/
+
+#if !defined(LUA_PROMPT)
+#define LUA_PROMPT "> "
+#define LUA_PROMPT2 ">> "
+#endif
+
+#if !defined(LUA_MAXINPUT)
+#define LUA_MAXINPUT 512
+#endif
+
+
+/*
+** lua_stdin_is_tty detects whether the standard input is a 'tty' (that
+** is, whether we're running lua interactively).
+*/
+#if !defined(lua_stdin_is_tty) /* { */
+
+#if defined(LUA_USE_POSIX) /* { */
+
+#include <unistd.h>
+#define lua_stdin_is_tty() isatty(0)
+
+#elif defined(LUA_USE_WINDOWS) /* }{ */
+
+#include <io.h>
+#include <windows.h>
+
+#define lua_stdin_is_tty() _isatty(_fileno(stdin))
+
+#else /* }{ */
+
+/* ISO C definition */
+#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
+
+#endif /* } */
+
+#endif /* } */
+
+
+/*
+** lua_readline defines how to show a prompt and then read a line from
+** the standard input.
+** lua_saveline defines how to "save" a read line in a "history".
+** lua_freeline defines how to free a line read by lua_readline.
+*/
+#if !defined(lua_readline) /* { */
+
+#if defined(LUA_USE_READLINE) /* { */
+
+#include <readline/readline.h>
+#include <readline/history.h>
+#define lua_initreadline(L) ((void)L, rl_readline_name="lua")
+#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL)
+#define lua_saveline(L,line) ((void)L, add_history(line))
+#define lua_freeline(L,b) ((void)L, free(b))
+
+#else /* }{ */
+
+#define lua_initreadline(L) ((void)L)
+#define lua_readline(L,b,p) \
+ ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \
+ fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */
+#define lua_saveline(L,line) { (void)L; (void)line; }
+#define lua_freeline(L,b) { (void)L; (void)b; }
+
+#endif /* } */
+
+#endif /* } */
+
+
+/*
** Returns the string to be used as a prompt by the interpreter.
*/
static const char *get_prompt (lua_State *L, int firstline) {
@@ -406,6 +554,7 @@
int status;
const char *oldprogname = progname;
progname = NULL; /* no 'progname' on errors in interactive mode */
+ lua_initreadline(L);
while ((status = loadline(L)) != -1) {
if (status == LUA_OK)
status = docall(L, 0, LUA_MULTRET);
@@ -417,134 +566,7 @@
progname = oldprogname;
}
-
-/*
-** Push on the stack the contents of table 'arg' from 1 to #arg
-*/
-static int pushargs (lua_State *L) {
- int i, n;
- if (lua_getglobal(L, "arg") != LUA_TTABLE)
- luaL_error(L, "'arg' is not a table");
- n = (int)luaL_len(L, -1);
- luaL_checkstack(L, n + 3, "too many arguments to script");
- for (i = 1; i <= n; i++)
- lua_rawgeti(L, -i, i);
- lua_remove(L, -i); /* remove table from the stack */
- return n;
-}
-
-
-static int handle_script (lua_State *L, char **argv) {
- int status;
- const char *fname = argv[0];
- if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
- fname = NULL; /* stdin */
- status = luaL_loadfile(L, fname);
- if (status == LUA_OK) {
- int n = pushargs(L); /* push arguments to script */
- status = docall(L, n, LUA_MULTRET);
- }
- return report(L, status);
-}
-
-
-
-/* bits of various argument indicators in 'args' */
-#define has_error 1 /* bad option */
-#define has_i 2 /* -i */
-#define has_v 4 /* -v */
-#define has_e 8 /* -e */
-#define has_E 16 /* -E */
-
-/*
-** Traverses all arguments from 'argv', returning a mask with those
-** needed before running any Lua code (or an error code if it finds
-** any invalid argument). 'first' returns the first not-handled argument
-** (either the script name or a bad argument in case of error).
-*/
-static int collectargs (char **argv, int *first) {
- int args = 0;
- int i;
- for (i = 1; argv[i] != NULL; i++) {
- *first = i;
- if (argv[i][0] != '-') /* not an option? */
- return args; /* stop handling options */
- switch (argv[i][1]) { /* else check option */
- case '-': /* '--' */
- if (argv[i][2] != '\0') /* extra characters after '--'? */
- return has_error; /* invalid option */
- *first = i + 1;
- return args;
- case '\0': /* '-' */
- return args; /* script "name" is '-' */
- case 'E':
- if (argv[i][2] != '\0') /* extra characters after 1st? */
- return has_error; /* invalid option */
- args |= has_E;
- break;
- case 'i':
- args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */
- case 'v':
- if (argv[i][2] != '\0') /* extra characters after 1st? */
- return has_error; /* invalid option */
- args |= has_v;
- break;
- case 'e':
- args |= has_e; /* FALLTHROUGH */
- case 'l': /* both options need an argument */
- if (argv[i][2] == '\0') { /* no concatenated argument? */
- i++; /* try next 'argv' */
- if (argv[i] == NULL || argv[i][0] == '-')
- return has_error; /* no next argument or it is another option */
- }
- break;
- default: /* invalid option */
- return has_error;
- }
- }
- *first = i; /* no script name */
- return args;
-}
-
-
-/*
-** Processes options 'e' and 'l', which involve running Lua code.
-** Returns 0 if some code raises an error.
-*/
-static int runargs (lua_State *L, char **argv, int n) {
- int i;
- for (i = 1; i < n; i++) {
- int option = argv[i][1];
- lua_assert(argv[i][0] == '-'); /* already checked */
- if (option == 'e' || option == 'l') {
- int status;
- const char *extra = argv[i] + 2; /* both options need an argument */
- if (*extra == '\0') extra = argv[++i];
- lua_assert(extra != NULL);
- status = (option == 'e')
- ? dostring(L, extra, "=(command line)")
- : dolibrary(L, extra);
- if (status != LUA_OK) return 0;
- }
- }
- return 1;
-}
-
-
-
-static int handle_luainit (lua_State *L) {
- const char *name = "=" LUA_INITVARVERSION;
- const char *init = getenv(name + 1);
- if (init == NULL) {
- name = "=" LUA_INIT_VAR;
- init = getenv(name + 1); /* try alternative name */
- }
- if (init == NULL) return LUA_OK;
- else if (init[0] == '@')
- return dofile(L, init+1);
- else
- return dostring(L, init, name);
-}
+/* }================================================================== */
/*
@@ -570,6 +592,7 @@
}
luaL_openlibs(L); /* open standard libraries */
createargtable(L, argv, argc, script); /* create table 'arg' */
+ lua_gc(L, LUA_GCGEN, 0, 0); /* GC in generational mode */
if (!(args & has_E)) { /* no option '-E'? */
if (handle_luainit(L) != LUA_OK) /* run LUA_INIT */
return 0; /* error running LUA_INIT */
diff --git a/src/lua.h b/src/lua.h
index c236e36..b348c14 100644
--- a/src/lua.h
+++ b/src/lua.h
@@ -1,5 +1,5 @@
/*
-** $Id: lua.h,v 1.332.1.2 2018/06/13 16:58:17 roberto Exp $
+** $Id: lua.h $
** Lua - A Scripting Language
** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
** See Copyright Notice at the end of this file
@@ -17,13 +17,15 @@
#define LUA_VERSION_MAJOR "5"
-#define LUA_VERSION_MINOR "3"
-#define LUA_VERSION_NUM 503
-#define LUA_VERSION_RELEASE "5"
+#define LUA_VERSION_MINOR "4"
+#define LUA_VERSION_RELEASE "0"
+
+#define LUA_VERSION_NUM 504
+#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + 0)
#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE
-#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2018 Lua.org, PUC-Rio"
+#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2020 Lua.org, PUC-Rio"
#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes"
@@ -49,8 +51,7 @@
#define LUA_ERRRUN 2
#define LUA_ERRSYNTAX 3
#define LUA_ERRMEM 4
-#define LUA_ERRGCMM 5
-#define LUA_ERRERR 6
+#define LUA_ERRERR 5
typedef struct lua_State lua_State;
@@ -71,7 +72,7 @@
#define LUA_TUSERDATA 7
#define LUA_TTHREAD 8
-#define LUA_NUMTAGS 9
+#define LUA_NUMTYPES 9
@@ -124,6 +125,13 @@
typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
+/*
+** Type for warning functions
+*/
+typedef void (*lua_WarnFunction) (void *ud, const char *msg, int tocont);
+
+
+
/*
** generic extra include file
@@ -145,11 +153,12 @@
LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud);
LUA_API void (lua_close) (lua_State *L);
LUA_API lua_State *(lua_newthread) (lua_State *L);
+LUA_API int (lua_resetthread) (lua_State *L);
LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf);
-LUA_API const lua_Number *(lua_version) (lua_State *L);
+LUA_API lua_Number (lua_version) (lua_State *L);
/*
@@ -182,7 +191,7 @@
LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum);
LUA_API int (lua_toboolean) (lua_State *L, int idx);
LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len);
-LUA_API size_t (lua_rawlen) (lua_State *L, int idx);
+LUA_API lua_Unsigned (lua_rawlen) (lua_State *L, int idx);
LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx);
LUA_API void *(lua_touserdata) (lua_State *L, int idx);
LUA_API lua_State *(lua_tothread) (lua_State *L, int idx);
@@ -247,9 +256,9 @@
LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p);
LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec);
-LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz);
+LUA_API void *(lua_newuserdatauv) (lua_State *L, size_t sz, int nuvalue);
LUA_API int (lua_getmetatable) (lua_State *L, int objindex);
-LUA_API int (lua_getuservalue) (lua_State *L, int idx);
+LUA_API int (lua_getiuservalue) (lua_State *L, int idx, int n);
/*
@@ -263,7 +272,7 @@
LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n);
LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p);
LUA_API int (lua_setmetatable) (lua_State *L, int objindex);
-LUA_API void (lua_setuservalue) (lua_State *L, int idx);
+LUA_API int (lua_setiuservalue) (lua_State *L, int idx, int n);
/*
@@ -288,7 +297,8 @@
*/
LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx,
lua_KFunction k);
-LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg);
+LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg,
+ int *nres);
LUA_API int (lua_status) (lua_State *L);
LUA_API int (lua_isyieldable) (lua_State *L);
@@ -296,6 +306,13 @@
/*
+** Warning-related functions
+*/
+LUA_API void (lua_setwarnf) (lua_State *L, lua_WarnFunction f, void *ud);
+LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont);
+
+
+/*
** garbage-collection function and options
*/
@@ -308,8 +325,10 @@
#define LUA_GCSETPAUSE 6
#define LUA_GCSETSTEPMUL 7
#define LUA_GCISRUNNING 9
+#define LUA_GCGEN 10
+#define LUA_GCINC 11
-LUA_API int (lua_gc) (lua_State *L, int what, int data);
+LUA_API int (lua_gc) (lua_State *L, int what, ...);
/*
@@ -328,6 +347,7 @@
LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);
LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud);
+LUA_API void (lua_toclose) (lua_State *L, int idx);
/*
@@ -377,7 +397,7 @@
/*
** {==============================================================
-** compatibility macros for unsigned conversions
+** compatibility macros
** ===============================================================
*/
#if defined(LUA_COMPAT_APIINTCASTS)
@@ -387,6 +407,13 @@
#define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL)
#endif
+
+#define lua_newuserdata(L,s) lua_newuserdatauv(L,s,1)
+#define lua_getuservalue(L,idx) lua_getiuservalue(L,idx,1)
+#define lua_setuservalue(L,idx) lua_setiuservalue(L,idx,1)
+
+#define LUA_NUMTAGS LUA_NUMTYPES
+
/* }============================================================== */
/*
@@ -437,6 +464,7 @@
LUA_API int (lua_gethookmask) (lua_State *L);
LUA_API int (lua_gethookcount) (lua_State *L);
+LUA_API int (lua_setcstacklimit) (lua_State *L, unsigned int limit);
struct lua_Debug {
int event;
@@ -444,6 +472,7 @@
const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */
const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */
const char *source; /* (S) */
+ size_t srclen; /* (S) */
int currentline; /* (l) */
int linedefined; /* (S) */
int lastlinedefined; /* (S) */
@@ -451,6 +480,8 @@
unsigned char nparams;/* (u) number of parameters */
char isvararg; /* (u) */
char istailcall; /* (t) */
+ unsigned short ftransfer; /* (r) index of first value transferred */
+ unsigned short ntransfer; /* (r) number of transferred values */
char short_src[LUA_IDSIZE]; /* (S) */
/* private part */
struct CallInfo *i_ci; /* active function */
@@ -460,7 +491,7 @@
/******************************************************************************
-* Copyright (C) 1994-2018 Lua.org, PUC-Rio.
+* Copyright (C) 1994-2020 Lua.org, PUC-Rio.
*
* Permission is hereby granted, free of charge, to any person obtaining
* a copy of this software and associated documentation files (the
diff --git a/src/luac.c b/src/luac.c
index 549ad39..56ddc41 100644
--- a/src/luac.c
+++ b/src/luac.c
@@ -1,5 +1,5 @@
/*
-** $Id: luac.c,v 1.76 2018/06/19 01:32:02 lhf Exp $
+** $Id: luac.c $
** Lua compiler (saves bytecodes to files; also lists bytecodes)
** See Copyright Notice in lua.h
*/
@@ -18,7 +18,10 @@
#include "lua.h"
#include "lauxlib.h"
+#include "ldebug.h"
#include "lobject.h"
+#include "lopcodes.h"
+#include "lopnames.h"
#include "lstate.h"
#include "lundump.h"
@@ -34,6 +37,7 @@
static char Output[]={ OUTPUT }; /* default output file name */
static const char* output=Output; /* actual output file name */
static const char* progname=PROGNAME; /* actual program name */
+static TString **tmname;
static void fatal(const char* message)
{
@@ -119,7 +123,7 @@
#define FUNCTION "(function()end)();"
-static const char* reader(lua_State *L, void *ud, size_t *size)
+static const char* reader(lua_State* L, void* ud, size_t* size)
{
UNUSED(L);
if ((*(int*)ud)--)
@@ -134,7 +138,7 @@
}
}
-#define toproto(L,i) getproto(L->top+(i))
+#define toproto(L,i) getproto(s2v(L->top+(i)))
static const Proto* combine(lua_State* L, int n)
{
@@ -168,6 +172,7 @@
char** argv=(char**)lua_touserdata(L,2);
const Proto* f;
int i;
+ tmname=G(L)->tmname;
if (!lua_checkstack(L,argc)) fatal("too many input files");
for (i=0; i<argc; i++)
{
@@ -206,63 +211,102 @@
}
/*
-** $Id: luac.c,v 1.76 2018/06/19 01:32:02 lhf Exp $
** print bytecodes
-** See Copyright Notice in lua.h
*/
-#include <ctype.h>
-#include <stdio.h>
-
-#define luac_c
-#define LUA_CORE
-
-#include "ldebug.h"
-#include "lobject.h"
-#include "lopcodes.h"
-
-#define VOID(p) ((const void*)(p))
+#define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
+#define VOID(p) ((const void*)(p))
+#define eventname(i) (getstr(tmname[i]))
static void PrintString(const TString* ts)
{
const char* s=getstr(ts);
size_t i,n=tsslen(ts);
- printf("%c",'"');
+ printf("\"");
for (i=0; i<n; i++)
{
int c=(int)(unsigned char)s[i];
switch (c)
{
- case '"': printf("\\\""); break;
- case '\\': printf("\\\\"); break;
- case '\a': printf("\\a"); break;
- case '\b': printf("\\b"); break;
- case '\f': printf("\\f"); break;
- case '\n': printf("\\n"); break;
- case '\r': printf("\\r"); break;
- case '\t': printf("\\t"); break;
- case '\v': printf("\\v"); break;
- default: if (isprint(c))
- printf("%c",c);
- else
- printf("\\%03d",c);
+ case '"':
+ printf("\\\"");
+ break;
+ case '\\':
+ printf("\\\\");
+ break;
+ case '\a':
+ printf("\\a");
+ break;
+ case '\b':
+ printf("\\b");
+ break;
+ case '\f':
+ printf("\\f");
+ break;
+ case '\n':
+ printf("\\n");
+ break;
+ case '\r':
+ printf("\\r");
+ break;
+ case '\t':
+ printf("\\t");
+ break;
+ case '\v':
+ printf("\\v");
+ break;
+ default:
+ if (isprint(c)) printf("%c",c); else printf("\\%03d",c);
+ break;
}
}
- printf("%c",'"');
+ printf("\"");
+}
+
+static void PrintType(const Proto* f, int i)
+{
+ const TValue* o=&f->k[i];
+ switch (ttypetag(o))
+ {
+ case LUA_VNIL:
+ printf("N");
+ break;
+ case LUA_VFALSE:
+ case LUA_VTRUE:
+ printf("B");
+ break;
+ case LUA_VNUMFLT:
+ printf("F");
+ break;
+ case LUA_VNUMINT:
+ printf("I");
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ printf("S");
+ break;
+ default: /* cannot happen */
+ printf("?%d",ttypetag(o));
+ break;
+ }
+ printf("\t");
}
static void PrintConstant(const Proto* f, int i)
{
const TValue* o=&f->k[i];
- switch (ttype(o))
+ switch (ttypetag(o))
{
- case LUA_TNIL:
+ case LUA_VNIL:
printf("nil");
break;
- case LUA_TBOOLEAN:
- printf(bvalue(o) ? "true" : "false");
+ case LUA_VFALSE:
+ printf("false");
break;
- case LUA_TNUMFLT:
+ case LUA_VTRUE:
+ printf("true");
+ break;
+ case LUA_VNUMFLT:
{
char buff[100];
sprintf(buff,LUA_NUMBER_FMT,fltvalue(o));
@@ -270,20 +314,23 @@
if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0");
break;
}
- case LUA_TNUMINT:
+ case LUA_VNUMINT:
printf(LUA_INTEGER_FMT,ivalue(o));
break;
- case LUA_TSHRSTR: case LUA_TLNGSTR:
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
PrintString(tsvalue(o));
break;
default: /* cannot happen */
- printf("? type=%d",ttype(o));
+ printf("?%d",ttypetag(o));
break;
}
}
-#define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
-#define MYK(x) (-1-(x))
+#define COMMENT "\t; "
+#define EXTRAARG GETARG_Ax(code[pc+1])
+#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
+#define ISK (isk ? "k" : "")
static void PrintCode(const Proto* f)
{
@@ -298,98 +345,324 @@
int c=GETARG_C(i);
int ax=GETARG_Ax(i);
int bx=GETARG_Bx(i);
+ int sb=GETARG_sB(i);
+ int sc=GETARG_sC(i);
int sbx=GETARG_sBx(i);
- int line=getfuncline(f,pc);
+ int isk=GETARG_k(i);
+ int line=luaG_getfuncline(f,pc);
printf("\t%d\t",pc+1);
if (line>0) printf("[%d]\t",line); else printf("[-]\t");
- printf("%-9s\t",luaP_opnames[o]);
- switch (getOpMode(o))
- {
- case iABC:
- printf("%d",a);
- if (getBMode(o)!=OpArgN) printf(" %d",ISK(b) ? (MYK(INDEXK(b))) : b);
- if (getCMode(o)!=OpArgN) printf(" %d",ISK(c) ? (MYK(INDEXK(c))) : c);
- break;
- case iABx:
- printf("%d",a);
- if (getBMode(o)==OpArgK) printf(" %d",MYK(bx));
- if (getBMode(o)==OpArgU) printf(" %d",bx);
- break;
- case iAsBx:
- printf("%d %d",a,sbx);
- break;
- case iAx:
- printf("%d",MYK(ax));
- break;
- }
+ printf("%-9s\t",opnames[o]);
switch (o)
{
+ case OP_MOVE:
+ printf("%d %d",a,b);
+ break;
+ case OP_LOADI:
+ printf("%d %d",a,sbx);
+ break;
+ case OP_LOADF:
+ printf("%d %d",a,sbx);
+ break;
case OP_LOADK:
- printf("\t; "); PrintConstant(f,bx);
- break;
+ printf("%d %d",a,bx);
+ printf(COMMENT); PrintConstant(f,bx);
+ break;
+ case OP_LOADKX:
+ printf("%d",a);
+ printf(COMMENT); PrintConstant(f,EXTRAARG);
+ break;
+ case OP_LOADFALSE:
+ printf("%d",a);
+ break;
+ case OP_LFALSESKIP:
+ printf("%d",a);
+ break;
+ case OP_LOADTRUE:
+ printf("%d",a);
+ break;
+ case OP_LOADNIL:
+ printf("%d %d",a,b);
+ printf(COMMENT "%d out",b+1);
+ break;
case OP_GETUPVAL:
+ printf("%d %d",a,b);
+ printf(COMMENT "%s",UPVALNAME(b));
+ break;
case OP_SETUPVAL:
- printf("\t; %s",UPVALNAME(b));
- break;
+ printf("%d %d",a,b);
+ printf(COMMENT "%s",UPVALNAME(b));
+ break;
case OP_GETTABUP:
- printf("\t; %s",UPVALNAME(b));
- if (ISK(c)) { printf(" "); PrintConstant(f,INDEXK(c)); }
- break;
- case OP_SETTABUP:
- printf("\t; %s",UPVALNAME(a));
- if (ISK(b)) { printf(" "); PrintConstant(f,INDEXK(b)); }
- if (ISK(c)) { printf(" "); PrintConstant(f,INDEXK(c)); }
- break;
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%s",UPVALNAME(b));
+ printf(" "); PrintConstant(f,c);
+ break;
case OP_GETTABLE:
- case OP_SELF:
- if (ISK(c)) { printf("\t; "); PrintConstant(f,INDEXK(c)); }
- break;
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_GETI:
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_GETFIELD:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SETTABUP:
+ printf("%d %d %d%s",a,b,c,ISK);
+ printf(COMMENT "%s",UPVALNAME(a));
+ printf(" "); PrintConstant(f,b);
+ if (isk) { printf(" "); PrintConstant(f,c); }
+ break;
case OP_SETTABLE:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_SETI:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_SETFIELD:
+ printf("%d %d %d%s",a,b,c,ISK);
+ printf(COMMENT); PrintConstant(f,b);
+ if (isk) { printf(" "); PrintConstant(f,c); }
+ break;
+ case OP_NEWTABLE:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%d",c+EXTRAARGC);
+ break;
+ case OP_SELF:
+ printf("%d %d %d%s",a,b,c,ISK);
+ if (isk) { printf(COMMENT); PrintConstant(f,c); }
+ break;
+ case OP_ADDI:
+ printf("%d %d %d",a,b,sc);
+ break;
+ case OP_ADDK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SUBK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_MULK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_MODK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_POWK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_DIVK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_IDIVK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BANDK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BORK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_BXORK:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT); PrintConstant(f,c);
+ break;
+ case OP_SHRI:
+ printf("%d %d %d",a,b,sc);
+ break;
+ case OP_SHLI:
+ printf("%d %d %d",a,b,sc);
+ break;
case OP_ADD:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_SUB:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_MUL:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_MOD:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_POW:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_DIV:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_IDIV:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_BAND:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_BOR:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_BXOR:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_SHL:
+ printf("%d %d %d",a,b,c);
+ break;
case OP_SHR:
- case OP_EQ:
- case OP_LT:
- case OP_LE:
- if (ISK(b) || ISK(c))
- {
- printf("\t; ");
- if (ISK(b)) PrintConstant(f,INDEXK(b)); else printf("-");
- printf(" ");
- if (ISK(c)) PrintConstant(f,INDEXK(c)); else printf("-");
- }
- break;
+ printf("%d %d %d",a,b,c);
+ break;
+ case OP_MMBIN:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%s",eventname(c));
+ break;
+ case OP_MMBINI:
+ printf("%d %d %d %d",a,sb,c,isk);
+ printf(COMMENT "%s",eventname(c));
+ if (isk) printf(" flip");
+ break;
+ case OP_MMBINK:
+ printf("%d %d %d %d",a,b,c,isk);
+ printf(COMMENT "%s ",eventname(c)); PrintConstant(f,b);
+ if (isk) printf(" flip");
+ break;
+ case OP_UNM:
+ printf("%d %d",a,b);
+ break;
+ case OP_BNOT:
+ printf("%d %d",a,b);
+ break;
+ case OP_NOT:
+ printf("%d %d",a,b);
+ break;
+ case OP_LEN:
+ printf("%d %d",a,b);
+ break;
+ case OP_CONCAT:
+ printf("%d %d",a,b);
+ break;
+ case OP_CLOSE:
+ printf("%d",a);
+ break;
+ case OP_TBC:
+ printf("%d",a);
+ break;
case OP_JMP:
+ printf("%d",GETARG_sJ(i));
+ printf(COMMENT "to %d",GETARG_sJ(i)+pc+2);
+ break;
+ case OP_EQ:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_LT:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_LE:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_EQK:
+ printf("%d %d %d",a,b,isk);
+ printf(COMMENT); PrintConstant(f,b);
+ break;
+ case OP_EQI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_LTI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_LEI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_GTI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_GEI:
+ printf("%d %d %d",a,sb,isk);
+ break;
+ case OP_TEST:
+ printf("%d %d",a,isk);
+ break;
+ case OP_TESTSET:
+ printf("%d %d %d",a,b,isk);
+ break;
+ case OP_CALL:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT);
+ if (b==0) printf("all in "); else printf("%d in ",b-1);
+ if (c==0) printf("all out"); else printf("%d out",c-1);
+ break;
+ case OP_TAILCALL:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "%d in",b-1);
+ break;
+ case OP_RETURN:
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT);
+ if (b==0) printf("all out"); else printf("%d out",b-1);
+ break;
+ case OP_RETURN0:
+ break;
+ case OP_RETURN1:
+ printf("%d",a);
+ break;
case OP_FORLOOP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc-bx+2);
+ break;
case OP_FORPREP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc+bx+2);
+ break;
+ case OP_TFORPREP:
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc+bx+2);
+ break;
+ case OP_TFORCALL:
+ printf("%d %d",a,c);
+ break;
case OP_TFORLOOP:
- printf("\t; to %d",sbx+pc+2);
- break;
- case OP_CLOSURE:
- printf("\t; %p",VOID(f->p[bx]));
- break;
+ printf("%d %d",a,bx);
+ printf(COMMENT "to %d",pc-bx+2);
+ break;
case OP_SETLIST:
- if (c==0) printf("\t; %d",(int)code[++pc]); else printf("\t; %d",c);
- break;
+ printf("%d %d %d",a,b,c);
+ if (isk) printf(COMMENT "%d",c+EXTRAARGC);
+ break;
+ case OP_CLOSURE:
+ printf("%d %d",a,bx);
+ printf(COMMENT "%p",VOID(f->p[bx]));
+ break;
+ case OP_VARARG:
+ printf("%d %d",a,c);
+ printf(COMMENT);
+ if (c==0) printf("all out"); else printf("%d out",c-1);
+ break;
+ case OP_VARARGPREP:
+ printf("%d",a);
+ break;
case OP_EXTRAARG:
- printf("\t; "); PrintConstant(f,ax);
- break;
+ printf("%d",ax);
+ break;
+#if 0
default:
- break;
+ printf("%d %d %d",a,b,c);
+ printf(COMMENT "not handled");
+ break;
+#endif
}
printf("\n");
}
}
+
#define SS(x) ((x==1)?"":"s")
#define S(x) (int)(x),SS(x)
@@ -403,7 +676,7 @@
else
s="(string)";
printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
- (f->linedefined==0)?"main":"function",s,
+ (f->linedefined==0)?"main":"function",s,
f->linedefined,f->lastlinedefined,
S(f->sizecode),VOID(f));
printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
@@ -420,7 +693,8 @@
printf("constants (%d) for %p:\n",n,VOID(f));
for (i=0; i<n; i++)
{
- printf("\t%d\t",i+1);
+ printf("\t%d\t",i);
+ PrintType(f,i);
PrintConstant(f,i);
printf("\n");
}
diff --git a/src/luaconf.h b/src/luaconf.h
index 9eeeea6..bdf927e 100644
--- a/src/luaconf.h
+++ b/src/luaconf.h
@@ -1,5 +1,5 @@
/*
-** $Id: luaconf.h,v 1.259.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: luaconf.h $
** Configuration file for Lua
** See Copyright Notice in lua.h
*/
@@ -14,6 +14,16 @@
/*
** ===================================================================
+** General Configuration File for Lua
+**
+** Some definitions here can be changed externally, through the
+** compiler (e.g., with '-D' options). Those are protected by
+** '#if !defined' guards. However, several other definitions should
+** be changed directly here, either because they affect the Lua
+** ABI (by making the changes here, you ensure that all software
+** connected to Lua, such as C libraries, will be compiled with the
+** same configuration); or because they are seldom changed.
+**
** Search for "@@" to find all configurable definitions.
** ===================================================================
*/
@@ -22,18 +32,23 @@
/*
** {====================================================================
** System Configuration: macros to adapt (if needed) Lua to some
-** particular platform, for instance compiling it with 32-bit numbers or
-** restricting it to C89.
+** particular platform, for instance restricting it to C89.
** =====================================================================
*/
/*
-@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats. You
-** can also define LUA_32BITS in the make file, but changing here you
-** ensure that all software connected to Lua will be compiled with the
-** same configuration.
+@@ LUAI_MAXCSTACK defines the maximum depth for nested calls and
+** also limits the maximum depth of other recursive algorithms in
+** the implementation, such as syntactic analysis. A value too
+** large may allow the interpreter to crash (C-stack overflow).
+** The default value seems ok for regular machines, but may be
+** too high for restricted hardware.
+** The test file 'cstack.lua' may help finding a good limit.
+** (It will crash with a limit too high.)
*/
-/* #define LUA_32BITS */
+#if !defined(LUAI_MAXCSTACK)
+#define LUAI_MAXCSTACK 2000
+#endif
/*
@@ -61,18 +76,37 @@
#if defined(LUA_USE_LINUX)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
-#define LUA_USE_READLINE /* needs some extra libraries */
#endif
#if defined(LUA_USE_MACOSX)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN /* MacOS does not need -ldl */
-#define LUA_USE_READLINE /* needs an extra library: -lreadline */
#endif
/*
+@@ LUAI_IS32INT is true iff 'int' has (at least) 32 bits.
+*/
+#define LUAI_IS32INT ((UINT_MAX >> 30) >= 3)
+
+/* }================================================================== */
+
+
+
+/*
+** {==================================================================
+** Configuration for Number types.
+** ===================================================================
+*/
+
+/*
+@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats.
+*/
+/* #define LUA_32BITS */
+
+
+/*
@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for
** C89 ('long' and 'double'); Windows always has '__int64', so it does
** not need to use this case.
@@ -82,24 +116,11 @@
#endif
-
-/*
-@@ LUAI_BITSINT defines the (minimum) number of bits in an 'int'.
-*/
-/* avoid undefined shifts */
-#if ((INT_MAX >> 15) >> 15) >= 1
-#define LUAI_BITSINT 32
-#else
-/* 'int' always must have at least 16 bits */
-#define LUAI_BITSINT 16
-#endif
-
-
/*
@@ LUA_INT_TYPE defines the type for Lua integers.
@@ LUA_FLOAT_TYPE defines the type for Lua floats.
-** Lua should work fine with any mix of these options (if supported
-** by your C compiler). The usual configurations are 64-bit integers
+** Lua should work fine with any mix of these options supported
+** by your C compiler. The usual configurations are 64-bit integers
** and 'double' (the default), 32-bit integers and 'float' (for
** restricted platforms), and 'long'/'double' (for C compilers not
** compliant with C99, which may not have support for 'long long').
@@ -119,7 +140,7 @@
/*
** 32-bit integers and 'float'
*/
-#if LUAI_BITSINT >= 32 /* use 'int' if big enough */
+#if LUAI_IS32INT /* use 'int' if big enough */
#define LUA_INT_TYPE LUA_INT_INT
#else /* otherwise use 'long' */
#define LUA_INT_TYPE LUA_INT_LONG
@@ -151,7 +172,6 @@
-
/*
** {==================================================================
** Configuration for Paths.
@@ -179,6 +199,7 @@
** hierarchy or if you want to install your libraries in
** non-conventional directories.
*/
+
#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
#if defined(_WIN32) /* { */
/*
@@ -188,27 +209,40 @@
#define LUA_LDIR "!\\lua\\"
#define LUA_CDIR "!\\"
#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"
+
+#if !defined(LUA_PATH_DEFAULT)
#define LUA_PATH_DEFAULT \
LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \
LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \
LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \
".\\?.lua;" ".\\?\\init.lua"
+#endif
+
+#if !defined(LUA_CPATH_DEFAULT)
#define LUA_CPATH_DEFAULT \
LUA_CDIR"?.dll;" \
LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \
LUA_CDIR"loadall.dll;" ".\\?.dll"
+#endif
#else /* }{ */
#define LUA_ROOT "/usr/local/"
#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"
#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"
+
+#if !defined(LUA_PATH_DEFAULT)
#define LUA_PATH_DEFAULT \
LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \
LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \
"./?.lua;" "./?/init.lua"
+#endif
+
+#if !defined(LUA_CPATH_DEFAULT)
#define LUA_CPATH_DEFAULT \
LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so"
+#endif
+
#endif /* } */
@@ -217,12 +251,16 @@
** CHANGE it if your machine does not use "/" as the directory separator
** and is not Windows. (On Windows Lua automatically uses "\".)
*/
+#if !defined(LUA_DIRSEP)
+
#if defined(_WIN32)
#define LUA_DIRSEP "\\"
#else
#define LUA_DIRSEP "/"
#endif
+#endif
+
/* }================================================================== */
@@ -256,16 +294,18 @@
#endif /* } */
-/* more often than not the libs go together with the core */
+/*
+** More often than not the libs go together with the core.
+*/
#define LUALIB_API LUA_API
-#define LUAMOD_API LUALIB_API
+#define LUAMOD_API LUA_API
/*
@@ LUAI_FUNC is a mark for all extern functions that are not to be
** exported to outside modules.
-@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables
-** that are not to be exported to outside modules (LUAI_DDEF for
+@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables,
+** none of which to be exported to outside modules (LUAI_DDEF for
** definitions and LUAI_DDEC for declarations).
** CHANGE them if you need to mark them in some special way. Elf/gcc
** (versions 3.2 and later) mark them as "hidden" to optimize access
@@ -277,12 +317,12 @@
*/
#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
defined(__ELF__) /* { */
-#define LUAI_FUNC __attribute__((visibility("hidden"))) extern
+#define LUAI_FUNC __attribute__((visibility("internal"))) extern
#else /* }{ */
#define LUAI_FUNC extern
#endif /* } */
-#define LUAI_DDEC LUAI_FUNC
+#define LUAI_DDEC(dec) LUAI_FUNC dec
#define LUAI_DDEF /* empty */
/* }================================================================== */
@@ -295,88 +335,43 @@
*/
/*
-@@ LUA_COMPAT_5_2 controls other macros for compatibility with Lua 5.2.
-@@ LUA_COMPAT_5_1 controls other macros for compatibility with Lua 5.1.
+@@ LUA_COMPAT_5_3 controls other macros for compatibility with Lua 5.3.
** You can define it to get all options, or change specific options
** to fit your specific needs.
*/
-#if defined(LUA_COMPAT_5_2) /* { */
+#if defined(LUA_COMPAT_5_3) /* { */
/*
@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated
** functions in the mathematical library.
+** (These functions were already officially removed in 5.3;
+** nevertheless they are still available here.)
*/
#define LUA_COMPAT_MATHLIB
/*
-@@ LUA_COMPAT_BITLIB controls the presence of library 'bit32'.
-*/
-#define LUA_COMPAT_BITLIB
-
-/*
-@@ LUA_COMPAT_IPAIRS controls the effectiveness of the __ipairs metamethod.
-*/
-#define LUA_COMPAT_IPAIRS
-
-/*
@@ LUA_COMPAT_APIINTCASTS controls the presence of macros for
** manipulating other integer types (lua_pushunsigned, lua_tounsigned,
** luaL_checkint, luaL_checklong, etc.)
+** (These macros were also officially removed in 5.3, but they are still
+** available here.)
*/
#define LUA_COMPAT_APIINTCASTS
-#endif /* } */
-
-
-#if defined(LUA_COMPAT_5_1) /* { */
-
-/* Incompatibilities from 5.2 -> 5.3 */
-#define LUA_COMPAT_MATHLIB
-#define LUA_COMPAT_APIINTCASTS
/*
-@@ LUA_COMPAT_UNPACK controls the presence of global 'unpack'.
-** You can replace it with 'table.unpack'.
+@@ LUA_COMPAT_LT_LE controls the emulation of the '__le' metamethod
+** using '__lt'.
*/
-#define LUA_COMPAT_UNPACK
+#define LUA_COMPAT_LT_LE
-/*
-@@ LUA_COMPAT_LOADERS controls the presence of table 'package.loaders'.
-** You can replace it with 'package.searchers'.
-*/
-#define LUA_COMPAT_LOADERS
-
-/*
-@@ macro 'lua_cpcall' emulates deprecated function lua_cpcall.
-** You can call your C function directly (with light C functions).
-*/
-#define lua_cpcall(L,f,u) \
- (lua_pushcfunction(L, (f)), \
- lua_pushlightuserdata(L,(u)), \
- lua_pcall(L,1,0,0))
-
-
-/*
-@@ LUA_COMPAT_LOG10 defines the function 'log10' in the math library.
-** You can rewrite 'log10(x)' as 'log(x, 10)'.
-*/
-#define LUA_COMPAT_LOG10
-
-/*
-@@ LUA_COMPAT_LOADSTRING defines the function 'loadstring' in the base
-** library. You can rewrite 'loadstring(s)' as 'load(s)'.
-*/
-#define LUA_COMPAT_LOADSTRING
-
-/*
-@@ LUA_COMPAT_MAXN defines the function 'maxn' in the table library.
-*/
-#define LUA_COMPAT_MAXN
/*
@@ The following macros supply trivial compatibility for some
** changes in the API. The macros themselves document how to
** change your code to avoid using them.
+** (Once more, these macros were officially removed in 5.3, but they are
+** still available here.)
*/
#define lua_strlen(L,i) lua_rawlen(L, (i))
@@ -385,23 +380,8 @@
#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)
-/*
-@@ LUA_COMPAT_MODULE controls compatibility with previous
-** module functions 'module' (Lua) and 'luaL_register' (C).
-*/
-#define LUA_COMPAT_MODULE
-
#endif /* } */
-
-/*
-@@ LUA_COMPAT_FLOATSTRING makes Lua format integral floats without a
-@@ a float mark ('.0').
-** This macro is not on by default even in compatibility mode,
-** because this is not really an incompatibility.
-*/
-/* #define LUA_COMPAT_FLOATSTRING */
-
/* }================================================================== */
@@ -418,14 +398,14 @@
@@ LUA_NUMBER is the floating-point type used by Lua.
@@ LUAI_UACNUMBER is the result of a 'default argument promotion'
@@ over a floating number.
-@@ l_mathlim(x) corrects limit name 'x' to the proper float type
+@@ l_floatatt(x) corrects float attribute 'x' to the proper float type
** by prefixing it with one of FLT/DBL/LDBL.
@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.
@@ LUA_NUMBER_FMT is the format for writing floats.
@@ lua_number2str converts a float to a string.
@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.
@@ l_floor takes the floor of a float.
-@@ lua_str2number converts a decimal numeric string to a number.
+@@ lua_str2number converts a decimal numeral to a number.
*/
@@ -437,12 +417,13 @@
l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n))
/*
-@@ lua_numbertointeger converts a float number to an integer, or
-** returns 0 if float is not within the range of a lua_Integer.
-** (The range comparisons are tricky because of rounding. The tests
-** here assume a two-complement representation, where MININTEGER always
-** has an exact representation as a float; MAXINTEGER may not have one,
-** and therefore its conversion to float may have an ill-defined value.)
+@@ lua_numbertointeger converts a float number with an integral value
+** to an integer, or returns 0 if float is not within the range of
+** a lua_Integer. (The range comparisons are tricky because of
+** rounding. The tests here assume a two-complement representation,
+** where MININTEGER always has an exact representation as a float;
+** MAXINTEGER may not have one, and therefore its conversion to float
+** may have an ill-defined value.)
*/
#define lua_numbertointeger(n,p) \
((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \
@@ -456,7 +437,7 @@
#define LUA_NUMBER float
-#define l_mathlim(n) (FLT_##n)
+#define l_floatatt(n) (FLT_##n)
#define LUAI_UACNUMBER double
@@ -472,7 +453,7 @@
#define LUA_NUMBER long double
-#define l_mathlim(n) (LDBL_##n)
+#define l_floatatt(n) (LDBL_##n)
#define LUAI_UACNUMBER long double
@@ -487,7 +468,7 @@
#define LUA_NUMBER double
-#define l_mathlim(n) (DBL_##n)
+#define l_floatatt(n) (DBL_##n)
#define LUAI_UACNUMBER double
@@ -512,11 +493,13 @@
@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.
**
@@ LUAI_UACINT is the result of a 'default argument promotion'
-@@ over a lUA_INTEGER.
+@@ over a LUA_INTEGER.
@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.
@@ LUA_INTEGER_FMT is the format for writing integers.
@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.
@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.
+@@ LUA_MAXUNSIGNED is the maximum value for a LUA_UNSIGNED.
+@@ LUA_UNSIGNEDBITS is the number of bits in a LUA_UNSIGNED.
@@ lua_integer2str converts an integer to a string.
*/
@@ -537,6 +520,9 @@
#define LUA_UNSIGNED unsigned LUAI_UACINT
+#define LUA_UNSIGNEDBITS (sizeof(LUA_UNSIGNED) * CHAR_BIT)
+
+
/* now the variable definitions */
#if LUA_INT_TYPE == LUA_INT_INT /* { int */
@@ -547,6 +533,8 @@
#define LUA_MAXINTEGER INT_MAX
#define LUA_MININTEGER INT_MIN
+#define LUA_MAXUNSIGNED UINT_MAX
+
#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */
#define LUA_INTEGER long
@@ -555,6 +543,8 @@
#define LUA_MAXINTEGER LONG_MAX
#define LUA_MININTEGER LONG_MIN
+#define LUA_MAXUNSIGNED ULONG_MAX
+
#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */
/* use presence of macro LLONG_MAX as proxy for C99 compliance */
@@ -567,6 +557,8 @@
#define LUA_MAXINTEGER LLONG_MAX
#define LUA_MININTEGER LLONG_MIN
+#define LUA_MAXUNSIGNED ULLONG_MAX
+
#elif defined(LUA_USE_WINDOWS) /* }{ */
/* in Windows, can use specific Windows types */
@@ -576,6 +568,8 @@
#define LUA_MAXINTEGER _I64_MAX
#define LUA_MININTEGER _I64_MIN
+#define LUA_MAXUNSIGNED _UI64_MAX
+
#else /* }{ */
#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \
@@ -610,7 +604,7 @@
/*
-@@ lua_strx2number converts an hexadecimal numeric string to a number.
+@@ lua_strx2number converts a hexadecimal numeral to a number.
** In C99, 'strtod' does that conversion. Otherwise, you can
** leave 'lua_strx2number' undefined and Lua will provide its own
** implementation.
@@ -628,7 +622,7 @@
/*
-@@ lua_number2strx converts a float to an hexadecimal numeric string.
+@@ lua_number2strx converts a float to a hexadecimal numeral.
** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.
** Otherwise, you can leave 'lua_number2strx' undefined and Lua will
** provide its own implementation.
@@ -674,7 +668,7 @@
/*
@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).
** Change that if you do not want to use C locales. (Code using this
-** macro must include header 'locale.h'.)
+** macro must include the header 'locale.h'.)
*/
#if !defined(lua_getlocaledecpoint)
#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])
@@ -715,7 +709,7 @@
** {==================================================================
** Macros that affect the API and must be stable (that is, must be the
** same when you compile Lua and when you compile code that links to
-** Lua). You probably do not want/need to change them.
+** Lua).
** =====================================================================
*/
@@ -724,8 +718,9 @@
** CHANGE it if you need a different limit. This limit is arbitrary;
** its only purpose is to stop Lua from consuming unlimited stack
** space (and to reserve some numbers for pseudo-indices).
+** (It must fit into max(size_t)/32.)
*/
-#if LUAI_BITSINT >= 32
+#if LUAI_IS32INT
#define LUAI_MAXSTACK 1000000
#else
#define LUAI_MAXSTACK 15000
@@ -750,27 +745,18 @@
/*
@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.
-** CHANGE it if it uses too much C-stack space. (For long double,
-** 'string.format("%.99f", -1e4932)' needs 5034 bytes, so a
-** smaller buffer would force a memory allocation for each call to
-** 'string.format'.)
*/
-#if LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE
-#define LUAL_BUFFERSIZE 8192
-#else
-#define LUAL_BUFFERSIZE ((int)(0x80 * sizeof(void*) * sizeof(lua_Integer)))
-#endif
-
-/* }================================================================== */
+#define LUAL_BUFFERSIZE ((int)(16 * sizeof(void*) * sizeof(lua_Number)))
/*
-@@ LUA_QL describes how error messages quote program elements.
-** Lua does not use these macros anymore; they are here for
-** compatibility only.
+@@ LUAI_MAXALIGN defines fields that, when used in a union, ensure
+** maximum alignment for the other items in that union.
*/
-#define LUA_QL(x) "'" x "'"
-#define LUA_QS LUA_QL("%s")
+#define LUAI_MAXALIGN lua_Number n; double u; void *s; lua_Integer i; long l
+
+/* }================================================================== */
+
diff --git a/src/lualib.h b/src/lualib.h
index f5304aa..eb08b53 100644
--- a/src/lualib.h
+++ b/src/lualib.h
@@ -1,5 +1,5 @@
/*
-** $Id: lualib.h,v 1.45.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lualib.h $
** Lua standard libraries
** See Copyright Notice in lua.h
*/
@@ -35,9 +35,6 @@
#define LUA_UTF8LIBNAME "utf8"
LUAMOD_API int (luaopen_utf8) (lua_State *L);
-#define LUA_BITLIBNAME "bit32"
-LUAMOD_API int (luaopen_bit32) (lua_State *L);
-
#define LUA_MATHLIBNAME "math"
LUAMOD_API int (luaopen_math) (lua_State *L);
diff --git a/src/lundump.c b/src/lundump.c
index 7a67d75..4243678 100644
--- a/src/lundump.c
+++ b/src/lundump.c
@@ -1,5 +1,5 @@
/*
-** $Id: lundump.c,v 2.44.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lundump.c $
** load precompiled Lua chunks
** See Copyright Notice in lua.h
*/
@@ -10,6 +10,7 @@
#include "lprefix.h"
+#include <limits.h>
#include <string.h>
#include "lua.h"
@@ -25,7 +26,7 @@
#if !defined(luai_verifycode)
-#define luai_verifycode(L,b,f) /* empty */
+#define luai_verifycode(L,f) /* empty */
#endif
@@ -36,224 +37,266 @@
} LoadState;
-static l_noret error(LoadState *S, const char *why) {
- luaO_pushfstring(S->L, "%s: %s precompiled chunk", S->name, why);
+static l_noret error (LoadState *S, const char *why) {
+ luaO_pushfstring(S->L, "%s: bad binary format (%s)", S->name, why);
luaD_throw(S->L, LUA_ERRSYNTAX);
}
/*
-** All high-level loads go through LoadVector; you can change it to
+** All high-level loads go through loadVector; you can change it to
** adapt to the endianness of the input
*/
-#define LoadVector(S,b,n) LoadBlock(S,b,(n)*sizeof((b)[0]))
+#define loadVector(S,b,n) loadBlock(S,b,(n)*sizeof((b)[0]))
-static void LoadBlock (LoadState *S, void *b, size_t size) {
+static void loadBlock (LoadState *S, void *b, size_t size) {
if (luaZ_read(S->Z, b, size) != 0)
- error(S, "truncated");
+ error(S, "truncated chunk");
}
-#define LoadVar(S,x) LoadVector(S,&x,1)
+#define loadVar(S,x) loadVector(S,&x,1)
-static lu_byte LoadByte (LoadState *S) {
- lu_byte x;
- LoadVar(S, x);
+static lu_byte loadByte (LoadState *S) {
+ int b = zgetc(S->Z);
+ if (b == EOZ)
+ error(S, "truncated chunk");
+ return cast_byte(b);
+}
+
+
+static size_t loadUnsigned (LoadState *S, size_t limit) {
+ size_t x = 0;
+ int b;
+ limit >>= 7;
+ do {
+ b = loadByte(S);
+ if (x >= limit)
+ error(S, "integer overflow");
+ x = (x << 7) | (b & 0x7f);
+ } while ((b & 0x80) == 0);
return x;
}
-static int LoadInt (LoadState *S) {
- int x;
- LoadVar(S, x);
- return x;
+static size_t loadSize (LoadState *S) {
+ return loadUnsigned(S, ~(size_t)0);
}
-static lua_Number LoadNumber (LoadState *S) {
+static int loadInt (LoadState *S) {
+ return cast_int(loadUnsigned(S, INT_MAX));
+}
+
+
+static lua_Number loadNumber (LoadState *S) {
lua_Number x;
- LoadVar(S, x);
+ loadVar(S, x);
return x;
}
-static lua_Integer LoadInteger (LoadState *S) {
+static lua_Integer loadInteger (LoadState *S) {
lua_Integer x;
- LoadVar(S, x);
+ loadVar(S, x);
return x;
}
-static TString *LoadString (LoadState *S) {
- size_t size = LoadByte(S);
- if (size == 0xFF)
- LoadVar(S, size);
- if (size == 0)
+/*
+** Load a nullable string into prototype 'p'.
+*/
+static TString *loadStringN (LoadState *S, Proto *p) {
+ lua_State *L = S->L;
+ TString *ts;
+ size_t size = loadSize(S);
+ if (size == 0) /* no string? */
return NULL;
else if (--size <= LUAI_MAXSHORTLEN) { /* short string? */
char buff[LUAI_MAXSHORTLEN];
- LoadVector(S, buff, size);
- return luaS_newlstr(S->L, buff, size);
+ loadVector(S, buff, size); /* load string into buffer */
+ ts = luaS_newlstr(L, buff, size); /* create string */
}
else { /* long string */
- TString *ts = luaS_createlngstrobj(S->L, size);
- LoadVector(S, getstr(ts), size); /* load directly in final place */
- return ts;
+ ts = luaS_createlngstrobj(L, size); /* create string */
+ loadVector(S, getstr(ts), size); /* load directly in final place */
}
+ luaC_objbarrier(L, p, ts);
+ return ts;
}
-static void LoadCode (LoadState *S, Proto *f) {
- int n = LoadInt(S);
- f->code = luaM_newvector(S->L, n, Instruction);
+/*
+** Load a non-nullable string into prototype 'p'.
+*/
+static TString *loadString (LoadState *S, Proto *p) {
+ TString *st = loadStringN(S, p);
+ if (st == NULL)
+ error(S, "bad format for constant string");
+ return st;
+}
+
+
+static void loadCode (LoadState *S, Proto *f) {
+ int n = loadInt(S);
+ f->code = luaM_newvectorchecked(S->L, n, Instruction);
f->sizecode = n;
- LoadVector(S, f->code, n);
+ loadVector(S, f->code, n);
}
-static void LoadFunction(LoadState *S, Proto *f, TString *psource);
+static void loadFunction(LoadState *S, Proto *f, TString *psource);
-static void LoadConstants (LoadState *S, Proto *f) {
+static void loadConstants (LoadState *S, Proto *f) {
int i;
- int n = LoadInt(S);
- f->k = luaM_newvector(S->L, n, TValue);
+ int n = loadInt(S);
+ f->k = luaM_newvectorchecked(S->L, n, TValue);
f->sizek = n;
for (i = 0; i < n; i++)
setnilvalue(&f->k[i]);
for (i = 0; i < n; i++) {
TValue *o = &f->k[i];
- int t = LoadByte(S);
+ int t = loadByte(S);
switch (t) {
- case LUA_TNIL:
- setnilvalue(o);
- break;
- case LUA_TBOOLEAN:
- setbvalue(o, LoadByte(S));
- break;
- case LUA_TNUMFLT:
- setfltvalue(o, LoadNumber(S));
- break;
- case LUA_TNUMINT:
- setivalue(o, LoadInteger(S));
- break;
- case LUA_TSHRSTR:
- case LUA_TLNGSTR:
- setsvalue2n(S->L, o, LoadString(S));
- break;
- default:
- lua_assert(0);
+ case LUA_VNIL:
+ setnilvalue(o);
+ break;
+ case LUA_VFALSE:
+ setbfvalue(o);
+ break;
+ case LUA_VTRUE:
+ setbtvalue(o);
+ break;
+ case LUA_VNUMFLT:
+ setfltvalue(o, loadNumber(S));
+ break;
+ case LUA_VNUMINT:
+ setivalue(o, loadInteger(S));
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ setsvalue2n(S->L, o, loadString(S, f));
+ break;
+ default: lua_assert(0);
}
}
}
-static void LoadProtos (LoadState *S, Proto *f) {
+static void loadProtos (LoadState *S, Proto *f) {
int i;
- int n = LoadInt(S);
- f->p = luaM_newvector(S->L, n, Proto *);
+ int n = loadInt(S);
+ f->p = luaM_newvectorchecked(S->L, n, Proto *);
f->sizep = n;
for (i = 0; i < n; i++)
f->p[i] = NULL;
for (i = 0; i < n; i++) {
f->p[i] = luaF_newproto(S->L);
- LoadFunction(S, f->p[i], f->source);
+ luaC_objbarrier(S->L, f, f->p[i]);
+ loadFunction(S, f->p[i], f->source);
}
}
-static void LoadUpvalues (LoadState *S, Proto *f) {
+static void loadUpvalues (LoadState *S, Proto *f) {
int i, n;
- n = LoadInt(S);
- f->upvalues = luaM_newvector(S->L, n, Upvaldesc);
+ n = loadInt(S);
+ f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
f->sizeupvalues = n;
- for (i = 0; i < n; i++)
- f->upvalues[i].name = NULL;
for (i = 0; i < n; i++) {
- f->upvalues[i].instack = LoadByte(S);
- f->upvalues[i].idx = LoadByte(S);
+ f->upvalues[i].name = NULL;
+ f->upvalues[i].instack = loadByte(S);
+ f->upvalues[i].idx = loadByte(S);
+ f->upvalues[i].kind = loadByte(S);
}
}
-static void LoadDebug (LoadState *S, Proto *f) {
+static void loadDebug (LoadState *S, Proto *f) {
int i, n;
- n = LoadInt(S);
- f->lineinfo = luaM_newvector(S->L, n, int);
+ n = loadInt(S);
+ f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte);
f->sizelineinfo = n;
- LoadVector(S, f->lineinfo, n);
- n = LoadInt(S);
- f->locvars = luaM_newvector(S->L, n, LocVar);
+ loadVector(S, f->lineinfo, n);
+ n = loadInt(S);
+ f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo);
+ f->sizeabslineinfo = n;
+ for (i = 0; i < n; i++) {
+ f->abslineinfo[i].pc = loadInt(S);
+ f->abslineinfo[i].line = loadInt(S);
+ }
+ n = loadInt(S);
+ f->locvars = luaM_newvectorchecked(S->L, n, LocVar);
f->sizelocvars = n;
for (i = 0; i < n; i++)
f->locvars[i].varname = NULL;
for (i = 0; i < n; i++) {
- f->locvars[i].varname = LoadString(S);
- f->locvars[i].startpc = LoadInt(S);
- f->locvars[i].endpc = LoadInt(S);
+ f->locvars[i].varname = loadStringN(S, f);
+ f->locvars[i].startpc = loadInt(S);
+ f->locvars[i].endpc = loadInt(S);
}
- n = LoadInt(S);
+ n = loadInt(S);
for (i = 0; i < n; i++)
- f->upvalues[i].name = LoadString(S);
+ f->upvalues[i].name = loadStringN(S, f);
}
-static void LoadFunction (LoadState *S, Proto *f, TString *psource) {
- f->source = LoadString(S);
+static void loadFunction (LoadState *S, Proto *f, TString *psource) {
+ f->source = loadStringN(S, f);
if (f->source == NULL) /* no source in dump? */
f->source = psource; /* reuse parent's source */
- f->linedefined = LoadInt(S);
- f->lastlinedefined = LoadInt(S);
- f->numparams = LoadByte(S);
- f->is_vararg = LoadByte(S);
- f->maxstacksize = LoadByte(S);
- LoadCode(S, f);
- LoadConstants(S, f);
- LoadUpvalues(S, f);
- LoadProtos(S, f);
- LoadDebug(S, f);
+ f->linedefined = loadInt(S);
+ f->lastlinedefined = loadInt(S);
+ f->numparams = loadByte(S);
+ f->is_vararg = loadByte(S);
+ f->maxstacksize = loadByte(S);
+ loadCode(S, f);
+ loadConstants(S, f);
+ loadUpvalues(S, f);
+ loadProtos(S, f);
+ loadDebug(S, f);
}
static void checkliteral (LoadState *S, const char *s, const char *msg) {
char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */
size_t len = strlen(s);
- LoadVector(S, buff, len);
+ loadVector(S, buff, len);
if (memcmp(s, buff, len) != 0)
error(S, msg);
}
static void fchecksize (LoadState *S, size_t size, const char *tname) {
- if (LoadByte(S) != size)
- error(S, luaO_pushfstring(S->L, "%s size mismatch in", tname));
+ if (loadByte(S) != size)
+ error(S, luaO_pushfstring(S->L, "%s size mismatch", tname));
}
#define checksize(S,t) fchecksize(S,sizeof(t),#t)
static void checkHeader (LoadState *S) {
- checkliteral(S, LUA_SIGNATURE + 1, "not a"); /* 1st char already checked */
- if (LoadByte(S) != LUAC_VERSION)
- error(S, "version mismatch in");
- if (LoadByte(S) != LUAC_FORMAT)
- error(S, "format mismatch in");
- checkliteral(S, LUAC_DATA, "corrupted");
- checksize(S, int);
- checksize(S, size_t);
+ /* skip 1st char (already read and checked) */
+ checkliteral(S, &LUA_SIGNATURE[1], "not a binary chunk");
+ if (loadByte(S) != LUAC_VERSION)
+ error(S, "version mismatch");
+ if (loadByte(S) != LUAC_FORMAT)
+ error(S, "format mismatch");
+ checkliteral(S, LUAC_DATA, "corrupted chunk");
checksize(S, Instruction);
checksize(S, lua_Integer);
checksize(S, lua_Number);
- if (LoadInteger(S) != LUAC_INT)
- error(S, "endianness mismatch in");
- if (LoadNumber(S) != LUAC_NUM)
- error(S, "float format mismatch in");
+ if (loadInteger(S) != LUAC_INT)
+ error(S, "integer format mismatch");
+ if (loadNumber(S) != LUAC_NUM)
+ error(S, "float format mismatch");
}
/*
-** load precompiled chunk
+** Load precompiled chunk.
*/
LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) {
LoadState S;
@@ -267,13 +310,14 @@
S.L = L;
S.Z = Z;
checkHeader(&S);
- cl = luaF_newLclosure(L, LoadByte(&S));
- setclLvalue(L, L->top, cl);
+ cl = luaF_newLclosure(L, loadByte(&S));
+ setclLvalue2s(L, L->top, cl);
luaD_inctop(L);
cl->p = luaF_newproto(L);
- LoadFunction(&S, cl->p, NULL);
+ luaC_objbarrier(L, cl, cl->p);
+ loadFunction(&S, cl->p, NULL);
lua_assert(cl->nupvalues == cl->p->sizeupvalues);
- luai_verifycode(L, buff, cl->p);
+ luai_verifycode(L, cl->p);
return cl;
}
diff --git a/src/lundump.h b/src/lundump.h
index ce492d6..f3748a9 100644
--- a/src/lundump.h
+++ b/src/lundump.h
@@ -1,5 +1,5 @@
/*
-** $Id: lundump.h,v 1.45.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lundump.h $
** load precompiled Lua chunks
** See Copyright Notice in lua.h
*/
@@ -18,8 +18,12 @@
#define LUAC_INT 0x5678
#define LUAC_NUM cast_num(370.5)
-#define MYINT(s) (s[0]-'0')
+/*
+** Encode major-minor version in one byte, one nibble for each
+*/
+#define MYINT(s) (s[0]-'0') /* assume one-digit numerals */
#define LUAC_VERSION (MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR))
+
#define LUAC_FORMAT 0 /* this is the official format */
/* load one chunk; from lundump.c */
diff --git a/src/lutf8lib.c b/src/lutf8lib.c
index 10bd238..901d985 100644
--- a/src/lutf8lib.c
+++ b/src/lutf8lib.c
@@ -1,5 +1,5 @@
/*
-** $Id: lutf8lib.c,v 1.16.1.1 2017/04/19 17:29:57 roberto Exp $
+** $Id: lutf8lib.c $
** Standard library for UTF-8 manipulation
** See Copyright Notice in lua.h
*/
@@ -20,7 +20,20 @@
#include "lauxlib.h"
#include "lualib.h"
-#define MAXUNICODE 0x10FFFF
+
+#define MAXUNICODE 0x10FFFFu
+
+#define MAXUTF 0x7FFFFFFFu
+
+/*
+** Integer type for decoded UTF-8 values; MAXUTF needs 31 bits.
+*/
+#if (UINT_MAX >> 30) >= 1
+typedef unsigned int utfint;
+#else
+typedef unsigned long utfint;
+#endif
+
#define iscont(p) ((*(p) & 0xC0) == 0x80)
@@ -35,53 +48,62 @@
/*
-** Decode one UTF-8 sequence, returning NULL if byte sequence is invalid.
+** Decode one UTF-8 sequence, returning NULL if byte sequence is
+** invalid. The array 'limits' stores the minimum value for each
+** sequence length, to check for overlong representations. Its first
+** entry forces an error for non-ascii bytes with no continuation
+** bytes (count == 0).
*/
-static const char *utf8_decode (const char *o, int *val) {
- static const unsigned int limits[] = {0xFF, 0x7F, 0x7FF, 0xFFFF};
- const unsigned char *s = (const unsigned char *)o;
- unsigned int c = s[0];
- unsigned int res = 0; /* final result */
+static const char *utf8_decode (const char *s, utfint *val, int strict) {
+ static const utfint limits[] =
+ {~(utfint)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u};
+ unsigned int c = (unsigned char)s[0];
+ utfint res = 0; /* final result */
if (c < 0x80) /* ascii? */
res = c;
else {
int count = 0; /* to count number of continuation bytes */
- while (c & 0x40) { /* still have continuation bytes? */
- int cc = s[++count]; /* read next byte */
+ for (; c & 0x40; c <<= 1) { /* while it needs continuation bytes... */
+ unsigned int cc = (unsigned char)s[++count]; /* read next byte */
if ((cc & 0xC0) != 0x80) /* not a continuation byte? */
return NULL; /* invalid byte sequence */
res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */
- c <<= 1; /* to test next bit */
}
- res |= ((c & 0x7F) << (count * 5)); /* add first byte */
- if (count > 3 || res > MAXUNICODE || res <= limits[count])
+ res |= ((utfint)(c & 0x7F) << (count * 5)); /* add first byte */
+ if (count > 5 || res > MAXUTF || res < limits[count])
return NULL; /* invalid byte sequence */
s += count; /* skip continuation bytes read */
}
+ if (strict) {
+ /* check for invalid code points; too large or surrogates */
+ if (res > MAXUNICODE || (0xD800u <= res && res <= 0xDFFFu))
+ return NULL;
+ }
if (val) *val = res;
- return (const char *)s + 1; /* +1 to include first byte */
+ return s + 1; /* +1 to include first byte */
}
/*
-** utf8len(s [, i [, j]]) --> number of characters that start in the
-** range [i,j], or nil + current position if 's' is not well formed in
-** that interval
+** utf8len(s [, i [, j [, lax]]]) --> number of characters that
+** start in the range [i,j], or nil + current position if 's' is not
+** well formed in that interval
*/
static int utflen (lua_State *L) {
- int n = 0;
- size_t len;
+ lua_Integer n = 0; /* counter for the number of characters */
+ size_t len; /* string length in bytes */
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len);
+ int lax = lua_toboolean(L, 4);
luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2,
- "initial position out of string");
+ "initial position out of bounds");
luaL_argcheck(L, --posj < (lua_Integer)len, 3,
- "final position out of string");
+ "final position out of bounds");
while (posi <= posj) {
- const char *s1 = utf8_decode(s + posi, NULL);
+ const char *s1 = utf8_decode(s + posi, NULL, !lax);
if (s1 == NULL) { /* conversion error? */
- lua_pushnil(L); /* return nil ... */
+ luaL_pushfail(L); /* return fail ... */
lua_pushinteger(L, posi + 1); /* ... and current position */
return 2;
}
@@ -94,28 +116,29 @@
/*
-** codepoint(s, [i, [j]]) -> returns codepoints for all characters
-** that start in the range [i,j]
+** codepoint(s, [i, [j [, lax]]]) -> returns codepoints for all
+** characters that start in the range [i,j]
*/
static int codepoint (lua_State *L) {
size_t len;
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len);
+ int lax = lua_toboolean(L, 4);
int n;
const char *se;
- luaL_argcheck(L, posi >= 1, 2, "out of range");
- luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of range");
+ luaL_argcheck(L, posi >= 1, 2, "out of bounds");
+ luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of bounds");
if (posi > pose) return 0; /* empty interval; return no values */
if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */
return luaL_error(L, "string slice too long");
- n = (int)(pose - posi) + 1;
+ n = (int)(pose - posi) + 1; /* upper bound for number of returns */
luaL_checkstack(L, n, "string slice too long");
- n = 0;
- se = s + pose;
+ n = 0; /* count the number of returns */
+ se = s + pose; /* string end */
for (s += posi - 1; s < se;) {
- int code;
- s = utf8_decode(s, &code);
+ utfint code;
+ s = utf8_decode(s, &code, !lax);
if (s == NULL)
return luaL_error(L, "invalid UTF-8 code");
lua_pushinteger(L, code);
@@ -126,8 +149,8 @@
static void pushutfchar (lua_State *L, int arg) {
- lua_Integer code = luaL_checkinteger(L, arg);
- luaL_argcheck(L, 0 <= code && code <= MAXUNICODE, arg, "value out of range");
+ lua_Unsigned code = (lua_Unsigned)luaL_checkinteger(L, arg);
+ luaL_argcheck(L, code <= MAXUTF, arg, "value out of range");
lua_pushfstring(L, "%U", (long)code);
}
@@ -164,7 +187,7 @@
lua_Integer posi = (n >= 0) ? 1 : len + 1;
posi = u_posrelat(luaL_optinteger(L, 3, posi), len);
luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3,
- "position out of range");
+ "position out of bounds");
if (n == 0) {
/* find beginning of current byte sequence */
while (posi > 0 && iscont(s + posi)) posi--;
@@ -193,12 +216,12 @@
if (n == 0) /* did it find given character? */
lua_pushinteger(L, posi + 1);
else /* no such character */
- lua_pushnil(L);
+ luaL_pushfail(L);
return 1;
}
-static int iter_aux (lua_State *L) {
+static int iter_aux (lua_State *L, int strict) {
size_t len;
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer n = lua_tointeger(L, 2) - 1;
@@ -211,9 +234,9 @@
if (n >= (lua_Integer)len)
return 0; /* no more codepoints */
else {
- int code;
- const char *next = utf8_decode(s + n, &code);
- if (next == NULL || iscont(next))
+ utfint code;
+ const char *next = utf8_decode(s + n, &code, strict);
+ if (next == NULL)
return luaL_error(L, "invalid UTF-8 code");
lua_pushinteger(L, n + 1);
lua_pushinteger(L, code);
@@ -222,9 +245,19 @@
}
+static int iter_auxstrict (lua_State *L) {
+ return iter_aux(L, 1);
+}
+
+static int iter_auxlax (lua_State *L) {
+ return iter_aux(L, 0);
+}
+
+
static int iter_codes (lua_State *L) {
+ int lax = lua_toboolean(L, 2);
luaL_checkstring(L, 1);
- lua_pushcfunction(L, iter_aux);
+ lua_pushcfunction(L, lax ? iter_auxlax : iter_auxstrict);
lua_pushvalue(L, 1);
lua_pushinteger(L, 0);
return 3;
@@ -232,7 +265,7 @@
/* pattern to match a single UTF-8 character */
-#define UTF8PATT "[\0-\x7F\xC2-\xF4][\x80-\xBF]*"
+#define UTF8PATT "[\0-\x7F\xC2-\xFD][\x80-\xBF]*"
static const luaL_Reg funcs[] = {
diff --git a/src/lvm.c b/src/lvm.c
index cc43d87..e7781db 100644
--- a/src/lvm.c
+++ b/src/lvm.c
@@ -1,5 +1,5 @@
/*
-** $Id: lvm.c,v 2.268.1.1 2017/04/19 17:39:34 roberto Exp $
+** $Id: lvm.c $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@@ -31,38 +31,69 @@
#include "lvm.h"
-/* limit for table tag-method chains (to avoid loops) */
+/*
+** By default, use jump tables in the main interpreter loop on gcc
+** and compatible compilers.
+*/
+#if !defined(LUA_USE_JUMPTABLE)
+#if defined(__GNUC__)
+#define LUA_USE_JUMPTABLE 1
+#else
+#define LUA_USE_JUMPTABLE 0
+#endif
+#endif
+
+
+
+/* limit for table tag-method chains (to avoid infinite loops) */
#define MAXTAGLOOP 2000
-
/*
-** 'l_intfitsf' checks whether a given integer can be converted to a
-** float without rounding. Used in comparisons. Left undefined if
-** all integers fit in a float precisely.
+** 'l_intfitsf' checks whether a given integer is in the range that
+** can be converted to a float without rounding. Used in comparisons.
*/
-#if !defined(l_intfitsf)
/* number of bits in the mantissa of a float */
-#define NBM (l_mathlim(MANT_DIG))
+#define NBM (l_floatatt(MANT_DIG))
/*
-** Check whether some integers may not fit in a float, that is, whether
-** (maxinteger >> NBM) > 0 (that implies (1 << NBM) <= maxinteger).
-** (The shifts are done in parts to avoid shifting by more than the size
+** Check whether some integers may not fit in a float, testing whether
+** (maxinteger >> NBM) > 0. (That implies (1 << NBM) <= maxinteger.)
+** (The shifts are done in parts, to avoid shifting by more than the size
** of an integer. In a worst case, NBM == 113 for long double and
-** sizeof(integer) == 32.)
+** sizeof(long) == 32.)
*/
#if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \
>> (NBM - (3 * (NBM / 4)))) > 0
-#define l_intfitsf(i) \
- (-((lua_Integer)1 << NBM) <= (i) && (i) <= ((lua_Integer)1 << NBM))
+/* limit for integers that fit in a float */
+#define MAXINTFITSF ((lua_Unsigned)1 << NBM)
+
+/* check whether 'i' is in the interval [-MAXINTFITSF, MAXINTFITSF] */
+#define l_intfitsf(i) ((MAXINTFITSF + l_castS2U(i)) <= (2 * MAXINTFITSF))
+
+#else /* all integers fit in a float precisely */
+
+#define l_intfitsf(i) 1
#endif
-#endif
+/*
+** Try to convert a value from string to a number value.
+** If the value is not a string or is a string not representing
+** a valid numeral (or if coercions from strings to numbers
+** are disabled via macro 'cvt2num'), do not modify 'result'
+** and return 0.
+*/
+static int l_strton (const TValue *obj, TValue *result) {
+ lua_assert(obj != result);
+ if (!cvt2num(obj)) /* is object not a string? */
+ return 0;
+ else
+ return (luaO_str2num(svalue(obj), result) == vslen(obj) + 1);
+}
/*
@@ -75,8 +106,7 @@
*n = cast_num(ivalue(obj));
return 1;
}
- else if (cvt2num(obj) && /* string convertible to number? */
- luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {
+ else if (l_strton(obj, &v)) { /* string coercible to number? */
*n = nvalue(&v); /* convert result of 'luaO_str2num' to a float */
return 1;
}
@@ -86,76 +116,173 @@
/*
-** try to convert a value to an integer, rounding according to 'mode':
-** mode == 0: accepts only integral values
-** mode == 1: takes the floor of the number
-** mode == 2: takes the ceil of the number
+** try to convert a float to an integer, rounding according to 'mode'.
*/
-int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode) {
- TValue v;
- again:
- if (ttisfloat(obj)) {
- lua_Number n = fltvalue(obj);
- lua_Number f = l_floor(n);
- if (n != f) { /* not an integral value? */
- if (mode == 0) return 0; /* fails if mode demands integral value */
- else if (mode > 1) /* needs ceil? */
- f += 1; /* convert floor to ceil (remember: n != f) */
- }
- return lua_numbertointeger(f, p);
+int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode) {
+ lua_Number f = l_floor(n);
+ if (n != f) { /* not an integral value? */
+ if (mode == F2Ieq) return 0; /* fails if mode demands integral value */
+ else if (mode == F2Iceil) /* needs ceil? */
+ f += 1; /* convert floor to ceil (remember: n != f) */
}
- else if (ttisinteger(obj)) {
- *p = ivalue(obj);
- return 1;
- }
- else if (cvt2num(obj) &&
- luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {
- obj = &v;
- goto again; /* convert result from 'luaO_str2num' to an integer */
- }
- return 0; /* conversion failed */
+ return lua_numbertointeger(f, p);
}
/*
-** Try to convert a 'for' limit to an integer, preserving the
-** semantics of the loop.
-** (The following explanation assumes a non-negative step; it is valid
-** for negative steps mutatis mutandis.)
-** If the limit can be converted to an integer, rounding down, that is
-** it.
-** Otherwise, check whether the limit can be converted to a number. If
-** the number is too large, it is OK to set the limit as LUA_MAXINTEGER,
-** which means no limit. If the number is too negative, the loop
-** should not run, because any initial integer value is larger than the
-** limit. So, it sets the limit to LUA_MININTEGER. 'stopnow' corrects
-** the extreme case when the initial value is LUA_MININTEGER, in which
-** case the LUA_MININTEGER limit would still run the loop once.
+** try to convert a value to an integer, rounding according to 'mode',
+** without string coercion.
+** ("Fast track" handled by macro 'tointegerns'.)
*/
-static int forlimit (const TValue *obj, lua_Integer *p, lua_Integer step,
- int *stopnow) {
- *stopnow = 0; /* usually, let loops run */
- if (!luaV_tointeger(obj, p, (step < 0 ? 2 : 1))) { /* not fit in integer? */
- lua_Number n; /* try to convert to float */
- if (!tonumber(obj, &n)) /* cannot convert to float? */
- return 0; /* not a number */
- if (luai_numlt(0, n)) { /* if true, float is larger than max integer */
- *p = LUA_MAXINTEGER;
- if (step < 0) *stopnow = 1;
+int luaV_tointegerns (const TValue *obj, lua_Integer *p, F2Imod mode) {
+ if (ttisfloat(obj))
+ return luaV_flttointeger(fltvalue(obj), p, mode);
+ else if (ttisinteger(obj)) {
+ *p = ivalue(obj);
+ return 1;
+ }
+ else
+ return 0;
+}
+
+
+/*
+** try to convert a value to an integer.
+*/
+int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode) {
+ TValue v;
+ if (l_strton(obj, &v)) /* does 'obj' point to a numerical string? */
+ obj = &v; /* change it to point to its corresponding number */
+ return luaV_tointegerns(obj, p, mode);
+}
+
+
+/*
+** Try to convert a 'for' limit to an integer, preserving the semantics
+** of the loop. Return true if the loop must not run; otherwise, '*p'
+** gets the integer limit.
+** (The following explanation assumes a positive step; it is valid for
+** negative steps mutatis mutandis.)
+** If the limit is an integer or can be converted to an integer,
+** rounding down, that is the limit.
+** Otherwise, check whether the limit can be converted to a float. If
+** the float is too large, clip it to LUA_MAXINTEGER. If the float
+** is too negative, the loop should not run, because any initial
+** integer value is greater than such limit; so, the function returns
+** true to signal that. (For this latter case, no integer limit would be
+** correct; even a limit of LUA_MININTEGER would run the loop once for
+** an initial value equal to LUA_MININTEGER.)
+*/
+static int forlimit (lua_State *L, lua_Integer init, const TValue *lim,
+ lua_Integer *p, lua_Integer step) {
+ if (!luaV_tointeger(lim, p, (step < 0 ? F2Iceil : F2Ifloor))) {
+ /* not coercible to in integer */
+ lua_Number flim; /* try to convert to float */
+ if (!tonumber(lim, &flim)) /* cannot convert to float? */
+ luaG_forerror(L, lim, "limit");
+ /* else 'flim' is a float out of integer bounds */
+ if (luai_numlt(0, flim)) { /* if it is positive, it is too large */
+ if (step < 0) return 1; /* initial value must be less than it */
+ *p = LUA_MAXINTEGER; /* truncate */
}
- else { /* float is smaller than min integer */
- *p = LUA_MININTEGER;
- if (step >= 0) *stopnow = 1;
+ else { /* it is less than min integer */
+ if (step > 0) return 1; /* initial value must be greater than it */
+ *p = LUA_MININTEGER; /* truncate */
}
}
- return 1;
+ return (step > 0 ? init > *p : init < *p); /* not to run? */
+}
+
+
+/*
+** Prepare a numerical for loop (opcode OP_FORPREP).
+** Return true to skip the loop. Otherwise,
+** after preparation, stack will be as follows:
+** ra : internal index (safe copy of the control variable)
+** ra + 1 : loop counter (integer loops) or limit (float loops)
+** ra + 2 : step
+** ra + 3 : control variable
+*/
+static int forprep (lua_State *L, StkId ra) {
+ TValue *pinit = s2v(ra);
+ TValue *plimit = s2v(ra + 1);
+ TValue *pstep = s2v(ra + 2);
+ if (ttisinteger(pinit) && ttisinteger(pstep)) { /* integer loop? */
+ lua_Integer init = ivalue(pinit);
+ lua_Integer step = ivalue(pstep);
+ lua_Integer limit;
+ if (step == 0)
+ luaG_runerror(L, "'for' step is zero");
+ setivalue(s2v(ra + 3), init); /* control variable */
+ if (forlimit(L, init, plimit, &limit, step))
+ return 1; /* skip the loop */
+ else { /* prepare loop counter */
+ lua_Unsigned count;
+ if (step > 0) { /* ascending loop? */
+ count = l_castS2U(limit) - l_castS2U(init);
+ if (step != 1) /* avoid division in the too common case */
+ count /= l_castS2U(step);
+ }
+ else { /* step < 0; descending loop */
+ count = l_castS2U(init) - l_castS2U(limit);
+ /* 'step+1' avoids negating 'mininteger' */
+ count /= l_castS2U(-(step + 1)) + 1u;
+ }
+ /* store the counter in place of the limit (which won't be
+ needed anymore */
+ setivalue(plimit, l_castU2S(count));
+ }
+ }
+ else { /* try making all values floats */
+ lua_Number init; lua_Number limit; lua_Number step;
+ if (unlikely(!tonumber(plimit, &limit)))
+ luaG_forerror(L, plimit, "limit");
+ if (unlikely(!tonumber(pstep, &step)))
+ luaG_forerror(L, pstep, "step");
+ if (unlikely(!tonumber(pinit, &init)))
+ luaG_forerror(L, pinit, "initial value");
+ if (step == 0)
+ luaG_runerror(L, "'for' step is zero");
+ if (luai_numlt(0, step) ? luai_numlt(limit, init)
+ : luai_numlt(init, limit))
+ return 1; /* skip the loop */
+ else {
+ /* make sure internal values are all floats */
+ setfltvalue(plimit, limit);
+ setfltvalue(pstep, step);
+ setfltvalue(s2v(ra), init); /* internal index */
+ setfltvalue(s2v(ra + 3), init); /* control variable */
+ }
+ }
+ return 0;
+}
+
+
+/*
+** Execute a step of a float numerical for loop, returning
+** true iff the loop must continue. (The integer case is
+** written online with opcode OP_FORLOOP, for performance.)
+*/
+static int floatforloop (StkId ra) {
+ lua_Number step = fltvalue(s2v(ra + 2));
+ lua_Number limit = fltvalue(s2v(ra + 1));
+ lua_Number idx = fltvalue(s2v(ra)); /* internal index */
+ idx = luai_numadd(L, idx, step); /* increment index */
+ if (luai_numlt(0, step) ? luai_numle(idx, limit)
+ : luai_numle(limit, idx)) {
+ chgfltvalue(s2v(ra), idx); /* update internal index */
+ setfltvalue(s2v(ra + 3), idx); /* and control variable */
+ return 1; /* jump back */
+ }
+ else
+ return 0; /* finish the loop */
}
/*
** Finish the table access 'val = t[key]'.
** if 'slot' is NULL, 't' is not a table; otherwise, 'slot' points to
-** t[k] entry (which must be nil).
+** t[k] entry (which must be empty).
*/
void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val,
const TValue *slot) {
@@ -165,25 +292,25 @@
if (slot == NULL) { /* 't' is not a table? */
lua_assert(!ttistable(t));
tm = luaT_gettmbyobj(L, t, TM_INDEX);
- if (ttisnil(tm))
+ if (unlikely(notm(tm)))
luaG_typeerror(L, t, "index"); /* no metamethod */
/* else will try the metamethod */
}
else { /* 't' is a table */
- lua_assert(ttisnil(slot));
+ lua_assert(isempty(slot));
tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); /* table's metamethod */
if (tm == NULL) { /* no metamethod? */
- setnilvalue(val); /* result is nil */
+ setnilvalue(s2v(val)); /* result is nil */
return;
}
/* else will try the metamethod */
}
if (ttisfunction(tm)) { /* is metamethod a function? */
- luaT_callTM(L, tm, t, key, val, 1); /* call it */
+ luaT_callTMres(L, tm, t, key, val); /* call it */
return;
}
t = tm; /* else try to access 'tm[key]' */
- if (luaV_fastget(L,t,key,slot,luaH_get)) { /* fast track? */
+ if (luaV_fastget(L, t, key, slot, luaH_get)) { /* fast track? */
setobj2s(L, val, slot); /* done */
return;
}
@@ -196,51 +323,54 @@
/*
** Finish a table assignment 't[key] = val'.
** If 'slot' is NULL, 't' is not a table. Otherwise, 'slot' points
-** to the entry 't[key]', or to 'luaO_nilobject' if there is no such
-** entry. (The value at 'slot' must be nil, otherwise 'luaV_fastset'
-** would have done the job.)
+** to the entry 't[key]', or to a value with an absent key if there
+** is no such entry. (The value at 'slot' must be empty, otherwise
+** 'luaV_fastget' would have done the job.)
*/
void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
- StkId val, const TValue *slot) {
+ TValue *val, const TValue *slot) {
int loop; /* counter to avoid infinite loops */
for (loop = 0; loop < MAXTAGLOOP; loop++) {
const TValue *tm; /* '__newindex' metamethod */
if (slot != NULL) { /* is 't' a table? */
Table *h = hvalue(t); /* save 't' table */
- lua_assert(ttisnil(slot)); /* old value must be nil */
+ lua_assert(isempty(slot)); /* slot must be empty */
tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */
if (tm == NULL) { /* no metamethod? */
- if (slot == luaO_nilobject) /* no previous entry? */
+ if (isabstkey(slot)) /* no previous entry? */
slot = luaH_newkey(L, h, key); /* create one */
/* no metamethod and (now) there is an entry with given key */
setobj2t(L, cast(TValue *, slot), val); /* set its new value */
invalidateTMcache(h);
- luaC_barrierback(L, h, val);
+ luaC_barrierback(L, obj2gco(h), val);
return;
}
/* else will try the metamethod */
}
else { /* not a table; check metamethod */
- if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))
+ tm = luaT_gettmbyobj(L, t, TM_NEWINDEX);
+ if (unlikely(notm(tm)))
luaG_typeerror(L, t, "index");
}
/* try the metamethod */
if (ttisfunction(tm)) {
- luaT_callTM(L, tm, t, key, val, 0);
+ luaT_callTM(L, tm, t, key, val);
return;
}
t = tm; /* else repeat assignment over 'tm' */
- if (luaV_fastset(L, t, key, slot, luaH_get, val))
+ if (luaV_fastget(L, t, key, slot, luaH_get)) {
+ luaV_finishfastset(L, t, slot, val);
return; /* done */
- /* else loop */
+ }
+ /* else 'return luaV_finishset(L, t, key, val, slot)' (loop) */
}
luaG_runerror(L, "'__newindex' chain too long; possible loop");
}
/*
-** Compare two strings 'ls' x 'rs', returning an integer smaller-equal-
-** -larger than zero if 'ls' is smaller-equal-larger than 'rs'.
+** Compare two strings 'ls' x 'rs', returning an integer less-equal-
+** -greater than zero if 'ls' is less-equal-greater than 'rs'.
** The code is a little tricky because it allows '\0' in the strings
** and it uses 'strcoll' (to respect locales) for each segments
** of the strings.
@@ -259,7 +389,7 @@
if (len == lr) /* 'rs' is finished? */
return (len == ll) ? 0 : 1; /* check 'ls' */
else if (len == ll) /* 'ls' is finished? */
- return -1; /* 'ls' is smaller than 'rs' ('rs' is not finished) */
+ return -1; /* 'ls' is less than 'rs' ('rs' is not finished) */
/* both strings longer than 'len'; go on comparing after the '\0' */
len++;
l += len; ll -= len; r += len; lr -= len;
@@ -271,25 +401,24 @@
/*
** Check whether integer 'i' is less than float 'f'. If 'i' has an
** exact representation as a float ('l_intfitsf'), compare numbers as
-** floats. Otherwise, if 'f' is outside the range for integers, result
-** is trivial. Otherwise, compare them as integers. (When 'i' has no
-** float representation, either 'f' is "far away" from 'i' or 'f' has
-** no precision left for a fractional part; either way, how 'f' is
-** truncated is irrelevant.) When 'f' is NaN, comparisons must result
-** in false.
+** floats. Otherwise, use the equivalence 'i < f <=> i < ceil(f)'.
+** If 'ceil(f)' is out of integer range, either 'f' is greater than
+** all integers or less than all integers.
+** (The test with 'l_intfitsf' is only for performance; the else
+** case is correct for all values, but it is slow due to the conversion
+** from float to int.)
+** When 'f' is NaN, comparisons must result in false.
*/
static int LTintfloat (lua_Integer i, lua_Number f) {
-#if defined(l_intfitsf)
- if (!l_intfitsf(i)) {
- if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */
- return 1; /* f >= maxint + 1 > i */
- else if (f > cast_num(LUA_MININTEGER)) /* minint < f <= maxint ? */
- return (i < cast(lua_Integer, f)); /* compare them as integers */
- else /* f <= minint <= i (or 'f' is NaN) --> not(i < f) */
- return 0;
+ if (l_intfitsf(i))
+ return luai_numlt(cast_num(i), f); /* compare them as floats */
+ else { /* i < f <=> i < ceil(f) */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
+ return i < fi; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f > 0; /* greater? */
}
-#endif
- return luai_numlt(cast_num(i), f); /* compare them as floats */
}
@@ -298,17 +427,49 @@
** See comments on previous function.
*/
static int LEintfloat (lua_Integer i, lua_Number f) {
-#if defined(l_intfitsf)
- if (!l_intfitsf(i)) {
- if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */
- return 1; /* f >= maxint + 1 > i */
- else if (f >= cast_num(LUA_MININTEGER)) /* minint <= f <= maxint ? */
- return (i <= cast(lua_Integer, f)); /* compare them as integers */
- else /* f < minint <= i (or 'f' is NaN) --> not(i <= f) */
- return 0;
+ if (l_intfitsf(i))
+ return luai_numle(cast_num(i), f); /* compare them as floats */
+ else { /* i <= f <=> i <= floor(f) */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
+ return i <= fi; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f > 0; /* greater? */
}
-#endif
- return luai_numle(cast_num(i), f); /* compare them as floats */
+}
+
+
+/*
+** Check whether float 'f' is less than integer 'i'.
+** See comments on previous function.
+*/
+static int LTfloatint (lua_Number f, lua_Integer i) {
+ if (l_intfitsf(i))
+ return luai_numlt(f, cast_num(i)); /* compare them as floats */
+ else { /* f < i <=> floor(f) < i */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
+ return fi < i; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f < 0; /* less? */
+ }
+}
+
+
+/*
+** Check whether float 'f' is less than or equal to integer 'i'.
+** See comments on previous function.
+*/
+static int LEfloatint (lua_Number f, lua_Integer i) {
+ if (l_intfitsf(i))
+ return luai_numle(f, cast_num(i)); /* compare them as floats */
+ else { /* f <= i <=> ceil(f) <= i */
+ lua_Integer fi;
+ if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
+ return fi <= i; /* compare them as integers */
+ else /* 'f' is either greater or less than all integers */
+ return f < 0; /* less? */
+ }
}
@@ -316,6 +477,7 @@
** Return 'l < r', for numbers.
*/
static int LTnum (const TValue *l, const TValue *r) {
+ lua_assert(ttisnumber(l) && ttisnumber(r));
if (ttisinteger(l)) {
lua_Integer li = ivalue(l);
if (ttisinteger(r))
@@ -327,10 +489,8 @@
lua_Number lf = fltvalue(l); /* 'l' must be float */
if (ttisfloat(r))
return luai_numlt(lf, fltvalue(r)); /* both are float */
- else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */
- return 0; /* NaN < i is always false */
- else /* without NaN, (l < r) <--> not(r <= l) */
- return !LEintfloat(ivalue(r), lf); /* not (r <= l) ? */
+ else /* 'l' is float and 'r' is int */
+ return LTfloatint(lf, ivalue(r));
}
}
@@ -339,6 +499,7 @@
** Return 'l <= r', for numbers.
*/
static int LEnum (const TValue *l, const TValue *r) {
+ lua_assert(ttisnumber(l) && ttisnumber(r));
if (ttisinteger(l)) {
lua_Integer li = ivalue(l);
if (ttisinteger(r))
@@ -350,53 +511,53 @@
lua_Number lf = fltvalue(l); /* 'l' must be float */
if (ttisfloat(r))
return luai_numle(lf, fltvalue(r)); /* both are float */
- else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */
- return 0; /* NaN <= i is always false */
- else /* without NaN, (l <= r) <--> not(r < l) */
- return !LTintfloat(ivalue(r), lf); /* not (r < l) ? */
+ else /* 'l' is float and 'r' is int */
+ return LEfloatint(lf, ivalue(r));
}
}
/*
+** return 'l < r' for non-numbers.
+*/
+static int lessthanothers (lua_State *L, const TValue *l, const TValue *r) {
+ lua_assert(!ttisnumber(l) || !ttisnumber(r));
+ if (ttisstring(l) && ttisstring(r)) /* both are strings? */
+ return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
+ else
+ return luaT_callorderTM(L, l, r, TM_LT);
+}
+
+
+/*
** Main operation less than; return 'l < r'.
*/
int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
- int res;
if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
return LTnum(l, r);
- else if (ttisstring(l) && ttisstring(r)) /* both are strings? */
- return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
- else if ((res = luaT_callorderTM(L, l, r, TM_LT)) < 0) /* no metamethod? */
- luaG_ordererror(L, l, r); /* error */
- return res;
+ else return lessthanothers(L, l, r);
}
/*
-** Main operation less than or equal to; return 'l <= r'. If it needs
-** a metamethod and there is no '__le', try '__lt', based on
-** l <= r iff !(r < l) (assuming a total order). If the metamethod
-** yields during this substitution, the continuation has to know
-** about it (to negate the result of r<l); bit CIST_LEQ in the call
-** status keeps that information.
+** return 'l <= r' for non-numbers.
+*/
+static int lessequalothers (lua_State *L, const TValue *l, const TValue *r) {
+ lua_assert(!ttisnumber(l) || !ttisnumber(r));
+ if (ttisstring(l) && ttisstring(r)) /* both are strings? */
+ return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
+ else
+ return luaT_callorderTM(L, l, r, TM_LE);
+}
+
+
+/*
+** Main operation less than or equal to; return 'l <= r'.
*/
int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
- int res;
if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
return LEnum(l, r);
- else if (ttisstring(l) && ttisstring(r)) /* both are strings? */
- return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
- else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0) /* try 'le' */
- return res;
- else { /* try 'lt': */
- L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
- res = luaT_callorderTM(L, r, l, TM_LT);
- L->ci->callstatus ^= CIST_LEQ; /* clear mark */
- if (res < 0)
- luaG_ordererror(L, l, r);
- return !res; /* result is negated */
- }
+ else return lessequalothers(L, l, r);
}
@@ -406,25 +567,24 @@
*/
int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
const TValue *tm;
- if (ttype(t1) != ttype(t2)) { /* not the same variant? */
- if (ttnov(t1) != ttnov(t2) || ttnov(t1) != LUA_TNUMBER)
+ if (ttypetag(t1) != ttypetag(t2)) { /* not the same variant? */
+ if (ttype(t1) != ttype(t2) || ttype(t1) != LUA_TNUMBER)
return 0; /* only numbers can be equal with different variants */
else { /* two numbers with different variants */
lua_Integer i1, i2; /* compare them as integers */
- return (tointeger(t1, &i1) && tointeger(t2, &i2) && i1 == i2);
+ return (tointegerns(t1, &i1) && tointegerns(t2, &i2) && i1 == i2);
}
}
/* values have same type and same variant */
- switch (ttype(t1)) {
- case LUA_TNIL: return 1;
- case LUA_TNUMINT: return (ivalue(t1) == ivalue(t2));
- case LUA_TNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
- case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */
- case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
- case LUA_TLCF: return fvalue(t1) == fvalue(t2);
- case LUA_TSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
- case LUA_TLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
- case LUA_TUSERDATA: {
+ switch (ttypetag(t1)) {
+ case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE: return 1;
+ case LUA_VNUMINT: return (ivalue(t1) == ivalue(t2));
+ case LUA_VNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
+ case LUA_VLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
+ case LUA_VLCF: return fvalue(t1) == fvalue(t2);
+ case LUA_VSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
+ case LUA_VLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
+ case LUA_VUSERDATA: {
if (uvalue(t1) == uvalue(t2)) return 1;
else if (L == NULL) return 0;
tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
@@ -432,7 +592,7 @@
tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
break; /* will try TM */
}
- case LUA_TTABLE: {
+ case LUA_VTABLE: {
if (hvalue(t1) == hvalue(t2)) return 1;
else if (L == NULL) return 0;
tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
@@ -445,8 +605,10 @@
}
if (tm == NULL) /* no TM? */
return 0; /* objects are different */
- luaT_callTM(L, tm, t1, t2, L->top, 1); /* call TM */
- return !l_isfalse(L->top);
+ else {
+ luaT_callTMres(L, tm, t1, t2, L->top); /* call TM */
+ return !l_isfalse(s2v(L->top));
+ }
}
@@ -460,8 +622,8 @@
static void copy2buff (StkId top, int n, char *buff) {
size_t tl = 0; /* size already copied */
do {
- size_t l = vslen(top - n); /* length of string being copied */
- memcpy(buff + tl, svalue(top - n), l * sizeof(char));
+ size_t l = vslen(s2v(top - n)); /* length of string being copied */
+ memcpy(buff + tl, svalue(s2v(top - n)), l * sizeof(char));
tl += l;
} while (--n > 0);
}
@@ -476,21 +638,22 @@
do {
StkId top = L->top;
int n = 2; /* number of elements handled in this pass (at least 2) */
- if (!(ttisstring(top-2) || cvt2str(top-2)) || !tostring(L, top-1))
- luaT_trybinTM(L, top-2, top-1, top-2, TM_CONCAT);
- else if (isemptystr(top - 1)) /* second operand is empty? */
- cast_void(tostring(L, top - 2)); /* result is first operand */
- else if (isemptystr(top - 2)) { /* first operand is an empty string? */
+ if (!(ttisstring(s2v(top - 2)) || cvt2str(s2v(top - 2))) ||
+ !tostring(L, s2v(top - 1)))
+ luaT_tryconcatTM(L);
+ else if (isemptystr(s2v(top - 1))) /* second operand is empty? */
+ cast_void(tostring(L, s2v(top - 2))); /* result is first operand */
+ else if (isemptystr(s2v(top - 2))) { /* first operand is empty string? */
setobjs2s(L, top - 2, top - 1); /* result is second op. */
}
else {
/* at least two non-empty string values; get as many as possible */
- size_t tl = vslen(top - 1);
+ size_t tl = vslen(s2v(top - 1));
TString *ts;
/* collect total length and number of strings */
- for (n = 1; n < total && tostring(L, top - n - 1); n++) {
- size_t l = vslen(top - n - 1);
- if (l >= (MAX_SIZE/sizeof(char)) - tl)
+ for (n = 1; n < total && tostring(L, s2v(top - n - 1)); n++) {
+ size_t l = vslen(s2v(top - n - 1));
+ if (unlikely(l >= (MAX_SIZE/sizeof(char)) - tl))
luaG_runerror(L, "string length overflow");
tl += l;
}
@@ -512,34 +675,34 @@
/*
-** Main operation 'ra' = #rb'.
+** Main operation 'ra = #rb'.
*/
void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {
const TValue *tm;
- switch (ttype(rb)) {
- case LUA_TTABLE: {
+ switch (ttypetag(rb)) {
+ case LUA_VTABLE: {
Table *h = hvalue(rb);
tm = fasttm(L, h->metatable, TM_LEN);
if (tm) break; /* metamethod? break switch to call it */
- setivalue(ra, luaH_getn(h)); /* else primitive len */
+ setivalue(s2v(ra), luaH_getn(h)); /* else primitive len */
return;
}
- case LUA_TSHRSTR: {
- setivalue(ra, tsvalue(rb)->shrlen);
+ case LUA_VSHRSTR: {
+ setivalue(s2v(ra), tsvalue(rb)->shrlen);
return;
}
- case LUA_TLNGSTR: {
- setivalue(ra, tsvalue(rb)->u.lnglen);
+ case LUA_VLNGSTR: {
+ setivalue(s2v(ra), tsvalue(rb)->u.lnglen);
return;
}
default: { /* try metamethod */
tm = luaT_gettmbyobj(L, rb, TM_LEN);
- if (ttisnil(tm)) /* no metamethod? */
+ if (unlikely(notm(tm))) /* no metamethod? */
luaG_typeerror(L, rb, "get length of");
break;
}
}
- luaT_callTM(L, tm, rb, rb, ra, 1);
+ luaT_callTMres(L, tm, rb, rb, ra);
}
@@ -549,8 +712,8 @@
** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,
** otherwise 'floor(q) == trunc(q) - 1'.
*/
-lua_Integer luaV_div (lua_State *L, lua_Integer m, lua_Integer n) {
- if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */
+lua_Integer luaV_idiv (lua_State *L, lua_Integer m, lua_Integer n) {
+ if (unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
if (n == 0)
luaG_runerror(L, "attempt to divide by zero");
return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */
@@ -567,29 +730,41 @@
/*
** Integer modulus; return 'm % n'. (Assume that C '%' with
** negative operands follows C99 behavior. See previous comment
-** about luaV_div.)
+** about luaV_idiv.)
*/
lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {
- if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */
+ if (unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
if (n == 0)
luaG_runerror(L, "attempt to perform 'n%%0'");
return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */
}
else {
lua_Integer r = m % n;
- if (r != 0 && (m ^ n) < 0) /* 'm/n' would be non-integer negative? */
+ if (r != 0 && (r ^ n) < 0) /* 'm/n' would be non-integer negative? */
r += n; /* correct result for different rounding */
return r;
}
}
+/*
+** Float modulus
+*/
+lua_Number luaV_modf (lua_State *L, lua_Number m, lua_Number n) {
+ lua_Number r;
+ luai_nummod(L, m, n, r);
+ return r;
+}
+
+
/* number of bits in an integer */
#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT)
/*
** Shift left operation. (Shift right just negates 'y'.)
*/
+#define luaV_shiftr(x,y) luaV_shiftl(x,-(y))
+
lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {
if (y < 0) { /* shift right? */
if (y <= -NBITS) return 0;
@@ -603,31 +778,8 @@
/*
-** check whether cached closure in prototype 'p' may be reused, that is,
-** whether there is a cached closure with the same upvalues needed by
-** new closure to be created.
-*/
-static LClosure *getcached (Proto *p, UpVal **encup, StkId base) {
- LClosure *c = p->cache;
- if (c != NULL) { /* is there a cached closure? */
- int nup = p->sizeupvalues;
- Upvaldesc *uv = p->upvalues;
- int i;
- for (i = 0; i < nup; i++) { /* check whether it has right upvalues */
- TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v;
- if (c->upvals[i]->v != v)
- return NULL; /* wrong upvalue; cannot reuse closure */
- }
- }
- return c; /* return cached closure (or NULL if no cached closure) */
-}
-
-
-/*
** create a new Lua closure, push it in the stack, and initialize
-** its upvalues. Note that the closure is not cached if prototype is
-** already black (which means that 'cache' was already cleared by the
-** GC).
+** its upvalues.
*/
static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
StkId ra) {
@@ -636,77 +788,71 @@
int i;
LClosure *ncl = luaF_newLclosure(L, nup);
ncl->p = p;
- setclLvalue(L, ra, ncl); /* anchor new closure in stack */
+ setclLvalue2s(L, ra, ncl); /* anchor new closure in stack */
for (i = 0; i < nup; i++) { /* fill in its upvalues */
if (uv[i].instack) /* upvalue refers to local variable? */
ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);
else /* get upvalue from enclosing function */
ncl->upvals[i] = encup[uv[i].idx];
- ncl->upvals[i]->refcount++;
- /* new closure is white, so we do not need a barrier here */
+ luaC_objbarrier(L, ncl, ncl->upvals[i]);
}
- if (!isblack(p)) /* cache will not break GC invariant? */
- p->cache = ncl; /* save it on cache for reuse */
}
/*
-** finish execution of an opcode interrupted by an yield
+** finish execution of an opcode interrupted by a yield
*/
void luaV_finishOp (lua_State *L) {
CallInfo *ci = L->ci;
- StkId base = ci->u.l.base;
+ StkId base = ci->func + 1;
Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */
OpCode op = GET_OPCODE(inst);
switch (op) { /* finish its execution */
- case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: case OP_IDIV:
- case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR:
- case OP_MOD: case OP_POW:
+ case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
+ setobjs2s(L, base + GETARG_A(*(ci->u.l.savedpc - 2)), --L->top);
+ break;
+ }
case OP_UNM: case OP_BNOT: case OP_LEN:
- case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: {
+ case OP_GETTABUP: case OP_GETTABLE: case OP_GETI:
+ case OP_GETFIELD: case OP_SELF: {
setobjs2s(L, base + GETARG_A(inst), --L->top);
break;
}
- case OP_LE: case OP_LT: case OP_EQ: {
- int res = !l_isfalse(L->top - 1);
+ case OP_LT: case OP_LE:
+ case OP_LTI: case OP_LEI:
+ case OP_GTI: case OP_GEI:
+ case OP_EQ: { /* note that 'OP_EQI'/'OP_EQK' cannot yield */
+ int res = !l_isfalse(s2v(L->top - 1));
L->top--;
+#if defined(LUA_COMPAT_LT_LE)
if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */
- lua_assert(op == OP_LE);
ci->callstatus ^= CIST_LEQ; /* clear mark */
res = !res; /* negate result */
}
+#endif
lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
- if (res != GETARG_A(inst)) /* condition failed? */
+ if (res != GETARG_k(inst)) /* condition failed? */
ci->u.l.savedpc++; /* skip jump instruction */
break;
}
case OP_CONCAT: {
- StkId top = L->top - 1; /* top when 'luaT_trybinTM' was called */
- int b = GETARG_B(inst); /* first element to concatenate */
- int total = cast_int(top - 1 - (base + b)); /* yet to concatenate */
- setobj2s(L, top - 2, top); /* put TM result in proper position */
+ StkId top = L->top - 1; /* top when 'luaT_tryconcatTM' was called */
+ int a = GETARG_A(inst); /* first element to concatenate */
+ int total = cast_int(top - 1 - (base + a)); /* yet to concatenate */
+ setobjs2s(L, top - 2, top); /* put TM result in proper position */
if (total > 1) { /* are there elements to concat? */
L->top = top - 1; /* top is one after last element (at top-2) */
luaV_concat(L, total); /* concat them (may yield again) */
}
- /* move final result to final position */
- setobj2s(L, ci->u.l.base + GETARG_A(inst), L->top - 1);
- L->top = ci->top; /* restore top */
break;
}
- case OP_TFORCALL: {
- lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_TFORLOOP);
- L->top = ci->top; /* correct top */
+ default: {
+ /* only these other opcodes can yield */
+ lua_assert(op == OP_TFORCALL || op == OP_CALL ||
+ op == OP_TAILCALL || op == OP_SETTABUP || op == OP_SETTABLE ||
+ op == OP_SETI || op == OP_SETFIELD);
break;
}
- case OP_CALL: {
- if (GETARG_C(inst) - 1 >= 0) /* nresults >= 0? */
- L->top = ci->top; /* adjust results */
- break;
- }
- case OP_TAILCALL: case OP_SETTABUP: case OP_SETTABLE:
- break;
- default: lua_assert(0);
}
}
@@ -715,10 +861,172 @@
/*
** {==================================================================
-** Function 'luaV_execute': main interpreter loop
+** Macros for arithmetic/bitwise/comparison opcodes in 'luaV_execute'
** ===================================================================
*/
+#define l_addi(L,a,b) intop(+, a, b)
+#define l_subi(L,a,b) intop(-, a, b)
+#define l_muli(L,a,b) intop(*, a, b)
+#define l_band(a,b) intop(&, a, b)
+#define l_bor(a,b) intop(|, a, b)
+#define l_bxor(a,b) intop(^, a, b)
+
+#define l_lti(a,b) (a < b)
+#define l_lei(a,b) (a <= b)
+#define l_gti(a,b) (a > b)
+#define l_gei(a,b) (a >= b)
+
+
+/*
+** Arithmetic operations with immediate operands. 'iop' is the integer
+** operation, 'fop' is the float operation.
+*/
+#define op_arithI(L,iop,fop) { \
+ TValue *v1 = vRB(i); \
+ int imm = GETARG_sC(i); \
+ if (ttisinteger(v1)) { \
+ lua_Integer iv1 = ivalue(v1); \
+ pc++; setivalue(s2v(ra), iop(L, iv1, imm)); \
+ } \
+ else if (ttisfloat(v1)) { \
+ lua_Number nb = fltvalue(v1); \
+ lua_Number fimm = cast_num(imm); \
+ pc++; setfltvalue(s2v(ra), fop(L, nb, fimm)); \
+ }}
+
+
+/*
+** Auxiliary function for arithmetic operations over floats and others
+** with two register operands.
+*/
+#define op_arithf_aux(L,v1,v2,fop) { \
+ lua_Number n1; lua_Number n2; \
+ if (tonumberns(v1, n1) && tonumberns(v2, n2)) { \
+ pc++; setfltvalue(s2v(ra), fop(L, n1, n2)); \
+ }}
+
+
+/*
+** Arithmetic operations over floats and others with register operands.
+*/
+#define op_arithf(L,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations with K operands for floats.
+*/
+#define op_arithfK(L,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); \
+ op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations over integers and floats.
+*/
+#define op_arith_aux(L,v1,v2,iop,fop) { \
+ if (ttisinteger(v1) && ttisinteger(v2)) { \
+ lua_Integer i1 = ivalue(v1); lua_Integer i2 = ivalue(v2); \
+ pc++; setivalue(s2v(ra), iop(L, i1, i2)); \
+ } \
+ else op_arithf_aux(L, v1, v2, fop); }
+
+
+/*
+** Arithmetic operations with register operands.
+*/
+#define op_arith(L,iop,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ op_arith_aux(L, v1, v2, iop, fop); }
+
+
+/*
+** Arithmetic operations with K operands.
+*/
+#define op_arithK(L,iop,fop) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); \
+ op_arith_aux(L, v1, v2, iop, fop); }
+
+
+/*
+** Bitwise operations with constant operand.
+*/
+#define op_bitwiseK(L,op) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = KC(i); \
+ lua_Integer i1; \
+ lua_Integer i2 = ivalue(v2); \
+ if (tointegerns(v1, &i1)) { \
+ pc++; setivalue(s2v(ra), op(i1, i2)); \
+ }}
+
+
+/*
+** Bitwise operations with register operands.
+*/
+#define op_bitwise(L,op) { \
+ TValue *v1 = vRB(i); \
+ TValue *v2 = vRC(i); \
+ lua_Integer i1; lua_Integer i2; \
+ if (tointegerns(v1, &i1) && tointegerns(v2, &i2)) { \
+ pc++; setivalue(s2v(ra), op(i1, i2)); \
+ }}
+
+
+/*
+** Order operations with register operands. 'opn' actually works
+** for all numbers, but the fast track improves performance for
+** integers.
+*/
+#define op_order(L,opi,opn,other) { \
+ int cond; \
+ TValue *rb = vRB(i); \
+ if (ttisinteger(s2v(ra)) && ttisinteger(rb)) { \
+ lua_Integer ia = ivalue(s2v(ra)); \
+ lua_Integer ib = ivalue(rb); \
+ cond = opi(ia, ib); \
+ } \
+ else if (ttisnumber(s2v(ra)) && ttisnumber(rb)) \
+ cond = opn(s2v(ra), rb); \
+ else \
+ Protect(cond = other(L, s2v(ra), rb)); \
+ docondjump(); }
+
+
+/*
+** Order operations with immediate operand. (Immediate operand is
+** always small enough to have an exact representation as a float.)
+*/
+#define op_orderI(L,opi,opf,inv,tm) { \
+ int cond; \
+ int im = GETARG_sB(i); \
+ if (ttisinteger(s2v(ra))) \
+ cond = opi(ivalue(s2v(ra)), im); \
+ else if (ttisfloat(s2v(ra))) { \
+ lua_Number fa = fltvalue(s2v(ra)); \
+ lua_Number fim = cast_num(im); \
+ cond = opf(fa, fim); \
+ } \
+ else { \
+ int isf = GETARG_C(i); \
+ Protect(cond = luaT_callorderiTM(L, s2v(ra), im, inv, isf, tm)); \
+ } \
+ docondjump(); }
+
+/* }================================================================== */
+
+
+/*
+** {==================================================================
+** Function 'luaV_execute': main interpreter loop
+** ===================================================================
+*/
/*
** some macros for common tasks in 'luaV_execute'
@@ -726,40 +1034,89 @@
#define RA(i) (base+GETARG_A(i))
-#define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i))
-#define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i))
-#define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \
- ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i))
-#define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \
- ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i))
+#define RB(i) (base+GETARG_B(i))
+#define vRB(i) s2v(RB(i))
+#define KB(i) (k+GETARG_B(i))
+#define RC(i) (base+GETARG_C(i))
+#define vRC(i) s2v(RC(i))
+#define KC(i) (k+GETARG_C(i))
+#define RKC(i) ((TESTARG_k(i)) ? k + GETARG_C(i) : s2v(base + GETARG_C(i)))
-/* execute a jump instruction */
-#define dojump(ci,i,e) \
- { int a = GETARG_A(i); \
- if (a != 0) luaF_close(L, ci->u.l.base + a - 1); \
- ci->u.l.savedpc += GETARG_sBx(i) + e; }
+
+#define updatetrap(ci) (trap = ci->u.l.trap)
+
+#define updatebase(ci) (base = ci->func + 1)
+
+
+#define updatestack(ci) { if (trap) { updatebase(ci); ra = RA(i); } }
+
+
+/*
+** Execute a jump instruction. The 'updatetrap' allows signals to stop
+** tight loops. (Without it, the local copy of 'trap' could never change.)
+*/
+#define dojump(ci,i,e) { pc += GETARG_sJ(i) + e; updatetrap(ci); }
+
/* for test instructions, execute the jump instruction that follows it */
-#define donextjump(ci) { i = *ci->u.l.savedpc; dojump(ci, i, 1); }
+#define donextjump(ci) { Instruction ni = *pc; dojump(ci, ni, 1); }
+
+/*
+** do a conditional jump: skip next instruction if 'cond' is not what
+** was expected (parameter 'k'), else do next instruction, which must
+** be a jump.
+*/
+#define docondjump() if (cond != GETARG_k(i)) pc++; else donextjump(ci);
-#define Protect(x) { {x;}; base = ci->u.l.base; }
+/*
+** Correct global 'pc'.
+*/
+#define savepc(L) (ci->u.l.savedpc = pc)
+
+
+/*
+** Whenever code can raise errors, the global 'pc' and the global
+** 'top' must be correct to report occasional errors.
+*/
+#define savestate(L,ci) (savepc(L), L->top = ci->top)
+
+
+/*
+** Protect code that, in general, can raise errors, reallocate the
+** stack, and change the hooks.
+*/
+#define Protect(exp) (savestate(L,ci), (exp), updatetrap(ci))
+
+/* special version that does not change the top */
+#define ProtectNT(exp) (savepc(L), (exp), updatetrap(ci))
+
+/*
+** Protect code that will finish the loop (returns) or can only raise
+** errors. (That is, it will not return to the interpreter main loop
+** after changing the stack or hooks.)
+*/
+#define halfProtect(exp) (savestate(L,ci), (exp))
+
+/* idem, but without changing the stack */
+#define halfProtectNT(exp) (savepc(L), (exp))
+
#define checkGC(L,c) \
{ luaC_condGC(L, L->top = (c), /* limit of live values */ \
- Protect(L->top = ci->top)); /* restore top */ \
+ updatetrap(ci)); \
luai_threadyield(L); }
/* fetch an instruction and prepare its execution */
#define vmfetch() { \
- i = *(ci->u.l.savedpc++); \
- if (L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) \
- Protect(luaG_traceexec(L)); \
+ if (trap) { /* stack reallocation or hooks? */ \
+ trap = luaG_traceexec(L, pc); /* handle hooks */ \
+ updatebase(ci); /* correct stack */ \
+ } \
+ i = *(pc++); \
ra = RA(i); /* WARNING: any stack reallocation invalidates 'ra' */ \
- lua_assert(base == ci->u.l.base); \
- lua_assert(base <= L->top && L->top < L->stack + L->stacksize); \
}
#define vmdispatch(o) switch(o)
@@ -767,43 +1124,52 @@
#define vmbreak break
-/*
-** copy of 'luaV_gettable', but protecting the call to potential
-** metamethod (which can reallocate the stack)
-*/
-#define gettableProtected(L,t,k,v) { const TValue *slot; \
- if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \
- else Protect(luaV_finishget(L,t,k,v,slot)); }
-
-
-/* same for 'luaV_settable' */
-#define settableProtected(L,t,k,v) { const TValue *slot; \
- if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \
- Protect(luaV_finishset(L,t,k,v,slot)); }
-
-
-
-void luaV_execute (lua_State *L) {
- CallInfo *ci = L->ci;
+void luaV_execute (lua_State *L, CallInfo *ci) {
LClosure *cl;
TValue *k;
StkId base;
- ci->callstatus |= CIST_FRESH; /* fresh invocation of 'luaV_execute" */
- newframe: /* reentry point when frame changes (call/return) */
- lua_assert(ci == L->ci);
- cl = clLvalue(ci->func); /* local reference to function's closure */
- k = cl->p->k; /* local reference to function's constant table */
- base = ci->u.l.base; /* local copy of function's base */
+ const Instruction *pc;
+ int trap;
+#if LUA_USE_JUMPTABLE
+#include "ljumptab.h"
+#endif
+ tailcall:
+ trap = L->hookmask;
+ cl = clLvalue(s2v(ci->func));
+ k = cl->p->k;
+ pc = ci->u.l.savedpc;
+ if (trap) {
+ if (cl->p->is_vararg)
+ trap = 0; /* hooks will start after VARARGPREP instruction */
+ else if (pc == cl->p->code) /* first instruction (not resuming)? */
+ luaD_hookcall(L, ci);
+ ci->u.l.trap = 1; /* there may be other hooks */
+ }
+ base = ci->func + 1;
/* main loop of interpreter */
for (;;) {
- Instruction i;
- StkId ra;
+ Instruction i; /* instruction being executed */
+ StkId ra; /* instruction's A register */
vmfetch();
+ lua_assert(base == ci->func + 1);
+ lua_assert(base <= L->top && L->top < L->stack + L->stacksize);
+ /* invalidate top for instructions not expecting it */
+ lua_assert(isIT(i) || (cast_void(L->top = base), 1));
vmdispatch (GET_OPCODE(i)) {
vmcase(OP_MOVE) {
setobjs2s(L, ra, RB(i));
vmbreak;
}
+ vmcase(OP_LOADI) {
+ lua_Integer b = GETARG_sBx(i);
+ setivalue(s2v(ra), b);
+ vmbreak;
+ }
+ vmcase(OP_LOADF) {
+ int b = GETARG_sBx(i);
+ setfltvalue(s2v(ra), cast_num(b));
+ vmbreak;
+ }
vmcase(OP_LOADK) {
TValue *rb = k + GETARG_Bx(i);
setobj2s(L, ra, rb);
@@ -811,20 +1177,27 @@
}
vmcase(OP_LOADKX) {
TValue *rb;
- lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);
- rb = k + GETARG_Ax(*ci->u.l.savedpc++);
+ rb = k + GETARG_Ax(*pc); pc++;
setobj2s(L, ra, rb);
vmbreak;
}
- vmcase(OP_LOADBOOL) {
- setbvalue(ra, GETARG_B(i));
- if (GETARG_C(i)) ci->u.l.savedpc++; /* skip next instruction (if C) */
+ vmcase(OP_LOADFALSE) {
+ setbfvalue(s2v(ra));
+ vmbreak;
+ }
+ vmcase(OP_LFALSESKIP) {
+ setbfvalue(s2v(ra));
+ pc++; /* skip next instruction */
+ vmbreak;
+ }
+ vmcase(OP_LOADTRUE) {
+ setbtvalue(s2v(ra));
vmbreak;
}
vmcase(OP_LOADNIL) {
int b = GETARG_B(i);
do {
- setnilvalue(ra++);
+ setnilvalue(s2v(ra++));
} while (b--);
vmbreak;
}
@@ -833,248 +1206,335 @@
setobj2s(L, ra, cl->upvals[b]->v);
vmbreak;
}
+ vmcase(OP_SETUPVAL) {
+ UpVal *uv = cl->upvals[GETARG_B(i)];
+ setobj(L, uv->v, s2v(ra));
+ luaC_barrier(L, uv, s2v(ra));
+ vmbreak;
+ }
vmcase(OP_GETTABUP) {
+ const TValue *slot;
TValue *upval = cl->upvals[GETARG_B(i)]->v;
- TValue *rc = RKC(i);
- gettableProtected(L, upval, rc, ra);
+ TValue *rc = KC(i);
+ TString *key = tsvalue(rc); /* key must be a string */
+ if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, upval, rc, ra, slot));
vmbreak;
}
vmcase(OP_GETTABLE) {
- StkId rb = RB(i);
- TValue *rc = RKC(i);
- gettableProtected(L, rb, rc, ra);
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ TValue *rc = vRC(i);
+ lua_Unsigned n;
+ if (ttisinteger(rc) /* fast track for integers? */
+ ? (cast_void(n = ivalue(rc)), luaV_fastgeti(L, rb, n, slot))
+ : luaV_fastget(L, rb, rc, slot, luaH_get)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_GETI) {
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ int c = GETARG_C(i);
+ if (luaV_fastgeti(L, rb, c, slot)) {
+ setobj2s(L, ra, slot);
+ }
+ else {
+ TValue key;
+ setivalue(&key, c);
+ Protect(luaV_finishget(L, rb, &key, ra, slot));
+ }
+ vmbreak;
+ }
+ vmcase(OP_GETFIELD) {
+ const TValue *slot;
+ TValue *rb = vRB(i);
+ TValue *rc = KC(i);
+ TString *key = tsvalue(rc); /* key must be a string */
+ if (luaV_fastget(L, rb, key, slot, luaH_getshortstr)) {
+ setobj2s(L, ra, slot);
+ }
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
vmbreak;
}
vmcase(OP_SETTABUP) {
+ const TValue *slot;
TValue *upval = cl->upvals[GETARG_A(i)]->v;
- TValue *rb = RKB(i);
+ TValue *rb = KB(i);
TValue *rc = RKC(i);
- settableProtected(L, upval, rb, rc);
- vmbreak;
- }
- vmcase(OP_SETUPVAL) {
- UpVal *uv = cl->upvals[GETARG_B(i)];
- setobj(L, uv->v, ra);
- luaC_upvalbarrier(L, uv);
+ TString *key = tsvalue(rb); /* key must be a string */
+ if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
+ luaV_finishfastset(L, upval, slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, upval, rb, rc, slot));
vmbreak;
}
vmcase(OP_SETTABLE) {
- TValue *rb = RKB(i);
+ const TValue *slot;
+ TValue *rb = vRB(i); /* key (table is in 'ra') */
+ TValue *rc = RKC(i); /* value */
+ lua_Unsigned n;
+ if (ttisinteger(rb) /* fast track for integers? */
+ ? (cast_void(n = ivalue(rb)), luaV_fastgeti(L, s2v(ra), n, slot))
+ : luaV_fastget(L, s2v(ra), rb, slot, luaH_get)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
+ vmbreak;
+ }
+ vmcase(OP_SETI) {
+ const TValue *slot;
+ int c = GETARG_B(i);
TValue *rc = RKC(i);
- settableProtected(L, ra, rb, rc);
+ if (luaV_fastgeti(L, s2v(ra), c, slot)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else {
+ TValue key;
+ setivalue(&key, c);
+ Protect(luaV_finishset(L, s2v(ra), &key, rc, slot));
+ }
+ vmbreak;
+ }
+ vmcase(OP_SETFIELD) {
+ const TValue *slot;
+ TValue *rb = KB(i);
+ TValue *rc = RKC(i);
+ TString *key = tsvalue(rb); /* key must be a string */
+ if (luaV_fastget(L, s2v(ra), key, slot, luaH_getshortstr)) {
+ luaV_finishfastset(L, s2v(ra), slot, rc);
+ }
+ else
+ Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
vmbreak;
}
vmcase(OP_NEWTABLE) {
- int b = GETARG_B(i);
- int c = GETARG_C(i);
- Table *t = luaH_new(L);
- sethvalue(L, ra, t);
+ int b = GETARG_B(i); /* log2(hash size) + 1 */
+ int c = GETARG_C(i); /* array size */
+ Table *t;
+ if (b > 0)
+ b = 1 << (b - 1); /* size is 2^(b - 1) */
+ lua_assert((!TESTARG_k(i)) == (GETARG_Ax(*pc) == 0));
+ if (TESTARG_k(i)) /* non-zero extra argument? */
+ c += GETARG_Ax(*pc) * (MAXARG_C + 1); /* add it to size */
+ pc++; /* skip extra argument */
+ L->top = ra + 1; /* correct top in case of emergency GC */
+ t = luaH_new(L); /* memory allocation */
+ sethvalue2s(L, ra, t);
if (b != 0 || c != 0)
- luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c));
+ luaH_resize(L, t, c, b); /* idem */
checkGC(L, ra + 1);
vmbreak;
}
vmcase(OP_SELF) {
- const TValue *aux;
- StkId rb = RB(i);
+ const TValue *slot;
+ TValue *rb = vRB(i);
TValue *rc = RKC(i);
TString *key = tsvalue(rc); /* key must be a string */
- setobjs2s(L, ra + 1, rb);
- if (luaV_fastget(L, rb, key, aux, luaH_getstr)) {
- setobj2s(L, ra, aux);
+ setobj2s(L, ra + 1, rb);
+ if (luaV_fastget(L, rb, key, slot, luaH_getstr)) {
+ setobj2s(L, ra, slot);
}
- else Protect(luaV_finishget(L, rb, rc, ra, aux));
+ else
+ Protect(luaV_finishget(L, rb, rc, ra, slot));
+ vmbreak;
+ }
+ vmcase(OP_ADDI) {
+ op_arithI(L, l_addi, luai_numadd);
+ vmbreak;
+ }
+ vmcase(OP_ADDK) {
+ op_arithK(L, l_addi, luai_numadd);
+ vmbreak;
+ }
+ vmcase(OP_SUBK) {
+ op_arithK(L, l_subi, luai_numsub);
+ vmbreak;
+ }
+ vmcase(OP_MULK) {
+ op_arithK(L, l_muli, luai_nummul);
+ vmbreak;
+ }
+ vmcase(OP_MODK) {
+ op_arithK(L, luaV_mod, luaV_modf);
+ vmbreak;
+ }
+ vmcase(OP_POWK) {
+ op_arithfK(L, luai_numpow);
+ vmbreak;
+ }
+ vmcase(OP_DIVK) {
+ op_arithfK(L, luai_numdiv);
+ vmbreak;
+ }
+ vmcase(OP_IDIVK) {
+ op_arithK(L, luaV_idiv, luai_numidiv);
+ vmbreak;
+ }
+ vmcase(OP_BANDK) {
+ op_bitwiseK(L, l_band);
+ vmbreak;
+ }
+ vmcase(OP_BORK) {
+ op_bitwiseK(L, l_bor);
+ vmbreak;
+ }
+ vmcase(OP_BXORK) {
+ op_bitwiseK(L, l_bxor);
+ vmbreak;
+ }
+ vmcase(OP_SHRI) {
+ TValue *rb = vRB(i);
+ int ic = GETARG_sC(i);
+ lua_Integer ib;
+ if (tointegerns(rb, &ib)) {
+ pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic));
+ }
+ vmbreak;
+ }
+ vmcase(OP_SHLI) {
+ TValue *rb = vRB(i);
+ int ic = GETARG_sC(i);
+ lua_Integer ib;
+ if (tointegerns(rb, &ib)) {
+ pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib));
+ }
vmbreak;
}
vmcase(OP_ADD) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (ttisinteger(rb) && ttisinteger(rc)) {
- lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
- setivalue(ra, intop(+, ib, ic));
- }
- else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_numadd(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_ADD)); }
+ op_arith(L, l_addi, luai_numadd);
vmbreak;
}
vmcase(OP_SUB) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (ttisinteger(rb) && ttisinteger(rc)) {
- lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
- setivalue(ra, intop(-, ib, ic));
- }
- else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_numsub(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SUB)); }
+ op_arith(L, l_subi, luai_numsub);
vmbreak;
}
vmcase(OP_MUL) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (ttisinteger(rb) && ttisinteger(rc)) {
- lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
- setivalue(ra, intop(*, ib, ic));
- }
- else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_nummul(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MUL)); }
- vmbreak;
- }
- vmcase(OP_DIV) { /* float division (always with floats) */
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_numdiv(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_DIV)); }
- vmbreak;
- }
- vmcase(OP_BAND) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Integer ib; lua_Integer ic;
- if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
- setivalue(ra, intop(&, ib, ic));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BAND)); }
- vmbreak;
- }
- vmcase(OP_BOR) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Integer ib; lua_Integer ic;
- if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
- setivalue(ra, intop(|, ib, ic));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BOR)); }
- vmbreak;
- }
- vmcase(OP_BXOR) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Integer ib; lua_Integer ic;
- if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
- setivalue(ra, intop(^, ib, ic));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BXOR)); }
- vmbreak;
- }
- vmcase(OP_SHL) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Integer ib; lua_Integer ic;
- if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
- setivalue(ra, luaV_shiftl(ib, ic));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHL)); }
- vmbreak;
- }
- vmcase(OP_SHR) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Integer ib; lua_Integer ic;
- if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
- setivalue(ra, luaV_shiftl(ib, -ic));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHR)); }
+ op_arith(L, l_muli, luai_nummul);
vmbreak;
}
vmcase(OP_MOD) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (ttisinteger(rb) && ttisinteger(rc)) {
- lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
- setivalue(ra, luaV_mod(L, ib, ic));
- }
- else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- lua_Number m;
- luai_nummod(L, nb, nc, m);
- setfltvalue(ra, m);
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MOD)); }
- vmbreak;
- }
- vmcase(OP_IDIV) { /* floor division */
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (ttisinteger(rb) && ttisinteger(rc)) {
- lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
- setivalue(ra, luaV_div(L, ib, ic));
- }
- else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_numidiv(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_IDIV)); }
+ op_arith(L, luaV_mod, luaV_modf);
vmbreak;
}
vmcase(OP_POW) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- lua_Number nb; lua_Number nc;
- if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
- setfltvalue(ra, luai_numpow(L, nb, nc));
- }
- else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_POW)); }
+ op_arithf(L, luai_numpow);
+ vmbreak;
+ }
+ vmcase(OP_DIV) { /* float division (always with floats) */
+ op_arithf(L, luai_numdiv);
+ vmbreak;
+ }
+ vmcase(OP_IDIV) { /* floor division */
+ op_arith(L, luaV_idiv, luai_numidiv);
+ vmbreak;
+ }
+ vmcase(OP_BAND) {
+ op_bitwise(L, l_band);
+ vmbreak;
+ }
+ vmcase(OP_BOR) {
+ op_bitwise(L, l_bor);
+ vmbreak;
+ }
+ vmcase(OP_BXOR) {
+ op_bitwise(L, l_bxor);
+ vmbreak;
+ }
+ vmcase(OP_SHR) {
+ op_bitwise(L, luaV_shiftr);
+ vmbreak;
+ }
+ vmcase(OP_SHL) {
+ op_bitwise(L, luaV_shiftl);
+ vmbreak;
+ }
+ vmcase(OP_MMBIN) {
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ TValue *rb = vRB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ StkId result = RA(pi);
+ lua_assert(OP_ADD <= GET_OPCODE(pi) && GET_OPCODE(pi) <= OP_SHR);
+ Protect(luaT_trybinTM(L, s2v(ra), rb, result, tm));
+ vmbreak;
+ }
+ vmcase(OP_MMBINI) {
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ int imm = GETARG_sB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ int flip = GETARG_k(i);
+ StkId result = RA(pi);
+ Protect(luaT_trybiniTM(L, s2v(ra), imm, flip, result, tm));
+ vmbreak;
+ }
+ vmcase(OP_MMBINK) {
+ Instruction pi = *(pc - 2); /* original arith. expression */
+ TValue *imm = KB(i);
+ TMS tm = (TMS)GETARG_C(i);
+ int flip = GETARG_k(i);
+ StkId result = RA(pi);
+ Protect(luaT_trybinassocTM(L, s2v(ra), imm, flip, result, tm));
vmbreak;
}
vmcase(OP_UNM) {
- TValue *rb = RB(i);
+ TValue *rb = vRB(i);
lua_Number nb;
if (ttisinteger(rb)) {
lua_Integer ib = ivalue(rb);
- setivalue(ra, intop(-, 0, ib));
+ setivalue(s2v(ra), intop(-, 0, ib));
}
- else if (tonumber(rb, &nb)) {
- setfltvalue(ra, luai_numunm(L, nb));
+ else if (tonumberns(rb, nb)) {
+ setfltvalue(s2v(ra), luai_numunm(L, nb));
}
- else {
+ else
Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));
- }
vmbreak;
}
vmcase(OP_BNOT) {
- TValue *rb = RB(i);
+ TValue *rb = vRB(i);
lua_Integer ib;
- if (tointeger(rb, &ib)) {
- setivalue(ra, intop(^, ~l_castS2U(0), ib));
+ if (tointegerns(rb, &ib)) {
+ setivalue(s2v(ra), intop(^, ~l_castS2U(0), ib));
}
- else {
+ else
Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));
- }
vmbreak;
}
vmcase(OP_NOT) {
- TValue *rb = RB(i);
- int res = l_isfalse(rb); /* next assignment may change this value */
- setbvalue(ra, res);
+ TValue *rb = vRB(i);
+ if (l_isfalse(rb))
+ setbtvalue(s2v(ra));
+ else
+ setbfvalue(s2v(ra));
vmbreak;
}
vmcase(OP_LEN) {
- Protect(luaV_objlen(L, ra, RB(i)));
+ Protect(luaV_objlen(L, ra, vRB(i)));
vmbreak;
}
vmcase(OP_CONCAT) {
- int b = GETARG_B(i);
- int c = GETARG_C(i);
- StkId rb;
- L->top = base + c + 1; /* mark the end of concat operands */
- Protect(luaV_concat(L, c - b + 1));
- ra = RA(i); /* 'luaV_concat' may invoke TMs and move the stack */
- rb = base + b;
- setobjs2s(L, ra, rb);
- checkGC(L, (ra >= rb ? ra + 1 : rb));
- L->top = ci->top; /* restore top */
+ int n = GETARG_B(i); /* number of elements to concatenate */
+ L->top = ra + n; /* mark the end of concat operands */
+ ProtectNT(luaV_concat(L, n));
+ checkGC(L, L->top); /* 'luaV_concat' ensures correct top */
+ vmbreak;
+ }
+ vmcase(OP_CLOSE) {
+ Protect(luaF_close(L, ra, LUA_OK));
+ vmbreak;
+ }
+ vmcase(OP_TBC) {
+ /* create new to-be-closed upvalue */
+ halfProtect(luaF_newtbcupval(L, ra));
vmbreak;
}
vmcase(OP_JMP) {
@@ -1082,47 +1542,66 @@
vmbreak;
}
vmcase(OP_EQ) {
- TValue *rb = RKB(i);
- TValue *rc = RKC(i);
- Protect(
- if (luaV_equalobj(L, rb, rc) != GETARG_A(i))
- ci->u.l.savedpc++;
- else
- donextjump(ci);
- )
+ int cond;
+ TValue *rb = vRB(i);
+ Protect(cond = luaV_equalobj(L, s2v(ra), rb));
+ docondjump();
vmbreak;
}
vmcase(OP_LT) {
- Protect(
- if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i))
- ci->u.l.savedpc++;
- else
- donextjump(ci);
- )
+ op_order(L, l_lti, LTnum, lessthanothers);
vmbreak;
}
vmcase(OP_LE) {
- Protect(
- if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i))
- ci->u.l.savedpc++;
- else
- donextjump(ci);
- )
+ op_order(L, l_lei, LEnum, lessequalothers);
+ vmbreak;
+ }
+ vmcase(OP_EQK) {
+ TValue *rb = KB(i);
+ /* basic types do not use '__eq'; we can use raw equality */
+ int cond = luaV_rawequalobj(s2v(ra), rb);
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_EQI) {
+ int cond;
+ int im = GETARG_sB(i);
+ if (ttisinteger(s2v(ra)))
+ cond = (ivalue(s2v(ra)) == im);
+ else if (ttisfloat(s2v(ra)))
+ cond = luai_numeq(fltvalue(s2v(ra)), cast_num(im));
+ else
+ cond = 0; /* other types cannot be equal to a number */
+ docondjump();
+ vmbreak;
+ }
+ vmcase(OP_LTI) {
+ op_orderI(L, l_lti, luai_numlt, 0, TM_LT);
+ vmbreak;
+ }
+ vmcase(OP_LEI) {
+ op_orderI(L, l_lei, luai_numle, 0, TM_LE);
+ vmbreak;
+ }
+ vmcase(OP_GTI) {
+ op_orderI(L, l_gti, luai_numgt, 1, TM_LT);
+ vmbreak;
+ }
+ vmcase(OP_GEI) {
+ op_orderI(L, l_gei, luai_numge, 1, TM_LE);
vmbreak;
}
vmcase(OP_TEST) {
- if (GETARG_C(i) ? l_isfalse(ra) : !l_isfalse(ra))
- ci->u.l.savedpc++;
- else
- donextjump(ci);
+ int cond = !l_isfalse(s2v(ra));
+ docondjump();
vmbreak;
}
vmcase(OP_TESTSET) {
- TValue *rb = RB(i);
- if (GETARG_C(i) ? l_isfalse(rb) : !l_isfalse(rb))
- ci->u.l.savedpc++;
+ TValue *rb = vRB(i);
+ if (l_isfalse(rb) == GETARG_k(i))
+ pc++;
else {
- setobjs2s(L, ra, rb);
+ setobj2s(L, ra, rb);
donextjump(ci);
}
vmbreak;
@@ -1130,184 +1609,196 @@
vmcase(OP_CALL) {
int b = GETARG_B(i);
int nresults = GETARG_C(i) - 1;
- if (b != 0) L->top = ra+b; /* else previous instruction set top */
- if (luaD_precall(L, ra, nresults)) { /* C function? */
- if (nresults >= 0)
- L->top = ci->top; /* adjust results */
- Protect((void)0); /* update 'base' */
- }
- else { /* Lua function */
- ci = L->ci;
- goto newframe; /* restart luaV_execute over new Lua function */
- }
+ if (b != 0) /* fixed number of arguments? */
+ L->top = ra + b; /* top signals number of arguments */
+ /* else previous instruction set top */
+ ProtectNT(luaD_call(L, ra, nresults));
vmbreak;
}
vmcase(OP_TAILCALL) {
- int b = GETARG_B(i);
- if (b != 0) L->top = ra+b; /* else previous instruction set top */
- lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);
- if (luaD_precall(L, ra, LUA_MULTRET)) { /* C function? */
- Protect((void)0); /* update 'base' */
+ int b = GETARG_B(i); /* number of arguments + 1 (function) */
+ int nparams1 = GETARG_C(i);
+ /* delat is virtual 'func' - real 'func' (vararg functions) */
+ int delta = (nparams1) ? ci->u.l.nextraargs + nparams1 : 0;
+ if (b != 0)
+ L->top = ra + b;
+ else /* previous instruction set top */
+ b = cast_int(L->top - ra);
+ savepc(ci); /* some calls here can raise errors */
+ if (TESTARG_k(i)) {
+ /* close upvalues from current call; the compiler ensures
+ that there are no to-be-closed variables here, so this
+ call cannot change the stack */
+ luaF_close(L, base, NOCLOSINGMETH);
+ lua_assert(base == ci->func + 1);
}
- else {
- /* tail call: put called frame (n) in place of caller one (o) */
- CallInfo *nci = L->ci; /* called frame */
- CallInfo *oci = nci->previous; /* caller frame */
- StkId nfunc = nci->func; /* called function */
- StkId ofunc = oci->func; /* caller function */
- /* last stack slot filled by 'precall' */
- StkId lim = nci->u.l.base + getproto(nfunc)->numparams;
- int aux;
- /* close all upvalues from previous call */
- if (cl->p->sizep > 0) luaF_close(L, oci->u.l.base);
- /* move new frame into old one */
- for (aux = 0; nfunc + aux < lim; aux++)
- setobjs2s(L, ofunc + aux, nfunc + aux);
- oci->u.l.base = ofunc + (nci->u.l.base - nfunc); /* correct base */
- oci->top = L->top = ofunc + (L->top - nfunc); /* correct top */
- oci->u.l.savedpc = nci->u.l.savedpc;
- oci->callstatus |= CIST_TAIL; /* function was tail called */
- ci = L->ci = oci; /* remove new frame */
- lua_assert(L->top == oci->u.l.base + getproto(ofunc)->maxstacksize);
- goto newframe; /* restart luaV_execute over new Lua function */
+ while (!ttisfunction(s2v(ra))) { /* not a function? */
+ luaD_tryfuncTM(L, ra); /* try '__call' metamethod */
+ b++; /* there is now one extra argument */
+ checkstackp(L, 1, ra);
}
- vmbreak;
+ if (!ttisLclosure(s2v(ra))) { /* C function? */
+ luaD_call(L, ra, LUA_MULTRET); /* call it */
+ updatetrap(ci);
+ updatestack(ci); /* stack may have been relocated */
+ ci->func -= delta;
+ luaD_poscall(L, ci, cast_int(L->top - ra));
+ return;
+ }
+ ci->func -= delta;
+ luaD_pretailcall(L, ci, ra, b); /* prepare call frame */
+ goto tailcall;
}
vmcase(OP_RETURN) {
- int b = GETARG_B(i);
- if (cl->p->sizep > 0) luaF_close(L, base);
- b = luaD_poscall(L, ci, ra, (b != 0 ? b - 1 : cast_int(L->top - ra)));
- if (ci->callstatus & CIST_FRESH) /* local 'ci' still from callee */
- return; /* external invocation: return */
- else { /* invocation via reentry: continue execution */
- ci = L->ci;
- if (b) L->top = ci->top;
- lua_assert(isLua(ci));
- lua_assert(GET_OPCODE(*((ci)->u.l.savedpc - 1)) == OP_CALL);
- goto newframe; /* restart luaV_execute over new Lua function */
+ int n = GETARG_B(i) - 1; /* number of results */
+ int nparams1 = GETARG_C(i);
+ if (n < 0) /* not fixed? */
+ n = cast_int(L->top - ra); /* get what is available */
+ savepc(ci);
+ if (TESTARG_k(i)) { /* may there be open upvalues? */
+ if (L->top < ci->top)
+ L->top = ci->top;
+ luaF_close(L, base, LUA_OK);
+ updatetrap(ci);
+ updatestack(ci);
}
+ if (nparams1) /* vararg function? */
+ ci->func -= ci->u.l.nextraargs + nparams1;
+ L->top = ra + n; /* set call for 'luaD_poscall' */
+ luaD_poscall(L, ci, n);
+ return;
+ }
+ vmcase(OP_RETURN0) {
+ if (L->hookmask) {
+ L->top = ra;
+ halfProtectNT(luaD_poscall(L, ci, 0)); /* no hurry... */
+ }
+ else { /* do the 'poscall' here */
+ int nres = ci->nresults;
+ L->ci = ci->previous; /* back to caller */
+ L->top = base - 1;
+ while (nres-- > 0)
+ setnilvalue(s2v(L->top++)); /* all results are nil */
+ }
+ return;
+ }
+ vmcase(OP_RETURN1) {
+ if (L->hookmask) {
+ L->top = ra + 1;
+ halfProtectNT(luaD_poscall(L, ci, 1)); /* no hurry... */
+ }
+ else { /* do the 'poscall' here */
+ int nres = ci->nresults;
+ L->ci = ci->previous; /* back to caller */
+ if (nres == 0)
+ L->top = base - 1; /* asked for no results */
+ else {
+ setobjs2s(L, base - 1, ra); /* at least this result */
+ L->top = base;
+ while (--nres > 0) /* complete missing results */
+ setnilvalue(s2v(L->top++));
+ }
+ }
+ return;
}
vmcase(OP_FORLOOP) {
- if (ttisinteger(ra)) { /* integer loop? */
- lua_Integer step = ivalue(ra + 2);
- lua_Integer idx = intop(+, ivalue(ra), step); /* increment index */
- lua_Integer limit = ivalue(ra + 1);
- if ((0 < step) ? (idx <= limit) : (limit <= idx)) {
- ci->u.l.savedpc += GETARG_sBx(i); /* jump back */
- chgivalue(ra, idx); /* update internal index... */
- setivalue(ra + 3, idx); /* ...and external index */
+ if (ttisinteger(s2v(ra + 2))) { /* integer loop? */
+ lua_Unsigned count = l_castS2U(ivalue(s2v(ra + 1)));
+ if (count > 0) { /* still more iterations? */
+ lua_Integer step = ivalue(s2v(ra + 2));
+ lua_Integer idx = ivalue(s2v(ra)); /* internal index */
+ chgivalue(s2v(ra + 1), count - 1); /* update counter */
+ idx = intop(+, idx, step); /* add step to index */
+ chgivalue(s2v(ra), idx); /* update internal index */
+ setivalue(s2v(ra + 3), idx); /* and control variable */
+ pc -= GETARG_Bx(i); /* jump back */
}
}
- else { /* floating loop */
- lua_Number step = fltvalue(ra + 2);
- lua_Number idx = luai_numadd(L, fltvalue(ra), step); /* inc. index */
- lua_Number limit = fltvalue(ra + 1);
- if (luai_numlt(0, step) ? luai_numle(idx, limit)
- : luai_numle(limit, idx)) {
- ci->u.l.savedpc += GETARG_sBx(i); /* jump back */
- chgfltvalue(ra, idx); /* update internal index... */
- setfltvalue(ra + 3, idx); /* ...and external index */
- }
- }
+ else if (floatforloop(ra)) /* float loop */
+ pc -= GETARG_Bx(i); /* jump back */
+ updatetrap(ci); /* allows a signal to break the loop */
vmbreak;
}
vmcase(OP_FORPREP) {
- TValue *init = ra;
- TValue *plimit = ra + 1;
- TValue *pstep = ra + 2;
- lua_Integer ilimit;
- int stopnow;
- if (ttisinteger(init) && ttisinteger(pstep) &&
- forlimit(plimit, &ilimit, ivalue(pstep), &stopnow)) {
- /* all values are integer */
- lua_Integer initv = (stopnow ? 0 : ivalue(init));
- setivalue(plimit, ilimit);
- setivalue(init, intop(-, initv, ivalue(pstep)));
- }
- else { /* try making all values floats */
- lua_Number ninit; lua_Number nlimit; lua_Number nstep;
- if (!tonumber(plimit, &nlimit))
- luaG_runerror(L, "'for' limit must be a number");
- setfltvalue(plimit, nlimit);
- if (!tonumber(pstep, &nstep))
- luaG_runerror(L, "'for' step must be a number");
- setfltvalue(pstep, nstep);
- if (!tonumber(init, &ninit))
- luaG_runerror(L, "'for' initial value must be a number");
- setfltvalue(init, luai_numsub(L, ninit, nstep));
- }
- ci->u.l.savedpc += GETARG_sBx(i);
+ savestate(L, ci); /* in case of errors */
+ if (forprep(L, ra))
+ pc += GETARG_Bx(i) + 1; /* skip the loop */
vmbreak;
}
+ vmcase(OP_TFORPREP) {
+ /* create to-be-closed upvalue (if needed) */
+ halfProtect(luaF_newtbcupval(L, ra + 3));
+ pc += GETARG_Bx(i);
+ i = *(pc++); /* go to next instruction */
+ lua_assert(GET_OPCODE(i) == OP_TFORCALL && ra == RA(i));
+ goto l_tforcall;
+ }
vmcase(OP_TFORCALL) {
- StkId cb = ra + 3; /* call base */
- setobjs2s(L, cb+2, ra+2);
- setobjs2s(L, cb+1, ra+1);
- setobjs2s(L, cb, ra);
- L->top = cb + 3; /* func. + 2 args (state and index) */
- Protect(luaD_call(L, cb, GETARG_C(i)));
- L->top = ci->top;
- i = *(ci->u.l.savedpc++); /* go to next instruction */
- ra = RA(i);
- lua_assert(GET_OPCODE(i) == OP_TFORLOOP);
+ l_tforcall:
+ /* 'ra' has the iterator function, 'ra + 1' has the state,
+ 'ra + 2' has the control variable, and 'ra + 3' has the
+ to-be-closed variable. The call will use the stack after
+ these values (starting at 'ra + 4')
+ */
+ /* push function, state, and control variable */
+ memcpy(ra + 4, ra, 3 * sizeof(*ra));
+ L->top = ra + 4 + 3;
+ ProtectNT(luaD_call(L, ra + 4, GETARG_C(i))); /* do the call */
+ updatestack(ci); /* stack may have changed */
+ i = *(pc++); /* go to next instruction */
+ lua_assert(GET_OPCODE(i) == OP_TFORLOOP && ra == RA(i));
goto l_tforloop;
}
vmcase(OP_TFORLOOP) {
l_tforloop:
- if (!ttisnil(ra + 1)) { /* continue loop? */
- setobjs2s(L, ra, ra + 1); /* save control variable */
- ci->u.l.savedpc += GETARG_sBx(i); /* jump back */
+ if (!ttisnil(s2v(ra + 4))) { /* continue loop? */
+ setobjs2s(L, ra + 2, ra + 4); /* save control variable */
+ pc -= GETARG_Bx(i); /* jump back */
}
vmbreak;
}
vmcase(OP_SETLIST) {
int n = GETARG_B(i);
- int c = GETARG_C(i);
- unsigned int last;
- Table *h;
- if (n == 0) n = cast_int(L->top - ra) - 1;
- if (c == 0) {
- lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);
- c = GETARG_Ax(*ci->u.l.savedpc++);
+ unsigned int last = GETARG_C(i);
+ Table *h = hvalue(s2v(ra));
+ if (n == 0)
+ n = cast_int(L->top - ra) - 1; /* get up to the top */
+ else
+ L->top = ci->top; /* correct top in case of emergency GC */
+ last += n;
+ if (TESTARG_k(i)) {
+ last += GETARG_Ax(*pc) * (MAXARG_C + 1);
+ pc++;
}
- h = hvalue(ra);
- last = ((c-1)*LFIELDS_PER_FLUSH) + n;
- if (last > h->sizearray) /* needs more space? */
+ if (last > luaH_realasize(h)) /* needs more space? */
luaH_resizearray(L, h, last); /* preallocate it at once */
for (; n > 0; n--) {
- TValue *val = ra+n;
- luaH_setint(L, h, last--, val);
- luaC_barrierback(L, h, val);
+ TValue *val = s2v(ra + n);
+ setobj2t(L, &h->array[last - 1], val);
+ last--;
+ luaC_barrierback(L, obj2gco(h), val);
}
- L->top = ci->top; /* correct top (in case of previous open call) */
vmbreak;
}
vmcase(OP_CLOSURE) {
Proto *p = cl->p->p[GETARG_Bx(i)];
- LClosure *ncl = getcached(p, cl->upvals, base); /* cached closure */
- if (ncl == NULL) /* no match? */
- pushclosure(L, p, cl->upvals, base, ra); /* create a new one */
- else
- setclLvalue(L, ra, ncl); /* push cashed closure */
+ halfProtect(pushclosure(L, p, cl->upvals, base, ra));
checkGC(L, ra + 1);
vmbreak;
}
vmcase(OP_VARARG) {
- int b = GETARG_B(i) - 1; /* required results */
- int j;
- int n = cast_int(base - ci->func) - cl->p->numparams - 1;
- if (n < 0) /* less arguments than parameters? */
- n = 0; /* no vararg arguments */
- if (b < 0) { /* B == 0? */
- b = n; /* get all var. arguments */
- Protect(luaD_checkstack(L, n));
- ra = RA(i); /* previous call may change the stack */
- L->top = ra + n;
+ int n = GETARG_C(i) - 1; /* required results */
+ Protect(luaT_getvarargs(L, ci, ra, n));
+ vmbreak;
+ }
+ vmcase(OP_VARARGPREP) {
+ luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p);
+ updatetrap(ci);
+ if (trap) {
+ luaD_hookcall(L, ci);
+ L->oldpc = pc + 1; /* next opcode will be seen as a "new" line */
}
- for (j = 0; j < b && j < n; j++)
- setobjs2s(L, ra + j, base - n + j);
- for (; j < b; j++) /* complete required results with nil */
- setnilvalue(ra + j);
+ updatebase(ci); /* function has new base after adjustment */
vmbreak;
}
vmcase(OP_EXTRAARG) {
@@ -1319,4 +1810,3 @@
}
/* }================================================================== */
-
diff --git a/src/lvm.h b/src/lvm.h
index a8f954f..2d4ac16 100644
--- a/src/lvm.h
+++ b/src/lvm.h
@@ -1,5 +1,5 @@
/*
-** $Id: lvm.h,v 2.41.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lvm.h $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@@ -33,15 +33,40 @@
** integral values)
*/
#if !defined(LUA_FLOORN2I)
-#define LUA_FLOORN2I 0
+#define LUA_FLOORN2I F2Ieq
#endif
+/*
+** Rounding modes for float->integer coercion
+ */
+typedef enum {
+ F2Ieq, /* no rounding; accepts only integral values */
+ F2Ifloor, /* takes the floor of the number */
+ F2Iceil /* takes the ceil of the number */
+} F2Imod;
+
+
+/* convert an object to a float (including string coercion) */
#define tonumber(o,n) \
(ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n))
+
+/* convert an object to a float (without string coercion) */
+#define tonumberns(o,n) \
+ (ttisfloat(o) ? ((n) = fltvalue(o), 1) : \
+ (ttisinteger(o) ? ((n) = cast_num(ivalue(o)), 1) : 0))
+
+
+/* convert an object to an integer (including string coercion) */
#define tointeger(o,i) \
- (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointeger(o,i,LUA_FLOORN2I))
+ (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointeger(o,i,LUA_FLOORN2I))
+
+
+/* convert an object to an integer (without string coercion) */
+#define tointegerns(o,i) \
+ (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointegerns(o,i,LUA_FLOORN2I))
+
#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))
@@ -49,47 +74,39 @@
/*
-** fast track for 'gettable': if 't' is a table and 't[k]' is not nil,
-** return 1 with 'slot' pointing to 't[k]' (final result). Otherwise,
-** return 0 (meaning it will have to check metamethod) with 'slot'
-** pointing to a nil 't[k]' (if 't' is a table) or NULL (otherwise).
-** 'f' is the raw get function to use.
+** fast track for 'gettable': if 't' is a table and 't[k]' is present,
+** return 1 with 'slot' pointing to 't[k]' (position of final result).
+** Otherwise, return 0 (meaning it will have to check metamethod)
+** with 'slot' pointing to an empty 't[k]' (if 't' is a table) or NULL
+** (otherwise). 'f' is the raw get function to use.
*/
#define luaV_fastget(L,t,k,slot,f) \
(!ttistable(t) \
? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
: (slot = f(hvalue(t), k), /* else, do raw access */ \
- !ttisnil(slot))) /* result not nil? */
-
-/*
-** standard implementation for 'gettable'
-*/
-#define luaV_gettable(L,t,k,v) { const TValue *slot; \
- if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \
- else luaV_finishget(L,t,k,v,slot); }
+ !isempty(slot))) /* result not empty? */
/*
-** Fast track for set table. If 't' is a table and 't[k]' is not nil,
-** call GC barrier, do a raw 't[k]=v', and return true; otherwise,
-** return false with 'slot' equal to NULL (if 't' is not a table) or
-** 'nil'. (This is needed by 'luaV_finishget'.) Note that, if the macro
-** returns true, there is no need to 'invalidateTMcache', because the
-** call is not creating a new entry.
+** Special case of 'luaV_fastget' for integers, inlining the fast case
+** of 'luaH_getint'.
*/
-#define luaV_fastset(L,t,k,slot,f,v) \
- (!ttistable(t) \
- ? (slot = NULL, 0) \
- : (slot = f(hvalue(t), k), \
- ttisnil(slot) ? 0 \
- : (luaC_barrierback(L, hvalue(t), v), \
- setobj2t(L, cast(TValue *,slot), v), \
- 1)))
+#define luaV_fastgeti(L,t,k,slot) \
+ (!ttistable(t) \
+ ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
+ : (slot = (l_castS2U(k) - 1u < hvalue(t)->alimit) \
+ ? &hvalue(t)->array[k - 1] : luaH_getint(hvalue(t), k), \
+ !isempty(slot))) /* result not empty? */
-#define luaV_settable(L,t,k,v) { const TValue *slot; \
- if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \
- luaV_finishset(L,t,k,v,slot); }
+/*
+** Finish a fast set operation (when fast get succeeds). In that case,
+** 'slot' points to the place to put the value.
+*/
+#define luaV_finishfastset(L,t,slot,v) \
+ { setobj2t(L, cast(TValue *,slot), v); \
+ luaC_barrierback(L, gcvalue(t), v); }
+
@@ -97,16 +114,20 @@
LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);
LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);
-LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode);
+LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode);
+LUAI_FUNC int luaV_tointegerns (const TValue *obj, lua_Integer *p,
+ F2Imod mode);
+LUAI_FUNC int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode);
LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key,
StkId val, const TValue *slot);
LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
- StkId val, const TValue *slot);
+ TValue *val, const TValue *slot);
LUAI_FUNC void luaV_finishOp (lua_State *L);
-LUAI_FUNC void luaV_execute (lua_State *L);
+LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci);
LUAI_FUNC void luaV_concat (lua_State *L, int total);
-LUAI_FUNC lua_Integer luaV_div (lua_State *L, lua_Integer x, lua_Integer y);
+LUAI_FUNC lua_Integer luaV_idiv (lua_State *L, lua_Integer x, lua_Integer y);
LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);
+LUAI_FUNC lua_Number luaV_modf (lua_State *L, lua_Number x, lua_Number y);
LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);
LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);
diff --git a/src/lzio.c b/src/lzio.c
index 6f79094..cd0a02d 100644
--- a/src/lzio.c
+++ b/src/lzio.c
@@ -1,5 +1,5 @@
/*
-** $Id: lzio.c,v 1.37.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lzio.c $
** Buffered streams
** See Copyright Notice in lua.h
*/
diff --git a/src/lzio.h b/src/lzio.h
index d897870..38f397f 100644
--- a/src/lzio.h
+++ b/src/lzio.h
@@ -1,5 +1,5 @@
/*
-** $Id: lzio.h,v 1.31.1.1 2017/04/19 17:20:42 roberto Exp $
+** $Id: lzio.h $
** Buffered streams
** See Copyright Notice in lua.h
*/
