diff --git a/lapi.c b/lapi.c index 34e64af142..27fa524797 100644 --- a/lapi.c +++ b/lapi.c @@ -40,10 +40,8 @@ const char lua_ident[] = /* ** Test for a valid index (one that is not the 'nilvalue'). -** '!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) +#define isvalid(L, o) ((o) != &G(L)->nilvalue) /* test for pseudo index */ @@ -92,7 +90,7 @@ static TValue *index2value (lua_State *L, int idx) { /* ** Convert a valid actual index (not a pseudo-index) to its address. */ -l_sinline StkId index2stack (lua_State *L, int idx) { +static StkId index2stack (lua_State *L, int idx) { CallInfo *ci = L->ci; if (idx > 0) { StkId o = ci->func.p + idx; @@ -129,7 +127,7 @@ LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) { int i; if (from == to) return; lua_lock(to); - api_checknelems(from, n); + api_checkpop(from, n); api_check(from, G(from) == G(to), "moving among independent states"); api_check(from, to->ci->top.p - to->top.p >= n, "stack overflow"); from->top.p -= n; @@ -195,10 +193,9 @@ LUA_API void lua_settop (lua_State *L, int idx) { api_check(L, -(idx+1) <= (L->top.p - (func + 1)), "invalid new top"); diff = idx + 1; /* will "subtract" index (as it is negative) */ } - api_check(L, L->tbclist.p < L->top.p, "previous pop of an unclosed slot"); newtop = L->top.p + diff; if (diff < 0 && L->tbclist.p >= newtop) { - lua_assert(hastocloseCfunc(ci->nresults)); + lua_assert(ci->callstatus & CIST_TBC); newtop = luaF_close(L, newtop, CLOSEKTOP, 0); } L->top.p = newtop; /* correct top only after closing any upvalue */ @@ -210,7 +207,7 @@ LUA_API void lua_closeslot (lua_State *L, int idx) { StkId level; lua_lock(L); level = index2stack(L, idx); - api_check(L, hastocloseCfunc(L->ci->nresults) && L->tbclist.p == level, + api_check(L, (L->ci->callstatus & CIST_TBC) && (L->tbclist.p == level), "no variable to close at given level"); level = luaF_close(L, level, CLOSEKTOP, 0); setnilvalue(s2v(level)); @@ -224,7 +221,7 @@ LUA_API void lua_closeslot (lua_State *L, int idx) { ** Note that we move(copy) only the value inside the stack. ** (We do not move additional fields that may exist.) */ -l_sinline void reverse (lua_State *L, StkId from, StkId to) { +static void reverse (lua_State *L, StkId from, StkId to) { for (; from < to; from++, to--) { TValue temp; setobj(L, &temp, s2v(from)); @@ -243,6 +240,7 @@ LUA_API void lua_rotate (lua_State *L, int idx, int n) { lua_lock(L); t = L->top.p - 1; /* end of stack segment being rotated */ p = index2stack(L, idx); /* start of segment */ + api_check(L, L->tbclist.p < p, "moving a to-be-closed slot"); 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' */ @@ -335,15 +333,15 @@ LUA_API int lua_rawequal (lua_State *L, int index1, int index2) { LUA_API void lua_arith (lua_State *L, int op) { lua_lock(L); if (op != LUA_OPUNM && op != LUA_OPBNOT) - api_checknelems(L, 2); /* all other operations expect two operands */ + api_checkpop(L, 2); /* all other operations expect two operands */ else { /* for unary operations, add fake 2nd operand */ - api_checknelems(L, 1); + api_checkpop(L, 1); setobjs2s(L, L->top.p, L->top.p - 1); api_incr_top(L); } /* first operand at top - 2, second at top - 1; result go to top - 2 */ luaO_arith(L, op, s2v(L->top.p - 2), s2v(L->top.p - 1), L->top.p - 2); - L->top.p--; /* remove second operand */ + L->top.p--; /* pop second operand */ lua_unlock(L); } @@ -368,6 +366,18 @@ LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) { } +LUA_API unsigned (lua_numbertocstring) (lua_State *L, int idx, char *buff) { + const TValue *o = index2value(L, idx); + if (ttisnumber(o)) { + unsigned len = luaO_tostringbuff(o, buff); + buff[len++] = '\0'; /* add final zero */ + return len; + } + else + return 0; +} + + LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) { size_t sz = luaO_str2num(s, s2v(L->top.p)); if (sz != 0) @@ -416,20 +426,27 @@ LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) { luaC_checkGC(L); o = index2value(L, idx); /* previous call may reallocate the stack */ } - if (len != NULL) - *len = vslen(o); lua_unlock(L); - return svalue(o); + if (len != NULL) + return getlstr(tsvalue(o), *len); + else + return getstr(tsvalue(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)); + case LUA_VSHRSTR: return cast(lua_Unsigned, tsvalue(o)->shrlen); + case LUA_VLNGSTR: return cast(lua_Unsigned, tsvalue(o)->u.lnglen); + case LUA_VUSERDATA: return cast(lua_Unsigned, uvalue(o)->len); + case LUA_VTABLE: { + lua_Unsigned res; + lua_lock(L); + res = luaH_getn(L, hvalue(o)); + lua_unlock(L); + return res; + } default: return 0; } } @@ -467,7 +484,7 @@ LUA_API lua_State *lua_tothread (lua_State *L, int idx) { /* ** Returns a pointer to the internal representation of an object. -** Note that ANSI C does not allow the conversion of a pointer to +** Note that ISO 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.) @@ -535,6 +552,21 @@ LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) { } +LUA_API const char *lua_pushexternalstring (lua_State *L, + const char *s, size_t len, lua_Alloc falloc, void *ud) { + TString *ts; + lua_lock(L); + api_check(L, len <= MAX_SIZE, "string too large"); + api_check(L, s[len] == '\0', "string not ending with zero"); + ts = luaS_newextlstr (L, s, len, falloc, ud); + setsvalue2s(L, L->top.p, ts); + api_incr_top(L); + luaC_checkGC(L); + lua_unlock(L); + return getstr(ts); +} + + LUA_API const char *lua_pushstring (lua_State *L, const char *s) { lua_lock(L); if (s == NULL) @@ -567,9 +599,7 @@ LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) { const char *ret; va_list argp; lua_lock(L); - va_start(argp, fmt); - ret = luaO_pushvfstring(L, fmt, argp); - va_end(argp); + pushvfstring(L, argp, fmt, ret); luaC_checkGC(L); lua_unlock(L); return ret; @@ -583,17 +613,18 @@ LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { api_incr_top(L); } else { + int i; CClosure *cl; - api_checknelems(L, n); + api_checkpop(L, n); api_check(L, n <= MAXUPVAL, "upvalue index too large"); cl = luaF_newCclosure(L, n); cl->f = fn; - L->top.p -= n; - while (n--) { - setobj2n(L, &cl->upvalue[n], s2v(L->top.p + n)); + for (i = 0; i < n; i++) { + setobj2n(L, &cl->upvalue[i], s2v(L->top.p - n + i)); /* does not need barrier because closure is white */ lua_assert(iswhite(cl)); } + L->top.p -= n; setclCvalue(L, s2v(L->top.p), cl); api_incr_top(L); luaC_checkGC(L); @@ -626,7 +657,7 @@ LUA_API int lua_pushthread (lua_State *L) { setthvalue(L, s2v(L->top.p), L); api_incr_top(L); lua_unlock(L); - return (G(L)->mainthread == L); + return (mainthread(G(L)) == L); } @@ -636,53 +667,54 @@ LUA_API int lua_pushthread (lua_State *L) { */ -l_sinline int auxgetstr (lua_State *L, const TValue *t, const char *k) { - const TValue *slot; +static int auxgetstr (lua_State *L, const TValue *t, const char *k) { + lu_byte tag; TString *str = luaS_new(L, k); - if (luaV_fastget(L, t, str, slot, luaH_getstr)) { - setobj2s(L, L->top.p, slot); + luaV_fastget(t, str, s2v(L->top.p), luaH_getstr, tag); + if (!tagisempty(tag)) api_incr_top(L); - } else { setsvalue2s(L, L->top.p, str); api_incr_top(L); - luaV_finishget(L, t, s2v(L->top.p - 1), L->top.p - 1, slot); + tag = luaV_finishget(L, t, s2v(L->top.p - 1), L->top.p - 1, tag); } lua_unlock(L); - return ttype(s2v(L->top.p - 1)); + return novariant(tag); } /* -** Get the global table in the registry. Since all predefined -** indices in the registry were inserted right when the registry -** was created and never removed, they must always be in the array -** part of the registry. +** The following function assumes that the registry cannot be a weak +** table; so, an emergency collection while using the global table +** cannot collect it. */ -#define getGtable(L) \ - (&hvalue(&G(L)->l_registry)->array[LUA_RIDX_GLOBALS - 1]) +static void getGlobalTable (lua_State *L, TValue *gt) { + Table *registry = hvalue(&G(L)->l_registry); + lu_byte tag = luaH_getint(registry, LUA_RIDX_GLOBALS, gt); + (void)tag; /* avoid not-used warnings when checks are off */ + api_check(L, novariant(tag) == LUA_TTABLE, "global table must exist"); +} LUA_API int lua_getglobal (lua_State *L, const char *name) { - const TValue *G; + TValue gt; lua_lock(L); - G = getGtable(L); - return auxgetstr(L, G, name); + getGlobalTable(L, >); + return auxgetstr(L, >, name); } LUA_API int lua_gettable (lua_State *L, int idx) { - const TValue *slot; + lu_byte tag; TValue *t; lua_lock(L); + api_checkpop(L, 1); t = index2value(L, idx); - if (luaV_fastget(L, t, s2v(L->top.p - 1), slot, luaH_get)) { - setobj2s(L, L->top.p - 1, slot); - } - else - luaV_finishget(L, t, s2v(L->top.p - 1), L->top.p - 1, slot); + luaV_fastget(t, s2v(L->top.p - 1), s2v(L->top.p - 1), luaH_get, tag); + if (tagisempty(tag)) + tag = luaV_finishget(L, t, s2v(L->top.p - 1), L->top.p - 1, tag); lua_unlock(L); - return ttype(s2v(L->top.p - 1)); + return novariant(tag); } @@ -694,35 +726,31 @@ LUA_API int lua_getfield (lua_State *L, int idx, const char *k) { LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) { TValue *t; - const TValue *slot; + lu_byte tag; lua_lock(L); t = index2value(L, idx); - if (luaV_fastgeti(L, t, n, slot)) { - setobj2s(L, L->top.p, slot); - } - else { - TValue aux; - setivalue(&aux, n); - luaV_finishget(L, t, &aux, L->top.p, slot); + luaV_fastgeti(t, n, s2v(L->top.p), tag); + if (tagisempty(tag)) { + TValue key; + setivalue(&key, n); + tag = luaV_finishget(L, t, &key, L->top.p, tag); } api_incr_top(L); lua_unlock(L); - return ttype(s2v(L->top.p - 1)); + return novariant(tag); } -l_sinline int finishrawget (lua_State *L, const TValue *val) { - if (isempty(val)) /* avoid copying empty items to the stack */ +static int finishrawget (lua_State *L, lu_byte tag) { + if (tagisempty(tag)) /* avoid copying empty items to the stack */ setnilvalue(s2v(L->top.p)); - else - setobj2s(L, L->top.p, val); api_incr_top(L); lua_unlock(L); - return ttype(s2v(L->top.p - 1)); + return novariant(tag); } -static Table *gettable (lua_State *L, int idx) { +l_sinline Table *gettable (lua_State *L, int idx) { TValue *t = index2value(L, idx); api_check(L, ttistable(t), "table expected"); return hvalue(t); @@ -731,21 +759,23 @@ static Table *gettable (lua_State *L, int idx) { LUA_API int lua_rawget (lua_State *L, int idx) { Table *t; - const TValue *val; + lu_byte tag; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); t = gettable(L, idx); - val = luaH_get(t, s2v(L->top.p - 1)); - L->top.p--; /* remove key */ - return finishrawget(L, val); + tag = luaH_get(t, s2v(L->top.p - 1), s2v(L->top.p - 1)); + L->top.p--; /* pop key */ + return finishrawget(L, tag); } LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) { Table *t; + lu_byte tag; lua_lock(L); t = gettable(L, idx); - return finishrawget(L, luaH_getint(t, n)); + luaH_fastgeti(t, n, s2v(L->top.p), tag); + return finishrawget(L, tag); } @@ -755,7 +785,7 @@ LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) { lua_lock(L); t = gettable(L, idx); setpvalue(&k, cast_voidp(p)); - return finishrawget(L, luaH_get(t, &k)); + return finishrawget(L, luaH_get(t, &k, s2v(L->top.p))); } @@ -766,7 +796,7 @@ LUA_API void lua_createtable (lua_State *L, int narray, int nrec) { sethvalue2s(L, L->top.p, t); api_incr_top(L); if (narray > 0 || nrec > 0) - luaH_resize(L, t, narray, nrec); + luaH_resize(L, t, cast_uint(narray), cast_uint(nrec)); luaC_checkGC(L); lua_unlock(L); } @@ -827,17 +857,18 @@ LUA_API int lua_getiuservalue (lua_State *L, int idx, int n) { ** t[k] = value at the top of the stack (where 'k' is a string) */ static void auxsetstr (lua_State *L, const TValue *t, const char *k) { - const TValue *slot; + int hres; TString *str = luaS_new(L, k); - api_checknelems(L, 1); - if (luaV_fastget(L, t, str, slot, luaH_getstr)) { - luaV_finishfastset(L, t, slot, s2v(L->top.p - 1)); + api_checkpop(L, 1); + luaV_fastset(t, str, s2v(L->top.p - 1), hres, luaH_psetstr); + if (hres == HOK) { + luaV_finishfastset(L, t, s2v(L->top.p - 1)); L->top.p--; /* pop value */ } else { setsvalue2s(L, L->top.p, str); /* push 'str' (to make it a TValue) */ api_incr_top(L); - luaV_finishset(L, t, s2v(L->top.p - 1), s2v(L->top.p - 2), slot); + luaV_finishset(L, t, s2v(L->top.p - 1), s2v(L->top.p - 2), hres); L->top.p -= 2; /* pop value and key */ } lua_unlock(L); /* lock done by caller */ @@ -845,24 +876,24 @@ static void auxsetstr (lua_State *L, const TValue *t, const char *k) { LUA_API void lua_setglobal (lua_State *L, const char *name) { - const TValue *G; + TValue gt; lua_lock(L); /* unlock done in 'auxsetstr' */ - G = getGtable(L); - auxsetstr(L, G, name); + getGlobalTable(L, >); + auxsetstr(L, >, name); } LUA_API void lua_settable (lua_State *L, int idx) { TValue *t; - const TValue *slot; + int hres; lua_lock(L); - api_checknelems(L, 2); + api_checkpop(L, 2); t = index2value(L, idx); - if (luaV_fastget(L, t, s2v(L->top.p - 2), slot, luaH_get)) { - luaV_finishfastset(L, t, slot, s2v(L->top.p - 1)); - } + luaV_fastset(t, s2v(L->top.p - 2), s2v(L->top.p - 1), hres, luaH_pset); + if (hres == HOK) + luaV_finishfastset(L, t, s2v(L->top.p - 1)); else - luaV_finishset(L, t, s2v(L->top.p - 2), s2v(L->top.p - 1), slot); + luaV_finishset(L, t, s2v(L->top.p - 2), s2v(L->top.p - 1), hres); L->top.p -= 2; /* pop index and value */ lua_unlock(L); } @@ -876,17 +907,17 @@ LUA_API void lua_setfield (lua_State *L, int idx, const char *k) { LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) { TValue *t; - const TValue *slot; + int hres; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); t = index2value(L, idx); - if (luaV_fastgeti(L, t, n, slot)) { - luaV_finishfastset(L, t, slot, s2v(L->top.p - 1)); - } + luaV_fastseti(t, n, s2v(L->top.p - 1), hres); + if (hres == HOK) + luaV_finishfastset(L, t, s2v(L->top.p - 1)); else { - TValue aux; - setivalue(&aux, n); - luaV_finishset(L, t, &aux, s2v(L->top.p - 1), slot); + TValue temp; + setivalue(&temp, n); + luaV_finishset(L, t, &temp, s2v(L->top.p - 1), hres); } L->top.p--; /* pop value */ lua_unlock(L); @@ -896,7 +927,7 @@ LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) { static void aux_rawset (lua_State *L, int idx, TValue *key, int n) { Table *t; lua_lock(L); - api_checknelems(L, n); + api_checkpop(L, n); t = gettable(L, idx); luaH_set(L, t, key, s2v(L->top.p - 1)); invalidateTMcache(t); @@ -921,7 +952,7 @@ LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) { LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) { Table *t; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); t = gettable(L, idx); luaH_setint(L, t, n, s2v(L->top.p - 1)); luaC_barrierback(L, obj2gco(t), s2v(L->top.p - 1)); @@ -934,7 +965,7 @@ LUA_API int lua_setmetatable (lua_State *L, int objindex) { TValue *obj; Table *mt; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); obj = index2value(L, objindex); if (ttisnil(s2v(L->top.p - 1))) mt = NULL; @@ -974,7 +1005,7 @@ LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) { TValue *o; int res; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); o = index2value(L, idx); api_check(L, ttisfulluserdata(o), "full userdata expected"); if (!(cast_uint(n) - 1u < cast_uint(uvalue(o)->nuvalue))) @@ -996,9 +1027,11 @@ LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) { #define checkresults(L,na,nr) \ - api_check(L, (nr) == LUA_MULTRET \ + (api_check(L, (nr) == LUA_MULTRET \ || (L->ci->top.p - L->top.p >= (nr) - (na)), \ - "results from function overflow current stack size") + "results from function overflow current stack size"), \ + api_check(L, LUA_MULTRET <= (nr) && (nr) <= MAXRESULTS, \ + "invalid number of results")) LUA_API void lua_callk (lua_State *L, int nargs, int nresults, @@ -1007,7 +1040,7 @@ LUA_API void lua_callk (lua_State *L, int nargs, int nresults, lua_lock(L); api_check(L, k == NULL || !isLua(L->ci), "cannot use continuations inside hooks"); - api_checknelems(L, nargs+1); + api_checkpop(L, nargs + 1); api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); checkresults(L, nargs, nresults); func = L->top.p - (nargs+1); @@ -1043,12 +1076,12 @@ static void f_call (lua_State *L, void *ud) { LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc, lua_KContext ctx, lua_KFunction k) { struct CallS c; - int status; + TStatus status; ptrdiff_t func; lua_lock(L); api_check(L, k == NULL || !isLua(L->ci), "cannot use continuations inside hooks"); - api_checknelems(L, nargs+1); + api_checkpop(L, nargs + 1); api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); checkresults(L, nargs, nresults); if (errfunc == 0) @@ -1071,7 +1104,7 @@ LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc, 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' */ + setoah(ci, L->allowhook); /* save value of 'allowhook' */ ci->callstatus |= CIST_YPCALL; /* function can do error recovery */ luaD_call(L, c.func, nresults); /* do the call */ ci->callstatus &= ~CIST_YPCALL; @@ -1080,14 +1113,14 @@ LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc, } adjustresults(L, nresults); lua_unlock(L); - return status; + return APIstatus(status); } LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data, const char *chunkname, const char *mode) { ZIO z; - int status; + TStatus status; lua_lock(L); if (!chunkname) chunkname = "?"; luaZ_init(L, &z, reader, data); @@ -1096,34 +1129,38 @@ LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data, LClosure *f = clLvalue(s2v(L->top.p - 1)); /* get new function */ if (f->nupvalues >= 1) { /* does it have an upvalue? */ /* get global table from registry */ - const TValue *gt = getGtable(L); + TValue gt; + getGlobalTable(L, >); /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */ - setobj(L, f->upvals[0]->v.p, gt); - luaC_barrier(L, f->upvals[0], gt); + setobj(L, f->upvals[0]->v.p, >); + luaC_barrier(L, f->upvals[0], >); } } lua_unlock(L); - return status; + return APIstatus(status); } +/* +** Dump a Lua function, calling 'writer' to write its parts. Ensure +** the stack returns with its original size. +*/ LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) { int status; - TValue *o; + ptrdiff_t otop = savestack(L, L->top.p); /* original top */ + TValue *f = s2v(L->top.p - 1); /* function to be dumped */ lua_lock(L); - api_checknelems(L, 1); - o = s2v(L->top.p - 1); - if (isLfunction(o)) - status = luaU_dump(L, getproto(o), writer, data, strip); - else - status = 1; + api_checkpop(L, 1); + api_check(L, isLfunction(f), "Lua function expected"); + status = luaU_dump(L, clLvalue(f)->p, writer, data, strip); + L->top.p = restorestack(L, otop); /* restore top */ lua_unlock(L); return status; } LUA_API int lua_status (lua_State *L) { - return L->status; + return APIstatus(L->status); } @@ -1134,7 +1171,7 @@ LUA_API int lua_gc (lua_State *L, int what, ...) { va_list argp; int res = 0; global_State *g = G(L); - if (g->gcstp & GCSTPGC) /* internal stop? */ + if (g->gcstp & (GCSTPGC | GCSTPCLS)) /* internal stop? */ return -1; /* all options are invalid when stopped */ lua_lock(L); va_start(argp, what); @@ -1145,7 +1182,7 @@ LUA_API int lua_gc (lua_State *L, int what, ...) { } case LUA_GCRESTART: { luaE_setdebt(g, 0); - g->gcstp = 0; /* (GCSTPGC must be already zero here) */ + g->gcstp = 0; /* (other bits must be zero here) */ break; } case LUA_GCCOLLECT: { @@ -1162,34 +1199,17 @@ LUA_API int lua_gc (lua_State *L, int what, ...) { 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 oldstp = g->gcstp; - g->gcstp = 0; /* allow GC to run (GCSTPGC must be zero here) */ - if (data == 0) { - luaE_setdebt(g, 0); /* do a basic step */ - luaC_step(L); - } - else { /* add 'data' to total debt */ - debt = cast(l_mem, data) * 1024 + g->GCdebt; - luaE_setdebt(g, debt); - luaC_checkGC(L); - } - g->gcstp = oldstp; /* restore previous state */ - if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */ + l_mem n = cast(l_mem, va_arg(argp, size_t)); + int work = 0; /* true if GC did some work */ + g->gcstp = 0; /* allow GC to run (other bits must be zero here) */ + if (n <= 0) + n = g->GCdebt; /* force to run one basic step */ + luaE_setdebt(g, g->GCdebt - n); + luaC_condGC(L, (void)0, work = 1); + if (work && g->gcstate == GCSpause) /* end of cycle? */ res = 1; /* signal it */ - break; - } - case LUA_GCSETPAUSE: { - int data = va_arg(argp, int); - res = getgcparam(g->gcpause); - setgcparam(g->gcpause, data); - break; - } - case LUA_GCSETSTEPMUL: { - int data = va_arg(argp, int); - res = getgcparam(g->gcstepmul); - setgcparam(g->gcstepmul, data); + g->gcstp = oldstp; /* restore previous state */ break; } case LUA_GCISRUNNING: { @@ -1197,30 +1217,24 @@ LUA_API int lua_gc (lua_State *L, int what, ...) { 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); + res = (g->gckind == KGC_INC) ? LUA_GCINC : LUA_GCGEN; + luaC_changemode(L, KGC_GENMINOR); 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; + res = (g->gckind == KGC_INC) ? LUA_GCINC : LUA_GCGEN; luaC_changemode(L, KGC_INC); break; } + case LUA_GCPARAM: { + int param = va_arg(argp, int); + int value = va_arg(argp, int); + api_check(L, 0 <= param && param < LUA_GCPN, "invalid parameter"); + res = cast_int(luaO_applyparam(g->gcparams[param], 100)); + if (value >= 0) + g->gcparams[param] = luaO_codeparam(cast_uint(value)); + break; + } default: res = -1; /* invalid option */ } va_end(argp); @@ -1239,7 +1253,7 @@ LUA_API int lua_error (lua_State *L) { TValue *errobj; lua_lock(L); errobj = s2v(L->top.p - 1); - api_checknelems(L, 1); + api_checkpop(L, 1); /* error object is the memory error message? */ if (ttisshrstring(errobj) && eqshrstr(tsvalue(errobj), G(L)->memerrmsg)) luaM_error(L); /* raise a memory error */ @@ -1254,30 +1268,25 @@ LUA_API int lua_next (lua_State *L, int idx) { Table *t; int more; lua_lock(L); - api_checknelems(L, 1); + api_checkpop(L, 1); t = gettable(L, idx); more = luaH_next(L, t, L->top.p - 1); - if (more) { + if (more) api_incr_top(L); - } else /* no more elements */ - L->top.p -= 1; /* remove key */ + L->top.p--; /* pop key */ lua_unlock(L); return more; } 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->tbclist.p < o, "given index below or equal a marked 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)); + L->ci->callstatus |= CIST_TBC; /* mark that function has TBC slots */ lua_unlock(L); } @@ -1285,13 +1294,14 @@ LUA_API void lua_toclose (lua_State *L, int idx) { LUA_API void lua_concat (lua_State *L, int n) { lua_lock(L); api_checknelems(L, n); - if (n > 0) + if (n > 0) { luaV_concat(L, n); + luaC_checkGC(L); + } else { /* nothing to concatenate */ setsvalue2s(L, L->top.p, luaS_newlstr(L, "", 0)); /* push empty string */ api_incr_top(L); } - luaC_checkGC(L); lua_unlock(L); } @@ -1343,8 +1353,8 @@ void lua_warning (lua_State *L, const char *msg, int tocont) { LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) { Udata *u; lua_lock(L); - api_check(L, 0 <= nuvalue && nuvalue < USHRT_MAX, "invalid value"); - u = luaS_newudata(L, size, nuvalue); + api_check(L, 0 <= nuvalue && nuvalue < SHRT_MAX, "invalid value"); + u = luaS_newudata(L, size, cast(unsigned short, nuvalue)); setuvalue(L, s2v(L->top.p), u); api_incr_top(L); luaC_checkGC(L); diff --git a/lapi.h b/lapi.h index a742427cdc..9b54534428 100644 --- a/lapi.h +++ b/lapi.h @@ -12,10 +12,29 @@ #include "lstate.h" +#if defined(LUA_USE_APICHECK) +#include +#define api_check(l,e,msg) assert(e) +#else /* for testing */ +#define api_check(l,e,msg) ((void)(l), lua_assert((e) && msg)) +#endif + + + /* Increments 'L->top.p', checking for stack overflows */ -#define api_incr_top(L) {L->top.p++; \ - api_check(L, L->top.p <= L->ci->top.p, \ - "stack overflow");} +#define api_incr_top(L) \ + (L->top.p++, api_check(L, L->top.p <= L->ci->top.p, "stack overflow")) + + +/* +** macros that are executed whenever program enters the Lua core +** ('lua_lock') and leaves the core ('lua_unlock') +*/ +#if !defined(lua_lock) +#define lua_lock(L) ((void) 0) +#define lua_unlock(L) ((void) 0) +#endif + /* @@ -30,23 +49,17 @@ /* Ensure the stack has at least 'n' elements */ #define api_checknelems(L,n) \ - api_check(L, (n) < (L->top.p - L->ci->func.p), \ - "not enough elements in the stack") + api_check(L, (n) < (L->top.p - L->ci->func.p), \ + "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. +/* Ensure the stack has at least 'n' elements to be popped. (Some +** functions only update a slot after checking it for popping, but that +** is only an optimization for a pop followed by a push.) */ - -#define hastocloseCfunc(n) ((n) < LUA_MULTRET) - -/* Map [-1, inf) (range of 'nresults') into (-inf, -2] */ -#define codeNresults(n) (-(n) - 3) -#define decodeNresults(n) (-(n) - 3) +#define api_checkpop(L,n) \ + api_check(L, (n) < L->top.p - L->ci->func.p && \ + L->tbclist.p < L->top.p - (n), \ + "not enough free elements in the stack") #endif diff --git a/lauxlib.c b/lauxlib.c index 4ca6c65488..1bb41bb1da 100644 --- a/lauxlib.c +++ b/lauxlib.c @@ -25,12 +25,7 @@ #include "lua.h" #include "lauxlib.h" - - -#if !defined(MAX_SIZET) -/* maximum value for size_t */ -#define MAX_SIZET ((size_t)(~(size_t)0)) -#endif +#include "llimits.h" /* @@ -80,6 +75,7 @@ static int pushglobalfuncname (lua_State *L, lua_Debug *ar) { int top = lua_gettop(L); lua_getinfo(L, "f", ar); /* push function */ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE); + luaL_checkstack(L, 6, "not enough stack"); /* slots for 'findfield' */ if (findfield(L, top + 1, 2)) { const char *name = lua_tostring(L, -1); if (strncmp(name, LUA_GNAME ".", 3) == 0) { /* name start with '_G.'? */ @@ -98,14 +94,14 @@ static int pushglobalfuncname (lua_State *L, lua_Debug *ar) { static void pushfuncname (lua_State *L, lua_Debug *ar) { - if (pushglobalfuncname(L, ar)) { /* try first a global name */ - lua_pushfstring(L, "function '%s'", lua_tostring(L, -1)); - lua_remove(L, -2); /* remove name */ - } - else if (*ar->namewhat != '\0') /* is there a name from code? */ + if (*ar->namewhat != '\0') /* is there a name from code? */ lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name); /* use it */ else if (*ar->what == 'm') /* main? */ lua_pushliteral(L, "main chunk"); + else if (pushglobalfuncname(L, ar)) { /* try a global name */ + lua_pushfstring(L, "function '%s'", lua_tostring(L, -1)); + lua_remove(L, -2); /* remove name */ + } else if (*ar->what != 'C') /* for Lua functions, use */ lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined); else /* nothing left... */ @@ -174,19 +170,27 @@ LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1, LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) { lua_Debug ar; + const char *argword; if (!lua_getstack(L, 0, &ar)) /* no stack frame? */ return luaL_error(L, "bad argument #%d (%s)", arg, extramsg); - lua_getinfo(L, "n", &ar); - if (strcmp(ar.namewhat, "method") == 0) { - arg--; /* do not count 'self' */ - if (arg == 0) /* error is in the self argument itself? */ - return luaL_error(L, "calling '%s' on bad self (%s)", - ar.name, extramsg); + lua_getinfo(L, "nt", &ar); + if (arg <= ar.extraargs) /* error in an extra argument? */ + argword = "extra argument"; + else { + arg -= ar.extraargs; /* do not count extra arguments */ + if (strcmp(ar.namewhat, "method") == 0) { /* colon syntax? */ + arg--; /* do not count (extra) self argument */ + if (arg == 0) /* error in self argument? */ + return luaL_error(L, "calling '%s' on bad self (%s)", + ar.name, extramsg); + /* else go through; error in a regular argument */ + } + argword = "argument"; } if (ar.name == NULL) ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?"; - return luaL_error(L, "bad argument #%d to '%s' (%s)", - arg, ar.name, extramsg); + return luaL_error(L, "bad %s #%d to '%s' (%s)", + argword, arg, ar.name, extramsg); } @@ -229,7 +233,7 @@ LUALIB_API void luaL_where (lua_State *L, int level) { /* ** Again, the use of 'lua_pushvfstring' ensures this function does ** not need reserved stack space when called. (At worst, it generates -** an error with "stack overflow" instead of the given message.) +** a memory error instead of the given message.) */ LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) { va_list argp; @@ -249,11 +253,13 @@ LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) { return 1; } else { + const char *msg; luaL_pushfail(L); + msg = (en != 0) ? strerror(en) : "(no extra info)"; if (fname) - lua_pushfstring(L, "%s: %s", fname, strerror(en)); + lua_pushfstring(L, "%s: %s", fname, msg); else - lua_pushstring(L, strerror(en)); + lua_pushstring(L, msg); lua_pushinteger(L, en); return 3; } @@ -470,18 +476,27 @@ typedef struct UBox { } UBox; +/* Resize the buffer used by a box. Optimize for the common case of +** resizing to the old size. (For instance, __gc will resize the box +** to 0 even after it was closed. 'pushresult' may also resize it to a +** final size that is equal to the one set when the buffer was created.) +*/ static void *resizebox (lua_State *L, int idx, size_t newsize) { - void *ud; - lua_Alloc allocf = lua_getallocf(L, &ud); UBox *box = (UBox *)lua_touserdata(L, idx); - void *temp = allocf(ud, box->box, box->bsize, newsize); - if (l_unlikely(temp == NULL && newsize > 0)) { /* allocation error? */ - lua_pushliteral(L, "not enough memory"); - lua_error(L); /* raise a memory error */ + if (box->bsize == newsize) /* not changing size? */ + return box->box; /* keep the buffer */ + else { + void *ud; + lua_Alloc allocf = lua_getallocf(L, &ud); + void *temp = allocf(ud, box->box, box->bsize, newsize); + if (l_unlikely(temp == NULL && newsize > 0)) { /* allocation error? */ + lua_pushliteral(L, "not enough memory"); + lua_error(L); /* raise a memory error */ + } + box->box = temp; + box->bsize = newsize; + return temp; } - box->box = temp; - box->bsize = newsize; - return temp; } @@ -526,15 +541,17 @@ static void newbox (lua_State *L) { /* ** Compute new size for buffer 'B', enough to accommodate extra 'sz' -** bytes. (The test for "not big enough" also gets the case when the -** computation of 'newsize' overflows.) +** bytes plus one for a terminating zero. */ static size_t newbuffsize (luaL_Buffer *B, size_t sz) { - size_t newsize = (B->size / 2) * 3; /* buffer size * 1.5 */ - if (l_unlikely(MAX_SIZET - sz < B->n)) /* overflow in (B->n + sz)? */ - return luaL_error(B->L, "buffer too large"); - if (newsize < B->n + sz) /* not big enough? */ - newsize = B->n + sz; + size_t newsize = B->size; + if (l_unlikely(sz >= MAX_SIZE - B->n)) + return cast_sizet(luaL_error(B->L, "resulting string too large")); + /* else B->n + sz + 1 <= MAX_SIZE */ + if (newsize <= MAX_SIZE/3 * 2) /* no overflow? */ + newsize += (newsize >> 1); /* new size *= 1.5 */ + if (newsize < B->n + sz + 1) /* not big enough? */ + newsize = B->n + sz + 1; return newsize; } @@ -594,9 +611,23 @@ LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) { LUALIB_API void luaL_pushresult (luaL_Buffer *B) { lua_State *L = B->L; checkbufferlevel(B, -1); - lua_pushlstring(L, B->b, B->n); - if (buffonstack(B)) + if (!buffonstack(B)) /* using static buffer? */ + lua_pushlstring(L, B->b, B->n); /* save result as regular string */ + else { /* reuse buffer already allocated */ + UBox *box = (UBox *)lua_touserdata(L, -1); + void *ud; + lua_Alloc allocf = lua_getallocf(L, &ud); /* function to free buffer */ + size_t len = B->n; /* final string length */ + char *s; + resizebox(L, -1, len + 1); /* adjust box size to content size */ + s = (char*)box->box; /* final buffer address */ + s[len] = '\0'; /* add ending zero */ + /* clear box, as Lua will take control of the buffer */ + box->bsize = 0; box->box = NULL; + lua_pushexternalstring(L, s, len, allocf, ud); lua_closeslot(L, -2); /* close the box */ + lua_gc(L, LUA_GCSTEP, len); + } lua_remove(L, -2); /* remove box or placeholder from the stack */ } @@ -650,13 +681,10 @@ LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) { ** ======================================================= */ -/* index of free-list header (after the predefined values) */ -#define freelist (LUA_RIDX_LAST + 1) - /* -** The previously freed references form a linked list: -** t[freelist] is the index of a first free index, or zero if list is -** empty; t[t[freelist]] is the index of the second element; etc. +** The previously freed references form a linked list: t[1] is the index +** of a first free index, t[t[1]] is the index of the second element, +** etc. A zero signals the end of the list. */ LUALIB_API int luaL_ref (lua_State *L, int t) { int ref; @@ -665,19 +693,18 @@ LUALIB_API int luaL_ref (lua_State *L, int t) { return LUA_REFNIL; /* 'nil' has a unique fixed reference */ } t = lua_absindex(L, t); - if (lua_rawgeti(L, t, freelist) == LUA_TNIL) { /* first access? */ + if (lua_rawgeti(L, t, 1) == LUA_TNUMBER) /* already initialized? */ + ref = (int)lua_tointeger(L, -1); /* ref = t[1] */ + else { /* first access */ + lua_assert(!lua_toboolean(L, -1)); /* must be nil or false */ ref = 0; /* list is empty */ lua_pushinteger(L, 0); /* initialize as an empty list */ - lua_rawseti(L, t, freelist); /* ref = t[freelist] = 0 */ - } - else { /* already initialized */ - lua_assert(lua_isinteger(L, -1)); - ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */ + lua_rawseti(L, t, 1); /* ref = t[1] = 0 */ } lua_pop(L, 1); /* remove element from stack */ if (ref != 0) { /* any free element? */ lua_rawgeti(L, t, ref); /* remove it from list */ - lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */ + lua_rawseti(L, t, 1); /* (t[1] = t[ref]) */ } else /* no free elements */ ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */ @@ -689,11 +716,11 @@ LUALIB_API int luaL_ref (lua_State *L, int t) { LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { if (ref >= 0) { t = lua_absindex(L, t); - lua_rawgeti(L, t, freelist); + lua_rawgeti(L, t, 1); lua_assert(lua_isinteger(L, -1)); - lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */ + lua_rawseti(L, t, ref); /* t[ref] = t[1] */ lua_pushinteger(L, ref); - lua_rawseti(L, t, freelist); /* t[freelist] = ref */ + lua_rawseti(L, t, 1); /* t[1] = ref */ } } @@ -707,7 +734,7 @@ LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { */ typedef struct LoadF { - int n; /* number of pre-read characters */ + unsigned n; /* number of pre-read characters */ FILE *f; /* file being read */ char buff[BUFSIZ]; /* area for reading file */ } LoadF; @@ -715,7 +742,7 @@ typedef struct LoadF { static const char *getF (lua_State *L, void *ud, size_t *size) { LoadF *lf = (LoadF *)ud; - (void)L; /* not used */ + UNUSED(L); if (lf->n > 0) { /* are there pre-read characters to be read? */ *size = lf->n; /* return them (chars already in buffer) */ lf->n = 0; /* no more pre-read characters */ @@ -732,9 +759,12 @@ static const char *getF (lua_State *L, void *ud, size_t *size) { static int errfile (lua_State *L, const char *what, int fnameindex) { - const char *serr = strerror(errno); + int err = errno; const char *filename = lua_tostring(L, fnameindex) + 1; - lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr); + if (err != 0) + lua_pushfstring(L, "cannot %s %s: %s", what, filename, strerror(err)); + else + lua_pushfstring(L, "cannot %s %s", what, filename); lua_remove(L, fnameindex); return LUA_ERRFILE; } @@ -787,6 +817,7 @@ LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename, } else { lua_pushfstring(L, "@%s", filename); + errno = 0; lf.f = fopen(filename, "r"); if (lf.f == NULL) return errfile(L, "open", fnameindex); } @@ -796,15 +827,17 @@ LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename, if (c == LUA_SIGNATURE[0]) { /* binary file? */ lf.n = 0; /* remove possible newline */ if (filename) { /* "real" file? */ + errno = 0; lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */ if (lf.f == NULL) return errfile(L, "reopen", fnameindex); skipcomment(lf.f, &c); /* re-read initial portion */ } } if (c != EOF) - lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */ + lf.buff[lf.n++] = cast_char(c); /* 'c' is the first character */ status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode); readstatus = ferror(lf.f); + errno = 0; /* no useful error number until here */ if (filename) fclose(lf.f); /* close file (even in case of errors) */ if (readstatus) { lua_settop(L, fnameindex); /* ignore results from 'lua_load' */ @@ -823,7 +856,7 @@ typedef struct LoadS { static const char *getS (lua_State *L, void *ud, size_t *size) { LoadS *ls = (LoadS *)ud; - (void)L; /* not used */ + UNUSED(L); if (ls->size == 0) return NULL; *size = ls->size; ls->size = 0; @@ -895,10 +928,9 @@ LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) { else { switch (lua_type(L, idx)) { case LUA_TNUMBER: { - if (lua_isinteger(L, idx)) - lua_pushfstring(L, "%I", (LUAI_UACINT)lua_tointeger(L, idx)); - else - lua_pushfstring(L, "%f", (LUAI_UACNUMBER)lua_tonumber(L, idx)); + char buff[LUA_N2SBUFFSZ]; + lua_numbertocstring(L, idx, buff); + lua_pushstring(L, buff); break; } case LUA_TSTRING: @@ -933,7 +965,7 @@ LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) { 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 */ - if (l->func == NULL) /* place holder? */ + if (l->func == NULL) /* placeholder? */ lua_pushboolean(L, 0); else { int i; @@ -996,7 +1028,7 @@ LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s, const char *wild; size_t l = strlen(p); while ((wild = strstr(s, p)) != NULL) { - luaL_addlstring(b, s, wild - s); /* push prefix */ + luaL_addlstring(b, s, ct_diff2sz(wild - s)); /* push prefix */ luaL_addstring(b, r); /* push replacement in place of pattern */ s = wild + l; /* continue after 'p' */ } @@ -1014,8 +1046,8 @@ LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, } -static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { - (void)ud; (void)osize; /* not used */ +void *luaL_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { + UNUSED(ud); UNUSED(osize); if (nsize == 0) { free(ptr); return NULL; @@ -1025,9 +1057,14 @@ static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { } +/* +** Standard panic function just prints an error message. The test +** with 'lua_type' avoids possible memory errors in 'lua_tostring'. +*/ static int panic (lua_State *L) { - const char *msg = lua_tostring(L, -1); - if (msg == NULL) msg = "error object is not a string"; + const char *msg = (lua_type(L, -1) == LUA_TSTRING) + ? lua_tostring(L, -1) + : "error object is not a string"; lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n", msg); return 0; /* return to Lua to abort */ @@ -1091,8 +1128,61 @@ static void warnfon (void *ud, const char *message, int tocont) { } -LUALIB_API lua_State *luaL_newstate (void) { - lua_State *L = lua_newstate(l_alloc, NULL); + +/* +** A function to compute an unsigned int with some level of +** randomness. Rely on Address Space Layout Randomization (if present) +** and the current time. +*/ +#if !defined(luai_makeseed) + +#include + + +/* Size for the buffer, in bytes */ +#define BUFSEEDB (sizeof(void*) + sizeof(time_t)) + +/* Size for the buffer in int's, rounded up */ +#define BUFSEED ((BUFSEEDB + sizeof(int) - 1) / sizeof(int)) + +/* +** Copy the contents of variable 'v' into the buffer pointed by 'b'. +** (The '&b[0]' disguises 'b' to fix an absurd warning from clang.) +*/ +#define addbuff(b,v) (memcpy(&b[0], &(v), sizeof(v)), b += sizeof(v)) + + +static unsigned int luai_makeseed (void) { + unsigned int buff[BUFSEED]; + unsigned int res; + unsigned int i; + time_t t = time(NULL); + char *b = (char*)buff; + addbuff(b, b); /* local variable's address */ + addbuff(b, t); /* time */ + /* fill (rare but possible) remain of the buffer with zeros */ + memset(b, 0, sizeof(buff) - BUFSEEDB); + res = buff[0]; + for (i = 1; i < BUFSEED; i++) + res ^= (res >> 3) + (res << 7) + buff[i]; + return res; +} + +#endif + + +LUALIB_API unsigned int luaL_makeseed (lua_State *L) { + UNUSED(L); + return luai_makeseed(); +} + + +/* +** Use the name with parentheses so that headers can redefine it +** as a macro. +*/ +LUALIB_API lua_State *(luaL_newstate) (void) { + lua_State *L = lua_newstate(luaL_alloc, NULL, luaL_makeseed(NULL)); if (l_likely(L)) { lua_atpanic(L, &panic); lua_setwarnf(L, warnfoff, L); /* default is warnings off */ diff --git a/lauxlib.h b/lauxlib.h index 5b977e2a39..7f1d3ca195 100644 --- a/lauxlib.h +++ b/lauxlib.h @@ -81,6 +81,9 @@ LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def, LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname); LUALIB_API int (luaL_execresult) (lua_State *L, int stat); +LUALIB_API void *luaL_alloc (void *ud, void *ptr, size_t osize, + size_t nsize); + /* predefined references */ #define LUA_NOREF (-2) @@ -100,6 +103,8 @@ LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); LUALIB_API lua_State *(luaL_newstate) (void); +LUALIB_API unsigned luaL_makeseed (lua_State *L); + LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx); LUALIB_API void (luaL_addgsub) (luaL_Buffer *b, const char *s, @@ -163,21 +168,10 @@ LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname, /* push the value used to represent failure/error */ -#define luaL_pushfail(L) lua_pushnil(L) - - -/* -** Internal assertions for in-house debugging -*/ -#if !defined(lua_assert) - -#if defined LUAI_ASSERT - #include - #define lua_assert(c) assert(c) +#if defined(LUA_FAILISFALSE) +#define luaL_pushfail(L) lua_pushboolean(L, 0) #else - #define lua_assert(c) ((void)0) -#endif - +#define luaL_pushfail(L) lua_pushnil(L) #endif @@ -249,30 +243,6 @@ typedef struct luaL_Stream { /* }====================================================== */ -/* -** {================================================================== -** "Abstraction Layer" for basic report of messages and errors -** =================================================================== -*/ - -/* print a string */ -#if !defined(lua_writestring) -#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout) -#endif - -/* print a newline and flush the output */ -#if !defined(lua_writeline) -#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout)) -#endif - -/* print an error message */ -#if !defined(lua_writestringerror) -#define lua_writestringerror(s,p) \ - (fprintf(stderr, (s), (p)), fflush(stderr)) -#endif - -/* }================================================================== */ - /* ** {============================================================ diff --git a/lbaselib.c b/lbaselib.c index 1d60c9dede..891bb90f48 100644 --- a/lbaselib.c +++ b/lbaselib.c @@ -19,6 +19,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" static int luaB_print (lua_State *L) { @@ -57,21 +58,22 @@ static int luaB_warn (lua_State *L) { #define SPACECHARS " \f\n\r\t\v" -static const char *b_str2int (const char *s, int base, lua_Integer *pn) { +static const char *b_str2int (const char *s, unsigned base, lua_Integer *pn) { lua_Unsigned n = 0; int neg = 0; s += strspn(s, SPACECHARS); /* skip initial spaces */ if (*s == '-') { s++; neg = 1; } /* handle sign */ else if (*s == '+') s++; - if (!isalnum((unsigned char)*s)) /* no digit? */ + if (!isalnum(cast_uchar(*s))) /* no digit? */ return NULL; do { - int digit = (isdigit((unsigned char)*s)) ? *s - '0' - : (toupper((unsigned char)*s) - 'A') + 10; + unsigned digit = cast_uint(isdigit(cast_uchar(*s)) + ? *s - '0' + : (toupper(cast_uchar(*s)) - 'A') + 10); if (digit >= base) return NULL; /* invalid numeral */ n = n * base + digit; s++; - } while (isalnum((unsigned char)*s)); + } while (isalnum(cast_uchar(*s))); s += strspn(s, SPACECHARS); /* skip trailing spaces */ *pn = (lua_Integer)((neg) ? (0u - n) : n); return s; @@ -101,7 +103,7 @@ static int luaB_tonumber (lua_State *L) { luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */ s = lua_tolstring(L, 1, &l); luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); - if (b_str2int(s, (int)base, &n) == s + l) { + if (b_str2int(s, cast_uint(base), &n) == s + l) { lua_pushinteger(L, n); return 1; } /* else not a number */ @@ -158,7 +160,7 @@ static int luaB_rawlen (lua_State *L) { int t = lua_type(L, 1); luaL_argexpected(L, t == LUA_TTABLE || t == LUA_TSTRING, 1, "table or string"); - lua_pushinteger(L, lua_rawlen(L, 1)); + lua_pushinteger(L, l_castU2S(lua_rawlen(L, 1))); return 1; } @@ -198,11 +200,11 @@ static int pushmode (lua_State *L, int oldmode) { static int luaB_collectgarbage (lua_State *L) { static const char *const opts[] = {"stop", "restart", "collect", - "count", "step", "setpause", "setstepmul", - "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_GCGEN, LUA_GCINC}; + "count", "step", "isrunning", "generational", "incremental", + "param", NULL}; + static const char optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT, + LUA_GCCOUNT, LUA_GCSTEP, LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC, + LUA_GCPARAM}; int o = optsnum[luaL_checkoption(L, 1, "collect", opts)]; switch (o) { case LUA_GCCOUNT: { @@ -213,20 +215,12 @@ static int luaB_collectgarbage (lua_State *L) { return 1; } case LUA_GCSTEP: { - int step = (int)luaL_optinteger(L, 2, 0); - int res = lua_gc(L, o, step); + lua_Integer n = luaL_optinteger(L, 2, 0); + int res = lua_gc(L, o, cast_sizet(n)); checkvalres(res); 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); - checkvalres(previous); - lua_pushinteger(L, previous); - return 1; - } case LUA_GCISRUNNING: { int res = lua_gc(L, o); checkvalres(res); @@ -234,15 +228,22 @@ static int luaB_collectgarbage (lua_State *L) { 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)); + return pushmode(L, lua_gc(L, o)); } 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)); + return pushmode(L, lua_gc(L, o)); + } + case LUA_GCPARAM: { + static const char *const params[] = { + "minormul", "majorminor", "minormajor", + "pause", "stepmul", "stepsize", NULL}; + static const char pnum[] = { + LUA_GCPMINORMUL, LUA_GCPMAJORMINOR, LUA_GCPMINORMAJOR, + LUA_GCPPAUSE, LUA_GCPSTEPMUL, LUA_GCPSTEPSIZE}; + int p = pnum[luaL_checkoption(L, 2, NULL, params)]; + lua_Integer value = luaL_optinteger(L, 3, -1); + lua_pushinteger(L, lua_gc(L, o, p, (int)value)); + return 1; } default: { int res = lua_gc(L, o); @@ -278,21 +279,22 @@ static int luaB_next (lua_State *L) { static int pairscont (lua_State *L, int status, lua_KContext k) { (void)L; (void)status; (void)k; /* unused */ - return 3; + return 4; /* __pairs did all the work, just return its results */ } static int luaB_pairs (lua_State *L) { 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 */ + lua_pushcfunction(L, luaB_next); /* will return generator and */ + lua_pushvalue(L, 1); /* state */ + lua_pushnil(L); /* initial value */ + lua_pushnil(L); /* to-be-closed object */ } else { lua_pushvalue(L, 1); /* argument 'self' to metamethod */ - lua_callk(L, 1, 3, 0, pairscont); /* get 3 values from metamethod */ + lua_callk(L, 1, 4, 0, pairscont); /* get 4 values from metamethod */ } - return 3; + return 4; } @@ -337,9 +339,17 @@ static int load_aux (lua_State *L, int status, int envidx) { } +static const char *getMode (lua_State *L, int idx) { + const char *mode = luaL_optstring(L, idx, "bt"); + if (strchr(mode, 'B') != NULL) /* Lua code cannot use fixed buffers */ + luaL_argerror(L, idx, "invalid mode"); + return mode; +} + + static int luaB_loadfile (lua_State *L) { const char *fname = luaL_optstring(L, 1, NULL); - const char *mode = luaL_optstring(L, 2, NULL); + const char *mode = getMode(L, 2); int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */ int status = luaL_loadfilex(L, fname, mode); return load_aux(L, status, env); @@ -388,7 +398,7 @@ static int luaB_load (lua_State *L) { int status; size_t l; const char *s = lua_tolstring(L, 1, &l); - const char *mode = luaL_optstring(L, 3, "bt"); + const char *mode = getMode(L, 3); int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */ if (s != NULL) { /* loading a string? */ const char *chunkname = luaL_optstring(L, 2, s); diff --git a/lcode.c b/lcode.c index 911dbd5f1e..95ef900cfd 100644 --- a/lcode.c +++ b/lcode.c @@ -31,10 +31,7 @@ #include "lvm.h" -/* Maximum number of registers in a Lua function (must fit in 8 bits) */ -#define MAXREGS 255 - - +/* (note that expressions VJMP also have jumps.) */ #define hasjumps(e) ((e)->t != (e)->f) @@ -43,8 +40,12 @@ static int codesJ (FuncState *fs, OpCode o, int sj, int k); /* semantic error */ -l_noret luaK_semerror (LexState *ls, const char *msg) { +l_noret luaK_semerror (LexState *ls, const char *fmt, ...) { + const char *msg; + va_list argp; + pushvfstring(ls->L, argp, fmt, msg); ls->t.token = 0; /* remove "near " from final message */ + ls->linenumber = ls->lastline; /* back to line of last used token */ luaX_syntaxerror(ls, msg); } @@ -211,6 +212,7 @@ void luaK_ret (FuncState *fs, int first, int nret) { case 1: op = OP_RETURN1; break; default: op = OP_RETURN; break; } + luaY_checklimit(fs, nret + 1, MAXARG_B, "returns"); luaK_codeABC(fs, op, first, nret + 1, 0); } @@ -331,15 +333,15 @@ static void savelineinfo (FuncState *fs, Proto *f, int line) { 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->sizeabslineinfo, AbsLineInfo, INT_MAX, "lines"); f->abslineinfo[fs->nabslineinfo].pc = pc; f->abslineinfo[fs->nabslineinfo++].line = line; linedif = ABSLINEINFO; /* signal that there is absolute information */ fs->iwthabs = 1; /* restart counter */ } luaM_growvector(fs->ls->L, f->lineinfo, pc, f->sizelineinfo, ls_byte, - MAX_INT, "opcodes"); - f->lineinfo[pc] = linedif; + INT_MAX, "opcodes"); + f->lineinfo[pc] = cast(ls_byte, linedif); fs->previousline = line; /* last line saved */ } @@ -383,7 +385,7 @@ int luaK_code (FuncState *fs, Instruction i) { Proto *f = fs->f; /* put new instruction in code array */ luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction, - MAX_INT, "opcodes"); + INT_MAX, "opcodes"); f->code[fs->pc++] = i; savelineinfo(fs, f, fs->ls->lastline); return fs->pc - 1; /* index of new instruction */ @@ -394,32 +396,40 @@ int luaK_code (FuncState *fs, Instruction i) { ** Format and emit an 'iABC' instruction. (Assertions check consistency ** of parameters versus opcode.) */ -int luaK_codeABCk (FuncState *fs, OpCode o, int a, int b, int c, int k) { +int luaK_codeABCk (FuncState *fs, OpCode o, int A, int B, int C, int k) { lua_assert(getOpMode(o) == iABC); - 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)); + 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)); +} + + +int luaK_codevABCk (FuncState *fs, OpCode o, int A, int B, int C, int k) { + lua_assert(getOpMode(o) == ivABC); + lua_assert(A <= MAXARG_A && B <= MAXARG_vB && + C <= MAXARG_vC && (k & ~1) == 0); + return luaK_code(fs, CREATE_vABCk(o, A, B, C, k)); } /* ** Format and emit an 'iABx' instruction. */ -int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) { +int luaK_codeABx (FuncState *fs, OpCode o, int A, int Bc) { lua_assert(getOpMode(o) == iABx); - lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx); - return luaK_code(fs, CREATE_ABx(o, a, bc)); + 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; +static int codeAsBx (FuncState *fs, OpCode o, int A, int Bc) { + 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)); + lua_assert(A <= MAXARG_A && b <= MAXARG_Bx); + return luaK_code(fs, CREATE_ABx(o, A, b)); } @@ -427,7 +437,7 @@ int luaK_codeAsBx (FuncState *fs, OpCode o, int a, int bc) { ** Format and emit an 'isJ' instruction. */ static int codesJ (FuncState *fs, OpCode o, int sj, int k) { - unsigned int j = sj + OFFSET_sJ; + 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)); @@ -437,9 +447,9 @@ static int codesJ (FuncState *fs, OpCode o, int sj, int k) { /* ** Emit an "extra argument" instruction (format 'iAx') */ -static int codeextraarg (FuncState *fs, int a) { - lua_assert(a <= MAXARG_Ax); - return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a)); +static int codeextraarg (FuncState *fs, int A) { + lua_assert(A <= MAXARG_Ax); + return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, A)); } @@ -466,9 +476,7 @@ static int luaK_codek (FuncState *fs, int reg, int k) { void luaK_checkstack (FuncState *fs, int n) { int newstack = fs->freereg + n; if (newstack > fs->f->maxstacksize) { - if (newstack >= MAXREGS) - luaX_syntaxerror(fs->ls, - "function or expression needs too many registers"); + luaY_checklimit(fs, newstack, MAX_FSTACK, "registers"); fs->f->maxstacksize = cast_byte(newstack); } } @@ -479,7 +487,7 @@ void luaK_checkstack (FuncState *fs, int n) { */ void luaK_reserveregs (FuncState *fs, int n) { luaK_checkstack(fs, n); - fs->freereg += n; + fs->freereg = cast_byte(fs->freereg + n); } @@ -533,39 +541,45 @@ static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) { /* ** Add constant 'v' to prototype's list of constants (field 'k'). +*/ +static int addk (FuncState *fs, Proto *f, TValue *v) { + lua_State *L = fs->ls->L; + int oldsize = f->sizek; + int k = fs->nk; + luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants"); + while (oldsize < f->sizek) + setnilvalue(&f->k[oldsize++]); + setobj(L, &f->k[k], v); + fs->nk++; + luaC_barrier(L, f, v); + return k; +} + + +/* ** Use scanner's table to cache position of constants in constant list ** and try to reuse constants. Because some values should not be used ** as keys (nil cannot be a key, integer keys can collapse with float ** keys), the caller must provide a useful 'key' for indexing the cache. -** Note that all functions share the same table, so entering or exiting -** a function can make some indices wrong. */ -static int addk (FuncState *fs, TValue *key, TValue *v) { +static int k2proto (FuncState *fs, TValue *key, TValue *v) { TValue val; - lua_State *L = fs->ls->L; Proto *f = fs->f; - const TValue *idx = luaH_get(fs->ls->h, key); /* query scanner table */ - int k, oldsize; - 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 && ttypetag(&f->k[k]) == ttypetag(v) && - luaV_rawequalobj(&f->k[k], v)) - return k; /* reuse index */ + int tag = luaH_get(fs->kcache, key, &val); /* query scanner table */ + if (!tagisempty(tag)) { /* is there an index there? */ + int k = cast_int(ivalue(&val)); + /* collisions can happen only for float keys */ + lua_assert(ttisfloat(key) || luaV_rawequalobj(&f->k[k], v)); + return k; /* reuse index */ + } + else { /* constant not found; create a new entry */ + int k = addk(fs, f, v); + /* cache it for reuse; numerical value does not need GC barrier; + table is not a metatable, so it does not need to invalidate cache */ + setivalue(&val, k); + luaH_set(fs->ls->L, fs->kcache, key, &val); + return k; } - /* constant not found; create a new entry */ - oldsize = f->sizek; - k = fs->nk; - /* numerical value does not need GC barrier; - table has no metatable, so it does not need to invalidate cache */ - setivalue(&val, k); - luaH_finishset(L, fs->ls->h, key, idx, &val); - luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants"); - while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]); - setobj(L, &f->k[k], v); - fs->nk++; - luaC_barrier(L, f, v); - return k; } @@ -575,7 +589,7 @@ static int addk (FuncState *fs, TValue *key, TValue *v) { 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 */ + return k2proto(fs, &o, &o); /* use string itself as key */ } @@ -585,36 +599,42 @@ static int stringK (FuncState *fs, TString *s) { static int luaK_intK (FuncState *fs, lua_Integer n) { TValue o; setivalue(&o, n); - return addk(fs, &o, &o); /* use integer itself as key */ + return k2proto(fs, &o, &o); /* use integer itself as key */ } /* ** Add a float to list of constants and return its index. Floats ** with integral values need a different key, to avoid collision -** with actual integers. To that, we add to the number its smaller +** with actual integers. To that end, we add to the number its smaller ** power-of-two fraction that is still significant in its scale. -** For doubles, that would be 1/2^52. -** (This method is not bulletproof: there may be another float -** with that value, and for floats larger than 2^53 the result is -** still an integer. At worst, this only wastes an entry with -** a duplicate.) +** (For doubles, the fraction would be 2^-52). +** This method is not bulletproof: different numbers may generate the +** same key (e.g., very large numbers will overflow to 'inf') and for +** floats larger than 2^53 the result is still an integer. For those +** cases, just generate a new entry. At worst, this only wastes an entry +** with a duplicate. */ static int luaK_numberK (FuncState *fs, lua_Number r) { - TValue o; - lua_Integer ik; - setfltvalue(&o, r); - if (!luaV_flttointeger(r, &ik, F2Ieq)) /* not an integral value? */ - return addk(fs, &o, &o); /* use number itself as key */ - else { /* must build an alternative key */ + TValue o, kv; + setfltvalue(&o, r); /* value as a TValue */ + if (r == 0) { /* handle zero as a special case */ + setpvalue(&kv, fs); /* use FuncState as index */ + return k2proto(fs, &kv, &o); /* cannot collide */ + } + else { const int nbm = l_floatatt(MANT_DIG); const lua_Number q = l_mathop(ldexp)(l_mathop(1.0), -nbm + 1); - const lua_Number k = (ik == 0) ? q : r + r*q; /* new key */ - TValue kv; - setfltvalue(&kv, k); - /* result is not an integral value, unless value is too large */ - lua_assert(!luaV_flttointeger(k, &ik, F2Ieq) || - l_mathop(fabs)(r) >= l_mathop(1e6)); - return addk(fs, &kv, &o); + const lua_Number k = r * (1 + q); /* key */ + lua_Integer ik; + setfltvalue(&kv, k); /* key as a TValue */ + if (!luaV_flttointeger(k, &ik, F2Ieq)) { /* not an integer value? */ + int n = k2proto(fs, &kv, &o); /* use key */ + if (luaV_rawequalobj(&fs->f->k[n], &o)) /* correct value? */ + return n; + } + /* else, either key is still an integer or there was a collision; + anyway, do not try to reuse constant; instead, create a new one */ + return addk(fs, fs->f, &o); } } @@ -625,7 +645,7 @@ static int luaK_numberK (FuncState *fs, lua_Number r) { static int boolF (FuncState *fs) { TValue o; setbfvalue(&o); - return addk(fs, &o, &o); /* use boolean itself as key */ + return k2proto(fs, &o, &o); /* use boolean itself as key */ } @@ -635,7 +655,7 @@ static int boolF (FuncState *fs) { static int boolT (FuncState *fs) { TValue o; setbtvalue(&o); - return addk(fs, &o, &o); /* use boolean itself as key */ + return k2proto(fs, &o, &o); /* use boolean itself as key */ } @@ -645,9 +665,9 @@ static int boolT (FuncState *fs) { static int nilK (FuncState *fs) { TValue k, v; setnilvalue(&v); - /* cannot use nil as key; instead use table itself to represent nil */ - sethvalue(fs->ls->L, &k, fs->ls->h); - return addk(fs, &k, &v); + /* cannot use nil as key; instead use table itself */ + sethvalue(fs->ls->L, &k, fs->kcache); + return k2proto(fs, &k, &v); } @@ -671,7 +691,7 @@ static int fitsBx (lua_Integer i) { void luaK_int (FuncState *fs, int reg, lua_Integer i) { if (fitsBx(i)) - luaK_codeAsBx(fs, OP_LOADI, reg, cast_int(i)); + codeAsBx(fs, OP_LOADI, reg, cast_int(i)); else luaK_codek(fs, reg, luaK_intK(fs, i)); } @@ -680,12 +700,28 @@ void luaK_int (FuncState *fs, int reg, lua_Integer 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)); + codeAsBx(fs, OP_LOADF, reg, cast_int(fi)); else luaK_codek(fs, reg, luaK_numberK(fs, f)); } +/* +** Get the value of 'var' in a register and generate an opcode to check +** whether that register is nil. 'k' is the index of the variable name +** in the list of constants. If its value cannot be encoded in Bx, a 0 +** will use '?' for the name. +*/ +void luaK_codecheckglobal (FuncState *fs, expdesc *var, int k, int line) { + luaK_exp2anyreg(fs, var); + luaK_fixline(fs, line); + k = (k >= MAXARG_Bx) ? 0 : k + 1; + luaK_codeABx(fs, OP_ERRNNIL, var->u.info, k); + luaK_fixline(fs, line); + freeexp(fs, var); +} + + /* ** Convert a constant in 'v' into an expression description 'e' */ @@ -720,6 +756,7 @@ static void const2exp (TValue *v, expdesc *e) { */ void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) { Instruction *pc = &getinstruction(fs, e); + luaY_checklimit(fs, nresults + 1, MAXARG_C, "multiple results"); if (e->k == VCALL) /* expression is an open function call? */ SETARG_C(*pc, nresults + 1); else { @@ -734,10 +771,11 @@ void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) { /* ** Convert a VKSTR to a VK */ -static void str2K (FuncState *fs, expdesc *e) { +static int str2K (FuncState *fs, expdesc *e) { lua_assert(e->k == VKSTR); e->u.info = stringK(fs, e->u.strval); e->k = VK; + return e->u.info; } @@ -764,6 +802,15 @@ void luaK_setoneret (FuncState *fs, expdesc *e) { } } +/* +** Change a vararg parameter into a regular local variable +*/ +void luaK_vapar2local (FuncState *fs, expdesc *var) { + fs->f->flag |= PF_VATAB; /* function will need a vararg table */ + /* now a vararg parameter is equivalent to a regular local variable */ + var->k = VLOCAL; +} + /* ** Ensure that expression 'e' is not a variable (nor a ). @@ -775,8 +822,12 @@ void luaK_dischargevars (FuncState *fs, expdesc *e) { const2exp(const2val(fs, e), e); break; } + case VVARGVAR: { + luaK_vapar2local(fs, e); /* turn it into a local variable */ + } /* FALLTHROUGH */ case VLOCAL: { /* already in a register */ - e->u.info = e->u.var.ridx; + int temp = e->u.var.ridx; + e->u.info = temp; /* (can't do a direct assignment; values overlap) */ e->k = VNONRELOC; /* becomes a non-relocatable value */ break; } @@ -808,6 +859,12 @@ void luaK_dischargevars (FuncState *fs, expdesc *e) { e->k = VRELOC; break; } + case VVARGIND: { + freeregs(fs, e->u.ind.t, e->u.ind.idx); + e->u.info = luaK_codeABC(fs, OP_GETVARG, 0, e->u.ind.t, e->u.ind.idx); + e->k = VRELOC; + break; + } case VVARARG: case VCALL: { luaK_setoneret(fs, e); break; @@ -970,11 +1027,11 @@ int luaK_exp2anyreg (FuncState *fs, expdesc *e) { /* -** Ensures final expression result is either in a register -** or in an upvalue. +** Ensures final expression result is either in a register, +** in an upvalue, or it is the vararg parameter. */ void luaK_exp2anyregup (FuncState *fs, expdesc *e) { - if (e->k != VUPVAL || hasjumps(e)) + if ((e->k != VUPVAL && e->k != VVARGVAR) || hasjumps(e)) luaK_exp2anyreg(fs, e); } @@ -984,7 +1041,7 @@ void luaK_exp2anyregup (FuncState *fs, expdesc *e) { ** or it is a constant. */ void luaK_exp2val (FuncState *fs, expdesc *e) { - if (hasjumps(e)) + if (e->k == VJMP || hasjumps(e)) luaK_exp2anyreg(fs, e); else luaK_dischargevars(fs, e); @@ -1025,7 +1082,7 @@ static int luaK_exp2K (FuncState *fs, expdesc *e) { ** in the range of R/K indices). ** Returns 1 iff expression is K. */ -int luaK_exp2RK (FuncState *fs, expdesc *e) { +static int exp2RK (FuncState *fs, expdesc *e) { if (luaK_exp2K(fs, e)) return 1; else { /* not a constant in the right range: put it in a register */ @@ -1035,10 +1092,10 @@ int luaK_exp2RK (FuncState *fs, expdesc *e) { } -static void codeABRK (FuncState *fs, OpCode o, int a, int b, +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); + int k = exp2RK(fs, ec); + luaK_codeABCk(fs, o, A, B, ec->u.info, k); } @@ -1069,6 +1126,10 @@ void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) { codeABRK(fs, OP_SETFIELD, var->u.ind.t, var->u.ind.idx, ex); break; } + case VVARGIND: { + fs->f->flag |= PF_VATAB; /* function will need a vararg table */ + /* now, assignment is to a regular table */ + } /* FALLTHROUGH */ case VINDEXED: { codeABRK(fs, OP_SETTABLE, var->u.ind.t, var->u.ind.idx, ex); break; @@ -1079,22 +1140,6 @@ void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) { } -/* -** Emit SELF instruction (convert expression 'e' into 'e:key(e,'). -*/ -void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { - int ereg; - luaK_exp2anyreg(fs, e); - ereg = e->u.info; /* register where 'e' was placed */ - freeexp(fs, e); - e->u.info = fs->freereg; /* base register for op_self */ - e->k = VNONRELOC; /* self expression has a fixed register */ - luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */ - codeABRK(fs, OP_SELF, e->u.info, ereg, key); - freeexp(fs, key); -} - - /* ** Negate condition 'e' (where 'e' is a comparison). */ @@ -1157,7 +1202,7 @@ void luaK_goiftrue (FuncState *fs, expdesc *e) { /* ** Emit code to go through if 'e' is false, jump otherwise. */ -void luaK_goiffalse (FuncState *fs, expdesc *e) { +static void luaK_goiffalse (FuncState *fs, expdesc *e) { int pc; /* pc of new jump */ luaK_dischargevars(fs, e); switch (e->k) { @@ -1215,17 +1260,17 @@ static void codenot (FuncState *fs, expdesc *e) { /* -** Check whether expression 'e' is a small literal string +** Check whether expression 'e' is a short literal string */ static int isKstr (FuncState *fs, expdesc *e) { - return (e->k == VK && !hasjumps(e) && e->u.info <= MAXARG_B && + return (e->k == VK && !hasjumps(e) && e->u.info <= MAXINDEXRK && ttisshrstring(&fs->f->k[e->u.info])); } /* ** Check whether expression 'e' is a literal integer. */ -int luaK_isKint (expdesc *e) { +static int isKint (expdesc *e) { return (e->k == VKINT && !hasjumps(e)); } @@ -1235,7 +1280,7 @@ int luaK_isKint (expdesc *e) { ** 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)); + return isKint(e) && (l_castS2U(e->u.ival) <= l_castS2U(MAXARG_C)); } @@ -1244,7 +1289,7 @@ static int isCint (expdesc *e) { ** proper range to fit in register sC */ static int isSCint (expdesc *e) { - return luaK_isKint(e) && fitsC(e->u.ival); + return isKint(e) && fitsC(e->u.ival); } @@ -1269,6 +1314,40 @@ static int isSCnumber (expdesc *e, int *pi, int *isfloat) { } +/* +** Emit SELF instruction or equivalent: the code will convert +** expression 'e' into 'e.key(e,'. +*/ +void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { + int ereg, base; + luaK_exp2anyreg(fs, e); + ereg = e->u.info; /* register where 'e' (the receiver) was placed */ + freeexp(fs, e); + base = e->u.info = fs->freereg; /* base register for op_self */ + e->k = VNONRELOC; /* self expression has a fixed register */ + luaK_reserveregs(fs, 2); /* method and 'self' produced by op_self */ + lua_assert(key->k == VKSTR); + /* is method name a short string in a valid K index? */ + if (strisshr(key->u.strval) && luaK_exp2K(fs, key)) { + /* can use 'self' opcode */ + luaK_codeABCk(fs, OP_SELF, base, ereg, key->u.info, 0); + } + else { /* cannot use 'self' opcode; use move+gettable */ + luaK_exp2anyreg(fs, key); /* put method name in a register */ + luaK_codeABC(fs, OP_MOVE, base + 1, ereg, 0); /* copy self to base+1 */ + luaK_codeABC(fs, OP_GETTABLE, base, ereg, key->u.info); /* get method */ + } + freeexp(fs, key); +} + + +/* auxiliary function to define indexing expressions */ +static void fillidxk (expdesc *t, int idx, expkind k) { + t->u.ind.idx = cast_byte(idx); + t->k = k; +} + + /* ** Create expression 't[k]'. 't' must have its final result already in a ** register or upvalue. Upvalues can only be indexed by literal strings. @@ -1276,33 +1355,37 @@ static int isSCnumber (expdesc *e, int *pi, int *isfloat) { ** values in registers. */ void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) { + int keystr = -1; if (k->k == VKSTR) - str2K(fs, k); + keystr = str2K(fs, k); lua_assert(!hasjumps(t) && - (t->k == VLOCAL || t->k == VNONRELOC || t->k == VUPVAL)); + (t->k == VLOCAL || t->k == VVARGVAR || + 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; + lu_byte temp = cast_byte(t->u.info); /* upvalue index */ + t->u.ind.t = temp; /* (can't do a direct assignment; values overlap) */ + lua_assert(isKstr(fs, k)); + fillidxk(t, k->u.info, VINDEXUP); /* literal short string */ + } + else if (t->k == VVARGVAR) { /* indexing the vararg parameter? */ + lua_assert(t->u.ind.t == fs->f->numparams); + t->u.ind.t = cast_byte(t->u.var.ridx); + fillidxk(t, luaK_exp2anyreg(fs, k), VVARGIND); /* register */ } else { /* register index of the table */ - t->u.ind.t = (t->k == VLOCAL) ? t->u.var.ridx: 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; - } + t->u.ind.t = cast_byte((t->k == VLOCAL) ? t->u.var.ridx: t->u.info); + if (isKstr(fs, k)) + fillidxk(t, k->u.info, VINDEXSTR); /* literal short string */ + else if (isCint(k)) /* int. constant in proper range? */ + fillidxk(t, cast_int(k->u.ival), VINDEXI); + else + fillidxk(t, luaK_exp2anyreg(fs, k), VINDEXED); /* register */ } + t->u.ind.keystr = keystr; /* string index in 'k' */ + t->u.ind.ro = 0; /* by default, not read-only */ } @@ -1351,6 +1434,35 @@ static int constfolding (FuncState *fs, int op, expdesc *e1, } +/* +** Convert a BinOpr to an OpCode (ORDER OPR - ORDER OP) +*/ +l_sinline OpCode binopr2op (BinOpr opr, BinOpr baser, OpCode base) { + lua_assert(baser <= opr && + ((baser == OPR_ADD && opr <= OPR_SHR) || + (baser == OPR_LT && opr <= OPR_LE))); + return cast(OpCode, (cast_int(opr) - cast_int(baser)) + cast_int(base)); +} + + +/* +** Convert a UnOpr to an OpCode (ORDER OPR - ORDER OP) +*/ +l_sinline OpCode unopr2op (UnOpr opr) { + return cast(OpCode, (cast_int(opr) - cast_int(OPR_MINUS)) + + cast_int(OP_UNM)); +} + + +/* +** Convert a BinOpr to a tag method (ORDER OPR - ORDER TM) +*/ +l_sinline TMS binopr2TM (BinOpr opr) { + lua_assert(OPR_ADD <= opr && opr <= OPR_SHR); + return cast(TMS, (cast_int(opr) - cast_int(OPR_ADD)) + cast_int(TM_ADD)); +} + + /* ** Emit code for unary expressions that "produce values" ** (everything but 'not'). @@ -1380,7 +1492,7 @@ static void finishbinexpval (FuncState *fs, expdesc *e1, expdesc *e2, 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_codeABCk(fs, mmop, v1, v2, cast_int(event), flip); /* metamethod */ luaK_fixline(fs, line); } @@ -1389,15 +1501,15 @@ static void finishbinexpval (FuncState *fs, expdesc *e1, expdesc *e2, ** Emit code for binary expressions that "produce values" over ** two registers. */ -static void codebinexpval (FuncState *fs, OpCode op, +static void codebinexpval (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2, int line) { + OpCode op = binopr2op(opr, OPR_ADD, OP_ADD); int v2 = luaK_exp2anyreg(fs, e2); /* make sure 'e2' is in a register */ /* 'e1' must be already in a register or it is a constant */ lua_assert((VNIL <= e1->k && e1->k <= VKSTR) || e1->k == VNONRELOC || e1->k == VRELOC); 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)); + finishbinexpval(fs, e1, e2, op, v2, 0, line, OP_MMBIN, binopr2TM(opr)); } @@ -1418,9 +1530,9 @@ static void codebini (FuncState *fs, OpCode op, */ static void codebinK (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2, int flip, int line) { - TMS event = cast(TMS, opr + TM_ADD); + TMS event = binopr2TM(opr); int v2 = e2->u.info; /* K index */ - OpCode op = cast(OpCode, opr + OP_ADDK); + OpCode op = binopr2op(opr, OPR_ADD, OP_ADDK); finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK, event); } @@ -1430,7 +1542,7 @@ static void codebinK (FuncState *fs, BinOpr opr, */ static int finishbinexpneg (FuncState *fs, expdesc *e1, expdesc *e2, OpCode op, int line, TMS event) { - if (!luaK_isKint(e2)) + if (!isKint(e2)) return 0; /* not an integer constant */ else { lua_Integer i2 = e2->u.ival; @@ -1457,10 +1569,9 @@ static void swapexps (expdesc *e1, expdesc *e2) { */ static void codebinNoK (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2, int flip, int line) { - 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 */ + codebinexpval(fs, opr, e1, e2, line); /* use standard operators */ } @@ -1490,7 +1601,7 @@ static void codecommutative (FuncState *fs, BinOpr op, flip = 1; } if (op == OPR_ADD && isSCint(e2)) /* immediate operand? */ - codebini(fs, cast(OpCode, OP_ADDI), e1, e2, flip, line, TM_ADD); + codebini(fs, OP_ADDI, e1, e2, flip, line, TM_ADD); else codearith(fs, op, e1, e2, flip, line); } @@ -1518,25 +1629,27 @@ static void codebitwise (FuncState *fs, BinOpr opr, ** 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) { +static void codeorder (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) { int r1, r2; int im; int isfloat = 0; + OpCode op; if (isSCnumber(e2, &im, &isfloat)) { /* use immediate operand */ r1 = luaK_exp2anyreg(fs, e1); r2 = im; - op = cast(OpCode, (op - OP_LT) + OP_LTI); + op = binopr2op(opr, OPR_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; + op = binopr2op(opr, OPR_LT, OP_GTI); } else { /* regular case, compare two registers */ r1 = luaK_exp2anyreg(fs, e1); r2 = luaK_exp2anyreg(fs, e2); + op = binopr2op(opr, OPR_LT, OP_LT); } freeexps(fs, e1, e2); e1->u.info = condjump(fs, op, r1, r2, isfloat, 1); @@ -1562,7 +1675,7 @@ static void codeeq (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) { op = OP_EQI; r2 = im; /* immediate operand */ } - else if (luaK_exp2RK(fs, e2)) { /* 2nd expression is constant? */ + else if (exp2RK(fs, e2)) { /* 2nd expression is constant? */ op = OP_EQK; r2 = e2->u.info; /* constant index */ } @@ -1579,16 +1692,16 @@ static void codeeq (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) { /* ** Apply prefix operation 'op' to expression 'e'. */ -void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) { +void luaK_prefix (FuncState *fs, UnOpr opr, expdesc *e, int line) { static const expdesc ef = {VKINT, {0}, NO_JUMP, NO_JUMP}; luaK_dischargevars(fs, e); - switch (op) { + switch (opr) { case OPR_MINUS: case OPR_BNOT: /* use 'ef' as fake 2nd operand */ - if (constfolding(fs, op + LUA_OPUNM, e, &ef)) + if (constfolding(fs, cast_int(opr + LUA_OPUNM), e, &ef)) break; /* else */ /* FALLTHROUGH */ case OPR_LEN: - codeunexpval(fs, cast(OpCode, op + OP_UNM), e, line); + codeunexpval(fs, unopr2op(opr), e, line); break; case OPR_NOT: codenot(fs, e); break; default: lua_assert(0); @@ -1628,7 +1741,7 @@ void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) { } case OPR_EQ: case OPR_NE: { if (!tonumeral(v, NULL)) - luaK_exp2RK(fs, v); + exp2RK(fs, v); /* else keep numeral, which may be an immediate operand */ break; } @@ -1672,7 +1785,7 @@ static void codeconcat (FuncState *fs, expdesc *e1, expdesc *e2, int line) { void luaK_posfix (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2, int line) { luaK_dischargevars(fs, e2); - if (foldbinop(opr) && constfolding(fs, opr + LUA_OPADD, e1, e2)) + if (foldbinop(opr) && constfolding(fs, cast_int(opr + LUA_OPADD), e1, e2)) return; /* done by folding */ switch (opr) { case OPR_AND: { @@ -1718,30 +1831,27 @@ void luaK_posfix (FuncState *fs, BinOpr opr, /* coded as (r1 >> -I) */; } else /* regular case (two registers) */ - codebinexpval(fs, OP_SHL, e1, e2, line); + codebinexpval(fs, opr, 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); + codebinexpval(fs, opr, 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); + opr = cast(BinOpr, (opr - OPR_GT) + OPR_LT); + } /* FALLTHROUGH */ + case OPR_LT: case OPR_LE: { + codeorder(fs, opr, e1, e2); break; } default: lua_assert(0); @@ -1761,11 +1871,11 @@ void luaK_fixline (FuncState *fs, int 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 extra = asize / (MAXARG_vC + 1); /* higher bits of array size */ + int rc = asize % (MAXARG_vC + 1); /* lower bits of array size */ int k = (extra > 0); /* true iff needs extra argument */ - *inst = CREATE_ABCk(OP_NEWTABLE, ra, rb, rc, k); + hsize = (hsize != 0) ? luaO_ceillog2(cast_uint(hsize)) + 1 : 0; + *inst = CREATE_vABCk(OP_NEWTABLE, ra, hsize, rc, k); *(inst + 1) = CREATE_Ax(OP_EXTRAARG, extra); } @@ -1778,18 +1888,18 @@ void luaK_settablesize (FuncState *fs, int pc, int ra, int asize, int hsize) { ** table (or LUA_MULTRET to add up to stack top). */ void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) { - lua_assert(tostore != 0 && tostore <= LFIELDS_PER_FLUSH); + lua_assert(tostore != 0); if (tostore == LUA_MULTRET) tostore = 0; - if (nelems <= MAXARG_C) - luaK_codeABC(fs, OP_SETLIST, base, tostore, nelems); + if (nelems <= MAXARG_vC) + luaK_codevABCk(fs, OP_SETLIST, base, tostore, nelems, 0); else { - int extra = nelems / (MAXARG_C + 1); - nelems %= (MAXARG_C + 1); - luaK_codeABCk(fs, OP_SETLIST, base, tostore, nelems, 1); + int extra = nelems / (MAXARG_vC + 1); + nelems %= (MAXARG_vC + 1); + luaK_codevABCk(fs, OP_SETLIST, base, tostore, nelems, 1); codeextraarg(fs, extra); } - fs->freereg = base + 1; /* free registers with list values */ + fs->freereg = cast_byte(base + 1); /* free registers with list values */ } @@ -1802,8 +1912,8 @@ static int finaltarget (Instruction *code, int i) { Instruction pc = code[i]; if (GET_OPCODE(pc) != OP_JMP) break; - else - i += GETARG_sJ(pc) + 1; + else + i += GETARG_sJ(pc) + 1; } return i; } @@ -1813,15 +1923,18 @@ static int finaltarget (Instruction *code, int i) { ** Do a final pass over the code of a function, doing small peephole ** optimizations and adjustments. */ +#include "lopnames.h" 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)); + /* avoid "not used" warnings when assert is off (for 'onelua.c') */ + (void)luaP_isOT; (void)luaP_isIT; + lua_assert(i == 0 || luaP_isOT(*(pc - 1)) == luaP_isIT(*pc)); switch (GET_OPCODE(*pc)) { case OP_RETURN0: case OP_RETURN1: { - if (!(fs->needclose || p->is_vararg)) + if (!(fs->needclose || (p->flag & PF_ISVARARG))) break; /* no extra work */ /* else use OP_RETURN to do the extra work */ SET_OPCODE(*pc, OP_RETURN); @@ -1829,13 +1942,18 @@ void luaK_finish (FuncState *fs) { case OP_RETURN: case OP_TAILCALL: { if (fs->needclose) SETARG_k(*pc, 1); /* signal that it needs to close */ - if (p->is_vararg) + if (p->flag & PF_ISVARARG) SETARG_C(*pc, p->numparams + 1); /* signal that it is vararg */ break; } - case OP_JMP: { + case OP_GETVARG: { + if (p->flag & PF_VATAB) /* function has a vararg table? */ + SET_OPCODE(*pc, OP_GETTABLE); /* must get vararg there */ + break; + } + case OP_JMP: { /* to optimize jumps to jumps */ int target = finaltarget(p->code, i); - fixjump(fs, i, target); + fixjump(fs, i, target); /* jump directly to final target */ break; } default: break; diff --git a/lcode.h b/lcode.h index 3265824452..09e5c802b0 100644 --- a/lcode.h +++ b/lcode.h @@ -60,27 +60,28 @@ typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr; #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_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_codeABx (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_codevABCk (FuncState *fs, OpCode o, int A, int B, int C, + int k); 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_codecheckglobal (FuncState *fs, expdesc *var, int k, + int line); LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n); LUAI_FUNC void luaK_checkstack (FuncState *fs, int n); LUAI_FUNC void luaK_int (FuncState *fs, int reg, lua_Integer n); +LUAI_FUNC void luaK_vapar2local (FuncState *fs, expdesc *var); LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e); LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e); -LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key); LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k); LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e); LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults); LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e); @@ -98,7 +99,7 @@ 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); +LUAI_FUNC l_noret luaK_semerror (LexState *ls, const char *fmt, ...); #endif diff --git a/lcorolib.c b/lcorolib.c index 40b880b14d..23dd844156 100644 --- a/lcorolib.c +++ b/lcorolib.c @@ -16,6 +16,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" static lua_State *getco (lua_State *L) { @@ -76,7 +77,7 @@ static int luaB_auxwrap (lua_State *L) { if (l_unlikely(r < 0)) { /* error? */ int stat = lua_status(co); if (stat != LUA_OK && stat != LUA_YIELD) { /* error in the coroutine? */ - stat = lua_resetthread(co, L); /* close its tbc variables */ + stat = lua_closethread(co, L); /* close its tbc variables */ lua_assert(stat != LUA_OK); lua_xmove(co, L, 1); /* move error message to the caller */ } @@ -153,8 +154,13 @@ static int luaB_costatus (lua_State *L) { } +static lua_State *getoptco (lua_State *L) { + return (lua_isnone(L, 1) ? L : getco(L)); +} + + static int luaB_yieldable (lua_State *L) { - lua_State *co = lua_isnone(L, 1) ? L : getco(L); + lua_State *co = getoptco(L); lua_pushboolean(L, lua_isyieldable(co)); return 1; } @@ -168,11 +174,11 @@ static int luaB_corunning (lua_State *L) { static int luaB_close (lua_State *L) { - lua_State *co = getco(L); + lua_State *co = getoptco(L); int status = auxstatus(L, co); switch (status) { case COS_DEAD: case COS_YIELD: { - status = lua_resetthread(co, L); + status = lua_closethread(co, L); if (status == LUA_OK) { lua_pushboolean(L, 1); return 1; @@ -183,6 +189,13 @@ static int luaB_close (lua_State *L) { return 2; } } + case COS_RUN: /* running coroutine? */ + lua_geti(L, LUA_REGISTRYINDEX, LUA_RIDX_MAINTHREAD); /* get main */ + if (lua_tothread(L, -1) == co) + return luaL_error(L, "cannot close main thread"); + lua_closethread(co, L); /* close itself */ + lua_assert(0); /* previous call does not return */ + return 0; default: /* normal or running coroutine */ return luaL_error(L, "cannot close a %s coroutine", statname[status]); } diff --git a/lctype.c b/lctype.c index 9542280942..b1a43e44b0 100644 --- a/lctype.c +++ b/lctype.c @@ -18,7 +18,7 @@ #if defined (LUA_UCID) /* accept UniCode IDentifiers? */ -/* consider all non-ascii codepoints to be alphabetic */ +/* consider all non-ASCII codepoints to be alphabetic */ #define NONA 0x01 #else #define NONA 0x00 /* default */ diff --git a/ldblib.c b/ldblib.c index 6dcbaa9824..c7b74812e8 100644 --- a/ldblib.c +++ b/ldblib.c @@ -18,6 +18,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" /* @@ -190,8 +191,10 @@ static int db_getinfo (lua_State *L) { settabsi(L, "ftransfer", ar.ftransfer); settabsi(L, "ntransfer", ar.ntransfer); } - if (strchr(options, 't')) + if (strchr(options, 't')) { settabsb(L, "istailcall", ar.istailcall); + settabsi(L, "extraargs", ar.extraargs); + } if (strchr(options, 'L')) treatstackoption(L, L1, "activelines"); if (strchr(options, 'f')) @@ -446,14 +449,6 @@ static int db_traceback (lua_State *L) { } -static int db_setcstacklimit (lua_State *L) { - int limit = (int)luaL_checkinteger(L, 1); - int res = lua_setcstacklimit(L, limit); - lua_pushinteger(L, res); - return 1; -} - - static const luaL_Reg dblib[] = { {"debug", db_debug}, {"getuservalue", db_getuservalue}, @@ -471,7 +466,6 @@ static const luaL_Reg dblib[] = { {"setmetatable", db_setmetatable}, {"setupvalue", db_setupvalue}, {"traceback", db_traceback}, - {"setcstacklimit", db_setcstacklimit}, {NULL, NULL} }; diff --git a/ldebug.c b/ldebug.c index 3fae5cf25d..abead91ce6 100644 --- a/ldebug.c +++ b/ldebug.c @@ -31,8 +31,10 @@ -#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_VCCL) +#define LuaClosure(f) ((f) != NULL && (f)->c.tt == LUA_VLCL) +static const char strlocal[] = "local"; +static const char strupval[] = "upvalue"; static const char *funcnamefromcall (lua_State *L, CallInfo *ci, const char **name); @@ -63,7 +65,7 @@ static int getbaseline (const Proto *f, int pc, int *basepc) { return f->linedefined; } else { - int i = cast_uint(pc) / MAXIWTHABS - 1; /* get an estimate */ + int i = pc / MAXIWTHABS - 1; /* get an estimate */ /* estimate must be a lower bound of the correct base */ lua_assert(i < 0 || (i < f->sizeabslineinfo && f->abslineinfo[i].pc <= pc)); @@ -182,7 +184,7 @@ static const char *upvalname (const Proto *p, int uv) { static const char *findvararg (CallInfo *ci, int n, StkId *pos) { - if (clLvalue(s2v(ci->func.p))->p->is_vararg) { + if (clLvalue(s2v(ci->func.p))->p->flag & PF_ISVARARG) { int nextra = ci->u.l.nextraargs; if (n >= -nextra) { /* 'n' is negative */ *pos = ci->func.p - nextra - (n + 1); @@ -245,6 +247,7 @@ LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { lua_lock(L); name = luaG_findlocal(L, ar->i_ci, n, &pos); if (name) { + api_checkpop(L, 1); setobjs2s(L, pos, L->top.p - 1); L->top.p--; /* pop value */ } @@ -254,7 +257,7 @@ LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { static void funcinfo (lua_Debug *ar, Closure *cl) { - if (noLuaClosure(cl)) { + if (!LuaClosure(cl)) { ar->source = "=[C]"; ar->srclen = LL("=[C]"); ar->linedefined = -1; @@ -264,8 +267,7 @@ static void funcinfo (lua_Debug *ar, Closure *cl) { else { const Proto *p = cl->l.p; if (p->source) { - ar->source = getstr(p->source); - ar->srclen = tsslen(p->source); + ar->source = getlstr(p->source, ar->srclen); } else { ar->source = "=?"; @@ -288,29 +290,31 @@ static int nextline (const Proto *p, int currentline, int pc) { static void collectvalidlines (lua_State *L, Closure *f) { - if (noLuaClosure(f)) { + if (!LuaClosure(f)) { setnilvalue(s2v(L->top.p)); api_incr_top(L); } else { - int i; - TValue v; const Proto *p = f->l.p; int currentline = p->linedefined; Table *t = luaH_new(L); /* new table to store active lines */ sethvalue2s(L, L->top.p, t); /* push it on stack */ api_incr_top(L); - setbtvalue(&v); /* boolean 'true' to be the value of all indices */ - if (!p->is_vararg) /* regular function? */ - i = 0; /* consider all instructions */ - else { /* vararg function */ - lua_assert(GET_OPCODE(p->code[0]) == OP_VARARGPREP); - currentline = nextline(p, currentline, 0); - i = 1; /* skip first instruction (OP_VARARGPREP) */ - } - for (; i < p->sizelineinfo; i++) { /* for each instruction */ - currentline = nextline(p, currentline, i); /* get its line */ - luaH_setint(L, t, currentline, &v); /* table[line] = true */ + if (p->lineinfo != NULL) { /* proto with debug information? */ + int i; + TValue v; + setbtvalue(&v); /* boolean 'true' to be the value of all indices */ + if (!(p->flag & PF_ISVARARG)) /* regular function? */ + i = 0; /* consider all instructions */ + else { /* vararg function */ + lua_assert(GET_OPCODE(p->code[0]) == OP_VARARGPREP); + currentline = nextline(p, currentline, 0); + i = 1; /* skip first instruction (OP_VARARGPREP) */ + } + for (; i < p->sizelineinfo; i++) { /* for each instruction */ + currentline = nextline(p, currentline, i); /* get its line */ + luaH_setint(L, t, currentline, &v); /* table[line] = true */ + } } } } @@ -339,18 +343,26 @@ static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, } case 'u': { ar->nups = (f == NULL) ? 0 : f->c.nupvalues; - if (noLuaClosure(f)) { + if (!LuaClosure(f)) { ar->isvararg = 1; ar->nparams = 0; } else { - ar->isvararg = f->l.p->is_vararg; + ar->isvararg = (f->l.p->flag & PF_ISVARARG) ? 1 : 0; ar->nparams = f->l.p->numparams; } break; } case 't': { - ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0; + if (ci != NULL) { + ar->istailcall = !!(ci->callstatus & CIST_TAIL); + ar->extraargs = + cast_uchar((ci->callstatus & MAX_CCMT) >> CIST_CCMT); + } + else { + ar->istailcall = 0; + ar->extraargs = 0; + } break; } case 'n': { @@ -362,11 +374,11 @@ static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, break; } case 'r': { - if (ci == NULL || !(ci->callstatus & CIST_TRAN)) + if (ci == NULL || !(ci->callstatus & CIST_HOOKED)) ar->ftransfer = ar->ntransfer = 0; else { - ar->ftransfer = ci->u2.transferinfo.ftransfer; - ar->ntransfer = ci->u2.transferinfo.ntransfer; + ar->ftransfer = L->transferinfo.ftransfer; + ar->ntransfer = L->transferinfo.ntransfer; } break; } @@ -417,40 +429,6 @@ LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { ** ======================================================= */ -static const char *getobjname (const Proto *p, int lastpc, int reg, - const char **name); - - -/* -** Find a "name" for the constant 'c'. -*/ -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); -} - static int filterpc (int pc, int jmptarget) { if (pc < jmptarget) /* is code conditional (inside a jump)? */ @@ -509,28 +487,29 @@ static int findsetreg (const Proto *p, int lastpc, int reg) { /* -** Check whether table being indexed by instruction 'i' is the -** environment '_ENV' +** Find a "name" for the constant 'c'. */ -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 *kname (const Proto *p, int index, const char **name) { + TValue *kvalue = &p->k[index]; + if (ttisstring(kvalue)) { + *name = getstr(tsvalue(kvalue)); + return "constant"; + } + else { + *name = "?"; + return NULL; + } } -static const char *getobjname (const Proto *p, int lastpc, int reg, - const char **name) { - int pc; - *name = luaF_getlocalname(p, reg + 1, lastpc); +static const char *basicgetobjname (const Proto *p, int *ppc, int reg, + const char **name) { + int pc = *ppc; + *name = luaF_getlocalname(p, reg + 1, pc); if (*name) /* is a local? */ - return "local"; + return strlocal; /* else try symbolic execution */ - pc = findsetreg(p, lastpc, reg); + *ppc = pc = findsetreg(p, pc, reg); if (pc != -1) { /* could find instruction? */ Instruction i = p->code[pc]; OpCode op = GET_OPCODE(i); @@ -538,18 +517,73 @@ static const char *getobjname (const Proto *p, int lastpc, int reg, case OP_MOVE: { int b = GETARG_B(i); /* move from 'b' to 'a' */ if (b < GETARG_A(i)) - return getobjname(p, pc, b, name); /* get name for 'b' */ + return basicgetobjname(p, ppc, b, name); /* get name for 'b' */ break; } + case OP_GETUPVAL: { + *name = upvalname(p, GETARG_B(i)); + return strupval; + } + case OP_LOADK: return kname(p, GETARG_Bx(i), name); + case OP_LOADKX: return kname(p, GETARG_Ax(p->code[pc + 1]), name); + default: break; + } + } + return NULL; /* could not find reasonable name */ +} + + +/* +** Find a "name" for the register 'c'. +*/ +static void rname (const Proto *p, int pc, int c, const char **name) { + const char *what = basicgetobjname(p, &pc, c, name); /* search for 'c' */ + if (!(what && *what == 'c')) /* did not find a constant name? */ + *name = "?"; +} + + +/* +** Check whether table being indexed by instruction 'i' is the +** environment '_ENV' +*/ +static const char *isEnv (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 't' an upvalue? */ + name = upvalname(p, t); + else { /* 't' is a register */ + const char *what = basicgetobjname(p, &pc, t, &name); + /* 'name' must be the name of a local variable (at the current + level or an upvalue) */ + if (what != strlocal && what != strupval) + name = NULL; /* cannot be the variable _ENV */ + } + return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field"; +} + + +/* +** Extend 'basicgetobjname' to handle table accesses +*/ +static const char *getobjname (const Proto *p, int lastpc, int reg, + const char **name) { + const char *kind = basicgetobjname(p, &lastpc, reg, name); + if (kind != NULL) + return kind; + else if (lastpc != -1) { /* could find instruction? */ + Instruction i = p->code[lastpc]; + OpCode op = GET_OPCODE(i); + switch (op) { case OP_GETTABUP: { int k = GETARG_C(i); /* key index */ kname(p, k, name); - return gxf(p, pc, i, 1); + return isEnv(p, lastpc, i, 1); } case OP_GETTABLE: { int k = GETARG_C(i); /* key index */ - rname(p, pc, k, name); - return gxf(p, pc, i, 0); + rname(p, lastpc, k, name); + return isEnv(p, lastpc, i, 0); } case OP_GETI: { *name = "integer index"; @@ -558,24 +592,11 @@ static const char *getobjname (const Proto *p, int lastpc, int reg, 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)); - return "upvalue"; - } - case OP_LOADK: - case OP_LOADKX: { - int b = (op == OP_LOADK) ? GETARG_Bx(i) - : GETARG_Ax(p->code[pc + 1]); - if (ttisstring(&p->k[b])) { - *name = svalue(&p->k[b]); - return "constant"; - } - break; + return isEnv(p, lastpc, i, 0); } case OP_SELF: { - rkname(p, pc, i, name); + int k = GETARG_C(i); /* key index */ + kname(p, k, name); return "method"; } default: break; /* go through to return NULL */ @@ -627,7 +648,7 @@ static const char *funcnamefromcode (lua_State *L, const Proto *p, default: return NULL; /* cannot find a reasonable name */ } - *name = getstr(G(L)->tmname[tm]) + 2; + *name = getshrstr(G(L)->tmname[tm]) + 2; return "metamethod"; } @@ -656,18 +677,19 @@ static const char *funcnamefromcall (lua_State *L, CallInfo *ci, /* -** Check whether pointer 'o' points to some value in the stack -** frame of the current function. Because 'o' may not point to a -** value in this stack, we cannot compare it with the region -** boundaries (undefined behaviour in ISO C). +** Check whether pointer 'o' points to some value in the stack frame of +** the current function and, if so, returns its index. Because 'o' may +** not point to a value in this stack, we cannot compare it with the +** region boundaries (undefined behavior in ISO C). */ -static int isinstack (CallInfo *ci, const TValue *o) { - StkId pos; - for (pos = ci->func.p + 1; pos < ci->top.p; pos++) { - if (o == s2v(pos)) - return 1; +static int instack (CallInfo *ci, const TValue *o) { + int pos; + StkId base = ci->func.p + 1; + for (pos = 0; base + pos < ci->top.p; pos++) { + if (o == s2v(base + pos)) + return pos; } - return 0; /* not found */ + return -1; /* not found */ } @@ -683,7 +705,7 @@ static const char *getupvalname (CallInfo *ci, const TValue *o, for (i = 0; i < c->nupvalues; i++) { if (c->upvals[i]->v.p == o) { *name = upvalname(c->p, i); - return "upvalue"; + return strupval; } } return NULL; @@ -708,9 +730,11 @@ static const char *varinfo (lua_State *L, const TValue *o) { const char *kind = NULL; if (isLua(ci)) { kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */ - if (!kind && isinstack(ci, o)) /* no? try a register */ - kind = getobjname(ci_func(ci)->p, currentpc(ci), - cast_int(cast(StkId, o) - (ci->func.p + 1)), &name); + if (!kind) { /* not an upvalue? */ + int reg = instack(ci, o); /* try a register */ + if (reg >= 0) /* is 'o' a register? */ + kind = getobjname(ci_func(ci)->p, currentpc(ci), reg, &name); + } } return formatvarinfo(L, kind, name); } @@ -790,16 +814,26 @@ l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) { } +l_noret luaG_errnnil (lua_State *L, LClosure *cl, int k) { + const char *globalname = "?"; /* default name if k == 0 */ + if (k > 0) + kname(cl->p, k - 1, &globalname); + luaG_runerror(L, "global '%s' already defined", globalname); +} + + /* add src:line information to 'msg' */ const char *luaG_addinfo (lua_State *L, const char *msg, TString *src, int line) { - char buff[LUA_IDSIZE]; - if (src) - luaO_chunkid(buff, getstr(src), tsslen(src)); - else { /* no source available; use "?" instead */ - buff[0] = '?'; buff[1] = '\0'; + if (src == NULL) /* no debug information? */ + return luaO_pushfstring(L, "?:?: %s", msg); + else { + char buff[LUA_IDSIZE]; + size_t idlen; + const char *id = getlstr(src, idlen); + luaO_chunkid(buff, id, idlen); + return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); } - return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); } @@ -812,6 +846,10 @@ l_noret luaG_errormsg (lua_State *L) { L->top.p++; /* assume EXTRA_STACK */ luaD_callnoyield(L, L->top.p - 2, 1); /* call it */ } + if (ttisnil(s2v(L->top.p - 1))) { /* error object is nil? */ + /* change it to a proper message */ + setsvalue2s(L, L->top.p - 1, luaS_newliteral(L, "")); + } luaD_throw(L, LUA_ERRRUN); } @@ -821,10 +859,9 @@ l_noret luaG_runerror (lua_State *L, const char *fmt, ...) { const char *msg; va_list argp; luaC_checkGC(L); /* error message uses memory */ - va_start(argp, fmt); - msg = luaO_pushvfstring(L, fmt, argp); /* format message */ - va_end(argp); - if (isLua(ci)) { /* if Lua function, add source:line information */ + pushvfstring(L, argp, fmt, msg); + if (isLua(ci)) { /* Lua function? */ + /* add source:line information */ luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci)); setobjs2s(L, L->top.p - 2, L->top.p - 1); /* remove 'msg' */ L->top.p--; @@ -845,7 +882,7 @@ static int changedline (const Proto *p, int oldpc, int newpc) { if (p->lineinfo == NULL) /* no debug information? */ return 0; if (newpc - oldpc < MAXIWTHABS / 2) { /* not too far apart? */ - int delta = 0; /* line diference */ + int delta = 0; /* line difference */ int pc = oldpc; for (;;) { int lineinfo = p->lineinfo[++pc]; @@ -862,6 +899,28 @@ static int changedline (const Proto *p, int oldpc, int newpc) { } +/* +** Traces Lua calls. If code is running the first instruction of a function, +** and function is not vararg, and it is not coming from an yield, +** calls 'luaD_hookcall'. (Vararg functions will call 'luaD_hookcall' +** after adjusting its variable arguments; otherwise, they could call +** a line/count hook before the call hook. Functions coming from +** an yield already called 'luaD_hookcall' before yielding.) +*/ +int luaG_tracecall (lua_State *L) { + CallInfo *ci = L->ci; + Proto *p = ci_func(ci)->p; + ci->u.l.trap = 1; /* ensure hooks will be checked */ + if (ci->u.l.savedpc == p->code) { /* first instruction (not resuming)? */ + if (p->flag & PF_ISVARARG) + return 0; /* hooks will start at VARARGPREP instruction */ + else if (!(ci->callstatus & CIST_HOOKYIELD)) /* not yielded? */ + luaD_hookcall(L, ci); /* check 'call' hook */ + } + return 1; /* keep 'trap' on */ +} + + /* ** Traces the execution of a Lua function. Called before the execution ** of each opcode, when debug is on. 'L->oldpc' stores the last @@ -876,7 +935,7 @@ static int changedline (const Proto *p, int oldpc, int newpc) { */ int luaG_traceexec (lua_State *L, const Instruction *pc) { CallInfo *ci = L->ci; - lu_byte mask = L->hookmask; + lu_byte mask = cast_byte(L->hookmask); const Proto *p = ci_func(ci)->p; int counthook; if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */ @@ -885,16 +944,16 @@ int luaG_traceexec (lua_State *L, const Instruction *pc) { } pc++; /* reference is always next instruction */ ci->u.l.savedpc = pc; /* save 'pc' */ - counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT)); + counthook = (mask & LUA_MASKCOUNT) && (--L->hookcount == 0); if (counthook) resethookcount(L); /* reset count */ else if (!(mask & LUA_MASKLINE)) return 1; /* no line hook and count != 0; nothing to be done now */ - if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */ + if (ci->callstatus & CIST_HOOKYIELD) { /* hook yielded last time? */ ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */ return 1; /* do not call hook again (VM yielded, so it did not move) */ } - if (!isIT(*(ci->u.l.savedpc - 1))) /* top not being used? */ + if (!luaP_isIT(*(ci->u.l.savedpc - 1))) /* top not being used? */ L->top.p = ci->top.p; /* correct top */ if (counthook) luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */ @@ -912,7 +971,6 @@ int luaG_traceexec (lua_State *L, const Instruction *pc) { 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 */ luaD_throw(L, LUA_YIELD); } diff --git a/ldebug.h b/ldebug.h index 2c3074c61b..20d07818b4 100644 --- a/ldebug.h +++ b/ldebug.h @@ -53,11 +53,13 @@ LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2); LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2); +LUAI_FUNC l_noret luaG_errnnil (lua_State *L, LClosure *cl, int k); LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...); 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 int luaG_traceexec (lua_State *L, const Instruction *pc); +LUAI_FUNC int luaG_tracecall (lua_State *L); #endif diff --git a/ldo.c b/ldo.c index c30cde76f5..44937068f8 100644 --- a/ldo.c +++ b/ldo.c @@ -38,16 +38,37 @@ #define errorstatus(s) ((s) > LUA_YIELD) +/* +** these macros allow user-specific actions when a thread is +** resumed/yielded. +*/ +#if !defined(luai_userstateresume) +#define luai_userstateresume(L,n) ((void)L) +#endif + +#if !defined(luai_userstateyield) +#define luai_userstateyield(L,n) ((void)L) +#endif + + /* ** {====================================================== ** Error-recovery functions ** ======================================================= */ +/* chained list of long jump buffers */ +typedef struct lua_longjmp { + struct lua_longjmp *previous; + jmp_buf b; + volatile TStatus status; /* error code */ +} lua_longjmp; + + /* ** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By ** default, Lua handles errors with exceptions when compiling as -** C++ code, with _longjmp/_setjmp when asked to use them, and with +** C++ code, with _longjmp/_setjmp when available (POSIX), and with ** longjmp/setjmp otherwise. */ #if !defined(LUAI_THROW) /* { */ @@ -56,73 +77,64 @@ /* C++ exceptions */ #define LUAI_THROW(L,c) throw(c) -#define LUAI_TRY(L,c,a) \ - try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; } -#define luai_jmpbuf int /* dummy variable */ + +static void LUAI_TRY (lua_State *L, lua_longjmp *c, Pfunc f, void *ud) { + try { + f(L, ud); /* call function protected */ + } + catch (lua_longjmp *c1) { /* Lua error */ + if (c1 != c) /* not the correct level? */ + throw; /* rethrow to upper level */ + } + catch (...) { /* non-Lua exception */ + c->status = -1; /* create some error code */ + } +} + #elif defined(LUA_USE_POSIX) /* }{ */ -/* in POSIX, try _longjmp/_setjmp (more efficient) */ +/* in POSIX, use _longjmp/_setjmp (more efficient) */ #define LUAI_THROW(L,c) _longjmp((c)->b, 1) -#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a } -#define luai_jmpbuf jmp_buf +#define LUAI_TRY(L,c,f,ud) if (_setjmp((c)->b) == 0) ((f)(L, ud)) #else /* }{ */ /* ISO C handling with long jumps */ #define LUAI_THROW(L,c) longjmp((c)->b, 1) -#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a } -#define luai_jmpbuf jmp_buf +#define LUAI_TRY(L,c,f,ud) if (setjmp((c)->b) == 0) ((f)(L, ud)) #endif /* } */ #endif /* } */ - -/* chain list of long jump buffers */ -struct lua_longjmp { - struct lua_longjmp *previous; - luai_jmpbuf b; - volatile int status; /* error code */ -}; - - -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. */ - break; - } - case LUA_ERRERR: { - setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling")); - break; - } - case LUA_OK: { /* special case only for closing upvalues */ - setnilvalue(s2v(oldtop)); /* no error message */ - break; - } - default: { - lua_assert(errorstatus(errcode)); /* real error */ - setobjs2s(L, oldtop, L->top.p - 1); /* error message on current top */ - break; - } +void luaD_seterrorobj (lua_State *L, TStatus errcode, StkId oldtop) { + if (errcode == LUA_ERRMEM) { /* memory error? */ + setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */ + } + else { + lua_assert(errorstatus(errcode)); /* must be a real error */ + lua_assert(!ttisnil(s2v(L->top.p - 1))); /* with a non-nil object */ + setobjs2s(L, oldtop, L->top.p - 1); /* move it to 'oldtop' */ } - L->top.p = oldtop + 1; + L->top.p = oldtop + 1; /* top goes back to old top plus error object */ } -l_noret luaD_throw (lua_State *L, int errcode) { +l_noret luaD_throw (lua_State *L, TStatus errcode) { if (L->errorJmp) { /* thread has an error handler? */ L->errorJmp->status = errcode; /* set status */ LUAI_THROW(L, L->errorJmp); /* jump to it */ } else { /* thread has no error handler */ global_State *g = G(L); + lua_State *mainth = mainthread(g); errcode = luaE_resetthread(L, errcode); /* close all upvalues */ - if (g->mainthread->errorJmp) { /* main thread has a handler? */ - setobjs2s(L, g->mainthread->top.p++, L->top.p - 1); /* copy error obj. */ - luaD_throw(g->mainthread, errcode); /* re-throw in main thread */ + L->status = errcode; + if (mainth->errorJmp) { /* main thread has a handler? */ + setobjs2s(L, mainth->top.p++, L->top.p - 1); /* copy error obj. */ + luaD_throw(mainth, errcode); /* re-throw in main thread */ } else { /* no handler at all; abort */ if (g->panic) { /* panic function? */ @@ -135,15 +147,23 @@ l_noret luaD_throw (lua_State *L, int errcode) { } -int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { +l_noret luaD_throwbaselevel (lua_State *L, TStatus errcode) { + if (L->errorJmp) { + /* unroll error entries up to the first level */ + while (L->errorJmp->previous != NULL) + L->errorJmp = L->errorJmp->previous; + } + luaD_throw(L, errcode); +} + + +TStatus luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { l_uint32 oldnCcalls = L->nCcalls; - struct lua_longjmp lj; + lua_longjmp lj; lj.status = LUA_OK; lj.previous = L->errorJmp; /* chain new error handler */ L->errorJmp = &lj; - LUAI_TRY(L, &lj, - (*f)(L, ud); - ); + LUAI_TRY(L, &lj, f, ud); /* call 'f' catching errors */ L->errorJmp = lj.previous; /* restore old error handler */ L->nCcalls = oldnCcalls; return lj.status; @@ -158,7 +178,63 @@ int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { ** =================================================================== */ +/* some stack space for error handling */ +#define STACKERRSPACE 200 + + +/* +** LUAI_MAXSTACK limits the size of the Lua stack. +** It must fit into INT_MAX/2. +*/ + +#if !defined(LUAI_MAXSTACK) +#if 1000000 < (INT_MAX / 2) +#define LUAI_MAXSTACK 1000000 +#else +#define LUAI_MAXSTACK (INT_MAX / 2u) +#endif +#endif + + +/* maximum stack size that respects size_t */ +#define MAXSTACK_BYSIZET ((MAX_SIZET / sizeof(StackValue)) - STACKERRSPACE) + +/* +** Minimum between LUAI_MAXSTACK and MAXSTACK_BYSIZET +** (Maximum size for the stack must respect size_t.) +*/ +#define MAXSTACK cast_int(LUAI_MAXSTACK < MAXSTACK_BYSIZET \ + ? LUAI_MAXSTACK : MAXSTACK_BYSIZET) + + +/* stack size with extra space for error handling */ +#define ERRORSTACKSIZE (MAXSTACK + STACKERRSPACE) + + +/* raise a stack error while running the message handler */ +l_noret luaD_errerr (lua_State *L) { + TString *msg = luaS_newliteral(L, "error in error handling"); + setsvalue2s(L, L->top.p, msg); + L->top.p++; /* assume EXTRA_STACK */ + luaD_throw(L, LUA_ERRERR); +} + + +/* +** In ISO C, any pointer use after the pointer has been deallocated is +** undefined behavior. So, before a stack reallocation, all pointers +** should be changed to offsets, and after the reallocation they should +** be changed back to pointers. As during the reallocation the pointers +** are invalid, the reallocation cannot run emergency collections. +** Alternatively, we can use the old address after the deallocation. +** That is not strict ISO C, but seems to work fine everywhere. +** The following macro chooses how strict is the code. +*/ +#if !defined(LUAI_STRICT_ADDRESS) +#define LUAI_STRICT_ADDRESS 1 +#endif +#if LUAI_STRICT_ADDRESS /* ** Change all pointers to the stack into offsets. */ @@ -179,9 +255,10 @@ static void relstack (lua_State *L) { /* ** Change back all offsets into pointers. */ -static void correctstack (lua_State *L) { +static void correctstack (lua_State *L, StkId oldstack) { CallInfo *ci; UpVal *up; + UNUSED(oldstack); L->top.p = restorestack(L, L->top.offset); L->tbclist.p = restorestack(L, L->tbclist.offset); for (up = L->openupval; up != NULL; up = up->u.open.next) @@ -194,18 +271,40 @@ static void correctstack (lua_State *L) { } } +#else +/* +** Assume that it is fine to use an address after its deallocation, +** as long as we do not dereference it. +*/ + +static void relstack (lua_State *L) { UNUSED(L); } /* do nothing */ + + +/* +** Correct pointers into 'oldstack' to point into 'L->stack'. +*/ +static void correctstack (lua_State *L, StkId oldstack) { + CallInfo *ci; + UpVal *up; + StkId newstack = L->stack.p; + if (oldstack == newstack) + return; + L->top.p = L->top.p - oldstack + newstack; + L->tbclist.p = L->tbclist.p - oldstack + newstack; + for (up = L->openupval; up != NULL; up = up->u.open.next) + up->v.p = s2v(uplevel(up) - oldstack + newstack); + for (ci = L->ci; ci != NULL; ci = ci->previous) { + ci->top.p = ci->top.p - oldstack + newstack; + ci->func.p = ci->func.p - oldstack + newstack; + if (isLua(ci)) + ci->u.l.trap = 1; /* signal to update 'trap' in 'luaV_execute' */ + } +} +#endif -/* some space for error handling */ -#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200) /* ** Reallocate the stack to a new size, correcting all pointers into it. -** In ISO C, any pointer use after the pointer has been deallocated is -** undefined behavior. So, before the reallocation, all pointers are -** changed to offsets, and after the reallocation they are changed back -** to pointers. As during the reallocation the pointers are invalid, the -** reallocation cannot run emergency collections. -** ** In case of allocation error, raise an error or return false according ** to 'raiseerror'. */ @@ -213,21 +312,22 @@ int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) { int oldsize = stacksize(L); int i; StkId newstack; - int oldgcstop = G(L)->gcstopem; - lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE); + StkId oldstack = L->stack.p; + lu_byte oldgcstop = G(L)->gcstopem; + lua_assert(newsize <= MAXSTACK || newsize == ERRORSTACKSIZE); relstack(L); /* change pointers to offsets */ G(L)->gcstopem = 1; /* stop emergency collection */ - newstack = luaM_reallocvector(L, L->stack.p, oldsize + EXTRA_STACK, + newstack = luaM_reallocvector(L, oldstack, oldsize + EXTRA_STACK, newsize + EXTRA_STACK, StackValue); G(L)->gcstopem = oldgcstop; /* restore emergency collection */ if (l_unlikely(newstack == NULL)) { /* reallocation failed? */ - correctstack(L); /* change offsets back to pointers */ + correctstack(L, oldstack); /* change offsets back to pointers */ if (raiseerror) luaM_error(L); else return 0; /* do not raise an error */ } L->stack.p = newstack; - correctstack(L); /* change offsets back to pointers */ + correctstack(L, oldstack); /* change offsets back to pointers */ L->stack_last.p = L->stack.p + newsize; for (i = oldsize + EXTRA_STACK; i < newsize + EXTRA_STACK; i++) setnilvalue(s2v(newstack + i)); /* erase new segment */ @@ -241,23 +341,23 @@ int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) { */ int luaD_growstack (lua_State *L, int n, int raiseerror) { int size = stacksize(L); - if (l_unlikely(size > LUAI_MAXSTACK)) { + if (l_unlikely(size > MAXSTACK)) { /* if stack is larger than maximum, thread is already using the extra space reserved for errors, that is, thread is handling a stack error; cannot grow further than that. */ lua_assert(stacksize(L) == ERRORSTACKSIZE); if (raiseerror) - luaD_throw(L, LUA_ERRERR); /* error inside message handler */ + luaD_errerr(L); /* stack error inside message handler */ return 0; /* if not 'raiseerror', just signal it */ } - else if (n < LUAI_MAXSTACK) { /* avoids arithmetic overflows */ - int newsize = 2 * size; /* tentative new size */ + else if (n < MAXSTACK) { /* avoids arithmetic overflows */ + int newsize = size + (size >> 1); /* tentative new size (size * 1.5) */ int needed = cast_int(L->top.p - L->stack.p) + n; - if (newsize > LUAI_MAXSTACK) /* cannot cross the limit */ - newsize = LUAI_MAXSTACK; + if (newsize > MAXSTACK) /* cannot cross the limit */ + newsize = MAXSTACK; if (newsize < needed) /* but must respect what was asked for */ newsize = needed; - if (l_likely(newsize <= LUAI_MAXSTACK)) + if (l_likely(newsize <= MAXSTACK)) return luaD_reallocstack(L, newsize, raiseerror); } /* else stack overflow */ @@ -293,32 +393,28 @@ static int stackinuse (lua_State *L) { ** to twice the current use. (So, the final stack size is at most 2/3 the ** previous size, and half of its entries are empty.) ** As a particular case, if stack was handling a stack overflow and now -** it is not, 'max' (limited by LUAI_MAXSTACK) will be smaller than +** it is not, 'max' (limited by MAXSTACK) will be smaller than ** stacksize (equal to ERRORSTACKSIZE in this case), and so the stack ** will be reduced to a "regular" size. */ void luaD_shrinkstack (lua_State *L) { int inuse = stackinuse(L); - int nsize = inuse * 2; /* proposed new size */ - int max = inuse * 3; /* maximum "reasonable" size */ - if (max > LUAI_MAXSTACK) { - max = LUAI_MAXSTACK; /* respect stack limit */ - if (nsize > LUAI_MAXSTACK) - nsize = LUAI_MAXSTACK; - } + int max = (inuse > MAXSTACK / 3) ? MAXSTACK : inuse * 3; /* if thread is currently not handling a stack overflow and its size is larger than maximum "reasonable" size, shrink it */ - if (inuse <= LUAI_MAXSTACK && stacksize(L) > max) + if (inuse <= MAXSTACK && stacksize(L) > max) { + int nsize = (inuse > MAXSTACK / 2) ? MAXSTACK : inuse * 2; luaD_reallocstack(L, nsize, 0); /* ok if that fails */ + } else /* don't change stack */ - condmovestack(L,{},{}); /* (change only for debugging) */ + condmovestack(L,(void)0,(void)0); /* (change only for debugging) */ luaE_shrinkCI(L); /* shrink CI list */ } void luaD_inctop (lua_State *L) { - luaD_checkstack(L, 1); L->top.p++; + luaD_checkstack(L, 1); } /* }================================================================== */ @@ -333,7 +429,6 @@ 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.p); /* preserve original 'top' */ ptrdiff_t ci_top = savestack(L, ci->top.p); /* idem for 'ci->top' */ @@ -341,18 +436,15 @@ void luaD_hook (lua_State *L, int event, int line, 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; - } + L->transferinfo.ftransfer = ftransfer; + L->transferinfo.ntransfer = ntransfer; if (isLua(ci) && L->top.p < ci->top.p) L->top.p = ci->top.p; /* protect entire activation register */ luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ if (ci->top.p < L->top.p + LUA_MINSTACK) ci->top.p = L->top.p + LUA_MINSTACK; L->allowhook = 0; /* cannot call hooks inside a hook */ - ci->callstatus |= mask; + ci->callstatus |= CIST_HOOKED; lua_unlock(L); (*hook)(L, &ar); lua_lock(L); @@ -360,7 +452,7 @@ void luaD_hook (lua_State *L, int event, int line, L->allowhook = 1; ci->top.p = restorestack(L, ci_top); L->top.p = restorestack(L, top); - ci->callstatus &= ~mask; + ci->callstatus &= ~CIST_HOOKED; } } @@ -395,11 +487,11 @@ static void rethook (lua_State *L, CallInfo *ci, int nres) { int ftransfer; if (isLua(ci)) { Proto *p = ci_func(ci)->p; - if (p->is_vararg) + if (p->flag & PF_ISVARARG) delta = ci->u.l.nextraargs + p->numparams + 1; } ci->func.p += delta; /* if vararg, back to virtual 'func' */ - ftransfer = cast(unsigned short, firstres - ci->func.p); + ftransfer = cast_int(firstres - ci->func.p); luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres); /* call it */ ci->func.p -= delta; } @@ -410,51 +502,72 @@ static void rethook (lua_State *L, CallInfo *ci, int nres) { /* ** Check whether 'func' has a '__call' metafield. If so, put it in the -** stack, below original 'func', so that 'luaD_precall' can call it. Raise -** an error if there is no '__call' metafield. +** stack, below original 'func', so that 'luaD_precall' can call it. +** Raise an error if there is no '__call' metafield. +** Bits CIST_CCMT in status count how many _call metamethods were +** invoked and how many corresponding extra arguments were pushed. +** (This count will be saved in the 'callstatus' of the call). +** Raise an error if this counter overflows. */ -StkId luaD_tryfuncTM (lua_State *L, StkId func) { +static unsigned tryfuncTM (lua_State *L, StkId func, unsigned status) { const TValue *tm; StkId p; - checkstackGCp(L, 1, func); /* space for metamethod */ - tm = luaT_gettmbyobj(L, s2v(func), TM_CALL); /* (after previous GC) */ - if (l_unlikely(ttisnil(tm))) - luaG_callerror(L, s2v(func)); /* nothing to call */ + tm = luaT_gettmbyobj(L, s2v(func), TM_CALL); + if (l_unlikely(ttisnil(tm))) /* no metamethod? */ + luaG_callerror(L, s2v(func)); for (p = L->top.p; p > func; p--) /* open space for metamethod */ setobjs2s(L, p, p-1); L->top.p++; /* stack space pre-allocated by the caller */ setobj2s(L, func, tm); /* metamethod is the new function to be called */ - return func; + if ((status & MAX_CCMT) == MAX_CCMT) /* is counter full? */ + luaG_runerror(L, "'__call' chain too long"); + return status + (1u << CIST_CCMT); /* increment counter */ +} + + +/* Generic case for 'moveresult' */ +l_sinline void genmoveresults (lua_State *L, StkId res, int nres, + int wanted) { + StkId firstresult = L->top.p - nres; /* index of first result */ + int i; + if (nres > wanted) /* extra results? */ + nres = wanted; /* don't need them */ + 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(s2v(res + i)); + L->top.p = res + wanted; /* top points after the last result */ } /* -** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'. -** Handle most typical cases (zero results for commands, one result for -** expressions, multiple results for tail calls/single parameters) -** separated. +** Given 'nres' results at 'firstResult', move 'fwanted-1' of them +** to 'res'. Handle most typical cases (zero results for commands, +** one result for expressions, multiple results for tail calls/single +** parameters) separated. The flag CIST_TBC in 'fwanted', if set, +** forces the switch to go to the default case. */ -l_sinline void moveresults (lua_State *L, StkId res, int nres, int wanted) { - StkId firstresult; - int i; - switch (wanted) { /* handle typical cases separately */ - case 0: /* no values needed */ +l_sinline void moveresults (lua_State *L, StkId res, int nres, + l_uint32 fwanted) { + switch (fwanted) { /* handle typical cases separately */ + case 0 + 1: /* no values needed */ L->top.p = res; return; - case 1: /* one value needed */ + case 1 + 1: /* one value needed */ if (nres == 0) /* no results? */ setnilvalue(s2v(res)); /* adjust with nil */ else /* at least one result */ setobjs2s(L, res, L->top.p - nres); /* move it to proper place */ L->top.p = res + 1; return; - case LUA_MULTRET: - wanted = nres; /* we want all results */ + case LUA_MULTRET + 1: + genmoveresults(L, res, nres, nres); /* we want all results */ break; - default: /* two/more results and/or to-be-closed variables */ - if (hastocloseCfunc(wanted)) { /* to-be-closed variables? */ - L->ci->callstatus |= CIST_CLSRET; /* in case of yields */ + default: { /* two/more results and/or to-be-closed variables */ + int wanted = get_nresults(fwanted); + if (fwanted & CIST_TBC) { /* to-be-closed variables? */ L->ci->u2.nres = nres; + L->ci->callstatus |= CIST_CLSRET; /* in case of yields */ res = luaF_close(L, res, CLOSEKTOP, 1); L->ci->callstatus &= ~CIST_CLSRET; if (L->hookmask) { /* if needed, call hook after '__close's */ @@ -462,21 +575,13 @@ l_sinline void moveresults (lua_State *L, StkId res, int nres, int wanted) { rethook(L, L->ci, nres); res = restorestack(L, savedres); /* hook can move stack */ } - wanted = decodeNresults(wanted); if (wanted == LUA_MULTRET) wanted = nres; /* we want all results */ } + genmoveresults(L, res, nres, wanted); break; + } } - /* generic case */ - firstresult = L->top.p - nres; /* index of first result */ - if (nres > wanted) /* extra results? */ - nres = wanted; /* don't need them */ - 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(s2v(res + i)); - L->top.p = res + wanted; /* top points after the last result */ } @@ -487,14 +592,14 @@ l_sinline void moveresults (lua_State *L, StkId res, int nres, int wanted) { ** that. */ void luaD_poscall (lua_State *L, CallInfo *ci, int nres) { - int wanted = ci->nresults; - if (l_unlikely(L->hookmask && !hastocloseCfunc(wanted))) + l_uint32 fwanted = ci->callstatus & (CIST_TBC | CIST_NRESULTS); + if (l_unlikely(L->hookmask) && !(fwanted & CIST_TBC)) rethook(L, ci, nres); /* move results to proper place */ - moveresults(L, ci->func.p, nres, wanted); + moveresults(L, ci->func.p, nres, fwanted); /* function cannot be in any of these cases when returning */ lua_assert(!(ci->callstatus & - (CIST_HOOKED | CIST_YPCALL | CIST_FIN | CIST_TRAN | CIST_CLSRET))); + (CIST_HOOKED | CIST_YPCALL | CIST_FIN | CIST_CLSRET))); L->ci = ci->previous; /* back to caller (after closing variables) */ } @@ -503,12 +608,18 @@ void luaD_poscall (lua_State *L, CallInfo *ci, int nres) { #define next_ci(L) (L->ci->next ? L->ci->next : luaE_extendCI(L)) -l_sinline CallInfo *prepCallInfo (lua_State *L, StkId func, int nret, - int mask, StkId top) { +/* +** Allocate and initialize CallInfo structure. At this point, the +** only valid fields in the call status are number of results, +** CIST_C (if it's a C function), and number of extra arguments. +** (All these bit-fields fit in 16-bit values.) +*/ +l_sinline CallInfo *prepCallInfo (lua_State *L, StkId func, unsigned status, + StkId top) { CallInfo *ci = L->ci = next_ci(L); /* new frame */ ci->func.p = func; - ci->nresults = nret; - ci->callstatus = mask; + lua_assert((status & ~(CIST_NRESULTS | CIST_C | MAX_CCMT)) == 0); + ci->callstatus = status; ci->top.p = top; return ci; } @@ -517,12 +628,12 @@ l_sinline CallInfo *prepCallInfo (lua_State *L, StkId func, int nret, /* ** precall for C functions */ -l_sinline int precallC (lua_State *L, StkId func, int nresults, +l_sinline int precallC (lua_State *L, StkId func, unsigned status, lua_CFunction f) { int n; /* number of returns */ CallInfo *ci; - checkstackGCp(L, LUA_MINSTACK, func); /* ensure minimum stack size */ - L->ci = ci = prepCallInfo(L, func, nresults, CIST_C, + checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */ + L->ci = ci = prepCallInfo(L, func, status | CIST_C, L->top.p + LUA_MINSTACK); lua_assert(ci->top.p <= L->stack_last.p); if (l_unlikely(L->hookmask & LUA_MASKCALL)) { @@ -546,18 +657,19 @@ l_sinline int precallC (lua_State *L, StkId func, int nresults, */ int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int narg1, int delta) { + unsigned status = LUA_MULTRET + 1; retry: switch (ttypetag(s2v(func))) { case LUA_VCCL: /* C closure */ - return precallC(L, func, LUA_MULTRET, clCvalue(s2v(func))->f); + return precallC(L, func, status, clCvalue(s2v(func))->f); case LUA_VLCF: /* light C function */ - return precallC(L, func, LUA_MULTRET, fvalue(s2v(func))); + return precallC(L, func, status, fvalue(s2v(func))); case LUA_VLCL: { /* Lua function */ Proto *p = clLvalue(s2v(func))->p; int fsize = p->maxstacksize; /* frame size */ int nfixparams = p->numparams; int i; - checkstackGCp(L, fsize - delta, func); + checkstackp(L, fsize - delta, func); ci->func.p -= delta; /* restore 'func' (if vararg) */ for (i = 0; i < narg1; i++) /* move down function and arguments */ setobjs2s(L, ci->func.p + i, func + i); @@ -572,8 +684,8 @@ int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, return -1; } default: { /* not a function */ - func = luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */ - /* return luaD_pretailcall(L, ci, func, narg1 + 1, delta); */ + checkstackp(L, 1, func); /* space for metamethod */ + status = tryfuncTM(L, func, status); /* try '__call' metamethod */ narg1++; goto retry; /* try again */ } @@ -590,13 +702,15 @@ int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, ** original function position. */ CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) { + unsigned status = cast_uint(nresults + 1); + lua_assert(status <= MAXRESULTS + 1); retry: switch (ttypetag(s2v(func))) { case LUA_VCCL: /* C closure */ - precallC(L, func, nresults, clCvalue(s2v(func))->f); + precallC(L, func, status, clCvalue(s2v(func))->f); return NULL; case LUA_VLCF: /* light C function */ - precallC(L, func, nresults, fvalue(s2v(func))); + precallC(L, func, status, fvalue(s2v(func))); return NULL; case LUA_VLCL: { /* Lua function */ CallInfo *ci; @@ -604,8 +718,8 @@ CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) { int narg = cast_int(L->top.p - func) - 1; /* number of real arguments */ int nfixparams = p->numparams; int fsize = p->maxstacksize; /* frame size */ - checkstackGCp(L, fsize, func); - L->ci = ci = prepCallInfo(L, func, nresults, 0, func + 1 + fsize); + checkstackp(L, fsize, func); + L->ci = ci = prepCallInfo(L, func, status, func + 1 + fsize); ci->u.l.savedpc = p->code; /* starting point */ for (; narg < nfixparams; narg++) setnilvalue(s2v(L->top.p++)); /* complete missing arguments */ @@ -613,8 +727,8 @@ CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) { return ci; } default: { /* not a function */ - func = luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */ - /* return luaD_precall(L, func, nresults); */ + checkstackp(L, 1, func); /* space for metamethod */ + status = tryfuncTM(L, func, status); /* try '__call' metamethod */ goto retry; /* try again with metamethod */ } } @@ -629,7 +743,7 @@ CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) { ** check the stack before doing anything else. 'luaD_precall' already ** does that. */ -l_sinline void ccall (lua_State *L, StkId func, int nResults, int inc) { +l_sinline void ccall (lua_State *L, StkId func, int nResults, l_uint32 inc) { CallInfo *ci; L->nCcalls += inc; if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS)) { @@ -637,7 +751,7 @@ l_sinline void ccall (lua_State *L, StkId func, int nResults, int inc) { luaE_checkcstack(L); } if ((ci = luaD_precall(L, func, nResults)) != NULL) { /* Lua function? */ - ci->callstatus = CIST_FRESH; /* mark that it is a "fresh" execute */ + ci->callstatus |= CIST_FRESH; /* mark that it is a "fresh" execute */ luaV_execute(L, ci); /* call it */ } L->nCcalls -= inc; @@ -676,13 +790,13 @@ void luaD_callnoyield (lua_State *L, StkId func, int nResults) { ** particular, field CIST_RECST preserves the error status across these ** multiple runs, changing only if there is a new error. */ -static int finishpcallk (lua_State *L, CallInfo *ci) { - int status = getcistrecst(ci); /* get original status */ +static TStatus finishpcallk (lua_State *L, CallInfo *ci) { + TStatus status = getcistrecst(ci); /* get original status */ if (l_likely(status == LUA_OK)) /* no error? */ status = LUA_YIELD; /* was interrupted by an yield */ else { /* error */ StkId func = restorestack(L, ci->u2.funcidx); - L->allowhook = getoah(ci->callstatus); /* restore 'allowhook' */ + L->allowhook = getoah(ci); /* restore 'allowhook' */ func = luaF_close(L, func, status, 1); /* can yield or raise an error */ luaD_seterrorobj(L, status, func); luaD_shrinkstack(L); /* restore stack size in case of overflow */ @@ -711,20 +825,21 @@ static int finishpcallk (lua_State *L, CallInfo *ci) { */ static void finishCcall (lua_State *L, CallInfo *ci) { int n; /* actual number of results from C function */ - if (ci->callstatus & CIST_CLSRET) { /* was returning? */ - lua_assert(hastocloseCfunc(ci->nresults)); + if (ci->callstatus & CIST_CLSRET) { /* was closing TBC variable? */ + lua_assert(ci->callstatus & CIST_TBC); n = ci->u2.nres; /* just redo 'luaD_poscall' */ /* don't need to reset CIST_CLSRET, as it will be set again anyway */ } else { - int status = LUA_YIELD; /* default if there were no errors */ + TStatus status = LUA_YIELD; /* default if there were no errors */ + lua_KFunction kf = ci->u.c.k; /* continuation function */ /* must have a continuation and must be able to call it */ - lua_assert(ci->u.c.k != NULL && yieldable(L)); + lua_assert(kf != NULL && yieldable(L)); if (ci->callstatus & CIST_YPCALL) /* was inside a 'lua_pcallk'? */ status = finishpcallk(L, ci); /* finish it */ adjustresults(L, LUA_MULTRET); /* finish 'lua_callk' */ lua_unlock(L); - n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation */ + n = (*kf)(L, APIstatus(status), ci->u.c.ctx); /* call continuation */ lua_lock(L); api_checknelems(L, n); } @@ -771,6 +886,7 @@ static CallInfo *findpcall (lua_State *L) { ** coroutine error handler and should not kill the coroutine.) */ static int resume_error (lua_State *L, const char *msg, int narg) { + api_checkpop(L, narg); L->top.p -= narg; /* remove args from the stack */ setsvalue2s(L, L->top.p, luaS_new(L, msg)); /* push error message */ api_incr_top(L); @@ -796,6 +912,10 @@ static void resume (lua_State *L, void *ud) { lua_assert(L->status == LUA_YIELD); L->status = LUA_OK; /* mark that it is running (again) */ if (isLua(ci)) { /* yielded inside a hook? */ + /* undo increment made by 'luaG_traceexec': instruction was not + executed yet */ + lua_assert(ci->callstatus & CIST_HOOKYIELD); + ci->u.l.savedpc--; L->top.p = firstArg; /* discard arguments */ luaV_execute(L, ci); /* just continue running Lua code */ } @@ -821,7 +941,7 @@ static void resume (lua_State *L, void *ud) { ** (status == LUA_YIELD), or an unprotected error ('findpcall' doesn't ** find a recover point). */ -static int precover (lua_State *L, int status) { +static TStatus precover (lua_State *L, TStatus status) { CallInfo *ci; while (errorstatus(status) && (ci = findpcall(L)) != NULL) { L->ci = ci; /* go down to recovery functions */ @@ -834,7 +954,7 @@ static int precover (lua_State *L, int status) { LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs, int *nresults) { - int status; + TStatus status; lua_lock(L); if (L->status == LUA_OK) { /* may be starting a coroutine */ if (L->ci != &L->base_ci) /* not in base level? */ @@ -849,21 +969,21 @@ LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs, return resume_error(L, "C stack overflow", nargs); L->nCcalls++; luai_userstateresume(L, nargs); - api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs); + api_checkpop(L, (L->status == LUA_OK) ? nargs + 1 : nargs); status = luaD_rawrunprotected(L, resume, &nargs); /* continue running after recoverable errors */ status = precover(L, status); if (l_likely(!errorstatus(status))) lua_assert(status == L->status); /* normal end or yield */ else { /* unrecoverable error */ - L->status = cast_byte(status); /* mark thread as 'dead' */ + L->status = status; /* mark thread as 'dead' */ luaD_seterrorobj(L, status, L->top.p); /* push error message */ L->ci->top.p = L->top.p; } *nresults = (status == LUA_YIELD) ? L->ci->u2.nyield : cast_int(L->top.p - (L->ci->func.p + 1)); lua_unlock(L); - return status; + return APIstatus(status); } @@ -878,9 +998,9 @@ LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx, luai_userstateyield(L, nresults); lua_lock(L); ci = L->ci; - api_checknelems(L, nresults); + api_checkpop(L, nresults); if (l_unlikely(!yieldable(L))) { - if (L != G(L)->mainthread) + if (L != mainthread(G(L))) luaG_runerror(L, "attempt to yield across a C-call boundary"); else luaG_runerror(L, "attempt to yield from outside a coroutine"); @@ -908,7 +1028,7 @@ LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx, */ struct CloseP { StkId level; - int status; + TStatus status; }; @@ -925,7 +1045,7 @@ static void closepaux (lua_State *L, void *ud) { ** Calls 'luaF_close' in protected mode. Return the original status ** or, in case of errors, the new status. */ -int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status) { +TStatus luaD_closeprotected (lua_State *L, ptrdiff_t level, TStatus status) { CallInfo *old_ci = L->ci; lu_byte old_allowhooks = L->allowhook; for (;;) { /* keep closing upvalues until no more errors */ @@ -947,9 +1067,9 @@ int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status) { ** 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; +TStatus luaD_pcall (lua_State *L, Pfunc func, void *u, ptrdiff_t old_top, + ptrdiff_t ef) { + TStatus status; CallInfo *old_ci = L->ci; lu_byte old_allowhooks = L->allowhook; ptrdiff_t old_errfunc = L->errfunc; @@ -981,7 +1101,7 @@ struct SParser { /* data to 'f_parser' */ static void checkmode (lua_State *L, const char *mode, const char *x) { - if (mode && strchr(mode, x[0]) == NULL) { + if (strchr(mode, x[0]) == NULL) { luaO_pushfstring(L, "attempt to load a %s chunk (mode is '%s')", x, mode); luaD_throw(L, LUA_ERRSYNTAX); @@ -992,13 +1112,18 @@ static void checkmode (lua_State *L, const char *mode, const char *x) { static void f_parser (lua_State *L, void *ud) { LClosure *cl; struct SParser *p = cast(struct SParser *, ud); + const char *mode = p->mode ? p->mode : "bt"; int c = zgetc(p->z); /* read first character */ if (c == LUA_SIGNATURE[0]) { - checkmode(L, p->mode, "binary"); - cl = luaU_undump(L, p->z, p->name); + int fixed = 0; + if (strchr(mode, 'B') != NULL) + fixed = 1; + else + checkmode(L, mode, "binary"); + cl = luaU_undump(L, p->z, p->name, fixed); } else { - checkmode(L, p->mode, "text"); + checkmode(L, mode, "text"); cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c); } lua_assert(cl->nupvalues == cl->p->sizeupvalues); @@ -1006,10 +1131,10 @@ static void f_parser (lua_State *L, void *ud) { } -int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, - const char *mode) { +TStatus luaD_protectedparser (lua_State *L, ZIO *z, const char *name, + const char *mode) { struct SParser p; - int status; + TStatus status; 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; @@ -1018,9 +1143,9 @@ int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, luaZ_initbuffer(L, &p.buff); status = luaD_pcall(L, f_parser, &p, savestack(L, L->top.p), L->errfunc); luaZ_freebuffer(L, &p.buff); - luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size); - luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size); - luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size); + luaM_freearray(L, p.dyd.actvar.arr, cast_sizet(p.dyd.actvar.size)); + luaM_freearray(L, p.dyd.gt.arr, cast_sizet(p.dyd.gt.size)); + luaM_freearray(L, p.dyd.label.arr, cast_sizet(p.dyd.label.size)); decnny(L); return status; } diff --git a/ldo.h b/ldo.h index 1aa446ad09..2d4ca8be46 100644 --- a/ldo.h +++ b/ldo.h @@ -23,10 +23,19 @@ ** 'condmovestack' is used in heavy tests to force a stack reallocation ** at every check. */ + +#if !defined(HARDSTACKTESTS) +#define condmovestack(L,pre,pos) ((void)0) +#else +/* realloc stack keeping its size */ +#define condmovestack(L,pre,pos) \ + { int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; } +#endif + #define luaD_checkstackaux(L,n,pre,pos) \ if (l_unlikely(L->stack_last.p - L->top.p <= (n))) \ { pre; luaD_growstack(L, n, 1); pos; } \ - else { condmovestack(L,pre,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) @@ -44,24 +53,24 @@ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */ -/* macro to check stack size and GC, preserving 'p' */ -#define checkstackGCp(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), luaC_checkGC(L), (void)0) +/* +** Maximum depth for nested C calls, syntactical nested non-terminals, +** and other features implemented through recursion in C. (Value must +** fit in a 16-bit unsigned integer. It must also be compatible with +** the size of the C stack.) +*/ +#if !defined(LUAI_MAXCCALLS) +#define LUAI_MAXCCALLS 200 +#endif /* 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, +LUAI_FUNC l_noret luaD_errerr (lua_State *L); +LUAI_FUNC void luaD_seterrorobj (lua_State *L, TStatus errcode, StkId oldtop); +LUAI_FUNC TStatus 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, int fTransfer, int nTransfer); @@ -71,9 +80,9 @@ LUAI_FUNC int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, LUAI_FUNC CallInfo *luaD_precall (lua_State *L, StkId func, int nResults); 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 StkId luaD_tryfuncTM (lua_State *L, StkId func); -LUAI_FUNC int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status); -LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u, +LUAI_FUNC TStatus luaD_closeprotected (lua_State *L, ptrdiff_t level, + TStatus status); +LUAI_FUNC TStatus luaD_pcall (lua_State *L, Pfunc func, void *u, ptrdiff_t oldtop, ptrdiff_t ef); LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres); LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror); @@ -81,8 +90,9 @@ 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); -LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode); -LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); +LUAI_FUNC l_noret luaD_throw (lua_State *L, TStatus errcode); +LUAI_FUNC l_noret luaD_throwbaselevel (lua_State *L, TStatus errcode); +LUAI_FUNC TStatus luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); #endif diff --git a/ldump.c b/ldump.c index f848b669cb..5795788922 100644 --- a/ldump.c +++ b/ldump.c @@ -10,12 +10,16 @@ #include "lprefix.h" +#include #include #include "lua.h" +#include "lapi.h" +#include "lgc.h" #include "lobject.h" #include "lstate.h" +#include "ltable.h" #include "lundump.h" @@ -23,8 +27,11 @@ typedef struct { lua_State *L; lua_Writer writer; void *data; + size_t offset; /* current position relative to beginning of dump */ int strip; int status; + Table *h; /* table to track saved strings */ + lua_Unsigned nstr; /* counter for counting saved strings */ } DumpState; @@ -37,15 +44,36 @@ typedef struct { #define dumpLiteral(D, s) dumpBlock(D,s,sizeof(s) - sizeof(char)) +/* +** Dump the block of memory pointed by 'b' with given 'size'. +** 'b' should not be NULL, except for the last call signaling the end +** of the dump. +*/ static void dumpBlock (DumpState *D, const void *b, size_t size) { - if (D->status == 0 && size > 0) { + if (D->status == 0) { /* do not write anything after an error */ lua_unlock(D->L); D->status = (*D->writer)(D->L, b, size, D->data); lua_lock(D->L); + D->offset += size; } } +/* +** Dump enough zeros to ensure that current position is a multiple of +** 'align'. +*/ +static void dumpAlign (DumpState *D, unsigned align) { + unsigned padding = align - cast_uint(D->offset % align); + if (padding < align) { /* padding == align means no padding */ + static lua_Integer paddingContent = 0; + lua_assert(align <= sizeof(lua_Integer)); + dumpBlock(D, &paddingContent, padding); + } + lua_assert(D->offset % align == 0); +} + + #define dumpVar(D,x) dumpVector(D,&x,1) @@ -55,23 +83,33 @@ static void dumpByte (DumpState *D, int y) { } -/* dumpInt Buff Size */ -#define DIBS ((sizeof(size_t) * 8 / 7) + 1) +/* +** size for 'dumpVarint' buffer: each byte can store up to 7 bits. +** (The "+6" rounds up the division.) +*/ +#define DIBS ((l_numbits(lua_Unsigned) + 6) / 7) -static void dumpSize (DumpState *D, size_t x) { +/* +** Dumps an unsigned integer using the MSB Varint encoding +*/ +static void dumpVarint (DumpState *D, lua_Unsigned 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 */ + unsigned n = 1; + buff[DIBS - 1] = x & 0x7f; /* fill least-significant byte */ + while ((x >>= 7) != 0) /* fill other bytes in reverse order */ + buff[DIBS - (++n)] = cast_byte((x & 0x7f) | 0x80); dumpVector(D, buff + DIBS - n, n); } +static void dumpSize (DumpState *D, size_t sz) { + dumpVarint(D, cast(lua_Unsigned, sz)); +} + + static void dumpInt (DumpState *D, int x) { - dumpSize(D, x); + lua_assert(x >= 0); + dumpVarint(D, cast_uint(x)); } @@ -80,30 +118,65 @@ static void dumpNumber (DumpState *D, lua_Number x) { } +/* +** Signed integers are coded to keep small values small. (Coding -1 as +** 0xfff...fff would use too many bytes to save a quite common value.) +** A non-negative x is coded as 2x; a negative x is coded as -2x - 1. +** (0 => 0; -1 => 1; 1 => 2; -2 => 3; 2 => 4; ...) +*/ static void dumpInteger (DumpState *D, lua_Integer x) { - dumpVar(D, x); + lua_Unsigned cx = (x >= 0) ? 2u * l_castS2U(x) + : (2u * ~l_castS2U(x)) + 1; + dumpVarint(D, cx); } -static void dumpString (DumpState *D, const TString *s) { - if (s == NULL) - dumpSize(D, 0); +/* +** Dump a String. First dump its "size": +** size==0 is followed by an index and means "reuse saved string with +** that index"; index==0 means NULL. +** size>=1 is followed by the string contents with real size==size-1 and +** means that string, which will be saved with the next available index. +** The real size does not include the ending '\0' (which is not dumped), +** so adding 1 to it cannot overflow a size_t. +*/ +static void dumpString (DumpState *D, TString *ts) { + if (ts == NULL) { + dumpVarint(D, 0); /* will "reuse" NULL */ + dumpVarint(D, 0); /* special index for NULL */ + } else { - size_t size = tsslen(s); - const char *str = getstr(s); - dumpSize(D, size + 1); - dumpVector(D, str, size); + TValue idx; + int tag = luaH_getstr(D->h, ts, &idx); + if (!tagisempty(tag)) { /* string already saved? */ + dumpVarint(D, 0); /* reuse a saved string */ + dumpVarint(D, l_castS2U(ivalue(&idx))); /* index of saved string */ + } + else { /* must write and save the string */ + TValue key, value; /* to save the string in the hash */ + size_t size; + const char *s = getlstr(ts, size); + dumpSize(D, size + 1); + dumpVector(D, s, size + 1); /* include ending '\0' */ + D->nstr++; /* one more saved string */ + setsvalue(D->L, &key, ts); /* the string is the key */ + setivalue(&value, l_castU2S(D->nstr)); /* its index is the value */ + luaH_set(D->L, D->h, &key, &value); /* h[ts] = nstr */ + /* integer value does not need barrier */ + } } } static void dumpCode (DumpState *D, const Proto *f) { dumpInt(D, f->sizecode); - dumpVector(D, f->code, f->sizecode); + dumpAlign(D, sizeof(f->code[0])); + lua_assert(f->code != NULL); + dumpVector(D, f->code, cast_uint(f->sizecode)); } -static void dumpFunction(DumpState *D, const Proto *f, TString *psource); +static void dumpFunction (DumpState *D, const Proto *f); static void dumpConstants (DumpState *D, const Proto *f) { int i; @@ -136,7 +209,7 @@ static void dumpProtos (DumpState *D, const Proto *f) { int n = f->sizep; dumpInt(D, n); for (i = 0; i < n; i++) - dumpFunction(D, f->p[i], f->source); + dumpFunction(D, f->p[i]); } @@ -155,12 +228,14 @@ static void dumpDebug (DumpState *D, const Proto *f) { int i, n; n = (D->strip) ? 0 : f->sizelineinfo; dumpInt(D, n); - dumpVector(D, f->lineinfo, n); + if (f->lineinfo != NULL) + dumpVector(D, f->lineinfo, cast_uint(n)); n = (D->strip) ? 0 : f->sizeabslineinfo; dumpInt(D, n); - for (i = 0; i < n; i++) { - dumpInt(D, f->abslineinfo[i].pc); - dumpInt(D, f->abslineinfo[i].line); + if (n > 0) { + /* 'abslineinfo' is an array of structures of int's */ + dumpAlign(D, sizeof(int)); + dumpVector(D, f->abslineinfo, cast_uint(n)); } n = (D->strip) ? 0 : f->sizelocvars; dumpInt(D, n); @@ -176,51 +251,57 @@ static void dumpDebug (DumpState *D, const Proto *f) { } -static void dumpFunction (DumpState *D, const Proto *f, TString *psource) { - if (D->strip || f->source == psource) - dumpString(D, NULL); /* no debug info or same source as its parent */ - else - dumpString(D, f->source); +static void dumpFunction (DumpState *D, const Proto *f) { dumpInt(D, f->linedefined); dumpInt(D, f->lastlinedefined); dumpByte(D, f->numparams); - dumpByte(D, f->is_vararg); + dumpByte(D, f->flag); dumpByte(D, f->maxstacksize); dumpCode(D, f); dumpConstants(D, f); dumpUpvalues(D, f); dumpProtos(D, f); + dumpString(D, D->strip ? NULL : f->source); dumpDebug(D, f); } +#define dumpNumInfo(D, tvar, value) \ + { tvar i = value; dumpByte(D, sizeof(tvar)); dumpVar(D, i); } + + 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); + dumpNumInfo(D, int, LUAC_INT); + dumpNumInfo(D, Instruction, LUAC_INST); + dumpNumInfo(D, lua_Integer, LUAC_INT); + dumpNumInfo(D, lua_Number, LUAC_NUM); } /* ** dump Lua function as precompiled chunk */ -int luaU_dump(lua_State *L, const Proto *f, lua_Writer w, void *data, - int strip) { +int luaU_dump (lua_State *L, const Proto *f, lua_Writer w, void *data, + int strip) { DumpState D; + D.h = luaH_new(L); /* aux. table to keep strings already dumped */ + sethvalue2s(L, L->top.p, D.h); /* anchor it */ + L->top.p++; D.L = L; D.writer = w; + D.offset = 0; D.data = data; D.strip = strip; D.status = 0; + D.nstr = 0; dumpHeader(&D); dumpByte(&D, f->sizeupvalues); - dumpFunction(&D, f, NULL); + dumpFunction(&D, f); + dumpBlock(&D, NULL, 0); /* signal end of dump */ return D.status; } diff --git a/lfunc.c b/lfunc.c index 0945f241de..b6fd9ceb55 100644 --- a/lfunc.c +++ b/lfunc.c @@ -100,21 +100,23 @@ UpVal *luaF_findupval (lua_State *L, StkId level) { /* -** Call closing method for object 'obj' with error message 'err'. The +** Call closing method for object 'obj' with error object 'err'. The ** boolean 'yy' controls whether the call is yieldable. ** (This function assumes EXTRA_STACK.) */ static void callclosemethod (lua_State *L, TValue *obj, TValue *err, int yy) { StkId top = L->top.p; + StkId func = top; const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE); - 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.p = top + 3; /* add function and arguments */ + setobj2s(L, top++, tm); /* will call metamethod... */ + setobj2s(L, top++, obj); /* with 'self' as the 1st argument */ + if (err != NULL) /* if there was an error... */ + setobj2s(L, top++, err); /* then error object will be 2nd argument */ + L->top.p = top; /* add function and arguments */ if (yy) - luaD_call(L, top, 0); + luaD_call(L, func, 0); else - luaD_callnoyield(L, top, 0); + luaD_callnoyield(L, func, 0); } @@ -140,26 +142,28 @@ static void checkclosemth (lua_State *L, StkId level) { ** the 'level' of the upvalue being closed, as everything after that ** won't be used again. */ -static void prepcallclosemth (lua_State *L, StkId level, int status, int yy) { +static void prepcallclosemth (lua_State *L, StkId level, TStatus status, + int yy) { TValue *uv = s2v(level); /* value being closed */ TValue *errobj; - if (status == CLOSEKTOP) - errobj = &G(L)->nilvalue; /* error object is nil */ - else { /* 'luaD_seterrorobj' will set top to level + 2 */ - errobj = s2v(level + 1); /* error object goes after 'uv' */ - luaD_seterrorobj(L, status, level + 1); /* set error object */ + switch (status) { + case LUA_OK: + L->top.p = level + 1; /* call will be at this level */ + /* FALLTHROUGH */ + case CLOSEKTOP: /* don't need to change top */ + errobj = NULL; /* no error object */ + break; + default: /* 'luaD_seterrorobj' will set top to level + 2 */ + errobj = s2v(level + 1); /* error object goes after 'uv' */ + luaD_seterrorobj(L, status, level + 1); /* set error object */ + break; } callclosemethod(L, uv, errobj, yy); } -/* -** Maximum value for deltas in 'tbclist', dependent on the type -** of delta. (This macro assumes that an 'L' is in scope where it -** is used.) -*/ -#define MAXDELTA \ - ((256ul << ((sizeof(L->stack.p->tbclist.delta) - 1) * 8)) - 1) +/* Maximum value for deltas in 'tbclist' */ +#define MAXDELTA USHRT_MAX /* @@ -192,8 +196,7 @@ void luaF_unlinkupval (UpVal *uv) { */ void luaF_closeupval (lua_State *L, StkId level) { UpVal *uv; - StkId upl; /* stack index pointed by 'uv' */ - while ((uv = L->openupval) != NULL && (upl = uplevel(uv)) >= level) { + while ((uv = L->openupval) != NULL && uplevel(uv) >= level) { TValue *slot = &uv->u.value; /* new position for value */ lua_assert(uplevel(uv) < L->top.p); luaF_unlinkupval(uv); /* remove upvalue from 'openupval' list */ @@ -224,7 +227,7 @@ static void poptbclist (lua_State *L) { ** Close all upvalues and to-be-closed variables up to the given stack ** level. Return restored 'level'. */ -StkId luaF_close (lua_State *L, StkId level, int status, int yy) { +StkId luaF_close (lua_State *L, StkId level, TStatus status, int yy) { ptrdiff_t levelrel = savestack(L, level); luaF_closeupval(L, level); /* first, close the upvalues */ while (L->tbclist.p >= level) { /* traverse tbc's down to that level */ @@ -253,7 +256,7 @@ Proto *luaF_newproto (lua_State *L) { f->upvalues = NULL; f->sizeupvalues = 0; f->numparams = 0; - f->is_vararg = 0; + f->flag = 0; f->maxstacksize = 0; f->locvars = NULL; f->sizelocvars = 0; @@ -264,14 +267,31 @@ Proto *luaF_newproto (lua_State *L) { } +lu_mem luaF_protosize (Proto *p) { + lu_mem sz = cast(lu_mem, sizeof(Proto)) + + cast_uint(p->sizep) * sizeof(Proto*) + + cast_uint(p->sizek) * sizeof(TValue) + + cast_uint(p->sizelocvars) * sizeof(LocVar) + + cast_uint(p->sizeupvalues) * sizeof(Upvaldesc); + if (!(p->flag & PF_FIXED)) { + sz += cast_uint(p->sizecode) * sizeof(Instruction); + sz += cast_uint(p->sizelineinfo) * sizeof(lu_byte); + sz += cast_uint(p->sizeabslineinfo) * sizeof(AbsLineInfo); + } + return sz; +} + + void luaF_freeproto (lua_State *L, Proto *f) { - luaM_freearray(L, f->code, f->sizecode); - luaM_freearray(L, f->p, f->sizep); - luaM_freearray(L, f->k, f->sizek); - luaM_freearray(L, f->lineinfo, f->sizelineinfo); - luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo); - luaM_freearray(L, f->locvars, f->sizelocvars); - luaM_freearray(L, f->upvalues, f->sizeupvalues); + if (!(f->flag & PF_FIXED)) { + luaM_freearray(L, f->code, cast_sizet(f->sizecode)); + luaM_freearray(L, f->lineinfo, cast_sizet(f->sizelineinfo)); + luaM_freearray(L, f->abslineinfo, cast_sizet(f->sizeabslineinfo)); + } + luaM_freearray(L, f->p, cast_sizet(f->sizep)); + luaM_freearray(L, f->k, cast_sizet(f->sizek)); + luaM_freearray(L, f->locvars, cast_sizet(f->sizelocvars)); + luaM_freearray(L, f->upvalues, cast_sizet(f->sizeupvalues)); luaM_free(L, f); } diff --git a/lfunc.h b/lfunc.h index 3be265efb5..d6aad3a6df 100644 --- a/lfunc.h +++ b/lfunc.h @@ -11,11 +11,11 @@ #include "lobject.h" -#define sizeCclosure(n) (cast_int(offsetof(CClosure, upvalue)) + \ - cast_int(sizeof(TValue)) * (n)) +#define sizeCclosure(n) \ + (offsetof(CClosure, upvalue) + sizeof(TValue) * cast_uint(n)) -#define sizeLclosure(n) (cast_int(offsetof(LClosure, upvals)) + \ - cast_int(sizeof(TValue *)) * (n)) +#define sizeLclosure(n) \ + (offsetof(LClosure, upvals) + sizeof(UpVal *) * cast_uint(n)) /* test whether thread is in 'twups' list */ @@ -44,7 +44,7 @@ /* special status to close upvalues preserving the top of the stack */ -#define CLOSEKTOP (-1) +#define CLOSEKTOP (LUA_ERRERR + 1) LUAI_FUNC Proto *luaF_newproto (lua_State *L); @@ -54,8 +54,9 @@ LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl); LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level); LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level); LUAI_FUNC void luaF_closeupval (lua_State *L, StkId level); -LUAI_FUNC StkId luaF_close (lua_State *L, StkId level, int status, int yy); +LUAI_FUNC StkId luaF_close (lua_State *L, StkId level, TStatus status, int yy); LUAI_FUNC void luaF_unlinkupval (UpVal *uv); +LUAI_FUNC lu_mem luaF_protosize (Proto *p); 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/lgc.c b/lgc.c index a3094ff571..60f042c7a8 100644 --- a/lgc.c +++ b/lgc.c @@ -9,7 +9,6 @@ #include "lprefix.h" -#include #include @@ -32,32 +31,13 @@ ** (Large enough to dissipate fixed overheads but small enough ** to allow small steps for the collector.) */ -#define GCSWEEPMAX 100 - -/* -** Maximum number of finalizers to call in each single step. -*/ -#define GCFINMAX 10 - - -/* -** Cost of calling one finalizer. -*/ -#define GCFINALIZECOST 50 - - -/* -** The equivalent, in bytes, of one unit of "work" (visiting a slot, -** sweeping an object, etc.) -*/ -#define WORK2MEM sizeof(TValue) +#define GCSWEEPMAX 20 /* -** macro to adjust 'pause': 'pause' is actually used like -** 'pause / PAUSEADJ' (value chosen by tests) +** Cost (in work units) of running one finalizer. */ -#define PAUSEADJ 100 +#define CWUFIN 10 /* mask with all color bits */ @@ -91,7 +71,14 @@ #define gcvalueN(o) (iscollectable(o) ? gcvalue(o) : NULL) -#define markvalue(g,o) { checkliveness(g->mainthread,o); \ +/* +** Access to collectable objects in array part of tables +*/ +#define gcvalarr(t,i) \ + ((*getArrTag(t,i) & BIT_ISCOLLECTABLE) ? getArrVal(t,i)->gc : NULL) + + +#define markvalue(g,o) { checkliveness(mainthread(g),o); \ if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); } #define markkey(g, n) { if keyiswhite(n) reallymarkobject(g,gckey(n)); } @@ -104,8 +91,9 @@ */ #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 atomic (lua_State *L); static void entersweep (lua_State *L); @@ -122,6 +110,56 @@ static void entersweep (lua_State *L); #define gnodelast(h) gnode(h, cast_sizet(sizenode(h))) +static l_mem objsize (GCObject *o) { + lu_mem res; + switch (o->tt) { + case LUA_VTABLE: { + res = luaH_size(gco2t(o)); + break; + } + case LUA_VLCL: { + LClosure *cl = gco2lcl(o); + res = sizeLclosure(cl->nupvalues); + break; + } + case LUA_VCCL: { + CClosure *cl = gco2ccl(o); + res = sizeCclosure(cl->nupvalues); + break; + } + case LUA_VUSERDATA: { + Udata *u = gco2u(o); + res = sizeudata(u->nuvalue, u->len); + break; + } + case LUA_VPROTO: { + res = luaF_protosize(gco2p(o)); + break; + } + case LUA_VTHREAD: { + res = luaE_threadsize(gco2th(o)); + break; + } + case LUA_VSHRSTR: { + TString *ts = gco2ts(o); + res = sizestrshr(cast_uint(ts->shrlen)); + break; + } + case LUA_VLNGSTR: { + TString *ts = gco2ts(o); + res = luaS_sizelngstr(ts->u.lnglen, ts->shrlen); + break; + } + case LUA_VUPVAL: { + res = sizeof(UpVal); + break; + } + default: res = 0; lua_assert(0); + } + return cast(l_mem, res); +} + + static GCObject **getgclist (GCObject *o) { switch (o->tt) { case LUA_VTABLE: return &gco2t(o)->gclist; @@ -203,7 +241,7 @@ static int iscleared (global_State *g, const GCObject *o) { ** incremental sweep phase, it clears the black object to white (sweep ** it) to avoid other barrier calls for this same object. (That cannot ** be done is generational mode, as its sweep does not distinguish -** whites from deads.) +** white from dead.) */ void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) { global_State *g = G(L); @@ -217,7 +255,7 @@ void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) { } else { /* sweep phase */ lua_assert(issweepphase(g)); - if (g->gckind == KGC_INC) /* incremental mode? */ + if (g->gckind != KGC_GENMINOR) /* incremental mode? */ makewhite(g, o); /* mark 'o' as white to avoid other barriers */ } } @@ -230,7 +268,8 @@ void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) { void luaC_barrierback_ (lua_State *L, GCObject *o) { global_State *g = G(L); lua_assert(isblack(o) && !isdead(g, o)); - lua_assert((g->gckind == KGC_GEN) == (isold(o) && getage(o) != G_TOUCHED1)); + lua_assert((g->gckind != KGC_GENMINOR) + || (isold(o) && getage(o) != G_TOUCHED1)); if (getage(o) == G_TOUCHED2) /* already in gray list? */ set2gray(o); /* make it gray to become touched1 */ else /* link it in 'grayagain' and paint it gray */ @@ -255,7 +294,7 @@ void luaC_fix (lua_State *L, GCObject *o) { ** create a new collectable object (with given type, size, and offset) ** and link it to 'allgc' list. */ -GCObject *luaC_newobjdt (lua_State *L, int tt, size_t sz, size_t offset) { +GCObject *luaC_newobjdt (lua_State *L, lu_byte tt, size_t sz, size_t offset) { global_State *g = G(L); char *p = cast_charp(luaM_newobject(L, novariant(tt), sz)); GCObject *o = cast(GCObject *, p + offset); @@ -267,7 +306,10 @@ GCObject *luaC_newobjdt (lua_State *L, int tt, size_t sz, size_t offset) { } -GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) { +/* +** create a new collectable object with no offset. +*/ +GCObject *luaC_newobj (lua_State *L, lu_byte tt, size_t sz) { return luaC_newobjdt(L, tt, sz, 0); } @@ -295,6 +337,7 @@ GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) { ** (only closures can), and a userdata's metatable must be a table. */ static void reallymarkobject (global_State *g, GCObject *o) { + g->GCmarked += objsize(o); switch (o->tt) { case LUA_VSHRSTR: case LUA_VLNGSTR: { @@ -334,7 +377,7 @@ static void reallymarkobject (global_State *g, GCObject *o) { */ static void markmt (global_State *g) { int i; - for (i=0; i < LUA_NUMTAGS; i++) + for (i=0; i < LUA_NUMTYPES; i++) markobjectN(g, g->mt[i]); } @@ -342,14 +385,10 @@ static void markmt (global_State *g) { /* ** mark all objects in list of being-finalized */ -static lu_mem markbeingfnz (global_State *g) { +static void markbeingfnz (global_State *g) { GCObject *o; - lu_mem count = 0; - for (o = g->tobefnz; o != NULL; o = o->next) { - count++; + for (o = g->tobefnz; o != NULL; o = o->next) markobject(g, o); - } - return count; } @@ -364,12 +403,10 @@ static lu_mem markbeingfnz (global_State *g) { ** upvalues, as they have nothing to be checked. (If the thread gets an ** upvalue later, it will be linked in the list again.) */ -static int remarkupvals (global_State *g) { +static void remarkupvals (global_State *g) { lua_State *thread; lua_State **p = &g->twups; - int work = 0; /* estimate of how much work was done here */ while ((thread = *p) != NULL) { - work++; if (!iswhite(thread) && thread->openupval != NULL) p = &thread->twups; /* keep marked thread with upvalues in the list */ else { /* thread is not marked or without upvalues */ @@ -379,7 +416,6 @@ static int remarkupvals (global_State *g) { thread->twups = thread; /* mark that it is out of list */ for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) { lua_assert(getage(uv) <= getage(thread)); - work++; if (!iswhite(uv)) { /* upvalue already visited? */ lua_assert(upisopen(uv) && isgray(uv)); markvalue(g, uv->v.p); /* mark its value */ @@ -387,7 +423,6 @@ static int remarkupvals (global_State *g) { } } } - return work; } @@ -398,11 +433,14 @@ static void cleargraylists (global_State *g) { /* -** mark root set and reset all gray lists, to start a new collection +** mark root set and reset all gray lists, to start a new collection. +** 'GCmarked' is initialized to count the total number of live bytes +** during a cycle. */ static void restartcollection (global_State *g) { cleargraylists(g); - markobject(g, g->mainthread); + g->GCmarked = 0; + markobject(g, mainthread(g)); markvalue(g, &g->l_registry); markmt(g); markbeingfnz(g); /* mark any finalizing object left from previous cycle */ @@ -426,6 +464,8 @@ static void restartcollection (global_State *g) { ** TOUCHED1 objects need to be in the list. TOUCHED2 doesn't need to go ** back to a gray list, but then it must become OLD. (That is what ** 'correctgraylist' does when it finds a TOUCHED2 object.) +** This function is a no-op in incremental mode, as objects cannot be +** marked as touched in that mode. */ static void genlink (global_State *g, GCObject *o) { lua_assert(isblack(o)); @@ -433,7 +473,7 @@ static void genlink (global_State *g, GCObject *o) { linkobjgclist(o, g->grayagain); /* link it back in 'grayagain' */ } /* everything else do not need to be linked back */ else if (getage(o) == G_TOUCHED2) - changeage(o, G_TOUCHED2, G_OLD); /* advance age */ + setage(o, G_OLD); /* advance age */ } @@ -441,13 +481,14 @@ static void genlink (global_State *g, GCObject *o) { ** Traverse a table with weak values and link it to proper list. During ** propagate phase, keep it in 'grayagain' list, to be revisited in the ** atomic phase. In the atomic phase, if table has any white value, -** put it in 'weak' list, to be cleared. +** put it in 'weak' list, to be cleared; otherwise, call 'genlink' +** to check table age in generational mode. */ static void traverseweakvalue (global_State *g, Table *h) { 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->alimit > 0); + int hasclears = (h->asize > 0); for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */ if (isempty(gval(n))) /* entry is empty? */ clearkey(n); /* clear its key */ @@ -458,10 +499,30 @@ static void traverseweakvalue (global_State *g, Table *h) { hasclears = 1; /* table will have to be cleared */ } } - if (g->gcstate == GCSatomic && hasclears) - linkgclist(h, g->weak); /* has to be cleared later */ - else + if (g->gcstate == GCSpropagate) linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */ + else if (hasclears) + linkgclist(h, g->weak); /* has to be cleared later */ + else + genlink(g, obj2gco(h)); +} + + +/* +** Traverse the array part of a table. +*/ +static int traversearray (global_State *g, Table *h) { + unsigned asize = h->asize; + int marked = 0; /* true if some object is marked in this traversal */ + unsigned i; + for (i = 0; i < asize; i++) { + GCObject *o = gcvalarr(h, i); + if (o != NULL && iswhite(o)) { + marked = 1; + reallymarkobject(g, o); + } + } + return marked; } @@ -478,19 +539,11 @@ static void traverseweakvalue (global_State *g, Table *h) { ** by 'genlink'. */ 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" */ unsigned int i; - unsigned int asize = luaH_realasize(h); unsigned int nsize = sizenode(h); - /* traverse array part */ - for (i = 0; i < asize; i++) { - if (valiswhite(&h->array[i])) { - marked = 1; - reallymarkobject(g, gcvalue(&h->array[i])); - } - } + int marked = traversearray(g, h); /* traverse array part */ /* traverse hash part; if 'inv', traverse descending (see 'convergeephemerons') */ for (i = 0; i < nsize; i++) { @@ -522,10 +575,7 @@ static int traverseephemeron (global_State *g, Table *h, int inv) { static void traversestrongtable (global_State *g, Table *h) { Node *n, *limit = gnodelast(h); - unsigned int i; - unsigned int asize = luaH_realasize(h); - for (i = 0; i < asize; i++) /* traverse array part */ - markvalue(g, &h->array[i]); + traversearray(g, h); for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */ if (isempty(gval(n))) /* entry is empty? */ clearkey(n); /* clear its key */ @@ -539,28 +589,46 @@ static void traversestrongtable (global_State *g, Table *h) { } -static lu_mem traversetable (global_State *g, Table *h) { - const char *weakkey, *weakvalue; +/* +** (result & 1) iff weak values; (result & 2) iff weak keys. +*/ +static int getmode (global_State *g, Table *h) { const TValue *mode = gfasttm(g, h->metatable, TM_MODE); + if (mode == NULL || !ttisstring(mode)) + return 0; /* ignore non-string modes */ + else { + const char *smode = getstr(tsvalue(mode)); + const char *weakkey = strchr(smode, 'k'); + const char *weakvalue = strchr(smode, 'v'); + return ((weakkey != NULL) << 1) | (weakvalue != NULL); + } +} + + +static l_mem traversetable (global_State *g, Table *h) { markobjectN(g, h->metatable); - if (mode && ttisstring(mode) && /* is there a weak mode? */ - (cast_void(weakkey = strchr(svalue(mode), 'k')), - cast_void(weakvalue = strchr(svalue(mode), 'v')), - (weakkey || weakvalue))) { /* is really weak? */ - if (!weakkey) /* strong keys? */ + switch (getmode(g, h)) { + case 0: /* not weak */ + traversestrongtable(g, h); + break; + case 1: /* weak values */ traverseweakvalue(g, h); - else if (!weakvalue) /* strong values? */ + break; + case 2: /* weak keys */ traverseephemeron(g, h, 0); - else /* all weak */ - linkgclist(h, g->allweak); /* nothing to traverse now */ + break; + case 3: /* all weak; nothing to traverse */ + if (g->gcstate == GCSpropagate) + linkgclist(h, g->grayagain); /* must visit again its metatable */ + else + linkgclist(h, g->allweak); /* must clear collected entries */ + break; } - else /* not weak */ - traversestrongtable(g, h); - return 1 + h->alimit + 2 * allocsizenode(h); + return cast(l_mem, 1 + 2*sizenode(h) + h->asize); } -static int traverseudata (global_State *g, Udata *u) { +static l_mem traverseudata (global_State *g, Udata *u) { int i; markobjectN(g, u->metatable); /* mark its metatable */ for (i = 0; i < u->nuvalue; i++) @@ -575,7 +643,7 @@ static int traverseudata (global_State *g, Udata *u) { ** arrays can be larger than needed; the extra slots are filled with ** NULL, so the use of 'markobjectN') */ -static int traverseproto (global_State *g, Proto *f) { +static l_mem traverseproto (global_State *g, Proto *f) { int i; markobjectN(g, f->source); for (i = 0; i < f->sizek; i++) /* mark literals */ @@ -590,7 +658,7 @@ static int traverseproto (global_State *g, Proto *f) { } -static int traverseCclosure (global_State *g, CClosure *cl) { +static l_mem traverseCclosure (global_State *g, CClosure *cl) { int i; for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */ markvalue(g, &cl->upvalue[i]); @@ -601,7 +669,7 @@ static int traverseCclosure (global_State *g, CClosure *cl) { ** Traverse a Lua closure, marking its prototype and its upvalues. ** (Both can be NULL while closure is being created.) */ -static int traverseLclosure (global_State *g, LClosure *cl) { +static l_mem traverseLclosure (global_State *g, LClosure *cl) { int i; markobjectN(g, cl->p); /* mark its prototype */ for (i = 0; i < cl->nupvalues; i++) { /* visit its upvalues */ @@ -624,13 +692,13 @@ static int traverseLclosure (global_State *g, LClosure *cl) { ** (which can only happen in generational mode) or if the traverse is in ** the propagate phase (which can only happen in incremental mode). */ -static int traversethread (global_State *g, lua_State *th) { +static l_mem traversethread (global_State *g, lua_State *th) { UpVal *uv; StkId o = th->stack.p; if (isold(th) || g->gcstate == GCSpropagate) linkgclist(th, g->grayagain); /* insert into 'grayagain' list */ if (o == NULL) - return 1; /* stack not completely built yet */ + return 0; /* stack not completely built yet */ lua_assert(g->gcstate == GCSatomic || th->openupval == NULL || isintwups(th)); for (; o < th->top.p; o++) /* mark live elements in the stack */ @@ -638,7 +706,9 @@ static int traversethread (global_State *g, lua_State *th) { 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? */ - for (; o < th->stack_last.p + EXTRA_STACK; o++) + if (!g->gcemergency) + luaD_shrinkstack(th); /* do not change stack in emergency cycle */ + for (o = th->top.p; o < th->stack_last.p + EXTRA_STACK; o++) setnilvalue(s2v(o)); /* clear dead stack slice */ /* 'remarkupvals' may have removed thread from 'twups' list */ if (!isintwups(th) && th->openupval != NULL) { @@ -646,16 +716,15 @@ static int traversethread (global_State *g, lua_State *th) { g->twups = th; } } - else if (!g->gcemergency) - luaD_shrinkstack(th); /* do not change stack in emergency cycle */ - return 1 + stacksize(th); + return 1 + (th->top.p - th->stack.p); } /* -** traverse one gray object, turning it to black. +** traverse one gray object, turning it to black. Return an estimate +** of the number of slots traversed. */ -static lu_mem propagatemark (global_State *g) { +static l_mem propagatemark (global_State *g) { GCObject *o = g->gray; nw2black(o); g->gray = *getgclist(o); /* remove from 'gray' list */ @@ -671,11 +740,9 @@ static lu_mem propagatemark (global_State *g) { } -static lu_mem propagateall (global_State *g) { - lu_mem tot = 0; +static void propagateall (global_State *g) { while (g->gray) - tot += propagatemark(g); - return tot; + propagatemark(g); } @@ -684,7 +751,6 @@ static lu_mem propagateall (global_State *g) { ** 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; @@ -744,11 +810,11 @@ static void clearbyvalues (global_State *g, GCObject *l, GCObject *f) { Table *h = gco2t(l); Node *n, *limit = gnodelast(h); unsigned int i; - unsigned int asize = luaH_realasize(h); + unsigned int asize = h->asize; for (i = 0; i < asize; i++) { - TValue *o = &h->array[i]; - if (iscleared(g, gcvalueN(o))) /* value was collected? */ - setempty(o); /* remove entry */ + GCObject *o = gcvalarr(h, i); + if (iscleared(g, o)) /* value was collected? */ + *getArrTag(h, i) = LUA_VEMPTY; /* remove entry */ } for (n = gnode(h, 0); n < limit; n++) { if (iscleared(g, gcvalueN(gval(n)))) /* unmarked value? */ @@ -768,6 +834,7 @@ static void freeupval (lua_State *L, UpVal *uv) { static void freeobj (lua_State *L, GCObject *o) { + assert_code(l_mem newmem = gettotalbytes(G(L)) - objsize(o)); switch (o->tt) { case LUA_VPROTO: luaF_freeproto(L, gco2p(o)); @@ -799,46 +866,45 @@ static void freeobj (lua_State *L, GCObject *o) { case LUA_VSHRSTR: { TString *ts = gco2ts(o); luaS_remove(L, ts); /* remove it from hash table */ - luaM_freemem(L, ts, sizelstring(ts->shrlen)); + luaM_freemem(L, ts, sizestrshr(cast_uint(ts->shrlen))); break; } case LUA_VLNGSTR: { TString *ts = gco2ts(o); - luaM_freemem(L, ts, sizelstring(ts->u.lnglen)); + if (ts->shrlen == LSTRMEM) /* must free external string? */ + (*ts->falloc)(ts->ud, ts->contents, ts->u.lnglen + 1, 0); + luaM_freemem(L, ts, luaS_sizelngstr(ts->u.lnglen, ts->shrlen)); break; } default: lua_assert(0); } + lua_assert(gettotalbytes(G(L)) == newmem); } /* ** 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. ('*countout' gets the number of elements traversed.) +** white; change all non-dead objects back to white (and new), preparing +** for next collection cycle. Return where to continue the traversal or +** NULL if list is finished. */ -static GCObject **sweeplist (lua_State *L, GCObject **p, int countin, - int *countout) { +static GCObject **sweeplist (lua_State *L, GCObject **p, l_mem countin) { global_State *g = G(L); int ow = otherwhite(g); - int i; int white = luaC_white(g); /* current white */ - for (i = 0; *p != NULL && i < countin; i++) { + while (*p != NULL && countin-- > 0) { GCObject *curr = *p; int marked = curr->marked; if (isdeadm(ow, marked)) { /* is 'curr' dead? */ *p = curr->next; /* remove 'curr' from list */ freeobj(L, curr); /* erase 'curr' */ } - else { /* change mark to 'white' */ - curr->marked = cast_byte((marked & ~maskgcbits) | white); + else { /* change mark to 'white' and age to 'new' */ + curr->marked = cast_byte((marked & ~maskgcbits) | white | G_NEW); p = &curr->next; /* go to next element */ } } - if (countout) - *countout = i; /* number of elements traversed */ return (*p == NULL) ? NULL : p; } @@ -849,7 +915,7 @@ static GCObject **sweeplist (lua_State *L, GCObject **p, int countin, static GCObject **sweeptolive (lua_State *L, GCObject **p) { GCObject **old = p; do { - p = sweeplist(L, p, 1, NULL); + p = sweeplist(L, p, 1); } while (p == old); return p; } @@ -868,11 +934,8 @@ static GCObject **sweeptolive (lua_State *L, GCObject **p) { */ static void checkSizes (lua_State *L, global_State *g) { if (!g->gcemergency) { - if (g->strt.nuse < g->strt.size / 4) { /* string table too big? */ - l_mem olddebt = g->GCdebt; + if (g->strt.nuse < g->strt.size / 4) /* string table too big? */ luaS_resize(L, g->strt.size / 2); - g->GCestimate += g->GCdebt - olddebt; /* correct estimate */ - } } } @@ -910,9 +973,9 @@ static void GCTM (lua_State *L) { setgcovalue(L, &v, udata2finalize(g)); tm = luaT_gettmbyobj(L, &v, TM_GC); if (!notm(tm)) { /* is there a finalizer? */ - int status; + TStatus status; lu_byte oldah = L->allowhook; - int oldgcstp = g->gcstp; + lu_byte oldgcstp = g->gcstp; g->gcstp |= GCSTPGC; /* avoid GC steps */ L->allowhook = 0; /* stop debug hooks during GC metamethod */ setobj2s(L, L->top.p++, tm); /* push finalizer... */ @@ -930,18 +993,6 @@ static void GCTM (lua_State *L) { } -/* -** Call a few finalizers -*/ -static int runafewfinalizers (lua_State *L, int n) { - global_State *g = G(L); - int i; - for (i = 0; i < n && g->tobefnz; i++) - GCTM(L); /* call one finalizer */ - return i; -} - - /* ** call all pending finalizers */ @@ -1047,23 +1098,31 @@ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) { ** ======================================================= */ +/* +** Fields 'GCmarked' and 'GCmajorminor' are used to control the pace and +** the mode of the collector. They play several roles, depending on the +** mode of the collector: +** * KGC_INC: +** GCmarked: number of marked bytes during a cycle. +** GCmajorminor: not used. +** * KGC_GENMINOR +** GCmarked: number of bytes that became old since last major collection. +** GCmajorminor: number of bytes marked in last major collection. +** * KGC_GENMAJOR +** GCmarked: number of bytes that became old since last major collection. +** GCmajorminor: number of bytes marked in last major collection. +*/ + /* -** 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). +** Set the "time" to wait before starting a new incremental cycle; +** cycle will start when number of bytes in use hits the threshold of +** approximately (marked * pause / 100). */ 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 = (pause < MAX_LMEM / estimate) /* overflow? */ - ? estimate * pause /* no overflow */ - : MAX_LMEM; /* overflow; truncate to maximum */ - debt = gettotalbytes(g) - threshold; - if (debt > 0) debt = 0; + l_mem threshold = applygcparam(g, PAUSE, g->GCmarked); + l_mem debt = threshold - gettotalbytes(g); + if (debt < 0) debt = 0; luaE_setdebt(g, debt); } @@ -1111,7 +1170,8 @@ static void sweep2old (lua_State *L, GCObject **p) { ** will also remove objects turned white here from any gray list. */ static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p, - GCObject *limit, GCObject **pfirstold1) { + GCObject *limit, GCObject **pfirstold1, + l_mem *paddedold) { static const lu_byte nextage[] = { G_SURVIVAL, /* from G_NEW */ G_OLD1, /* from G_SURVIVAL */ @@ -1121,6 +1181,7 @@ static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p, G_TOUCHED1, /* from G_TOUCHED1 (do not change) */ G_TOUCHED2 /* from G_TOUCHED2 (do not change) */ }; + l_mem addedold = 0; int white = luaC_white(g); GCObject *curr; while ((curr = *p) != limit) { @@ -1130,42 +1191,38 @@ static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p, freeobj(L, curr); /* erase 'curr' */ } else { /* correct mark and age */ - if (getage(curr) == G_NEW) { /* new objects go back to white */ + int age = getage(curr); + if (age == G_NEW) { /* new objects go back to white */ int marked = curr->marked & ~maskgcbits; /* erase GC bits */ curr->marked = cast_byte(marked | G_SURVIVAL | white); } else { /* all other objects will be old, and so keep their color */ - setage(curr, nextage[getage(curr)]); - if (getage(curr) == G_OLD1 && *pfirstold1 == NULL) - *pfirstold1 = curr; /* first OLD1 object in the list */ + lua_assert(age != G_OLD1); /* advanced in 'markold' */ + setage(curr, nextage[age]); + if (getage(curr) == G_OLD1) { + addedold += objsize(curr); /* bytes becoming old */ + if (*pfirstold1 == NULL) + *pfirstold1 = curr; /* first OLD1 object in the list */ + } } p = &curr->next; /* go to next element */ } } + *paddedold += addedold; return p; } /* -** Traverse a list making all its elements white and clearing their -** age. In incremental mode, all objects are 'new' all the time, -** except for fixed strings (which are always old). -*/ -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 & ~maskgcbits) | white); -} - - -/* -** Correct a list of gray objects. Return pointer to where rest of the -** list should be linked. +** Correct a list of gray objects. Return a pointer to the last element +** left on the list, so that we can link another list to the end of +** this one. ** Because this correction is done after sweeping, young objects might ** be turned white and still be in the list. They are only removed. ** 'TOUCHED1' objects are advanced to 'TOUCHED2' and remain on the list; -** Non-white threads also remain on the list; 'TOUCHED2' objects become -** regular old; they and anything else are removed from the list. +** Non-white threads also remain on the list. 'TOUCHED2' objects and +** anything else become regular old, are marked black, and are removed +** from the list. */ static GCObject **correctgraylist (GCObject **p) { GCObject *curr; @@ -1176,7 +1233,7 @@ static GCObject **correctgraylist (GCObject **p) { else if (getage(curr) == G_TOUCHED1) { /* touched in this cycle? */ lua_assert(isgray(curr)); nw2black(curr); /* make it black, for next barrier */ - changeage(curr, G_TOUCHED1, G_TOUCHED2); + setage(curr, G_TOUCHED2); goto remain; /* keep it in the list and go to next element */ } else if (curr->tt == LUA_VTHREAD) { @@ -1186,7 +1243,7 @@ static GCObject **correctgraylist (GCObject **p) { else { /* everything else is removed */ lua_assert(isold(curr)); /* young objects should be white here */ if (getage(curr) == G_TOUCHED2) /* advance from TOUCHED2... */ - changeage(curr, G_TOUCHED2, G_OLD); /* ... to OLD */ + setage(curr, G_OLD); /* ... to OLD */ nw2black(curr); /* make object black (to be removed) */ goto remove; } @@ -1213,15 +1270,15 @@ static void correctgraylists (global_State *g) { /* ** Mark black '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. +** 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)); - changeage(p, G_OLD1, G_OLD); /* now they are old */ + setage(p, G_OLD); /* now they are old */ if (isblack(p)) reallymarkobject(g, p); } @@ -1241,12 +1298,43 @@ static void finishgencycle (lua_State *L, global_State *g) { } +/* +** Shifts from a minor collection to major collections. It starts in +** the "sweep all" state to clear all objects, which are mostly black +** in generational mode. +*/ +static void minor2inc (lua_State *L, global_State *g, lu_byte kind) { + g->GCmajorminor = g->GCmarked; /* number of live bytes */ + g->gckind = kind; + g->reallyold = g->old1 = g->survival = NULL; + g->finobjrold = g->finobjold1 = g->finobjsur = NULL; + entersweep(L); /* continue as an incremental cycle */ + /* set a debt equal to the step size */ + luaE_setdebt(g, applygcparam(g, STEPSIZE, 100)); +} + + +/* +** Decide whether to shift to major mode. It shifts if the accumulated +** number of added old bytes (counted in 'GCmarked') is larger than +** 'minormajor'% of the number of lived bytes after the last major +** collection. (This number is kept in 'GCmajorminor'.) +*/ +static int checkminormajor (global_State *g) { + l_mem limit = applygcparam(g, MINORMAJOR, g->GCmajorminor); + if (limit == 0) + return 0; /* special case: 'minormajor' 0 stops major collections */ + return (g->GCmarked >= limit); +} + /* ** Does a young collection. First, mark 'OLD1' objects. Then does the -** atomic step. Then, sweep all lists and advance pointers. Finally, -** finish the collection. +** atomic step. Then, check whether to continue in minor mode. If so, +** sweep all lists and advance pointers. Finally, finish the collection. */ static void youngcollection (lua_State *L, global_State *g) { + l_mem addedold1 = 0; + l_mem marked = g->GCmarked; /* preserve 'g->GCmarked' */ GCObject **psurvival; /* to point to first non-dead survival object */ GCObject *dummy; /* dummy out parameter to 'sweepgen' */ lua_assert(g->gcstate == GCSpropagate); @@ -1256,28 +1344,39 @@ static void youngcollection (lua_State *L, global_State *g) { } markold(g, g->finobj, g->finobjrold); markold(g, g->tobefnz, NULL); - atomic(L); + + atomic(L); /* will lose 'g->marked' */ /* sweep nursery and get a pointer to its last live element */ g->gcstate = GCSswpallgc; - psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1); + psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1, &addedold1); /* sweep 'survival' */ - sweepgen(L, g, psurvival, g->old1, &g->firstold1); + sweepgen(L, g, psurvival, g->old1, &g->firstold1, &addedold1); g->reallyold = g->old1; g->old1 = *psurvival; /* 'survival' survivals are old now */ g->survival = g->allgc; /* all news are survivals */ /* repeat for 'finobj' lists */ dummy = NULL; /* no 'firstold1' optimization for 'finobj' lists */ - psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy); + psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy, &addedold1); /* sweep 'survival' */ - sweepgen(L, g, psurvival, g->finobjold1, &dummy); + sweepgen(L, g, psurvival, g->finobjold1, &dummy, &addedold1); g->finobjrold = g->finobjold1; g->finobjold1 = *psurvival; /* 'survival' survivals are old now */ g->finobjsur = g->finobj; /* all news are survivals */ - sweepgen(L, g, &g->tobefnz, NULL, &dummy); - finishgencycle(L, g); + sweepgen(L, g, &g->tobefnz, NULL, &dummy, &addedold1); + + /* keep total number of added old1 bytes */ + g->GCmarked = marked + addedold1; + + /* decide whether to shift to major mode */ + if (checkminormajor(g)) { + minor2inc(L, g, KGC_GENMAJOR); /* go to major mode */ + g->GCmarked = 0; /* avoid pause in first major cycle (see 'setpause') */ + } + else + finishgencycle(L, g); /* still in minor mode; finish it */ } @@ -1302,19 +1401,21 @@ static void atomic2gen (lua_State *L, global_State *g) { sweep2old(L, &g->tobefnz); - g->gckind = KGC_GEN; - g->lastatomic = 0; - g->GCestimate = gettotalbytes(g); /* base for memory control */ + g->gckind = KGC_GENMINOR; + g->GCmajorminor = g->GCmarked; /* "base" for number of bytes */ + g->GCmarked = 0; /* to count the number of added old1 bytes */ finishgencycle(L, g); } /* ** Set debt for the next minor collection, which will happen when -** memory grows 'genminormul'%. +** total number of bytes grows 'genminormul'% in relation to +** the base, GCmajorminor, which is the number of bytes being used +** after the last major collection. */ static void setminordebt (global_State *g) { - luaE_setdebt(g, -(cast(l_mem, (gettotalbytes(g) / 100)) * g->genminormul)); + luaE_setdebt(g, applygcparam(g, MINORMUL, g->GCmajorminor)); } @@ -1324,31 +1425,12 @@ static void setminordebt (global_State *g) { ** are cleared. 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 */ +static void entergen (lua_State *L, global_State *g) { + luaC_runtilstate(L, GCSpause, 1); /* prepare to start a new cycle */ + luaC_runtilstate(L, GCSpropagate, 1); /* start new cycle */ + atomic(L); /* propagates all and then do the atomic stuff */ atomic2gen(L, g); setminordebt(g); /* set debt assuming next cycle will be minor */ - 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->old1 = g->survival = NULL; - whitelist(g, g->finobj); - whitelist(g, g->tobefnz); - g->finobjrold = g->finobjold1 = g->finobjsur = NULL; - g->gcstate = GCSpause; - g->gckind = KGC_INC; - g->lastatomic = 0; } @@ -1357,111 +1439,49 @@ static void enterinc (global_State *g) { */ void luaC_changemode (lua_State *L, int newmode) { global_State *g = G(L); - if (newmode != g->gckind) { - if (newmode == KGC_GEN) /* entering generational mode? */ + if (g->gckind == KGC_GENMAJOR) /* doing major collections? */ + g->gckind = KGC_INC; /* already incremental but in name */ + if (newmode != g->gckind) { /* does it need to change? */ + if (newmode == KGC_INC) /* entering incremental mode? */ + minor2inc(L, g, KGC_INC); /* entering incremental mode */ + else { + lua_assert(newmode == KGC_GENMINOR); 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); -} - - -/* -** 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; - } +static void fullgen (lua_State *L, global_State *g) { + minor2inc(L, g, KGC_INC); + entergen(L, g); } /* -** 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. */ - lua_assert(g->lastatomic == 0); - } - 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); +** After an atomic incremental step from a major collection, +** check whether collector could return to minor collections. +** It checks whether the number of bytes 'tobecollected' +** is greater than 'majorminor'% of the number of bytes added +** since the last collection ('addedbytes'). +*/ +static int checkmajorminor (lua_State *L, global_State *g) { + if (g->gckind == KGC_GENMAJOR) { /* generational mode? */ + l_mem numbytes = gettotalbytes(g); + l_mem addedbytes = numbytes - g->GCmajorminor; + l_mem limit = applygcparam(g, MAJORMINOR, addedbytes); + l_mem tobecollected = numbytes - g->GCmarked; + if (tobecollected > limit) { + atomic2gen(L, g); /* return to generational mode */ setminordebt(g); - g->GCestimate = majorbase; /* preserve base value */ + return 1; /* exit incremental collection */ } } - lua_assert(isdecGCmodegen(g)); + g->GCmajorminor = g->GCmarked; /* prepare for next collection */ + return 0; /* stay doing incremental collections */ } /* }====================================================== */ @@ -1513,32 +1533,31 @@ void luaC_freeallobjects (lua_State *L) { separatetobefnz(g, 1); /* separate all objects with finalizers */ lua_assert(g->finobj == NULL); callallpendingfinalizers(L); - deletelist(L, g->allgc, obj2gco(g->mainthread)); + deletelist(L, g->allgc, obj2gco(mainthread(g))); lua_assert(g->finobj == NULL); /* no new finalizers */ deletelist(L, g->fixedgc, NULL); /* collect fixed objects */ lua_assert(g->strt.nuse == 0); } -static lu_mem atomic (lua_State *L) { +static void atomic (lua_State *L) { global_State *g = G(L); - 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)); + lua_assert(!iswhite(mainthread(g))); 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 */ + propagateall(g); /* empties 'gray' list */ /* remark occasional upvalues of (maybe) dead threads */ - work += remarkupvals(g); - work += propagateall(g); /* propagate changes */ + remarkupvals(g); + propagateall(g); /* propagate changes */ g->gray = grayagain; - work += propagateall(g); /* traverse 'grayagain' list */ + propagateall(g); /* traverse 'grayagain' list */ convergeephemerons(g); /* at this point, all strongly accessible objects are marked. */ /* Clear values from weak tables, before checking finalizers */ @@ -1546,154 +1565,196 @@ static lu_mem atomic (lua_State *L) { clearbyvalues(g, g->allweak, NULL); origweak = g->weak; origall = g->allweak; separatetobefnz(g, 0); /* separate objects to be finalized */ - work += markbeingfnz(g); /* mark objects that will be finalized */ - work += propagateall(g); /* remark, to propagate 'resurrection' */ + markbeingfnz(g); /* mark objects that will be finalized */ + propagateall(g); /* remark, to propagate 'resurrection' */ convergeephemerons(g); /* at this point, all resurrected objects are marked. */ /* remove dead objects from weak tables */ - clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron tables */ - clearbykeys(g, g->allweak); /* clear keys from all 'allweak' tables */ + clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron */ + clearbykeys(g, g->allweak); /* clear keys from all 'allweak' */ /* clear values from resurrected weak tables */ clearbyvalues(g, g->weak, origweak); clearbyvalues(g, g->allweak, origall); luaS_clearcache(g); g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */ lua_assert(g->gray == NULL); - return work; /* estimate of slots marked by 'atomic' */ } -static int sweepstep (lua_State *L, global_State *g, - int nextstate, GCObject **nextlist) { - if (g->sweepgc) { - l_mem olddebt = g->GCdebt; - int count; - g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX, &count); - g->GCestimate += g->GCdebt - olddebt; /* update estimate */ - return count; - } +/* +** Do a sweep step. The normal case (not fast) sweeps at most GCSWEEPMAX +** elements. The fast case sweeps the whole list. +*/ +static void sweepstep (lua_State *L, global_State *g, + lu_byte nextstate, GCObject **nextlist, int fast) { + if (g->sweepgc) + g->sweepgc = sweeplist(L, g->sweepgc, fast ? MAX_LMEM : GCSWEEPMAX); else { /* enter next state */ g->gcstate = nextstate; g->sweepgc = nextlist; - return 0; /* no work done */ } } -static lu_mem singlestep (lua_State *L) { +/* +** Performs one incremental "step" in an incremental garbage collection. +** For indivisible work, a step goes to the next state. When marking +** (propagating), a step traverses one object. When sweeping, a step +** sweeps GCSWEEPMAX objects, to avoid a big overhead for sweeping +** objects one by one. (Sweeping is inexpensive, no matter the +** object.) When 'fast' is true, 'singlestep' tries to finish a state +** "as fast as possible". In particular, it skips the propagation +** phase and leaves all objects to be traversed by the atomic phase: +** That avoids traversing twice some objects, such as threads and +** weak tables. +*/ + +#define step2pause -3 /* finished collection; entered pause state */ +#define atomicstep -2 /* atomic step */ +#define step2minor -1 /* moved to minor collections */ + + +static l_mem singlestep (lua_State *L, int fast) { global_State *g = G(L); - lu_mem work; + l_mem stepresult; lua_assert(!g->gcstopem); /* collector is not reentrant */ g->gcstopem = 1; /* no emergency collections while collecting */ switch (g->gcstate) { case GCSpause: { restartcollection(g); g->gcstate = GCSpropagate; - work = 1; + stepresult = 1; break; } case GCSpropagate: { - if (g->gray == NULL) { /* no more gray objects? */ + if (fast || g->gray == NULL) { g->gcstate = GCSenteratomic; /* finish propagate phase */ - work = 0; + stepresult = 1; } else - work = propagatemark(g); /* traverse one gray object */ + stepresult = propagatemark(g); /* traverse one gray object */ break; } case GCSenteratomic: { - work = atomic(L); /* work is what was traversed by 'atomic' */ - entersweep(L); - g->GCestimate = gettotalbytes(g); /* first estimate */; + atomic(L); + if (checkmajorminor(L, g)) + stepresult = step2minor; + else { + entersweep(L); + stepresult = atomicstep; + } break; } case GCSswpallgc: { /* sweep "regular" objects */ - work = sweepstep(L, g, GCSswpfinobj, &g->finobj); + sweepstep(L, g, GCSswpfinobj, &g->finobj, fast); + stepresult = GCSWEEPMAX; break; } case GCSswpfinobj: { /* sweep objects with finalizers */ - work = sweepstep(L, g, GCSswptobefnz, &g->tobefnz); + sweepstep(L, g, GCSswptobefnz, &g->tobefnz, fast); + stepresult = GCSWEEPMAX; break; } case GCSswptobefnz: { /* sweep objects to be finalized */ - work = sweepstep(L, g, GCSswpend, NULL); + sweepstep(L, g, GCSswpend, NULL, fast); + stepresult = GCSWEEPMAX; break; } case GCSswpend: { /* finish sweeps */ checkSizes(L, g); g->gcstate = GCScallfin; - work = 0; + stepresult = GCSWEEPMAX; break; } - case GCScallfin: { /* call remaining finalizers */ + case GCScallfin: { /* call finalizers */ if (g->tobefnz && !g->gcemergency) { g->gcstopem = 0; /* ok collections during finalizers */ - work = runafewfinalizers(L, GCFINMAX) * GCFINALIZECOST; + GCTM(L); /* call one finalizer */ + stepresult = CWUFIN; } else { /* emergency mode or no more finalizers */ g->gcstate = GCSpause; /* finish collection */ - work = 0; + stepresult = step2pause; } break; } default: lua_assert(0); return 0; } g->gcstopem = 0; - return work; + return stepresult; } /* -** advances the garbage collector until it reaches a state allowed -** by 'statemask' +** Advances the garbage collector until it reaches the given state. +** (The option 'fast' is only for testing; in normal code, 'fast' +** here is always true.) */ -void luaC_runtilstate (lua_State *L, int statesmask) { +void luaC_runtilstate (lua_State *L, int state, int fast) { global_State *g = G(L); - while (!testbit(statesmask, g->gcstate)) - singlestep(L); + lua_assert(g->gckind == KGC_INC); + while (state != g->gcstate) + singlestep(L, fast); } /* -** Performs a basic incremental step. The debt and step size are +** Performs a basic incremental step. The step size is ** 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 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); + l_mem stepsize = applygcparam(g, STEPSIZE, 100); + l_mem work2do = applygcparam(g, STEPMUL, stepsize / cast_int(sizeof(void*))); + l_mem stres; + int fast = (work2do == 0); /* special case: do a full collection */ + do { /* repeat until enough work */ + stres = singlestep(L, fast); /* perform one single step */ + if (stres == step2minor) /* returned to minor collections? */ + return; /* nothing else to be done here */ + else if (stres == step2pause || (stres == atomicstep && !fast)) + break; /* end of cycle or atomic */ + else + work2do -= stres; + } while (fast || work2do > 0); if (g->gcstate == GCSpause) setpause(g); /* pause until next cycle */ - else { - debt = (debt / stepmul) * WORK2MEM; /* convert 'work units' to bytes */ - luaE_setdebt(g, debt); - } + else + luaE_setdebt(g, stepsize); } + +#if !defined(luai_tracegc) +#define luai_tracegc(L,f) ((void)0) +#endif + /* -** Performs a basic GC step if collector is running. (If collector is -** not running, set a reasonable debt to avoid it being called at -** every single check.) +** Performs a basic GC step if collector is running. (If collector was +** stopped by the user, set a reasonable debt to avoid it being called +** at every single check.) */ void luaC_step (lua_State *L) { global_State *g = G(L); - if (!gcrunning(g)) /* not running? */ - luaE_setdebt(g, -2000); + lua_assert(!g->gcemergency); + if (!gcrunning(g)) { /* not running? */ + if (g->gcstp & GCSTPUSR) /* stopped by the user? */ + luaE_setdebt(g, 20000); + } else { - if(isdecGCmodegen(g)) - genstep(L, g); - else - incstep(L, g); + luai_tracegc(L, 1); /* for internal debugging */ + switch (g->gckind) { + case KGC_INC: case KGC_GENMAJOR: + incstep(L, g); + break; + case KGC_GENMINOR: + youngcollection(L, g); + setminordebt(g); + break; + } + luai_tracegc(L, 0); /* for internal debugging */ } } @@ -1709,11 +1770,9 @@ 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 */ + luaC_runtilstate(L, GCSpause, 1); + luaC_runtilstate(L, GCScallfin, 1); /* run up to finalizers */ + luaC_runtilstate(L, GCSpause, 1); /* finish collection */ setpause(g); } @@ -1726,11 +1785,16 @@ static void fullinc (lua_State *L, global_State *g) { void luaC_fullgc (lua_State *L, int isemergency) { global_State *g = G(L); lua_assert(!g->gcemergency); - g->gcemergency = isemergency; /* set flag */ - if (g->gckind == KGC_INC) - fullinc(L, g); - else - fullgen(L, g); + g->gcemergency = cast_byte(isemergency); /* set flag */ + switch (g->gckind) { + case KGC_GENMINOR: fullgen(L, g); break; + case KGC_INC: fullinc(L, g); break; + case KGC_GENMAJOR: + g->gckind = KGC_INC; + fullinc(L, g); + g->gckind = KGC_GENMAJOR; + break; + } g->gcemergency = 0; } diff --git a/lgc.h b/lgc.h index 538f6edccc..ee0541793b 100644 --- a/lgc.h +++ b/lgc.h @@ -8,6 +8,9 @@ #define lgc_h +#include + + #include "lobject.h" #include "lstate.h" @@ -20,8 +23,9 @@ ** never point to a white one. Moreover, any gray object must be in a ** "gray list" (gray, grayagain, weak, allweak, ephemeron) so that it ** can be visited again before finishing the collection cycle. (Open -** upvalues are an exception to this rule.) These lists have no meaning -** when the invariant is not being enforced (e.g., sweep phase). +** upvalues are an exception to this rule, as they are attached to +** a corresponding thread.) These lists have no meaning when the +** invariant is not being enforced (e.g., sweep phase). */ @@ -45,10 +49,10 @@ /* ** macro to tell when main invariant (white objects cannot point to black -** ones) must be kept. During a collection, the sweep -** phase may break the invariant, as objects turned white may point to -** still-black objects. The invariant is restored when sweep ends and -** all objects are white again. +** ones) must be kept. During a collection, the sweep phase may break +** the invariant, as objects turned white may point to still-black +** objects. The invariant is restored when sweep ends and all objects +** are white again. */ #define keepinvariant(g) ((g)->gcstate <= GCSatomic) @@ -117,36 +121,90 @@ #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))) +/* +** In generational mode, objects are created 'new'. After surviving one +** cycle, they become 'survival'. Both 'new' and 'survival' can point +** to any other object, as they are traversed at the end of the cycle. +** We call them both 'young' objects. +** If a survival object survives another cycle, it becomes 'old1'. +** 'old1' objects can still point to survival objects (but not to +** new objects), so they still must be traversed. After another cycle +** (that, being old, 'old1' objects will "survive" no matter what) +** finally the 'old1' object becomes really 'old', and then they +** are no more traversed. +** +** To keep its invariants, the generational mode uses the same barriers +** also used by the incremental mode. If a young object is caught in a +** forward barrier, it cannot become old immediately, because it can +** still point to other young objects. Instead, it becomes 'old0', +** which in the next cycle becomes 'old1'. So, 'old0' objects is +** old but can point to new and survival objects; 'old1' is old +** but cannot point to new objects; and 'old' cannot point to any +** young object. +** +** If any old object ('old0', 'old1', 'old') is caught in a back +** barrier, it becomes 'touched1' and goes into a gray list, to be +** visited at the end of the cycle. There it evolves to 'touched2', +** which can point to survivals but not to new objects. In yet another +** cycle then it becomes 'old' again. +** +** The generational mode must also control the colors of objects, +** because of the barriers. While the mutator is running, young objects +** are kept white. 'old', 'old1', and 'touched2' objects are kept black, +** as they cannot point to new objects; exceptions are threads and open +** upvalues, which age to 'old1' and 'old' but are kept gray. 'old0' +** objects may be gray or black, as in the incremental mode. 'touched1' +** objects are kept gray, as they must be visited again at the end of +** the cycle. +*/ -/* 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 +/* +** {====================================================== +** Default Values for GC parameters +** ======================================================= +*/ /* -** some gc parameters are stored divided by 4 to allow a maximum value -** up to 1023 in a 'lu_byte'. +** Minor collections will shift to major ones after LUAI_MINORMAJOR% +** bytes become old. */ -#define getgcparam(p) ((p) * 4) -#define setgcparam(p,v) ((p) = (v) / 4) +#define LUAI_MINORMAJOR 70 -#define LUAI_GCMUL 100 +/* +** Major collections will shift to minor ones after a collection +** collects at least LUAI_MAJORMINOR% of the new bytes. +*/ +#define LUAI_MAJORMINOR 50 -/* how much to allocate before next GC step (log2) */ -#define LUAI_GCSTEPSIZE 13 /* 8 KB */ +/* +** A young (minor) collection will run after creating LUAI_GENMINORMUL% +** new bytes. +*/ +#define LUAI_GENMINORMUL 20 + + +/* incremental */ +/* Number of bytes must be LUAI_GCPAUSE% before starting new cycle */ +#define LUAI_GCPAUSE 250 /* -** 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'. +** Step multiplier: The collector handles LUAI_GCMUL% work units for +** each new allocated word. (Each "work unit" corresponds roughly to +** sweeping one object or traversing one slot.) */ -#define isdecGCmodegen(g) (g->gckind == KGC_GEN || g->lastatomic != 0) +#define LUAI_GCMUL 200 + +/* How many bytes to allocate before next GC step */ +#define LUAI_GCSTEPSIZE (200 * sizeof(Table)) + + +#define setgcparam(g,p,v) (g->gcparams[LUA_GCP##p] = luaO_codeparam(v)) +#define applygcparam(g,p,x) luaO_applyparam(g->gcparams[LUA_GCP##p], x) + +/* }====================================================== */ /* @@ -159,14 +217,22 @@ /* -** Does one step of collection when debt becomes positive. 'pre'/'pos' +** Does one step of collection when debt becomes zero. 'pre'/'pos' ** allows some adjustments to be done only when needed. macro ** 'condchangemem' is used only for heavy tests (forcing a full ** GC cycle on every opportunity) */ + +#if !defined(HARDMEMTESTS) +#define condchangemem(L,pre,pos,emg) ((void)0) +#else +#define condchangemem(L,pre,pos,emg) \ + { if (gcrunning(G(L))) { pre; luaC_fullgc(L, emg); pos; } } +#endif + #define luaC_condGC(L,pre,pos) \ - { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \ - condchangemem(L,pre,pos); } + { if (G(L)->GCdebt <= 0) { pre; luaC_step(L); pos;}; \ + condchangemem(L,pre,pos,0); } /* more often than not, 'pre'/'pos' are empty */ #define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0) @@ -188,10 +254,10 @@ 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); -LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask); +LUAI_FUNC void luaC_runtilstate (lua_State *L, int state, int fast); 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 GCObject *luaC_newobjdt (lua_State *L, int tt, size_t sz, +LUAI_FUNC GCObject *luaC_newobj (lua_State *L, lu_byte tt, size_t sz); +LUAI_FUNC GCObject *luaC_newobjdt (lua_State *L, lu_byte tt, size_t sz, size_t offset); LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v); LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o); diff --git a/linit.c b/linit.c index 69808f84f4..00d06f7ecb 100644 --- a/linit.c +++ b/linit.c @@ -8,21 +8,6 @@ #define linit_c #define LUA_LIB -/* -** If you embed Lua in your program and need to open the standard -** libraries, call luaL_openlibs in your program. If you need a -** different set of libraries, copy this file to your project and edit -** it to suit your needs. -** -** You can also *preload* libraries, so that a later 'require' can -** open the library, which is already linked to the application. -** For that, do the following code: -** -** luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE); -** lua_pushcfunction(L, luaopen_modname); -** lua_setfield(L, -2, modname); -** lua_pop(L, 1); // remove PRELOAD table -*/ #include "lprefix.h" @@ -33,33 +18,46 @@ #include "lualib.h" #include "lauxlib.h" +#include "llimits.h" /* -** these libs are loaded by lua.c and are readily available to any Lua -** program +** Standard Libraries. (Must be listed in the same ORDER of their +** respective constants LUA_K.) */ -static const luaL_Reg loadedlibs[] = { +static const luaL_Reg stdlibs[] = { {LUA_GNAME, luaopen_base}, {LUA_LOADLIBNAME, luaopen_package}, {LUA_COLIBNAME, luaopen_coroutine}, - {LUA_TABLIBNAME, luaopen_table}, + {LUA_DBLIBNAME, luaopen_debug}, {LUA_IOLIBNAME, luaopen_io}, + {LUA_MATHLIBNAME, luaopen_math}, {LUA_OSLIBNAME, luaopen_os}, {LUA_STRLIBNAME, luaopen_string}, - {LUA_MATHLIBNAME, luaopen_math}, + {LUA_TABLIBNAME, luaopen_table}, {LUA_UTF8LIBNAME, luaopen_utf8}, - {LUA_DBLIBNAME, luaopen_debug}, {NULL, NULL} }; -LUALIB_API void luaL_openlibs (lua_State *L) { +/* +** require and preload selected standard libraries +*/ +LUALIB_API void luaL_openselectedlibs (lua_State *L, int load, int preload) { + int mask; const luaL_Reg *lib; - /* "require" functions from 'loadedlibs' and set results to global table */ - for (lib = loadedlibs; lib->func; lib++) { - luaL_requiref(L, lib->name, lib->func, 1); - lua_pop(L, 1); /* remove lib */ + luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE); + for (lib = stdlibs, mask = 1; lib->name != NULL; lib++, mask <<= 1) { + if (load & mask) { /* selected? */ + luaL_requiref(L, lib->name, lib->func, 1); /* require library */ + lua_pop(L, 1); /* remove result from the stack */ + } + else if (preload & mask) { /* selected? */ + lua_pushcfunction(L, lib->func); + lua_setfield(L, -2, lib->name); /* add library to PRELOAD table */ + } } + lua_assert((mask >> 1) == LUA_UTF8LIBK); + lua_pop(L, 1); /* remove PRELOAD table */ } diff --git a/liolib.c b/liolib.c index b08397da45..57615e6f32 100644 --- a/liolib.c +++ b/liolib.c @@ -21,8 +21,7 @@ #include "lauxlib.h" #include "lualib.h" - - +#include "llimits.h" /* @@ -115,7 +114,7 @@ static int l_checkmode (const char *mode) { #if !defined(l_fseek) /* { */ -#if defined(LUA_USE_POSIX) /* { */ +#if defined(LUA_USE_POSIX) || defined(LUA_USE_OFF_T) /* { */ #include @@ -245,8 +244,8 @@ static int f_gc (lua_State *L) { */ static int io_fclose (lua_State *L) { LStream *p = tolstream(L); - int res = fclose(p->f); - return luaL_fileresult(L, (res == 0), NULL); + errno = 0; + return luaL_fileresult(L, (fclose(p->f) == 0), NULL); } @@ -272,6 +271,7 @@ static int io_open (lua_State *L) { LStream *p = newfile(L); const char *md = mode; /* to traverse/check mode */ luaL_argcheck(L, l_checkmode(md), 2, "invalid mode"); + errno = 0; p->f = fopen(filename, mode); return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; } @@ -292,6 +292,7 @@ static int io_popen (lua_State *L) { const char *mode = luaL_optstring(L, 2, "r"); LStream *p = newprefile(L); luaL_argcheck(L, l_checkmodep(mode), 2, "invalid mode"); + errno = 0; p->f = l_popen(L, filename, mode); p->closef = &io_pclose; return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; @@ -300,6 +301,7 @@ static int io_popen (lua_State *L) { static int io_tmpfile (lua_State *L) { LStream *p = newfile(L); + errno = 0; p->f = tmpfile(); return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1; } @@ -441,7 +443,7 @@ static int nextc (RN *rn) { return 0; /* fail */ } else { - rn->buff[rn->n++] = rn->c; /* save current char */ + rn->buff[rn->n++] = cast_char(rn->c); /* save current char */ rn->c = l_getc(rn->f); /* read next one */ return 1; } @@ -522,15 +524,15 @@ static int read_line (lua_State *L, FILE *f, int chop) { luaL_buffinit(L, &b); do { /* may need to read several chunks to get whole line */ char *buff = luaL_prepbuffer(&b); /* preallocate buffer space */ - int i = 0; + unsigned 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; /* read up to end of line or buffer limit */ + buff[i++] = cast_char(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_addchar(&b, '\n'); /* add ending newline to result */ luaL_pushresult(&b); /* close buffer */ /* return ok if read something (either a newline or something else) */ return (c == '\n' || lua_rawlen(L, -1) > 0); @@ -567,6 +569,7 @@ static int g_read (lua_State *L, FILE *f, int first) { int nargs = lua_gettop(L) - 1; int n, success; clearerr(f); + errno = 0; if (nargs == 0) { /* no arguments? */ success = read_line(L, f, 1); n = first + 1; /* to return 1 result */ @@ -659,26 +662,28 @@ static int io_readline (lua_State *L) { static int g_write (lua_State *L, FILE *f, int arg) { int nargs = lua_gettop(L) - arg; - int status = 1; - for (; nargs--; arg++) { - if (lua_type(L, arg) == LUA_TNUMBER) { - /* optimization: could be done exactly as for strings */ - int len = lua_isinteger(L, arg) - ? fprintf(f, LUA_INTEGER_FMT, - (LUAI_UACINT)lua_tointeger(L, arg)) - : fprintf(f, LUA_NUMBER_FMT, - (LUAI_UACNUMBER)lua_tonumber(L, arg)); - status = status && (len > 0); + size_t totalbytes = 0; /* total number of bytes written */ + errno = 0; + for (; nargs--; arg++) { /* for each argument */ + char buff[LUA_N2SBUFFSZ]; + const char *s; + size_t numbytes; /* bytes written in one call to 'fwrite' */ + size_t len = lua_numbertocstring(L, arg, buff); /* try as a number */ + if (len > 0) { /* did conversion work (value was a number)? */ + s = buff; + len--; } - else { - size_t l; - const char *s = luaL_checklstring(L, arg, &l); - status = status && (fwrite(s, sizeof(char), l, f) == l); + else /* must be a string */ + s = luaL_checklstring(L, arg, &len); + numbytes = fwrite(s, sizeof(char), len, f); + totalbytes += numbytes; + if (numbytes < len) { /* write error? */ + int n = luaL_fileresult(L, 0, NULL); + lua_pushinteger(L, cast_st2S(totalbytes)); + return n + 1; /* return fail, error msg., error code, and counter */ } } - if (l_likely(status)) - return 1; /* file handle already on stack top */ - else return luaL_fileresult(L, status, NULL); + return 1; /* no errors; file handle already on stack top */ } @@ -703,6 +708,7 @@ static int f_seek (lua_State *L) { l_seeknum offset = (l_seeknum)p3; luaL_argcheck(L, (lua_Integer)offset == p3, 3, "not an integer in proper range"); + errno = 0; op = l_fseek(f, offset, mode[op]); if (l_unlikely(op)) return luaL_fileresult(L, 0, NULL); /* error */ @@ -719,19 +725,26 @@ static int f_setvbuf (lua_State *L) { FILE *f = tofile(L); int op = luaL_checkoption(L, 2, NULL, modenames); lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE); - int res = setvbuf(f, NULL, mode[op], (size_t)sz); + int res; + errno = 0; + res = setvbuf(f, NULL, mode[op], (size_t)sz); return luaL_fileresult(L, res == 0, NULL); } - -static int io_flush (lua_State *L) { - return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); +static int aux_flush (lua_State *L, FILE *f) { + errno = 0; + return luaL_fileresult(L, fflush(f) == 0, NULL); } static int f_flush (lua_State *L) { - return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL); + return aux_flush(L, tofile(L)); +} + + +static int io_flush (lua_State *L) { + return aux_flush(L, getiofile(L, IO_OUTPUT)); } @@ -773,7 +786,7 @@ static const luaL_Reg meth[] = { ** metamethods for file handles */ static const luaL_Reg metameth[] = { - {"__index", NULL}, /* place holder */ + {"__index", NULL}, /* placeholder */ {"__gc", f_gc}, {"__close", f_gc}, {"__tostring", f_tostring}, diff --git a/ljumptab.h b/ljumptab.h index 8306f250cc..52fa6d746e 100644 --- a/ljumptab.h +++ b/ljumptab.h @@ -21,7 +21,7 @@ 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 +** sed -n '/^OP_/!d; s/OP_/\&\&L_OP_/ ; s/,.*/,/ ; s/\/.*// ; p' lopcodes.h ** #endif @@ -57,8 +57,8 @@ static const void *const disptab[NUM_OPCODES] = { &&L_OP_BANDK, &&L_OP_BORK, &&L_OP_BXORK, -&&L_OP_SHRI, &&L_OP_SHLI, +&&L_OP_SHRI, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, @@ -106,6 +106,8 @@ static const void *const disptab[NUM_OPCODES] = { &&L_OP_SETLIST, &&L_OP_CLOSURE, &&L_OP_VARARG, +&&L_OP_GETVARG, +&&L_OP_ERRNNIL, &&L_OP_VARARGPREP, &&L_OP_EXTRAARG diff --git a/llex.c b/llex.c index b0dc0acc24..f8bb3ea4b4 100644 --- a/llex.c +++ b/llex.c @@ -32,6 +32,11 @@ #define next(ls) (ls->current = zgetc(ls->z)) +/* minimum size for string buffer */ +#if !defined(LUA_MINBUFFER) +#define LUA_MINBUFFER 32 +#endif + #define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r') @@ -39,7 +44,7 @@ /* ORDER RESERVED */ static const char *const luaX_tokens [] = { "and", "break", "do", "else", "elseif", - "end", "false", "for", "function", "goto", "if", + "end", "false", "for", "function", "global", "goto", "if", "in", "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while", "//", "..", "...", "==", ">=", "<=", "~=", @@ -57,10 +62,10 @@ static l_noret lexerror (LexState *ls, const char *msg, int token); static void save (LexState *ls, int c) { Mbuffer *b = ls->buff; if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) { - size_t newsize; - if (luaZ_sizebuffer(b) >= MAX_SIZE/2) + size_t newsize = luaZ_sizebuffer(b); /* get old size */; + if (newsize >= (MAX_SIZE/3 * 2)) /* larger than MAX_SIZE/1.5 ? */ lexerror(ls, "lexical element too long", 0); - newsize = luaZ_sizebuffer(b) * 2; + newsize += (newsize >> 1); /* new size is 1.5 times the old one */ luaZ_resizebuffer(ls->L, b, newsize); } b->buffer[luaZ_bufflen(b)++] = cast_char(c); @@ -122,30 +127,34 @@ l_noret luaX_syntaxerror (LexState *ls, const char *msg) { /* -** Creates a new string and anchors it in scanner's table so that it -** will not be collected until the end of the compilation; by that time -** it should be anchored somewhere. It also internalizes long strings, -** ensuring there is only one copy of each unique string. The table -** here is used as a set: the string enters as the key, while its value -** is irrelevant. We use the string itself as the value only because it -** is a TValue readly available. Later, the code generation can change -** this value. +** Anchors a string in scanner's table so that it will not be collected +** until the end of the compilation; by that time it should be anchored +** somewhere. It also internalizes long strings, ensuring there is only +** one copy of each unique string. */ -TString *luaX_newstring (LexState *ls, const char *str, size_t l) { +static TString *anchorstr (LexState *ls, TString *ts) { lua_State *L = ls->L; - TString *ts = luaS_newlstr(L, str, l); /* create new string */ - const TValue *o = luaH_getstr(ls->h, ts); - if (!ttisnil(o)) /* string already present? */ - ts = keystrval(nodefromval(o)); /* get saved copy */ - else { /* not in use yet */ + TValue oldts; + int tag = luaH_getstr(ls->h, ts, &oldts); + if (!tagisempty(tag)) /* string already present? */ + return tsvalue(&oldts); /* use stored value */ + else { /* create a new entry */ TValue *stv = s2v(L->top.p++); /* reserve stack space for string */ - setsvalue(L, stv, ts); /* temporarily anchor the string */ - luaH_finishset(L, ls->h, stv, o, stv); /* t[string] = string */ + setsvalue(L, stv, ts); /* push (anchor) the string on the stack */ + luaH_set(L, ls->h, stv, stv); /* t[string] = string */ /* table is not a metatable, so it does not need to invalidate cache */ luaC_checkGC(L); L->top.p--; /* remove string from stack */ + return ts; } - return ts; +} + + +/* +** Creates a new string and anchors it in scanner's table. +*/ +TString *luaX_newstring (LexState *ls, const char *str, size_t l) { + return anchorstr(ls, luaS_newlstr(ls->L, str, l)); } @@ -159,7 +168,7 @@ static void inclinenumber (LexState *ls) { next(ls); /* skip '\n' or '\r' */ if (currIsNewline(ls) && ls->current != old) next(ls); /* skip '\n\r' or '\r\n' */ - if (++ls->linenumber >= MAX_INT) + if (++ls->linenumber >= INT_MAX) lexerror(ls, "chunk has too many lines", 0); } @@ -175,7 +184,15 @@ void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source, ls->linenumber = 1; ls->lastline = 1; ls->source = source; - ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */ + /* all three strings here ("_ENV", "break", "global") were fixed, + so they cannot be collected */ + ls->envn = luaS_newliteral(L, LUA_ENV); /* get env string */ + ls->brkn = luaS_newliteral(L, "break"); /* get "break" string */ +#if defined(LUA_COMPAT_GLOBAL) + /* compatibility mode: "global" is not a reserved word */ + ls->glbn = luaS_newliteral(L, "global"); /* get "global" string */ + ls->glbn->extra = 0; /* mark it as not reserved */ +#endif luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */ } @@ -340,12 +357,17 @@ static int readhexaesc (LexState *ls) { } -static unsigned long readutf8esc (LexState *ls) { - unsigned long r; - int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */ +/* +** When reading a UTF-8 escape sequence, save everything to the buffer +** for error reporting in case of errors; 'i' counts the number of +** saved characters, so that they can be removed if case of success. +*/ +static l_uint32 readutf8esc (LexState *ls) { + l_uint32 r; + int i = 4; /* number of chars to be removed: start with #"\u{X" */ save_and_next(ls); /* skip 'u' */ esccheck(ls, ls->current == '{', "missing '{'"); - r = gethexa(ls); /* must have at least one digit */ + r = cast_uint(gethexa(ls)); /* must have at least one digit */ while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) { i++; esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large"); @@ -542,12 +564,13 @@ static int llex (LexState *ls, SemInfo *seminfo) { do { save_and_next(ls); } while (lislalnum(ls->current)); - ts = luaX_newstring(ls, luaZ_buffer(ls->buff), - luaZ_bufflen(ls->buff)); - seminfo->ts = ts; - if (isreserved(ts)) /* reserved word? */ + /* find or create string */ + ts = luaS_newlstr(ls->L, luaZ_buffer(ls->buff), + luaZ_bufflen(ls->buff)); + if (isreserved(ts)) /* reserved word? */ return ts->extra - 1 + FIRST_RESERVED; else { + seminfo->ts = anchorstr(ls, ts); return TK_NAME; } } diff --git a/llex.h b/llex.h index 389d2f8635..37016e8a3f 100644 --- a/llex.h +++ b/llex.h @@ -33,8 +33,8 @@ enum RESERVED { /* terminal symbols denoted by reserved words */ TK_AND = FIRST_RESERVED, TK_BREAK, TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION, - TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, - TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, + TK_GLOBAL, TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, + TK_REPEAT, TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, /* other terminal symbols */ TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_SHL, TK_SHR, @@ -59,7 +59,7 @@ typedef struct Token { } Token; -/* state of the lexer plus state of the parser when shared by all +/* state of the scanner plus state of the parser when shared by all functions */ typedef struct LexState { int current; /* current character (charint) */ @@ -75,6 +75,8 @@ typedef struct LexState { struct Dyndata *dyd; /* dynamic structures used by the parser */ TString *source; /* current source name */ TString *envn; /* environment variable name */ + TString *brkn; /* "break" name (used as a label) */ + TString *glbn; /* "global" name (when not a reserved word) */ } LexState; diff --git a/llimits.h b/llimits.h index 52a32f92e3..fc5cb276f6 100644 --- a/llimits.h +++ b/llimits.h @@ -15,50 +15,49 @@ #include "lua.h" +#define l_numbits(t) cast_int(sizeof(t) * CHAR_BIT) + /* -** '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 +** 'l_mem' is a signed integer big enough to count the total memory +** used by Lua. (It is signed due to the use of debt in several +** computations.) 'lu_mem' is a corresponding unsigned type. Usually, ** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines. */ #if defined(LUAI_MEM) /* { external definitions? */ -typedef LUAI_UMEM lu_mem; typedef LUAI_MEM l_mem; +typedef LUAI_UMEM lu_mem; #elif LUAI_IS32INT /* }{ */ -typedef size_t lu_mem; typedef ptrdiff_t l_mem; +typedef size_t lu_mem; #else /* 16-bit ints */ /* }{ */ -typedef unsigned long lu_mem; typedef long l_mem; +typedef unsigned long lu_mem; #endif /* } */ +#define MAX_LMEM \ + cast(l_mem, (cast(lu_mem, 1) << (l_numbits(l_mem) - 1)) - 1) + /* 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) */ -#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \ - : (size_t)(LUA_MAXINTEGER)) - - -#define MAX_LUMEM ((lu_mem)(~(lu_mem)0)) - -#define MAX_LMEM ((l_mem)(MAX_LUMEM >> 1)) +/* Type for thread status/error codes */ +typedef lu_byte TStatus; +/* The C API still uses 'int' for status/error codes */ +#define APIstatus(st) cast_int(st) -#define MAX_INT INT_MAX /* maximum value of an int */ - +/* maximum value for size_t */ +#define MAX_SIZET ((size_t)(~(size_t)0)) /* -** 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.) +** Maximum size for strings and userdata visible for Lua; should be +** representable as a lua_Integer and as a size_t. */ -#define log2maxs(t) (sizeof(t) * 8 - 2) - +#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \ + : cast_sizet(LUA_MAXINTEGER)) /* ** test whether an unsigned value is a power of 2 (or zero) @@ -71,11 +70,24 @@ typedef signed char ls_byte; /* -** conversion of pointer to unsigned integer: -** this is for hashing only; there is no problem if the integer -** cannot hold the whole pointer value +** conversion of pointer to unsigned integer: this is for hashing only; +** there is no problem if the integer cannot hold the whole pointer +** value. (In strict ISO C this may cause undefined behavior, but no +** actual machine seems to bother.) */ -#define point2uint(p) ((unsigned int)((size_t)(p) & UINT_MAX)) +#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \ + __STDC_VERSION__ >= 199901L +#include +#if defined(UINTPTR_MAX) /* even in C99 this type is optional */ +#define L_P2I uintptr_t +#else /* no 'intptr'? */ +#define L_P2I uintmax_t /* use the largest available integer */ +#endif +#else /* C89 option */ +#define L_P2I size_t +#endif + +#define point2uint(p) cast_uint((L_P2I)(p) & UINT_MAX) @@ -91,26 +103,18 @@ typedef LUAI_UACINT l_uacInt; #undef NDEBUG #include #define lua_assert(c) assert(c) +#define assert_code(c) c #endif #if defined(lua_assert) -#define check_exp(c,e) (lua_assert(c), (e)) -/* to avoid problems with conditions too long */ -#define lua_longassert(c) ((c) ? (void)0 : lua_assert(0)) #else #define lua_assert(c) ((void)0) -#define check_exp(c,e) (e) -#define lua_longassert(c) ((void)0) -#endif - -/* -** assertion for checking API calls -*/ -#if !defined(luai_apicheck) -#define luai_apicheck(l,e) ((void)l, lua_assert(e)) +#define assert_code(c) ((void)0) #endif -#define api_check(l,e,msg) luai_apicheck(l,(e) && msg) +#define check_exp(c,e) (lua_assert(c), (e)) +/* to avoid problems with conditions too long */ +#define lua_longassert(c) assert_code((c) ? (void)0 : lua_assert(0)) /* macro to avoid warnings about unused variables */ @@ -126,12 +130,15 @@ typedef LUAI_UACINT l_uacInt; #define cast_voidp(i) cast(void *, (i)) #define cast_num(i) cast(lua_Number, (i)) #define cast_int(i) cast(int, (i)) +#define cast_short(i) cast(short, (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)) +#define cast_Integer(i) cast(lua_Integer, (i)) +#define cast_Inst(i) cast(Instruction, (i)) /* cast a signed lua_Integer to lua_Unsigned */ @@ -148,6 +155,38 @@ typedef LUAI_UACINT l_uacInt; #define l_castU2S(i) ((lua_Integer)(i)) #endif +/* +** cast a size_t to lua_Integer: These casts are always valid for +** sizes of Lua objects (see MAX_SIZE) +*/ +#define cast_st2S(sz) ((lua_Integer)(sz)) + +/* Cast a ptrdiff_t to size_t, when it is known that the minuend +** comes from the subtrahend (the base) +*/ +#define ct_diff2sz(df) ((size_t)(df)) + +/* ptrdiff_t to lua_Integer */ +#define ct_diff2S(df) cast_st2S(ct_diff2sz(df)) + +/* +** Special type equivalent to '(void*)' for functions (to suppress some +** warnings when converting function pointers) +*/ +typedef void (*voidf)(void); + +/* +** Macro to convert pointer-to-void* to pointer-to-function. This cast +** is undefined according to ISO C, but POSIX assumes that it works. +** (The '__extension__' in gnu compilers is only to avoid warnings.) +*/ +#if defined(__GNUC__) +#define cast_func(p) (__extension__ (voidf)(p)) +#else +#define cast_func(p) ((voidf)(p)) +#endif + + /* ** non-return type @@ -180,8 +219,7 @@ typedef LUAI_UACINT l_uacInt; /* -** type for virtual-machine instructions; -** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h) +** An unsigned with (at least) 4 bytes */ #if LUAI_IS32INT typedef unsigned int l_uint32; @@ -189,107 +227,6 @@ typedef unsigned int l_uint32; typedef unsigned long l_uint32; #endif -typedef l_uint32 Instruction; - - - -/* -** Maximum length for short strings, that is, strings that are -** internalized. (Cannot be smaller than reserved words or tags for -** metamethods, as these strings must be internalized; -** #("function") = 8, #("__newindex") = 10.) -*/ -#if !defined(LUAI_MAXSHORTLEN) -#define LUAI_MAXSHORTLEN 40 -#endif - - -/* -** Initial size for the string table (must be power of 2). -** The Lua core alone registers ~50 strings (reserved words + -** metaevent keys + a few others). Libraries would typically add -** a few dozens more. -*/ -#if !defined(MINSTRTABSIZE) -#define MINSTRTABSIZE 128 -#endif - - -/* -** Size of cache for strings in the API. 'N' is the number of -** sets (better be a prime) and "M" is the size of each set (M == 1 -** makes a direct cache.) -*/ -#if !defined(STRCACHE_N) -#define STRCACHE_N 53 -#define STRCACHE_M 2 -#endif - - -/* minimum size for string buffer */ -#if !defined(LUA_MINBUFFER) -#define LUA_MINBUFFER 32 -#endif - - -/* -** Maximum depth for nested C calls, syntactical nested non-terminals, -** and other features implemented through recursion in C. (Value must -** fit in a 16-bit unsigned integer. It must also be compatible with -** the size of the C stack.) -*/ -#if !defined(LUAI_MAXCCALLS) -#define LUAI_MAXCCALLS 200 -#endif - - -/* -** macros that are executed whenever program enters the Lua core -** ('lua_lock') and leaves the core ('lua_unlock') -*/ -#if !defined(lua_lock) -#define lua_lock(L) ((void) 0) -#define lua_unlock(L) ((void) 0) -#endif - -/* -** macro executed during Lua functions at points where the -** function can yield. -*/ -#if !defined(luai_threadyield) -#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);} -#endif - - -/* -** these macros allow user-specific actions when a thread is -** created/deleted/resumed/yielded. -*/ -#if !defined(luai_userstateopen) -#define luai_userstateopen(L) ((void)L) -#endif - -#if !defined(luai_userstateclose) -#define luai_userstateclose(L) ((void)L) -#endif - -#if !defined(luai_userstatethread) -#define luai_userstatethread(L,L1) ((void)L) -#endif - -#if !defined(luai_userstatefree) -#define luai_userstatefree(L,L1) ((void)L) -#endif - -#if !defined(luai_userstateresume) -#define luai_userstateresume(L,n) ((void)L) -#endif - -#if !defined(luai_userstateyield) -#define luai_userstateyield(L,n) ((void)L) -#endif - - /* ** The luai_num* macros define the primitive operations over numbers. @@ -344,24 +281,77 @@ typedef l_uint32 Instruction; +/* +** lua_numbertointeger converts a float number with an integral value +** to an integer, or returns 0 if the 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) && \ + (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \ + (*(p) = (LUA_INTEGER)(n), 1)) + /* -** macro to control inclusion of some hard tests on stack reallocation +** 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, +** none of which to be exported to outside modules (LUAI_DDEF for +** definitions and LUAI_DDEC for declarations). +** Elf and MACH/gcc (versions 3.2 and later) mark them as "hidden" to +** optimize access when Lua is compiled as a shared library. Not all elf +** targets support this attribute. Unfortunately, gcc does not offer +** a way to check whether the target offers that support, and those +** without support give a warning about it. To avoid these warnings, +** change to the default definition. */ -#if !defined(HARDSTACKTESTS) -#define condmovestack(L,pre,pos) ((void)0) +#if !defined(LUAI_FUNC) + +#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ + (defined(__ELF__) || defined(__MACH__)) +#define LUAI_FUNC __attribute__((visibility("internal"))) extern #else -/* realloc stack keeping its size */ -#define condmovestack(L,pre,pos) \ - { int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; } +#define LUAI_FUNC extern #endif -#if !defined(HARDMEMTESTS) -#define condchangemem(L,pre,pos) ((void)0) -#else -#define condchangemem(L,pre,pos) \ - { if (gcrunning(G(L))) { pre; luaC_fullgc(L, 0); pos; } } +#define LUAI_DDEC(dec) LUAI_FUNC dec +#define LUAI_DDEF /* empty */ + +#endif + + +/* Give these macros simpler names for internal use */ +#define l_likely(x) luai_likely(x) +#define l_unlikely(x) luai_unlikely(x) + +/* +** {================================================================== +** "Abstraction Layer" for basic report of messages and errors +** =================================================================== +*/ + +/* print a string */ +#if !defined(lua_writestring) +#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout) +#endif + +/* print a newline and flush the output */ +#if !defined(lua_writeline) +#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout)) #endif +/* print an error message */ +#if !defined(lua_writestringerror) +#define lua_writestringerror(s,p) \ + (fprintf(stderr, (s), (p)), fflush(stderr)) #endif + +/* }================================================================== */ + +#endif + diff --git a/lmathlib.c b/lmathlib.c index d0b1e1e5d6..a6b13f969c 100644 --- a/lmathlib.c +++ b/lmathlib.c @@ -20,6 +20,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" #undef PI @@ -37,31 +38,37 @@ static int math_abs (lua_State *L) { return 1; } + static int math_sin (lua_State *L) { lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1))); return 1; } + static int math_cos (lua_State *L) { lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1))); return 1; } + static int math_tan (lua_State *L) { lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1))); return 1; } + static int math_asin (lua_State *L) { lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1))); return 1; } + static int math_acos (lua_State *L) { lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1))); return 1; } + static int math_atan (lua_State *L) { lua_Number y = luaL_checknumber(L, 1); lua_Number x = luaL_optnumber(L, 2, 1); @@ -105,7 +112,7 @@ static int math_floor (lua_State *L) { static int math_ceil (lua_State *L) { if (lua_isinteger(L, 1)) - lua_settop(L, 1); /* integer is its own ceil */ + lua_settop(L, 1); /* integer is its own ceiling */ else { lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1)); pushnumint(L, d); @@ -166,6 +173,7 @@ static int math_ult (lua_State *L) { return 1; } + static int math_log (lua_State *L) { lua_Number x = luaL_checknumber(L, 1); lua_Number res; @@ -187,22 +195,42 @@ static int math_log (lua_State *L) { return 1; } + static int math_exp (lua_State *L) { lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1))); return 1; } + static int math_deg (lua_State *L) { lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI)); return 1; } + static int math_rad (lua_State *L) { lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0))); return 1; } +static int math_frexp (lua_State *L) { + lua_Number x = luaL_checknumber(L, 1); + int ep; + lua_pushnumber(L, l_mathop(frexp)(x, &ep)); + lua_pushinteger(L, ep); + return 2; +} + + +static int math_ldexp (lua_State *L) { + lua_Number x = luaL_checknumber(L, 1); + int ep = (int)luaL_checkinteger(L, 2); + lua_pushnumber(L, l_mathop(ldexp)(x, ep)); + return 1; +} + + static int math_min (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ int imin = 1; /* index of current minimum value */ @@ -249,6 +277,15 @@ static int math_type (lua_State *L) { ** =================================================================== */ +/* +** This code uses lots of shifts. ISO C does not allow shifts greater +** than or equal to the width of the type being shifted, so some shifts +** are written in convoluted ways to match that restriction. For +** preprocessor tests, it assumes a width of 32 bits, so the maximum +** shift there is 31 bits. +*/ + + /* number of binary digits in the mantissa of a float */ #define FIGS l_floatatt(MANT_DIG) @@ -271,16 +308,19 @@ static int math_type (lua_State *L) { /* 'long' has at least 64 bits */ #define Rand64 unsigned long +#define SRand64 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 +#define SRand64 long long #elif ((LUA_MAXUNSIGNED >> 31) >> 31) >= 3 /* 'lua_Unsigned' has at least 64 bits */ #define Rand64 lua_Unsigned +#define SRand64 lua_Integer #endif @@ -319,23 +359,30 @@ static Rand64 nextrand (Rand64 *state) { } -/* 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. +** Some old Microsoft compilers cannot cast an unsigned long +** to a floating-point number, so we use a signed long as an +** intermediary. When lua_Number is float or double, the shift ensures +** that 'sx' is non negative; in that case, a good compiler will remove +** the correction. */ /* must throw out the extra (64 - FIGS) bits */ #define shift64_FIG (64 - FIGS) -/* to scale to [0, 1), multiply by scaleFIG = 2^(-FIGS) */ +/* 2^(-FIGS) == 2^-1 / 2^(FIGS-1) */ #define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1))) static lua_Number I2d (Rand64 x) { - return (lua_Number)(trim64(x) >> shift64_FIG) * scaleFIG; + SRand64 sx = (SRand64)(trim64(x) >> shift64_FIG); + lua_Number res = (lua_Number)(sx) * scaleFIG; + if (sx < 0) + res += l_mathop(1.0); /* correct the two's complement if negative */ + lua_assert(0 <= res && res < 1); + return res; } /* convert a 'Rand64' to a 'lua_Unsigned' */ @@ -347,25 +394,17 @@ static lua_Number I2d (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 */ + l_uint32 h; /* higher half */ + l_uint32 l; /* lower half */ } Rand64; /* -** If 'lu_int32' has more than 32 bits, the extra bits do not interfere +** If 'l_uint32' 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. */ @@ -379,7 +418,7 @@ typedef struct Rand64 { */ /* build a new Rand64 value */ -static Rand64 packI (lu_int32 h, lu_int32 l) { +static Rand64 packI (l_uint32 h, l_uint32 l) { Rand64 result; result.h = h; result.l = l; @@ -452,7 +491,7 @@ static Rand64 nextrand (Rand64 *state) { */ /* an unsigned 1 with proper type */ -#define UONE ((lu_int32)1) +#define UONE ((l_uint32)1) #if FIGS <= 32 @@ -471,8 +510,6 @@ static lua_Number I2d (Rand64 x) { #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 \ (l_mathop(1.0) / (UONE << 30) / l_mathop(8.0) / (UONE << (FIGS - 33))) @@ -505,7 +542,7 @@ static lua_Unsigned I2UInt (Rand64 x) { /* convert a 'lua_Unsigned' to a 'Rand64' */ static Rand64 Int2I (lua_Unsigned n) { - return packI((lu_int32)((n >> 31) >> 1), (lu_int32)n); + return packI((l_uint32)((n >> 31) >> 1), (l_uint32)n); } #endif /* } */ @@ -523,7 +560,7 @@ typedef struct { ** 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 +** division). So, 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', @@ -531,26 +568,14 @@ typedef struct { */ 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; - } + lua_Unsigned lim = n; /* to compute the Mersenne number */ + int sh; /* how much to spread bits to the right in 'lim' */ + /* spread '1' bits in 'lim' until it becomes a Mersenne number */ + for (sh = 1; (lim & (lim + 1)) != 0; sh *= 2) + lim |= (lim >> sh); /* spread '1's to the right */ + while ((ran &= lim) > n) /* project 'ran' into [0..lim] and test */ + ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */ + return ran; } @@ -568,7 +593,7 @@ static int math_random (lua_State *L) { low = 1; up = luaL_checkinteger(L, 1); if (up == 0) { /* single 0 as argument? */ - lua_pushinteger(L, I2UInt(rv)); /* full random integer */ + lua_pushinteger(L, l_castU2S(I2UInt(rv))); /* full random integer */ return 1; } break; @@ -583,8 +608,8 @@ static int math_random (lua_State *L) { /* random integer in the interval [low, up] */ luaL_argcheck(L, low <= up, 1, "interval is empty"); /* 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); + p = project(I2UInt(rv), l_castS2U(up) - l_castS2U(low), state); + lua_pushinteger(L, l_castU2S(p + l_castS2U(low))); return 1; } @@ -598,33 +623,23 @@ static void setseed (lua_State *L, Rand64 *state, 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); + lua_pushinteger(L, l_castU2S(n1)); + lua_pushinteger(L, l_castU2S(n2)); } static int math_randomseed (lua_State *L) { RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1)); + lua_Unsigned n1, n2; if (lua_isnone(L, 1)) { - randseed(L, state); + n1 = luaL_makeseed(L); /* "random" seed */ + n2 = I2UInt(nextrand(state->s)); /* in case seed is not that random... */ } else { - lua_Integer n1 = luaL_checkinteger(L, 1); - lua_Integer n2 = luaL_optinteger(L, 2, 0); - setseed(L, state->s, n1, n2); + n1 = l_castS2U(luaL_checkinteger(L, 1)); + n2 = l_castS2U(luaL_optinteger(L, 2, 0)); } + setseed(L, state->s, n1, n2); return 2; /* return seeds */ } @@ -641,7 +656,7 @@ static const luaL_Reg randfuncs[] = { */ static void setrandfunc (lua_State *L) { RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0); - randseed(L, state); /* initialize with a "random" seed */ + setseed(L, state->s, luaL_makeseed(L), 0); /* initialize with random seed */ lua_pop(L, 2); /* remove pushed seeds */ luaL_setfuncs(L, randfuncs, 1); } @@ -678,20 +693,6 @@ static int math_pow (lua_State *L) { return 1; } -static int math_frexp (lua_State *L) { - int e; - lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e)); - lua_pushinteger(L, e); - return 2; -} - -static int math_ldexp (lua_State *L) { - lua_Number x = luaL_checknumber(L, 1); - int ep = (int)luaL_checkinteger(L, 2); - lua_pushnumber(L, l_mathop(ldexp)(x, ep)); - return 1; -} - static int math_log10 (lua_State *L) { lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1))); return 1; @@ -714,7 +715,9 @@ static const luaL_Reg mathlib[] = { {"tointeger", math_toint}, {"floor", math_floor}, {"fmod", math_fmod}, + {"frexp", math_frexp}, {"ult", math_ult}, + {"ldexp", math_ldexp}, {"log", math_log}, {"max", math_max}, {"min", math_min}, @@ -730,8 +733,6 @@ static const luaL_Reg mathlib[] = { {"sinh", math_sinh}, {"tanh", math_tanh}, {"pow", math_pow}, - {"frexp", math_frexp}, - {"ldexp", math_ldexp}, {"log10", math_log10}, #endif /* placeholders */ diff --git a/lmem.c b/lmem.c index 9800a86fc0..de8503d91b 100644 --- a/lmem.c +++ b/lmem.c @@ -95,7 +95,7 @@ static void *firsttry (global_State *g, void *block, size_t os, size_t ns) { void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize, - int size_elems, int limit, const char *what) { + unsigned size_elems, int limit, const char *what) { void *newblock; int size = *psize; if (nelems + 1 <= size) /* does one extra element still fit? */ @@ -126,10 +126,10 @@ void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize, ** error. */ void *luaM_shrinkvector_ (lua_State *L, void *block, int *size, - int final_n, int size_elem) { + int final_n, unsigned size_elem) { void *newblock; - size_t oldsize = cast_sizet((*size) * size_elem); - size_t newsize = cast_sizet(final_n * size_elem); + 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; @@ -151,7 +151,7 @@ void luaM_free_ (lua_State *L, void *block, size_t osize) { global_State *g = G(L); lua_assert((osize == 0) == (block == NULL)); callfrealloc(g, block, osize, 0); - g->GCdebt -= osize; + g->GCdebt += cast(l_mem, osize); } @@ -184,7 +184,7 @@ void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) { return NULL; /* do not update 'GCdebt' */ } lua_assert((nsize == 0) == (newblock == NULL)); - g->GCdebt = (g->GCdebt + nsize) - osize; + g->GCdebt -= cast(l_mem, nsize) - cast(l_mem, osize); return newblock; } @@ -203,13 +203,13 @@ void *luaM_malloc_ (lua_State *L, size_t size, int tag) { return NULL; /* that's all */ else { global_State *g = G(L); - void *newblock = firsttry(g, NULL, tag, size); + void *newblock = firsttry(g, NULL, cast_sizet(tag), size); if (l_unlikely(newblock == NULL)) { - newblock = tryagain(L, NULL, tag, size); + newblock = tryagain(L, NULL, cast_sizet(tag), size); if (newblock == NULL) luaM_error(L); } - g->GCdebt += size; + g->GCdebt -= cast(l_mem, size); return newblock; } } diff --git a/lmem.h b/lmem.h index 8c75a44beb..dc714fb2e4 100644 --- a/lmem.h +++ b/lmem.h @@ -39,11 +39,11 @@ ** 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'.) +** '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)))) + cast_int((MAX_SIZET/sizeof(t)))) /* @@ -57,12 +57,15 @@ #define luaM_freearray(L, b, n) luaM_free_(L, (b), (n)*sizeof(*(b))) #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_newvector(L,n,t) \ + cast(t*, luaM_malloc_(L, cast_sizet(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_malloc_(L, (s), tag) +#define luaM_newblock(L, size) luaM_newvector(L, size, char) + #define luaM_growvector(L,v,nelems,size,t,limit,e) \ ((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t), \ luaM_limitN(limit,t),e))) @@ -83,10 +86,10 @@ 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, + int *size, unsigned 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); + int final_n, unsigned size_elem); LUAI_FUNC void *luaM_malloc_ (lua_State *L, size_t size, int tag); #endif diff --git a/loadlib.c b/loadlib.c index d792dffaa0..8d2e68e261 100644 --- a/loadlib.c +++ b/loadlib.c @@ -22,15 +22,7 @@ #include "lauxlib.h" #include "lualib.h" - - -/* -** LUA_IGMARK is a mark to ignore all before it when building the -** luaopen_ function name. -*/ -#if !defined (LUA_IGMARK) -#define LUA_IGMARK "-" -#endif +#include "llimits.h" /* @@ -67,11 +59,8 @@ static const char *const CLIBS = "_CLIBS"; #define setprogdir(L) ((void)0) -/* -** Special type equivalent to '(void*)' for functions in gcc -** (to suppress warnings when converting function pointers) -*/ -typedef void (*voidf)(void); +/* cast void* to a Lua function */ +#define cast_Lfunc(p) cast(lua_CFunction, cast_func(p)) /* @@ -104,26 +93,13 @@ static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym); #if defined(LUA_USE_DLOPEN) /* { */ /* ** {======================================================================== -** This is an implementation of loadlib based on the dlfcn interface. -** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, -** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least -** as an emulation layer on top of native functions. +** This is an implementation of loadlib based on the dlfcn interface, +** which is available in all POSIX systems. ** ========================================================================= */ #include -/* -** Macro to convert pointer-to-void* to pointer-to-function. This cast -** is undefined according to ISO C, but POSIX assumes that it works. -** (The '__extension__' in gnu compilers is only to avoid warnings.) -*/ -#if defined(__GNUC__) -#define cast_func(p) (__extension__ (lua_CFunction)(p)) -#else -#define cast_func(p) ((lua_CFunction)(p)) -#endif - static void lsys_unloadlib (void *lib) { dlclose(lib); @@ -139,7 +115,7 @@ static void *lsys_load (lua_State *L, const char *path, int seeglb) { static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) { - lua_CFunction f = cast_func(dlsym(lib, sym)); + lua_CFunction f = cast_Lfunc(dlsym(lib, sym)); if (l_unlikely(f == NULL)) lua_pushstring(L, dlerror()); return f; @@ -215,7 +191,7 @@ static void *lsys_load (lua_State *L, const char *path, int seeglb) { static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) { - lua_CFunction f = (lua_CFunction)(voidf)GetProcAddress((HMODULE)lib, sym); + lua_CFunction f = cast_Lfunc(GetProcAddress((HMODULE)lib, sym)); if (f == NULL) pusherror(L); return f; } @@ -292,7 +268,8 @@ static int noenv (lua_State *L) { /* -** Set a path +** Set a path. (If using the default path, assume it is a string +** literal in C and create it as an external string.) */ static void setpath (lua_State *L, const char *fieldname, const char *envname, @@ -303,7 +280,7 @@ static void setpath (lua_State *L, const char *fieldname, 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 */ + lua_pushexternalstring(L, dft, strlen(dft), NULL, NULL); /* use default */ 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 */ @@ -311,13 +288,13 @@ static void setpath (lua_State *L, const char *fieldname, luaL_Buffer b; luaL_buffinit(L, &b); if (path < dftmark) { /* is there a prefix before ';;'? */ - luaL_addlstring(&b, path, dftmark - path); /* add it */ + luaL_addlstring(&b, path, ct_diff2sz(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_addlstring(&b, dftmark + 2, ct_diff2sz((path + len - 2) - dftmark)); } luaL_pushresult(&b); } @@ -329,6 +306,16 @@ static void setpath (lua_State *L, const char *fieldname, /* }================================================================== */ +/* +** External strings created by DLLs may need the DLL code to be +** deallocated. This implies that a DLL can only be unloaded after all +** its strings were deallocated. To ensure that, we create a 'library +** string' to represent each DLL, and when this string is deallocated +** it closes its corresponding DLL. +** (The string itself is irrelevant; its userdata is the DLL pointer.) +*/ + + /* ** return registry.CLIBS[path] */ @@ -343,34 +330,41 @@ static void *checkclib (lua_State *L, const char *path) { /* -** registry.CLIBS[path] = plib -- for queries -** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries +** Deallocate function for library strings. +** Unload the DLL associated with the string being deallocated. */ -static void addtoclib (lua_State *L, const char *path, void *plib) { - lua_getfield(L, LUA_REGISTRYINDEX, CLIBS); - lua_pushlightuserdata(L, plib); - lua_pushvalue(L, -1); - lua_setfield(L, -3, path); /* CLIBS[path] = plib */ - lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */ - lua_pop(L, 1); /* pop CLIBS table */ +static void *freelib (void *ud, void *ptr, size_t osize, size_t nsize) { + /* string itself is irrelevant and static */ + (void)ptr; (void)osize; (void)nsize; + lsys_unloadlib(ud); /* unload library represented by the string */ + return NULL; } /* -** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib -** handles in list CLIBS +** Create a library string that, when deallocated, will unload 'plib' */ -static int gctm (lua_State *L) { - lua_Integer n = luaL_len(L, 1); - for (; n >= 1; n--) { /* for each handle, in reverse order */ - lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */ - lsys_unloadlib(lua_touserdata(L, -1)); - lua_pop(L, 1); /* pop handle */ - } - return 0; +static void createlibstr (lua_State *L, void *plib) { + /* common content for all library strings */ + static const char dummy[] = "01234567890"; + lua_pushexternalstring(L, dummy, sizeof(dummy) - 1, freelib, plib); } +/* +** registry.CLIBS[path] = plib -- for queries. +** Also create a reference to strlib, so that the library string will +** only be collected when registry.CLIBS is collected. +*/ +static void addtoclib (lua_State *L, const char *path, void *plib) { + lua_getfield(L, LUA_REGISTRYINDEX, CLIBS); + lua_pushlightuserdata(L, plib); + lua_setfield(L, -2, path); /* CLIBS[path] = plib */ + createlibstr(L, plib); + luaL_ref(L, -2); /* keep library string in CLIBS */ + lua_pop(L, 1); /* pop CLIBS table */ +} + /* error codes for 'lookforfunc' */ #define ERRLIB 1 @@ -384,8 +378,8 @@ static int gctm (lua_State *L) { ** Then, if 'sym' is '*', return true (as library has been loaded). ** Otherwise, look for symbol 'sym' in the library and push a ** C function with that symbol. -** Return 0 and 'true' or a function in the stack; in case of -** errors, return an error code and an error message in the stack. +** Return 0 with 'true' or a function in the stack; in case of +** errors, return an error code with an error message in the stack. */ static int lookforfunc (lua_State *L, const char *path, const char *sym) { void *reg = checkclib(L, path); /* check loaded C libraries */ @@ -566,7 +560,7 @@ static int loadfunc (lua_State *L, const char *filename, const char *modname) { mark = strchr(modname, *LUA_IGMARK); if (mark) { int stat; - openfunc = lua_pushlstring(L, modname, mark - modname); + openfunc = lua_pushlstring(L, modname, ct_diff2sz(mark - modname)); openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc); stat = lookforfunc(L, filename, openfunc); if (stat != ERRFUNC) return stat; @@ -591,7 +585,7 @@ static int searcher_Croot (lua_State *L) { const char *p = strchr(name, '.'); int stat; if (p == NULL) return 0; /* is root */ - lua_pushlstring(L, name, p - name); + lua_pushlstring(L, name, ct_diff2sz(p - name)); filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP); if (filename == NULL) return 1; /* root not found */ if ((stat = loadfunc(L, filename, name)) != 0) { @@ -629,12 +623,12 @@ static void findloader (lua_State *L, const char *name) { != LUA_TTABLE)) luaL_error(L, "'package.searchers' must be a table"); luaL_buffinit(L, &msg); + luaL_addstring(&msg, "\n\t"); /* error-message prefix for first message */ /* iterate over available searchers to find a loader */ for (i = 1; ; i++) { - luaL_addstring(&msg, "\n\t"); /* error-message prefix */ if (l_unlikely(lua_rawgeti(L, 3, i) == LUA_TNIL)) { /* no more searchers? */ lua_pop(L, 1); /* remove nil */ - luaL_buffsub(&msg, 2); /* remove prefix */ + luaL_buffsub(&msg, 2); /* remove last prefix */ luaL_pushresult(&msg); /* create error message */ luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1)); } @@ -645,11 +639,10 @@ static void findloader (lua_State *L, const char *name) { else if (lua_isstring(L, -2)) { /* searcher returned error message? */ lua_pop(L, 1); /* remove extra return */ luaL_addvalue(&msg); /* concatenate error message */ + luaL_addstring(&msg, "\n\t"); /* prefix for next message */ } - else { /* no error message */ + else /* no error message */ lua_pop(L, 2); /* remove both returns */ - luaL_buffsub(&msg, 2); /* remove prefix */ - } } } @@ -728,21 +721,9 @@ static void createsearcherstable (lua_State *L) { } -/* -** create table CLIBS to keep track of loaded C libraries, -** setting a finalizer to close all libraries when closing state. -*/ -static void createclibstable (lua_State *L) { - 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); -} - - LUAMOD_API int luaopen_package (lua_State *L) { - createclibstable(L); + luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */ + lua_pop(L, 1); /* will not use it now */ luaL_newlib(L, pk_funcs); /* create 'package' table */ createsearcherstable(L); /* set paths */ diff --git a/lobject.c b/lobject.c index f73ffc6d92..763b484609 100644 --- a/lobject.c +++ b/lobject.c @@ -10,6 +10,7 @@ #include "lprefix.h" +#include #include #include #include @@ -30,10 +31,11 @@ /* -** Computes ceil(log2(x)) +** Computes ceil(log2(x)), which is the smallest integer n such that +** x <= (1 << n). */ -int luaO_ceillog2 (unsigned int x) { - static const lu_byte log_2[256] = { /* log_2[i] = ceil(log2(i - 1)) */ +lu_byte luaO_ceillog2 (unsigned int x) { + static const lu_byte log_2[256] = { /* log_2[i - 1] = ceil(log2(i)) */ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, @@ -46,7 +48,67 @@ int luaO_ceillog2 (unsigned int x) { int l = 0; x--; while (x >= 256) { l += 8; x >>= 8; } - return l + log_2[x]; + return cast_byte(l + log_2[x]); +} + +/* +** Encodes 'p'% as a floating-point byte, represented as (eeeexxxx). +** The exponent is represented using excess-7. Mimicking IEEE 754, the +** representation normalizes the number when possible, assuming an extra +** 1 before the mantissa (xxxx) and adding one to the exponent (eeee) +** to signal that. So, the real value is (1xxxx) * 2^(eeee - 7 - 1) if +** eeee != 0, and (xxxx) * 2^-7 otherwise (subnormal numbers). +*/ +lu_byte luaO_codeparam (unsigned int p) { + if (p >= (cast(lu_mem, 0x1F) << (0xF - 7 - 1)) * 100u) /* overflow? */ + return 0xFF; /* return maximum value */ + else { + p = (cast(l_uint32, p) * 128 + 99) / 100; /* round up the division */ + if (p < 0x10) { /* subnormal number? */ + /* exponent bits are already zero; nothing else to do */ + return cast_byte(p); + } + else { /* p >= 0x10 implies ceil(log2(p + 1)) >= 5 */ + /* preserve 5 bits in 'p' */ + unsigned log = luaO_ceillog2(p + 1) - 5u; + return cast_byte(((p >> log) - 0x10) | ((log + 1) << 4)); + } + } +} + + +/* +** Computes 'p' times 'x', where 'p' is a floating-point byte. Roughly, +** we have to multiply 'x' by the mantissa and then shift accordingly to +** the exponent. If the exponent is positive, both the multiplication +** and the shift increase 'x', so we have to care only about overflows. +** For negative exponents, however, multiplying before the shift keeps +** more significant bits, as long as the multiplication does not +** overflow, so we check which order is best. +*/ +l_mem luaO_applyparam (lu_byte p, l_mem x) { + int m = p & 0xF; /* mantissa */ + int e = (p >> 4); /* exponent */ + if (e > 0) { /* normalized? */ + e--; /* correct exponent */ + m += 0x10; /* correct mantissa; maximum value is 0x1F */ + } + e -= 7; /* correct excess-7 */ + if (e >= 0) { + if (x < (MAX_LMEM / 0x1F) >> e) /* no overflow? */ + return (x * m) << e; /* order doesn't matter here */ + else /* real overflow */ + return MAX_LMEM; + } + else { /* negative exponent */ + e = -e; + if (x < MAX_LMEM / 0x1F) /* multiplication cannot overflow? */ + return (x * m) >> e; /* multiplying first gives more precision */ + else if ((x >> e) < MAX_LMEM / 0x1F) /* cannot overflow after shift? */ + return (x >> e) * m; + else /* real overflow */ + return MAX_LMEM; + } } @@ -132,9 +194,10 @@ void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2, } -int luaO_hexavalue (int c) { - if (lisdigit(c)) return c - '0'; - else return (ltolower(c) - 'a') + 10; +lu_byte luaO_hexavalue (int c) { + lua_assert(lisxdigit(c)); + if (lisdigit(c)) return cast_byte(c - '0'); + else return cast_byte((ltolower(c) - 'a') + 10); } @@ -185,7 +248,7 @@ static lua_Number lua_strx2number (const char *s, char **endptr) { nosigdig++; else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */ r = (r * l_mathop(16.0)) + luaO_hexavalue(*s); - else e++; /* too many digits; ignore, but still count for exponent */ + else e++; /* too many digits; ignore, but still count for exponent */ if (hasdot) e--; /* decimal digit? correct exponent */ } else break; /* neither a dot nor a digit */ @@ -292,7 +355,7 @@ static const char *l_str2int (const char *s, lua_Integer *result) { int d = *s - '0'; if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */ return NULL; /* do not accept it (as integer) */ - a = a * 10 + d; + a = a * 10 + cast_uint(d); empty = 0; } } @@ -316,14 +379,14 @@ size_t luaO_str2num (const char *s, TValue *o) { } else return 0; /* conversion failed */ - return (e - s) + 1; /* success; return string size */ + return ct_diff2sz(e - s) + 1; /* success; return string size */ } -int luaO_utf8esc (char *buff, unsigned long x) { +int luaO_utf8esc (char *buff, l_uint32 x) { int n = 1; /* number of bytes put in buffer (backwards) */ lua_assert(x <= 0x7FFFFFFFu); - if (x < 0x80) /* ascii? */ + if (x < 0x80) /* ASCII? */ buff[UTF8BUFFSZ - 1] = cast_char(x); else { /* need continuation bytes */ unsigned int mfb = 0x3f; /* maximum that fits in first byte */ @@ -339,32 +402,59 @@ int luaO_utf8esc (char *buff, unsigned long x) { /* -** Maximum length of the conversion of a number to a string. Must be -** enough to accommodate both LUA_INTEGER_FMT and LUA_NUMBER_FMT. -** (For a long long int, this is 19 digits plus a sign and a final '\0', -** adding to 21. For a long double, it can go to a sign, 33 digits, -** the dot, an exponent letter, an exponent sign, 5 exponent digits, -** and a final '\0', adding to 43.) +** The size of the buffer for the conversion of a number to a string +** 'LUA_N2SBUFFSZ' must be enough to accommodate both LUA_INTEGER_FMT +** and LUA_NUMBER_FMT. For a long long int, this is 19 digits plus a +** sign and a final '\0', adding to 21. For a long double, it can go to +** a sign, the dot, an exponent letter, an exponent sign, 4 exponent +** digits, the final '\0', plus the significant digits, which are +** approximately the *_DIG attribute. */ -#define MAXNUMBER2STR 44 +#if LUA_N2SBUFFSZ < (20 + l_floatatt(DIG)) +#error "invalid value for LUA_N2SBUFFSZ" +#endif /* -** Convert a number object to a string, adding it to a buffer +** Convert a float to a string, adding it to a buffer. First try with +** a not too large number of digits, to avoid noise (for instance, +** 1.1 going to "1.1000000000000001"). If that lose precision, so +** that reading the result back gives a different number, then do the +** conversion again with extra precision. Moreover, if the numeral looks +** like an integer (without a decimal point or an exponent), add ".0" to +** its end. */ -static int tostringbuff (TValue *obj, char *buff) { +static int tostringbuffFloat (lua_Number n, char *buff) { + /* first conversion */ + int len = l_sprintf(buff, LUA_N2SBUFFSZ, LUA_NUMBER_FMT, + (LUAI_UACNUMBER)n); + lua_Number check = lua_str2number(buff, NULL); /* read it back */ + if (check != n) { /* not enough precision? */ + /* convert again with more precision */ + len = l_sprintf(buff, LUA_N2SBUFFSZ, LUA_NUMBER_FMT_N, + (LUAI_UACNUMBER)n); + } + /* looks like an integer? */ + if (buff[strspn(buff, "-0123456789")] == '\0') { + buff[len++] = lua_getlocaledecpoint(); + buff[len++] = '0'; /* adds '.0' to result */ + } + return len; +} + + +/* +** Convert a number object to a string, adding it to a buffer. +*/ +unsigned luaO_tostringbuff (const TValue *obj, char *buff) { int len; lua_assert(ttisnumber(obj)); if (ttisinteger(obj)) - len = lua_integer2str(buff, MAXNUMBER2STR, ivalue(obj)); - else { - 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 */ - } - } - return len; + len = lua_integer2str(buff, LUA_N2SBUFFSZ, ivalue(obj)); + else + len = tostringbuffFloat(fltvalue(obj), buff); + lua_assert(len < LUA_N2SBUFFSZ); + return cast_uint(len); } @@ -372,8 +462,8 @@ static int tostringbuff (TValue *obj, char *buff) { ** 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); + char buff[LUA_N2SBUFFSZ]; + unsigned len = luaO_tostringbuff(obj, buff); setsvalue(L, obj, luaS_newlstr(L, buff, len)); } @@ -388,78 +478,104 @@ void luaO_tostring (lua_State *L, TValue *obj) { /* ** Size for buffer space used by 'luaO_pushvfstring'. It should be -** (LUA_IDSIZE + MAXNUMBER2STR) + a minimal space for basic messages, -** so that 'luaG_addinfo' can work directly on the buffer. +** (LUA_IDSIZE + LUA_N2SBUFFSZ) + a minimal space for basic messages, +** so that 'luaG_addinfo' can work directly on the static buffer. */ -#define BUFVFS (LUA_IDSIZE + MAXNUMBER2STR + 95) +#define BUFVFS cast_uint(LUA_IDSIZE + LUA_N2SBUFFSZ + 95) -/* buffer used by 'luaO_pushvfstring' */ +/* +** Buffer used by 'luaO_pushvfstring'. 'err' signals an error while +** building result (memory error [1] or buffer overflow [2]). +*/ typedef struct BuffFS { lua_State *L; - int pushed; /* true if there is a part of the result on the stack */ - int blen; /* length of partial string in 'space' */ - char space[BUFVFS]; /* holds last part of the result */ + char *b; + size_t buffsize; + size_t blen; /* length of string in 'buff' */ + int err; + char space[BUFVFS]; /* initial buffer */ } BuffFS; -/* -** Push given string to the stack, as part of the result, and -** join it to previous partial result if there is one. -** It may call 'luaV_concat' while using one slot from EXTRA_STACK. -** This call cannot invoke metamethods, as both operands must be -** strings. It can, however, raise an error if the result is too -** long. In that case, 'luaV_concat' frees the extra slot before -** raising the error. -*/ -static void pushstr (BuffFS *buff, const char *str, size_t lstr) { - lua_State *L = buff->L; - setsvalue2s(L, L->top.p, luaS_newlstr(L, str, lstr)); - L->top.p++; /* may use one slot from EXTRA_STACK */ - if (!buff->pushed) /* no previous string on the stack? */ - buff->pushed = 1; /* now there is one */ - else /* join previous string with new one */ - luaV_concat(L, 2); +static void initbuff (lua_State *L, BuffFS *buff) { + buff->L = L; + buff->b = buff->space; + buff->buffsize = sizeof(buff->space); + buff->blen = 0; + buff->err = 0; } /* -** empty the buffer space into the stack +** Push final result from 'luaO_pushvfstring'. This function may raise +** errors explicitly or through memory errors, so it must run protected. */ -static void clearbuff (BuffFS *buff) { - pushstr(buff, buff->space, buff->blen); /* push buffer contents */ - buff->blen = 0; /* space now is empty */ +static void pushbuff (lua_State *L, void *ud) { + BuffFS *buff = cast(BuffFS*, ud); + switch (buff->err) { + case 1: /* memory error */ + luaD_throw(L, LUA_ERRMEM); + break; + case 2: /* length overflow: Add "..." at the end of result */ + if (buff->buffsize - buff->blen < 3) + strcpy(buff->b + buff->blen - 3, "..."); /* 'blen' must be > 3 */ + else { /* there is enough space left for the "..." */ + strcpy(buff->b + buff->blen, "..."); + buff->blen += 3; + } + /* FALLTHROUGH */ + default: { /* no errors, but it can raise one creating the new string */ + TString *ts = luaS_newlstr(L, buff->b, buff->blen); + setsvalue2s(L, L->top.p, ts); + L->top.p++; + } + } } -/* -** 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; +static const char *clearbuff (BuffFS *buff) { + lua_State *L = buff->L; + const char *res; + if (luaD_rawrunprotected(L, pushbuff, buff) != LUA_OK) /* errors? */ + res = NULL; /* error message is on the top of the stack */ + else + res = getstr(tsvalue(s2v(L->top.p - 1))); + if (buff->b != buff->space) /* using dynamic buffer? */ + luaM_freearray(L, buff->b, buff->buffsize); /* free it */ + return res; } -#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 */ + size_t left = buff->buffsize - buff->blen; /* space left in the buffer */ + if (buff->err) /* do nothing else after an error */ + return; + if (slen > left) { /* new string doesn't fit into current buffer? */ + if (slen > ((MAX_SIZE/2) - buff->blen)) { /* overflow? */ + memcpy(buff->b + buff->blen, str, left); /* copy what it can */ + buff->blen = buff->buffsize; + buff->err = 2; /* doesn't add anything else */ + return; + } + else { + size_t newsize = buff->buffsize + slen; /* limited to MAX_SIZE/2 */ + char *newb = + (buff->b == buff->space) /* still using static space? */ + ? luaM_reallocvector(buff->L, NULL, 0, newsize, char) + : luaM_reallocvector(buff->L, buff->b, buff->buffsize, newsize, + char); + if (newb == NULL) { /* allocation error? */ + buff->err = 1; /* signal a memory error */ + return; + } + if (buff->b == buff->space) /* new buffer (not reallocated)? */ + memcpy(newb, buff->b, buff->blen); /* copy previous content */ + buff->b = newb; /* set new (larger) buffer... */ + buff->buffsize = newsize; /* ...and its new size */ + } } + memcpy(buff->b + buff->blen, str, slen); /* copy new content */ + buff->blen += slen; } @@ -467,9 +583,9 @@ static void addstr2buff (BuffFS *buff, const char *str, size_t slen) { ** Add a numeral 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); + char numbuff[LUA_N2SBUFFSZ]; + unsigned len = luaO_tostringbuff(num, numbuff); + addstr2buff(buff, numbuff, len); } @@ -480,10 +596,9 @@ static void addnum2buff (BuffFS *buff, TValue *num) { const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { BuffFS buff; /* holds last part of the result */ const char *e; /* points to next '%' */ - buff.pushed = buff.blen = 0; - buff.L = L; + initbuff(L, &buff); while ((e = strchr(fmt, '%')) != NULL) { - addstr2buff(&buff, fmt, e - fmt); /* add 'fmt' up to '%' */ + addstr2buff(&buff, fmt, ct_diff2sz(e - fmt)); /* add 'fmt' up to '%' */ switch (*(e + 1)) { /* conversion specifier */ case 's': { /* zero-terminated string */ const char *s = va_arg(argp, char *); @@ -492,7 +607,7 @@ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { break; } case 'c': { /* an 'int' as a character */ - char c = cast_uchar(va_arg(argp, int)); + char c = cast_char(va_arg(argp, int)); addstr2buff(&buff, &c, sizeof(char)); break; } @@ -504,7 +619,7 @@ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { } case 'I': { /* a 'lua_Integer' */ TValue num; - setivalue(&num, cast(lua_Integer, va_arg(argp, l_uacInt))); + setivalue(&num, cast_Integer(va_arg(argp, l_uacInt))); addnum2buff(&buff, &num); break; } @@ -515,17 +630,17 @@ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { break; } case 'p': { /* a pointer */ - const int sz = 3 * sizeof(void*) + 8; /* enough space for '%p' */ - char *bf = getbuff(&buff, sz); + char bf[LUA_N2SBUFFSZ]; /* enough space for '%p' */ void *p = va_arg(argp, void *); - int len = lua_pointer2str(bf, sz, p); - addsize(&buff, len); + int len = lua_pointer2str(bf, LUA_N2SBUFFSZ, p); + addstr2buff(&buff, bf, cast_uint(len)); break; } - case 'U': { /* a 'long' as a UTF-8 sequence */ + case 'U': { /* an 'unsigned long' as a UTF-8 sequence */ char bf[UTF8BUFFSZ]; - int len = luaO_utf8esc(bf, va_arg(argp, long)); - addstr2buff(&buff, bf + UTF8BUFFSZ - len, len); + unsigned long arg = va_arg(argp, unsigned long); + int len = luaO_utf8esc(bf, cast(l_uint32, arg)); + addstr2buff(&buff, bf + UTF8BUFFSZ - len, cast_uint(len)); break; } case '%': { @@ -533,16 +648,14 @@ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { break; } default: { - luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'", - *(e + 1)); + addstr2buff(&buff, e, 2); /* keep unknown format in the result */ + break; } } fmt = e + 2; /* skip '%' and the specifier */ } addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */ - clearbuff(&buff); /* empty buffer into the stack */ - lua_assert(buff.pushed == 1); - return svalue(s2v(L->top.p - 1)); + return clearbuff(&buff); /* empty buffer into a new string */ } @@ -552,6 +665,8 @@ const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { va_start(argp, fmt); msg = luaO_pushvfstring(L, fmt, argp); va_end(argp); + if (msg == NULL) /* error? */ + luaD_throw(L, LUA_ERRMEM); return msg; } @@ -591,7 +706,8 @@ void luaO_chunkid (char *out, const char *source, size_t srclen) { addstr(out, source, srclen); /* keep it */ } else { - if (nl != NULL) srclen = nl - source; /* stop at first newline */ + if (nl != NULL) + srclen = ct_diff2sz(nl - source); /* stop at first newline */ if (srclen > bufflen) srclen = bufflen; addstr(out, source, srclen); addstr(out, RETS, LL(RETS)); diff --git a/lobject.h b/lobject.h index 556608e4aa..841ab5b9c3 100644 --- a/lobject.h +++ b/lobject.h @@ -188,10 +188,21 @@ typedef union { /* Value returned for a key not found in a table (absent key) */ #define LUA_VABSTKEY makevariant(LUA_TNIL, 2) +/* Special variant to signal that a fast get is accessing a non-table */ +#define LUA_VNOTABLE makevariant(LUA_TNIL, 3) + /* macro to test for (any kind of) nil */ #define ttisnil(v) checktype((v), LUA_TNIL) +/* +** Macro to test the result of a table access. Formally, it should +** distinguish between LUA_VEMPTY/LUA_VABSTKEY/LUA_VNOTABLE and +** other tags. As currently nil is equivalent to LUA_VEMPTY, it is +** simpler to just test whether the value is nil. +*/ +#define tagisempty(tag) (novariant(tag) == LUA_TNIL) + /* macro to test for a standard nil */ #define ttisstrictnil(o) checktag((o), LUA_VNIL) @@ -245,6 +256,8 @@ typedef union { #define l_isfalse(o) (ttisfalse(o) || ttisnil(o)) +#define tagisfalse(t) ((t) == LUA_VFALSE || novariant(t) == LUA_TNIL) + #define setbfvalue(obj) settt_(obj, LUA_VFALSE) @@ -380,37 +393,54 @@ typedef struct GCObject { #define setsvalue2n setsvalue +/* Kinds of long strings (stored in 'shrlen') */ +#define LSTRREG -1 /* regular long string */ +#define LSTRFIX -2 /* fixed external long string */ +#define LSTRMEM -3 /* external long string with deallocation */ + + /* ** Header for a string value. */ typedef struct TString { CommonHeader; lu_byte extra; /* reserved words for short strings; "has hash" for longs */ - lu_byte shrlen; /* length for short strings */ + ls_byte shrlen; /* length for short strings, negative for long strings */ unsigned int hash; union { size_t lnglen; /* length for long strings */ struct TString *hnext; /* linked list for hash table */ } u; - char contents[1]; + char *contents; /* pointer to content in long strings */ + lua_Alloc falloc; /* deallocation function for external strings */ + void *ud; /* user data for external strings */ } TString; +#define strisshr(ts) ((ts)->shrlen >= 0) +#define isextstr(ts) (ttislngstring(ts) && tsvalue(ts)->shrlen != LSTRREG) + /* -** Get the actual string (array of bytes) from a 'TString'. +** Get the actual string (array of bytes) from a 'TString'. (Generic +** version and specialized versions for long and short strings.) */ -#define getstr(ts) ((ts)->contents) - +#define rawgetshrstr(ts) (cast_charp(&(ts)->contents)) +#define getshrstr(ts) check_exp(strisshr(ts), rawgetshrstr(ts)) +#define getlngstr(ts) check_exp(!strisshr(ts), (ts)->contents) +#define getstr(ts) (strisshr(ts) ? rawgetshrstr(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_VSHRSTR ? (s)->shrlen : (s)->u.lnglen) +/* get string length from 'TString *ts' */ +#define tsslen(ts) \ + (strisshr(ts) ? cast_sizet((ts)->shrlen) : (ts)->u.lnglen) -/* get string length from 'TValue *o' */ -#define vslen(o) tsslen(tsvalue(o)) +/* +** Get string and length */ +#define getlstr(ts, len) \ + (strisshr(ts) \ + ? (cast_void((len) = cast_sizet((ts)->shrlen)), rawgetshrstr(ts)) \ + : (cast_void((len) = (ts)->u.lnglen), (ts)->contents)) /* }================================================================== */ @@ -488,8 +518,8 @@ typedef struct 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))) + ((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)) @@ -509,6 +539,9 @@ typedef struct Udata0 { #define LUA_VPROTO makevariant(LUA_TPROTO, 0) +typedef l_uint32 Instruction; + + /* ** Description of an upvalue for function prototypes */ @@ -546,13 +579,23 @@ typedef struct AbsLineInfo { int line; } AbsLineInfo; + +/* +** Flags in Prototypes +*/ +#define PF_ISVARARG 1 /* function is vararg */ +#define PF_VAVAR 2 /* function has vararg parameter */ +#define PF_VATAB 4 /* function has vararg table */ +#define PF_FIXED 8 /* prototype has parts in fixed memory */ + + /* ** Function Prototypes */ typedef struct Proto { CommonHeader; lu_byte numparams; /* number of fixed (named) parameters */ - lu_byte is_vararg; + lu_byte flag; lu_byte maxstacksize; /* number of registers needed by this function */ int sizeupvalues; /* size of 'upvalues' */ int sizek; /* size of 'k' */ @@ -710,10 +753,9 @@ typedef union Node { /* copy a value into a key */ -#define setnodekey(L,node,obj) \ +#define setnodekey(node,obj) \ { Node *n_=(node); const TValue *io_=(obj); \ - n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; \ - checkliveness(L,io_); } + n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; } /* copy a value from a key */ @@ -723,27 +765,14 @@ typedef union Node { 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)->flags & BITRAS)) -#define setrealasize(t) ((t)->flags &= cast_byte(~BITRAS)) -#define setnorealasize(t) ((t)->flags |= BITRAS) - typedef struct Table { CommonHeader; lu_byte flags; /* 1<

lsizenode)) /* size of buffer for 'luaO_utf8esc' function */ #define UTF8BUFFSZ 8 -LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x); -LUAI_FUNC int luaO_ceillog2 (unsigned int x); + +/* macro to call 'luaO_pushvfstring' correctly */ +#define pushvfstring(L, argp, fmt, msg) \ + { va_start(argp, fmt); \ + msg = luaO_pushvfstring(L, fmt, argp); \ + va_end(argp); \ + if (msg == NULL) luaD_throw(L, LUA_ERRMEM); /* only after 'va_end' */ } + + +LUAI_FUNC int luaO_utf8esc (char *buff, l_uint32 x); +LUAI_FUNC lu_byte luaO_ceillog2 (unsigned int x); +LUAI_FUNC lu_byte luaO_codeparam (unsigned int p); +LUAI_FUNC l_mem luaO_applyparam (lu_byte p, l_mem 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, StkId res); LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o); -LUAI_FUNC int luaO_hexavalue (int c); +LUAI_FUNC unsigned luaO_tostringbuff (const TValue *obj, char *buff); +LUAI_FUNC lu_byte luaO_hexavalue (int c); 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); diff --git a/lopcodes.c b/lopcodes.c index c67aa227c5..7e182315bc 100644 --- a/lopcodes.c +++ b/lopcodes.c @@ -13,6 +13,10 @@ #include "lopcodes.h" +#define opmode(mm,ot,it,t,a,m) \ + (((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m)) + + /* ORDER OP */ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { @@ -36,7 +40,7 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { ,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, ivABC) /* 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 */ @@ -49,8 +53,8 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { ,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_SHRI */ ,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 */ @@ -64,8 +68,8 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { ,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(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 */ @@ -95,10 +99,42 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { ,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, 1, 0, 0, ivABC) /* OP_SETLIST */ ,opmode(0, 0, 0, 0, 1, iABx) /* OP_CLOSURE */ ,opmode(0, 1, 0, 0, 1, iABC) /* OP_VARARG */ + ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETVARG */ + ,opmode(0, 0, 0, 0, 0, iABx) /* OP_ERRNNIL */ ,opmode(0, 0, 1, 0, 1, iABC) /* OP_VARARGPREP */ ,opmode(0, 0, 0, 0, 0, iAx) /* OP_EXTRAARG */ }; + + +/* +** Check whether instruction sets top for next instruction, that is, +** it results in multiple values. +*/ +int luaP_isOT (Instruction i) { + OpCode op = GET_OPCODE(i); + switch (op) { + case OP_TAILCALL: return 1; + default: + return testOTMode(op) && GETARG_C(i) == 0; + } +} + + +/* +** Check whether instruction uses top from previous instruction, that is, +** it accepts multiple results. +*/ +int luaP_isIT (Instruction i) { + OpCode op = GET_OPCODE(i); + switch (op) { + case OP_SETLIST: + return testITMode(GET_OPCODE(i)) && GETARG_vB(i) == 0; + default: + return testITMode(GET_OPCODE(i)) && GETARG_B(i) == 0; + } +} + diff --git a/lopcodes.h b/lopcodes.h index 7c27451596..f7bded2cc1 100644 --- a/lopcodes.h +++ b/lopcodes.h @@ -8,6 +8,7 @@ #define lopcodes_h #include "llimits.h" +#include "lobject.h" /*=========================================================================== @@ -18,25 +19,30 @@ 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) | +ivABC vC(10) | vB(6) |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) | +isJ sJ (signed)(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. + ('v' stands for "variant", 's' for "signed", 'x' for "extended".) + A signed argument is represented in excess K: The represented value is + the written unsigned value minus K, where K is half (rounded down) the + maximum value for the corresponding unsigned argument. ===========================================================================*/ -enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ +/* basic instruction formats */ +enum OpMode {iABC, ivABC, iABx, iAsBx, iAx, isJ}; /* ** size and position of opcode arguments. */ #define SIZE_C 8 +#define SIZE_vC 10 #define SIZE_B 8 +#define SIZE_vB 6 #define SIZE_Bx (SIZE_C + SIZE_B + 1) #define SIZE_A 8 #define SIZE_Ax (SIZE_Bx + SIZE_A) @@ -49,7 +55,9 @@ enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ #define POS_A (POS_OP + SIZE_OP) #define POS_k (POS_A + SIZE_A) #define POS_B (POS_k + 1) +#define POS_vB (POS_k + 1) #define POS_C (POS_B + SIZE_B) +#define POS_vC (POS_vB + SIZE_vB) #define POS_Bx POS_k @@ -64,14 +72,17 @@ enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ ** so they must fit in ints. */ -/* Check whether type 'int' has at least 'b' bits ('b' < 32) */ -#define L_INTHASBITS(b) ((UINT_MAX >> ((b) - 1)) >= 1) +/* +** Check whether type 'int' has at least 'b' + 1 bits. +** 'b' < 32; +1 for the sign bit. +*/ +#define L_INTHASBITS(b) ((UINT_MAX >> (b)) >= 1) #if L_INTHASBITS(SIZE_Bx) #define MAXARG_Bx ((1<>1) /* 'sBx' is signed */ @@ -80,13 +91,13 @@ enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ #if L_INTHASBITS(SIZE_Ax) #define MAXARG_Ax ((1<> 1) @@ -94,7 +105,9 @@ enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ #define MAXARG_A ((1<> 1) #define int2sC(i) ((i) + OFFSET_sC) @@ -113,28 +126,36 @@ enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */ #define GET_OPCODE(i) (cast(OpCode, ((i)>>POS_OP) & MASK1(SIZE_OP,0))) #define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \ - ((cast(Instruction, o)<>(pos)) & MASK1(size,0))) #define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \ - ((cast(Instruction, v)<> sC */ OP_SHLI,/* A B sC R[A] := sC << R[B] */ +OP_SHRI,/* A B sC R[A] := R[B] >> sC */ OP_ADD,/* A B C R[A] := R[B] + R[C] */ OP_SUB,/* A B C R[A] := R[B] - R[C] */ @@ -298,13 +332,17 @@ 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+i] := R[A+i], 1 <= i <= B */ +OP_SETLIST,/* A vB vC k R[A][vC+i] := R[A+i], 1 <= i <= vB */ 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_GETVARG, /* A B C R[A] := R[B][R[C]], R[B] is vararg parameter */ + +OP_ERRNNIL,/* A Bx raise error if R[A] ~= nil (K[Bx] is global name)*/ + +OP_VARARGPREP,/* (adjust vararg parameters) */ OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */ } OpCode; @@ -344,9 +382,9 @@ OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */ real C = EXTRAARG _ C (the bits of EXTRAARG concatenated with the bits of C). - (*) In OP_NEWTABLE, B is log2 of the hash size (which is always a + (*) In OP_NEWTABLE, vB 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. + is vC. Otherwise, the array size is EXTRAARG _ vC. (*) For comparisons, k specifies what condition the test should accept (true or false). @@ -387,19 +425,9 @@ LUAI_DDEC(const lu_byte luaP_opmodes[NUM_OPCODES];) #define testOTMode(m) (luaP_opmodes[m] & (1 << 6)) #define testMMMode(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) - -#define opmode(mm,ot,it,t,a,m) \ - (((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m)) +LUAI_FUNC int luaP_isOT (Instruction i); +LUAI_FUNC int luaP_isIT (Instruction i); -/* number of list items to accumulate before a SETLIST instruction */ -#define LFIELDS_PER_FLUSH 50 #endif diff --git a/lopnames.h b/lopnames.h index 965cec9bf2..0554a2e9a1 100644 --- a/lopnames.h +++ b/lopnames.h @@ -45,8 +45,8 @@ static const char *const opnames[] = { "BANDK", "BORK", "BXORK", - "SHRI", "SHLI", + "SHRI", "ADD", "SUB", "MUL", @@ -94,6 +94,8 @@ static const char *const opnames[] = { "SETLIST", "CLOSURE", "VARARG", + "GETVARG", + "ERRNNIL", "VARARGPREP", "EXTRAARG", NULL diff --git a/loslib.c b/loslib.c index 7eb05cafd4..b7a2b0d15f 100644 --- a/loslib.c +++ b/loslib.c @@ -20,6 +20,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" /* @@ -30,23 +31,14 @@ */ #if !defined(LUA_STRFTIMEOPTIONS) /* { */ -/* options for ANSI C 89 (only 1-char options) */ -#define L_STRFTIMEC89 "aAbBcdHIjmMpSUwWxXyYZ%" - -/* options for ISO C 99 and POSIX */ -#define L_STRFTIMEC99 "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \ - "||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */ - -/* options for Windows */ -#define L_STRFTIMEWIN "aAbBcdHIjmMpSUwWxXyYzZ%" \ - "||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */ - #if defined(LUA_USE_WINDOWS) -#define LUA_STRFTIMEOPTIONS L_STRFTIMEWIN -#elif defined(LUA_USE_C89) -#define LUA_STRFTIMEOPTIONS L_STRFTIMEC89 +#define LUA_STRFTIMEOPTIONS "aAbBcdHIjmMpSUwWxXyYzZ%" \ + "||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */ +#elif defined(LUA_USE_C89) /* C89 (only 1-char options) */ +#define LUA_STRFTIMEOPTIONS "aAbBcdHIjmMpSUwWxXyYZ%" #else /* C99 specification */ -#define LUA_STRFTIMEOPTIONS L_STRFTIMEC99 +#define LUA_STRFTIMEOPTIONS "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \ + "||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */ #endif #endif /* } */ @@ -138,21 +130,14 @@ /* }================================================================== */ -/* -** Despite claiming to be ISO, the C library in some Apple platforms -** does not implement 'system'. -*/ -#if !defined(l_system) && defined(__APPLE__) /* { */ -#include "TargetConditionals.h" -#if TARGET_OS_IOS || TARGET_OS_WATCH || TARGET_OS_TV -#define l_system(cmd) ((cmd) == NULL ? 0 : -1) -#endif -#endif /* } */ - #if !defined(l_system) +#if defined(LUA_USE_IOS) +/* Despite claiming to be ISO C, iOS does not implement 'system'. */ +#define l_system(cmd) ((cmd) == NULL ? 0 : -1) +#else #define l_system(cmd) system(cmd) /* default definition */ #endif - +#endif static int os_execute (lua_State *L) { @@ -171,6 +156,7 @@ static int os_execute (lua_State *L) { static int os_remove (lua_State *L) { const char *filename = luaL_checkstring(L, 1); + errno = 0; return luaL_fileresult(L, remove(filename) == 0, filename); } @@ -178,6 +164,7 @@ static int os_remove (lua_State *L) { static int os_rename (lua_State *L) { const char *fromname = luaL_checkstring(L, 1); const char *toname = luaL_checkstring(L, 2); + errno = 0; return luaL_fileresult(L, rename(fromname, toname) == 0, NULL); } @@ -286,9 +273,9 @@ static int getfield (lua_State *L, const char *key, int d, int delta) { static const char *checkoption (lua_State *L, const char *conv, - ptrdiff_t convlen, char *buff) { + size_t convlen, char *buff) { const char *option = LUA_STRFTIMEOPTIONS; - int oplen = 1; /* length of options being checked */ + unsigned oplen = 1; /* length of options being checked */ for (; *option != '\0' && oplen <= convlen; option += oplen) { if (*option == '|') /* next block? */ oplen++; /* will check options with next length (+1) */ @@ -346,7 +333,8 @@ static int os_date (lua_State *L) { size_t reslen; char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT); s++; /* skip '%' */ - s = checkoption(L, s, se - s, cc + 1); /* copy specifier to 'cc' */ + /* copy specifier to 'cc' */ + s = checkoption(L, s, ct_diff2sz(se - s), cc + 1); reslen = strftime(buff, SIZETIMEFMT, cc, stm); luaL_addsize(&b, reslen); } diff --git a/lparser.c b/lparser.c index 24668c2485..77141e79f9 100644 --- a/lparser.c +++ b/lparser.c @@ -30,8 +30,8 @@ -/* maximum number of local variables per function (must be smaller - than 250, due to the bytecode format) */ +/* maximum number of variable declarations per function (must be + smaller than 250, due to the bytecode format) */ #define MAXVARS 200 @@ -50,9 +50,9 @@ typedef struct BlockCnt { struct BlockCnt *previous; /* chain */ int firstlabel; /* index of first label in this block */ int firstgoto; /* index of first pending goto in this block */ - lu_byte nactvar; /* # active locals outside the block */ + short nactvar; /* number of active declarations at block entry */ lu_byte upval; /* true if some variable in the block is an upvalue */ - lu_byte isloop; /* true if 'block' is a loop */ + lu_byte isloop; /* 1 if 'block' is a loop; 2 if it has pending breaks */ lu_byte insidetbc; /* true if inside the scope of a to-be-closed var. */ } BlockCnt; @@ -84,8 +84,8 @@ static l_noret errorlimit (FuncState *fs, int limit, const char *what) { } -static void checklimit (FuncState *fs, int v, int l, const char *what) { - if (v > l) errorlimit(fs, l, what); +void luaY_checklimit (FuncState *fs, int v, int l, const char *what) { + if (l_unlikely(v > l)) errorlimit(fs, l, what); } @@ -172,7 +172,8 @@ static void codename (LexState *ls, expdesc *e) { ** Register a new local variable in the active 'Proto' (for debug ** information). */ -static int registerlocalvar (LexState *ls, FuncState *fs, TString *varname) { +static short registerlocalvar (LexState *ls, FuncState *fs, + TString *varname) { Proto *f = fs->f; int oldsize = f->sizelocvars; luaM_growvector(ls->L, f->locvars, fs->ndebugvars, f->sizelocvars, @@ -187,24 +188,30 @@ static int registerlocalvar (LexState *ls, FuncState *fs, TString *varname) { /* -** Create a new local variable with the given 'name'. Return its index -** in the function. +** Create a new variable with the given 'name' and given 'kind'. +** Return its index in the function. */ -static int new_localvar (LexState *ls, TString *name) { +static int new_varkind (LexState *ls, TString *name, lu_byte kind) { lua_State *L = ls->L; FuncState *fs = ls->fs; Dyndata *dyd = ls->dyd; Vardesc *var; - checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal, - MAXVARS, "local variables"); luaM_growvector(L, dyd->actvar.arr, dyd->actvar.n + 1, - dyd->actvar.size, Vardesc, USHRT_MAX, "local variables"); + dyd->actvar.size, Vardesc, SHRT_MAX, "variable declarations"); var = &dyd->actvar.arr[dyd->actvar.n++]; - var->vd.kind = VDKREG; /* default */ + var->vd.kind = kind; /* default */ var->vd.name = name; return dyd->actvar.n - 1 - fs->firstlocal; } + +/* +** Create a new local variable with the given 'name' and regular kind. +*/ +static int new_localvar (LexState *ls, TString *name) { + return new_varkind(ls, name, VDKREG); +} + #define new_localvarliteral(ls,v) \ new_localvar(ls, \ luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char)) - 1)); @@ -226,11 +233,11 @@ static Vardesc *getlocalvardesc (FuncState *fs, int vidx) { ** register. For that, search for the highest variable below that level ** that is in a register and uses its register index ('ridx') plus one. */ -static int reglevel (FuncState *fs, int nvar) { +static lu_byte reglevel (FuncState *fs, int nvar) { while (nvar-- > 0) { Vardesc *vd = getlocalvardesc(fs, nvar); /* get previous variable */ - if (vd->vd.kind != RDKCTC) /* is in a register? */ - return vd->vd.ridx + 1; + if (varinreg(vd)) /* is in a register? */ + return cast_byte(vd->vd.ridx + 1); } return 0; /* no variables in registers */ } @@ -240,7 +247,7 @@ static int reglevel (FuncState *fs, int nvar) { ** Return the number of variables in the register stack for the given ** function. */ -int luaY_nvarstack (FuncState *fs) { +lu_byte luaY_nvarstack (FuncState *fs) { return reglevel(fs, fs->nactvar); } @@ -250,7 +257,7 @@ int luaY_nvarstack (FuncState *fs) { */ static LocVar *localdebuginfo (FuncState *fs, int vidx) { Vardesc *vd = getlocalvardesc(fs, vidx); - if (vd->vd.kind == RDKCTC) + if (!varinreg(vd)) return NULL; /* no debug info. for constants */ else { int idx = vd->vd.pidx; @@ -266,13 +273,15 @@ static LocVar *localdebuginfo (FuncState *fs, int 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.vidx = cast_short(vidx); e->u.var.ridx = getlocalvardesc(fs, vidx)->vd.ridx; } /* -** Raises an error if variable described by 'e' is read only +** Raises an error if variable described by 'e' is read only; moreover, +** if 'e' is t[exp] where t is the vararg parameter, change it to index +** a real table. (Virtual vararg tables cannot be changed.) */ static void check_readonly (LexState *ls, expdesc *e) { FuncState *fs = ls->fs; @@ -282,7 +291,7 @@ static void check_readonly (LexState *ls, expdesc *e) { varname = ls->dyd->actvar.arr[e->u.info].vd.name; break; } - case VLOCAL: { + case VLOCAL: case VVARGVAR: { Vardesc *vardesc = getlocalvardesc(fs, e->u.var.vidx); if (vardesc->vd.kind != VDKREG) /* not a regular variable? */ varname = vardesc->vd.name; @@ -294,14 +303,22 @@ static void check_readonly (LexState *ls, expdesc *e) { varname = up->name; break; } + case VVARGIND: { + fs->f->flag |= PF_VATAB; /* function will need a vararg table */ + e->k = VINDEXED; + } /* FALLTHROUGH */ + case VINDEXUP: case VINDEXSTR: case VINDEXED: { /* global variable */ + if (e->u.ind.ro) /* read-only? */ + varname = tsvalue(&fs->f->k[e->u.ind.keystr]); + 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 */ + lua_assert(e->k == VINDEXI); /* this one doesn't need any check */ + return; /* integer index cannot be read-only */ } + if (varname) + luaK_semerror(ls, "attempt to assign to const variable '%s'", + getstr(varname)); } @@ -315,8 +332,9 @@ static void adjustlocalvars (LexState *ls, int nvars) { for (i = 0; i < nvars; i++) { int vidx = fs->nactvar++; Vardesc *var = getlocalvardesc(fs, vidx); - var->vd.ridx = reglevel++; + var->vd.ridx = cast_byte(reglevel++); var->vd.pidx = registerlocalvar(ls, fs, var->vd.name); + luaY_checklimit(fs, reglevel, MAXVARS, "local variables"); } } @@ -352,7 +370,7 @@ static int searchupvalue (FuncState *fs, TString *name) { static Upvaldesc *allocupvalue (FuncState *fs) { Proto *f = fs->f; int oldsize = f->sizeupvalues; - checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues"); + luaY_checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues"); luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues, Upvaldesc, MAXUPVAL, "upvalues"); while (oldsize < f->sizeupvalues) @@ -383,20 +401,43 @@ static int newupvalue (FuncState *fs, TString *name, expdesc *v) { /* -** Look for an active local variable with the name 'n' in the +** Look for an active variable with the name 'n' in the ** function 'fs'. If found, initialize 'var' with it and return -** its expression kind; otherwise return -1. +** its expression kind; otherwise return -1. While searching, +** var->u.info==-1 means that the preambular global declaration is +** active (the default while there is no other global declaration); +** var->u.info==-2 means there is no active collective declaration +** (some previous global declaration but no collective declaration); +** and var->u.info>=0 points to the inner-most (the first one found) +** collective declaration, if there is one. */ static int searchvar (FuncState *fs, TString *n, expdesc *var) { int i; for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) { Vardesc *vd = getlocalvardesc(fs, i); - if (eqstr(n, vd->vd.name)) { /* found? */ + if (varglobal(vd)) { /* global declaration? */ + if (vd->vd.name == NULL) { /* collective declaration? */ + if (var->u.info < 0) /* no previous collective declaration? */ + var->u.info = fs->firstlocal + i; /* this is the first one */ + } + else { /* global name */ + if (eqstr(n, vd->vd.name)) { /* found? */ + init_exp(var, VGLOBAL, fs->firstlocal + i); + return VGLOBAL; + } + else if (var->u.info == -1) /* active preambular declaration? */ + var->u.info = -2; /* invalidate preambular declaration */ + } + } + else 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 */ + else { /* local variable */ init_var(fs, var, i); - return var->k; + if (vd->vd.kind == RDKVAVAR) /* vararg parameter? */ + var->k = VVARGVAR; + } + return cast_int(var->k); } } return -1; /* not found */ @@ -433,48 +474,72 @@ static void marktobeclosed (FuncState *fs) { ** '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, var); /* look up locals at current level */ - if (v >= 0) { /* found? */ - if (v == VLOCAL && !base) - markupval(fs, var->u.var.vidx); /* local will be used as an upval */ + int v = searchvar(fs, n, var); /* look up variables at current level */ + if (v >= 0) { /* found? */ + if (!base) { + if (var->k == VVARGVAR) /* vararg parameter? */ + luaK_vapar2local(fs, var); /* change it to a regular local */ + if (var->k == VLOCAL) + markupval(fs, var->u.var.vidx); /* will be used as an upvalue */ } - else { /* not found as local at current level; try upvalues */ - int idx = searchupvalue(fs, n); /* try existing upvalues */ - if (idx < 0) { /* not found? */ + /* else nothing else to be done */ + } + else { /* not found at current level; try upvalues */ + int idx = searchupvalue(fs, n); /* try existing upvalues */ + if (idx < 0) { /* not found? */ + if (fs->prev != NULL) /* more levels? */ singlevaraux(fs->prev, n, var, 0); /* try upper levels */ - 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 */ + 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 */ } } +static void buildglobal (LexState *ls, TString *varname, expdesc *var) { + FuncState *fs = ls->fs; + expdesc key; + init_exp(var, VGLOBAL, -1); /* global by default */ + singlevaraux(fs, ls->envn, var, 1); /* get environment variable */ + if (var->k == VGLOBAL) + luaK_semerror(ls, "_ENV is global when accessing variable '%s'", + getstr(varname)); + luaK_exp2anyregup(fs, var); /* _ENV could be a constant */ + codestring(&key, varname); /* key is variable name */ + luaK_indexed(fs, var, &key); /* 'var' represents _ENV[varname] */ +} + + /* ** Find a variable with the given name 'n', handling global variables ** too. */ -static void singlevar (LexState *ls, expdesc *var) { - TString *varname = str_checkname(ls); +static void buildvar (LexState *ls, TString *varname, expdesc *var) { FuncState *fs = ls->fs; + init_exp(var, VGLOBAL, -1); /* global by default */ singlevaraux(fs, varname, var, 1); - if (var->k == VVOID) { /* global name? */ - expdesc key; - singlevaraux(fs, ls->envn, var, 1); /* get environment variable */ - lua_assert(var->k != VVOID); /* this one must exist */ - luaK_exp2anyregup(fs, var); /* but could be a constant */ - codestring(&key, varname); /* key is variable name */ - luaK_indexed(fs, var, &key); /* env[varname] */ + if (var->k == VGLOBAL) { /* global name? */ + int info = var->u.info; + /* global by default in the scope of a global declaration? */ + if (info == -2) + luaK_semerror(ls, "variable '%s' not declared", getstr(varname)); + buildglobal(ls, varname, var); + if (info != -1 && ls->dyd->actvar.arr[info].vd.kind == GDKCONST) + var->u.ind.ro = 1; /* mark variable as read-only */ + else /* anyway must be a global */ + lua_assert(info == -1 || ls->dyd->actvar.arr[info].vd.kind == GDKREG); } } +static void singlevar (LexState *ls, expdesc *var) { + buildvar(ls, str_checkname(ls), var); +} + + /* ** Adjust the number of results from an expression list 'e' with 'nexps' ** expressions to 'nvars' values. @@ -482,6 +547,7 @@ static void singlevar (LexState *ls, expdesc *var) { static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { FuncState *fs = ls->fs; int needed = nvars - nexps; /* extra values needed */ + luaK_checkstack(fs, needed); if (hasmultret(e->k)) { /* last expression has multiple returns? */ int extra = needed + 1; /* discount last expression itself */ if (extra < 0) @@ -497,7 +563,7 @@ static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { if (needed > 0) luaK_reserveregs(fs, needed); /* registers for extra values */ else /* adding 'needed' is actually a subtraction */ - fs->freereg += needed; /* remove extra values */ + fs->freereg = cast_byte(fs->freereg + needed); /* remove extra values */ } @@ -509,29 +575,43 @@ static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { /* ** Generates an error that a goto jumps into the scope of some -** local variable. +** variable declaration. */ static l_noret jumpscopeerror (LexState *ls, Labeldesc *gt) { - const char *varname = getstr(getlocalvardesc(ls->fs, gt->nactvar)->vd.name); - const char *msg = " 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 */ + TString *tsname = getlocalvardesc(ls->fs, gt->nactvar)->vd.name; + const char *varname = (tsname != NULL) ? getstr(tsname) : "*"; + luaK_semerror(ls, + " at line %d jumps into the scope of '%s'", + getstr(gt->name), gt->line, varname); /* raise the error */ } /* -** Solves the goto at index 'g' to given 'label' and removes it -** from the list of pending goto's. +** Closes the goto at index 'g' to given 'label' and removes it +** from the list of pending gotos. ** If it jumps into the scope of some variable, raises an error. +** The goto needs a CLOSE if it jumps out of a block with upvalues, +** or out of the scope of some variable and the block has upvalues +** (signaled by parameter 'bup'). */ -static void solvegoto (LexState *ls, int g, Labeldesc *label) { +static void closegoto (LexState *ls, int g, Labeldesc *label, int bup) { int i; - Labellist *gl = &ls->dyd->gt; /* list of goto's */ + FuncState *fs = ls->fs; + Labellist *gl = &ls->dyd->gt; /* list of gotos */ Labeldesc *gt = &gl->arr[g]; /* goto to be resolved */ lua_assert(eqstr(gt->name, label->name)); if (l_unlikely(gt->nactvar < label->nactvar)) /* enter some scope? */ jumpscopeerror(ls, gt); - luaK_patchlist(ls->fs, gt->pc, label->pc); + if (gt->close || + (label->nactvar < gt->nactvar && bup)) { /* needs close? */ + lu_byte stklevel = reglevel(fs, label->nactvar); + /* move jump to CLOSE position */ + fs->f->code[gt->pc + 1] = fs->f->code[gt->pc]; + /* put CLOSE instruction at original position */ + fs->f->code[gt->pc] = CREATE_ABCk(OP_CLOSE, stklevel, 0, 0, 0); + gt->pc++; /* must point to jump instruction */ + } + luaK_patchlist(ls->fs, gt->pc, label->pc); /* goto jumps to label */ for (i = g; i < gl->n - 1; i++) /* remove goto from pending list */ gl->arr[i] = gl->arr[i + 1]; gl->n--; @@ -539,14 +619,14 @@ static void solvegoto (LexState *ls, int g, Labeldesc *label) { /* -** Search for an active label with the given name. +** Search for an active label with the given name, starting at +** index 'ilb' (so that it can search for all labels in current block +** or all labels in current function). */ -static Labeldesc *findlabel (LexState *ls, TString *name) { - int i; +static Labeldesc *findlabel (LexState *ls, TString *name, int ilb) { Dyndata *dyd = ls->dyd; - /* check labels in current function for a match */ - for (i = ls->fs->firstlabel; i < dyd->label.n; i++) { - Labeldesc *lb = &dyd->label.arr[i]; + for (; ilb < dyd->label.n; ilb++) { + Labeldesc *lb = &dyd->label.arr[ilb]; if (eqstr(lb->name, name)) /* correct label? */ return lb; } @@ -572,41 +652,30 @@ static int newlabelentry (LexState *ls, Labellist *l, TString *name, } -static int newgotoentry (LexState *ls, TString *name, int line, int pc) { - return newlabelentry(ls, &ls->dyd->gt, name, line, pc); -} - - /* -** 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. +** Create an entry for the goto and the code for it. As it is not known +** at this point whether the goto may need a CLOSE, the code has a jump +** followed by an CLOSE. (As the CLOSE comes after the jump, it is a +** dead instruction; it works as a placeholder.) When the goto is closed +** against a label, if it needs a CLOSE, the two instructions swap +** positions, so that the CLOSE comes before the jump. */ -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; +static int newgotoentry (LexState *ls, TString *name, int line) { + FuncState *fs = ls->fs; + int pc = luaK_jump(fs); /* create jump */ + luaK_codeABC(fs, OP_CLOSE, 0, 1, 0); /* spaceholder, marked as dead */ + return newlabelentry(ls, &ls->dyd->gt, name, line, pc); } /* ** 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 +** block. Solves all pending gotos 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) { +static void 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)); @@ -614,28 +683,37 @@ static int createlabel (LexState *ls, TString *name, int line, /* 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. +** Traverse the pending gotos of the finishing block checking whether +** each match some label of that block. Those that do not match are +** "exported" to the outer block, to be solved there. In particular, +** its 'nactvar' is updated with the level of the inner block, +** as the variables of the inner block are now out of scope. */ -static void movegotosout (FuncState *fs, BlockCnt *bl) { - int i; - Labellist *gl = &fs->ls->dyd->gt; - /* correct pending gotos to current block */ - for (i = bl->firstgoto; i < gl->n; i++) { /* for each pending goto */ - Labeldesc *gt = &gl->arr[i]; - /* leaving a variable scope? */ - if (reglevel(fs, gt->nactvar) > reglevel(fs, bl->nactvar)) - gt->close |= bl->upval; /* jump may need a close */ - gt->nactvar = bl->nactvar; /* update goto level */ +static void solvegotos (FuncState *fs, BlockCnt *bl) { + LexState *ls = fs->ls; + Labellist *gl = &ls->dyd->gt; + int outlevel = reglevel(fs, bl->nactvar); /* level outside the block */ + int igt = bl->firstgoto; /* first goto in the finishing block */ + while (igt < gl->n) { /* for each pending goto */ + Labeldesc *gt = &gl->arr[igt]; + /* search for a matching label in the current block */ + Labeldesc *lb = findlabel(ls, gt->name, bl->firstlabel); + if (lb != NULL) /* found a match? */ + closegoto(ls, igt, lb, bl->upval); /* close and remove goto */ + else { /* adjust 'goto' for outer block */ + /* block has variables to be closed and goto escapes the scope of + some variable? */ + if (bl->upval && reglevel(fs, gt->nactvar) > outlevel) + gt->close = 1; /* jump may need a close */ + gt->nactvar = bl->nactvar; /* correct level for outer block */ + igt++; /* go to next goto */ + } } + ls->dyd->label.n = bl->firstlabel; /* remove local labels */ } @@ -645,8 +723,9 @@ static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) { bl->firstlabel = fs->ls->dyd->label.n; bl->firstgoto = fs->ls->dyd->gt.n; bl->upval = 0; + /* inherit 'insidetbc' from enclosing block */ bl->insidetbc = (fs->bl != NULL && fs->bl->insidetbc); - bl->previous = fs->bl; + bl->previous = fs->bl; /* link block in function's block list */ fs->bl = bl; lua_assert(fs->freereg == luaY_nvarstack(fs)); } @@ -656,39 +735,30 @@ static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) { ** generates an error for an undefined 'goto'. */ static l_noret undefgoto (LexState *ls, Labeldesc *gt) { - 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 at line %d"; - msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line); - } - luaK_semerror(ls, msg); + /* breaks are checked when created, cannot be undefined */ + lua_assert(!eqstr(gt->name, ls->brkn)); + luaK_semerror(ls, "no visible label '%s' for at line %d", + getstr(gt->name), gt->line); } static void leaveblock (FuncState *fs) { BlockCnt *bl = fs->bl; LexState *ls = fs->ls; - int hasclose = 0; - int stklevel = reglevel(fs, bl->nactvar); /* level outside the block */ - removevars(fs, bl->nactvar); /* remove block locals */ - lua_assert(bl->nactvar == fs->nactvar); /* back to level on entry */ - if (bl->isloop) /* has to fix pending breaks? */ - hasclose = createlabel(ls, luaS_newliteral(ls->L, "break"), 0, 0); - if (!hasclose && bl->previous && bl->upval) /* still need a 'close'? */ + lu_byte stklevel = reglevel(fs, bl->nactvar); /* level outside block */ + if (bl->previous && bl->upval) /* need a 'close'? */ luaK_codeABC(fs, OP_CLOSE, stklevel, 0, 0); fs->freereg = stklevel; /* free registers */ - ls->dyd->label.n = bl->firstlabel; /* remove local labels */ - fs->bl = bl->previous; /* current block now is previous one */ - if (bl->previous) /* was it a nested block? */ - movegotosout(fs, bl); /* update pending gotos to enclosing block */ - else { + removevars(fs, bl->nactvar); /* remove block locals */ + lua_assert(bl->nactvar == fs->nactvar); /* back to level on entry */ + if (bl->isloop == 2) /* has to fix pending breaks? */ + createlabel(ls, ls->brkn, 0, 0); + solvegotos(fs, bl); + if (bl->previous == NULL) { /* was it the last block? */ if (bl->firstgoto < ls->dyd->gt.n) /* still pending gotos? */ undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */ } + fs->bl = bl->previous; /* current block now is previous one */ } @@ -727,6 +797,7 @@ static void codeclosure (LexState *ls, expdesc *v) { static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) { + lua_State *L = ls->L; Proto *f = fs->f; fs->prev = ls->fs; /* linked list of funcstates */ fs->ls = ls; @@ -747,8 +818,11 @@ static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) { fs->firstlabel = ls->dyd->label.n; fs->bl = NULL; f->source = ls->source; - luaC_objbarrier(ls->L, f, f->source); + luaC_objbarrier(L, f, f->source); f->maxstacksize = 2; /* registers 0/1 are always valid */ + fs->kcache = luaH_new(L); /* create table for function */ + sethvalue2s(L, L->top.p, fs->kcache); /* anchor it */ + luaD_inctop(L); enterblock(fs, bl, 0); } @@ -770,14 +844,16 @@ static void close_func (LexState *ls) { luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->ndebugvars, LocVar); luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc); ls->fs = fs->prev; + L->top.p--; /* pop kcache table */ luaC_checkGC(L); } - -/*============================================================*/ -/* GRAMMAR RULES */ -/*============================================================*/ +/* +** {====================================================================== +** GRAMMAR RULES +** ======================================================================= +*/ /* @@ -834,25 +910,36 @@ static void yindex (LexState *ls, expdesc *v) { ** ======================================================================= */ - typedef struct ConsControl { expdesc v; /* last list item read */ expdesc *t; /* table descriptor */ int nh; /* total number of 'record' elements */ int na; /* number of array elements already stored */ int tostore; /* number of array elements pending to be stored */ + int maxtostore; /* maximum number of pending elements */ } ConsControl; +/* +** Maximum number of elements in a constructor, to control the following: +** * counter overflows; +** * overflows in 'extra' for OP_NEWTABLE and OP_SETLIST; +** * overflows when adding multiple returns in OP_SETLIST. +*/ +#define MAX_CNST (INT_MAX/2) +#if MAX_CNST/(MAXARG_vC + 1) > MAXARG_Ax +#undef MAX_CNST +#define MAX_CNST (MAXARG_Ax * (MAXARG_vC + 1)) +#endif + + static void recfield (LexState *ls, ConsControl *cc) { /* recfield -> (NAME | '['exp']') = exp */ FuncState *fs = ls->fs; - int reg = ls->fs->freereg; + lu_byte reg = ls->fs->freereg; expdesc tab, key, val; - if (ls->t.token == TK_NAME) { - checklimit(fs, cc->nh, MAX_INT, "items in a constructor"); + if (ls->t.token == TK_NAME) codename(ls, &key); - } else /* ls->t.token == '[' */ yindex(ls, &key); cc->nh++; @@ -866,10 +953,10 @@ static void recfield (LexState *ls, ConsControl *cc) { static void closelistfield (FuncState *fs, ConsControl *cc) { - if (cc->v.k == VVOID) return; /* there is no list item */ + lua_assert(cc->tostore > 0); luaK_exp2nextreg(fs, &cc->v); cc->v.k = VVOID; - if (cc->tostore == LFIELDS_PER_FLUSH) { + if (cc->tostore >= cc->maxtostore) { luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */ cc->na += cc->tostore; cc->tostore = 0; /* no more items pending */ @@ -922,12 +1009,28 @@ static void field (LexState *ls, ConsControl *cc) { } +/* +** Compute a limit for how many registers a constructor can use before +** emitting a 'SETLIST' instruction, based on how many registers are +** available. +*/ +static int maxtostore (FuncState *fs) { + int numfreeregs = MAX_FSTACK - fs->freereg; + if (numfreeregs >= 160) /* "lots" of registers? */ + return numfreeregs / 5; /* use up to 1/5 of them */ + else if (numfreeregs >= 80) /* still "enough" registers? */ + return 10; /* one 'SETLIST' instruction for each 10 values */ + else /* save registers for potential more nesting */ + return 1; +} + + static void constructor (LexState *ls, expdesc *t) { /* constructor -> '{' [ field { sep field } [sep] ] '}' sep -> ',' | ';' */ FuncState *fs = ls->fs; int line = ls->linenumber; - int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0); + int pc = luaK_codevABCk(fs, OP_NEWTABLE, 0, 0, 0, 0); ConsControl cc; luaK_code(fs, 0); /* space for extra arg. */ cc.na = cc.nh = cc.tostore = 0; @@ -935,14 +1038,17 @@ static void constructor (LexState *ls, expdesc *t) { 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) */ - checknext(ls, '{'); + checknext(ls, '{' /*}*/); + cc.maxtostore = maxtostore(fs); do { - lua_assert(cc.v.k == VVOID || cc.tostore > 0); - if (ls->t.token == '}') break; - closelistfield(fs, &cc); + if (ls->t.token == /*{*/ '}') break; + if (cc.v.k != VVOID) /* is there a previous list item? */ + closelistfield(fs, &cc); /* close it */ field(ls, &cc); + luaY_checklimit(fs, cc.tostore + cc.na + cc.nh, MAX_CNST, + "items in a constructor"); } while (testnext(ls, ',') || testnext(ls, ';')); - check_match(ls, '}', '{', line); + check_match(ls, /*{*/ '}', '{' /*}*/, line); lastlistfield(fs, &cc); luaK_settablesize(fs, pc, t->u.info, cc.na, cc.nh); } @@ -950,9 +1056,10 @@ static void constructor (LexState *ls, expdesc *t) { /* }====================================================================== */ -static void setvararg (FuncState *fs, int nparams) { - fs->f->is_vararg = 1; - luaK_codeABC(fs, OP_VARARGPREP, nparams, 0, 0); +static void setvararg (FuncState *fs, int kind) { + lua_assert(kind & PF_ISVARARG); + fs->f->flag |= cast_byte(kind); + luaK_codeABC(fs, OP_VARARGPREP, 0, 0, 0); } @@ -961,7 +1068,7 @@ static void parlist (LexState *ls) { FuncState *fs = ls->fs; Proto *f = fs->f; int nparams = 0; - int isvararg = 0; + int varargk = 0; if (ls->t.token != ')') { /* is 'parlist' not empty? */ do { switch (ls->t.token) { @@ -971,19 +1078,27 @@ static void parlist (LexState *ls) { break; } case TK_DOTS: { - luaX_next(ls); - isvararg = 1; + varargk |= PF_ISVARARG; + luaX_next(ls); /* skip '...' */ + if (ls->t.token == TK_NAME) { + new_varkind(ls, str_checkname(ls), RDKVAVAR); + varargk |= PF_VAVAR; + } break; } default: luaX_syntaxerror(ls, " or '...' expected"); } - } while (!isvararg && testnext(ls, ',')); + } while (!varargk && testnext(ls, ',')); } adjustlocalvars(ls, nparams); f->numparams = cast_byte(fs->nactvar); - if (isvararg) - setvararg(fs, f->numparams); /* declared vararg */ - luaK_reserveregs(fs, fs->nactvar); /* reserve registers for parameters */ + if (varargk != 0) { + setvararg(fs, varargk); /* declared vararg */ + if (varargk & PF_VAVAR) + adjustlocalvars(ls, 1); /* vararg parameter */ + } + /* reserve registers for parameters (plus vararg parameter, if present) */ + luaK_reserveregs(fs, fs->nactvar); } @@ -1022,10 +1137,11 @@ static int explist (LexState *ls, expdesc *v) { } -static void funcargs (LexState *ls, expdesc *f, int line) { +static void funcargs (LexState *ls, expdesc *f) { FuncState *fs = ls->fs; expdesc args; int base, nparams; + int line = ls->linenumber; switch (ls->t.token) { case '(': { /* funcargs -> '(' [ explist ] ')' */ luaX_next(ls); @@ -1039,7 +1155,7 @@ static void funcargs (LexState *ls, expdesc *f, int line) { check_match(ls, ')', '(', line); break; } - case '{': { /* funcargs -> constructor */ + case '{' /*}*/: { /* funcargs -> constructor */ constructor(ls, &args); break; } @@ -1063,8 +1179,9 @@ static void funcargs (LexState *ls, expdesc *f, int line) { } init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2)); luaK_fixline(fs, line); - fs->freereg = base+1; /* call remove function and arguments and leaves - (unless changed) one result */ + /* call removes function and arguments and leaves one result (unless + changed later) */ + fs->freereg = cast_byte(base + 1); } @@ -1103,7 +1220,6 @@ static void suffixedexp (LexState *ls, expdesc *v) { /* suffixedexp -> primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */ FuncState *fs = ls->fs; - int line = ls->linenumber; primaryexp(ls, v); for (;;) { switch (ls->t.token) { @@ -1123,12 +1239,12 @@ static void suffixedexp (LexState *ls, expdesc *v) { luaX_next(ls); codename(ls, &key); luaK_self(fs, v, &key); - funcargs(ls, v, line); + funcargs(ls, v); break; } - case '(': case TK_STRING: case '{': { /* funcargs */ + case '(': case TK_STRING: case '{' /*}*/: { /* funcargs */ luaK_exp2nextreg(fs, v); - funcargs(ls, v, line); + funcargs(ls, v); break; } default: return; @@ -1169,12 +1285,12 @@ static void simpleexp (LexState *ls, expdesc *v) { } case TK_DOTS: { /* vararg */ FuncState *fs = ls->fs; - check_condition(ls, fs->f->is_vararg, + check_condition(ls, fs->f->flag & PF_ISVARARG, "cannot use '...' outside a vararg function"); init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 0, 1)); break; } - case '{': { /* constructor */ + case '{' /*}*/: { /* constructor */ constructor(ls, v); return; } @@ -1330,7 +1446,7 @@ struct LHS_assign { */ static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { FuncState *fs = ls->fs; - int extra = fs->freereg; /* eventual position to save local variable */ + lu_byte extra = fs->freereg; /* eventual position to save local variable */ int conflict = 0; for (; lh; lh = lh->prev) { /* check all previous assignments */ if (vkisindexed(lh->v.k)) { /* assignment to table field? */ @@ -1365,6 +1481,15 @@ static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { } } + +/* Create code to store the "top" register in 'var' */ +static void storevartop (FuncState *fs, expdesc *var) { + expdesc e; + init_exp(&e, VNONRELOC, fs->freereg - 1); + luaK_storevar(fs, var, &e); /* will also free the top register */ +} + + /* ** Parse and compile a multiple assignment. The first "variable" ** (a 'suffixedexp') was already read by the caller. @@ -1398,8 +1523,7 @@ static void restassign (LexState *ls, struct LHS_assign *lh, int nvars) { return; /* avoid default */ } } - init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */ - luaK_storevar(ls->fs, &lh->v, &e); + storevartop(ls->fs, &lh->v); /* default assignment */ } @@ -1413,45 +1537,38 @@ static int cond (LexState *ls) { } -static void gotostat (LexState *ls) { - FuncState *fs = ls->fs; - int line = ls->linenumber; +static void gotostat (LexState *ls, int line) { 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 = reglevel(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); - } + newgotoentry(ls, name, line); } /* ** Break statement. Semantically equivalent to "goto break". */ -static void breakstat (LexState *ls) { - int line = ls->linenumber; +static void breakstat (LexState *ls, int line) { + BlockCnt *bl; /* to look for an enclosing loop */ + for (bl = ls->fs->bl; bl != NULL; bl = bl->previous) { + if (bl->isloop) /* found one? */ + goto ok; + } + luaX_syntaxerror(ls, "break outside loop"); + ok: + bl->isloop = 2; /* signal that block has pending breaks */ luaX_next(ls); /* skip break */ - newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, luaK_jump(ls->fs)); + newgotoentry(ls, ls->brkn, line); } /* -** Check whether there is already a label with the given 'name'. +** Check whether there is already a label with the given 'name' at +** current function. */ static void checkrepeated (LexState *ls, TString *name) { - Labeldesc *lb = findlabel(ls, name); - if (l_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 */ - } + Labeldesc *lb = findlabel(ls, name, ls->fs->firstlabel); + if (l_unlikely(lb != NULL)) /* already defined? */ + luaK_semerror(ls, "label '%s' already defined on line %d", + getstr(name), lb->line); /* error */ } @@ -1550,6 +1667,7 @@ static void forbody (LexState *ls, int base, int line, int nvars, int isgen) { int prep, endfor; checknext(ls, TK_DO); prep = luaK_codeABx(fs, forprep[isgen], base, 0); + fs->freereg--; /* both 'forprep' remove one register from the stack */ enterblock(fs, &bl, 0); /* scope for declared variables */ adjustlocalvars(ls, nvars); luaK_reserveregs(fs, nvars); @@ -1572,8 +1690,7 @@ static void fornum (LexState *ls, TString *varname, int line) { int base = fs->freereg; new_localvarliteral(ls, "(for state)"); new_localvarliteral(ls, "(for state)"); - new_localvarliteral(ls, "(for state)"); - new_localvar(ls, varname); + new_varkind(ls, varname, RDKCONST); /* control variable */ checknext(ls, '='); exp1(ls); /* initial value */ checknext(ls, ','); @@ -1584,7 +1701,7 @@ static void fornum (LexState *ls, TString *varname, int line) { luaK_int(fs, fs->freereg, 1); luaK_reserveregs(fs, 1); } - adjustlocalvars(ls, 3); /* control variables */ + adjustlocalvars(ls, 2); /* start scope for internal variables */ forbody(ls, base, line, 1, 0); } @@ -1593,16 +1710,15 @@ static void forlist (LexState *ls, TString *indexname) { /* forlist -> NAME {,NAME} IN explist forbody */ FuncState *fs = ls->fs; expdesc e; - int nvars = 5; /* gen, state, control, toclose, 'indexname' */ + int nvars = 4; /* function, state, closing, control */ int line; int base = fs->freereg; - /* create control variables */ - new_localvarliteral(ls, "(for state)"); - new_localvarliteral(ls, "(for state)"); - new_localvarliteral(ls, "(for state)"); - new_localvarliteral(ls, "(for state)"); - /* create declared variables */ - new_localvar(ls, indexname); + /* create internal variables */ + new_localvarliteral(ls, "(for state)"); /* iterator function */ + new_localvarliteral(ls, "(for state)"); /* state */ + new_localvarliteral(ls, "(for state)"); /* closing var. (after swap) */ + new_varkind(ls, indexname, RDKCONST); /* control variable */ + /* other declared variables */ while (testnext(ls, ',')) { new_localvar(ls, str_checkname(ls)); nvars++; @@ -1610,10 +1726,10 @@ static void forlist (LexState *ls, TString *indexname) { checknext(ls, TK_IN); line = ls->linenumber; adjust_assign(ls, 4, explist(ls, &e), &e); - adjustlocalvars(ls, 4); /* control variables */ - marktobeclosed(fs); /* last control var. must be closed */ - luaK_checkstack(fs, 3); /* extra space to call generator */ - forbody(ls, base, line, nvars - 4, 1); + adjustlocalvars(ls, 3); /* start scope for internal variables */ + marktobeclosed(fs); /* last internal var. must be closed */ + luaK_checkstack(fs, 2); /* extra space to call iterator */ + forbody(ls, base, line, nvars - 3, 1); } @@ -1637,38 +1753,16 @@ static void forstat (LexState *ls, int line) { static void test_then_block (LexState *ls, int *escapelist) { /* test_then_block -> [IF | ELSEIF] cond THEN block */ - BlockCnt bl; FuncState *fs = ls->fs; - expdesc v; - int jf; /* instruction to skip 'then' code (if condition is false) */ + int condtrue; luaX_next(ls); /* skip IF or ELSEIF */ - expr(ls, &v); /* read condition */ + condtrue = cond(ls); /* read condition */ checknext(ls, TK_THEN); - if (ls->t.token == TK_BREAK) { /* 'if x then break' ? */ - int line = ls->linenumber; - luaK_goiffalse(ls->fs, &v); /* will jump if condition is true */ - luaX_next(ls); /* skip 'break' */ - enterblock(fs, &bl, 0); /* must enter block before 'goto' */ - newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, v.t); - 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 a break) */ - luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */ - enterblock(fs, &bl, 0); - jf = v.f; - } - statlist(ls); /* 'then' part */ - leaveblock(fs); + block(ls); /* 'then' part */ if (ls->t.token == TK_ELSE || ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */ luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */ - luaK_patchtohere(fs, jf); + luaK_patchtohere(fs, condtrue); } @@ -1698,20 +1792,20 @@ static void localfunc (LexState *ls) { } -static int getlocalattribute (LexState *ls) { - /* ATTRIB -> ['<' Name '>'] */ +static lu_byte getvarattribute (LexState *ls, lu_byte df) { + /* attrib -> ['<' NAME '>'] */ if (testnext(ls, '<')) { - const char *attr = getstr(str_checkname(ls)); + TString *ts = str_checkname(ls); + const char *attr = getstr(ts); 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)); + luaK_semerror(ls, "unknown attribute '%s'", attr); } - return VDKREG; /* regular variable */ + return df; /* return default value */ } @@ -1724,18 +1818,20 @@ static void checktoclose (FuncState *fs, int level) { static void localstat (LexState *ls) { - /* stat -> LOCAL NAME ATTRIB { ',' NAME ATTRIB } ['=' explist] */ + /* stat -> LOCAL NAME attrib { ',' NAME attrib } ['=' 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 vidx; /* index of last variable */ int nvars = 0; int nexps; expdesc e; - do { - vidx = new_localvar(ls, str_checkname(ls)); - kind = getlocalattribute(ls); - getlocalvardesc(fs, vidx)->vd.kind = kind; + /* get prefixed attribute (if any); default is regular local variable */ + lu_byte defkind = getvarattribute(ls, VDKREG); + do { /* for each variable */ + TString *vname = str_checkname(ls); /* get its name */ + lu_byte kind = getvarattribute(ls, defkind); /* postfixed attribute */ + vidx = new_varkind(ls, vname, kind); /* predeclare it */ if (kind == RDKTOCLOSE) { /* to-be-closed? */ if (toclose != -1) /* one already present? */ luaK_semerror(ls, "multiple to-be-closed variables in local list"); @@ -1743,13 +1839,13 @@ static void localstat (LexState *ls) { } nvars++; } while (testnext(ls, ',')); - if (testnext(ls, '=')) + if (testnext(ls, '=')) /* initialization? */ nexps = explist(ls, &e); else { e.k = VVOID; nexps = 0; } - var = getlocalvardesc(fs, vidx); /* get last variable */ + var = getlocalvardesc(fs, vidx); /* retrieve last variable */ if (nvars == nexps && /* no adjustments? */ var->vd.kind == RDKCONST && /* last variable is const? */ luaK_exp2const(fs, &e, &var->k)) { /* compile-time constant? */ @@ -1765,6 +1861,116 @@ static void localstat (LexState *ls) { } +static lu_byte getglobalattribute (LexState *ls, lu_byte df) { + lu_byte kind = getvarattribute(ls, df); + switch (kind) { + case RDKTOCLOSE: + luaK_semerror(ls, "global variables cannot be to-be-closed"); + return kind; /* to avoid warnings */ + case RDKCONST: + return GDKCONST; /* adjust kind for global variable */ + default: + return kind; + } +} + + +static void checkglobal (LexState *ls, TString *varname, int line) { + FuncState *fs = ls->fs; + expdesc var; + int k; + buildglobal(ls, varname, &var); /* create global variable in 'var' */ + k = var.u.ind.keystr; /* index of global name in 'k' */ + luaK_codecheckglobal(fs, &var, k, line); +} + + +/* +** Recursively traverse list of globals to be initalized. When +** going, generate table description for the global. In the end, +** after all indices have been generated, read list of initializing +** expressions. When returning, generate the assignment of the value on +** the stack to the corresponding table description. 'n' is the variable +** being handled, range [0, nvars - 1]. +*/ +static void initglobal (LexState *ls, int nvars, int firstidx, int n, + int line) { + if (n == nvars) { /* traversed all variables? */ + expdesc e; + int nexps = explist(ls, &e); /* read list of expressions */ + adjust_assign(ls, nvars, nexps, &e); + } + else { /* handle variable 'n' */ + FuncState *fs = ls->fs; + expdesc var; + TString *varname = getlocalvardesc(fs, firstidx + n)->vd.name; + buildglobal(ls, varname, &var); /* create global variable in 'var' */ + enterlevel(ls); /* control recursion depth */ + initglobal(ls, nvars, firstidx, n + 1, line); + leavelevel(ls); + checkglobal(ls, varname, line); + storevartop(fs, &var); + } +} + + +static void globalnames (LexState *ls, lu_byte defkind) { + FuncState *fs = ls->fs; + int nvars = 0; + int lastidx; /* index of last registered variable */ + do { /* for each name */ + TString *vname = str_checkname(ls); + lu_byte kind = getglobalattribute(ls, defkind); + lastidx = new_varkind(ls, vname, kind); + nvars++; + } while (testnext(ls, ',')); + if (testnext(ls, '=')) /* initialization? */ + initglobal(ls, nvars, lastidx - nvars + 1, 0, ls->linenumber); + fs->nactvar = cast_short(fs->nactvar + nvars); /* activate declaration */ +} + + +static void globalstat (LexState *ls) { + /* globalstat -> (GLOBAL) attrib '*' + globalstat -> (GLOBAL) attrib NAME attrib {',' NAME attrib} */ + FuncState *fs = ls->fs; + /* get prefixed attribute (if any); default is regular global variable */ + lu_byte defkind = getglobalattribute(ls, GDKREG); + if (!testnext(ls, '*')) + globalnames(ls, defkind); + else { + /* use NULL as name to represent '*' entries */ + new_varkind(ls, NULL, defkind); + fs->nactvar++; /* activate declaration */ + } +} + + +static void globalfunc (LexState *ls, int line) { + /* globalfunc -> (GLOBAL FUNCTION) NAME body */ + expdesc var, b; + FuncState *fs = ls->fs; + TString *fname = str_checkname(ls); + new_varkind(ls, fname, GDKREG); /* declare global variable */ + fs->nactvar++; /* enter its scope */ + buildglobal(ls, fname, &var); + body(ls, &b, 0, ls->linenumber); /* compile and return closure in 'b' */ + checkglobal(ls, fname, line); + luaK_storevar(fs, &var, &b); + luaK_fixline(fs, line); /* definition "happens" in the first line */ +} + + +static void globalstatfunc (LexState *ls, int line) { + /* stat -> GLOBAL globalfunc | GLOBAL globalstat */ + luaX_next(ls); /* skip 'global' */ + if (testnext(ls, TK_FUNCTION)) + globalfunc(ls, line); + else + globalstat(ls); +} + + static int funcname (LexState *ls, expdesc *v) { /* funcname -> NAME {fieldsel} [':' NAME] */ int ismethod = 0; @@ -1785,8 +1991,8 @@ static void funcstat (LexState *ls, int line) { expdesc v, b; luaX_next(ls); /* skip FUNCTION */ ismethod = funcname(ls, &v); - body(ls, &b, ismethod, line); check_readonly(ls, &v); + body(ls, &b, ismethod, line); luaK_storevar(ls->fs, &v, &b); luaK_fixline(ls->fs, line); /* definition "happens" in the first line */ } @@ -1884,6 +2090,10 @@ static void statement (LexState *ls) { localstat(ls); break; } + case TK_GLOBAL: { /* stat -> globalstatfunc */ + globalstatfunc(ls, line); + break; + } case TK_DBCOLON: { /* stat -> label */ luaX_next(ls); /* skip double colon */ labelstat(ls, str_checkname(ls), line); @@ -1895,14 +2105,30 @@ static void statement (LexState *ls) { break; } case TK_BREAK: { /* stat -> breakstat */ - breakstat(ls); + breakstat(ls, line); break; } case TK_GOTO: { /* stat -> 'goto' NAME */ luaX_next(ls); /* skip 'goto' */ - gotostat(ls); + gotostat(ls, line); break; } +#if defined(LUA_COMPAT_GLOBAL) + case TK_NAME: { + /* compatibility code to parse global keyword when "global" + is not reserved */ + if (ls->t.seminfo.ts == ls->glbn) { /* current = "global"? */ + int lk = luaX_lookahead(ls); + if (lk == '<' || lk == TK_NAME || lk == '*' || lk == TK_FUNCTION) { + /* 'global ' or 'global name' or 'global *' or + 'global function' */ + globalstatfunc(ls, line); + break; + } + } /* else... */ + } +#endif + /* FALLTHROUGH */ default: { /* stat -> func | assignment */ exprstat(ls); break; @@ -1916,6 +2142,8 @@ static void statement (LexState *ls) { /* }====================================================================== */ +/* }====================================================================== */ + /* ** compiles the main function, which is a regular vararg function with an @@ -1925,7 +2153,7 @@ static void mainfunc (LexState *ls, FuncState *fs) { BlockCnt bl; Upvaldesc *env; open_func(ls, fs, &bl); - setvararg(fs, 0); /* main function is always declared vararg */ + setvararg(fs, PF_ISVARARG); /* main function is always vararg */ env = allocupvalue(fs); /* ...set environment upvalue */ env->instack = 1; env->idx = 0; diff --git a/lparser.h b/lparser.h index 5e4500f181..a30df04f77 100644 --- a/lparser.h +++ b/lparser.h @@ -32,26 +32,36 @@ typedef enum { VKFLT, /* floating constant; nval = numerical float value */ VKINT, /* integer constant; ival = numerical integer value */ VKSTR, /* string constant; strval = TString address; - (string is fixed by the lexer) */ + (string is fixed by the scanner) */ VNONRELOC, /* expression has its value in a fixed register; info = result register */ VLOCAL, /* local variable; var.ridx = register index; var.vidx = relative index in 'actvar.arr' */ + VVARGVAR, /* vararg parameter; var.ridx = register index; + var.vidx = relative index in 'actvar.arr' */ + VGLOBAL, /* global variable; + info = relative index in 'actvar.arr' (or -1 for + implicit declaration) */ VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */ VCONST, /* compile-time variable; info = absolute index in 'actvar.arr' */ VINDEXED, /* indexed variable; ind.t = table register; - ind.idx = key's R index */ + ind.idx = key's R index; + ind.ro = true if it represents a read-only global; + ind.keystr = if key is a string, index in 'k' of that string; + -1 if key is not a string */ + VVARGIND, /* indexed vararg parameter; + ind.* as in VINDEXED */ VINDEXUP, /* indexed upvalue; - ind.t = table upvalue; - ind.idx = key's K index */ + ind.idx = key's K index; + ind.* as in VINDEXED */ 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 */ + ind.idx = key's K index; + ind.* as in VINDEXED */ VJMP, /* expression is a test/comparison; info = pc of corresponding jump instruction */ VRELOC, /* expression can put result in any register; @@ -75,10 +85,12 @@ typedef struct expdesc { struct { /* for indexed variables */ short idx; /* index (R or "long" K) */ lu_byte t; /* table (register or upvalue) */ + lu_byte ro; /* true if variable is read-only */ + int keystr; /* index in 'k' of string key, or -1 if not a string */ } ind; struct { /* for local variables */ lu_byte ridx; /* register holding the variable */ - unsigned short vidx; /* compiler index (in 'actvar.arr') */ + short vidx; /* index in 'actvar.arr' */ } var; } u; int t; /* patch list of 'exit when true' */ @@ -87,12 +99,22 @@ typedef struct expdesc { /* kinds of variables */ -#define VDKREG 0 /* regular */ -#define RDKCONST 1 /* constant */ -#define RDKTOCLOSE 2 /* to-be-closed */ -#define RDKCTC 3 /* compile-time constant */ +#define VDKREG 0 /* regular local */ +#define RDKCONST 1 /* local constant */ +#define RDKVAVAR 2 /* vararg parameter */ +#define RDKTOCLOSE 3 /* to-be-closed */ +#define RDKCTC 4 /* local compile-time constant */ +#define GDKREG 5 /* regular global */ +#define GDKCONST 6 /* global constant */ + +/* variables that live in registers */ +#define varinreg(v) ((v)->vd.kind <= RDKTOCLOSE) + +/* test for global variables */ +#define varglobal(v) ((v)->vd.kind >= GDKREG) + -/* description of an active local variable */ +/* description of an active variable */ typedef union Vardesc { struct { TValuefields; /* constant value (if it is a compile-time constant) */ @@ -111,8 +133,8 @@ typedef struct Labeldesc { TString *name; /* label identifier */ int pc; /* position in code */ int line; /* line where it appeared */ - lu_byte nactvar; /* number of active variables in that position */ - lu_byte close; /* goto that escapes upvalues */ + short nactvar; /* number of active variables in that position */ + lu_byte close; /* true for goto that escapes upvalues */ } Labeldesc; @@ -146,6 +168,7 @@ typedef struct FuncState { struct FuncState *prev; /* enclosing function */ struct LexState *ls; /* lexical state */ struct BlockCnt *bl; /* chain of current blocks */ + Table *kcache; /* cache for reusing constants */ int pc; /* next position to code (equivalent to 'ncode') */ int lasttarget; /* 'label' of last 'jump label' */ int previousline; /* last line that was saved in 'lineinfo' */ @@ -155,7 +178,7 @@ typedef struct FuncState { int firstlocal; /* index of first local var (in Dyndata array) */ 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 */ + short nactvar; /* number of active variable declarations */ lu_byte nups; /* number of upvalues */ lu_byte freereg; /* first free register */ lu_byte iwthabs; /* instructions issued since last absolute line info */ @@ -163,7 +186,9 @@ typedef struct FuncState { } FuncState; -LUAI_FUNC int luaY_nvarstack (FuncState *fs); +LUAI_FUNC lu_byte luaY_nvarstack (FuncState *fs); +LUAI_FUNC void luaY_checklimit (FuncState *fs, int v, int l, + const char *what); LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, Dyndata *dyd, const char *name, int firstchar); diff --git a/lstate.c b/lstate.c index 1fbefb4b14..70a11aaec6 100644 --- a/lstate.c +++ b/lstate.c @@ -29,79 +29,45 @@ -/* -** thread state + extra space -*/ -typedef struct LX { - lu_byte extra_[LUA_EXTRASPACE]; - lua_State l; -} LX; - - -/* -** Main thread combines a thread state and the global state -*/ -typedef struct LG { - LX l; - global_State g; -} LG; - - - #define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l))) /* -** A macro to create a "random" seed when a state is created; -** the seed is used to randomize string hashes. +** these macros allow user-specific actions when a thread is +** created/deleted */ -#if !defined(luai_makeseed) +#if !defined(luai_userstateopen) +#define luai_userstateopen(L) ((void)L) +#endif -#include +#if !defined(luai_userstateclose) +#define luai_userstateclose(L) ((void)L) +#endif -/* -** 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_sizet(e); \ - memcpy(b + p, &t, sizeof(t)); p += sizeof(t); } - -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, &lua_newstate); /* public function */ - lua_assert(p == sizeof(buff)); - return luaS_hash(buff, p, h); -} +#if !defined(luai_userstatethread) +#define luai_userstatethread(L,L1) ((void)L) +#endif +#if !defined(luai_userstatefree) +#define luai_userstatefree(L,L1) ((void)L) #endif /* -** set GCdebt to a new value keeping the value (totalbytes + GCdebt) -** invariant (and avoiding underflows in 'totalbytes') +** set GCdebt to a new value keeping the real number of allocated +** objects (GCtotalobjs - GCdebt) invariant and avoiding overflows in +** 'GCtotalobjs'. */ void luaE_setdebt (global_State *g, l_mem debt) { l_mem tb = gettotalbytes(g); lua_assert(tb > 0); - if (debt < tb - MAX_LMEM) - debt = tb - MAX_LMEM; /* will make 'totalbytes == MAX_LMEM' */ - g->totalbytes = tb - debt; + if (debt > MAX_LMEM - tb) + debt = MAX_LMEM - tb; /* will make GCtotalbytes == MAX_LMEM */ + g->GCtotalbytes = tb + debt; g->GCdebt = debt; } -LUA_API int lua_setcstacklimit (lua_State *L, unsigned int limit) { - UNUSED(L); UNUSED(limit); - return LUAI_MAXCCALLS; /* warning?? */ -} - - CallInfo *luaE_extendCI (lua_State *L) { CallInfo *ci; lua_assert(L->ci->next == NULL); @@ -119,7 +85,7 @@ CallInfo *luaE_extendCI (lua_State *L) { /* ** free all CallInfo structures not in use by a thread */ -void luaE_freeCI (lua_State *L) { +static void freeCI (lua_State *L) { CallInfo *ci = L->ci; CallInfo *next = ci->next; ci->next = NULL; @@ -166,7 +132,7 @@ void luaE_checkcstack (lua_State *L) { if (getCcalls(L) == LUAI_MAXCCALLS) luaG_runerror(L, "C stack overflow"); else if (getCcalls(L) >= (LUAI_MAXCCALLS / 10 * 11)) - luaD_throw(L, LUA_ERRERR); /* error while handling stack error */ + luaD_errerr(L); /* error while handling stack error */ } @@ -177,26 +143,29 @@ LUAI_FUNC void luaE_incCstack (lua_State *L) { } +static void resetCI (lua_State *L) { + CallInfo *ci = L->ci = &L->base_ci; + ci->func.p = L->stack.p; + setnilvalue(s2v(ci->func.p)); /* 'function' entry for basic 'ci' */ + ci->top.p = ci->func.p + 1 + LUA_MINSTACK; /* +1 for 'function' entry */ + ci->u.c.k = NULL; + ci->callstatus = CIST_C; + L->status = LUA_OK; + L->errfunc = 0; /* stack unwind can "throw away" the error function */ +} + + static void stack_init (lua_State *L1, lua_State *L) { - int i; CallInfo *ci; + int i; /* initialize stack array */ L1->stack.p = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, StackValue); L1->tbclist.p = L1->stack.p; for (i = 0; i < BASIC_STACK_SIZE + EXTRA_STACK; i++) setnilvalue(s2v(L1->stack.p + i)); /* erase new stack */ - L1->top.p = L1->stack.p; L1->stack_last.p = L1->stack.p + BASIC_STACK_SIZE; /* initialize first ci */ - ci = &L1->base_ci; - ci->next = ci->previous = NULL; - ci->callstatus = CIST_C; - ci->func.p = L1->top.p; - ci->u.c.k = NULL; - ci->nresults = 0; - setnilvalue(s2v(L1->top.p)); /* 'function' entry for this 'ci' */ - L1->top.p++; - ci->top.p = L1->top.p + LUA_MINSTACK; - L1->ci = ci; + resetCI(L1); + L1->top.p = L1->stack.p + 1; /* +1 for 'function' entry */ } @@ -204,9 +173,10 @@ static void freestack (lua_State *L) { if (L->stack.p == NULL) return; /* stack not completely built yet */ L->ci = &L->base_ci; /* free the entire 'ci' list */ - luaE_freeCI(L); + freeCI(L); lua_assert(L->nci == 0); - luaM_freearray(L, L->stack.p, stacksize(L) + EXTRA_STACK); /* free stack */ + /* free stack */ + luaM_freearray(L, L->stack.p, cast_sizet(stacksize(L) + EXTRA_STACK)); } @@ -215,13 +185,19 @@ static void freestack (lua_State *L) { */ static void init_registry (lua_State *L, global_State *g) { /* create registry */ + TValue aux; Table *registry = luaH_new(L); sethvalue(L, &g->l_registry, registry); luaH_resize(L, registry, LUA_RIDX_LAST, 0); + /* registry[1] = false */ + setbfvalue(&aux); + luaH_setint(L, registry, 1, &aux); /* registry[LUA_RIDX_MAINTHREAD] = L */ - setthvalue(L, ®istry->array[LUA_RIDX_MAINTHREAD - 1], L); + setthvalue(L, &aux, L); + luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &aux); /* registry[LUA_RIDX_GLOBALS] = new table (table of globals) */ - sethvalue(L, ®istry->array[LUA_RIDX_GLOBALS - 1], luaH_new(L)); + sethvalue(L, &aux, luaH_new(L)); + luaH_setint(L, registry, LUA_RIDX_GLOBALS, &aux); } @@ -263,6 +239,16 @@ static void preinit_thread (lua_State *L, global_State *g) { L->status = LUA_OK; L->errfunc = 0; L->oldpc = 0; + L->base_ci.previous = L->base_ci.next = NULL; +} + + +lu_mem luaE_threadsize (lua_State *L) { + lu_mem sz = cast(lu_mem, sizeof(LX)) + + cast_uint(L->nci) * sizeof(CallInfo); + if (L->stack.p != NULL) + sz += cast_uint(stacksize(L) + EXTRA_STACK) * sizeof(StackValue); + return sz; } @@ -271,15 +257,16 @@ static void close_state (lua_State *L) { if (!completestate(g)) /* closing a partially built state? */ luaC_freeallobjects(L); /* just collect its objects */ else { /* closing a fully built state */ - L->ci = &L->base_ci; /* unwind CallInfo list */ + resetCI(L); luaD_closeprotected(L, 1, LUA_OK); /* close all upvalues */ + L->top.p = L->stack.p + 1; /* empty the stack to run finalizers */ luaC_freeallobjects(L); /* collect all objects */ luai_userstateclose(L); } - luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size); + luaM_freearray(L, G(L)->strt.hash, cast_sizet(G(L)->strt.size)); freestack(L); - lua_assert(gettotalbytes(g) == sizeof(LG)); - (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */ + lua_assert(gettotalbytes(g) == sizeof(global_State)); + (*g->frealloc)(g->ud, g, sizeof(global_State), 0); /* free main block */ } @@ -301,7 +288,7 @@ LUA_API lua_State *lua_newthread (lua_State *L) { L1->hook = L->hook; resethookcount(L1); /* initialize L1 extra space */ - memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread), + memcpy(lua_getextraspace(L1), lua_getextraspace(mainthread(g)), LUA_EXTRASPACE); luai_userstatethread(L, L1); stack_init(L1, L); /* init stack */ @@ -320,43 +307,39 @@ void luaE_freethread (lua_State *L, lua_State *L1) { } -int luaE_resetthread (lua_State *L, int status) { - CallInfo *ci = L->ci = &L->base_ci; /* unwind CallInfo list */ - setnilvalue(s2v(L->stack.p)); /* 'function' entry for basic 'ci' */ - ci->func.p = L->stack.p; - ci->callstatus = CIST_C; +TStatus luaE_resetthread (lua_State *L, TStatus status) { + resetCI(L); if (status == LUA_YIELD) status = LUA_OK; - L->status = LUA_OK; /* so it can run __close metamethods */ status = luaD_closeprotected(L, 1, status); if (status != LUA_OK) /* errors? */ luaD_seterrorobj(L, status, L->stack.p + 1); else L->top.p = L->stack.p + 1; - ci->top.p = L->top.p + LUA_MINSTACK; - luaD_reallocstack(L, cast_int(ci->top.p - L->stack.p), 0); + luaD_reallocstack(L, cast_int(L->ci->top.p - L->stack.p), 0); return status; } -LUA_API int lua_resetthread (lua_State *L, lua_State *from) { - int status; +LUA_API int lua_closethread (lua_State *L, lua_State *from) { + TStatus status; lua_lock(L); L->nCcalls = (from) ? getCcalls(from) : 0; status = luaE_resetthread(L, L->status); + if (L == from) /* closing itself? */ + luaD_throwbaselevel(L, status); lua_unlock(L); - return status; + return APIstatus(status); } -LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { +LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud, unsigned seed) { int i; lua_State *L; - global_State *g; - LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG))); - if (l == NULL) return NULL; - L = &l->l.l; - g = &l->g; + global_State *g = cast(global_State*, + (*f)(ud, NULL, LUA_TTHREAD, sizeof(global_State))); + if (g == NULL) return NULL; + L = &g->mainth.l; L->tt = LUA_VTHREAD; g->currentwhite = bitmask(WHITE0BIT); L->marked = luaC_white(g); @@ -368,8 +351,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { g->ud = ud; g->warnf = NULL; g->ud_warn = NULL; - g->mainthread = L; - g->seed = luai_makeseed(L); + g->seed = seed; g->gcstp = GCSTPGC; /* no GC while building state */ g->strt.size = g->strt.nuse = 0; g->strt.hash = NULL; @@ -386,16 +368,17 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { g->gray = g->grayagain = NULL; g->weak = g->ephemeron = g->allweak = NULL; g->twups = NULL; - g->totalbytes = sizeof(LG); + g->GCtotalbytes = sizeof(global_State); + g->GCmarked = 0; g->GCdebt = 0; - 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; + setgcparam(g, PAUSE, LUAI_GCPAUSE); + setgcparam(g, STEPMUL, LUAI_GCMUL); + setgcparam(g, STEPSIZE, LUAI_GCSTEPSIZE); + setgcparam(g, MINORMUL, LUAI_GENMINORMUL); + setgcparam(g, MINORMAJOR, LUAI_MINORMAJOR); + setgcparam(g, MAJORMINOR, LUAI_MAJORMINOR); + for (i=0; i < LUA_NUMTYPES; i++) g->mt[i] = NULL; if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) { /* memory allocation error: free partial state */ close_state(L); @@ -407,7 +390,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { LUA_API void lua_close (lua_State *L) { lua_lock(L); - L = G(L)->mainthread; /* only the main thread can be closed */ + L = mainthread(G(L)); /* only the main thread can be closed */ close_state(L); } @@ -425,7 +408,7 @@ void luaE_warning (lua_State *L, const char *msg, int tocont) { void luaE_warnerror (lua_State *L, const char *where) { TValue *errobj = s2v(L->top.p - 1); /* error object */ const char *msg = (ttisstring(errobj)) - ? svalue(errobj) + ? getstr(tsvalue(errobj)) : "error object is not a string"; /* produce warning "error in %s (%s)" (where, msg) */ luaE_warning(L, "error in ", 1); diff --git a/lstate.h b/lstate.h index 8bf6600e34..20dc4d24f0 100644 --- a/lstate.h +++ b/lstate.h @@ -85,7 +85,7 @@ typedef struct CallInfo CallInfo; ** they must be visited again at the end of the cycle), but they are ** marked black because assignments to them must activate barriers (to ** move them back to TOUCHED1). -** - Open upvales are kept gray to avoid barriers, but they stay out +** - Open upvalues are kept gray to avoid barriers, but they stay out ** of gray lists. (They don't even have a 'gclist' field.) */ @@ -142,6 +142,17 @@ struct lua_longjmp; /* defined in ldo.c */ #define EXTRA_STACK 5 +/* +** Size of cache for strings in the API. 'N' is the number of +** sets (better be a prime) and "M" is the size of each set. +** (M == 1 makes a direct cache.) +*/ +#if !defined(STRCACHE_N) +#define STRCACHE_N 53 +#define STRCACHE_M 2 +#endif + + #define BASIC_STACK_SIZE (2*LUA_MINSTACK) #define stacksize(th) cast_int((th)->stack_last.p - (th)->stack.p) @@ -149,13 +160,14 @@ struct lua_longjmp; /* defined in ldo.c */ /* kinds of Garbage Collection */ #define KGC_INC 0 /* incremental gc */ -#define KGC_GEN 1 /* generational gc */ +#define KGC_GENMINOR 1 /* generational gc in minor (regular) mode */ +#define KGC_GENMAJOR 2 /* generational in major mode */ typedef struct stringtable { - TString **hash; + TString **hash; /* array of buckets (linked lists of strings) */ int nuse; /* number of elements */ - int size; + int size; /* number of buckets */ } stringtable; @@ -171,17 +183,15 @@ typedef struct stringtable { ** yield (from the yield until the next resume); ** - field 'nres' is used only while closing tbc variables when ** returning from a function; -** - field 'transferinfo' is used only during call/returnhooks, -** before the function starts or after it ends. */ struct CallInfo { StkIdRel func; /* function index in the stack */ - StkIdRel top; /* top for this function */ + StkIdRel top; /* top for this function */ struct CallInfo *previous, *next; /* dynamic call link */ union { struct { /* only for Lua functions */ const Instruction *savedpc; - volatile l_signalT trap; + volatile l_signalT trap; /* function is tracing lines/counts */ int nextraargs; /* # of extra arguments in vararg functions */ } l; struct { /* only for C functions */ @@ -194,36 +204,55 @@ struct CallInfo { int funcidx; /* called-function index */ int nyield; /* number of values yielded */ int nres; /* number of values returned */ - 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; + l_uint32 callstatus; }; /* -** Bits in CallInfo status +** Maximum expected number of results from a function +** (must fit in CIST_NRESULTS). */ -#define CIST_OAH (1<<0) /* original value of 'allowhook' */ -#define CIST_C (1<<1) /* call is running a C function */ -#define CIST_FRESH (1<<2) /* call is on a fresh "luaV_execute" frame */ -#define CIST_HOOKED (1<<3) /* call is running a debug hook */ -#define CIST_YPCALL (1<<4) /* doing a yieldable protected call */ -#define CIST_TAIL (1<<5) /* call was tail called */ -#define CIST_HOOKYIELD (1<<6) /* last hook called yielded */ -#define CIST_FIN (1<<7) /* function "called" a finalizer */ -#define CIST_TRAN (1<<8) /* 'ci' has transfer information */ -#define CIST_CLSRET (1<<9) /* function is closing tbc variables */ -/* Bits 10-12 are used for CIST_RECST (see below) */ -#define CIST_RECST 10 -#if defined(LUA_COMPAT_LT_LE) -#define CIST_LEQ (1<<13) /* using __lt for __le */ -#endif +#define MAXRESULTS 250 +/* +** Bits in CallInfo status +*/ +/* bits 0-7 are the expected number of results from this function + 1 */ +#define CIST_NRESULTS 0xffu + +/* bits 8-11 count call metamethods (and their extra arguments) */ +#define CIST_CCMT 8 /* the offset, not the mask */ +#define MAX_CCMT (0xfu << CIST_CCMT) + +/* Bits 12-14 are used for CIST_RECST (see below) */ +#define CIST_RECST 12 /* the offset, not the mask */ + +/* call is running a C function (still in first 16 bits) */ +#define CIST_C (1u << (CIST_RECST + 3)) +/* call is on a fresh "luaV_execute" frame */ +#define CIST_FRESH (cast(l_uint32, CIST_C) << 1) +/* function is closing tbc variables */ +#define CIST_CLSRET (CIST_FRESH << 1) +/* function has tbc variables to close */ +#define CIST_TBC (CIST_CLSRET << 1) +/* original value of 'allowhook' */ +#define CIST_OAH (CIST_TBC << 1) +/* call is running a debug hook */ +#define CIST_HOOKED (CIST_OAH << 1) +/* doing a yieldable protected call */ +#define CIST_YPCALL (CIST_HOOKED << 1) +/* call was tail called */ +#define CIST_TAIL (CIST_YPCALL << 1) +/* last hook called yielded */ +#define CIST_HOOKYIELD (CIST_TAIL << 1) +/* function "called" a finalizer */ +#define CIST_FIN (CIST_HOOKYIELD << 1) + + +#define get_nresults(cs) (cast_int((cs) & CIST_NRESULTS) - 1) + /* ** Field CIST_RECST stores the "recover status", used to keep the error ** status while closing to-be-closed variables in coroutines, so that @@ -233,8 +262,8 @@ struct CallInfo { #define getcistrecst(ci) (((ci)->callstatus >> CIST_RECST) & 7) #define setcistrecst(ci,st) \ check_exp(((st) & 7) == (st), /* status must fit in three bits */ \ - ((ci)->callstatus = ((ci)->callstatus & ~(7 << CIST_RECST)) \ - | ((st) << CIST_RECST))) + ((ci)->callstatus = ((ci)->callstatus & ~(7u << CIST_RECST)) \ + | (cast(l_uint32, st) << CIST_RECST))) /* active function is a Lua function */ @@ -243,9 +272,53 @@ struct CallInfo { /* 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)) -#define getoah(st) ((st) & CIST_OAH) + +#define setoah(ci,v) \ + ((ci)->callstatus = ((v) ? (ci)->callstatus | CIST_OAH \ + : (ci)->callstatus & ~CIST_OAH)) +#define getoah(ci) (((ci)->callstatus & CIST_OAH) ? 1 : 0) + + +/* +** 'per thread' state +*/ +struct lua_State { + CommonHeader; + lu_byte allowhook; + TStatus status; + StkIdRel top; /* first free slot in the stack */ + struct global_State *l_G; + CallInfo *ci; /* call info for current function */ + StkIdRel stack_last; /* end of stack (last element + 1) */ + StkIdRel stack; /* stack base */ + UpVal *openupval; /* list of open upvalues in this stack */ + StkIdRel tbclist; /* list of to-be-closed variables */ + GCObject *gclist; + struct lua_State *twups; /* list of threads with open upvalues */ + struct lua_longjmp *errorJmp; /* current error recover point */ + CallInfo base_ci; /* CallInfo for first level (C host) */ + volatile lua_Hook hook; + ptrdiff_t errfunc; /* current error handling function (stack index) */ + l_uint32 nCcalls; /* number of nested non-yieldable or C calls */ + int oldpc; /* last pc traced */ + int nci; /* number of items in 'ci' list */ + int basehookcount; + int hookcount; + volatile l_signalT hookmask; + struct { /* info about transferred values (for call/return hooks) */ + int ftransfer; /* offset of first value transferred */ + int ntransfer; /* number of values transferred */ + } transferinfo; +}; + + +/* +** thread state + extra space +*/ +typedef struct LX { + lu_byte extra_[LUA_EXTRASPACE]; + lua_State l; +} LX; /* @@ -254,25 +327,21 @@ struct CallInfo { typedef struct global_State { lua_Alloc frealloc; /* function to reallocate memory */ 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 GCestimate; /* an estimate of the non-garbage memory in use */ - lu_mem lastatomic; /* see function 'genstep' in file 'lgc.c' */ + l_mem GCtotalbytes; /* number of bytes currently allocated + debt */ + l_mem GCdebt; /* bytes counted but not yet allocated */ + l_mem GCmarked; /* number of objects marked in a GC cycle */ + l_mem GCmajorminor; /* auxiliary counter to control major-minor shifts */ stringtable strt; /* hash table for strings */ TValue l_registry; TValue nilvalue; /* a nil value */ unsigned int seed; /* randomized seed for hashes */ + lu_byte gcparams[LUA_GCPN]; lu_byte currentwhite; lu_byte gcstate; /* state of garbage collector */ lu_byte gckind; /* kind of GC running */ lu_byte gcstopem; /* stops emergency collections */ - lu_byte genminormul; /* control for minor generational collections */ - lu_byte genmajormul; /* control for major generational collections */ lu_byte gcstp; /* control whether 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 */ @@ -293,46 +362,18 @@ typedef struct global_State { GCObject *finobjrold; /* list of really old objects with finalizers */ struct lua_State *twups; /* list of threads with open upvalues */ lua_CFunction panic; /* to be called in unprotected errors */ - struct lua_State *mainthread; TString *memerrmsg; /* message for memory-allocation errors */ TString *tmname[TM_N]; /* array with tag-method names */ struct Table *mt[LUA_NUMTYPES]; /* 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' */ + LX mainth; /* main thread of this state */ } global_State; -/* -** 'per thread' state -*/ -struct lua_State { - CommonHeader; - lu_byte status; - lu_byte allowhook; - unsigned short nci; /* number of items in 'ci' list */ - StkIdRel top; /* first free slot in the stack */ - global_State *l_G; - CallInfo *ci; /* call info for current function */ - StkIdRel stack_last; /* end of stack (last element + 1) */ - StkIdRel stack; /* stack base */ - UpVal *openupval; /* list of open upvalues in this stack */ - StkIdRel tbclist; /* list of to-be-closed variables */ - GCObject *gclist; - struct lua_State *twups; /* list of threads with open upvalues */ - struct lua_longjmp *errorJmp; /* current error recover point */ - 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 nested (non-yieldable | C) calls */ - int oldpc; /* last pc traced */ - int basehookcount; - int hookcount; - volatile l_signalT hookmask; -}; - - #define G(L) (L->l_G) +#define mainthread(G) (&(G)->mainth.l) /* ** 'g->nilvalue' being a nil value flags that the state was completely @@ -385,24 +426,25 @@ union GCUnion { /* ** 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)) +#define obj2gco(v) \ + check_exp(novariant((v)->tt) >= LUA_TSTRING, &(cast_u(v)->gc)) + +/* actual number of total memory allocated */ +#define gettotalbytes(g) ((g)->GCtotalbytes - (g)->GCdebt) -/* actual number of total bytes allocated */ -#define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt) LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt); LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1); +LUAI_FUNC lu_mem luaE_threadsize (lua_State *L); 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_checkcstack (lua_State *L); LUAI_FUNC void luaE_incCstack (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); -LUAI_FUNC int luaE_resetthread (lua_State *L, int status); +LUAI_FUNC TStatus luaE_resetthread (lua_State *L, TStatus status); #endif diff --git a/lstring.c b/lstring.c index 13dcaf4259..75635142e9 100644 --- a/lstring.c +++ b/lstring.c @@ -25,22 +25,32 @@ /* ** Maximum size for string table. */ -#define MAXSTRTB cast_int(luaM_limitN(MAX_INT, TString*)) +#define MAXSTRTB cast_int(luaM_limitN(INT_MAX, TString*)) + +/* +** Initial size for the string table (must be power of 2). +** The Lua core alone registers ~50 strings (reserved words + +** metaevent keys + a few others). Libraries would typically add +** a few dozens more. +*/ +#if !defined(MINSTRTABSIZE) +#define MINSTRTABSIZE 128 +#endif /* -** equality for long strings +** generic equality for strings */ -int luaS_eqlngstr (TString *a, TString *b) { - size_t len = a->u.lnglen; - 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 */ +int luaS_eqstr (TString *a, TString *b) { + size_t len1, len2; + const char *s1 = getlstr(a, len1); + const char *s2 = getlstr(b, len2); + return ((len1 == len2) && /* equal length and ... */ + (memcmp(s1, s2, len1) == 0)); /* equal contents */ } -unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) { +static unsigned luaS_hash (const char *str, size_t l, unsigned seed) { unsigned int h = seed ^ cast_uint(l); for (; l > 0; l--) h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1])); @@ -48,11 +58,11 @@ unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) { } -unsigned int luaS_hashlongstr (TString *ts) { +unsigned luaS_hashlongstr (TString *ts) { lua_assert(ts->tt == LUA_VLNGSTR); if (ts->extra == 0) { /* no hash? */ size_t len = ts->u.lnglen; - ts->hash = luaS_hash(getstr(ts), len, ts->hash); + ts->hash = luaS_hash(getlngstr(ts), len, ts->hash); ts->extra = 1; /* now it has its hash */ } return ts->hash; @@ -136,27 +146,43 @@ void luaS_init (lua_State *L) { } +size_t luaS_sizelngstr (size_t len, int kind) { + switch (kind) { + case LSTRREG: /* regular long string */ + /* don't need 'falloc'/'ud', but need space for content */ + return offsetof(TString, falloc) + (len + 1) * sizeof(char); + case LSTRFIX: /* fixed external long string */ + /* don't need 'falloc'/'ud' */ + return offsetof(TString, falloc); + default: /* external long string with deallocation */ + lua_assert(kind == LSTRMEM); + return sizeof(TString); + } +} + /* ** creates a new string object */ -static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) { +static TString *createstrobj (lua_State *L, size_t totalsize, lu_byte tag, + unsigned h) { TString *ts; GCObject *o; - size_t totalsize; /* total size of TString object */ - totalsize = sizelstring(l); o = luaC_newobj(L, tag, totalsize); ts = gco2ts(o); ts->hash = h; ts->extra = 0; - getstr(ts)[l] = '\0'; /* ending 0 */ return ts; } TString *luaS_createlngstrobj (lua_State *L, size_t l) { - TString *ts = createstrobj(L, l, LUA_VLNGSTR, G(L)->seed); + size_t totalsize = luaS_sizelngstr(l, LSTRREG); + TString *ts = createstrobj(L, totalsize, LUA_VLNGSTR, G(L)->seed); ts->u.lnglen = l; + ts->shrlen = LSTRREG; /* signals that it is a regular long string */ + ts->contents = cast_charp(ts) + offsetof(TString, falloc); + ts->contents[l] = '\0'; /* ending 0 */ return ts; } @@ -172,9 +198,9 @@ void luaS_remove (lua_State *L, TString *ts) { static void growstrtab (lua_State *L, stringtable *tb) { - if (l_unlikely(tb->nuse == MAX_INT)) { /* too many strings? */ + if (l_unlikely(tb->nuse == INT_MAX)) { /* too many strings? */ luaC_fullgc(L, 1); /* try to free some... */ - if (tb->nuse == MAX_INT) /* still too many? */ + if (tb->nuse == INT_MAX) /* still too many? */ luaM_error(L); /* cannot even create a message... */ } if (tb->size <= MAXSTRTB / 2) /* can grow string table? */ @@ -193,7 +219,8 @@ static TString *internshrstr (lua_State *L, const char *str, size_t l) { 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 == cast_uint(ts->shrlen) && + (memcmp(str, getshrstr(ts), l * sizeof(char)) == 0)) { /* found! */ if (isdead(g, ts)) /* dead (but not collected yet)? */ changewhite(ts); /* resurrect it */ @@ -205,9 +232,10 @@ static TString *internshrstr (lua_State *L, const char *str, size_t l) { growstrtab(L, tb); list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */ } - ts = createstrobj(L, l, LUA_VSHRSTR, h); - memcpy(getstr(ts), str, l * sizeof(char)); - ts->shrlen = cast_byte(l); + ts = createstrobj(L, sizestrshr(l), LUA_VSHRSTR, h); + ts->shrlen = cast(ls_byte, l); + getshrstr(ts)[l] = '\0'; /* ending 0 */ + memcpy(getshrstr(ts), str, l * sizeof(char)); ts->u.hnext = *list; *list = ts; tb->nuse++; @@ -223,10 +251,10 @@ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { return internshrstr(L, str, l); else { TString *ts; - if (l_unlikely(l >= (MAX_SIZE - sizeof(TString))/sizeof(char))) + if (l_unlikely(l * sizeof(char) >= (MAX_SIZE - sizeof(TString)))) luaM_toobig(L); ts = luaS_createlngstrobj(L, l); - memcpy(getstr(ts), str, l * sizeof(char)); + memcpy(getlngstr(ts), str, l * sizeof(char)); return ts; } } @@ -255,7 +283,7 @@ TString *luaS_new (lua_State *L, const char *str) { } -Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) { +Udata *luaS_newudata (lua_State *L, size_t s, unsigned short nuvalue) { Udata *u; int i; GCObject *o; @@ -271,3 +299,55 @@ Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) { return u; } + +struct NewExt { + ls_byte kind; + const char *s; + size_t len; + TString *ts; /* output */ +}; + + +static void f_newext (lua_State *L, void *ud) { + struct NewExt *ne = cast(struct NewExt *, ud); + size_t size = luaS_sizelngstr(0, ne->kind); + ne->ts = createstrobj(L, size, LUA_VLNGSTR, G(L)->seed); +} + + +TString *luaS_newextlstr (lua_State *L, + const char *s, size_t len, lua_Alloc falloc, void *ud) { + struct NewExt ne; + if (!falloc) { + ne.kind = LSTRFIX; + f_newext(L, &ne); /* just create header */ + } + else { + ne.kind = LSTRMEM; + if (luaD_rawrunprotected(L, f_newext, &ne) != LUA_OK) { /* mem. error? */ + (*falloc)(ud, cast_voidp(s), len + 1, 0); /* free external string */ + luaM_error(L); /* re-raise memory error */ + } + ne.ts->falloc = falloc; + ne.ts->ud = ud; + } + ne.ts->shrlen = ne.kind; + ne.ts->u.lnglen = len; + ne.ts->contents = cast_charp(s); + return ne.ts; +} + + +/* +** Normalize an external string: If it is short, internalize it. +*/ +TString *luaS_normstr (lua_State *L, TString *ts) { + size_t len = ts->u.lnglen; + if (len > LUAI_MAXSHORTLEN) + return ts; /* long string; keep the original */ + else { + const char *str = getlngstr(ts); + return internshrstr(L, str, len); + } +} + diff --git a/lstring.h b/lstring.h index 450c2390d1..1643c3d82b 100644 --- a/lstring.h +++ b/lstring.h @@ -20,10 +20,23 @@ /* -** Size of a TString: Size of the header plus space for the string +** Maximum length for short strings, that is, strings that are +** internalized. (Cannot be smaller than reserved words or tags for +** metamethods, as these strings must be internalized; +** #("function") = 8, #("__newindex") = 10.) +*/ +#if !defined(LUAI_MAXSHORTLEN) +#define LUAI_MAXSHORTLEN 40 +#endif + + +/* +** Size of a short 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 sizestrshr(l) \ + (offsetof(TString, contents) + ((l) + 1) * sizeof(char)) + #define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \ (sizeof(s)/sizeof(char))-1)) @@ -32,7 +45,7 @@ /* ** test whether a string is a reserved word */ -#define isreserved(s) ((s)->tt == LUA_VSHRSTR && (s)->extra > 0) +#define isreserved(s) (strisshr(s) && (s)->extra > 0) /* @@ -41,17 +54,20 @@ #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_hashlongstr (TString *ts); -LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b); +LUAI_FUNC unsigned luaS_hashlongstr (TString *ts); +LUAI_FUNC int luaS_eqstr (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, int nuvalue); +LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, + unsigned short 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); - +LUAI_FUNC TString *luaS_newextlstr (lua_State *L, + const char *s, size_t len, lua_Alloc falloc, void *ud); +LUAI_FUNC size_t luaS_sizelngstr (size_t len, int kind); +LUAI_FUNC TString *luaS_normstr (lua_State *L, TString *ts); #endif diff --git a/lstrlib.c b/lstrlib.c index 0b4fdbb7b5..23df839ea0 100644 --- a/lstrlib.c +++ b/lstrlib.c @@ -24,6 +24,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" /* @@ -36,22 +37,6 @@ #endif -/* macro to 'unsign' a character */ -#define uchar(c) ((unsigned char)(c)) - - -/* -** Some sizes are better limited to fit in 'int', but must also fit in -** 'size_t'. (We assume that 'lua_Integer' cannot be smaller than 'int'.) -*/ -#define MAX_SIZET ((size_t)(~(size_t)0)) - -#define MAXSIZE \ - (sizeof(size_t) < sizeof(int) ? MAX_SIZET : (size_t)(INT_MAX)) - - - - static int str_len (lua_State *L) { size_t l; luaL_checklstring(L, 1, &l); @@ -128,7 +113,7 @@ static int str_lower (lua_State *L) { const char *s = luaL_checklstring(L, 1, &l); char *p = luaL_buffinitsize(L, &b, l); for (i=0; i MAXSIZE / n)) + else if (l_unlikely(len > MAX_SIZE - lsep || + cast_st2S(len + lsep) > cast_st2S(MAX_SIZE) / n)) return luaL_error(L, "resulting string too large"); else { - size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep; + size_t totallen = (cast_sizet(n) * (len + lsep)) - lsep; luaL_Buffer b; char *p = luaL_buffinitsize(L, &b, totallen); while (n-- > 1) { /* first n-1 copies (followed by separator) */ - memcpy(p, s, l * sizeof(char)); p += l; + memcpy(p, s, len * sizeof(char)); p += len; if (lsep > 0) { /* empty 'memcpy' is not that cheap */ - memcpy(p, sep, lsep * sizeof(char)); - p += lsep; + memcpy(p, sep, lsep * sizeof(char)); p += lsep; } } - memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */ + memcpy(p, s, len * sizeof(char)); /* last copy without separator */ luaL_pushresultsize(&b, totallen); } return 1; @@ -187,7 +176,7 @@ static int str_byte (lua_State *L) { n = (int)(pose - posi) + 1; luaL_checkstack(L, n, "string slice too long"); for (i=0; iinit = 1; luaL_buffinit(L, &state->B); } - luaL_addlstring(&state->B, (const char *)b, size); + if (b == NULL) { /* finishing dump? */ + luaL_pushresult(&state->B); /* push result */ + lua_replace(L, 1); /* move it to reserved slot */ + } + else + luaL_addlstring(&state->B, (const char *)b, size); return 0; } @@ -233,12 +227,13 @@ static int writer (lua_State *L, const void *b, size_t size, void *ud) { static int str_dump (lua_State *L) { struct str_Writer state; int strip = lua_toboolean(L, 2); - luaL_checktype(L, 1, LUA_TFUNCTION); - lua_settop(L, 1); /* ensure function is on the top of the stack */ + luaL_argcheck(L, lua_type(L, 1) == LUA_TFUNCTION && !lua_iscfunction(L, 1), + 1, "Lua function expected"); + /* ensure function is on the top of the stack and vacate slot 1 */ + lua_pushvalue(L, 1); state.init = 0; - if (l_unlikely(lua_dump(L, writer, &state, strip) != 0)) - return luaL_error(L, "unable to dump given function"); - luaL_pushresult(&state.B); + lua_dump(L, writer, &state, strip); + lua_settop(L, 1); /* leave final result on top */ return 1; } @@ -274,11 +269,18 @@ static int tonum (lua_State *L, int arg) { } -static void trymt (lua_State *L, const char *mtname) { +/* +** To be here, either the first operand was a string or the first +** operand didn't have a corresponding metamethod. (Otherwise, that +** other metamethod would have been called.) So, if this metamethod +** doesn't work, the only other option would be for the second +** operand to have a different metamethod. +*/ +static void trymt (lua_State *L, const char *mtkey, const char *opname) { lua_settop(L, 2); /* back to the original arguments */ if (l_unlikely(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_getmetafield(L, 2, mtkey))) + luaL_error(L, "attempt to %s a '%s' with a '%s'", opname, luaL_typename(L, -2), luaL_typename(L, -1)); lua_insert(L, -3); /* put metamethod before arguments */ lua_call(L, 2, 1); /* call metamethod */ @@ -289,7 +291,7 @@ 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); + trymt(L, mtname, mtname + 2); return 1; } @@ -361,10 +363,10 @@ typedef struct MatchState { const char *p_end; /* end ('\0') of pattern */ lua_State *L; int matchdepth; /* control for recursive depth (to avoid C stack overflow) */ - unsigned char level; /* total number of captures (finished or unfinished) */ + int level; /* total number of captures (finished or unfinished) */ struct { const char *init; - ptrdiff_t len; + ptrdiff_t len; /* length or special value (CAP_*) */ } capture[LUA_MAXCAPTURES]; } MatchState; @@ -453,15 +455,15 @@ static int matchbracketclass (int c, const char *p, const char *ec) { while (++p < ec) { if (*p == L_ESC) { p++; - if (match_class(c, uchar(*p))) + if (match_class(c, cast_uchar(*p))) return sig; } else if ((*(p+1) == '-') && (p+2 < ec)) { p+=2; - if (uchar(*(p-2)) <= c && c <= uchar(*p)) + if (cast_uchar(*(p-2)) <= c && c <= cast_uchar(*p)) return sig; } - else if (uchar(*p) == c) return sig; + else if (cast_uchar(*p) == c) return sig; } return !sig; } @@ -472,12 +474,12 @@ static int singlematch (MatchState *ms, const char *s, const char *p, if (s >= ms->src_end) return 0; else { - int c = uchar(*s); + int c = cast_uchar(*s); switch (*p) { case '.': return 1; /* matches any char */ - case L_ESC: return match_class(c, uchar(*(p+1))); + case L_ESC: return match_class(c, cast_uchar(*(p+1))); case '[': return matchbracketclass(c, p, ep-1); - default: return (uchar(*p) == c); + default: return (cast_uchar(*p) == c); } } } @@ -559,7 +561,7 @@ static const char *end_capture (MatchState *ms, const char *s, static const char *match_capture (MatchState *ms, const char *s, int l) { size_t len; l = check_capture(ms, l); - len = ms->capture[l].len; + len = cast_sizet(ms->capture[l].len); if ((size_t)(ms->src_end-s) >= len && memcmp(ms->capture[l].init, s, len) == 0) return s+len; @@ -570,7 +572,7 @@ static const char *match_capture (MatchState *ms, const char *s, int l) { static const char *match (MatchState *ms, const char *s, const char *p) { if (l_unlikely(ms->matchdepth-- == 0)) luaL_error(ms->L, "pattern too complex"); - init: /* using goto's to optimize tail recursion */ + init: /* using goto to optimize tail recursion */ if (p != ms->p_end) { /* end of pattern? */ switch (*p) { case '(': { /* start capture */ @@ -606,8 +608,8 @@ static const char *match (MatchState *ms, const char *s, const char *p) { luaL_error(ms->L, "missing '[' after '%%f' in pattern"); ep = classend(ms, p); /* points to what is next */ previous = (s == ms->src_init) ? '\0' : *(s - 1); - if (!matchbracketclass(uchar(previous), p, ep - 1) && - matchbracketclass(uchar(*s), p, ep - 1)) { + if (!matchbracketclass(cast_uchar(previous), p, ep - 1) && + matchbracketclass(cast_uchar(*s), p, ep - 1)) { p = ep; goto init; /* return match(ms, s, ep); */ } s = NULL; /* match failed */ @@ -616,7 +618,7 @@ static const char *match (MatchState *ms, const char *s, const char *p) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { /* capture results (%0-%9)? */ - s = match_capture(ms, s, uchar(*(p + 1))); + s = match_capture(ms, s, cast_uchar(*(p + 1))); if (s != NULL) { p += 2; goto init; /* return match(ms, s, p + 2) */ } @@ -683,7 +685,7 @@ static const char *lmemfind (const char *s1, size_t l1, if (memcmp(init, s2+1, l2) == 0) return init-1; else { /* correct 'l1' and 's1' to try again */ - l1 -= init-s1; + l1 -= ct_diff2sz(init - s1); s1 = init; } } @@ -699,13 +701,13 @@ static const char *lmemfind (const char *s1, size_t l1, ** 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, +static ptrdiff_t get_onecapture (MatchState *ms, int i, const char *s, const char *e, const char **cap) { if (i >= ms->level) { if (l_unlikely(i != 0)) luaL_error(ms->L, "invalid capture index %%%d", i + 1); *cap = s; - return e - s; + return (e - s); } else { ptrdiff_t capl = ms->capture[i].len; @@ -713,7 +715,8 @@ static size_t get_onecapture (MatchState *ms, int i, const char *s, if (l_unlikely(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); + lua_pushinteger(ms->L, + ct_diff2S(ms->capture[i].init - ms->src_init) + 1); return capl; } } @@ -727,7 +730,7 @@ static void push_onecapture (MatchState *ms, int i, const char *s, const char *cap; ptrdiff_t l = get_onecapture(ms, i, s, e, &cap); if (l != CAP_POSITION) - lua_pushlstring(ms->L, cap, l); + lua_pushlstring(ms->L, cap, cast_sizet(l)); /* else position was already pushed */ } @@ -784,8 +787,8 @@ static int str_find_aux (lua_State *L, int find) { /* do a plain search */ const char *s2 = lmemfind(s + init, ls - init, p, lp); if (s2) { - lua_pushinteger(L, (s2 - s) + 1); - lua_pushinteger(L, (s2 - s) + lp); + lua_pushinteger(L, ct_diff2S(s2 - s) + 1); + lua_pushinteger(L, cast_st2S(ct_diff2sz(s2 - s) + lp)); return 2; } } @@ -802,8 +805,8 @@ static int str_find_aux (lua_State *L, int find) { reprepstate(&ms); if ((res=match(&ms, s1, p)) != NULL) { if (find) { - lua_pushinteger(L, (s1 - s) + 1); /* start */ - lua_pushinteger(L, res - s); /* end */ + lua_pushinteger(L, ct_diff2S(s1 - s) + 1); /* start */ + lua_pushinteger(L, ct_diff2S(res - s)); /* end */ return push_captures(&ms, NULL, 0) + 2; } else @@ -875,23 +878,23 @@ static void add_s (MatchState *ms, luaL_Buffer *b, const char *s, const char *news = lua_tolstring(L, 3, &l); const char *p; while ((p = (char *)memchr(news, L_ESC, l)) != NULL) { - luaL_addlstring(b, news, p - news); + luaL_addlstring(b, news, ct_diff2sz(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' */ + luaL_addlstring(b, s, ct_diff2sz(e - s)); + else if (isdigit(cast_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); + luaL_addlstring(b, cap, cast_sizet(resl)); } else luaL_error(L, "invalid use of '%c' in replacement string", L_ESC); - l -= p + 1 - news; + l -= ct_diff2sz(p + 1 - news); news = p + 1; } luaL_addlstring(b, news, l); @@ -926,7 +929,7 @@ static int add_value (MatchState *ms, luaL_Buffer *b, const char *s, } if (!lua_toboolean(L, -1)) { /* nil or false? */ lua_pop(L, 1); /* remove value */ - luaL_addlstring(b, s, e - s); /* keep original text */ + luaL_addlstring(b, s, ct_diff2sz(e - s)); /* keep original text */ return 0; /* no changes */ } else if (l_unlikely(!lua_isstring(L, -1))) @@ -945,7 +948,8 @@ static int str_gsub (lua_State *L) { const char *p = luaL_checklstring(L, 2, &lp); /* pattern */ const char *lastmatch = NULL; /* end of last match */ int tr = lua_type(L, 3); /* replacement type */ - lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */ + /* max replacements */ + lua_Integer max_s = luaL_optinteger(L, 4, cast_st2S(srcl) + 1); int anchor = (*p == '^'); lua_Integer n = 0; /* replacement count */ int changed = 0; /* change flag */ @@ -975,7 +979,7 @@ static int str_gsub (lua_State *L) { if (!changed) /* no changes? */ lua_pushvalue(L, 1); /* return original string */ else { /* something changed */ - luaL_addlstring(&b, src, ms.src_end-src); + luaL_addlstring(&b, src, ct_diff2sz(ms.src_end - src)); luaL_pushresult(&b); /* create and return new string */ } lua_pushinteger(L, n); /* number of substitutions */ @@ -1013,15 +1017,15 @@ static int str_gsub (lua_State *L) { /* ** Add integer part of 'x' to buffer and return new 'x' */ -static lua_Number adddigit (char *buff, int n, lua_Number x) { +static lua_Number adddigit (char *buff, unsigned n, lua_Number x) { lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */ int d = (int)dd; - buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */ + buff[n] = cast_char(d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */ return x - dd; /* return what is left */ } -static int num2straux (char *buff, int sz, lua_Number x) { +static int num2straux (char *buff, unsigned sz, lua_Number x) { /* if 'inf' or 'NaN', format it like '%g' */ if (x != x || x == (lua_Number)HUGE_VAL || x == -(lua_Number)HUGE_VAL) return l_sprintf(buff, sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)x); @@ -1032,7 +1036,7 @@ static int num2straux (char *buff, int sz, lua_Number x) { else { int e; lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */ - int n = 0; /* character count */ + unsigned n = 0; /* character count */ if (m < 0) { /* is number negative? */ buff[n++] = '-'; /* add sign */ m = -m; /* make it positive */ @@ -1046,20 +1050,20 @@ static int num2straux (char *buff, int sz, lua_Number x) { m = adddigit(buff, n++, m * 16); } while (m > 0); } - n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */ + n += cast_uint(l_sprintf(buff + n, sz - n, "p%+d", e)); /* add exponent */ lua_assert(n < sz); - return n; + return cast_int(n); } } -static int lua_number2strx (lua_State *L, char *buff, int sz, +static int lua_number2strx (lua_State *L, char *buff, unsigned sz, const char *fmt, lua_Number x) { int n = num2straux(buff, sz, x); if (fmt[SIZELENMOD] == 'A') { int i; for (i = 0; i < n; i++) - buff[i] = toupper(uchar(buff[i])); + buff[i] = cast_char(toupper(cast_uchar(buff[i]))); } else if (l_unlikely(fmt[SIZELENMOD] != 'a')) return luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented"); @@ -1126,12 +1130,12 @@ static void addquoted (luaL_Buffer *b, const char *s, size_t len) { luaL_addchar(b, '\\'); luaL_addchar(b, *s); } - else if (iscntrl(uchar(*s))) { + else if (iscntrl(cast_uchar(*s))) { char buff[10]; - if (!isdigit(uchar(*(s+1)))) - l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s)); + if (!isdigit(cast_uchar(*(s+1)))) + l_sprintf(buff, sizeof(buff), "\\%d", (int)cast_uchar(*s)); else - l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s)); + l_sprintf(buff, sizeof(buff), "\\%03d", (int)cast_uchar(*s)); luaL_addstring(b, buff); } else @@ -1160,9 +1164,9 @@ static int quotefloat (lua_State *L, char *buff, lua_Number n) { 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? */ + if (memchr(buff, '.', cast_uint(nb)) == NULL) { /* no dot? */ char point = lua_getlocaledecpoint(); /* try locale point */ - char *ppoint = (char *)memchr(buff, point, nb); + char *ppoint = (char *)memchr(buff, point, cast_uint(nb)); if (ppoint) *ppoint = '.'; /* change it to a dot */ } return nb; @@ -1192,7 +1196,7 @@ static void addliteral (lua_State *L, luaL_Buffer *b, int arg) { : LUA_INTEGER_FMT; /* else use default format */ nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n); } - luaL_addsize(b, nb); + luaL_addsize(b, cast_uint(nb)); break; } case LUA_TNIL: case LUA_TBOOLEAN: { @@ -1208,9 +1212,9 @@ static void addliteral (lua_State *L, luaL_Buffer *b, int arg) { static const char *get2digits (const char *s) { - if (isdigit(uchar(*s))) { + if (isdigit(cast_uchar(*s))) { s++; - if (isdigit(uchar(*s))) s++; /* (2 digits at most) */ + if (isdigit(cast_uchar(*s))) s++; /* (2 digits at most) */ } return s; } @@ -1233,7 +1237,7 @@ static void checkformat (lua_State *L, const char *form, const char *flags, spec = get2digits(spec); /* skip precision */ } } - if (!isalpha(uchar(*spec))) /* did not go to the end? */ + if (!isalpha(cast_uchar(*spec))) /* did not go to the end? */ luaL_error(L, "invalid conversion specification: '%s'", form); } @@ -1286,7 +1290,7 @@ static int str_format (lua_State *L) { luaL_addchar(&b, *strfrmt++); /* %% */ else { /* format item */ char form[MAX_FORMAT]; /* to store the format ('%...') */ - int maxitem = MAX_ITEM; /* maximum length for the result */ + unsigned maxitem = MAX_ITEM; /* maximum length for the result */ char *buff = luaL_prepbuffsize(&b, maxitem); /* to put result */ int nb = 0; /* number of bytes in result */ if (++arg > top) @@ -1369,8 +1373,8 @@ static int str_format (lua_State *L) { return luaL_error(L, "invalid conversion '%s' to 'format'", form); } } - lua_assert(nb < maxitem); - luaL_addsize(&b, nb); + lua_assert(cast_uint(nb) < maxitem); + luaL_addsize(&b, cast_uint(nb)); } } luaL_pushresult(&b); @@ -1418,7 +1422,7 @@ static const union { typedef struct Header { lua_State *L; int islittle; - int maxalign; + unsigned maxalign; } Header; @@ -1446,14 +1450,14 @@ typedef enum KOption { */ static int digit (int c) { return '0' <= c && c <= '9'; } -static int getnum (const char **fmt, int df) { +static size_t getnum (const char **fmt, size_t df) { if (!digit(**fmt)) /* no number? */ return df; /* return default value */ else { - int a = 0; + size_t a = 0; do { - a = a*10 + (*((*fmt)++) - '0'); - } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10); + a = a*10 + cast_uint(*((*fmt)++) - '0'); + } while (digit(**fmt) && a <= (MAX_SIZE - 9)/10); return a; } } @@ -1461,14 +1465,14 @@ static int getnum (const char **fmt, int df) { /* ** Read an integer numeral and raises an error if it is larger -** than the maximum size for integers. +** than the maximum size of integers. */ -static int getnumlimit (Header *h, const char **fmt, int df) { - int sz = getnum(fmt, df); - if (l_unlikely(sz > MAXINTSIZE || sz <= 0)) - return luaL_error(h->L, "integral size (%d) out of limits [1,%d]", - sz, MAXINTSIZE); - return sz; +static unsigned getnumlimit (Header *h, const char **fmt, size_t df) { + size_t sz = getnum(fmt, df); + if (l_unlikely((sz - 1u) >= MAXINTSIZE)) + return cast_uint(luaL_error(h->L, + "integral size (%d) out of limits [1,%d]", sz, MAXINTSIZE)); + return cast_uint(sz); } @@ -1485,7 +1489,7 @@ static void initheader (lua_State *L, Header *h) { /* ** Read and classify next option. 'size' is filled with option's size. */ -static KOption getoption (Header *h, const char **fmt, int *size) { +static KOption getoption (Header *h, const char **fmt, size_t *size) { /* dummy structure to get native alignment requirements */ struct cD { char c; union { LUAI_MAXALIGN; } u; }; int opt = *((*fmt)++); @@ -1507,8 +1511,8 @@ static KOption getoption (Header *h, const char **fmt, int *size) { case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint; case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring; case 'c': - *size = getnum(fmt, -1); - if (l_unlikely(*size == -1)) + *size = getnum(fmt, cast_sizet(-1)); + if (l_unlikely(*size == cast_sizet(-1))) luaL_error(h->L, "missing size for format option 'c'"); return Kchar; case 'z': return Kzstr; @@ -1519,7 +1523,7 @@ static KOption getoption (Header *h, const char **fmt, int *size) { case '>': h->islittle = 0; break; case '=': h->islittle = nativeendian.little; break; case '!': { - const int maxalign = offsetof(struct cD, u); + const size_t maxalign = offsetof(struct cD, u); h->maxalign = getnumlimit(h, fmt, maxalign); break; } @@ -1538,10 +1542,10 @@ static KOption getoption (Header *h, const char **fmt, int *size) { ** the maximum alignment ('maxalign'). Kchar option needs no alignment ** despite its size. */ -static KOption getdetails (Header *h, size_t totalsize, - const char **fmt, int *psize, int *ntoalign) { +static KOption getdetails (Header *h, size_t totalsize, const char **fmt, + size_t *psize, unsigned *ntoalign) { KOption opt = getoption(h, fmt, psize); - int align = *psize; /* usually, alignment follows size */ + size_t align = *psize; /* usually, alignment follows size */ if (opt == Kpaddalign) { /* 'X' gets alignment from following option */ if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0) luaL_argerror(h->L, 1, "invalid next option for option 'X'"); @@ -1551,9 +1555,15 @@ static KOption getdetails (Header *h, size_t totalsize, else { if (align > h->maxalign) /* enforce maximum alignment */ align = h->maxalign; - if (l_unlikely((align & (align - 1)) != 0)) /* not a power of 2? */ + if (l_unlikely(!ispow2(align))) { /* not a power of 2? */ + *ntoalign = 0; /* to avoid warnings */ luaL_argerror(h->L, 1, "format asks for alignment not power of 2"); - *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1); + } + else { + /* 'szmoda' = totalsize % align */ + unsigned szmoda = cast_uint(totalsize & (align - 1)); + *ntoalign = cast_uint((align - szmoda) & (align - 1)); + } } return opt; } @@ -1566,9 +1576,9 @@ static KOption getdetails (Header *h, size_t totalsize, ** bytes if necessary (by default they would be zeros). */ static void packint (luaL_Buffer *b, lua_Unsigned n, - int islittle, int size, int neg) { + int islittle, unsigned size, int neg) { char *buff = luaL_prepbuffsize(b, size); - int i; + unsigned i; buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */ for (i = 1; i < size; i++) { n >>= NB; @@ -1587,7 +1597,7 @@ static void packint (luaL_Buffer *b, lua_Unsigned n, ** given 'islittle' is different from native endianness. */ static void copywithendian (char *dest, const char *src, - int size, int islittle) { + unsigned size, int islittle) { if (islittle == nativeendian.little) memcpy(dest, src, size); else { @@ -1608,8 +1618,11 @@ static int str_pack (lua_State *L) { lua_pushnil(L); /* mark to separate arguments from string buffer */ luaL_buffinit(L, &b); while (*fmt != '\0') { - int size, ntoalign; + unsigned ntoalign; + size_t size; KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign); + luaL_argcheck(L, size + ntoalign <= MAX_SIZE - totalsize, arg, + "result too long"); totalsize += ntoalign + size; while (ntoalign-- > 0) luaL_addchar(&b, LUAL_PACKPADBYTE); /* fill alignment */ @@ -1621,7 +1634,7 @@ static int str_pack (lua_State *L) { lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1); luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow"); } - packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0)); + packint(&b, (lua_Unsigned)n, h.islittle, cast_uint(size), (n < 0)); break; } case Kuint: { /* unsigned integers */ @@ -1629,7 +1642,7 @@ static int str_pack (lua_State *L) { if (size < SZINT) /* need overflow check? */ luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)), arg, "unsigned overflow"); - packint(&b, (lua_Unsigned)n, h.islittle, size, 0); + packint(&b, (lua_Unsigned)n, h.islittle, cast_uint(size), 0); break; } case Kfloat: { /* C float */ @@ -1659,20 +1672,24 @@ static int str_pack (lua_State *L) { case Kchar: { /* fixed-size string */ size_t len; const char *s = luaL_checklstring(L, arg, &len); - luaL_argcheck(L, len <= (size_t)size, arg, - "string longer than given size"); + luaL_argcheck(L, len <= size, arg, "string longer than given size"); luaL_addlstring(&b, s, len); /* add string */ - while (len++ < (size_t)size) /* pad extra space */ - luaL_addchar(&b, LUAL_PACKPADBYTE); + if (len < size) { /* does it need padding? */ + size_t psize = size - len; /* pad size */ + char *buff = luaL_prepbuffsize(&b, psize); + memset(buff, LUAL_PACKPADBYTE, psize); + luaL_addsize(&b, psize); + } break; } case Kstring: { /* strings with length count */ size_t len; const char *s = luaL_checklstring(L, arg, &len); - luaL_argcheck(L, size >= (int)sizeof(size_t) || - len < ((size_t)1 << (size * NB)), + luaL_argcheck(L, size >= sizeof(lua_Unsigned) || + len < ((lua_Unsigned)1 << (size * NB)), arg, "string length does not fit in given size"); - packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */ + /* pack length */ + packint(&b, (lua_Unsigned)len, h.islittle, cast_uint(size), 0); luaL_addlstring(&b, s, len); totalsize += len; break; @@ -1703,16 +1720,17 @@ static int str_packsize (lua_State *L) { size_t totalsize = 0; /* accumulate total size of result */ initheader(L, &h); while (*fmt != '\0') { - int size, ntoalign; + unsigned ntoalign; + size_t size; 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"); + luaL_argcheck(L, totalsize <= LUA_MAXINTEGER - size, + 1, "format result too large"); totalsize += size; } - lua_pushinteger(L, (lua_Integer)totalsize); + lua_pushinteger(L, cast_st2S(totalsize)); return 1; } @@ -1761,9 +1779,10 @@ static int str_unpack (lua_State *L) { luaL_argcheck(L, pos <= ld, 3, "initial position out of string"); initheader(L, &h); while (*fmt != '\0') { - int size, ntoalign; + unsigned ntoalign; + size_t size; KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign); - luaL_argcheck(L, (size_t)ntoalign + size <= ld - pos, 2, + luaL_argcheck(L, ntoalign + size <= ld - pos, 2, "data string too short"); pos += ntoalign; /* skip alignment */ /* stack space for item + next position */ @@ -1772,8 +1791,8 @@ static int str_unpack (lua_State *L) { switch (opt) { case Kint: case Kuint: { - lua_Integer res = unpackint(L, data + pos, h.islittle, size, - (opt == Kint)); + lua_Integer res = unpackint(L, data + pos, h.islittle, + cast_int(size), (opt == Kint)); lua_pushinteger(L, res); break; } @@ -1800,10 +1819,11 @@ static int str_unpack (lua_State *L) { break; } case Kstring: { - size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0); + lua_Unsigned len = (lua_Unsigned)unpackint(L, data + pos, + h.islittle, cast_int(size), 0); luaL_argcheck(L, len <= ld - pos - size, 2, "data string too short"); - lua_pushlstring(L, data + pos + size, len); - pos += len; /* skip string */ + lua_pushlstring(L, data + pos + size, cast_sizet(len)); + pos += cast_sizet(len); /* skip string */ break; } case Kzstr: { @@ -1820,7 +1840,7 @@ static int str_unpack (lua_State *L) { } pos += size; } - lua_pushinteger(L, pos + 1); /* next position */ + lua_pushinteger(L, cast_st2S(pos) + 1); /* next position */ return n + 1; } diff --git a/ltable.c b/ltable.c index cc7993e083..b7f88f6ffe 100644 --- a/ltable.c +++ b/ltable.c @@ -25,6 +25,7 @@ #include #include +#include #include "lua.h" @@ -40,18 +41,48 @@ /* -** MAXABITS is the largest integer such that MAXASIZE fits in an +** Only hash parts with at least 2^LIMFORLAST have a 'lastfree' field +** that optimizes finding a free slot. That field is stored just before +** the array of nodes, in the same block. Smaller tables do a complete +** search when looking for a free slot. +*/ +#define LIMFORLAST 3 /* log2 of real limit (8) */ + +/* +** The union 'Limbox' stores 'lastfree' and ensures that what follows it +** is properly aligned to store a Node. +*/ +typedef struct { Node *dummy; Node follows_pNode; } Limbox_aux; + +typedef union { + Node *lastfree; + char padding[offsetof(Limbox_aux, follows_pNode)]; +} Limbox; + +#define haslastfree(t) ((t)->lsizenode >= LIMFORLAST) +#define getlastfree(t) ((cast(Limbox *, (t)->node) - 1)->lastfree) + + +/* +** MAXABITS is the largest integer such that 2^MAXABITS fits in an ** unsigned int. */ -#define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1) +#define MAXABITS (l_numbits(int) - 1) + + +/* +** MAXASIZEB is the maximum number of elements in the array part such +** that the size of the array fits in 'size_t'. +*/ +#define MAXASIZEB (MAX_SIZET/(sizeof(Value) + 1)) /* ** 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'. +** between 2^MAXABITS and MAXASIZEB. */ -#define MAXASIZE luaM_limitN(1u << MAXABITS, TValue) +#define MAXASIZE \ + (((1u << MAXABITS) < MAXASIZEB) ? (1u << MAXABITS) : cast_uint(MAXASIZEB)) /* ** MAXHBITS is the largest integer such that 2^MAXHBITS fits in a @@ -65,7 +96,7 @@ ** 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 MAXHSIZE luaM_limitN(1 << MAXHBITS, Node) /* @@ -78,7 +109,7 @@ ** for other types, it is better to avoid modulo by power of 2, as ** they can have many 2 factors. */ -#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) +#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1u)|1u)))) #define hashstr(t,str) hashpow2(t, (str)->hash) @@ -90,9 +121,15 @@ #define dummynode (&dummynode_) +/* +** Common hash part for tables with empty hash parts. That allows all +** tables to have a hash part, avoiding an extra check ("is there a hash +** part?") when indexing. Its sole node has an empty value and a key +** (DEADKEY, NULL) that is different from any valid TValue. +*/ static const Node dummynode_ = { {{NULL}, LUA_VEMPTY, /* value's value and type */ - LUA_VNIL, 0, {NULL}} /* key type, next, and key value */ + LUA_TDEADKEY, 0, {NULL}} /* key type, next, and key value */ }; @@ -108,7 +145,7 @@ static const TValue absentkey = {ABSTKEYCONSTANT}; static Node *hashint (const Table *t, lua_Integer i) { lua_Unsigned ui = l_castS2U(i); if (ui <= cast_uint(INT_MAX)) - return hashmod(t, cast_int(ui)); + return gnode(t, cast_int(ui) % cast_int((sizenode(t)-1) | 1)); else return hashmod(t, ui); } @@ -119,7 +156,7 @@ static Node *hashint (const Table *t, lua_Integer i) { ** The main computation should be just ** n = frexp(n, &i); return (n * INT_MAX) + i ** but there are some numerical subtleties. -** In a two-complement representation, INT_MAX does not has an exact +** In a two-complement representation, INT_MAX may not have an exact ** representation as a float, but INT_MIN does; because the absolute ** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the ** absolute value of the product 'frexp * -INT_MIN' is smaller or equal @@ -128,7 +165,7 @@ static Node *hashint (const Table *t, lua_Integer i) { ** INT_MIN. */ #if !defined(l_hashfloat) -static int l_hashfloat (lua_Number n) { +static unsigned l_hashfloat (lua_Number n) { int i; lua_Integer ni; n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN); @@ -138,7 +175,7 @@ static int l_hashfloat (lua_Number n) { } else { /* normal case */ unsigned int u = cast_uint(i) + cast_uint(ni); - return cast_int(u <= cast_uint(INT_MAX) ? u : ~u); + return (u <= cast_uint(INT_MAX) ? u : ~u); } } #endif @@ -197,98 +234,55 @@ l_sinline Node *mainpositionfromnode (const Table *t, Node *nd) { ** 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. -** A true 'deadok' means to accept dead keys as equal to their original -** values. All dead keys are compared in the default case, by pointer -** identity. (Only collectable objects can produce dead keys.) Note that -** dead long strings are also compared by identity. -** Once a key is dead, its corresponding value may be collected, and -** then another value can be created with the same address. If this -** other value is given to 'next', 'equalkey' will signal a false -** positive. In a regular traversal, this situation should never happen, -** as all keys given to 'next' came from the table itself, and therefore -** could not have been collected. Outside a regular traversal, we -** have garbage in, garbage out. What is relevant is that this false -** positive does not break anything. (In particular, 'next' will return -** some other valid item on the table or nil.) +** floats. It is assumed that 'eqshrstr' is simply pointer equality, +** so that short strings are handled in the default case. The flag +** 'deadok' means to accept dead keys as equal to their original values. +** (Only collectable objects can produce dead keys.) Note that dead +** long strings are also compared by identity. Once a key is dead, +** its corresponding value may be collected, and then another value +** can be created with the same address. If this other value is given +** to 'next', 'equalkey' will signal a false positive. In a regular +** traversal, this situation should never happen, as all keys given to +** 'next' came from the table itself, and therefore could not have been +** collected. Outside a regular traversal, we have garbage in, garbage +** out. What is relevant is that this false positive does not break +** anything. (In particular, 'next' will return some other valid item +** on the table or nil.) */ static int equalkey (const TValue *k1, const Node *n2, int deadok) { - if ((rawtt(k1) != keytt(n2)) && /* not the same variants? */ - !(deadok && keyisdead(n2) && iscollectable(k1))) - return 0; /* cannot be same key */ - switch (keytt(n2)) { - 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 ctb(LUA_VLNGSTR): - return luaS_eqlngstr(tsvalue(k1), keystrval(n2)); - default: + if (rawtt(k1) != keytt(n2)) { /* not the same variants? */ + if (keyisshrstr(n2) && ttislngstring(k1)) { + /* an external string can be equal to a short-string key */ + return luaS_eqstr(tsvalue(k1), keystrval(n2)); + } + else if (deadok && keyisdead(n2) && iscollectable(k1)) { + /* a collectable value can be equal to a dead key */ return gcvalue(k1) == gcvalueraw(keyval(n2)); + } + else + return 0; /* otherwise, different variants cannot be equal */ } -} - - -/* -** 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; + else { /* equal variants */ + switch (keytt(n2)) { + 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 ctb(LUA_VLNGSTR): + return luaS_eqstr(tsvalue(k1), keystrval(n2)); + default: + return gcvalue(k1) == gcvalueraw(keyval(n2)); + } } } -/* -** 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.) @@ -310,14 +304,34 @@ static const TValue *getgeneric (Table *t, const TValue *key, int deadok) { /* -** returns the index for 'k' if 'k' is an appropriate key to live in -** the array part of a table, 0 otherwise. +** Return the index 'k' (converted to an unsigned) if it is inside +** the range [1, limit]. */ -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; +static unsigned checkrange (lua_Integer k, unsigned limit) { + return (l_castS2U(k) - 1u < limit) ? cast_uint(k) : 0; +} + + +/* +** Return the index 'k' if 'k' is an appropriate key to live in the +** array part of a table, 0 otherwise. +*/ +#define arrayindex(k) checkrange(k, MAXASIZE) + + +/* +** Check whether an integer key is in the array part of a table and +** return its index there, or zero. +*/ +#define ikeyinarray(t,k) checkrange(k, t->asize) + + +/* +** Check whether a key is in the array part of a table and return its +** index there, or zero. +*/ +static unsigned keyinarray (Table *t, const TValue *key) { + return (ttisinteger(key)) ? ikeyinarray(t, ivalue(key)) : 0; } @@ -326,18 +340,18 @@ static unsigned int arrayindex (lua_Integer k) { ** 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, TValue *key, - unsigned int asize) { +static unsigned findindex (lua_State *L, Table *t, TValue *key, + unsigned asize) { unsigned int i; if (ttisnil(key)) return 0; /* first iteration */ - i = ttisinteger(key) ? arrayindex(ivalue(key)) : 0; - if (i - 1u < asize) /* is 'key' inside array part? */ + i = keyinarray(t, key); + if (i != 0) /* is 'key' inside array part? */ return i; /* yes; that's the index */ else { const TValue *n = getgeneric(t, key, 1); if (l_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 */ + i = cast_uint(nodefromval(n) - gnode(t, 0)); /* key index in hash table */ /* hash elements are numbered after array ones */ return (i + 1) + asize; } @@ -345,16 +359,17 @@ static unsigned int findindex (lua_State *L, Table *t, TValue *key, int luaH_next (lua_State *L, Table *t, StkId key) { - unsigned int asize = luaH_realasize(t); + unsigned int asize = t->asize; 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]); + lu_byte tag = *getArrTag(t, i); + if (!tagisempty(tag)) { /* a non-empty entry? */ + setivalue(s2v(key), cast_int(i) + 1); + farr2val(t, i, tag, s2v(key + 1)); return 1; } } - for (i -= asize; cast_int(i) < sizenode(t); i++) { /* hash part */ + for (i -= asize; 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); @@ -366,9 +381,21 @@ int luaH_next (lua_State *L, Table *t, StkId key) { } +/* Extra space in Node array if it has a lastfree entry */ +#define extraLastfree(t) (haslastfree(t) ? sizeof(Limbox) : 0) + +/* 'node' size in bytes */ +static size_t sizehash (Table *t) { + return cast_sizet(sizenode(t)) * sizeof(Node) + extraLastfree(t); +} + + static void freehash (lua_State *L, Table *t) { - if (!isdummy(t)) - luaM_freearray(L, t->node, cast_sizet(sizenode(t))); + if (!isdummy(t)) { + /* get pointer to the beginning of Node array */ + char *arr = cast_charp(t->node) - extraLastfree(t); + luaM_freearray(L, arr, sizehash(t)); + } } @@ -378,58 +405,92 @@ static void freehash (lua_State *L, Table *t) { ** ============================================================== */ +static int insertkey (Table *t, const TValue *key, TValue *value); +static void newcheckedkey (Table *t, const TValue *key, TValue *value); + + +/* +** Structure to count the keys in a table. +** 'total' is the total number of keys in the table. +** 'na' is the number of *array indices* in the table (see 'arrayindex'). +** 'deleted' is true if there are deleted nodes in the hash part. +** 'nums' is a "count array" where 'nums[i]' is the number of integer +** keys between 2^(i - 1) + 1 and 2^i. Note that 'na' is the summation +** of 'nums'. +*/ +typedef struct { + unsigned total; + unsigned na; + int deleted; + unsigned nums[MAXABITS + 1]; +} Counters; + + +/* +** Check whether it is worth to use 'na' array entries instead of 'nh' +** hash nodes. (A hash node uses ~3 times more memory than an array +** entry: Two values plus 'next' versus one value.) Evaluate with size_t +** to avoid overflows. +*/ +#define arrayXhash(na,nh) (cast_sizet(na) <= cast_sizet(nh) * 3) + /* -** Compute the optimal size for the array part of table 't'. 'nums' is a -** "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. (The condition -** 'twotoi > 0' in the for loop stops the loop if 'twotoi' overflows.) +** Compute the optimal size for the array part of table 't'. +** This size maximizes the number of elements going to the array part +** while satisfying the condition 'arrayXhash' with the use of memory if +** all those elements went to the hash part. +** 'ct->na' enters with the total number of array indices in the table +** and leaves with the number of keys that will go to the array part; +** return the optimal size for the array part. */ -static unsigned int computesizes (unsigned int nums[], unsigned int *pna) { +static unsigned computesizes (Counters *ct) { int i; unsigned int twotoi; /* 2^i (candidate for optimal size) */ unsigned int a = 0; /* number of elements smaller than 2^i */ unsigned int na = 0; /* number of elements to go to array part */ unsigned int optimal = 0; /* optimal size for array part */ - /* loop while keys can fill more than half of total size */ + /* traverse slices while 'twotoi' does not overflow and total of array + indices still can satisfy 'arrayXhash' against the array size */ for (i = 0, twotoi = 1; - twotoi > 0 && *pna > twotoi / 2; + twotoi > 0 && arrayXhash(twotoi, ct->na); i++, twotoi *= 2) { - a += nums[i]; - if (a > twotoi/2) { /* more than half elements present? */ + unsigned nums = ct->nums[i]; + a += nums; + if (nums > 0 && /* grows array only if it gets more elements... */ + arrayXhash(twotoi, a)) { /* ...while using "less memory" */ 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); - *pna = na; + ct->na = na; return optimal; } -static int countint (lua_Integer key, unsigned int *nums) { +static void countint (lua_Integer key, Counters *ct) { unsigned int k = arrayindex(key); - if (k != 0) { /* is 'key' an appropriate array index? */ - nums[luaO_ceillog2(k)]++; /* count as such */ - return 1; + if (k != 0) { /* is 'key' an array index? */ + ct->nums[luaO_ceillog2(k)]++; /* count as such */ + ct->na++; } - else - return 0; +} + + +l_sinline int arraykeyisempty (const Table *t, unsigned key) { + int tag = *getArrTag(t, key - 1); + return tagisempty(tag); } /* -** Count keys in array part of table 't': Fill 'nums[i]' with -** number of keys that will go into corresponding slice and return -** total number of non-nil keys. +** Count keys in array part of table 't'. */ -static unsigned int numusearray (const Table *t, unsigned int *nums) { +static void numusearray (const Table *t, Counters *ct) { int lg; 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 */ + unsigned int i = 1; /* index to traverse all array keys */ + unsigned int asize = t->asize; /* traverse each slice */ for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) { unsigned int lc = 0; /* counter */ @@ -441,30 +502,93 @@ static unsigned int numusearray (const Table *t, unsigned int *nums) { } /* count elements in range (2^(lg - 1), 2^lg] */ for (; i <= lim; i++) { - if (!isempty(&t->array[i-1])) + if (!arraykeyisempty(t, i)) lc++; } - nums[lg] += lc; + ct->nums[lg] += lc; ause += lc; } - return ause; + ct->total += ause; + ct->na += ause; } -static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) { - int totaluse = 0; /* total number of elements */ - int ause = 0; /* elements added to 'nums' (can go to array part) */ - int i = sizenode(t); +/* +** Count keys in hash part of table 't'. As this only happens during +** a rehash, all nodes have been used. A node can have a nil value only +** if it was deleted after being created. +*/ +static void numusehash (const Table *t, Counters *ct) { + unsigned i = sizenode(t); + unsigned total = 0; while (i--) { Node *n = &t->node[i]; - if (!isempty(gval(n))) { + if (isempty(gval(n))) { + lua_assert(!keyisnil(n)); /* entry was deleted; key cannot be nil */ + ct->deleted = 1; + } + else { + total++; if (keyisinteger(n)) - ause += countint(keyival(n), nums); - totaluse++; + countint(keyival(n), ct); } } - *pna += ause; - return totaluse; + ct->total += total; +} + + +/* +** Convert an "abstract size" (number of slots in an array) to +** "concrete size" (number of bytes in the array). +*/ +static size_t concretesize (unsigned int size) { + if (size == 0) + return 0; + else /* space for the two arrays plus an unsigned in between */ + return size * (sizeof(Value) + 1) + sizeof(unsigned); +} + + +/* +** Resize the array part of a table. If new size is equal to the old, +** do nothing. Else, if new size is zero, free the old array. (It must +** be present, as the sizes are different.) Otherwise, allocate a new +** array, move the common elements to new proper position, and then +** frees the old array. +** We could reallocate the array, but we still would need to move the +** elements to their new position, so the copy implicit in realloc is a +** waste. Moreover, most allocators will move the array anyway when the +** new size is double the old one (the most common case). +*/ +static Value *resizearray (lua_State *L , Table *t, + unsigned oldasize, + unsigned newasize) { + if (oldasize == newasize) + return t->array; /* nothing to be done */ + else if (newasize == 0) { /* erasing array? */ + Value *op = t->array - oldasize; /* original array's real address */ + luaM_freemem(L, op, concretesize(oldasize)); /* free it */ + return NULL; + } + else { + size_t newasizeb = concretesize(newasize); + Value *np = cast(Value *, + luaM_reallocvector(L, NULL, 0, newasizeb, lu_byte)); + if (np == NULL) /* allocation error? */ + return NULL; + np += newasize; /* shift pointer to the end of value segment */ + if (oldasize > 0) { + /* move common elements to new position */ + size_t oldasizeb = concretesize(oldasize); + Value *op = t->array; /* original array */ + unsigned tomove = (oldasize < newasize) ? oldasize : newasize; + size_t tomoveb = (oldasize < newasize) ? oldasizeb : newasizeb; + lua_assert(tomoveb > 0); + memcpy(np - tomove, op - tomove, tomoveb); + luaM_freemem(L, op - oldasize, oldasizeb); /* free old block */ + } + return np; + } } @@ -475,27 +599,34 @@ static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) { ** comparison ensures that the shift in the second one does not ** overflow. */ -static void setnodevector (lua_State *L, Table *t, unsigned int size) { +static void setnodevector (lua_State *L, Table *t, unsigned size) { if (size == 0) { /* no elements to hash part? */ t->node = cast(Node *, dummynode); /* use common 'dummynode' */ t->lsizenode = 0; - t->lastfree = NULL; /* signal that it is using dummy node */ + setdummy(t); /* signal that it is using dummy node */ } else { int i; int lsize = luaO_ceillog2(size); - if (lsize > MAXHBITS || (1u << lsize) > MAXHSIZE) + if (lsize > MAXHBITS || (1 << lsize) > MAXHSIZE) luaG_runerror(L, "table overflow"); size = twoto(lsize); - t->node = luaM_newvector(L, size, Node); + if (lsize < LIMFORLAST) /* no 'lastfree' field? */ + t->node = luaM_newvector(L, size, Node); + else { + size_t bsize = size * sizeof(Node) + sizeof(Limbox); + char *node = luaM_newblock(L, bsize); + t->node = cast(Node *, node + sizeof(Limbox)); + getlastfree(t) = gnode(t, size); /* all positions are free */ + } + t->lsizenode = cast_byte(lsize); + setnodummy(t); for (i = 0; i < cast_int(size); i++) { Node *n = gnode(t, i); gnext(n) = 0; setnilkey(n); setempty(gval(n)); } - t->lsizenode = cast_byte(lsize); - t->lastfree = gnode(t, size); /* all positions are free */ } } @@ -503,9 +634,9 @@ static void setnodevector (lua_State *L, Table *t, unsigned int size) { /* ** (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); +static void reinserthash (lua_State *L, Table *ot, Table *t) { + unsigned j; + unsigned size = sizenode(ot); for (j = 0; j < size; j++) { Node *old = gnode(ot, j); if (!isempty(gval(old))) { @@ -513,25 +644,56 @@ static void reinsert (lua_State *L, Table *ot, Table *t) { already present in the table */ TValue k; getnodekey(L, &k, old); - luaH_set(L, t, &k, gval(old)); + newcheckedkey(t, &k, gval(old)); } } } /* -** Exchange the hash part of 't1' and 't2'. +** Exchange the hash part of 't1' and 't2'. (In 'flags', only the +** dummy bit must be exchanged: The 'isrealasize' is not related +** to the hash part, and the metamethod bits do not change during +** a resize, so the "real" table can keep their values.) */ static void exchangehashpart (Table *t1, Table *t2) { lu_byte lsizenode = t1->lsizenode; Node *node = t1->node; - Node *lastfree = t1->lastfree; + int bitdummy1 = t1->flags & BITDUMMY; t1->lsizenode = t2->lsizenode; t1->node = t2->node; - t1->lastfree = t2->lastfree; + t1->flags = cast_byte((t1->flags & NOTBITDUMMY) | (t2->flags & BITDUMMY)); t2->lsizenode = lsizenode; t2->node = node; - t2->lastfree = lastfree; + t2->flags = cast_byte((t2->flags & NOTBITDUMMY) | bitdummy1); +} + + +/* +** Re-insert into the new hash part of a table the elements from the +** vanishing slice of the array part. +*/ +static void reinsertOldSlice (Table *t, unsigned oldasize, + unsigned newasize) { + unsigned i; + for (i = newasize; i < oldasize; i++) { /* traverse vanishing slice */ + lu_byte tag = *getArrTag(t, i); + if (!tagisempty(tag)) { /* a non-empty entry? */ + TValue key, aux; + setivalue(&key, l_castU2S(i) + 1); /* make the key */ + farr2val(t, i, tag, &aux); /* copy value into 'aux' */ + insertkey(t, &key, &aux); /* insert entry into the hash part */ + } + } +} + + +/* +** Clear new slice of the array. +*/ +static void clearNewSlice (Table *t, unsigned oldasize, unsigned newasize) { + for (; oldasize < newasize; oldasize++) + *getArrTag(t, oldasize) = LUA_VEMPTY; } @@ -547,28 +709,28 @@ static void exchangehashpart (Table *t1, Table *t2) { ** 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. +** Note that if the new size for the array part ('newasize') is equal to +** the old one ('oldasize'), this function will do nothing with that +** part. */ -void luaH_resize (lua_State *L, Table *t, unsigned int newasize, - unsigned int nhsize) { - unsigned int i; +void luaH_resize (lua_State *L, Table *t, unsigned newasize, + unsigned nhsize) { Table newt; /* to keep the new hash part */ - unsigned int oldasize = setlimittosize(t); - TValue *newarray; + unsigned oldasize = t->asize; + Value *newarray; + if (newasize > MAXASIZE) + luaG_runerror(L, "table overflow"); /* create new hash part with appropriate size into 'newt' */ + newt.flags = 0; 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]); - } - t->alimit = oldasize; /* restore current size... */ - exchangehashpart(t, &newt); /* and hash (in case of errors) */ + exchangehashpart(t, &newt); /* pretend table has new hash */ + reinsertOldSlice(t, oldasize, newasize); + exchangehashpart(t, &newt); /* restore old hash (in case of errors) */ } /* allocate new array */ - newarray = luaM_reallocvector(L, t->array, oldasize, newasize, TValue); + newarray = resizearray(L, t, oldasize, newasize); if (l_unlikely(newarray == NULL && newasize > 0)) { /* allocation failed? */ freehash(L, &newt); /* release new hash part */ luaM_error(L); /* raise error (with array unchanged) */ @@ -576,46 +738,59 @@ void luaH_resize (lua_State *L, Table *t, unsigned int newasize, /* 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]); + t->asize = newasize; + if (newarray != NULL) + *lenhint(t) = newasize / 2u; /* set an initial hint */ + clearNewSlice(t, oldasize, newasize); /* re-insert elements from old hash part into new parts */ - reinsert(L, &newt, t); /* 'newt' now has the old hash */ + reinserthash(L, &newt, t); /* 'newt' now has the old hash */ freehash(L, &newt); /* free old hash part */ } void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) { - int nsize = allocsizenode(t); + unsigned nsize = allocsizenode(t); luaH_resize(L, t, nasize, nsize); } + /* -** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i +** Rehash a table. First, count its keys. If there are array indices +** outside the array part, compute the new best size for that part. +** Then, resize the table. */ static void rehash (lua_State *L, Table *t, const TValue *ek) { - unsigned int asize; /* optimal size for array part */ - unsigned int na; /* number of keys in the array part */ - unsigned int nums[MAXABITS + 1]; - 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 */ + unsigned asize; /* optimal size for array part */ + Counters ct; + unsigned i; + unsigned nsize; /* size for the hash part */ + /* reset counts */ + for (i = 0; i <= MAXABITS; i++) ct.nums[i] = 0; + ct.na = 0; + ct.deleted = 0; + ct.total = 1; /* count extra key */ if (ttisinteger(ek)) - na += countint(ivalue(ek), nums); - totaluse++; - /* compute new size for array part */ - asize = computesizes(nums, &na); + countint(ivalue(ek), &ct); /* extra key may go to array */ + numusehash(t, &ct); /* count keys in hash part */ + if (ct.na == 0) { + /* no new keys to enter array part; keep it with the same size */ + asize = t->asize; + } + else { /* compute best size for array part */ + numusearray(t, &ct); /* count keys in array part */ + asize = computesizes(&ct); /* compute new size for array part */ + } + /* all keys not in the array part go to the hash part */ + nsize = ct.total - ct.na; + if (ct.deleted) { /* table has deleted entries? */ + /* insertion-deletion-insertion: give hash some extra size to + avoid repeated resizings */ + nsize += nsize >> 2; + } /* resize the table to new computed sizes */ - luaH_resize(L, t, asize, totaluse - na); + luaH_resize(L, t, asize, nsize); } - - /* ** }============================================================= */ @@ -625,27 +800,47 @@ Table *luaH_new (lua_State *L) { GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table)); Table *t = gco2t(o); t->metatable = NULL; - t->flags = cast_byte(maskflags); /* table has no metamethod fields */ + t->flags = maskflags; /* table has no metamethod fields */ t->array = NULL; - t->alimit = 0; + t->asize = 0; setnodevector(L, t, 0); return t; } +lu_mem luaH_size (Table *t) { + lu_mem sz = cast(lu_mem, sizeof(Table)) + concretesize(t->asize); + if (!isdummy(t)) + sz += sizehash(t); + return sz; +} + + +/* +** Frees a table. +*/ void luaH_free (lua_State *L, Table *t) { freehash(L, t); - luaM_freearray(L, t->array, luaH_realasize(t)); + resizearray(L, t, t->asize, 0); luaM_free(L, t); } static Node *getfreepos (Table *t) { - if (!isdummy(t)) { - while (t->lastfree > t->node) { - t->lastfree--; - if (keyisnil(t->lastfree)) - return t->lastfree; + if (haslastfree(t)) { /* does it have 'lastfree' information? */ + /* look for a spot before 'lastfree', updating 'lastfree' */ + while (getlastfree(t) > t->node) { + Node *free = --getlastfree(t); + if (keyisnil(free)) + return free; + } + } + else { /* no 'lastfree' information */ + unsigned i = sizenode(t); + while (i--) { /* do a linear search */ + Node *free = gnode(t, i); + if (keyisnil(free)) + return free; } } return NULL; /* could not find a free place */ @@ -654,39 +849,22 @@ static Node *getfreepos (Table *t) { /* -** inserts a new key into a hash table; first, check whether key's main +** Inserts a new key into a hash table; first, check whether key's main ** position is free. If not, check whether colliding node is in its main -** position or not: if it is not, move colliding node to an empty place and -** put new key in its main position; otherwise (colliding node is in its main -** position), new key goes to an empty position. -*/ -void luaH_newkey (lua_State *L, Table *t, const TValue *key, TValue *value) { - Node *mp; - TValue aux; - if (l_unlikely(ttisnil(key))) - luaG_runerror(L, "table index is nil"); - else if (ttisfloat(key)) { - lua_Number f = fltvalue(key); - lua_Integer k; - if (luaV_flttointeger(f, &k, F2Ieq)) { /* does key fit in an integer? */ - setivalue(&aux, k); - key = &aux; /* insert it as an integer */ - } - else if (l_unlikely(luai_numisnan(f))) - luaG_runerror(L, "table index is NaN"); - } - if (ttisnil(value)) - return; /* do not insert nil values */ - mp = mainpositionTV(t, key); +** position or not: if it is not, move colliding node to an empty place +** and put new key in its main position; otherwise (colliding node is in +** its main position), new key goes to an empty position. Return 0 if +** could not insert key (could not find a free space). +*/ +static int insertkey (Table *t, const TValue *key, TValue *value) { + Node *mp = mainpositionTV(t, key); + /* table cannot already contain the key */ + lua_assert(isabstkey(getgeneric(t, key, 0))); 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? */ - rehash(L, t, key); /* grow table */ - /* whatever called 'newkey' takes care of TM cache */ - luaH_set(L, t, key, value); /* insert key into grown table */ - return; - } + if (f == NULL) /* cannot find a free place? */ + return 0; lua_assert(!isdummy(t)); othern = mainpositionfromnode(t, mp); if (othern != mp) { /* is colliding node out of its main position? */ @@ -710,52 +888,93 @@ void luaH_newkey (lua_State *L, Table *t, const TValue *key, TValue *value) { mp = f; } } - setnodekey(L, mp, key); - luaC_barrierback(L, obj2gco(t), key); + setnodekey(mp, key); lua_assert(isempty(gval(mp))); - setobj2t(L, gval(mp), value); + setobj2t(cast(lua_State *, 0), gval(mp), value); + return 1; } /* -** 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). +** Insert a key in a table where there is space for that key, the +** key is valid, and the value is not nil. */ -const TValue *luaH_getint (Table *t, lua_Integer key) { - 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]; - } +static void newcheckedkey (Table *t, const TValue *key, TValue *value) { + unsigned i = keyinarray(t, key); + if (i > 0) /* is key in the array part? */ + obj2arr(t, i - 1, value); /* set value in the array */ else { - Node *n = hashint(t, key); - for (;;) { /* check whether 'key' is somewhere in the chain */ - if (keyisinteger(n) && keyival(n) == key) - return gval(n); /* that's it */ - else { - int nx = gnext(n); - if (nx == 0) break; - n += nx; - } + int done = insertkey(t, key, value); /* insert key in the hash part */ + lua_assert(done); /* it cannot fail */ + cast(void, done); /* to avoid warnings */ + } +} + + +static void luaH_newkey (lua_State *L, Table *t, const TValue *key, + TValue *value) { + if (!ttisnil(value)) { /* do not insert nil values */ + int done = insertkey(t, key, value); + if (!done) { /* could not find a free place? */ + rehash(L, t, key); /* grow table */ + newcheckedkey(t, key, value); /* insert key in grown table */ } - return &absentkey; + luaC_barrierback(L, obj2gco(t), key); + /* for debugging only: any new key may force an emergency collection */ + condchangemem(L, (void)0, (void)0, 1); } } +static const TValue *getintfromhash (Table *t, lua_Integer key) { + Node *n = hashint(t, key); + lua_assert(!ikeyinarray(t, key)); + for (;;) { /* check whether 'key' is somewhere in the chain */ + if (keyisinteger(n) && keyival(n) == key) + return gval(n); /* that's it */ + else { + int nx = gnext(n); + if (nx == 0) break; + n += nx; + } + } + return &absentkey; +} + + +static int hashkeyisempty (Table *t, lua_Unsigned key) { + const TValue *val = getintfromhash(t, l_castU2S(key)); + return isempty(val); +} + + +static lu_byte finishnodeget (const TValue *val, TValue *res) { + if (!ttisnil(val)) { + setobj(((lua_State*)NULL), res, val); + } + return ttypetag(val); +} + + +lu_byte luaH_getint (Table *t, lua_Integer key, TValue *res) { + unsigned k = ikeyinarray(t, key); + if (k > 0) { + lu_byte tag = *getArrTag(t, k - 1); + if (!tagisempty(tag)) + farr2val(t, k - 1, tag, res); + return tag; + } + else + return finishnodeget(getintfromhash(t, key), res); +} + + /* ** search function for short strings */ -const TValue *luaH_getshortstr (Table *t, TString *key) { +const TValue *luaH_Hgetshortstr (Table *t, TString *key) { Node *n = hashstr(t, key); - lua_assert(key->tt == LUA_VSHRSTR); + lua_assert(strisshr(key)); for (;;) { /* check whether 'key' is somewhere in the chain */ if (keyisshrstr(n) && eqshrstr(keystrval(n), key)) return gval(n); /* that's it */ @@ -769,49 +988,203 @@ const TValue *luaH_getshortstr (Table *t, TString *key) { } -const TValue *luaH_getstr (Table *t, TString *key) { - if (key->tt == LUA_VSHRSTR) - return luaH_getshortstr(t, key); - else { /* for long strings, use generic case */ - TValue ko; - setsvalue(cast(lua_State *, NULL), &ko, key); - return getgeneric(t, &ko, 0); - } +lu_byte luaH_getshortstr (Table *t, TString *key, TValue *res) { + return finishnodeget(luaH_Hgetshortstr(t, key), res); +} + + +static const TValue *Hgetlongstr (Table *t, TString *key) { + TValue ko; + lua_assert(!strisshr(key)); + setsvalue(cast(lua_State *, NULL), &ko, key); + return getgeneric(t, &ko, 0); /* for long strings, use generic case */ +} + + +static const TValue *Hgetstr (Table *t, TString *key) { + if (strisshr(key)) + return luaH_Hgetshortstr(t, key); + else + return Hgetlongstr(t, key); +} + + +lu_byte luaH_getstr (Table *t, TString *key, TValue *res) { + return finishnodeget(Hgetstr(t, key), res); } /* ** main search function */ -const TValue *luaH_get (Table *t, const TValue *key) { +lu_byte luaH_get (Table *t, const TValue *key, TValue *res) { + const TValue *slot; 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_VSHRSTR: + slot = luaH_Hgetshortstr(t, tsvalue(key)); + break; + case LUA_VNUMINT: + return luaH_getint(t, ivalue(key), res); + case LUA_VNIL: + slot = &absentkey; + break; case LUA_VNUMFLT: { lua_Integer k; if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */ - return luaH_getint(t, k); /* use specialized version */ + return luaH_getint(t, k, res); /* use specialized version */ /* else... */ } /* FALLTHROUGH */ default: - return getgeneric(t, key, 0); + slot = getgeneric(t, key, 0); + break; } + return finishnodeget(slot, res); } /* -** Finish a raw "set table" operation, where 'slot' is where the value -** should have been (the result of a previous "get table"). -** Beware: when using this function you probably need to check a GC -** barrier and invalidate the TM cache. +** When a 'pset' cannot be completed, this function returns an encoding +** of its result, to be used by 'luaH_finishset'. */ -void luaH_finishset (lua_State *L, Table *t, const TValue *key, - const TValue *slot, TValue *value) { +static int retpsetcode (Table *t, const TValue *slot) { if (isabstkey(slot)) - luaH_newkey(L, t, key, value); + return HNOTFOUND; /* no slot with that key */ + else /* return node encoded */ + return cast_int((cast(Node*, slot) - t->node)) + HFIRSTNODE; +} + + +static int finishnodeset (Table *t, const TValue *slot, TValue *val) { + if (!ttisnil(slot)) { + setobj(((lua_State*)NULL), cast(TValue*, slot), val); + return HOK; /* success */ + } else - setobj2t(L, cast(TValue *, slot), value); + return retpsetcode(t, slot); +} + + +static int rawfinishnodeset (const TValue *slot, TValue *val) { + if (isabstkey(slot)) + return 0; /* no slot with that key */ + else { + setobj(((lua_State*)NULL), cast(TValue*, slot), val); + return 1; /* success */ + } +} + + +int luaH_psetint (Table *t, lua_Integer key, TValue *val) { + lua_assert(!ikeyinarray(t, key)); + return finishnodeset(t, getintfromhash(t, key), val); +} + + +static int psetint (Table *t, lua_Integer key, TValue *val) { + int hres; + luaH_fastseti(t, key, val, hres); + return hres; +} + + +/* +** This function could be just this: +** return finishnodeset(t, luaH_Hgetshortstr(t, key), val); +** However, it optimizes the common case created by constructors (e.g., +** {x=1, y=2}), which creates a key in a table that has no metatable, +** it is not old/black, and it already has space for the key. +*/ + +int luaH_psetshortstr (Table *t, TString *key, TValue *val) { + const TValue *slot = luaH_Hgetshortstr(t, key); + if (!ttisnil(slot)) { /* key already has a value? (all too common) */ + setobj(((lua_State*)NULL), cast(TValue*, slot), val); /* update it */ + return HOK; /* done */ + } + else if (checknoTM(t->metatable, TM_NEWINDEX)) { /* no metamethod? */ + if (ttisnil(val)) /* new value is nil? */ + return HOK; /* done (value is already nil/absent) */ + if (isabstkey(slot) && /* key is absent? */ + !(isblack(t) && iswhite(key))) { /* and don't need barrier? */ + TValue tk; /* key as a TValue */ + setsvalue(cast(lua_State *, NULL), &tk, key); + if (insertkey(t, &tk, val)) { /* insert key, if there is space */ + invalidateTMcache(t); + return HOK; + } + } + } + /* Else, either table has new-index metamethod, or it needs barrier, + or it needs to rehash for the new key. In any of these cases, the + operation cannot be completed here. Return a code for the caller. */ + return retpsetcode(t, slot); +} + + +int luaH_psetstr (Table *t, TString *key, TValue *val) { + if (strisshr(key)) + return luaH_psetshortstr(t, key, val); + else + return finishnodeset(t, Hgetlongstr(t, key), val); +} + + +int luaH_pset (Table *t, const TValue *key, TValue *val) { + switch (ttypetag(key)) { + case LUA_VSHRSTR: return luaH_psetshortstr(t, tsvalue(key), val); + case LUA_VNUMINT: return psetint(t, ivalue(key), val); + case LUA_VNIL: return HNOTFOUND; + case LUA_VNUMFLT: { + lua_Integer k; + if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */ + return psetint(t, k, val); /* use specialized version */ + /* else... */ + } /* FALLTHROUGH */ + default: + return finishnodeset(t, getgeneric(t, key, 0), val); + } +} + +/* +** Finish a raw "set table" operation, where 'hres' encodes where the +** value should have been (the result of a previous 'pset' operation). +** Beware: when using this function the caller probably need to check a +** GC barrier and invalidate the TM cache. +*/ +void luaH_finishset (lua_State *L, Table *t, const TValue *key, + TValue *value, int hres) { + lua_assert(hres != HOK); + if (hres == HNOTFOUND) { + TValue aux; + if (l_unlikely(ttisnil(key))) + luaG_runerror(L, "table index is nil"); + else if (ttisfloat(key)) { + lua_Number f = fltvalue(key); + lua_Integer k; + if (luaV_flttointeger(f, &k, F2Ieq)) { + setivalue(&aux, k); /* key is equal to an integer */ + key = &aux; /* insert it as an integer */ + } + else if (l_unlikely(luai_numisnan(f))) + luaG_runerror(L, "table index is NaN"); + } + else if (isextstr(key)) { /* external string? */ + /* If string is short, must internalize it to be used as table key */ + TString *ts = luaS_normstr(L, tsvalue(key)); + setsvalue2s(L, L->top.p++, ts); /* anchor 'ts' (EXTRA_STACK) */ + luaH_newkey(L, t, s2v(L->top.p - 1), value); + L->top.p--; + return; + } + luaH_newkey(L, t, key, value); + } + else if (hres > 0) { /* regular Node? */ + setobj2t(L, gval(gnode(t, hres - HFIRSTNODE)), value); + } + else { /* array entry */ + hres = ~hres; /* real index */ + obj2arr(t, cast_uint(hres), value); + } } @@ -820,156 +1193,160 @@ void luaH_finishset (lua_State *L, Table *t, const TValue *key, ** barrier and invalidate the TM cache. */ void luaH_set (lua_State *L, Table *t, const TValue *key, TValue *value) { - const TValue *slot = luaH_get(t, key); - luaH_finishset(L, t, key, slot, value); + int hres = luaH_pset(t, key, value); + if (hres != HOK) + luaH_finishset(L, t, key, value, hres); } +/* +** Ditto for a GC barrier. (No need to invalidate the TM cache, as +** integers cannot be keys to metamethods.) +*/ void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) { - const TValue *p = luaH_getint(t, key); - if (isabstkey(p)) { - TValue k; - setivalue(&k, key); - luaH_newkey(L, t, &k, value); + unsigned ik = ikeyinarray(t, key); + if (ik > 0) + obj2arr(t, ik - 1, value); + else { + int ok = rawfinishnodeset(getintfromhash(t, key), value); + if (!ok) { + TValue k; + setivalue(&k, key); + luaH_newkey(L, t, &k, value); + } } - else - setobj2t(L, cast(TValue *, p), value); } /* ** 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 { +** caller, we know that 'asize + 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.) Otherwise, 'j' is a +** boundary. ('j + 1' cannot be a present integer key because it is not +** a valid integer in Lua.) +** About 'rnd': If we used a fixed algorithm, a bad actor could fill +** a table with only the keys that would be probed, in such a way that +** a small table could result in a huge length. To avoid that, we use +** the state's seed as a source of randomness. For the first probe, +** we "randomly double" 'i' by adding to it a random number roughly its +** width. +*/ +static lua_Unsigned hash_search (lua_State *L, Table *t, unsigned asize) { + lua_Unsigned i = asize + 1; /* caller ensures t[i] is present */ + unsigned rnd = G(L)->seed; + int n = (asize > 0) ? luaO_ceillog2(asize) : 0; /* width of 'asize' */ + unsigned mask = (1u << n) - 1; /* 11...111 with the width of 'asize' */ + unsigned incr = (rnd & mask) + 1; /* first increment (at least 1) */ + lua_Unsigned j = (incr <= l_castS2U(LUA_MAXINTEGER) - i) ? i + incr : i + 1; + rnd >>= n; /* used 'n' bits from 'rnd' */ + while (!hashkeyisempty(t, j)) { /* repeat until an absent t[j] */ i = j; /* 'i' is a present index */ - if (j <= l_castS2U(LUA_MAXINTEGER) / 2) - j *= 2; + if (j <= l_castS2U(LUA_MAXINTEGER)/2 - 1) { + j = j*2 + (rnd & 1); /* try again with 2j or 2j+1 */ + rnd >>= 1; + } else { j = LUA_MAXINTEGER; - if (isempty(luaH_getint(t, j))) /* t[j] not present? */ + if (hashkeyisempty(t, j)) /* t[j] not present? */ break; /* 'j' now is an absent index */ else /* weird case */ return j; /* well, max integer is a boundary... */ } - } 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; + if (hashkeyisempty(t, m)) j = m; else i = m; } return i; } -static unsigned int binsearch (const TValue *array, unsigned int i, - unsigned int j) { +static unsigned int binsearch (Table *array, unsigned int i, unsigned int j) { + lua_assert(i <= j); while (j - i > 1u) { /* binary search */ unsigned int m = (i + j) / 2; - if (isempty(&array[m - 1])) j = m; + if (arraykeyisempty(array, m)) j = m; else i = m; } return i; } +/* return a border, saving it as a hint for next call */ +static lua_Unsigned newhint (Table *t, unsigned hint) { + lua_assert(hint <= t->asize); + *lenhint(t) = hint; + return hint; +} + + /* -** 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 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; - } - 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); +** Try to find a border in table 't'. (A 'border' is an integer index +** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent, +** or 'maxinteger' if t[maxinteger] is present.) +** If there is an array part, try to find a border there. First try +** to find it in the vicinity of the previous result (hint), to handle +** cases like 't[#t + 1] = val' or 't[#t] = nil', that move the border +** by one entry. Otherwise, do a binary search to find the border. +** If there is no array part, or its last element is non empty, the +** border may be in the hash part. +*/ +lua_Unsigned luaH_getn (lua_State *L, Table *t) { + unsigned asize = t->asize; + if (asize > 0) { /* is there an array part? */ + const unsigned maxvicinity = 4; + unsigned limit = *lenhint(t); /* start with the hint */ + if (limit == 0) + limit = 1; /* make limit a valid index in the array */ + if (arraykeyisempty(t, limit)) { /* t[limit] empty? */ + /* there must be a border before 'limit' */ + unsigned i; + /* look for a border in the vicinity of the hint */ + for (i = 0; i < maxvicinity && limit > 1; i++) { + limit--; + if (!arraykeyisempty(t, limit)) + return newhint(t, limit); /* 'limit' is a border */ } - return boundary; + /* t[limit] still empty; search for a border in [0, limit) */ + return newhint(t, binsearch(t, 0, limit)); } - } - /* '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 { /* 'limit' is present in table; look for a border after it */ + unsigned i; + /* look for a border in the vicinity of the hint */ + for (i = 0; i < maxvicinity && limit < asize; i++) { + limit++; + if (arraykeyisempty(t, limit)) + return newhint(t, limit - 1); /* 'limit - 1' is a border */ + } + if (arraykeyisempty(t, asize)) { /* last element empty? */ + /* t[limit] not empty; search for a border in [limit, asize) */ + return newhint(t, binsearch(t, limit, asize)); + } } - /* else, new limit is present in the table; check the hash part */ + /* last element non empty; set a hint to speed up finding that again */ + /* (keys in the hash part cannot be hints) */ + *lenhint(t) = asize; } - /* (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); + /* no array part or t[asize] is not empty; check the hash part */ + lua_assert(asize == 0 || !arraykeyisempty(t, asize)); + if (isdummy(t) || hashkeyisempty(t, asize + 1)) + return asize; /* 'asize + 1' is empty */ + else /* 'asize + 1' is also non empty */ + return hash_search(L, t, asize); } #if defined(LUA_DEBUG) -/* export these functions for the test library */ +/* export this function for the test library */ Node *luaH_mainposition (const Table *t, const TValue *key) { return mainpositionTV(t, key); diff --git a/ltable.h b/ltable.h index 75dd9e26e0..f3b7bc7e7e 100644 --- a/ltable.h +++ b/ltable.h @@ -20,11 +20,21 @@ ** may have any of these metamethods. (First access that fails after the ** clearing will set the bit again.) */ -#define invalidateTMcache(t) ((t)->flags &= ~maskflags) +#define invalidateTMcache(t) ((t)->flags &= cast_byte(~maskflags)) -/* true when 't' is using 'dummynode' as its hash part */ -#define isdummy(t) ((t)->lastfree == NULL) +/* +** Bit BITDUMMY set in 'flags' means the table is using the dummy node +** for its hash part. +*/ + +#define BITDUMMY (1 << 6) +#define NOTBITDUMMY cast_byte(~BITDUMMY) +#define isdummy(t) ((t)->flags & BITDUMMY) + +#define setnodummy(t) ((t)->flags &= NOTBITDUMMY) +#define setdummy(t) ((t)->flags |= BITDUMMY) + /* allocated size for hash nodes */ @@ -35,26 +45,135 @@ #define nodefromval(v) cast(Node *, (v)) -LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key); + +#define luaH_fastgeti(t,k,res,tag) \ + { Table *h = t; lua_Unsigned u = l_castS2U(k) - 1u; \ + if ((u < h->asize)) { \ + tag = *getArrTag(h, u); \ + if (!tagisempty(tag)) { farr2val(h, u, tag, res); }} \ + else { tag = luaH_getint(h, (k), res); }} + + +#define luaH_fastseti(t,k,val,hres) \ + { Table *h = t; lua_Unsigned u = l_castS2U(k) - 1u; \ + if ((u < h->asize)) { \ + lu_byte *tag = getArrTag(h, u); \ + if (checknoTM(h->metatable, TM_NEWINDEX) || !tagisempty(*tag)) \ + { fval2arr(h, u, tag, val); hres = HOK; } \ + else hres = ~cast_int(u); } \ + else { hres = luaH_psetint(h, k, val); }} + + +/* results from pset */ +#define HOK 0 +#define HNOTFOUND 1 +#define HNOTATABLE 2 +#define HFIRSTNODE 3 + +/* +** 'luaH_get*' operations set 'res', unless the value is absent, and +** return the tag of the result. +** The 'luaH_pset*' (pre-set) operations set the given value and return +** HOK, unless the original value is absent. In that case, if the key +** is really absent, they return HNOTFOUND. Otherwise, if there is a +** slot with that key but with no value, 'luaH_pset*' return an encoding +** of where the key is (usually called 'hres'). (pset cannot set that +** value because there might be a metamethod.) If the slot is in the +** hash part, the encoding is (HFIRSTNODE + hash index); if the slot is +** in the array part, the encoding is (~array index), a negative value. +** The value HNOTATABLE is used by the fast macros to signal that the +** value being indexed is not a table. +** (The size for the array part is limited by the maximum power of two +** that fits in an unsigned integer; that is INT_MAX+1. So, the C-index +** ranges from 0, which encodes to -1, to INT_MAX, which encodes to +** INT_MIN. The size of the hash part is limited by the maximum power of +** two that fits in a signed integer; that is (INT_MAX+1)/2. So, it is +** safe to add HFIRSTNODE to any index there.) +*/ + + +/* +** The array part of a table is represented by an inverted array of +** values followed by an array of tags, to avoid wasting space with +** padding. In between them there is an unsigned int, explained later. +** The 'array' pointer points between the two arrays, so that values are +** indexed with negative indices and tags with non-negative indices. + + Values Tags + -------------------------------------------------------- + ... | Value 1 | Value 0 |unsigned|0|1|... + -------------------------------------------------------- + ^ t->array + +** All accesses to 't->array' should be through the macros 'getArrTag' +** and 'getArrVal'. +*/ + +/* Computes the address of the tag for the abstract C-index 'k' */ +#define getArrTag(t,k) (cast(lu_byte*, (t)->array) + sizeof(unsigned) + (k)) + +/* Computes the address of the value for the abstract C-index 'k' */ +#define getArrVal(t,k) ((t)->array - 1 - (k)) + + +/* +** The unsigned between the two arrays is used as a hint for #t; +** see luaH_getn. It is stored there to avoid wasting space in +** the structure Table for tables with no array part. +*/ +#define lenhint(t) cast(unsigned*, (t)->array) + + +/* +** Move TValues to/from arrays, using C indices +*/ +#define arr2obj(h,k,val) \ + ((val)->tt_ = *getArrTag(h,(k)), (val)->value_ = *getArrVal(h,(k))) + +#define obj2arr(h,k,val) \ + (*getArrTag(h,(k)) = (val)->tt_, *getArrVal(h,(k)) = (val)->value_) + + +/* +** Often, we need to check the tag of a value before moving it. The +** following macros also move TValues to/from arrays, but receive the +** precomputed tag value or address as an extra argument. +*/ +#define farr2val(h,k,tag,res) \ + ((res)->tt_ = tag, (res)->value_ = *getArrVal(h,(k))) + +#define fval2arr(h,k,tag,val) \ + (*tag = (val)->tt_, *getArrVal(h,(k)) = (val)->value_) + + +LUAI_FUNC lu_byte luaH_get (Table *t, const TValue *key, TValue *res); +LUAI_FUNC lu_byte luaH_getshortstr (Table *t, TString *key, TValue *res); +LUAI_FUNC lu_byte luaH_getstr (Table *t, TString *key, TValue *res); +LUAI_FUNC lu_byte luaH_getint (Table *t, lua_Integer key, TValue *res); + +/* Special get for metamethods */ +LUAI_FUNC const TValue *luaH_Hgetshortstr (Table *t, TString *key); + +LUAI_FUNC int luaH_psetint (Table *t, lua_Integer key, TValue *val); +LUAI_FUNC int luaH_psetshortstr (Table *t, TString *key, TValue *val); +LUAI_FUNC int luaH_psetstr (Table *t, TString *key, TValue *val); +LUAI_FUNC int luaH_pset (Table *t, const TValue *key, TValue *val); + LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value); -LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key); -LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key); -LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key); -LUAI_FUNC void luaH_newkey (lua_State *L, Table *t, const TValue *key, - TValue *value); LUAI_FUNC void luaH_set (lua_State *L, Table *t, const TValue *key, TValue *value); + LUAI_FUNC void luaH_finishset (lua_State *L, Table *t, const TValue *key, - const TValue *slot, TValue *value); + TValue *value, int hres); LUAI_FUNC Table *luaH_new (lua_State *L); -LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize, - unsigned int nhsize); -LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize); +LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned nasize, + unsigned nhsize); +LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned nasize); +LUAI_FUNC lu_mem luaH_size (Table *t); 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); +LUAI_FUNC lua_Unsigned luaH_getn (lua_State *L, Table *t); #if defined(LUA_DEBUG) diff --git a/ltablib.c b/ltablib.c index e6bc4d04af..46ecb5e024 100644 --- a/ltablib.c +++ b/ltablib.c @@ -18,6 +18,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" /* @@ -58,6 +59,16 @@ static void checktab (lua_State *L, int arg, int what) { } +static int tcreate (lua_State *L) { + lua_Unsigned sizeseq = (lua_Unsigned)luaL_checkinteger(L, 1); + lua_Unsigned sizerest = (lua_Unsigned)luaL_optinteger(L, 2, 0); + luaL_argcheck(L, sizeseq <= cast_uint(INT_MAX), 1, "out of range"); + luaL_argcheck(L, sizerest <= cast_uint(INT_MAX), 2, "out of range"); + lua_createtable(L, cast_int(sizeseq), cast_int(sizerest)); + return 1; +} + + static int tinsert (lua_State *L) { lua_Integer pos; /* where to insert new element */ lua_Integer e = aux_getn(L, 1, TAB_RW); @@ -196,7 +207,7 @@ static int tunpack (lua_State *L) { lua_Integer i = luaL_optinteger(L, 2, 1); lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1)); if (i > e) return 0; /* empty range */ - n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */ + n = l_castS2U(e) - l_castS2U(i); /* number of elements minus 1 */ if (l_unlikely(n >= (unsigned int)INT_MAX || !lua_checkstack(L, (int)(++n)))) return luaL_error(L, "too many results to unpack"); @@ -220,41 +231,26 @@ static int tunpack (lua_State *L) { */ -/* type for array indices */ +/* +** Type for array indices. These indices are always limited by INT_MAX, +** so it is safe to cast them to lua_Integer even for Lua 32 bits. +*/ typedef unsigned int IdxT; +/* Versions of lua_seti/lua_geti specialized for IdxT */ +#define geti(L,idt,idx) lua_geti(L, idt, l_castU2S(idx)) +#define seti(L,idt,idx) lua_seti(L, idt, l_castU2S(idx)) + + /* ** Produce a "random" 'unsigned int' to randomize pivot choice. This ** macro is used only when 'sort' detects a big imbalance in the result ** of a partition. (If you don't want/need this "randomness", ~0 is a ** good choice.) */ -#if !defined(l_randomizePivot) /* { */ - -#include - -/* size of 'e' measured in number of 'unsigned int's */ -#define sof(e) (sizeof(e) / sizeof(unsigned int)) - -/* -** Use 'time' and 'clock' as sources of "randomness". Because we don't -** know the types 'clock_t' and 'time_t', we cannot cast them to -** anything without risking overflows. A safe way to use their values -** is to copy them to an array of a known type and use the array values. -*/ -static unsigned int l_randomizePivot (void) { - clock_t c = clock(); - time_t t = time(NULL); - unsigned int buff[sof(c) + sof(t)]; - unsigned int i, rnd = 0; - memcpy(buff, &c, sof(c) * sizeof(unsigned int)); - memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int)); - for (i = 0; i < sof(buff); i++) - rnd += buff[i]; - return rnd; -} - +#if !defined(l_randomizePivot) +#define l_randomizePivot(L) luaL_makeseed(L) #endif /* } */ @@ -263,8 +259,8 @@ static unsigned int l_randomizePivot (void) { static void set2 (lua_State *L, IdxT i, IdxT j) { - lua_seti(L, 1, i); - lua_seti(L, 1, j); + seti(L, 1, i); + seti(L, 1, j); } @@ -301,15 +297,15 @@ static IdxT partition (lua_State *L, IdxT lo, IdxT up) { /* loop invariant: a[lo .. i] <= P <= a[j .. up] */ for (;;) { /* next loop: repeat ++i while a[i] < P */ - while ((void)lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) { - if (l_unlikely(i == up - 1)) /* a[i] < P but a[up - 1] == P ?? */ + while ((void)geti(L, 1, ++i), sort_comp(L, -1, -2)) { + if (l_unlikely(i == up - 1)) /* a[up - 1] < P == a[up - 1] */ 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 */ + /* after the loop, a[i] >= P and a[lo .. i - 1] < P (a) */ /* next loop: repeat --j while P < a[j] */ - while ((void)lua_geti(L, 1, --j), sort_comp(L, -3, -1)) { - if (l_unlikely(j < i)) /* j < i but a[j] > P ?? */ + while ((void)geti(L, 1, --j), sort_comp(L, -3, -1)) { + if (l_unlikely(j < i)) /* j <= i - 1 and a[j] > P, contradicts (a) */ luaL_error(L, "invalid order function for sorting"); lua_pop(L, 1); /* remove a[j] */ } @@ -333,7 +329,7 @@ static IdxT partition (lua_State *L, IdxT lo, IdxT up) { */ static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) { IdxT r4 = (up - lo) / 4; /* range/4 */ - IdxT p = rnd % (r4 * 2) + (lo + r4); + IdxT p = (rnd ^ lo ^ up) % (r4 * 2) + (lo + r4); lua_assert(lo + r4 <= p && p <= up - r4); return p; } @@ -342,14 +338,13 @@ static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) { /* ** Quicksort algorithm (recursive function) */ -static void auxsort (lua_State *L, IdxT lo, IdxT up, - unsigned int rnd) { +static void auxsort (lua_State *L, IdxT lo, IdxT up, unsigned rnd) { while (lo < up) { /* loop for tail recursion */ IdxT p; /* Pivot index */ IdxT n; /* to be used later */ /* sort elements 'lo', 'p', and 'up' */ - lua_geti(L, 1, lo); - lua_geti(L, 1, up); + geti(L, 1, lo); + geti(L, 1, up); if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */ set2(L, lo, up); /* swap a[lo] - a[up] */ else @@ -360,13 +355,13 @@ static void auxsort (lua_State *L, IdxT lo, IdxT up, p = (lo + up)/2; /* middle element is a good pivot */ else /* for larger intervals, it is worth a random pivot */ p = choosePivot(lo, up, rnd); - lua_geti(L, 1, p); - lua_geti(L, 1, lo); + geti(L, 1, p); + geti(L, 1, lo); if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */ set2(L, p, lo); /* swap a[p] - a[lo] */ else { lua_pop(L, 1); /* remove a[lo] */ - lua_geti(L, 1, up); + geti(L, 1, up); if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */ set2(L, p, up); /* swap a[up] - a[p] */ else @@ -374,9 +369,9 @@ static void auxsort (lua_State *L, IdxT lo, IdxT up, } if (up - lo == 2) /* only 3 elements? */ return; /* already sorted */ - lua_geti(L, 1, p); /* get middle element (Pivot) */ + geti(L, 1, p); /* get middle element (Pivot) */ lua_pushvalue(L, -1); /* push Pivot */ - lua_geti(L, 1, up - 1); /* push a[up - 1] */ + geti(L, 1, up - 1); /* push a[up - 1] */ set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */ p = partition(L, lo, up); /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */ @@ -391,7 +386,7 @@ static void auxsort (lua_State *L, IdxT lo, IdxT up, up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */ } if ((up - lo) / 128 > n) /* partition too imbalanced? */ - rnd = l_randomizePivot(); /* try a new randomization */ + rnd = l_randomizePivot(L); /* try a new randomization */ } /* tail call auxsort(L, lo, up, rnd) */ } @@ -413,6 +408,7 @@ static int sort (lua_State *L) { static const luaL_Reg tab_funcs[] = { {"concat", tconcat}, + {"create", tcreate}, {"insert", tinsert}, {"pack", tpack}, {"unpack", tunpack}, diff --git a/ltests.c b/ltests.c index 4a0a6af1fd..c4905f9487 100644 --- a/ltests.c +++ b/ltests.c @@ -73,8 +73,9 @@ static void badexit (const char *fmt, const char *s1, const char *s2) { static int tpanic (lua_State *L) { - const char *msg = lua_tostring(L, -1); - if (msg == NULL) msg = "error object is not a string"; + const char *msg = (lua_type(L, -1) == LUA_TSTRING) + ? lua_tostring(L, -1) + : "error object is not a string"; return (badexit("PANIC: unprotected error in call to Lua API (%s)\n", msg, NULL), 0); /* do not return to Lua */ @@ -163,13 +164,13 @@ static void warnf (void *ud, const char *msg, int tocont) { #define MARK 0x55 /* 01010101 (a nice pattern) */ -typedef union Header { +typedef union memHeader { LUAI_MAXALIGN; struct { size_t size; int type; } d; -} Header; +} memHeader; #if !defined(EXTERNMEMCHECK) @@ -192,14 +193,14 @@ Memcontrol l_memcontrol = {0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL}}; -static void freeblock (Memcontrol *mc, Header *block) { +static void freeblock (Memcontrol *mc, memHeader *block) { if (block) { size_t size = block->d.size; int i; for (i = 0; i < MARKSIZE; i++) /* check marks after block */ lua_assert(*(cast_charp(block + 1) + size + i) == MARK); mc->objcount[block->d.type]--; - fillmem(block, sizeof(Header) + size + MARKSIZE); /* erase block */ + fillmem(block, sizeof(memHeader) + size + MARKSIZE); /* erase block */ free(block); /* actually free block */ mc->numblocks--; /* update counts */ mc->total -= size; @@ -209,14 +210,14 @@ static void freeblock (Memcontrol *mc, Header *block) { void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) { Memcontrol *mc = cast(Memcontrol *, ud); - Header *block = cast(Header *, b); + memHeader *block = cast(memHeader *, b); int type; if (mc->memlimit == 0) { /* first time? */ char *limit = getenv("MEMLIMIT"); /* initialize memory limit */ mc->memlimit = limit ? strtoul(limit, NULL, 10) : ULONG_MAX; } if (block == NULL) { - type = (oldsize < LUA_NUMTAGS) ? oldsize : 0; + type = (oldsize < LUA_NUMTYPES) ? cast_int(oldsize) : 0; oldsize = 0; } else { @@ -240,12 +241,12 @@ void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) { if (size > oldsize && mc->total+size-oldsize > mc->memlimit) return NULL; /* fake a memory allocation error */ else { - Header *newblock; + memHeader *newblock; int i; size_t commonsize = (oldsize < size) ? oldsize : size; - size_t realsize = sizeof(Header) + size + MARKSIZE; + size_t realsize = sizeof(memHeader) + size + MARKSIZE; if (realsize < size) return NULL; /* arithmetic overflow! */ - newblock = cast(Header *, malloc(realsize)); /* alloc a new block */ + newblock = cast(memHeader *, malloc(realsize)); /* alloc a new block */ if (newblock == NULL) return NULL; /* really out of memory? */ if (block) { @@ -297,13 +298,13 @@ static int testobjref1 (global_State *g, GCObject *f, GCObject *t) { if (isdead(g,t)) return 0; if (issweepphase(g)) return 1; /* no invariants */ - else if (g->gckind == KGC_INC) + else if (g->gckind != KGC_GENMINOR) return !(isblack(f) && iswhite(t)); /* basic incremental invariant */ else { /* generational mode */ if ((getage(f) == G_OLD && isblack(f)) && !isold(t)) return 0; - if (((getage(f) == G_OLD1 || getage(f) == G_TOUCHED2) && isblack(f)) && - getage(t) == G_NEW) + if ((getage(f) == G_OLD1 || getage(f) == G_TOUCHED2) && + getage(t) == G_NEW) return 0; return 1; } @@ -324,6 +325,46 @@ void lua_printobj (lua_State *L, struct GCObject *o) { printobj(G(L), o); } + +void lua_printvalue (TValue *v) { + switch (ttypetag(v)) { + case LUA_VNUMINT: case LUA_VNUMFLT: { + char buff[LUA_N2SBUFFSZ]; + unsigned len = luaO_tostringbuff(v, buff); + buff[len] = '\0'; + printf("%s", buff); + break; + } + case LUA_VSHRSTR: + printf("'%s'", getstr(tsvalue(v))); break; + case LUA_VLNGSTR: + printf("'%.30s...'", getstr(tsvalue(v))); break; + case LUA_VFALSE: + printf("%s", "false"); break; + case LUA_VTRUE: + printf("%s", "true"); break; + case LUA_VLIGHTUSERDATA: + printf("light udata: %p", pvalue(v)); break; + case LUA_VUSERDATA: + printf("full udata: %p", uvalue(v)); break; + case LUA_VNIL: + printf("nil"); break; + case LUA_VLCF: + printf("light C function: %p", fvalue(v)); break; + case LUA_VCCL: + printf("C closure: %p", clCvalue(v)); break; + case LUA_VLCL: + printf("Lua function: %p", clLvalue(v)); break; + case LUA_VTHREAD: + printf("thread: %p", thvalue(v)); break; + case LUA_VTABLE: + printf("table: %p", hvalue(v)); break; + default: + lua_assert(0); + } +} + + static int testobjref (global_State *g, GCObject *f, GCObject *t) { int r1 = testobjref1(g, f, t); if (!r1) { @@ -358,16 +399,19 @@ static void checkvalref (global_State *g, GCObject *f, const TValue *t) { static void checktable (global_State *g, Table *h) { unsigned int i; - unsigned int asize = luaH_realasize(h); + unsigned int asize = h->asize; Node *n, *limit = gnode(h, sizenode(h)); GCObject *hgc = obj2gco(h); checkobjrefN(g, hgc, h->metatable); - for (i = 0; i < asize; i++) - checkvalref(g, hgc, &h->array[i]); + for (i = 0; i < asize; i++) { + TValue aux; + arr2obj(h, i, &aux); + checkvalref(g, hgc, &aux); + } for (n = gnode(h, 0); n < limit; n++) { if (!isempty(gval(n))) { TValue k; - getnodekey(g->mainthread, &k, n); + getnodekey(mainthread(g), &k, n); assert(!keyisnil(n)); checkvalref(g, hgc, &k); checkvalref(g, hgc, gval(n)); @@ -436,7 +480,7 @@ static int lua_checkpc (CallInfo *ci) { } -static void checkstack (global_State *g, lua_State *L1) { +static void check_stack (global_State *g, lua_State *L1) { StkId o; CallInfo *ci; UpVal *uv; @@ -473,7 +517,7 @@ static void checkrefs (global_State *g, GCObject *o) { break; } case LUA_VTHREAD: { - checkstack(g, gco2th(o)); + check_stack(g, gco2th(o)); break; } case LUA_VLCL: { @@ -507,7 +551,8 @@ static void checkrefs (global_State *g, GCObject *o) { ** * objects must be old enough for their lists ('listage'). ** * old objects cannot be white. ** * old objects must be black, except for 'touched1', 'old0', -** threads, and open upvalues. +** threads, and open upvalues. +** * 'touched1' objects must be gray. */ static void checkobject (global_State *g, GCObject *o, int maybedead, int listage) { @@ -515,23 +560,24 @@ static void checkobject (global_State *g, GCObject *o, int maybedead, assert(maybedead); else { assert(g->gcstate != GCSpause || iswhite(o)); - if (g->gckind == KGC_GEN) { /* generational mode? */ + if (g->gckind == KGC_GENMINOR) { /* generational mode? */ assert(getage(o) >= listage); - assert(!iswhite(o) || !isold(o)); if (isold(o)) { + assert(!iswhite(o)); assert(isblack(o) || getage(o) == G_TOUCHED1 || getage(o) == G_OLD0 || o->tt == LUA_VTHREAD || (o->tt == LUA_VUPVAL && upisopen(gco2upv(o)))); } + assert(getage(o) != G_TOUCHED1 || isgray(o)); } checkrefs(g, o); } } -static lu_mem checkgraylist (global_State *g, GCObject *o) { +static l_mem checkgraylist (global_State *g, GCObject *o) { int total = 0; /* count number of elements in the list */ cast_void(g); /* better to keep it if we need to print an object */ while (o) { @@ -560,8 +606,8 @@ static lu_mem checkgraylist (global_State *g, GCObject *o) { /* ** Check objects in gray lists. */ -static lu_mem checkgrays (global_State *g) { - int total = 0; /* count number of elements in all lists */ +static l_mem checkgrays (global_State *g) { + l_mem total = 0; /* count number of elements in all lists */ if (!keepinvariant(g)) return total; total += checkgraylist(g, g->gray); total += checkgraylist(g, g->grayagain); @@ -577,7 +623,7 @@ static lu_mem checkgrays (global_State *g) { ** 'count' and check its TESTBIT. (It must have been previously set by ** 'checkgraylist'.) */ -static void incifingray (global_State *g, GCObject *o, lu_mem *count) { +static void incifingray (global_State *g, GCObject *o, l_mem *count) { if (!keepinvariant(g)) return; /* gray lists not being kept in these phases */ if (o->tt == LUA_VUPVAL) { @@ -594,10 +640,10 @@ static void incifingray (global_State *g, GCObject *o, lu_mem *count) { } -static lu_mem checklist (global_State *g, int maybedead, int tof, +static l_mem checklist (global_State *g, int maybedead, int tof, GCObject *newl, GCObject *survival, GCObject *old, GCObject *reallyold) { GCObject *o; - lu_mem total = 0; /* number of object that should be in gray lists */ + l_mem total = 0; /* number of object that should be in gray lists */ for (o = newl; o != survival; o = o->next) { checkobject(g, o, maybedead, G_NEW); incifingray(g, o, &total); @@ -626,10 +672,10 @@ int lua_checkmemory (lua_State *L) { global_State *g = G(L); GCObject *o; int maybedead; - lu_mem totalin; /* total of objects that are in gray lists */ - lu_mem totalshould; /* total of objects that should be in gray lists */ + l_mem totalin; /* total of objects that are in gray lists */ + l_mem totalshould; /* total of objects that should be in gray lists */ if (keepinvariant(g)) { - assert(!iswhite(g->mainthread)); + assert(!iswhite(mainthread(g))); assert(!iswhite(gcvalue(&g->l_registry))); } assert(!isdead(g, gcvalue(&g->l_registry))); @@ -691,6 +737,11 @@ static char *buildop (Proto *p, int pc, char *buff) { GETARG_A(i), GETARG_B(i), GETARG_C(i), GETARG_k(i) ? " (k)" : ""); break; + case ivABC: + sprintf(buff, "%-12s%4d %4d %4d%s", name, + GETARG_A(i), GETARG_vB(i), GETARG_vC(i), + GETARG_k(i) ? " (k)" : ""); + break; case iABx: sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i)); break; @@ -811,35 +862,68 @@ static int listlocals (lua_State *L) { -static void printstack (lua_State *L) { +void lua_printstack (lua_State *L) { int i; int n = lua_gettop(L); printf("stack: >>\n"); for (i = 1; i <= n; i++) { - printf("%3d: %s\n", i, luaL_tolstring(L, i, NULL)); - lua_pop(L, 1); + printf("%3d: ", i); + lua_printvalue(s2v(L->ci->func.p + i)); + printf("\n"); } printf("<<\n"); } +int lua_printallstack (lua_State *L) { + StkId p; + int i = 1; + CallInfo *ci = &L->base_ci; + printf("stack: >>\n"); + for (p = L->stack.p; p < L->top.p; p++) { + if (ci != NULL && p == ci->func.p) { + printf(" ---\n"); + if (ci == L->ci) + ci = NULL; /* printed last frame */ + else + ci = ci->next; + } + printf("%3d: ", i++); + lua_printvalue(s2v(p)); + printf("\n"); + } + printf("<<\n"); + return 0; +} + + static int get_limits (lua_State *L) { - lua_createtable(L, 0, 6); + lua_createtable(L, 0, 5); setnameval(L, "IS32INT", LUAI_IS32INT); setnameval(L, "MAXARG_Ax", MAXARG_Ax); setnameval(L, "MAXARG_Bx", MAXARG_Bx); setnameval(L, "OFFSET_sBx", OFFSET_sBx); - setnameval(L, "LFPF", LFIELDS_PER_FLUSH); setnameval(L, "NUM_OPCODES", NUM_OPCODES); return 1; } +static int get_sizes (lua_State *L) { + lua_newtable(L); + setnameval(L, "Lua state", sizeof(lua_State)); + setnameval(L, "global state", sizeof(global_State)); + setnameval(L, "TValue", sizeof(TValue)); + setnameval(L, "Node", sizeof(Node)); + setnameval(L, "stack Value", sizeof(StackValue)); + return 1; +} + + static int mem_query (lua_State *L) { if (lua_isnone(L, 1)) { - lua_pushinteger(L, l_memcontrol.total); - lua_pushinteger(L, l_memcontrol.numblocks); - lua_pushinteger(L, l_memcontrol.maxmem); + lua_pushinteger(L, cast_Integer(l_memcontrol.total)); + lua_pushinteger(L, cast_Integer(l_memcontrol.numblocks)); + lua_pushinteger(L, cast_Integer(l_memcontrol.maxmem)); return 3; } else if (lua_isnumber(L, 1)) { @@ -851,9 +935,9 @@ static int mem_query (lua_State *L) { else { const char *t = luaL_checkstring(L, 1); int i; - for (i = LUA_NUMTAGS - 1; i >= 0; i--) { + for (i = LUA_NUMTYPES - 1; i >= 0; i--) { if (strcmp(t, ttypename(i)) == 0) { - lua_pushinteger(L, l_memcontrol.objcount[i]); + lua_pushinteger(L, cast_Integer(l_memcontrol.objcount[i])); return 1; } } @@ -864,9 +948,9 @@ static int mem_query (lua_State *L) { static int alloc_count (lua_State *L) { if (lua_isnone(L, 1)) - l_memcontrol.countlimit = ~0L; + l_memcontrol.countlimit = cast(unsigned long, ~0L); else - l_memcontrol.countlimit = luaL_checkinteger(L, 1); + l_memcontrol.countlimit = cast(unsigned long, luaL_checkinteger(L, 1)); return 0; } @@ -934,57 +1018,90 @@ static int gc_printobj (lua_State *L) { } +static const char *const statenames[] = { + "propagate", "enteratomic", "atomic", "sweepallgc", "sweepfinobj", + "sweeptobefnz", "sweepend", "callfin", "pause", ""}; + static int gc_state (lua_State *L) { - static const char *statenames[] = { - "propagate", "atomic", "enteratomic", "sweepallgc", "sweepfinobj", - "sweeptobefnz", "sweepend", "callfin", "pause", ""}; static const int states[] = { GCSpropagate, GCSenteratomic, GCSatomic, GCSswpallgc, GCSswpfinobj, GCSswptobefnz, GCSswpend, GCScallfin, GCSpause, -1}; int option = states[luaL_checkoption(L, 1, "", statenames)]; + global_State *g = G(L); if (option == -1) { - lua_pushstring(L, statenames[G(L)->gcstate]); + lua_pushstring(L, statenames[g->gcstate]); return 1; } else { - global_State *g = G(L); - if (G(L)->gckind == KGC_GEN) + if (g->gckind != KGC_INC) luaL_error(L, "cannot change states in generational mode"); lua_lock(L); if (option < g->gcstate) { /* must cross 'pause'? */ - luaC_runtilstate(L, bitmask(GCSpause)); /* run until pause */ + luaC_runtilstate(L, GCSpause, 1); /* run until pause */ } - luaC_runtilstate(L, bitmask(option)); - lua_assert(G(L)->gcstate == option); + luaC_runtilstate(L, option, 0); /* do not skip propagation state */ + lua_assert(g->gcstate == option); lua_unlock(L); return 0; } } +static int tracinggc = 0; +void luai_tracegctest (lua_State *L, int first) { + if (!tracinggc) return; + else { + global_State *g = G(L); + lua_unlock(L); + g->gcstp = GCSTPGC; + lua_checkstack(L, 10); + lua_getfield(L, LUA_REGISTRYINDEX, "tracegc"); + lua_pushboolean(L, first); + lua_call(L, 1, 0); + g->gcstp = 0; + lua_lock(L); + } +} + + +static int tracegc (lua_State *L) { + if (lua_isnil(L, 1)) + tracinggc = 0; + else { + tracinggc = 1; + lua_setfield(L, LUA_REGISTRYINDEX, "tracegc"); + } + return 0; +} + + static int hash_query (lua_State *L) { if (lua_isnone(L, 2)) { + TString *ts; luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected"); - lua_pushinteger(L, tsvalue(obj_at(L, 1))->hash); + ts = tsvalue(obj_at(L, 1)); + if (ts->tt == LUA_VLNGSTR) + luaS_hashlongstr(ts); /* make sure long string has a hash */ + lua_pushinteger(L, cast_int(ts->hash)); } else { TValue *o = obj_at(L, 1); Table *t; luaL_checktype(L, 2, LUA_TTABLE); t = hvalue(obj_at(L, 2)); - lua_pushinteger(L, luaH_mainposition(t, o) - t->node); + lua_pushinteger(L, cast_Integer(luaH_mainposition(t, o) - t->node)); } return 1; } static int stacklevel (lua_State *L) { - unsigned long a = 0; - lua_pushinteger(L, (L->top.p - L->stack.p)); + int a = 0; + lua_pushinteger(L, cast_Integer(L->top.p - L->stack.p)); lua_pushinteger(L, stacksize(L)); - lua_pushinteger(L, L->nCcalls); + lua_pushinteger(L, cast_Integer(L->nCcalls)); lua_pushinteger(L, L->nci); - lua_pushinteger(L, (unsigned long)&a); + lua_pushinteger(L, (lua_Integer)(size_t)&a); return 5; } @@ -995,20 +1112,23 @@ static int table_query (lua_State *L) { unsigned int asize; luaL_checktype(L, 1, LUA_TTABLE); t = hvalue(obj_at(L, 1)); - asize = luaH_realasize(t); + asize = t->asize; if (i == -1) { - lua_pushinteger(L, asize); - lua_pushinteger(L, allocsizenode(t)); - lua_pushinteger(L, isdummy(t) ? 0 : t->lastfree - t->node); - lua_pushinteger(L, t->alimit); - return 4; + lua_pushinteger(L, cast_Integer(asize)); + lua_pushinteger(L, cast_Integer(allocsizenode(t))); + lua_pushinteger(L, cast_Integer(asize > 0 ? *lenhint(t) : 0)); + return 3; } - else if ((unsigned int)i < asize) { + else if (cast_uint(i) < asize) { lua_pushinteger(L, i); - pushobject(L, &t->array[i]); + if (!tagisempty(*getArrTag(t, i))) + arr2obj(t, cast_uint(i), s2v(L->top.p)); + else + setnilvalue(s2v(L->top.p)); + api_incr_top(L); lua_pushnil(L); } - else if ((i -= asize) < sizenode(t)) { + else if (cast_uint(i -= cast_int(asize)) < sizenode(t)) { TValue k; getnodekey(L, &k, gnode(t, i)); if (!isempty(gval(gnode(t, i))) || @@ -1018,16 +1138,45 @@ static int table_query (lua_State *L) { } else lua_pushliteral(L, ""); - pushobject(L, gval(gnode(t, i))); - if (gnext(&t->node[i]) != 0) - lua_pushinteger(L, gnext(&t->node[i])); + if (!isempty(gval(gnode(t, i)))) + pushobject(L, gval(gnode(t, i))); else lua_pushnil(L); + lua_pushinteger(L, gnext(&t->node[i])); } return 3; } +static int gc_query (lua_State *L) { + global_State *g = G(L); + lua_pushstring(L, g->gckind == KGC_INC ? "inc" + : g->gckind == KGC_GENMAJOR ? "genmajor" + : "genminor"); + lua_pushstring(L, statenames[g->gcstate]); + lua_pushinteger(L, cast_st2S(gettotalbytes(g))); + lua_pushinteger(L, cast_st2S(g->GCdebt)); + lua_pushinteger(L, cast_st2S(g->GCmarked)); + lua_pushinteger(L, cast_st2S(g->GCmajorminor)); + return 6; +} + + +static int test_codeparam (lua_State *L) { + lua_Integer p = luaL_checkinteger(L, 1); + lua_pushinteger(L, luaO_codeparam(cast_uint(p))); + return 1; +} + + +static int test_applyparam (lua_State *L) { + lua_Integer p = luaL_checkinteger(L, 1); + lua_Integer x = luaL_checkinteger(L, 2); + lua_pushinteger(L, cast_Integer(luaO_applyparam(cast_byte(p), x))); + return 1; +} + + static int string_query (lua_State *L) { stringtable *tb = &G(L)->strt; int s = cast_int(luaL_optinteger(L, 1, 0)) - 1; @@ -1050,27 +1199,39 @@ static int string_query (lua_State *L) { } +static int getreftable (lua_State *L) { + if (lua_istable(L, 2)) /* is there a table as second argument? */ + return 2; /* use it as the table */ + else + return LUA_REGISTRYINDEX; /* default is to use the register */ +} + + static int tref (lua_State *L) { + int t = getreftable(L); int level = lua_gettop(L); luaL_checkany(L, 1); lua_pushvalue(L, 1); - lua_pushinteger(L, luaL_ref(L, LUA_REGISTRYINDEX)); + lua_pushinteger(L, luaL_ref(L, t)); cast_void(level); /* to avoid warnings */ lua_assert(lua_gettop(L) == level+1); /* +1 for result */ return 1; } + static int getref (lua_State *L) { + int t = getreftable(L); int level = lua_gettop(L); - lua_rawgeti(L, LUA_REGISTRYINDEX, luaL_checkinteger(L, 1)); + lua_rawgeti(L, t, luaL_checkinteger(L, 1)); cast_void(level); /* to avoid warnings */ lua_assert(lua_gettop(L) == level+1); return 1; } static int unref (lua_State *L) { + int t = getreftable(L); int level = lua_gettop(L); - luaL_unref(L, LUA_REGISTRYINDEX, cast_int(luaL_checkinteger(L, 1))); + luaL_unref(L, t, cast_int(luaL_checkinteger(L, 1))); cast_void(level); /* to avoid warnings */ lua_assert(lua_gettop(L) == level); return 0; @@ -1096,7 +1257,7 @@ static int upvalue (lua_State *L) { static int newuserdata (lua_State *L) { size_t size = cast_sizet(luaL_optinteger(L, 1, 0)); - int nuv = luaL_optinteger(L, 2, 0); + int nuv = cast_int(luaL_optinteger(L, 2, 0)); char *p = cast_charp(lua_newuserdatauv(L, size, nuv)); while (size--) *p++ = '\0'; return 1; @@ -1111,7 +1272,7 @@ static int pushuserdata (lua_State *L) { static int udataval (lua_State *L) { - lua_pushinteger(L, cast(long, lua_touserdata(L, 1))); + lua_pushinteger(L, cast_st2S(cast_sizet(lua_touserdata(L, 1)))); return 1; } @@ -1147,10 +1308,16 @@ static int num2int (lua_State *L) { } +static int makeseed (lua_State *L) { + lua_pushinteger(L, cast_Integer(luaL_makeseed(L))); + return 1; +} + + static int newstate (lua_State *L) { void *ud; lua_Alloc f = lua_getallocf(L, &ud); - lua_State *L1 = lua_newstate(f, ud); + lua_State *L1 = lua_newstate(f, ud, 0); if (L1) { lua_atpanic(L1, tpanic); lua_pushlightuserdata(L, L1); @@ -1169,31 +1336,16 @@ static lua_State *getstate (lua_State *L) { static int loadlib (lua_State *L) { - static const luaL_Reg libs[] = { - {LUA_GNAME, luaopen_base}, - {"coroutine", luaopen_coroutine}, - {"debug", luaopen_debug}, - {"io", luaopen_io}, - {"os", luaopen_os}, - {"math", luaopen_math}, - {"string", luaopen_string}, - {"table", luaopen_table}, - {"T", luaB_opentests}, - {NULL, NULL} - }; lua_State *L1 = getstate(L); - int i; - luaL_requiref(L1, "package", luaopen_package, 0); + int load = cast_int(luaL_checkinteger(L, 2)); + int preload = cast_int(luaL_checkinteger(L, 3)); + luaL_openselectedlibs(L1, load, preload); + luaL_requiref(L1, "T", luaB_opentests, 0); lua_assert(lua_type(L1, -1) == LUA_TTABLE); /* 'requiref' should not reload module already loaded... */ - luaL_requiref(L1, "package", NULL, 1); /* seg. fault if it reloads */ + luaL_requiref(L1, "T", NULL, 1); /* seg. fault if it reloads */ /* ...but should return the same module */ lua_assert(lua_compare(L1, -1, -2, LUA_OPEQ)); - luaL_getsubtable(L1, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE); - for (i = 0; libs[i].name; i++) { - lua_pushcfunction(L1, libs[i].func); - lua_setfield(L1, -2, libs[i].name); - } return 0; } @@ -1259,9 +1411,9 @@ static int checkpanic (lua_State *L) { lua_Alloc f = lua_getallocf(L, &ud); b.paniccode = luaL_optstring(L, 2, ""); b.L = L; - L1 = lua_newstate(f, ud); /* create new state */ + L1 = lua_newstate(f, ud, 0); /* create new state */ if (L1 == NULL) { /* error? */ - lua_pushnil(L); + lua_pushstring(L, MEMERRMSG); return 1; } lua_atpanic(L1, panicback); /* set its panic function */ @@ -1280,6 +1432,37 @@ static int checkpanic (lua_State *L) { } +static int externKstr (lua_State *L) { + size_t len; + const char *s = luaL_checklstring(L, 1, &len); + lua_pushexternalstring(L, s, len, NULL, NULL); + return 1; +} + + +/* +** Create a buffer with the content of a given string and then +** create an external string using that buffer. Use the allocation +** function from Lua to create and free the buffer. +*/ +static int externstr (lua_State *L) { + size_t len; + const char *s = luaL_checklstring(L, 1, &len); + void *ud; + lua_Alloc allocf = lua_getallocf(L, &ud); /* get allocation function */ + /* create the buffer */ + char *buff = cast_charp((*allocf)(ud, NULL, 0, len + 1)); + if (buff == NULL) { /* memory error? */ + lua_pushliteral(L, "not enough memory"); + lua_error(L); /* raise a memory error */ + } + /* copy string content to buffer, including ending 0 */ + memcpy(buff, s, (len + 1) * sizeof(char)); + /* create external string */ + lua_pushexternalstring(L, buff, len, allocf, ud); + return 1; +} + /* ** {==================================================================== @@ -1318,6 +1501,16 @@ static int getnum_aux (lua_State *L, lua_State *L1, const char **pc) { (*pc)++; return res; } + else if (**pc == '!') { + (*pc)++; + if (**pc == 'G') + res = LUA_RIDX_GLOBALS; + else if (**pc == 'M') + res = LUA_RIDX_MAINTHREAD; + else lua_assert(0); + (*pc)++; + return res; + } else if (**pc == '-') { sig = -1; (*pc)++; @@ -1352,15 +1545,20 @@ static int getindex_aux (lua_State *L, lua_State *L1, const char **pc) { skip(pc); switch (*(*pc)++) { case 'R': return LUA_REGISTRYINDEX; - case 'G': return luaL_error(L, "deprecated index 'G'"); case 'U': return lua_upvalueindex(getnum_aux(L, L1, pc)); - default: (*pc)--; return getnum_aux(L, L1, pc); + default: { + int n; + (*pc)--; /* to read again */ + n = getnum_aux(L, L1, pc); + if (n == 0) return 0; + else return lua_absindex(L1, n); + } } } static const char *const statcodes[] = {"OK", "YIELD", "ERRRUN", - "ERRSYNTAX", MEMERRMSG, "ERRGCMM", "ERRERR"}; + "ERRSYNTAX", MEMERRMSG, "ERRERR"}; /* ** Avoid these stat codes from being collected, to avoid possible @@ -1403,17 +1601,17 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { const char *inst = getstring; if EQ("") return 0; else if EQ("absindex") { - lua_pushnumber(L1, lua_absindex(L1, getindex)); + lua_pushinteger(L1, getindex); } else if EQ("append") { int t = getindex; - int i = lua_rawlen(L1, t); + int i = cast_int(lua_rawlen(L1, t)); lua_rawseti(L1, t, i + 1); } else if EQ("arith") { int op; skip(&pc); - op = strchr(ops, *pc++) - ops; + op = cast_int(strchr(ops, *pc++) - ops); lua_arith(L1, op); } else if EQ("call") { @@ -1455,11 +1653,12 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { } else if EQ("func2num") { lua_CFunction func = lua_tocfunction(L1, getindex); - lua_pushnumber(L1, cast_sizet(func)); + lua_pushinteger(L1, cast_st2S(cast_sizet(func))); } else if EQ("getfield") { int t = getindex; - lua_getfield(L1, t, getstring); + int tp = lua_getfield(L1, t, getstring); + lua_assert(tp == lua_type(L1, -1)); } else if EQ("getglobal") { lua_getglobal(L1, getstring); @@ -1469,7 +1668,8 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { lua_pushnil(L1); } else if EQ("gettable") { - lua_gettable(L1, getindex); + int tp = lua_gettable(L1, getindex); + lua_assert(tp == lua_type(L1, -1)); } else if EQ("gettop") { lua_pushinteger(L1, lua_gettop(L1)); @@ -1520,8 +1720,11 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { luaL_loadfile(L1, luaL_checkstring(L1, getnum)); } else if EQ("loadstring") { - const char *s = luaL_checkstring(L1, getnum); - luaL_loadstring(L1, s); + size_t slen; + const char *s = luaL_checklstring(L1, getnum, &slen); + const char *name = getstring; + const char *mode = getstring; + luaL_loadbufferx(L1, s, slen, name, mode); } else if EQ("newmetatable") { lua_pushboolean(L1, luaL_newmetatable(L1, getstring)); @@ -1533,16 +1736,16 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { lua_newthread(L1); } else if EQ("resetthread") { - lua_pushinteger(L1, lua_resetthread(L1, L)); + lua_pushinteger(L1, lua_resetthread(L1)); /* deprecated */ } else if EQ("newuserdata") { - lua_newuserdata(L1, getnum); + lua_newuserdata(L1, cast_sizet(getnum)); } else if EQ("next") { lua_next(L1, -2); } else if EQ("objsize") { - lua_pushinteger(L1, lua_rawlen(L1, getindex)); + lua_pushinteger(L1, l_castU2S(lua_rawlen(L1, getindex))); } else if EQ("pcall") { int narg = getnum; @@ -1561,10 +1764,10 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { else if EQ("printstack") { int n = getnum; if (n != 0) { - printf("%s\n", luaL_tolstring(L1, n, NULL)); - lua_pop(L1, 1); + lua_printvalue(s2v(L->ci->func.p + n)); + printf("\n"); } - else printstack(L1); + else lua_printstack(L1); } else if EQ("print") { const char *msg = getstring; @@ -1649,6 +1852,17 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) { int nres; status = lua_resume(lua_tothread(L1, i), L, getnum, &nres); } + else if EQ("traceback") { + const char *msg = getstring; + int level = getnum; + luaL_traceback(L1, L1, msg, level); + } + else if EQ("threadstatus") { + lua_pushstring(L1, statcodes[lua_status(L1)]); + } + else if EQ("alloccount") { + l_memcontrol.countlimit = cast_uint(getnum); + } else if EQ("return") { int n = getnum; if (L1 != L) { @@ -1775,6 +1989,10 @@ static struct X { int x; } x; else if EQ("closeslot") { lua_closeslot(L1, getnum); } + else if EQ("argerror") { + int arg = getnum; + luaL_argerror(L1, arg, getstring); + } else luaL_error(L, "unknown instruction %s", buff); } return 0; @@ -1808,9 +2026,9 @@ static int Cfunc (lua_State *L) { static int Cfunck (lua_State *L, int status, lua_KContext ctx) { lua_pushstring(L, statcodes[status]); lua_setglobal(L, "status"); - lua_pushinteger(L, ctx); + lua_pushinteger(L, cast_Integer(ctx)); lua_setglobal(L, "ctx"); - return runC(L, L, lua_tostring(L, ctx)); + return runC(L, L, lua_tostring(L, cast_int(ctx))); } @@ -1903,6 +2121,25 @@ static int coresume (lua_State *L) { } } +#if !defined(LUA_USE_POSIX) + +#define nonblock NULL + +#else + +#include +#include + +static int nonblock (lua_State *L) { + FILE *f = cast(luaL_Stream*, luaL_checkudata(L, 1, LUA_FILEHANDLE))->f; + int fd = fileno(f); + int flags = fcntl(fd, F_GETFL, 0); + flags |= O_NONBLOCK; + fcntl(fd, F_SETFL, flags); + return 0; +} +#endif + /* }====================================================== */ @@ -1916,6 +2153,7 @@ static const struct luaL_Reg tests_funcs[] = { {"gccolor", gc_color}, {"gcage", gc_age}, {"gcstate", gc_state}, + {"tracegc", tracegc}, {"pobj", gc_printobj}, {"getref", getref}, {"hash", hash_query}, @@ -1923,6 +2161,7 @@ static const struct luaL_Reg tests_funcs[] = { {"limits", get_limits}, {"listcode", listcode}, {"printcode", printcode}, + {"printallstack", lua_printallstack}, {"listk", listk}, {"listabslineinfo", listabslineinfo}, {"listlocals", listlocals}, @@ -1931,14 +2170,19 @@ static const struct luaL_Reg tests_funcs[] = { {"newstate", newstate}, {"newuserdata", newuserdata}, {"num2int", num2int}, + {"makeseed", makeseed}, {"pushuserdata", pushuserdata}, + {"gcquery", gc_query}, {"querystr", string_query}, {"querytab", table_query}, + {"codeparam", test_codeparam}, + {"applyparam", test_applyparam}, {"ref", tref}, {"resume", coresume}, {"s2d", s2d}, {"sethook", sethook}, {"stacklevel", stacklevel}, + {"sizes", get_sizes}, {"testC", testC}, {"makeCfunc", makeCfunc}, {"totalmem", mem_query}, @@ -1948,6 +2192,9 @@ static const struct luaL_Reg tests_funcs[] = { {"udataval", udataval}, {"unref", unref}, {"upvalue", upvalue}, + {"externKstr", externKstr}, + {"externstr", externstr}, + {"nonblock", nonblock}, {NULL, NULL} }; diff --git a/ltests.h b/ltests.h index ec520498bd..93096da810 100644 --- a/ltests.h +++ b/ltests.h @@ -13,7 +13,7 @@ /* test Lua with compatibility code */ #define LUA_COMPAT_MATHLIB -#define LUA_COMPAT_LT_LE +#undef LUA_COMPAT_GLOBAL #define LUA_DEBUG @@ -44,6 +44,10 @@ #define LUA_RAND32 +/* test stack reallocation without strict address use */ +#define LUAI_STRICT_ADDRESS 0 + + /* memory-allocator control variables */ typedef struct Memcontrol { int failnext; @@ -58,23 +62,39 @@ typedef struct Memcontrol { LUA_API Memcontrol l_memcontrol; +#define luai_tracegc(L,f) luai_tracegctest(L, f) +extern void luai_tracegctest (lua_State *L, int first); + + /* ** generic variable for debug tricks */ extern void *l_Trick; - /* ** Function to traverse and check all memory used by Lua */ -LUAI_FUNC int lua_checkmemory (lua_State *L); +extern int lua_checkmemory (lua_State *L); /* ** Function to print an object GC-friendly */ struct GCObject; -LUAI_FUNC void lua_printobj (lua_State *L, struct GCObject *o); +extern void lua_printobj (lua_State *L, struct GCObject *o); + + +/* +** Function to print a value +*/ +struct TValue; +extern void lua_printvalue (struct TValue *v); + +/* +** Function to print the stack +*/ +extern void lua_printstack (lua_State *L); +extern int lua_printallstack (lua_State *L); /* test for lock/unlock */ @@ -101,13 +121,14 @@ LUA_API int luaB_opentests (lua_State *L); LUA_API void *debug_realloc (void *ud, void *block, size_t osize, size_t nsize); -#if defined(lua_c) -#define luaL_newstate() lua_newstate(debug_realloc, &l_memcontrol) -#define luaL_openlibs(L) \ - { (luaL_openlibs)(L); \ + +#define luaL_newstate() \ + lua_newstate(debug_realloc, &l_memcontrol, luaL_makeseed(NULL)) +#define luai_openlibs(L) \ + { luaL_openlibs(L); \ luaL_requiref(L, "T", luaB_opentests, 1); \ lua_pop(L, 1); } -#endif + @@ -121,20 +142,14 @@ LUA_API void *debug_realloc (void *ud, void *block, #define STRCACHE_N 23 #define STRCACHE_M 5 -#undef LUAI_USER_ALIGNMENT_T -#define LUAI_USER_ALIGNMENT_T union { char b[sizeof(void*) * 8]; } +#define MAXINDEXRK 1 /* -** This one is not compatible with tests for opcode optimizations, -** as it blocks some optimizations -#define MAXINDEXRK 0 +** Reduce maximum stack size to make stack-overflow tests run faster. +** (But value is still large enough to overflow smaller integers.) */ - - -/* make stack-overflow tests run faster */ -#undef LUAI_MAXSTACK -#define LUAI_MAXSTACK 50000 +#define LUAI_MAXSTACK 68000 /* test mode uses more stack space */ diff --git a/ltm.c b/ltm.c index 07a060811d..8d64235e81 100644 --- a/ltm.c +++ b/ltm.c @@ -58,7 +58,7 @@ void luaT_init (lua_State *L) { ** tag methods */ const TValue *luaT_gettm (Table *events, TMS event, TString *ename) { - const TValue *tm = luaH_getshortstr(events, ename); + const TValue *tm = luaH_Hgetshortstr(events, ename); lua_assert(event <= TM_EQ); if (notm(tm)) { /* no tag method? */ events->flags |= cast_byte(1u<mt[ttype(o)]; } - return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue); + return (mt ? luaH_Hgetshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue); } @@ -92,7 +92,7 @@ const char *luaT_objtypename (lua_State *L, const TValue *o) { Table *mt; if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) || (ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) { - const TValue *name = luaH_getshortstr(mt, luaS_new(L, "__name")); + const TValue *name = luaH_Hgetshortstr(mt, luaS_new(L, "__name")); if (ttisstring(name)) /* is '__name' a string? */ return getstr(tsvalue(name)); /* use it as type name */ } @@ -116,8 +116,8 @@ void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1, } -void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1, - const TValue *p2, StkId res) { +lu_byte 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.p; setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */ @@ -131,6 +131,7 @@ void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1, luaD_callnoyield(L, func, 1); res = restorestack(L, result); setobjs2s(L, res, --L->top.p); /* move result to its place */ + return ttypetag(s2v(res)); /* return tag of the result */ } @@ -139,15 +140,16 @@ static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2, const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ if (notm(tm)) tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ - if (notm(tm)) return 0; - luaT_callTMres(L, tm, p1, p2, res); - return 1; + if (notm(tm)) + return -1; /* tag method not found */ + else /* call tag method and return the tag of the result */ + return luaT_callTMres(L, tm, p1, p2, res); } void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2, StkId res, TMS event) { - if (l_unlikely(!callbinTM(L, p1, p2, res, event))) { + if (l_unlikely(callbinTM(L, p1, p2, res, event) < 0)) { switch (event) { case TM_BAND: case TM_BOR: case TM_BXOR: case TM_SHL: case TM_SHR: case TM_BNOT: { @@ -164,11 +166,14 @@ void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2, } +/* +** The use of 'p1' after 'callbinTM' is safe because, when a tag +** method is not found, 'callbinTM' cannot change the stack. +*/ void luaT_tryconcatTM (lua_State *L) { - StkId top = L->top.p; - if (l_unlikely(!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2, - TM_CONCAT))) - luaG_concaterror(L, s2v(top - 2), s2v(top - 1)); + StkId p1 = L->top.p - 2; /* first argument */ + if (l_unlikely(callbinTM(L, s2v(p1), s2v(p1 + 1), p1, TM_CONCAT) < 0)) + luaG_concaterror(L, s2v(p1), s2v(p1 + 1)); } @@ -191,28 +196,12 @@ void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2, /* ** 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 rtop.p, event)) /* try original event */ - return !l_isfalse(s2v(L->top.p)); -#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.p, TM_LT)) { - L->ci->callstatus ^= CIST_LEQ; /* clear mark */ - return l_isfalse(s2v(L->top.p)); - } - /* else error will remove this 'ci'; no need to clear mark */ - } -#endif + int tag = callbinTM(L, p1, p2, L->top.p, event); /* try original event */ + if (tag >= 0) /* found tag method? */ + return !tagisfalse(tag); luaG_ordererror(L, p1, p2); /* no metamethod found */ return 0; /* to avoid warnings */ } @@ -235,11 +224,38 @@ int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2, } -void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci, - const Proto *p) { +/* +** Create a vararg table at the top of the stack, with 'n' elements +** starting at 'f'. +*/ +static void createvarargtab (lua_State *L, StkId f, int n) { + int i; + TValue key, value; + Table *t = luaH_new(L); + sethvalue(L, s2v(L->top.p), t); + L->top.p++; + luaH_resize(L, t, cast_uint(n), 1); + setsvalue(L, &key, luaS_new(L, "n")); /* key is "n" */ + setivalue(&value, n); /* value is n */ + /* No need to anchor the key: Due to the resize, the next operation + cannot trigger a garbage collection */ + luaH_set(L, t, &key, &value); /* t.n = n */ + for (i = 0; i < n; i++) + luaH_setint(L, t, i + 1, s2v(f + i)); +} + + +/* +** initial stack: func arg1 ... argn extra1 ... +** ^ ci->func ^ L->top +** final stack: func nil ... nil extra1 ... func arg1 ... argn +** ^ ci->func ^ L->top +*/ +void luaT_adjustvarargs (lua_State *L, CallInfo *ci, const Proto *p) { int i; - int actual = cast_int(L->top.p - ci->func.p) - 1; /* number of arguments */ - int nextra = actual - nfixparams; /* number of extra arguments */ + int totalargs = cast_int(L->top.p - ci->func.p) - 1; + int nfixparams = p->numparams; + int nextra = totalargs - nfixparams; /* number of extra arguments */ ci->u.l.nextraargs = nextra; luaD_checkstack(L, p->maxstacksize + 1); /* copy function to the top of the stack */ @@ -249,18 +265,46 @@ void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci, setobjs2s(L, L->top.p++, ci->func.p + i); setnilvalue(s2v(ci->func.p + i)); /* erase original parameter (for GC) */ } - ci->func.p += actual + 1; - ci->top.p += actual + 1; + if (p->flag & PF_VAVAR) { /* is there a vararg parameter? */ + if (p->flag & PF_VATAB) /* does it need a vararg table? */ + createvarargtab(L, ci->func.p + nfixparams + 1, nextra); + else /* no table; set parameter to nil */ + setnilvalue(s2v(L->top.p)); + } + ci->func.p += totalargs + 1; + ci->top.p += totalargs + 1; lua_assert(L->top.p <= ci->top.p && ci->top.p <= L->stack_last.p); } +void luaT_getvararg (CallInfo *ci, StkId ra, TValue *rc) { + int nextra = ci->u.l.nextraargs; + lua_Integer n; + if (tointegerns(rc, &n)) { /* integral value? */ + if (l_castS2U(n) - 1 < cast_uint(nextra)) { + StkId slot = ci->func.p - nextra + cast_int(n) - 1; + setobjs2s(((lua_State*)NULL), ra, slot); + return; + } + } + else if (ttisstring(rc)) { /* string value? */ + size_t len; + const char *s = getlstr(tsvalue(rc), len); + if (len == 1 && s[0] == 'n') { /* key is "n"? */ + setivalue(s2v(ra), nextra); + return; + } + } + setnilvalue(s2v(ra)); /* else produce nil */ +} + + 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 */ - checkstackGCp(L, nextra, where); /* ensure stack space */ + checkstackp(L, nextra, where); /* ensure stack space */ L->top.p = where + nextra; /* next instruction will need top */ } for (i = 0; i < wanted && i < nextra; i++) diff --git a/ltm.h b/ltm.h index c309e2ae10..86f457ebce 100644 --- a/ltm.h +++ b/ltm.h @@ -9,7 +9,6 @@ #include "lobject.h" -#include "lstate.h" /* @@ -49,10 +48,10 @@ typedef enum { /* ** Mask with 1 in all fast-access methods. A 1 in any of these bits ** in the flag of a (meta)table means the metatable does not have the -** corresponding metamethod field. (Bit 7 of the flag is used for -** 'isrealasize'.) +** corresponding metamethod field. (Bit 6 of the flag indicates that +** the table is using the dummy node; bit 7 is used for 'isrealasize'.) */ -#define maskflags (~(~0u << (TM_EQ + 1))) +#define maskflags cast_byte(~(~0u << (TM_EQ + 1))) /* @@ -61,11 +60,12 @@ typedef enum { */ #define notm(tm) ttisnil(tm) +#define checknoTM(mt,e) ((mt) == NULL || (mt)->flags & (1u<<(e))) -#define gfasttm(g,et,e) ((et) == NULL ? NULL : \ - ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e])) +#define gfasttm(g,mt,e) \ + (checknoTM(mt, e) ? NULL : luaT_gettm(mt, e, (g)->tmname[e])) -#define fasttm(l,et,e) gfasttm(G(l), et, e) +#define fasttm(l,mt,e) gfasttm(G(l), mt, e) #define ttypename(x) luaT_typenames_[(x) + 1] @@ -81,8 +81,8 @@ 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, const TValue *p3); -LUAI_FUNC void luaT_callTMres (lua_State *L, const TValue *f, - const TValue *p1, const TValue *p2, StkId p3); +LUAI_FUNC lu_byte 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); @@ -95,9 +95,10 @@ LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1, 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, - CallInfo *ci, const Proto *p); -LUAI_FUNC void luaT_getvarargs (lua_State *L, CallInfo *ci, +LUAI_FUNC void luaT_adjustvarargs (lua_State *L, struct CallInfo *ci, + const Proto *p); +LUAI_FUNC void luaT_getvararg (CallInfo *ci, StkId ra, TValue *rc); +LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci, StkId where, int wanted); diff --git a/lua.c b/lua.c index 715430a0de..b2967a447d 100644 --- a/lua.c +++ b/lua.c @@ -19,6 +19,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" #if !defined(LUA_PROGNAME) @@ -115,12 +116,13 @@ static void l_message (const char *pname, const char *msg) { /* ** Check whether 'status' is not OK and, if so, prints the error -** message on the top of the stack. It assumes that the error object -** is a string, as it was either generated by Lua or by 'msghandler'. +** message on the top of the stack. */ static int report (lua_State *L, int status) { if (status != LUA_OK) { const char *msg = lua_tostring(L, -1); + if (msg == NULL) + msg = "(error message not a string)"; l_message(progname, msg); lua_pop(L, 1); /* remove message */ } @@ -210,12 +212,17 @@ static int dostring (lua_State *L, const char *s, const char *name) { /* ** Receives 'globname[=modname]' and runs 'globname = require(modname)'. +** If there is no explicit modname and globname contains a '-', cut +** the suffix after '-' (the "version") to make the global name. */ static int dolibrary (lua_State *L, char *globname) { int status; + char *suffix = NULL; char *modname = strchr(globname, '='); - if (modname == NULL) /* no explicit name? */ + if (modname == NULL) { /* no explicit name? */ modname = globname; /* module name is equal to global name */ + suffix = strchr(modname, *LUA_IGMARK); /* look for a suffix mark */ + } else { *modname = '\0'; /* global name ends here */ modname++; /* module name starts after the '=' */ @@ -223,8 +230,11 @@ static int dolibrary (lua_State *L, char *globname) { lua_getglobal(L, "require"); lua_pushstring(L, modname); status = docall(L, 1, 1); /* call 'require(modname)' */ - if (status == LUA_OK) + if (status == LUA_OK) { + if (suffix != NULL) /* is there a suffix mark? */ + *suffix = '\0'; /* remove suffix from global name */ lua_setglobal(L, globname); /* globname = require(modname) */ + } return report(L, status); } @@ -293,7 +303,8 @@ static int collectargs (char **argv, int *first) { case '-': /* '--' */ if (argv[i][2] != '\0') /* extra characters after '--'? */ return has_error; /* invalid option */ - *first = i + 1; + /* if there is a script name, it comes after '--' */ + *first = (argv[i + 1] != NULL) ? i + 1 : 0; return args; case '\0': /* '-' */ return args; /* script "name" is '-' */ @@ -422,30 +433,91 @@ static int handle_luainit (lua_State *L) { /* -** 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. +** * lua_initreadline initializes the readline system. +** * 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) /* { */ +/* Otherwise, all previously listed functions should be defined. */ #if defined(LUA_USE_READLINE) /* { */ +/* Lua will be linked with '-lreadline' */ #include #include + #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)) +#define lua_readline(buff,prompt) ((void)buff, readline(prompt)) +#define lua_saveline(line) add_history(line) +#define lua_freeline(line) free(line) + +#else /* }{ */ +/* use dynamically loaded readline (or nothing) */ + +/* pointer to 'readline' function (if any) */ +typedef char *(*l_readlineT) (const char *prompt); +static l_readlineT l_readline = NULL; + +/* pointer to 'add_history' function (if any) */ +typedef void (*l_addhistT) (const char *string); +static l_addhistT l_addhist = NULL; + + +static char *lua_readline (char *buff, const char *prompt) { + if (l_readline != NULL) /* is there a 'readline'? */ + return (*l_readline)(prompt); /* use it */ + else { /* emulate 'readline' over 'buff' */ + fputs(prompt, stdout); + fflush(stdout); /* show prompt */ + return fgets(buff, LUA_MAXINPUT, stdin); /* read line */ + } +} + + +static void lua_saveline (const char *line) { + if (l_addhist != NULL) /* is there an 'add_history'? */ + (*l_addhist)(line); /* use it */ + /* else nothing to be done */ +} + + +static void lua_freeline (char *line) { + if (l_readline != NULL) /* is there a 'readline'? */ + free(line); /* free line created by it */ + /* else 'lua_readline' used an automatic buffer; nothing to free */ +} -#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; } +#if defined(LUA_USE_DLOPEN) && defined(LUA_READLINELIB) /* { */ +/* try to load 'readline' dynamically */ + +#include + +static void lua_initreadline (lua_State *L) { + void *lib = dlopen(LUA_READLINELIB, RTLD_NOW | RTLD_LOCAL); + if (lib == NULL) + lua_warning(L, "library '" LUA_READLINELIB "' not found", 0); + else { + const char **name = cast(const char**, dlsym(lib, "rl_readline_name")); + if (name != NULL) + *name = "lua"; + l_readline = cast(l_readlineT, cast_func(dlsym(lib, "readline"))); + l_addhist = cast(l_addhistT, cast_func(dlsym(lib, "add_history"))); + if (l_readline == NULL) + lua_warning(L, "unable to load 'readline'", 0); + } +} + +#else /* }{ */ +/* no dlopen or LUA_READLINELIB undefined */ + +/* Leave pointers with NULL */ +#define lua_initreadline(L) ((void)L) + +#endif /* } */ #endif /* } */ @@ -481,10 +553,8 @@ static int incomplete (lua_State *L, int status) { if (status == LUA_ERRSYNTAX) { size_t lmsg; const char *msg = lua_tolstring(L, -1, &lmsg); - if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0) { - lua_pop(L, 1); + if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0) return 1; - } } return 0; /* else... */ } @@ -495,21 +565,17 @@ static int incomplete (lua_State *L, int status) { */ static int pushline (lua_State *L, int firstline) { char buffer[LUA_MAXINPUT]; - char *b = buffer; size_t l; const char *prmt = get_prompt(L, firstline); - int readstatus = lua_readline(L, b, prmt); - if (readstatus == 0) - return 0; /* no input (prompt will be popped by caller) */ + char *b = lua_readline(buffer, prmt); lua_pop(L, 1); /* remove prompt */ + if (b == NULL) + return 0; /* no input */ l = strlen(b); if (l > 0 && b[l-1] == '\n') /* line ends with newline? */ b[--l] = '\0'; /* remove it */ - if (firstline && b[0] == '=') /* for compatibility with 5.2, ... */ - lua_pushfstring(L, "return %s", b + 1); /* change '=' to 'return' */ - else - lua_pushlstring(L, b, l); - lua_freeline(L, b); + lua_pushlstring(L, b, l); + lua_freeline(b); return 1; } @@ -522,32 +588,44 @@ static int addreturn (lua_State *L) { const char *line = lua_tostring(L, -1); /* original line */ const char *retline = lua_pushfstring(L, "return %s;", line); int status = luaL_loadbuffer(L, retline, strlen(retline), "=stdin"); - if (status == LUA_OK) { + if (status == LUA_OK) lua_remove(L, -2); /* remove modified line */ - if (line[0] != '\0') /* non empty? */ - lua_saveline(L, line); /* keep history */ - } else lua_pop(L, 2); /* pop result from 'luaL_loadbuffer' and modified line */ return status; } +static void checklocal (const char *line) { + static const size_t szloc = sizeof("local") - 1; + static const char space[] = " \t"; + line += strspn(line, space); /* skip spaces */ + if (strncmp(line, "local", szloc) == 0 && /* "local"? */ + strchr(space, *(line + szloc)) != NULL) { /* followed by a space? */ + lua_writestringerror("%s\n", + "warning: locals do not survive across lines in interactive mode"); + } +} + + /* -** Read multiple lines until a complete Lua statement +** Read multiple lines until a complete Lua statement or an error not +** for an incomplete statement. Start with first line already read in +** the stack. */ static int multiline (lua_State *L) { + size_t len; + const char *line = lua_tolstring(L, 1, &len); /* get first line */ + checklocal(line); for (;;) { /* repeat until gets a complete statement */ - size_t len; - const char *line = lua_tolstring(L, 1, &len); /* get what it has */ int status = luaL_loadbuffer(L, line, len, "=stdin"); /* try it */ - if (!incomplete(L, status) || !pushline(L, 0)) { - lua_saveline(L, line); /* keep history */ - return status; /* cannot or should not try to add continuation line */ - } + if (!incomplete(L, status) || !pushline(L, 0)) + return status; /* should not or cannot try to add continuation line */ + lua_remove(L, -2); /* remove error message (from incomplete line) */ lua_pushliteral(L, "\n"); /* add newline... */ lua_insert(L, -2); /* ...between the two lines */ lua_concat(L, 3); /* join them */ + line = lua_tolstring(L, 1, &len); /* get what is has */ } } @@ -559,12 +637,16 @@ static int multiline (lua_State *L) { ** in the top of the stack. */ static int loadline (lua_State *L) { + const char *line; int status; lua_settop(L, 0); if (!pushline(L, 1)) return -1; /* no input */ if ((status = addreturn(L)) != LUA_OK) /* 'return ...' did not work? */ status = multiline(L); /* try as command, maybe with continuation lines */ + line = lua_tostring(L, 1); + if (line[0] != '\0') /* non empty? */ + lua_saveline(line); /* keep history */ lua_remove(L, 1); /* remove line from the stack */ lua_assert(lua_gettop(L) == 1); return status; @@ -609,6 +691,10 @@ static void doREPL (lua_State *L) { /* }================================================================== */ +#if !defined(luai_openlibs) +#define luai_openlibs(L) luaL_openselectedlibs(L, ~0, 0) +#endif + /* ** Main body of stand-alone interpreter (to be called in protected mode). @@ -631,10 +717,10 @@ static int pmain (lua_State *L) { lua_pushboolean(L, 1); /* signal for libraries to ignore env. vars. */ lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); } - luaL_openlibs(L); /* open standard libraries */ + luai_openlibs(L); /* open standard libraries */ createargtable(L, argv, argc, script); /* create table 'arg' */ lua_gc(L, LUA_GCRESTART); /* start GC... */ - lua_gc(L, LUA_GCGEN, 0, 0); /* ...in generational mode */ + lua_gc(L, LUA_GCGEN); /* ...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 */ @@ -666,7 +752,7 @@ int main (int argc, char **argv) { l_message(argv[0], "cannot create state: not enough memory"); return EXIT_FAILURE; } - lua_gc(L, LUA_GCSTOP); /* stop GC while buidling state */ + lua_gc(L, LUA_GCSTOP); /* stop GC while building state */ lua_pushcfunction(L, &pmain); /* to call 'pmain' in protected mode */ lua_pushinteger(L, argc); /* 1st argument */ lua_pushlightuserdata(L, argv); /* 2nd argument */ diff --git a/lua.h b/lua.h index feb3dbc556..ab473dc3e4 100644 --- a/lua.h +++ b/lua.h @@ -1,7 +1,7 @@ /* ** $Id: lua.h $ ** Lua - A Scripting Language -** Lua.org, PUC-Rio, Brazil (http://www.lua.org) +** Lua.org, PUC-Rio, Brazil (www.lua.org) ** See Copyright Notice at the end of this file */ @@ -13,20 +13,19 @@ #include -#include "luaconf.h" +#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2025 Lua.org, PUC-Rio" +#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes" -#define LUA_VERSION_MAJOR "5" -#define LUA_VERSION_MINOR "4" -#define LUA_VERSION_RELEASE "5" +#define LUA_VERSION_MAJOR_N 5 +#define LUA_VERSION_MINOR_N 5 +#define LUA_VERSION_RELEASE_N 0 -#define LUA_VERSION_NUM 504 -#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + 5) +#define LUA_VERSION_NUM (LUA_VERSION_MAJOR_N * 100 + LUA_VERSION_MINOR_N) +#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + LUA_VERSION_RELEASE_N) -#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-2022 Lua.org, PUC-Rio" -#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes" + +#include "luaconf.h" /* mark for precompiled code ('Lua') */ @@ -38,10 +37,10 @@ /* ** Pseudo-indices -** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty -** space after that to help overflow detection) +** (The stack size is limited to INT_MAX/2; we keep some free empty +** space after that to help overflow detection.) */ -#define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000) +#define LUA_REGISTRYINDEX (-(INT_MAX/2 + 1000)) #define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i)) @@ -81,9 +80,10 @@ typedef struct lua_State lua_State; /* predefined values in the registry */ -#define LUA_RIDX_MAINTHREAD 1 +/* index 1 is reserved for the reference mechanism */ #define LUA_RIDX_GLOBALS 2 -#define LUA_RIDX_LAST LUA_RIDX_GLOBALS +#define LUA_RIDX_MAINTHREAD 3 +#define LUA_RIDX_LAST 3 /* type of numbers in Lua */ @@ -160,10 +160,10 @@ extern const char lua_ident[]; /* ** state manipulation */ -LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); +LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud, unsigned seed); 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_State *from); +LUA_API int (lua_closethread) (lua_State *L, lua_State *from); LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); @@ -244,6 +244,8 @@ LUA_API void (lua_pushnil) (lua_State *L); LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len); +LUA_API const char *(lua_pushexternalstring) (lua_State *L, + const char *s, size_t len, lua_Alloc falloc, void *ud); LUA_API const char *(lua_pushstring) (lua_State *L, const char *s); LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, va_list argp); @@ -323,7 +325,7 @@ LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont); /* -** garbage-collection function and options +** garbage-collection options */ #define LUA_GCSTOP 0 @@ -332,11 +334,28 @@ LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont); #define LUA_GCCOUNT 3 #define LUA_GCCOUNTB 4 #define LUA_GCSTEP 5 -#define LUA_GCSETPAUSE 6 -#define LUA_GCSETSTEPMUL 7 -#define LUA_GCISRUNNING 9 -#define LUA_GCGEN 10 -#define LUA_GCINC 11 +#define LUA_GCISRUNNING 6 +#define LUA_GCGEN 7 +#define LUA_GCINC 8 +#define LUA_GCPARAM 9 + + +/* +** garbage-collection parameters +*/ +/* parameters for generational mode */ +#define LUA_GCPMINORMUL 0 /* control minor collections */ +#define LUA_GCPMAJORMINOR 1 /* control shift major->minor */ +#define LUA_GCPMINORMAJOR 2 /* control shift minor->major */ + +/* parameters for incremental mode */ +#define LUA_GCPPAUSE 3 /* size of pause between successive GCs */ +#define LUA_GCPSTEPMUL 4 /* GC "speed" */ +#define LUA_GCPSTEPSIZE 5 /* GC granularity */ + +/* number of parameters */ +#define LUA_GCPN 6 + LUA_API int (lua_gc) (lua_State *L, int what, ...); @@ -352,7 +371,9 @@ LUA_API int (lua_next) (lua_State *L, int idx); LUA_API void (lua_concat) (lua_State *L, int n); LUA_API void (lua_len) (lua_State *L, int idx); -LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s); +#define LUA_N2SBUFFSZ 64 +LUA_API unsigned (lua_numbertocstring) (lua_State *L, int idx, char *buff); +LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s); LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud); @@ -411,19 +432,12 @@ LUA_API void (lua_closeslot) (lua_State *L, int idx); ** compatibility macros ** =============================================================== */ -#if defined(LUA_COMPAT_APIINTCASTS) - -#define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n)) -#define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is)) -#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 +#define lua_resetthread(L) lua_closethread(L,NULL) /* }============================================================== */ @@ -469,7 +483,6 @@ LUA_API lua_Hook (lua_gethook) (lua_State *L); 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; @@ -484,9 +497,10 @@ struct lua_Debug { unsigned char nups; /* (u) number of upvalues */ unsigned char nparams;/* (u) number of parameters */ char isvararg; /* (u) */ + unsigned char extraargs; /* (t) number of extra arguments */ char istailcall; /* (t) */ - unsigned short ftransfer; /* (r) index of first value transferred */ - unsigned short ntransfer; /* (r) number of transferred values */ + int ftransfer; /* (r) index of first value transferred */ + int ntransfer; /* (r) number of transferred values */ char short_src[LUA_IDSIZE]; /* (S) */ /* private part */ struct CallInfo *i_ci; /* active function */ @@ -495,8 +509,19 @@ struct lua_Debug { /* }====================================================================== */ +#define LUAI_TOSTRAUX(x) #x +#define LUAI_TOSTR(x) LUAI_TOSTRAUX(x) + +#define LUA_VERSION_MAJOR LUAI_TOSTR(LUA_VERSION_MAJOR_N) +#define LUA_VERSION_MINOR LUAI_TOSTR(LUA_VERSION_MINOR_N) +#define LUA_VERSION_RELEASE LUAI_TOSTR(LUA_VERSION_RELEASE_N) + +#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR +#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE + + /****************************************************************************** -* Copyright (C) 1994-2022 Lua.org, PUC-Rio. +* Copyright (C) 1994-2025 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/luaconf.h b/luaconf.h index e4650fbce8..96a77802b9 100644 --- a/luaconf.h +++ b/luaconf.h @@ -58,15 +58,37 @@ #endif +/* +** When POSIX DLL ('LUA_USE_DLOPEN') is enabled, the Lua stand-alone +** application will try to dynamically link a 'readline' facility +** for its REPL. In that case, LUA_READLINELIB is the name of the +** library it will look for those facilities. If lua.c cannot open +** the specified library, it will generate a warning and then run +** without 'readline'. If that macro is not defined, lua.c will not +** use 'readline'. +*/ #if defined(LUA_USE_LINUX) #define LUA_USE_POSIX #define LUA_USE_DLOPEN /* needs an extra library: -ldl */ +#define LUA_READLINELIB "libreadline.so" #endif #if defined(LUA_USE_MACOSX) #define LUA_USE_POSIX -#define LUA_USE_DLOPEN /* MacOS does not need -ldl */ +#define LUA_USE_DLOPEN /* macOS does not need -ldl */ +#define LUA_READLINELIB "libedit.dylib" +#endif + + +#if defined(LUA_USE_IOS) +#define LUA_USE_POSIX +#define LUA_USE_DLOPEN +#endif + + +#if defined(LUA_USE_C89) && defined(LUA_USE_POSIX) +#error "POSIX is not compatible with C89" #endif @@ -116,7 +138,7 @@ /* @@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats. */ -#define LUA_32BITS 0 +/* #define LUA_32BITS */ /* @@ -131,7 +153,7 @@ #endif -#if LUA_32BITS /* { */ +#if defined(LUA_32BITS) /* { */ /* ** 32-bit integers and 'float' */ @@ -251,6 +273,15 @@ #endif + +/* +** LUA_IGMARK is a mark to ignore all after it when building the +** module name (e.g., used to build the luaopen_ function name). +** Typically, the suffix after the mark is the module version, +** as in "mod-v1.2.so". +*/ +#define LUA_IGMARK "-" + /* }================================================================== */ @@ -288,32 +319,13 @@ ** More often than not the libs go together with the core. */ #define LUALIB_API LUA_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, -** 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 -** when Lua is compiled as a shared library. Not all elf targets support -** this attribute. Unfortunately, gcc does not offer a way to check -** whether the target offers that support, and those without support -** give a warning about it. To avoid these warnings, change to the -** default definition. -*/ -#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ - defined(__ELF__) /* { */ -#define LUAI_FUNC __attribute__((visibility("internal"))) extern -#else /* }{ */ -#define LUAI_FUNC extern -#endif /* } */ -#define LUAI_DDEC(dec) LUAI_FUNC dec -#define LUAI_DDEF /* empty */ +#if defined(__cplusplus) +/* Lua uses the "C name" when calling open functions */ +#define LUAMOD_API extern "C" +#else +#define LUAMOD_API LUA_API +#endif /* }================================================================== */ @@ -325,11 +337,10 @@ */ /* -@@ 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. +@@ LUA_COMPAT_GLOBAL avoids 'global' being a reserved word */ -#if defined(LUA_COMPAT_5_3) /* { */ +#define LUA_COMPAT_GLOBAL + /* @@ LUA_COMPAT_MATHLIB controls the presence of several deprecated @@ -337,23 +348,7 @@ ** (These functions were already officially removed in 5.3; ** nevertheless they are still available here.) */ -#define LUA_COMPAT_MATHLIB - -/* -@@ 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 - - -/* -@@ LUA_COMPAT_LT_LE controls the emulation of the '__le' metamethod -** using '__lt'. -*/ -#define LUA_COMPAT_LT_LE +/* #define LUA_COMPAT_MATHLIB */ /* @@ -370,8 +365,6 @@ #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) -#endif /* } */ - /* }================================================================== */ @@ -390,35 +383,23 @@ @@ 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. +@@ LUA_NUMBER_FMT is the format for writing floats with the maximum +** number of digits that respects tostring(tonumber(numeral)) == numeral. +** (That would be floor(log10(2^n)), where n is the number of bits in +** the float mantissa.) +@@ LUA_NUMBER_FMT_N is the format for writing floats with the minimum +** number of digits that ensures tonumber(tostring(number)) == number. +** (That would be LUA_NUMBER_FMT+2.) @@ 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 numeral to a number. */ -/* The following definitions are good for most cases here */ +/* The following definition is good for most cases here */ #define l_floor(x) (l_mathop(floor)(x)) -#define lua_number2str(s,sz,n) \ - l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n)) - -/* -@@ 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) && \ - (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \ - (*(p) = (LUA_INTEGER)(n), 1)) - /* now the variable definitions */ @@ -432,6 +413,7 @@ #define LUA_NUMBER_FRMLEN "" #define LUA_NUMBER_FMT "%.7g" +#define LUA_NUMBER_FMT_N "%.9g" #define l_mathop(op) op##f @@ -448,6 +430,7 @@ #define LUA_NUMBER_FRMLEN "L" #define LUA_NUMBER_FMT "%.19Lg" +#define LUA_NUMBER_FMT_N "%.21Lg" #define l_mathop(op) op##l @@ -462,7 +445,8 @@ #define LUAI_UACNUMBER double #define LUA_NUMBER_FRMLEN "" -#define LUA_NUMBER_FMT "%.14g" +#define LUA_NUMBER_FMT "%.15g" +#define LUA_NUMBER_FMT_N "%.17g" #define l_mathop(op) op @@ -676,13 +660,6 @@ #endif -#if defined(LUA_CORE) || defined(LUA_LIB) -/* shorter names for Lua's own use */ -#define l_likely(x) luai_likely(x) -#define l_unlikely(x) luai_unlikely(x) -#endif - - /* }================================================================== */ @@ -707,10 +684,7 @@ @@ LUA_USE_APICHECK turns on several consistency checks on the C API. ** Define it as a help when debugging C code. */ -#if defined(LUA_USE_APICHECK) -#include -#define luai_apicheck(l,e) assert(e) -#endif +/* #define LUA_USE_APICHECK */ /* }================================================================== */ @@ -723,20 +697,6 @@ ** ===================================================================== */ -/* -@@ LUAI_MAXSTACK limits the size of the Lua stack. -** 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 and max(int)/2.) -*/ -#if LUAI_IS32INT -#define LUAI_MAXSTACK 1000000 -#else -#define LUAI_MAXSTACK 15000 -#endif - - /* @@ LUA_EXTRASPACE defines the size of a raw memory area associated with ** a Lua state with very fast access. @@ -781,7 +741,5 @@ - - #endif diff --git a/lualib.h b/lualib.h index 2625529076..068f60ab3b 100644 --- a/lualib.h +++ b/lualib.h @@ -14,39 +14,52 @@ /* version suffix for environment variable names */ #define LUA_VERSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR - +#define LUA_GLIBK 1 LUAMOD_API int (luaopen_base) (lua_State *L); +#define LUA_LOADLIBNAME "package" +#define LUA_LOADLIBK (LUA_GLIBK << 1) +LUAMOD_API int (luaopen_package) (lua_State *L); + + #define LUA_COLIBNAME "coroutine" +#define LUA_COLIBK (LUA_LOADLIBK << 1) LUAMOD_API int (luaopen_coroutine) (lua_State *L); -#define LUA_TABLIBNAME "table" -LUAMOD_API int (luaopen_table) (lua_State *L); +#define LUA_DBLIBNAME "debug" +#define LUA_DBLIBK (LUA_COLIBK << 1) +LUAMOD_API int (luaopen_debug) (lua_State *L); #define LUA_IOLIBNAME "io" +#define LUA_IOLIBK (LUA_DBLIBK << 1) LUAMOD_API int (luaopen_io) (lua_State *L); +#define LUA_MATHLIBNAME "math" +#define LUA_MATHLIBK (LUA_IOLIBK << 1) +LUAMOD_API int (luaopen_math) (lua_State *L); + #define LUA_OSLIBNAME "os" +#define LUA_OSLIBK (LUA_MATHLIBK << 1) LUAMOD_API int (luaopen_os) (lua_State *L); #define LUA_STRLIBNAME "string" +#define LUA_STRLIBK (LUA_OSLIBK << 1) LUAMOD_API int (luaopen_string) (lua_State *L); +#define LUA_TABLIBNAME "table" +#define LUA_TABLIBK (LUA_STRLIBK << 1) +LUAMOD_API int (luaopen_table) (lua_State *L); + #define LUA_UTF8LIBNAME "utf8" +#define LUA_UTF8LIBK (LUA_TABLIBK << 1) LUAMOD_API int (luaopen_utf8) (lua_State *L); -#define LUA_MATHLIBNAME "math" -LUAMOD_API int (luaopen_math) (lua_State *L); - -#define LUA_DBLIBNAME "debug" -LUAMOD_API int (luaopen_debug) (lua_State *L); - -#define LUA_LOADLIBNAME "package" -LUAMOD_API int (luaopen_package) (lua_State *L); +/* open selected libraries */ +LUALIB_API void (luaL_openselectedlibs) (lua_State *L, int load, int preload); -/* open all previous libraries */ -LUALIB_API void (luaL_openlibs) (lua_State *L); +/* open all libraries */ +#define luaL_openlibs(L) luaL_openselectedlibs(L, ~0, 0) #endif diff --git a/lundump.c b/lundump.c index aba93f8280..3b61cc8cbb 100644 --- a/lundump.c +++ b/lundump.c @@ -21,6 +21,7 @@ #include "lmem.h" #include "lobject.h" #include "lstring.h" +#include "ltable.h" #include "lundump.h" #include "lzio.h" @@ -34,6 +35,10 @@ typedef struct { lua_State *L; ZIO *Z; const char *name; + Table *h; /* list for string reuse */ + size_t offset; /* current position relative to beginning of dump */ + lua_Unsigned nstr; /* number of strings in the list */ + lu_byte fixed; /* dump is fixed in memory */ } LoadState; @@ -47,11 +52,33 @@ static l_noret error (LoadState *S, const char *why) { ** 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,cast_sizet(n)*sizeof((b)[0])) static void loadBlock (LoadState *S, void *b, size_t size) { if (luaZ_read(S->Z, b, size) != 0) error(S, "truncated chunk"); + S->offset += size; +} + + +static void loadAlign (LoadState *S, unsigned align) { + unsigned padding = align - cast_uint(S->offset % align); + if (padding < align) { /* (padding == align) means no padding */ + lua_Integer paddingContent; + loadBlock(S, &paddingContent, padding); + lua_assert(S->offset % align == 0); + } +} + + +#define getaddr(S,n,t) cast(t *, getaddr_(S,cast_sizet(n) * sizeof(t))) + +static const void *getaddr_ (LoadState *S, size_t size) { + const void *block = luaZ_getaddr(S->Z, size); + S->offset += size; + if (block == NULL) + error(S, "truncated fixed buffer"); + return block; } @@ -62,34 +89,36 @@ static lu_byte loadByte (LoadState *S) { int b = zgetc(S->Z); if (b == EOZ) error(S, "truncated chunk"); + S->offset++; return cast_byte(b); } -static size_t loadUnsigned (LoadState *S, size_t limit) { - size_t x = 0; +static lua_Unsigned loadVarint (LoadState *S, lua_Unsigned limit) { + lua_Unsigned x = 0; int b; limit >>= 7; do { b = loadByte(S); - if (x >= limit) + if (x > limit) error(S, "integer overflow"); x = (x << 7) | (b & 0x7f); - } while ((b & 0x80) == 0); + } while ((b & 0x80) != 0); return x; } static size_t loadSize (LoadState *S) { - return loadUnsigned(S, ~(size_t)0); + return cast_sizet(loadVarint(S, MAX_SIZE)); } static int loadInt (LoadState *S) { - return cast_int(loadUnsigned(S, INT_MAX)); + return cast_int(loadVarint(S, cast_sizet(INT_MAX))); } + static lua_Number loadNumber (LoadState *S) { lua_Number x; loadVar(S, x); @@ -98,58 +127,79 @@ static lua_Number loadNumber (LoadState *S) { static lua_Integer loadInteger (LoadState *S) { - lua_Integer x; - loadVar(S, x); - return x; + lua_Unsigned cx = loadVarint(S, LUA_MAXUNSIGNED); + /* decode unsigned to signed */ + if ((cx & 1) != 0) + return l_castU2S(~(cx >> 1)); + else + return l_castU2S(cx >> 1); } /* -** Load a nullable string into prototype 'p'. +** Load a nullable string into slot 'sl' from prototype 'p'. The +** assignment to the slot and the barrier must be performed before any +** possible GC activity, to anchor the string. (Both 'loadVector' and +** 'luaH_setint' can call the GC.) */ -static TString *loadStringN (LoadState *S, Proto *p) { +static void loadString (LoadState *S, Proto *p, TString **sl) { lua_State *L = S->L; TString *ts; + TValue sv; 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); /* load string into buffer */ - ts = luaS_newlstr(L, buff, size); /* create string */ + if (size == 0) { /* previously saved string? */ + lua_Unsigned idx = loadVarint(S, LUA_MAXUNSIGNED); /* get its index */ + TValue stv; + if (idx == 0) { /* no string? */ + lua_assert(*sl == NULL); /* must be prefilled */ + return; + } + if (novariant(luaH_getint(S->h, l_castU2S(idx), &stv)) != LUA_TSTRING) + error(S, "invalid string index"); + *sl = ts = tsvalue(&stv); /* get its value */ + luaC_objbarrier(L, p, ts); + return; /* do not save it again */ } - else { /* long string */ - ts = luaS_createlngstrobj(L, size); /* create string */ - setsvalue2s(L, L->top.p, ts); /* anchor it ('loadVector' can GC) */ - luaD_inctop(L); - loadVector(S, getstr(ts), size); /* load directly in final place */ - L->top.p--; /* pop string */ + else if ((size -= 1) <= LUAI_MAXSHORTLEN) { /* short string? */ + char buff[LUAI_MAXSHORTLEN + 1]; /* extra space for '\0' */ + loadVector(S, buff, size + 1); /* load string into buffer */ + *sl = ts = luaS_newlstr(L, buff, size); /* create string */ + luaC_objbarrier(L, p, ts); } - luaC_objbarrier(L, p, ts); - return ts; -} - - -/* -** 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; + else if (S->fixed) { /* for a fixed buffer, use a fixed string */ + const char *s = getaddr(S, size + 1, char); /* get content address */ + *sl = ts = luaS_newextlstr(L, s, size, NULL, NULL); + luaC_objbarrier(L, p, ts); + } + else { /* create internal copy */ + *sl = ts = luaS_createlngstrobj(L, size); /* create string */ + luaC_objbarrier(L, p, ts); + loadVector(S, getlngstr(ts), size + 1); /* load directly in final place */ + } + /* add string to list of saved strings */ + S->nstr++; + setsvalue(L, &sv, ts); + luaH_setint(L, S->h, l_castU2S(S->nstr), &sv); + luaC_objbarrierback(L, obj2gco(S->h), ts); } 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); + loadAlign(S, sizeof(f->code[0])); + if (S->fixed) { + f->code = getaddr(S, n, Instruction); + f->sizecode = n; + } + else { + f->code = luaM_newvectorchecked(S->L, n, Instruction); + f->sizecode = n; + loadVector(S, f->code, n); + } } -static void loadFunction(LoadState *S, Proto *f, TString *psource); +static void loadFunction(LoadState *S, Proto *f); static void loadConstants (LoadState *S, Proto *f) { @@ -179,10 +229,16 @@ static void loadConstants (LoadState *S, Proto *f) { setivalue(o, loadInteger(S)); break; case LUA_VSHRSTR: - case LUA_VLNGSTR: - setsvalue2n(S->L, o, loadString(S, f)); + case LUA_VLNGSTR: { + lua_assert(f->source == NULL); + loadString(S, f, &f->source); /* use 'source' to anchor string */ + if (f->source == NULL) + error(S, "bad format for constant string"); + setsvalue2n(S->L, o, f->source); /* save it in the right place */ + f->source = NULL; break; - default: lua_assert(0); + } + default: error(S, "invalid constant"); } } } @@ -198,7 +254,7 @@ static void loadProtos (LoadState *S, Proto *f) { for (i = 0; i < n; i++) { f->p[i] = luaF_newproto(S->L); luaC_objbarrier(S->L, f, f->p[i]); - loadFunction(S, f->p[i], f->source); + loadFunction(S, f->p[i]); } } @@ -210,8 +266,8 @@ static void loadProtos (LoadState *S, Proto *f) { ** in that case all prototypes must be consistent for the GC. */ static void loadUpvalues (LoadState *S, Proto *f) { - int i, n; - n = loadInt(S); + int i; + int n = loadInt(S); f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc); f->sizeupvalues = n; for (i = 0; i < n; i++) /* make array valid for GC */ @@ -225,17 +281,29 @@ static void loadUpvalues (LoadState *S, Proto *f) { static void loadDebug (LoadState *S, Proto *f) { - int i, n; - n = loadInt(S); - f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte); - f->sizelineinfo = n; - loadVector(S, f->lineinfo, n); + int i; + int n = loadInt(S); + if (S->fixed) { + f->lineinfo = getaddr(S, n, ls_byte); + f->sizelineinfo = n; + } + else { + f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte); + f->sizelineinfo = n; + 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); + if (n > 0) { + loadAlign(S, sizeof(int)); + if (S->fixed) { + f->abslineinfo = getaddr(S, n, AbsLineInfo); + f->sizeabslineinfo = n; + } + else { + f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo); + f->sizeabslineinfo = n; + loadVector(S, f->abslineinfo, n); + } } n = loadInt(S); f->locvars = luaM_newvectorchecked(S->L, n, LocVar); @@ -243,29 +311,32 @@ static void loadDebug (LoadState *S, Proto *f) { for (i = 0; i < n; i++) f->locvars[i].varname = NULL; for (i = 0; i < n; i++) { - f->locvars[i].varname = loadStringN(S, f); + loadString(S, f, &f->locvars[i].varname); f->locvars[i].startpc = loadInt(S); f->locvars[i].endpc = loadInt(S); } n = loadInt(S); + if (n != 0) /* does it have debug information? */ + n = f->sizeupvalues; /* must be this many */ for (i = 0; i < n; i++) - f->upvalues[i].name = loadStringN(S, f); + loadString(S, f, &f->upvalues[i].name); } -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 */ +static void loadFunction (LoadState *S, Proto *f) { f->linedefined = loadInt(S); f->lastlinedefined = loadInt(S); f->numparams = loadByte(S); - f->is_vararg = loadByte(S); + /* get only the meaningful flags */ + f->flag = cast_byte(loadByte(S) & ~PF_FIXED); + if (S->fixed) + f->flag |= PF_FIXED; /* signal that code is fixed */ f->maxstacksize = loadByte(S); loadCode(S, f); loadConstants(S, f); loadUpvalues(S, f); loadProtos(S, f); + loadString(S, f, &f->source); loadDebug(S, f); } @@ -279,13 +350,29 @@ static void checkliteral (LoadState *S, const char *s, const char *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", tname)); +static l_noret numerror (LoadState *S, const char *what, const char *tname) { + const char *msg = luaO_pushfstring(S->L, "%s %s mismatch", tname, what); + error(S, msg); +} + + +static void checknumsize (LoadState *S, int size, const char *tname) { + if (size != loadByte(S)) + numerror(S, "size", tname); +} + + +static void checknumformat (LoadState *S, int eq, const char *tname) { + if (!eq) + numerror(S, "format", tname); } -#define checksize(S,t) fchecksize(S,sizeof(t),#t) +#define checknum(S,tvar,value,tname) \ + { tvar i; checknumsize(S, sizeof(i), tname); \ + loadVar(S, i); \ + checknumformat(S, i == value, tname); } + static void checkHeader (LoadState *S) { /* skip 1st char (already read and checked) */ @@ -295,39 +382,43 @@ static void checkHeader (LoadState *S) { 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, "integer format mismatch"); - if (loadNumber(S) != LUAC_NUM) - error(S, "float format mismatch"); + checknum(S, int, LUAC_INT, "int"); + checknum(S, Instruction, LUAC_INST, "instruction"); + checknum(S, lua_Integer, LUAC_INT, "Lua integer"); + checknum(S, lua_Number, LUAC_NUM, "Lua number"); } /* ** Load precompiled chunk. */ -LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) { +LClosure *luaU_undump (lua_State *L, ZIO *Z, const char *name, int fixed) { LoadState S; LClosure *cl; if (*name == '@' || *name == '=') - S.name = name + 1; + name = name + 1; else if (*name == LUA_SIGNATURE[0]) - S.name = "binary string"; - else - S.name = name; + name = "binary string"; + S.name = name; S.L = L; S.Z = Z; + S.fixed = cast_byte(fixed); + S.offset = 1; /* fist byte was already read */ checkHeader(&S); cl = luaF_newLclosure(L, loadByte(&S)); setclLvalue2s(L, L->top.p, cl); luaD_inctop(L); + S.h = luaH_new(L); /* create list of saved strings */ + S.nstr = 0; + sethvalue2s(L, L->top.p, S.h); /* anchor it */ + luaD_inctop(L); cl->p = luaF_newproto(L); luaC_objbarrier(L, cl, cl->p); - loadFunction(&S, cl->p, NULL); - lua_assert(cl->nupvalues == cl->p->sizeupvalues); + loadFunction(&S, cl->p); + if (cl->nupvalues != cl->p->sizeupvalues) + error(&S, "corrupted chunk"); luai_verifycode(L, cl->p); + L->top.p--; /* pop table */ return cl; } diff --git a/lundump.h b/lundump.h index f3748a9980..c4e06f9ebd 100644 --- a/lundump.h +++ b/lundump.h @@ -7,6 +7,8 @@ #ifndef lundump_h #define lundump_h +#include + #include "llimits.h" #include "lobject.h" #include "lzio.h" @@ -15,19 +17,21 @@ /* data to catch conversion errors */ #define LUAC_DATA "\x19\x93\r\n\x1a\n" -#define LUAC_INT 0x5678 -#define LUAC_NUM cast_num(370.5) +#define LUAC_INT -0x5678 +#define LUAC_INST 0x12345678 +#define LUAC_NUM cast_num(-370.5) /* ** 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_VERSION (LUA_VERSION_MAJOR_N*16+LUA_VERSION_MINOR_N) #define LUAC_FORMAT 0 /* this is the official format */ + /* load one chunk; from lundump.c */ -LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name); +LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name, + int fixed); /* dump one chunk; from ldump.c */ LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, diff --git a/lutf8lib.c b/lutf8lib.c index 3a5b9bc38a..b7f3fe1e16 100644 --- a/lutf8lib.c +++ b/lutf8lib.c @@ -10,7 +10,6 @@ #include "lprefix.h" -#include #include #include #include @@ -19,6 +18,7 @@ #include "lauxlib.h" #include "lualib.h" +#include "llimits.h" #define MAXUNICODE 0x10FFFFu @@ -28,15 +28,6 @@ #define MSGInvalid "invalid UTF-8 code" -/* -** 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(c) (((c) & 0xC0) == 0x80) #define iscontp(p) iscont(*(p)) @@ -55,15 +46,15 @@ static lua_Integer u_posrelat (lua_Integer pos, size_t len) { ** 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 +** entry forces an error for non-ASCII bytes with no continuation ** bytes (count == 0). */ -static const char *utf8_decode (const char *s, utfint *val, int strict) { - static const utfint limits[] = - {~(utfint)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u}; +static const char *utf8_decode (const char *s, l_uint32 *val, int strict) { + static const l_uint32 limits[] = + {~(l_uint32)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u}; unsigned int c = (unsigned char)s[0]; - utfint res = 0; /* final result */ - if (c < 0x80) /* ascii? */ + l_uint32 res = 0; /* final result */ + if (c < 0x80) /* ASCII? */ res = c; else { int count = 0; /* to count number of continuation bytes */ @@ -73,7 +64,7 @@ static const char *utf8_decode (const char *s, utfint *val, int strict) { return NULL; /* invalid byte sequence */ res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */ } - res |= ((utfint)(c & 0x7F) << (count * 5)); /* add first byte */ + res |= ((l_uint32)(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 */ @@ -111,7 +102,7 @@ static int utflen (lua_State *L) { lua_pushinteger(L, posi + 1); /* ... and current position */ return 2; } - posi = s1 - s; + posi = ct_diff2S(s1 - s); n++; } lua_pushinteger(L, n); @@ -141,11 +132,11 @@ static int codepoint (lua_State *L) { n = 0; /* count the number of returns */ se = s + pose; /* string end */ for (s += posi - 1; s < se;) { - utfint code; + l_uint32 code; s = utf8_decode(s, &code, !lax); if (s == NULL) return luaL_error(L, MSGInvalid); - lua_pushinteger(L, code); + lua_pushinteger(L, l_castU2S(code)); n++; } return n; @@ -181,14 +172,14 @@ static int utfchar (lua_State *L) { /* -** offset(s, n, [i]) -> index where n-th character counting from -** position 'i' starts; 0 means character at 'i'. +** offset(s, n, [i]) -> indices where n-th character counting from +** position 'i' starts and ends; 0 means character at 'i'. */ static int byteoffset (lua_State *L) { size_t len; const char *s = luaL_checklstring(L, 1, &len); lua_Integer n = luaL_checkinteger(L, 2); - lua_Integer posi = (n >= 0) ? 1 : len + 1; + lua_Integer posi = (n >= 0) ? 1 : cast_st2S(len) + 1; posi = u_posrelat(luaL_optinteger(L, 3, posi), len); luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3, "position out of bounds"); @@ -200,28 +191,37 @@ static int byteoffset (lua_State *L) { if (iscontp(s + posi)) return luaL_error(L, "initial position is a continuation byte"); if (n < 0) { - while (n < 0 && posi > 0) { /* move back */ - do { /* find beginning of previous character */ - posi--; - } while (posi > 0 && iscontp(s + posi)); - n++; - } - } - else { - n--; /* do not move for 1st character */ - while (n > 0 && posi < (lua_Integer)len) { - do { /* find beginning of next character */ - posi++; - } while (iscontp(s + posi)); /* (cannot pass final '\0') */ - n--; - } - } + while (n < 0 && posi > 0) { /* move back */ + do { /* find beginning of previous character */ + posi--; + } while (posi > 0 && iscontp(s + posi)); + n++; + } + } + else { + n--; /* do not move for 1st character */ + while (n > 0 && posi < (lua_Integer)len) { + do { /* find beginning of next character */ + posi++; + } while (iscontp(s + posi)); /* (cannot pass final '\0') */ + n--; + } + } } - if (n == 0) /* did it find given character? */ - lua_pushinteger(L, posi + 1); - else /* no such character */ + if (n != 0) { /* did not find given character? */ luaL_pushfail(L); - return 1; + return 1; + } + lua_pushinteger(L, posi + 1); /* initial position */ + if ((s[posi] & 0x80) != 0) { /* multi-byte character? */ + if (iscont(s[posi])) + return luaL_error(L, "initial position is a continuation byte"); + while (iscontp(s + posi + 1)) + posi++; /* skip to last continuation byte */ + } + /* else one-byte character: final position is the initial one */ + lua_pushinteger(L, posi + 1); /* 'posi' now is the final position */ + return 2; } @@ -235,12 +235,12 @@ static int iter_aux (lua_State *L, int strict) { if (n >= len) /* (also handles original 'n' being negative) */ return 0; /* no more codepoints */ else { - utfint code; + l_uint32 code; const char *next = utf8_decode(s + n, &code, strict); if (next == NULL || iscontp(next)) return luaL_error(L, MSGInvalid); - lua_pushinteger(L, n + 1); - lua_pushinteger(L, code); + lua_pushinteger(L, l_castU2S(n + 1)); + lua_pushinteger(L, l_castU2S(code)); return 2; } } diff --git a/lvm.c b/lvm.c index 2e84dc63c1..2c868c2128 100644 --- a/lvm.c +++ b/lvm.c @@ -18,6 +18,7 @@ #include "lua.h" +#include "lapi.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" @@ -91,8 +92,12 @@ 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); + else { + TString *st = tsvalue(obj); + size_t stlen; + const char *s = getlstr(st, stlen); + return (luaO_str2num(s, result) == stlen + 1); + } } @@ -122,8 +127,8 @@ 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 (mode == F2Iceil) /* needs ceiling? */ + f += 1; /* convert floor to ceiling (remember: n != f) */ } return lua_numbertointeger(f, p); } @@ -196,12 +201,15 @@ static int forlimit (lua_State *L, lua_Integer init, const TValue *lim, /* ** Prepare a numerical for loop (opcode OP_FORPREP). +** Before execution, stack is as follows: +** ra : initial value +** ra + 1 : limit +** ra + 2 : step ** 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 +** ra : loop counter (integer loops) or limit (float loops) +** ra + 1 : step +** ra + 2 : control variable */ static int forprep (lua_State *L, StkId ra) { TValue *pinit = s2v(ra); @@ -213,7 +221,6 @@ static int forprep (lua_State *L, StkId ra) { 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 */ @@ -228,9 +235,10 @@ static int forprep (lua_State *L, StkId ra) { /* '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)); + /* use 'chgivalue' for places that for sure had integers */ + chgivalue(s2v(ra), l_castU2S(count)); /* change init to count */ + setivalue(s2v(ra + 1), step); /* change limit to step */ + chgivalue(s2v(ra + 2), init); /* change step to init */ } } else { /* try making all values floats */ @@ -247,11 +255,10 @@ static int forprep (lua_State *L, StkId ra) { : 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 */ + /* make sure all values are floats */ + setfltvalue(s2v(ra), limit); + setfltvalue(s2v(ra + 1), step); + setfltvalue(s2v(ra + 2), init); /* control variable */ } } return 0; @@ -264,14 +271,13 @@ static int forprep (lua_State *L, StkId ra) { ** 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 */ + lua_Number step = fltvalue(s2v(ra + 1)); + lua_Number limit = fltvalue(s2v(ra)); + lua_Number idx = fltvalue(s2v(ra + 2)); /* control variable */ 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 */ + chgfltvalue(s2v(ra + 2), idx); /* update control variable */ return 1; /* jump back */ } else @@ -280,16 +286,14 @@ static int floatforloop (StkId ra) { /* -** 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 empty). +** Finish the table access 'val = t[key]' and return the tag of the result. */ -void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val, - const TValue *slot) { +lu_byte luaV_finishget (lua_State *L, const TValue *t, TValue *key, + StkId val, lu_byte tag) { int loop; /* counter to avoid infinite loops */ const TValue *tm; /* metamethod */ for (loop = 0; loop < MAXTAGLOOP; loop++) { - if (slot == NULL) { /* 't' is not a table? */ + if (tag == LUA_VNOTABLE) { /* 't' is not a table? */ lua_assert(!ttistable(t)); tm = luaT_gettmbyobj(L, t, TM_INDEX); if (l_unlikely(notm(tm))) @@ -297,47 +301,49 @@ void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val, /* else will try the metamethod */ } else { /* 't' is a table */ - lua_assert(isempty(slot)); tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); /* table's metamethod */ if (tm == NULL) { /* no metamethod? */ setnilvalue(s2v(val)); /* result is nil */ - return; + return LUA_VNIL; } /* else will try the metamethod */ } if (ttisfunction(tm)) { /* is metamethod a function? */ - luaT_callTMres(L, tm, t, key, val); /* call it */ - return; + tag = luaT_callTMres(L, tm, t, key, val); /* call it */ + return tag; /* return tag of the result */ } t = tm; /* else try to access 'tm[key]' */ - if (luaV_fastget(L, t, key, slot, luaH_get)) { /* fast track? */ - setobj2s(L, val, slot); /* done */ - return; - } + luaV_fastget(t, key, s2v(val), luaH_get, tag); + if (!tagisempty(tag)) + return tag; /* done */ /* else repeat (tail call 'luaV_finishget') */ } luaG_runerror(L, "'__index' chain too long; possible loop"); + return 0; /* to avoid warnings */ } /* ** 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 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.) +** About anchoring the table before the call to 'luaH_finishset': +** This call may trigger an emergency collection. When loop>0, +** the table being accessed is a field in some metatable. If this +** metatable is weak and the table is not anchored, this collection +** could collect that table while it is being updated. */ void luaV_finishset (lua_State *L, const TValue *t, TValue *key, - TValue *val, const TValue *slot) { + TValue *val, int hres) { 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? */ + if (hres != HNOTATABLE) { /* is 't' a table? */ Table *h = hvalue(t); /* save 't' table */ - lua_assert(isempty(slot)); /* slot must be empty */ tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */ if (tm == NULL) { /* no metamethod? */ - luaH_finishset(L, h, key, slot, val); /* set new value */ + sethvalue2s(L, L->top.p, h); /* anchor 't' */ + L->top.p++; /* assume EXTRA_STACK */ + luaH_finishset(L, h, key, val, hres); /* set new value */ + L->top.p--; invalidateTMcache(h); luaC_barrierback(L, obj2gco(h), val); return; @@ -355,8 +361,9 @@ void luaV_finishset (lua_State *L, const TValue *t, TValue *key, return; } t = tm; /* else repeat assignment over 'tm' */ - if (luaV_fastget(L, t, key, slot, luaH_get)) { - luaV_finishfastset(L, t, slot, val); + luaV_fastset(t, key, val, hres, luaH_pset); + if (hres == HOK) { + luaV_finishfastset(L, t, val); return; /* done */ } /* else 'return luaV_finishset(L, t, key, val, slot)' (loop) */ @@ -366,30 +373,40 @@ void luaV_finishset (lua_State *L, const TValue *t, TValue *key, /* -** Compare two strings 'ls' x 'rs', returning an integer less-equal- -** -greater than zero if 'ls' is less-equal-greater than 'rs'. +** Function to be used for 0-terminated string order comparison +*/ +#if !defined(l_strcoll) +#define l_strcoll strcoll +#endif + + +/* +** Compare two strings 'ts1' x 'ts2', returning an integer less-equal- +** -greater than zero if 'ts1' is less-equal-greater than 'ts2'. ** 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. +** and it uses 'strcoll' (to respect locales) for each segment +** of the strings. Note that segments can compare equal but still +** have different lengths. */ -static int l_strcmp (const TString *ls, const TString *rs) { - const char *l = getstr(ls); - size_t ll = tsslen(ls); - const char *r = getstr(rs); - size_t lr = tsslen(rs); +static int l_strcmp (const TString *ts1, const TString *ts2) { + size_t rl1; /* real length */ + const char *s1 = getlstr(ts1, rl1); + size_t rl2; + const char *s2 = getlstr(ts2, rl2); for (;;) { /* for each segment */ - int temp = strcoll(l, r); + int temp = l_strcoll(s1, s2); if (temp != 0) /* not equal? */ return temp; /* done */ else { /* strings are equal up to a '\0' */ - size_t len = strlen(l); /* index of first '\0' in both strings */ - if (len == lr) /* 'rs' is finished? */ - return (len == ll) ? 0 : 1; /* check 'ls' */ - else if (len == ll) /* 'ls' is 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; + size_t zl1 = strlen(s1); /* index of first '\0' in 's1' */ + size_t zl2 = strlen(s2); /* index of first '\0' in 's2' */ + if (zl2 == rl2) /* 's2' is finished? */ + return (zl1 == rl1) ? 0 : 1; /* check 's1' */ + else if (zl1 == rl1) /* 's1' is finished? */ + return -1; /* 's1' is less than 's2' ('s2' is not finished) */ + /* both strings longer than 'zl'; go on comparing after the '\0' */ + zl1++; zl2++; + s1 += zl1; rl1 -= zl1; s2 += zl2; rl2 -= zl2; } } } @@ -564,52 +581,74 @@ int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) { */ int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) { const TValue *tm; - 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 */ - /* One of them is an integer. If the other does not have an - integer value, they cannot be equal; otherwise, compare their - integer values. */ - lua_Integer i1, i2; - return (luaV_tointegerns(t1, &i1, F2Ieq) && - luaV_tointegerns(t2, &i2, F2Ieq) && - i1 == i2); + if (ttype(t1) != ttype(t2)) /* not the same type? */ + return 0; + else if (ttypetag(t1) != ttypetag(t2)) { + switch (ttypetag(t1)) { + case LUA_VNUMINT: { /* integer == float? */ + /* integer and float can only be equal if float has an integer + value equal to the integer */ + lua_Integer i2; + return (luaV_flttointeger(fltvalue(t2), &i2, F2Ieq) && + ivalue(t1) == i2); + } + case LUA_VNUMFLT: { /* float == integer? */ + lua_Integer i1; /* see comment in previous case */ + return (luaV_flttointeger(fltvalue(t1), &i1, F2Ieq) && + i1 == ivalue(t2)); + } + case LUA_VSHRSTR: case LUA_VLNGSTR: { + /* compare two strings with different variants: they can be + equal when one string is a short string and the other is + an external string */ + return luaS_eqstr(tsvalue(t1), tsvalue(t2)); + } + default: + /* only numbers (integer/float) and strings (long/short) can have + equal values with different variants */ + return 0; } } - /* values have same type and same variant */ - 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); - if (tm == NULL) - tm = fasttm(L, uvalue(t2)->metatable, TM_EQ); - break; /* will try TM */ + else { /* equal variants */ + 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 (fltvalue(t1) == fltvalue(t2)); + case LUA_VLIGHTUSERDATA: return pvalue(t1) == pvalue(t2); + case LUA_VSHRSTR: + return eqshrstr(tsvalue(t1), tsvalue(t2)); + case LUA_VLNGSTR: + return luaS_eqstr(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); + if (tm == NULL) + tm = fasttm(L, uvalue(t2)->metatable, TM_EQ); + break; /* will try TM */ + } + case LUA_VTABLE: { + if (hvalue(t1) == hvalue(t2)) return 1; + else if (L == NULL) return 0; + tm = fasttm(L, hvalue(t1)->metatable, TM_EQ); + if (tm == NULL) + tm = fasttm(L, hvalue(t2)->metatable, TM_EQ); + break; /* will try TM */ + } + case LUA_VLCF: + return (fvalue(t1) == fvalue(t2)); + default: /* functions and threads */ + return (gcvalue(t1) == gcvalue(t2)); } - case LUA_VTABLE: { - if (hvalue(t1) == hvalue(t2)) return 1; - else if (L == NULL) return 0; - tm = fasttm(L, hvalue(t1)->metatable, TM_EQ); - if (tm == NULL) - tm = fasttm(L, hvalue(t2)->metatable, TM_EQ); - break; /* will try TM */ + if (tm == NULL) /* no TM? */ + return 0; /* objects are different */ + else { + int tag = luaT_callTMres(L, tm, t1, t2, L->top.p); /* call TM */ + return !tagisfalse(tag); } - default: - return gcvalue(t1) == gcvalue(t2); - } - if (tm == NULL) /* no TM? */ - return 0; /* objects are different */ - else { - luaT_callTMres(L, tm, t1, t2, L->top.p); /* call TM */ - return !l_isfalse(s2v(L->top.p)); } } @@ -618,14 +657,21 @@ int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) { #define tostring(L,o) \ (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1))) +/* +** Check whether object is a short empty string to optimize concatenation. +** (External strings can be empty too; they will be concatenated like +** non-empty ones.) +*/ #define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0) /* copy strings in stack from top - n up to top - 1 to buffer */ static void copy2buff (StkId top, int n, char *buff) { size_t tl = 0; /* size already copied */ do { - size_t l = vslen(s2v(top - n)); /* length of string being copied */ - memcpy(buff + tl, svalue(s2v(top - n)), l * sizeof(char)); + TString *st = tsvalue(s2v(top - n)); + size_t l; /* length of string being copied */ + const char *s = getlstr(st, l); + memcpy(buff + tl, s, l * sizeof(char)); tl += l; } while (--n > 0); } @@ -650,13 +696,13 @@ void luaV_concat (lua_State *L, int total) { 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(s2v(top - 1)); + /* at least two string values; get as many as possible */ + size_t tl = tsslen(tsvalue(s2v(top - 1))); /* total length */ TString *ts; /* collect total length and number of strings */ for (n = 1; n < total && tostring(L, s2v(top - n - 1)); n++) { - size_t l = vslen(s2v(top - n - 1)); - if (l_unlikely(l >= (MAX_SIZE/sizeof(char)) - tl)) { + size_t l = tsslen(tsvalue(s2v(top - n - 1))); + if (l_unlikely(l >= MAX_SIZE - sizeof(TString) - tl)) { L->top.p = top - total; /* pop strings to avoid wasting stack */ luaG_runerror(L, "string length overflow"); } @@ -669,7 +715,7 @@ void luaV_concat (lua_State *L, int total) { } else { /* long string; copy strings directly to final result */ ts = luaS_createlngstrobj(L, tl); - copy2buff(top, n, getstr(ts)); + copy2buff(top, n, getlngstr(ts)); } setsvalue2s(L, top - n, ts); /* create result */ } @@ -689,7 +735,7 @@ void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) { Table *h = hvalue(rb); tm = fasttm(L, h->metatable, TM_LEN); if (tm) break; /* metamethod? break switch to call it */ - setivalue(s2v(ra), luaH_getn(h)); /* else primitive len */ + setivalue(s2v(ra), l_castU2S(luaH_getn(L, h))); /* else primitive len */ return; } case LUA_VSHRSTR: { @@ -697,7 +743,7 @@ void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) { return; } case LUA_VLNGSTR: { - setivalue(s2v(ra), tsvalue(rb)->u.lnglen); + setivalue(s2v(ra), cast_st2S(tsvalue(rb)->u.lnglen)); return; } default: { /* try metamethod */ @@ -763,7 +809,7 @@ lua_Number luaV_modf (lua_State *L, lua_Number m, lua_Number n) { /* number of bits in an integer */ -#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT) +#define NBITS l_numbits(lua_Integer) /* @@ -828,12 +874,6 @@ void luaV_finishOp (lua_State *L) { case OP_EQ: { /* note that 'OP_EQI'/'OP_EQK' cannot yield */ int res = !l_isfalse(s2v(L->top.p - 1)); L->top.p--; -#if defined(LUA_COMPAT_LT_LE) - if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */ - ci->callstatus ^= CIST_LEQ; /* clear mark */ - res = !res; /* negate result */ - } -#endif lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP); if (res != GETARG_k(inst)) /* condition failed? */ ci->u.l.savedpc++; /* skip jump instruction */ @@ -877,6 +917,10 @@ void luaV_finishOp (lua_State *L) { /* ** {================================================================== ** Macros for arithmetic/bitwise/comparison opcodes in 'luaV_execute' +** +** All these macros are to be used exclusively inside the main +** iterpreter loop (function luaV_execute) and may access directly +** the local variables of that function (L, i, pc, ci, etc.). ** =================================================================== */ @@ -898,27 +942,28 @@ void luaV_finishOp (lua_State *L) { ** operation, 'fop' is the float operation. */ #define op_arithI(L,iop,fop) { \ - StkId ra = RA(i); \ + TValue *ra = vRA(i); \ 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)); \ + pc++; setivalue(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)); \ + pc++; setfltvalue(ra, fop(L, nb, fimm)); \ }} /* ** Auxiliary function for arithmetic operations over floats and others -** with two register operands. +** with two operands. */ #define op_arithf_aux(L,v1,v2,fop) { \ lua_Number n1; lua_Number n2; \ if (tonumberns(v1, n1) && tonumberns(v2, n2)) { \ + StkId ra = RA(i); \ pc++; setfltvalue(s2v(ra), fop(L, n1, n2)); \ }} @@ -927,7 +972,6 @@ void luaV_finishOp (lua_State *L) { ** Arithmetic operations over floats and others with register operands. */ #define op_arithf(L,fop) { \ - StkId ra = RA(i); \ TValue *v1 = vRB(i); \ TValue *v2 = vRC(i); \ op_arithf_aux(L, v1, v2, fop); } @@ -937,7 +981,6 @@ void luaV_finishOp (lua_State *L) { ** Arithmetic operations with K operands for floats. */ #define op_arithfK(L,fop) { \ - StkId ra = RA(i); \ TValue *v1 = vRB(i); \ TValue *v2 = KC(i); lua_assert(ttisnumber(v2)); \ op_arithf_aux(L, v1, v2, fop); } @@ -947,8 +990,8 @@ void luaV_finishOp (lua_State *L) { ** Arithmetic operations over integers and floats. */ #define op_arith_aux(L,v1,v2,iop,fop) { \ - StkId ra = RA(i); \ if (ttisinteger(v1) && ttisinteger(v2)) { \ + StkId ra = RA(i); \ lua_Integer i1 = ivalue(v1); lua_Integer i2 = ivalue(v2); \ pc++; setivalue(s2v(ra), iop(L, i1, i2)); \ } \ @@ -977,12 +1020,12 @@ void luaV_finishOp (lua_State *L) { ** Bitwise operations with constant operand. */ #define op_bitwiseK(L,op) { \ - StkId ra = RA(i); \ TValue *v1 = vRB(i); \ TValue *v2 = KC(i); \ lua_Integer i1; \ lua_Integer i2 = ivalue(v2); \ if (tointegerns(v1, &i1)) { \ + StkId ra = RA(i); \ pc++; setivalue(s2v(ra), op(i1, i2)); \ }} @@ -991,11 +1034,11 @@ void luaV_finishOp (lua_State *L) { ** Bitwise operations with register operands. */ #define op_bitwise(L,op) { \ - StkId ra = RA(i); \ TValue *v1 = vRB(i); \ TValue *v2 = vRC(i); \ lua_Integer i1; lua_Integer i2; \ if (tointegerns(v1, &i1) && tointegerns(v2, &i2)) { \ + StkId ra = RA(i); \ pc++; setivalue(s2v(ra), op(i1, i2)); \ }} @@ -1006,18 +1049,18 @@ void luaV_finishOp (lua_State *L) { ** integers. */ #define op_order(L,opi,opn,other) { \ - StkId ra = RA(i); \ + TValue *ra = vRA(i); \ int cond; \ TValue *rb = vRB(i); \ - if (ttisinteger(s2v(ra)) && ttisinteger(rb)) { \ - lua_Integer ia = ivalue(s2v(ra)); \ + if (ttisinteger(ra) && ttisinteger(rb)) { \ + lua_Integer ia = ivalue(ra); \ lua_Integer ib = ivalue(rb); \ cond = opi(ia, ib); \ } \ - else if (ttisnumber(s2v(ra)) && ttisnumber(rb)) \ - cond = opn(s2v(ra), rb); \ + else if (ttisnumber(ra) && ttisnumber(rb)) \ + cond = opn(ra, rb); \ else \ - Protect(cond = other(L, s2v(ra), rb)); \ + Protect(cond = other(L, ra, rb)); \ docondjump(); } @@ -1026,19 +1069,19 @@ void luaV_finishOp (lua_State *L) { ** always small enough to have an exact representation as a float.) */ #define op_orderI(L,opi,opf,inv,tm) { \ - StkId ra = RA(i); \ + TValue *ra = vRA(i); \ 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)); \ + if (ttisinteger(ra)) \ + cond = opi(ivalue(ra), im); \ + else if (ttisfloat(ra)) { \ + lua_Number fa = fltvalue(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)); \ + Protect(cond = luaT_callorderiTM(L, ra, im, inv, isf, tm)); \ } \ docondjump(); } @@ -1057,6 +1100,7 @@ void luaV_finishOp (lua_State *L) { #define RA(i) (base+GETARG_A(i)) +#define vRA(i) s2v(RA(i)) #define RB(i) (base+GETARG_B(i)) #define vRB(i) s2v(RB(i)) #define KB(i) (k+GETARG_B(i)) @@ -1097,14 +1141,14 @@ void luaV_finishOp (lua_State *L) { /* ** Correct global 'pc'. */ -#define savepc(L) (ci->u.l.savedpc = pc) +#define savepc(ci) (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.p = ci->top.p) +#define savestate(L,ci) (savepc(ci), L->top.p = ci->top.p) /* @@ -1114,7 +1158,7 @@ void luaV_finishOp (lua_State *L) { #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)) +#define ProtectNT(exp) (savepc(ci), (exp), updatetrap(ci)) /* ** Protect code that can only raise errors. (That is, it cannot change @@ -1122,9 +1166,17 @@ void luaV_finishOp (lua_State *L) { */ #define halfProtect(exp) (savestate(L,ci), (exp)) +/* +** macro executed during Lua functions at points where the +** function can yield. +*/ +#if !defined(luai_threadyield) +#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);} +#endif + /* 'c' is the limit of live values in the stack */ #define checkGC(L,c) \ - { luaC_condGC(L, (savepc(L), L->top.p = (c)), \ + { luaC_condGC(L, (savepc(ci), L->top.p = (c)), \ updatetrap(ci)); \ luai_threadyield(L); } @@ -1155,31 +1207,28 @@ void luaV_execute (lua_State *L, CallInfo *ci) { startfunc: trap = L->hookmask; returning: /* trap already set */ - cl = clLvalue(s2v(ci->func.p)); + cl = ci_func(ci); k = cl->p->k; pc = ci->u.l.savedpc; - if (l_unlikely(trap)) { - if (pc == cl->p->code) { /* first instruction (not resuming)? */ - if (cl->p->is_vararg) - trap = 0; /* hooks will start after VARARGPREP instruction */ - else /* check 'call' hook */ - luaD_hookcall(L, ci); - } - ci->u.l.trap = 1; /* assume trap is on, for now */ - } + if (l_unlikely(trap)) + trap = luaG_tracecall(L); base = ci->func.p + 1; /* main loop of interpreter */ for (;;) { Instruction i; /* instruction being executed */ vmfetch(); #if 0 - /* low-level line tracing for debugging Lua */ - printf("line: %d\n", luaG_getfuncline(cl->p, pcRel(pc, cl->p))); + { /* low-level line tracing for debugging Lua */ + #include "lopnames.h" + int pcrel = pcRel(pc, cl->p); + printf("line: %d; %s (%d)\n", luaG_getfuncline(cl->p, pcrel), + opnames[GET_OPCODE(i)], pcrel); + } #endif lua_assert(base == ci->func.p + 1); lua_assert(base <= L->top.p && L->top.p <= L->stack_last.p); - /* invalidate top for instructions not expecting it */ - lua_assert(isIT(i) || (cast_void(L->top.p = base), 1)); + /* for tests, invalidate top for instructions not expecting it */ + lua_assert(luaP_isIT(i) || (cast_void(L->top.p = base), 1)); vmdispatch (GET_OPCODE(i)) { vmcase(OP_MOVE) { StkId ra = RA(i); @@ -1250,126 +1299,123 @@ void luaV_execute (lua_State *L, CallInfo *ci) { } vmcase(OP_GETTABUP) { StkId ra = RA(i); - const TValue *slot; TValue *upval = cl->upvals[GETARG_B(i)]->v.p; 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)); + TString *key = tsvalue(rc); /* key must be a short string */ + lu_byte tag; + luaV_fastget(upval, key, s2v(ra), luaH_getshortstr, tag); + if (tagisempty(tag)) + Protect(luaV_finishget(L, upval, rc, ra, tag)); vmbreak; } vmcase(OP_GETTABLE) { StkId ra = RA(i); - 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); + lu_byte tag; + if (ttisinteger(rc)) { /* fast track for integers? */ + luaV_fastgeti(rb, ivalue(rc), s2v(ra), tag); } else - Protect(luaV_finishget(L, rb, rc, ra, slot)); + luaV_fastget(rb, rc, s2v(ra), luaH_get, tag); + if (tagisempty(tag)) + Protect(luaV_finishget(L, rb, rc, ra, tag)); vmbreak; } vmcase(OP_GETI) { StkId ra = RA(i); - const TValue *slot; TValue *rb = vRB(i); int c = GETARG_C(i); - if (luaV_fastgeti(L, rb, c, slot)) { - setobj2s(L, ra, slot); - } - else { + lu_byte tag; + luaV_fastgeti(rb, c, s2v(ra), tag); + if (tagisempty(tag)) { TValue key; setivalue(&key, c); - Protect(luaV_finishget(L, rb, &key, ra, slot)); + Protect(luaV_finishget(L, rb, &key, ra, tag)); } vmbreak; } vmcase(OP_GETFIELD) { StkId ra = RA(i); - 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)); + TString *key = tsvalue(rc); /* key must be a short string */ + lu_byte tag; + luaV_fastget(rb, key, s2v(ra), luaH_getshortstr, tag); + if (tagisempty(tag)) + Protect(luaV_finishget(L, rb, rc, ra, tag)); vmbreak; } vmcase(OP_SETTABUP) { - const TValue *slot; + int hres; TValue *upval = cl->upvals[GETARG_A(i)]->v.p; TValue *rb = KB(i); TValue *rc = RKC(i); - TString *key = tsvalue(rb); /* key must be a string */ - if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) { - luaV_finishfastset(L, upval, slot, rc); - } + TString *key = tsvalue(rb); /* key must be a short string */ + luaV_fastset(upval, key, rc, hres, luaH_psetshortstr); + if (hres == HOK) + luaV_finishfastset(L, upval, rc); else - Protect(luaV_finishset(L, upval, rb, rc, slot)); + Protect(luaV_finishset(L, upval, rb, rc, hres)); vmbreak; } vmcase(OP_SETTABLE) { StkId ra = RA(i); - const TValue *slot; + int hres; 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); + if (ttisinteger(rb)) { /* fast track for integers? */ + luaV_fastseti(s2v(ra), ivalue(rb), rc, hres); } + else { + luaV_fastset(s2v(ra), rb, rc, hres, luaH_pset); + } + if (hres == HOK) + luaV_finishfastset(L, s2v(ra), rc); else - Protect(luaV_finishset(L, s2v(ra), rb, rc, slot)); + Protect(luaV_finishset(L, s2v(ra), rb, rc, hres)); vmbreak; } vmcase(OP_SETI) { StkId ra = RA(i); - const TValue *slot; - int c = GETARG_B(i); + int hres; + int b = GETARG_B(i); TValue *rc = RKC(i); - if (luaV_fastgeti(L, s2v(ra), c, slot)) { - luaV_finishfastset(L, s2v(ra), slot, rc); - } + luaV_fastseti(s2v(ra), b, rc, hres); + if (hres == HOK) + luaV_finishfastset(L, s2v(ra), rc); else { TValue key; - setivalue(&key, c); - Protect(luaV_finishset(L, s2v(ra), &key, rc, slot)); + setivalue(&key, b); + Protect(luaV_finishset(L, s2v(ra), &key, rc, hres)); } vmbreak; } vmcase(OP_SETFIELD) { StkId ra = RA(i); - const TValue *slot; + int hres; 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); - } + TString *key = tsvalue(rb); /* key must be a short string */ + luaV_fastset(s2v(ra), key, rc, hres, luaH_psetshortstr); + if (hres == HOK) + luaV_finishfastset(L, s2v(ra), rc); else - Protect(luaV_finishset(L, s2v(ra), rb, rc, slot)); + Protect(luaV_finishset(L, s2v(ra), rb, rc, hres)); vmbreak; } vmcase(OP_NEWTABLE) { StkId ra = RA(i); - int b = GETARG_B(i); /* log2(hash size) + 1 */ - int c = GETARG_C(i); /* array size */ + unsigned b = cast_uint(GETARG_vB(i)); /* log2(hash size) + 1 */ + unsigned c = cast_uint(GETARG_vC(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 */ + b = 1u << (b - 1); /* hash size is 2^(b - 1) */ + if (TESTARG_k(i)) { /* non-zero extra argument? */ + lua_assert(GETARG_Ax(*pc) != 0); + /* add it to array size */ + c += cast_uint(GETARG_Ax(*pc)) * (MAXARG_vC + 1); + } pc++; /* skip extra argument */ L->top.p = ra + 1; /* correct top in case of emergency GC */ t = luaH_new(L); /* memory allocation */ @@ -1381,16 +1427,14 @@ void luaV_execute (lua_State *L, CallInfo *ci) { } vmcase(OP_SELF) { StkId ra = RA(i); - const TValue *slot; + lu_byte tag; TValue *rb = vRB(i); - TValue *rc = RKC(i); - TString *key = tsvalue(rc); /* key must be a string */ + TValue *rc = KC(i); + TString *key = tsvalue(rc); /* key must be a short string */ 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, slot)); + luaV_fastget(rb, key, s2v(ra), luaH_getshortstr, tag); + if (tagisempty(tag)) + Protect(luaV_finishget(L, rb, rc, ra, tag)); vmbreak; } vmcase(OP_ADDI) { @@ -1410,6 +1454,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmbreak; } vmcase(OP_MODK) { + savestate(L, ci); /* in case of division by 0 */ op_arithK(L, luaV_mod, luaV_modf); vmbreak; } @@ -1422,6 +1467,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmbreak; } vmcase(OP_IDIVK) { + savestate(L, ci); /* in case of division by 0 */ op_arithK(L, luaV_idiv, luai_numidiv); vmbreak; } @@ -1437,23 +1483,23 @@ void luaV_execute (lua_State *L, CallInfo *ci) { op_bitwiseK(L, l_bxor); vmbreak; } - vmcase(OP_SHRI) { + vmcase(OP_SHLI) { StkId ra = RA(i); TValue *rb = vRB(i); int ic = GETARG_sC(i); lua_Integer ib; if (tointegerns(rb, &ib)) { - pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic)); + pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib)); } vmbreak; } - vmcase(OP_SHLI) { + vmcase(OP_SHRI) { StkId ra = RA(i); TValue *rb = vRB(i); int ic = GETARG_sC(i); lua_Integer ib; if (tointegerns(rb, &ib)) { - pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib)); + pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic)); } vmbreak; } @@ -1470,6 +1516,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmbreak; } vmcase(OP_MOD) { + savestate(L, ci); /* in case of division by 0 */ op_arith(L, luaV_mod, luaV_modf); vmbreak; } @@ -1482,6 +1529,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmbreak; } vmcase(OP_IDIV) { /* floor division */ + savestate(L, ci); /* in case of division by 0 */ op_arith(L, luaV_idiv, luai_numidiv); vmbreak; } @@ -1497,14 +1545,14 @@ void luaV_execute (lua_State *L, CallInfo *ci) { 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_SHR) { + op_bitwise(L, luaV_shiftr); + vmbreak; + } vmcase(OP_MMBIN) { StkId ra = RA(i); Instruction pi = *(pc - 2); /* original arith. expression */ @@ -1585,6 +1633,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { } vmcase(OP_CLOSE) { StkId ra = RA(i); + lua_assert(!GETARG_B(i)); /* 'close must be alive */ Protect(luaF_close(L, ra, LUA_OK, 1)); vmbreak; } @@ -1676,7 +1725,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { if (b != 0) /* fixed number of arguments? */ L->top.p = ra + b; /* top signals number of arguments */ /* else previous instruction set top */ - savepc(L); /* in case of errors */ + savepc(ci); /* in case of errors */ if ((newci = luaD_precall(L, ra, nresults)) == NULL) updatetrap(ci); /* C call; nothing else to be done */ else { /* Lua call: run function in this same C frame */ @@ -1742,10 +1791,10 @@ void luaV_execute (lua_State *L, CallInfo *ci) { trap = 1; } else { /* do the 'poscall' here */ - int nres; + int nres = get_nresults(ci->callstatus); L->ci = ci->previous; /* back to caller */ L->top.p = base - 1; - for (nres = ci->nresults; l_unlikely(nres > 0); nres--) + for (; l_unlikely(nres > 0); nres--) setnilvalue(s2v(L->top.p++)); /* all results are nil */ } goto ret; @@ -1759,7 +1808,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) { trap = 1; } else { /* do the 'poscall' here */ - int nres = ci->nresults; + int nres = get_nresults(ci->callstatus); L->ci = ci->previous; /* back to caller */ if (nres == 0) L->top.p = base - 1; /* asked for no results */ @@ -1781,15 +1830,14 @@ void luaV_execute (lua_State *L, CallInfo *ci) { } vmcase(OP_FORLOOP) { StkId ra = RA(i); - if (ttisinteger(s2v(ra + 2))) { /* integer loop? */ - lua_Unsigned count = l_castS2U(ivalue(s2v(ra + 1))); + if (ttisinteger(s2v(ra + 1))) { /* integer loop? */ + lua_Unsigned count = l_castS2U(ivalue(s2v(ra))); 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 */ + lua_Integer step = ivalue(s2v(ra + 1)); + lua_Integer idx = ivalue(s2v(ra + 2)); /* control variable */ + chgivalue(s2v(ra), l_castU2S(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 */ + chgivalue(s2v(ra + 2), idx); /* update control variable */ pc -= GETARG_Bx(i); /* jump back */ } } @@ -1806,26 +1854,38 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmbreak; } vmcase(OP_TFORPREP) { + /* before: 'ra' has the iterator function, 'ra + 1' has the state, + 'ra + 2' has the initial value for the control variable, and + 'ra + 3' has the closing variable. This opcode then swaps the + control and the closing variables and marks the closing variable + as to-be-closed. + */ StkId ra = RA(i); - /* create to-be-closed upvalue (if needed) */ - halfProtect(luaF_newtbcupval(L, ra + 3)); - pc += GETARG_Bx(i); - i = *(pc++); /* go to next instruction */ + TValue temp; /* to swap control and closing variables */ + setobj(L, &temp, s2v(ra + 3)); + setobjs2s(L, ra + 3, ra + 2); + setobj2s(L, ra + 2, &temp); + /* create to-be-closed upvalue (if closing var. is not nil) */ + halfProtect(luaF_newtbcupval(L, ra + 2)); + pc += GETARG_Bx(i); /* go to end of the loop */ + i = *(pc++); /* fetch next instruction */ lua_assert(GET_OPCODE(i) == OP_TFORCALL && ra == RA(i)); goto l_tforcall; } vmcase(OP_TFORCALL) { l_tforcall: { - StkId ra = RA(i); /* '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') + 'ra + 2' has the closing variable, and 'ra + 3' has the control + variable. The call will use the stack starting at 'ra + 3', + so that it preserves the first three values, and the first + return will be the new value for the control variable. */ - /* push function, state, and control variable */ - memcpy(ra + 4, ra, 3 * sizeof(*ra)); - L->top.p = ra + 4 + 3; - ProtectNT(luaD_call(L, ra + 4, GETARG_C(i))); /* do the call */ + StkId ra = RA(i); + setobjs2s(L, ra + 5, ra + 3); /* copy the control variable */ + setobjs2s(L, ra + 4, ra + 1); /* copy state */ + setobjs2s(L, ra + 3, ra); /* copy function */ + L->top.p = ra + 3 + 3; + ProtectNT(luaD_call(L, ra + 3, 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)); @@ -1834,31 +1894,33 @@ void luaV_execute (lua_State *L, CallInfo *ci) { vmcase(OP_TFORLOOP) { l_tforloop: { StkId ra = RA(i); - if (!ttisnil(s2v(ra + 4))) { /* continue loop? */ - setobjs2s(L, ra + 2, ra + 4); /* save control variable */ + if (!ttisnil(s2v(ra + 3))) /* continue loop? */ pc -= GETARG_Bx(i); /* jump back */ - } vmbreak; }} vmcase(OP_SETLIST) { StkId ra = RA(i); - int n = GETARG_B(i); - unsigned int last = GETARG_C(i); + unsigned n = cast_uint(GETARG_vB(i)); + unsigned last = cast_uint(GETARG_vC(i)); Table *h = hvalue(s2v(ra)); if (n == 0) - n = cast_int(L->top.p - ra) - 1; /* get up to the top */ + n = cast_uint(L->top.p - ra) - 1; /* get up to the top */ else L->top.p = ci->top.p; /* correct top in case of emergency GC */ last += n; if (TESTARG_k(i)) { - last += GETARG_Ax(*pc) * (MAXARG_C + 1); + last += cast_uint(GETARG_Ax(*pc)) * (MAXARG_vC + 1); pc++; } - if (last > luaH_realasize(h)) /* needs more space? */ + /* when 'n' is known, table should have proper size */ + if (last > h->asize) { /* needs more space? */ + /* fixed-size sets should have space preallocated */ + lua_assert(GETARG_vB(i) == 0); luaH_resizearray(L, h, last); /* preallocate it at once */ + } for (; n > 0; n--) { TValue *val = s2v(ra + n); - setobj2t(L, &h->array[last - 1], val); + obj2arr(h, last - 1, val); last--; luaC_barrierback(L, obj2gco(h), val); } @@ -1877,8 +1939,20 @@ void luaV_execute (lua_State *L, CallInfo *ci) { Protect(luaT_getvarargs(L, ci, ra, n)); vmbreak; } + vmcase(OP_GETVARG) { + StkId ra = RA(i); + TValue *rc = vRC(i); + luaT_getvararg(ci, ra, rc); + vmbreak; + } + vmcase(OP_ERRNNIL) { + TValue *ra = vRA(i); + if (!ttisnil(ra)) + halfProtect(luaG_errnnil(L, cl, GETARG_Bx(i))); + vmbreak; + } vmcase(OP_VARARGPREP) { - ProtectNT(luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p)); + ProtectNT(luaT_adjustvarargs(L, ci, cl->p)); if (l_unlikely(trap)) { /* previous "Protect" updated trap */ luaD_hookcall(L, ci); L->oldpc = 1; /* next opcode will be seen as a "new" line */ diff --git a/lvm.h b/lvm.h index dba1ad2770..be7b9cb0ea 100644 --- a/lvm.h +++ b/lvm.h @@ -43,7 +43,7 @@ typedef enum { F2Ieq, /* no rounding; accepts only integral values */ F2Ifloor, /* takes the floor of the number */ - F2Iceil /* takes the ceil of the number */ + F2Iceil /* takes the ceiling of the number */ } F2Imod; @@ -76,38 +76,33 @@ typedef enum { /* -** 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. +** fast track for 'gettable' */ -#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 */ \ - !isempty(slot))) /* result not empty? */ +#define luaV_fastget(t,k,res,f, tag) \ + (tag = (!ttistable(t) ? LUA_VNOTABLE : f(hvalue(t), k, res))) /* ** Special case of 'luaV_fastget' for integers, inlining the fast case ** of 'luaH_getint'. */ -#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_fastgeti(t,k,res,tag) \ + if (!ttistable(t)) tag = LUA_VNOTABLE; \ + else { luaH_fastgeti(hvalue(t), k, res, tag); } + + +#define luaV_fastset(t,k,val,hres,f) \ + (hres = (!ttistable(t) ? HNOTATABLE : f(hvalue(t), k, val))) + +#define luaV_fastseti(t,k,val,hres) \ + if (!ttistable(t)) hres = HNOTATABLE; \ + else { luaH_fastseti(hvalue(t), k, val, hres); } /* -** Finish a fast set operation (when fast get succeeds). In that case, -** 'slot' points to the place to put the value. +** Finish a fast set operation (when fast set succeeds). */ -#define luaV_finishfastset(L,t,slot,v) \ - { setobj2t(L, cast(TValue *,slot), v); \ - luaC_barrierback(L, gcvalue(t), v); } +#define luaV_finishfastset(L,t,v) luaC_barrierback(L, gcvalue(t), v) /* @@ -125,10 +120,10 @@ 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 lu_byte luaV_finishget (lua_State *L, const TValue *t, TValue *key, + StkId val, lu_byte tag); LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key, - TValue *val, const TValue *slot); + TValue *val, int aux); LUAI_FUNC void luaV_finishOp (lua_State *L); LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci); LUAI_FUNC void luaV_concat (lua_State *L, int total); diff --git a/lzio.c b/lzio.c index cd0a02d5f9..301df4b94e 100644 --- a/lzio.c +++ b/lzio.c @@ -14,6 +14,7 @@ #include "lua.h" +#include "lapi.h" #include "llimits.h" #include "lmem.h" #include "lstate.h" @@ -45,17 +46,25 @@ void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) { /* --------------------------------------------------------------- read --- */ + +static int checkbuffer (ZIO *z) { + if (z->n == 0) { /* no bytes in buffer? */ + if (luaZ_fill(z) == EOZ) /* try to read more */ + return 0; /* no more input */ + else { + z->n++; /* luaZ_fill consumed first byte; put it back */ + z->p--; + } + } + return 1; /* now buffer has something */ +} + + size_t luaZ_read (ZIO *z, void *b, size_t n) { while (n) { size_t m; - if (z->n == 0) { /* no bytes in buffer? */ - if (luaZ_fill(z) == EOZ) /* try to read more */ - return n; /* no more input; return number of missing bytes */ - else { - z->n++; /* luaZ_fill consumed first byte; put it back */ - z->p--; - } - } + if (!checkbuffer(z)) + return n; /* no more input; return number of missing bytes */ m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ memcpy(b, z->p, m); z->n -= m; @@ -66,3 +75,15 @@ size_t luaZ_read (ZIO *z, void *b, size_t n) { return 0; } + +const void *luaZ_getaddr (ZIO* z, size_t n) { + const void *res; + if (!checkbuffer(z)) + return NULL; /* no more input */ + if (z->n < n) /* not enough bytes? */ + return NULL; /* block not whole; cannot give an address */ + res = z->p; /* get block address */ + z->n -= n; /* consume these bytes */ + z->p += n; + return res; +} diff --git a/lzio.h b/lzio.h index 38f397fd28..49047c98cb 100644 --- a/lzio.h +++ b/lzio.h @@ -32,7 +32,7 @@ typedef struct Mbuffer { #define luaZ_sizebuffer(buff) ((buff)->buffsize) #define luaZ_bufflen(buff) ((buff)->n) -#define luaZ_buffremove(buff,i) ((buff)->n -= (i)) +#define luaZ_buffremove(buff,i) ((buff)->n -= cast_sizet(i)) #define luaZ_resetbuffer(buff) ((buff)->n = 0) @@ -48,6 +48,7 @@ LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data); LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */ +LUAI_FUNC const void *luaZ_getaddr (ZIO* z, size_t n); /* --------- Private Part ------------------ */ diff --git a/makefile b/makefile index ee56c67205..8674519f5f 100644 --- a/makefile +++ b/makefile @@ -8,20 +8,18 @@ CWARNSCPP= \ -Wfatal-errors \ -Wextra \ -Wshadow \ - -Wsign-compare \ -Wundef \ -Wwrite-strings \ -Wredundant-decls \ -Wdisabled-optimization \ -Wdouble-promotion \ -Wmissing-declarations \ + -Wconversion \ # the next warnings might be useful sometimes, # but usually they generate too much noise + # -Wstrict-overflow=2 \ # -Werror \ # -pedantic # warns if we use jump tables \ - # -Wconversion \ - # -Wsign-conversion \ - # -Wstrict-overflow=2 \ # -Wformat=2 \ # -Wcast-qual \ @@ -60,20 +58,22 @@ CWARNS= $(CWARNSCPP) $(CWARNSC) $(CWARNGCC) # The following options help detect "undefined behavior"s that seldom # create problems; some are only available in newer gcc versions. To -# use some of them, we also have to define an enrivonment variable +# use some of them, we also have to define an environment variable # ASAN_OPTIONS="detect_invalid_pointer_pairs=2". # -fsanitize=undefined # -fsanitize=pointer-subtract -fsanitize=address -fsanitize=pointer-compare -# TESTS= -DLUA_USER_H='"ltests.h"' -O0 -g +# TESTS= -DLUA_USER_H='"ltests.h"' -Og -g LOCAL = $(TESTS) $(CWARNS) -# enable Linux goodies -MYCFLAGS= $(LOCAL) -std=c99 -DLUA_USE_LINUX -DLUA_USE_READLINE -MYLDFLAGS= $(LOCAL) -Wl,-E -MYLIBS= -ldl -lreadline +# To enable Linux goodies, -DLUA_USE_LINUX +# For C89, "-std=c89 -DLUA_USE_C89" +# Note that Linux/Posix options are not compatible with C89 +MYCFLAGS= $(LOCAL) -std=c99 -DLUA_USE_LINUX +MYLDFLAGS= -Wl,-E +MYLIBS= -ldl CC= gcc @@ -145,40 +145,45 @@ $(ALL_O): makefile ltests.h lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \ ltable.h lundump.h lvm.h -lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h -lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h llimits.h +lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.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 -lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h + ldo.h lgc.h lstring.h ltable.h lvm.h lopnames.h +lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h -ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \ ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \ lparser.h lstring.h ltable.h lundump.h lvm.h -ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \ - ltm.h lzio.h lmem.h lundump.h +ldump.o: ldump.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ + lobject.h ltm.h lzio.h lmem.h lgc.h ltable.h lundump.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 -liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h llimits.h +liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \ lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \ lstring.h ltable.h -lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h -loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \ ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \ lvm.h -lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h -loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h \ + lobject.h +loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h lparser.o: lparser.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 lfunc.h lstring.h lgc.h ltable.h @@ -187,25 +192,28 @@ lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lstring.h ltable.h lstring.o: lstring.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 -lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h -ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h ltests.o: ltests.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h lauxlib.h lcode.h llex.h lopcodes.h \ lparser.h lctype.h ldebug.h ldo.h lfunc.h lopnames.h lstring.h lgc.h \ ltable.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 lgc.h lstring.h ltable.h lvm.h -lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h +lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.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 ljumptab.h -lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \ - lobject.h ltm.h lzio.h + ltable.h lundump.h +lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \ + llimits.h +lvm.o: lvm.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ + lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \ + lstring.h ltable.h lvm.h ljumptab.h +lzio.o: lzio.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ + lobject.h ltm.h lzio.h lmem.h # (end of Makefile) diff --git a/manual/2html b/manual/2html index a4d860ddfd..b7afd2a6e4 100755 --- a/manual/2html +++ b/manual/2html @@ -8,11 +8,11 @@ --------------------------------------------------------------- header = [[ - + -Codestin Search App +Codestin Search App @@ -23,14 +23,14 @@ header = [[

[Lua logo] -Lua 5.4 Reference Manual +Lua 5.5 Reference Manual

by Roberto Ierusalimschy, Luiz Henrique de Figueiredo, Waldemar Celes

Copyright -© 2022 Lua.org, PUC-Rio. All rights reserved. +© 2025 Lua.org, PUC-Rio. All rights reserved.

@@ -358,7 +358,7 @@ item = function (s) local t, p = string.match(s, "^([^\n|]+)|()") if t then s = string.sub(s, p) - s = Tag.b(t..": ") .. s + s = Tag.b(t) ..": " .. s end return Tag.li(fixpara(s)) end, diff --git a/manual/manual.of b/manual/manual.of index 6d19e251e5..9b6976ca05 100644 --- a/manual/manual.of +++ b/manual/manual.of @@ -20,7 +20,7 @@ making it ideal for configuration, scripting, and rapid prototyping. Lua is implemented as a library, written in @emphx{clean C}, -the common subset of @N{Standard C} and C++. +the common subset of @N{standard C} and C++. The Lua distribution includes a host program called @id{lua}, which uses the Lua library to offer a complete, standalone Lua interpreter, @@ -127,7 +127,8 @@ strings can contain any 8-bit value, including @x{embedded zeros} (@Char{\0}). Lua is also encoding-agnostic; it makes no assumptions about the contents of a string. -The length of any string in Lua must fit in a Lua integer. +The length of any string in Lua must fit in a Lua integer, +and the string plus a small header must fit in @id{size_t}. Lua can call (and manipulate) functions written in Lua and functions written in C @see{functioncall}. @@ -213,11 +214,89 @@ of a given value @seeF{type}. } -@sect2{globalenv| @title{Environments and the Global Environment} +@sect2{globalenv| @title{Scopes, Variables, and Environments} +@index{visibility} + +A variable name refers to a global or a local variable according +to the declaration that is in context at that point of the code. +(For the purposes of this discussion, +a function's formal parameter is equivalent to a local variable.) + +All chunks start with an implicit declaration @T{global *}, +which declares all free names as global variables; +this preambular declaration becomes void inside the scope of any other +@Rw{global} declaration, +as the following example illustrates: +@verbatim{ +X = 1 -- Ok, global by default +do + global Y -- voids the implicit initial declaration + Y = 1 -- Ok, Y declared as global + X = 1 -- ERROR, X not declared +end +X = 2 -- Ok, global by default again +} +So, outside any global declaration, +Lua works as @x{global-by-default}. +Inside any global declaration, +Lua works without a default: +All variables must be declared. + +Lua is a lexically scoped language. +The scope of a variable declaration begins at the first statement after +the declaration and lasts until the last non-void statement +of the innermost block that includes the declaration. +(@emph{Void statements} are labels and empty statements.) + +A declaration shadows any declaration for the same name that +is in context at the point of the declaration. Inside this +shadow, any outer declaration for that name is void. +See the next example: +@verbatim{ +global print, x +x = 10 -- global variable +do -- new block + local x = x -- new 'x', with value 10 + print(x) --> 10 + x = x+1 + do -- another block + local x = x+1 -- another 'x' + print(x) --> 12 + end + print(x) --> 11 +end +print(x) --> 10 (the global one) +} + +Notice that, in a declaration like @T{local x = x}, +the new @id{x} being declared is not in scope yet, +and so the @id{x} on the right-hand side refers to the outside variable. + +Because of the @x{lexical scoping} rules, +local variables can be freely accessed by functions +defined inside their scope. +A local variable used by an inner function is called an @def{upvalue} +(or @emphx{external local variable}, or simply @emphx{external variable}) +inside the inner function. + +Notice that each execution of a @Rw{local} statement +defines new local variables. +Consider the following example: +@verbatim{ +a = {} +local x = 20 +for i = 1, 10 do + local y = 0 + a[i] = function () y = y + 1; return x + y end +end +} +The loop creates ten closures +(that is, ten instances of the anonymous function). +Each of these closures uses a different @id{y} variable, +while all of them share the same @id{x}. As we will discuss further in @refsec{variables} and @refsec{assignment}, -any reference to a free name -(that is, a name not bound to any declaration) @id{var} +any reference to a global variable @id{var} is syntactically translated to @T{_ENV.var}. Moreover, every chunk is compiled in the scope of an external local variable named @id{_ENV} @see{chunks}, @@ -225,12 +304,14 @@ so @id{_ENV} itself is never a free name in a chunk. Despite the existence of this external @id{_ENV} variable and the translation of free names, -@id{_ENV} is a completely regular name. +@id{_ENV} is a regular name. In particular, you can define new variables and parameters with that name. -Each reference to a free name uses the @id{_ENV} that is -visible at that point in the program, -following the usual visibility rules of Lua @see{visibility}. +(However, you should not define @id{_ENV} as a global variable, +otherwise @T{_ENV.var} would translate to +@T{_ENV._ENV.var} and so on, in an infinite loop.) +Each reference to a global variable name uses the @id{_ENV} that is +visible at that point in the program. Any table used as the value of @id{_ENV} is called an @def{environment}. @@ -244,8 +325,8 @@ When Lua loads a chunk, the default value for its @id{_ENV} variable is the global environment @seeF{load}. Therefore, by default, -free names in Lua code refer to entries in the global environment -and, therefore, they are also called @def{global variables}. +global variables in Lua code refer to entries in the global environment +and, therefore, they act as conventional global variables. Moreover, all standard libraries are loaded in the global environment and some functions there operate on that environment. You can use @Lid{load} (or @Lid{loadfile}) @@ -289,8 +370,10 @@ Whenever there is an error, an @def{error object} is propagated with information about the error. Lua itself only generates errors whose error object is a string, -but programs may generate errors with -any value as the error object. +but programs can generate errors with +any value as the error object, +except @nil. +(Lua will change a @nil as error object to a string message.) It is up to the Lua program or its host to handle such error objects. For historical reasons, an error object is often called an @def{error message}, @@ -298,7 +381,7 @@ even though it does not have to be a string. When you use @Lid{xpcall} (or @Lid{lua_pcall}, in C) -you may give a @def{message handler} +you can give a @def{message handler} to be called in case of errors. This function is called with the original error object and returns a new error object. @@ -343,7 +426,7 @@ which is then called a @def{metamethod}. In the previous example, the key is the string @St{__add} and the metamethod is the function that performs the addition. Unless stated otherwise, -a metamethod may in fact be any @x{callable value}, +a metamethod can in fact be any @x{callable value}, which is either a function or a value with a @idx{__call} metamethod. You can query the metatable of any value @@ -608,8 +691,8 @@ An object is considered @def{dead} as soon as the collector can be sure the object will not be accessed again in the normal execution of the program. (@Q{Normal execution} here excludes finalizers, -which can resurrect dead objects @see{finalizers}, -and excludes also operations using the debug library.) +which resurrect dead objects @see{finalizers}, +and it excludes also some operations using the debug library.) Note that the time when the collector can be sure that an object is dead may not coincide with the programmer's expectations. The only guarantees are that Lua will not collect an object @@ -621,7 +704,8 @@ that is inaccessible from Lua. another live object refer to the object.) Because Lua has no knowledge about @N{C code}, it never collects objects accessible through the registry @see{registry}, -which includes the global environment @see{globalenv}. +which includes the global environment @see{globalenv} and +the main thread. The garbage collector (GC) in Lua can work in two modes: @@ -638,8 +722,8 @@ therefore, optimal settings are also non-portable. You can change the GC mode and parameters by calling @Lid{lua_gc} @N{in C} or @Lid{collectgarbage} in Lua. -You can also use these functions to control -the collector directly (e.g., to stop and restart it). +You can also use these functions to control the collector directly, +for instance to stop or restart it. } @@ -656,39 +740,32 @@ and the @def{garbage-collector step size}. The garbage-collector pause controls how long the collector waits before starting a new cycle. -The collector starts a new cycle when the use of memory -hits @M{n%} of the use after the previous collection. +The collector starts a new cycle when the number of bytes +hits @M{n%} of the total after the previous collection. Larger values make the collector less aggressive. Values equal to or less than 100 mean the collector will not wait to start a new cycle. -A value of 200 means that the collector waits for the total memory in use -to double before starting a new cycle. -The default value is 200; the maximum value is 1000. - -The garbage-collector step multiplier -controls the speed of the collector relative to -memory allocation, -that is, -how many elements it marks or sweeps for each -kilobyte of memory allocated. -Larger values make the collector more aggressive but also increase -the size of each incremental step. -You should not use values less than 100, -because they make the collector too slow and -can result in the collector never finishing a cycle. -The default value is 100; the maximum value is 1000. +A value of 200 means that the collector waits for +the total number of bytes to double before starting a new cycle. The garbage-collector step size controls the size of each incremental step, specifically how many bytes the interpreter allocates -before performing a step. -This parameter is logarithmic: -A value of @M{n} means the interpreter will allocate @M{2@sp{n}} -bytes between steps and perform equivalent work during the step. -A large value (e.g., 60) makes the collector a stop-the-world -(non-incremental) collector. -The default value is 13, -which means steps of approximately @N{8 Kbytes}. +before performing a step: +A value of @M{n} means the interpreter will allocate +approximately @M{n} bytes between steps. + +The garbage-collector step multiplier +controls how much work each incremental step does. +A value of @M{n} means the interpreter will execute +@M{n%} @emphx{units of work} for each word allocated. +A unit of work corresponds roughly to traversing one slot +or sweeping one object. +Larger values make the collector more aggressive. +Beware that values too small can +make the collector too slow to ever finish a cycle. +As a special case, a zero value means unlimited work, +effectively producing a non-incremental, stop-the-world collector. } @@ -697,31 +774,45 @@ which means steps of approximately @N{8 Kbytes}. In generational mode, the collector does frequent @emph{minor} collections, which traverses only objects recently created. -If after a minor collection the use of memory is still above a limit, -the collector does a stop-the-world @emph{major} collection, +If after a minor collection the number of bytes is above a limit, +the collector shifts to a @emph{major} collection, which traverses all objects. -The generational mode uses two parameters: -the @def{minor multiplier} and the @def{the major multiplier}. +The collector will then stay doing major collections until +it detects that the program is generating enough garbage to justify +going back to minor collections. + +The generational mode uses three parameters: +the @def{minor multiplier}, the @def{minor-major multiplier}, +and the @def{major-minor multiplier}. The minor multiplier controls the frequency of minor collections. For a minor multiplier @M{x}, -a new minor collection will be done when memory -grows @M{x%} larger than the memory in use after the previous major -collection. +a new minor collection will be done when the number of bytes +grows @M{x%} larger than the number in use just +after the last major collection. For instance, for a multiplier of 20, -the collector will do a minor collection when the use of memory -gets 20% larger than the use after the previous major collection. -The default value is 20; the maximum value is 200. - -The major multiplier controls the frequency of major collections. -For a major multiplier @M{x}, -a new major collection will be done when memory -grows @M{x%} larger than the memory in use after the previous major -collection. +the collector will do a minor collection when the number of bytes +gets 20% larger than the total after the last major collection. + +The minor-major multiplier controls the shift to major collections. +For a multiplier @M{x}, +the collector will shift to a major collection +when the number of bytes from old objects grows @M{x%} larger +than the total after the previous major collection. For instance, for a multiplier of 100, -the collector will do a major collection when the use of memory -gets larger than twice the use after the previous collection. -The default value is 100; the maximum value is 1000. +the collector will do a major collection when the number of old bytes +gets larger than twice the total after the previous major collection. +As a special case, +a value of 0 stops the collector from doing major collections. + +The major-minor multiplier controls the shift back to minor collections. +For a multiplier @M{x}, +the collector will shift back to minor collections +after a major collection collects at least @M{x%} +of the bytes allocated during the last cycle. +In particular, for a multiplier of 0, +the collector will immediately shift back to minor collections +after doing one major collection. } @@ -1021,9 +1112,9 @@ and cannot be used as names: @index{reserved words} @verbatim{ and break do else elseif end -false for function goto if in -local nil not or repeat return -then true until while +false for function global goto if +in local nil not or repeat +return then true until while } Lua is a case-sensitive language: @@ -1188,17 +1279,15 @@ global variables, local variables, and table fields. A single name can denote a global variable or a local variable (or a function's formal parameter, -which is a particular kind of local variable): +which is a particular kind of local variable) @see{globalenv}: @Produc{ @producname{var}@producbody{@bnfNter{Name}} } @bnfNter{Name} denotes identifiers @see{lexical}. -Any variable name is assumed to be global unless explicitly declared -as a local @see{localvar}. -@x{Local variables} are @emph{lexically scoped}: +Because variables are @emph{lexically scoped}, local variables can be freely accessed by functions -defined inside their scope @see{visibility}. +defined inside their scope @see{globalenv}. Before the first assignment to a variable, its value is @nil. @@ -1217,8 +1306,6 @@ The syntax @id{var.Name} is just syntactic sugar for An access to a global variable @id{x} is equivalent to @id{_ENV.x}. -Due to the way that chunks are compiled, -the variable @id{_ENV} itself is never global @see{globalenv}. } @@ -1316,6 +1403,8 @@ Chunks can also be precompiled into binary form; see the program @idx{luac} and the function @Lid{string.dump} for details. Programs in source and compiled forms are interchangeable; Lua automatically detects the file type and acts accordingly @seeF{load}. +Be aware that, unlike source code, +maliciously crafted binary chunks can crash the interpreter. } @@ -1417,10 +1506,10 @@ labels in Lua are considered statements too: A label is visible in the entire block where it is defined, except inside nested functions. -A goto may jump to any visible label as long as it does not -enter into the scope of a local variable. +A goto can jump to any visible label as long as it does not +enter into the scope of a variable declaration. A label should not be declared -where a label with the same name is visible, +where a previous label with the same name is visible, even if this other label has been declared in an enclosing block. The @Rw{break} statement terminates the execution of a @@ -1467,7 +1556,8 @@ It has the following syntax: exp @bnfter{,} exp @bnfopt{@bnfter{,} exp} @Rw{do} block @Rw{end}} } The given identifier (@bnfNter{Name}) defines the control variable, -which is a new variable local to the loop body (@emph{block}). +which is a new read-only (@id{const}) variable local to the loop body +(@emph{block}). The loop starts by evaluating once the three control expressions. Their values are called respectively @@ -1499,11 +1589,6 @@ For integer loops, the control variable never wraps around; instead, the loop ends in case of an overflow. -You should not change the value of the control variable -during the loop. -If you need its value after the loop, -assign it to another variable before exiting the loop. - } @sect4{@title{The generic @Rw{for} loop} @@ -1526,7 +1611,8 @@ for @rep{var_1}, @Cdots, @rep{var_n} in @rep{explist} do @rep{body} end works as follows. The names @rep{var_i} declare loop variables local to the loop body. -The first of these variables is the @emph{control variable}. +The first of these variables is the @emph{control variable}, +which is a read-only (@id{const}) variable. The loop starts by evaluating @rep{explist} to produce four values: @@ -1550,9 +1636,6 @@ to-be-closed variable @see{to-be-closed}, which can be used to release resources when the loop ends. Otherwise, it does not interfere with the loop. -You should not change the value of the control variable -during the loop. - } } @@ -1568,34 +1651,91 @@ Function calls are explained in @See{functioncall}. } -@sect3{localvar| @title{Local Declarations} -@x{Local variables} can be declared anywhere inside a block. +@sect3{localvar| @title{Variable Declarations} +Local and global variables can be declared anywhere inside a block. The declaration can include an initialization: @Produc{ -@producname{stat}@producbody{@Rw{local} attnamelist @bnfopt{@bnfter{=} explist}} -@producname{attnamelist}@producbody{ - @bnfNter{Name} attrib @bnfrep{@bnfter{,} @bnfNter{Name} attrib}} -} -If present, an initial assignment has the same semantics +@producname{stat}@producbody{@Rw{local} + attnamelist @bnfopt{@bnfter{=} explist}} +@producname{stat}@producbody{@Rw{global} + attnamelist @bnfopt{@bnfter{=} explist}} +} +If there is no initialization, +local variables are initialized with @nil; +global variables are left unchanged. +Otherwise, the initialization gets the same adjustment of a multiple assignment @see{assignment}. -Otherwise, all variables are initialized with @nil. - -Each variable name may be postfixed by an attribute -(a name between angle brackets): +Moreover, for global variables, +the initialization will raise a runtime error +if the variable is already defined, +that is, it has a non-nil value. + +The list of names may be prefixed by an attribute +(a name between angle brackets) +and each variable name may be postfixed by an attribute: @Produc{ -@producname{attrib}@producbody{@bnfopt{@bnfter{<} @bnfNter{Name} @bnfter{>}}} +@producname{attnamelist}@producbody{ + @bnfopt{attrib} @bnfNter{Name} @bnfopt{attrib} + @bnfrep{@bnfter{,} @bnfNter{Name} @bnfopt{attrib}}} +@producname{attrib}@producbody{@bnfter{<} @bnfNter{Name} @bnfter{>}} } +A prefixed attribute applies to all names in the list; +a postfixed attribute applies to its particular name. There are two possible attributes: -@id{const}, which declares a @x{constant variable}, -that is, a variable that cannot be assigned to -after its initialization; +@id{const}, which declares a @emph{constant} or @emph{read-only} variable, +@index{constant variable} +that is, a variable that cannot be used as the left-hand side of an +assignment, and @id{close}, which declares a to-be-closed variable @see{to-be-closed}. +Only local variables can have the @id{close} attribute. A list of variables can contain at most one to-be-closed variable. +Lua offers also a collective declaration for global variables: +@Produc{ +@producname{stat}@producbody{@Rw{global} @bnfopt{attrib} @bnfter{*}} +} +This special form implicitly declares +as globals all names not explicitly declared previously. +In particular, +@T{global *} implicitly declares +as read-only globals all names not explicitly declared previously; +see the following example: +@verbatim{ +global X +global * +print(math.pi) -- Ok, 'print' and 'math' are read-only +X = 1 -- Ok, declared as read-write +Y = 1 -- Error, Y is read-only +} + +As noted in @See{globalenv}, +all chunks start with an implicit declaration @T{global *}, +but this preambular declaration becomes void inside +the scope of any other @Rw{global} declaration. +Therefore, a program that does not use global declarations +or start with @T{global *} +has free read-write access to any global; +a program that starts with @T{global *} +has free read-only access to any global; +and a program that starts with any other global declaration +(e.g., @T{global none}) can only refer to declared variables. + +Note that, for global variables, +the effect of any declaration is only syntactical +(except for the optional assignment): +@verbatim{ +global X , _G +X = 1 -- ERROR +_ENV.X = 1 -- Ok +_G.print(X) -- Ok +foo() -- 'foo' can freely change any global +} + A chunk is also a block @see{chunks}, -and so local variables can be declared in a chunk outside any explicit block. +and so variables can be declared in a chunk outside any explicit block. -The visibility rules for local variables are explained in @See{visibility}. +The visibility rules for variable declarations +are explained in @See{globalenv}. } @@ -1610,10 +1750,11 @@ or exiting by an error. Here, to @emph{close} a value means to call its @idx{__close} metamethod. When calling the metamethod, -the value itself is passed as the first argument -and the error object that caused the exit (if any) +the value itself is passed as the first argument. +If there was an error, +the error object that caused the exit is passed as a second argument; -if there was no error, the second argument is @nil. +otherwise, there is no second argument. The value assigned to a to-be-closed variable must have a @idx{__close} metamethod @@ -2127,7 +2268,7 @@ return x or f(x) -- results adjusted to 1 @sect3{func-def| @title{Function Definitions} -The syntax for function definition is +The syntax for a function definition is @Produc{ @producname{functiondef}@producbody{@Rw{function} funcbody} @producname{funcbody}@producbody{@bnfter{(} @bnfopt{parlist} @bnfter{)} block @Rw{end}} @@ -2137,6 +2278,7 @@ The following syntactic sugar simplifies function definitions: @Produc{ @producname{stat}@producbody{@Rw{function} funcname funcbody} @producname{stat}@producbody{@Rw{local} @Rw{function} @bnfNter{Name} funcbody} +@producname{stat}@producbody{@Rw{global} @Rw{function} @bnfNter{Name} funcbody} @producname{funcname}@producbody{@bnfNter{Name} @bnfrep{@bnfter{.} @bnfNter{Name}} @bnfopt{@bnfter{:} @bnfNter{Name}}} } The statement @@ -2155,6 +2297,7 @@ translates to @verbatim{ t.a.b.c.f = function () @rep{body} end } + The statement @verbatim{ local function f () @rep{body} end @@ -2168,7 +2311,29 @@ not to local f = function () @rep{body} end } (This only makes a difference when the body of the function -contains references to @id{f}.) +contains recursive references to @id{f}.) +Similarly, the statement +@verbatim{ +global function f () @rep{body} end +} +translates to +@verbatim{ +global f; global f = function () @rep{body} end +} +The second @Rw{global} makes the assignment an initialization, +which will raise an error if that global is already defined. + +The @emphx{colon} syntax +is used to emulate @def{methods}, +adding an implicit extra parameter @idx{self} to the function. +Thus, the statement +@verbatim{ +function t.a.b.c:f (@rep{params}) @rep{body} end +} +is syntactic sugar for +@verbatim{ +t.a.b.c.f = function (self, @rep{params}) @rep{body} end +} A function definition is an executable expression, whose value has type @emph{function}. @@ -2180,11 +2345,24 @@ the function is @emph{instantiated} (or @emph{closed}). This function instance, or @emphx{closure}, is the final value of the expression. +Results are returned using the @Rw{return} statement @see{control}. +If control reaches the end of a function +without encountering a @Rw{return} statement, +then the function returns with no results. + +@index{multiple return} +There is a system-dependent limit on the number of values +that a function may return. +This limit is guaranteed to be at least 1000. + +@sect4{@title{Parameters} + Parameters act as local variables that are initialized with the argument values: @Produc{ -@producname{parlist}@producbody{namelist @bnfopt{@bnfter{,} @bnfter{...}} @Or - @bnfter{...}} +@producname{parlist}@producbody{namelist @bnfopt{@bnfter{,} varargparam} @Or + varargparam} +@producname{varargparam}@producbody{@bnfter{...} @bnfopt{@bnfNter{Name}}} } When a Lua function is called, it adjusts its list of @x{arguments} to @@ -2194,11 +2372,12 @@ which is indicated by three dots (@Char{...}) at the end of its parameter list. A variadic function does not adjust its argument list; instead, it collects all extra arguments and supplies them -to the function through a @def{vararg expression}, -which is also written as three dots. -The value of this expression is a list of all actual extra arguments, -similar to a function with multiple results @see{multires}. +to the function through a @def{vararg expression} and, +if present, a @def{vararg table}. +A vararg expression is also written as three dots, +and its value is a list of all actual extra arguments, +similar to a function with multiple results @see{multires}. As an example, consider the following definitions: @verbatim{ @@ -2217,32 +2396,33 @@ f(3, 4, 5) a=3, b=4 f(r(), 10) a=1, b=10 f(r()) a=1, b=2 -g(3) a=3, b=nil, ... --> (nothing) -g(3, 4) a=3, b=4, ... --> (nothing) -g(3, 4, 5, 8) a=3, b=4, ... --> 5 8 -g(5, r()) a=5, b=1, ... --> 2 3 +g(3) a=3, b=nil, ... -> (nothing) +g(3, 4) a=3, b=4, ... -> (nothing) +g(3, 4, 5, 8) a=3, b=4, ... -> 5 8 +g(5, r()) a=5, b=1, ... -> 2 3 +} + +The presence of a varag table in a variadic function is indicated +by a name after the three dots. +When present, +a vararg table behaves like a read-only local variable +with the given name that is initialized with a table. +In that table, +the values at indices 1, 2, etc. are the extra arguments, +and the value at index @St{n} is the number of extra arguments. +In other words, the code behaves as if the function started with +the following statement, +assuming the standard behavior of @Lid{table.pack}: +@verbatim{ +local name = table.pack(...) } -Results are returned using the @Rw{return} statement @see{control}. -If control reaches the end of a function -without encountering a @Rw{return} statement, -then the function returns with no results. +As an optimization, +if the vararg table is used only as a base in indexing expressions +(the @T{t} in @T{t[exp]} or @T{t.id}) and it is not an upvalue, +the code does not create an actual table and instead translates +the indexing expressions into accesses to the internal vararg data. -@index{multiple return} -There is a system-dependent limit on the number of values -that a function may return. -This limit is guaranteed to be greater than 1000. - -The @emphx{colon} syntax -is used to emulate @def{methods}, -adding an implicit extra parameter @idx{self} to the function. -Thus, the statement -@verbatim{ -function t.a.b.c:f (@rep{params}) @rep{body} end -} -is syntactic sugar for -@verbatim{ -t.a.b.c.f = function (self, @rep{params}) @rep{body} end } } @@ -2276,8 +2456,8 @@ for instance @T{foo(e1, e2, e3)} @see{functioncall}.} @item{A multiple assignment, for instance @T{a , b, c = e1, e2, e3} @see{assignment}.} -@item{A local declaration, -for instance @T{local a , b, c = e1, e2, e3} @see{localvar}.} +@item{A local or global declaration, +which is similar to a multiple assignment.} @item{The initial values in a generic @rw{for} loop, for instance @T{for k in e1, e2, e3 do ... end} @see{for}.} @@ -2288,8 +2468,7 @@ the list of values from the list of expressions must be @emph{adjusted} to a specific length: the number of parameters in a call to a non-variadic function @see{func-def}, -the number of variables in a multiple assignment or -a local declaration, +the number of variables in a multiple assignment or a declaration, and exactly four values for a generic @rw{for} loop. The @def{adjustment} follows these rules: If there are more values than needed, @@ -2351,58 +2530,6 @@ return x,y,f() -- returns x, y, and all results from f(). } -@sect2{visibility| @title{Visibility Rules} - -@index{visibility} -Lua is a lexically scoped language. -The scope of a local variable begins at the first statement after -its declaration and lasts until the last non-void statement -of the innermost block that includes the declaration. -(@emph{Void statements} are labels and empty statements.) -Consider the following example: -@verbatim{ -x = 10 -- global variable -do -- new block - local x = x -- new 'x', with value 10 - print(x) --> 10 - x = x+1 - do -- another block - local x = x+1 -- another 'x' - print(x) --> 12 - end - print(x) --> 11 -end -print(x) --> 10 (the global one) -} - -Notice that, in a declaration like @T{local x = x}, -the new @id{x} being declared is not in scope yet, -and so the second @id{x} refers to the outside variable. - -Because of the @x{lexical scoping} rules, -local variables can be freely accessed by functions -defined inside their scope. -A local variable used by an inner function is called an @def{upvalue} -(or @emphx{external local variable}, or simply @emphx{external variable}) -inside the inner function. - -Notice that each execution of a @Rw{local} statement -defines new local variables. -Consider the following example: -@verbatim{ -a = {} -local x = 20 -for i = 1, 10 do - local y = 0 - a[i] = function () y = y + 1; return x + y end -end -} -The loop creates ten closures -(that is, ten instances of the anonymous function). -Each of these closures uses a different @id{y} variable, -while all of them share the same @id{x}. - -} } @@ -2569,8 +2696,8 @@ See also @Lid{luaL_checklstring}, @Lid{luaL_checkstring}, and @Lid{luaL_tolstring} in the auxiliary library.) In general, -Lua's garbage collection can free or move internal memory -and then invalidate pointers to internal strings. +Lua's garbage collection can free or move memory +and then invalidate pointers to strings handled by a Lua state. To allow a safe use of these pointers, the API guarantees that any pointer to a string in a stack index is valid while the string value at that index is not removed from the stack. @@ -2641,8 +2768,8 @@ string keys starting with an underscore followed by uppercase letters are reserved for Lua. The integer keys in the registry are used -by the reference mechanism @seeC{luaL_ref} -and by some predefined values. +by the reference mechanism @seeC{luaL_ref}, +with some predefined values. Therefore, integer keys in the registry must not be used for other purposes. @@ -2734,9 +2861,19 @@ status codes to indicate different kinds of errors or other conditions: For such errors, Lua does not call the @x{message handler}. } -@item{@defid{LUA_ERRERR}| error while running the @x{message handler}.} +@item{@defid{LUA_ERRERR}| +stack overflow while running the @x{message handler} +due to another stack overflow. +More often than not, +this error is the result of some other error while running +a message handler. +An error in a message handler will call the handler again, +which will generate the error again, and so on, +until this loop exhausts the stack and cause this error. +} -@item{@defid{LUA_ERRSYNTAX}| syntax error during precompilation.} +@item{@defid{LUA_ERRSYNTAX}| syntax error during precompilation +or format error in a binary chunk.} @item{@defid{LUA_YIELD}| the thread (coroutine) yields.} @@ -2914,7 +3051,7 @@ typedef void * (*lua_Alloc) (void *ud, size_t osize, size_t nsize);| -The type of the @x{memory-allocation function} used by Lua states. +The type of the @x{memory-allocator function} used by Lua states. The allocator function must provide a functionality similar to @id{realloc}, but not exactly the same. @@ -2949,11 +3086,12 @@ the allocator must behave like @id{realloc}. In particular, the allocator returns @id{NULL} if and only if it cannot fulfill the request. -Here is a simple implementation for the @x{allocator function}. -It is used in the auxiliary library by @Lid{luaL_newstate}. +Here is a simple implementation for the @x{allocator function}, +corresponding to the function @Lid{luaL_alloc} from the +auxiliary library. @verbatim{ -static void *l_alloc (void *ud, void *ptr, size_t osize, - size_t nsize) { +void *luaL_alloc (void *ud, void *ptr, size_t osize, + size_t nsize) { (void)ud; (void)osize; /* not used */ if (nsize == 0) { free(ptr); @@ -2963,7 +3101,7 @@ static void *l_alloc (void *ud, void *ptr, size_t osize, return realloc(ptr, nsize); } } -Note that @N{Standard C} ensures +Note that @N{ISO C} ensures that @T{free(NULL)} has no effect and that @T{realloc(NULL,size)} is equivalent to @T{malloc(size)}. @@ -3029,14 +3167,20 @@ When the function returns, all arguments and the function value are popped and the call results are pushed onto the stack. The number of results is adjusted to @id{nresults}, -unless @id{nresults} is @defid{LUA_MULTRET}. -In this case, all results from the function are pushed; +unless @id{nresults} is @defid{LUA_MULTRET}, +which makes all results from the function to be pushed. +In the first case, an explicit number of results, +the caller must ensure that the stack has space for the +returned values. +In the second case, all results, Lua takes care that the returned values fit into the stack space, but it does not ensure any extra space in the stack. The function results are pushed onto the stack in direct order (the first result is pushed first), so that after the call the last result is on the top of the stack. +The maximum value for @id{nresults} is 250. + Any error while calling and running the function is propagated upwards (with a @id{longjmp}). @@ -3163,7 +3307,32 @@ The index must be the last index previously marked to be closed A @idx{__close} metamethod cannot yield when called through this function. -(This function was introduced in @N{release 5.4.3}.) +} + +@APIEntry{int lua_closethread (lua_State *L, lua_State *from);| +@apii{0,?,-} + +Resets a thread, cleaning its call stack and closing all pending +to-be-closed variables. +The parameter @id{from} represents the coroutine that is resetting @id{L}. +If there is no such coroutine, +this parameter can be @id{NULL}. + +Unless @id{L} is equal to @id{from}, +the call returns a status code: +@Lid{LUA_OK} for no errors in the thread +(either the original error that stopped the thread or +errors in closing methods), +or an error status otherwise. +In case of error, +the error object is put on the top of the stack. + +If @id{L} is equal to @id{from}, +it corresponds to a thread closing itself. +In that case, +the call does not return; +instead, the resume that (re)started the thread returns. +The thread must be running inside a resume. } @@ -3212,18 +3381,18 @@ Values at other positions are not affected. } -@APIEntry{void lua_createtable (lua_State *L, int narr, int nrec);| +@APIEntry{void lua_createtable (lua_State *L, int nseq, int nrec);| @apii{0,1,m} Creates a new empty table and pushes it onto the stack. -Parameter @id{narr} is a hint for how many elements the table +Parameter @id{nseq} is a hint for how many elements the table will have as a sequence; parameter @id{nrec} is a hint for how many other elements the table will have. Lua may use these hints to preallocate memory for the new table. This preallocation may help performance when you know in advance how many elements the table will have. -Otherwise you can use the function @Lid{lua_newtable}. +Otherwise you should use the function @Lid{lua_newtable}. } @@ -3243,6 +3412,13 @@ As it produces parts of the chunk, with the given @id{data} to write them. +The function @Lid{lua_dump} fully preserves the Lua stack +through the calls to the writer function, +except that it may push some values for internal use +before the first call, +and it restores the stack size to its original size +after the last call. + If @id{strip} is true, the binary representation may not include all debug information about the function, @@ -3252,8 +3428,6 @@ The value returned is the error code returned by the last call to the writer; @N{0 means} no errors. -This function does not pop the Lua function from the stack. - } @APIEntry{int lua_error (lua_State *L);| @@ -3278,50 +3452,62 @@ For options that need extra arguments, they are listed after the option. @description{ -@item{@id{LUA_GCCOLLECT}| +@item{@defid{LUA_GCCOLLECT}| Performs a full garbage-collection cycle. } -@item{@id{LUA_GCSTOP}| +@item{@defid{LUA_GCSTOP}| Stops the garbage collector. } -@item{@id{LUA_GCRESTART}| +@item{@defid{LUA_GCRESTART}| Restarts the garbage collector. } -@item{@id{LUA_GCCOUNT}| +@item{@defid{LUA_GCCOUNT}| Returns the current amount of memory (in Kbytes) in use by Lua. } -@item{@id{LUA_GCCOUNTB}| +@item{@defid{LUA_GCCOUNTB}| Returns the remainder of dividing the current amount of bytes of memory in use by Lua by 1024. } -@item{@id{LUA_GCSTEP} @T{(int stepsize)}| -Performs an incremental step of garbage collection, -corresponding to the allocation of @id{stepsize} Kbytes. +@item{@defid{LUA_GCSTEP} (size_t n)| +Performs a step of garbage collection. } -@item{@id{LUA_GCISRUNNING}| +@item{@defid{LUA_GCISRUNNING}| Returns a boolean that tells whether the collector is running (i.e., not stopped). } -@item{@id{LUA_GCINC} (int pause, int stepmul, stepsize)| -Changes the collector to incremental mode -with the given parameters @see{incmode}. +@item{@defid{LUA_GCINC}| +Changes the collector to incremental mode. Returns the previous mode (@id{LUA_GCGEN} or @id{LUA_GCINC}). } -@item{@id{LUA_GCGEN} (int minormul, int majormul)| -Changes the collector to generational mode -with the given parameters @see{genmode}. +@item{@defid{LUA_GCGEN}| +Changes the collector to generational mode. Returns the previous mode (@id{LUA_GCGEN} or @id{LUA_GCINC}). } +@item{@defid{LUA_GCPARAM} (int param, int val)| +Changes and/or returns the value of a parameter of the collector. +If @id{val} is -1, the call only returns the current value. +The argument @id{param} must have one of the following values: +@description{ +@item{@defid{LUA_GCPMINORMUL}| The minor multiplier. } +@item{@defid{LUA_GCPMAJORMINOR}| The major-minor multiplier. } +@item{@defid{LUA_GCPMINORMAJOR}| The minor-major multiplier. } +@item{@defid{LUA_GCPPAUSE}| The garbage-collector pause. } +@item{@defid{LUA_GCPSTEPMUL}| The step multiplier. } +@item{@defid{LUA_GCPSTEPSIZE}| The step size. } +} +} + } + For more details about these options, see @Lid{collectgarbage}. @@ -3332,7 +3518,7 @@ This function should not be called by a finalizer. @APIEntry{lua_Alloc lua_getallocf (lua_State *L, void **ud);| @apii{0,0,-} -Returns the @x{memory-allocation function} of a given state. +Returns the @x{memory-allocator function} of a given state. If @id{ud} is not @id{NULL}, Lua stores in @T{*ud} the opaque pointer given when the memory-allocator function was set. @@ -3631,10 +3817,28 @@ and loads it accordingly (see program @idx{luac}). The string @id{mode} works as in function @Lid{load}, with the addition that a @id{NULL} value is equivalent to the string @St{bt}. - -@id{lua_load} uses the stack internally, -so the reader function must always leave the stack -unmodified when returning. +Moreover, it may have a @Char{B} instead of a @Char{b}, +meaning a @emphx{fixed buffer} with the binary dump. + +A fixed buffer means that the address returned by the reader function +will contain the chunk until everything created by the chunk has +been collected; +therefore, Lua can avoid copying to internal structures +some parts of the chunk. +(In general, a fixed buffer would keep its contents +until the end of the program, +for instance with the chunk in ROM.) +Moreover, for a fixed buffer, +the reader function should return the entire chunk in the first read. +(As an example, @Lid{luaL_loadbufferx} does that, +which means that you can use it to load fixed buffers.) + +The function @Lid{lua_load} fully preserves the Lua stack +through the calls to the reader function, +except that it may push some values for internal use +before the first call, +and it restores the stack size to its original size plus one +(for the pushed result) after the last call. @id{lua_load} can return @Lid{LUA_OK}, @Lid{LUA_ERRSYNTAX}, or @Lid{LUA_ERRMEM}. @@ -3650,7 +3854,8 @@ Other upvalues are initialized with @nil. } -@APIEntry{lua_State *lua_newstate (lua_Alloc f, void *ud);| +@APIEntry{lua_State *lua_newstate (lua_Alloc f, void *ud, + unsigned int seed);| @apii{0,0,-} Creates a new independent state and returns its main thread. @@ -3661,6 +3866,8 @@ Lua will do all memory allocation for this state through this function @seeF{lua_Alloc}. The second argument, @id{ud}, is an opaque pointer that Lua passes to the allocator in every call. +The third argument, @id{seed}, +is a seed for the hashing of strings. } @@ -3765,6 +3972,20 @@ This macro may evaluate its arguments more than once. } +@APIEntry{unsigned lua_numbertocstring (lua_State *L, int idx, + char *buff);| +@apii{0,0,-} + +Converts the number at acceptable index @id{idx} to a string +and puts the result in @id{buff}. +The buffer must have a size of at least @defid{LUA_N2SBUFFSZ} bytes. +The conversion follows a non-specified format @see{coercion}. +The function returns the number of bytes written to the buffer +(including the final zero), +or zero if the value at @id{idx} is not a number. + +} + @APIEntry{int lua_pcall (lua_State *L, int nargs, int nresults, int msgh);| @apii{nargs + 1,nresults|1,-} @@ -3877,32 +4098,60 @@ This function is equivalent to @Lid{lua_pushcclosure} with no upvalues. } +@APIEntry{const char *lua_pushexternalstring (lua_State *L, + const char *s, size_t len, lua_Alloc falloc, void *ud);| +@apii{0,1,m} + +Creates an @emphx{external string}, +that is, a string that uses memory not managed by Lua. +The pointer @id{s} points to the external buffer +holding the string content, +and @id{len} is the length of the string. +The string should have a zero at its end, +that is, the condition @T{s[len] == '\0'} should hold. +As with any string in Lua, +the length must fit in a Lua integer. + +If @id{falloc} is different from @id{NULL}, +that function will be called by Lua +when the external buffer is no longer needed. +The contents of the buffer should not change before this call. +The function will be called with the given @id{ud}, +the string @id{s} as the block, +the length plus one (to account for the ending zero) as the old size, +and 0 as the new size. + +Even when using an external buffer, +Lua still has to allocate a header for the string. +In case of a memory-allocation error, +Lua will call @id{falloc} before raising the error. + +} + + @APIEntry{const char *lua_pushfstring (lua_State *L, const char *fmt, ...);| @apii{0,1,v} Pushes onto the stack a formatted string and returns a pointer to this string @see{constchar}. -It is similar to the @ANSI{sprintf}, -but has two important differences. -First, -you do not have to allocate space for the result; -the result is a Lua string and Lua takes care of memory allocation -(and deallocation, through garbage collection). -Second, -the conversion specifiers are quite restricted. -There are no flags, widths, or precisions. -The conversion specifiers can only be +The result is a copy of @id{fmt} with +each @emph{conversion specifier} replaced by a string representation +of its respective extra argument. +A conversion specifier (and its corresponding extra argument) can be @Char{%%} (inserts the character @Char{%}), @Char{%s} (inserts a zero-terminated string, with no size restrictions), @Char{%f} (inserts a @Lid{lua_Number}), @Char{%I} (inserts a @Lid{lua_Integer}), -@Char{%p} (inserts a pointer), +@Char{%p} (inserts a void pointer), @Char{%d} (inserts an @T{int}), @Char{%c} (inserts an @T{int} as a one-byte character), and -@Char{%U} (inserts a @T{long int} as a @x{UTF-8} byte sequence). +@Char{%U} (inserts an @T{unsigned long} as a @x{UTF-8} byte sequence). + +Every occurrence of @Char{%} in the string @id{fmt} +must form a valid conversion specifier. -This function may raise errors due to memory overflow -or an invalid conversion specifier. +Besides memory allocation errors, +this function may raise an error if the resulting string is too large. } @@ -3936,7 +4185,7 @@ light userdata with the same @N{C address}. } @APIEntry{const char *lua_pushliteral (lua_State *L, const char *s);| -@apii{0,1,m} +@apii{0,1,v} This macro is equivalent to @Lid{lua_pushstring}, but should be used only when @id{s} is a literal string. @@ -3945,7 +4194,7 @@ but should be used only when @id{s} is a literal string. } @APIEntry{const char *lua_pushlstring (lua_State *L, const char *s, size_t len);| -@apii{0,1,m} +@apii{0,1,v} Pushes the string pointed to by @id{s} with size @id{len} onto the stack. @@ -3957,6 +4206,9 @@ including @x{embedded zeros}. Returns a pointer to the internal copy of the string @see{constchar}. +Besides memory allocation errors, +this function may raise an error if the string is too large. + } @APIEntry{void lua_pushnil (lua_State *L);| @@ -4008,10 +4260,14 @@ onto the stack. const char *lua_pushvfstring (lua_State *L, const char *fmt, va_list argp);| -@apii{0,1,v} +@apii{0,1,-} -Equivalent to @Lid{lua_pushfstring}, except that it receives a @id{va_list} -instead of a variable number of arguments. +Equivalent to @Lid{lua_pushfstring}, +except that it receives a @id{va_list} +instead of a variable number of arguments, +and it does not raise errors. +Instead, in case of errors it pushes the error message +and returns @id{NULL}. } @@ -4160,25 +4416,6 @@ and then pops the top element. } -@APIEntry{int lua_resetthread (lua_State *L, lua_State *from);| -@apii{0,?,-} - -Resets a thread, cleaning its call stack and closing all pending -to-be-closed variables. -Returns a status code: -@Lid{LUA_OK} for no errors in the thread -(either the original error that stopped the thread or -errors in closing methods), -or an error status otherwise. -In case of error, -leaves the error object on the top of the stack. - -The parameter @id{from} represents the coroutine that is resetting @id{L}. -If there is no such coroutine, -this parameter can be @id{NULL}. -(This parameter was introduced in @N{release 5.4.5}.) - -} @APIEntry{int lua_resume (lua_State *L, lua_State *from, int nargs, int *nresults);| @@ -4191,8 +4428,9 @@ you push the main function plus any arguments onto the empty stack of the thread. then you call @Lid{lua_resume}, with @id{nargs} being the number of arguments. -This call returns when the coroutine suspends or finishes its execution. -When it returns, +The function returns when the coroutine suspends, +finishes its execution, or raises an unprotected error. +When it returns without errors, @id{*nresults} is updated and the top of the stack contains the @id{*nresults} values passed to @Lid{lua_yield} @@ -4203,9 +4441,11 @@ or returned by the body function. without errors, or an error code in case of errors @see{statuscodes}. In case of errors, -the error object is on the top of the stack. +the error object is pushed on the top of the stack. +(In that case, @id{nresults} is not updated, +as its value would have to be 1 for the sole error object.) -To resume a coroutine, +To resume a suspended coroutine, you remove the @id{*nresults} yielded values from its stack, push the values to be passed as results from @id{yield}, and then call @Lid{lua_resume}. @@ -4313,7 +4553,7 @@ for the @Q{newindex} event @see{metatable}. @APIEntry{void lua_settop (lua_State *L, int index);| @apii{?,?,e} -Accepts any index, @N{or 0}, +Receives any acceptable stack index, @N{or 0}, and sets the stack top to this index. If the new top is greater than the old one, then the new elements are filled with @nil. @@ -4406,7 +4646,7 @@ otherwise, returns @id{NULL}. } @APIEntry{void lua_toclose (lua_State *L, int index);| -@apii{0,0,m} +@apii{0,0,v} Marks the given index in the stack as a to-be-closed slot @see{to-be-closed}. @@ -4423,6 +4663,9 @@ A slot marked as to-be-closed should not be removed from the stack by any other function in the API except @Lid{lua_settop} or @Lid{lua_pop}, unless previously deactivated by @Lid{lua_closeslot}. +This function raises an error if the value at the given slot +neither has a @idx{__close} metamethod nor is a false value. + This function should not be called for an index that is equal to or below an active to-be-closed slot. @@ -4460,8 +4703,6 @@ indicates whether the operation succeeded. @apii{0,0,m} Converts the Lua value at the given index to a @N{C string}. -If @id{len} is not @id{NULL}, -it sets @T{*len} with the string length. The Lua value must be a string or a number; otherwise, the function returns @id{NULL}. If the value is a number, @@ -4470,12 +4711,20 @@ then @id{lua_tolstring} also (This change confuses @Lid{lua_next} when @id{lua_tolstring} is applied to keys during a table traversal.) -@id{lua_tolstring} returns a pointer -to a string inside the Lua state @see{constchar}. -This string always has a zero (@Char{\0}) -after its last character (as @N{in C}), +If @id{len} is not @id{NULL}, +the function sets @T{*len} with the string length. +The returned @N{C string} always has a zero (@Char{\0}) +after its last character, but can contain other zeros in its body. +The pointer returned by @id{lua_tolstring} +may be invalidated by the garbage collector if the +corresponding Lua value is removed from the stack @see{constchar}. + +This function can raise memory errors only +when converting a number to a string +(as then it may create a new string). + } @APIEntry{lua_Number lua_tonumber (lua_State *L, int index);| @@ -4632,6 +4881,10 @@ passing along the buffer to be written (@id{p}), its size (@id{sz}), and the @id{ud} parameter supplied to @Lid{lua_dump}. +After @Lid{lua_dump} writes its last piece, +it will signal that by calling the writer function one more time, +with a @id{NULL} buffer (and size 0). + The writer returns an error code: @N{0 means} no errors; any other value means an error and stops @Lid{lua_dump} from @@ -4737,9 +4990,10 @@ typedef struct lua_Debug { unsigned char nups; /* (u) number of upvalues */ unsigned char nparams; /* (u) number of parameters */ char isvararg; /* (u) */ + unsigned char extraargs; /* (t) number of extra arguments */ char istailcall; /* (t) */ - unsigned short ftransfer; /* (r) index of first value transferred */ - unsigned short ntransfer; /* (r) number of transferred values */ + int ftransfer; /* (r) index of first value transferred */ + int ntransfer; /* (r) number of transferred values */ char short_src[LUA_IDSIZE]; /* (S) */ /* private part */ @rep{other fields} @@ -4814,8 +5068,8 @@ then @id{name} is set to @id{NULL}. @item{@id{namewhat}| explains the @T{name} field. The value of @T{namewhat} can be -@T{"global"}, @T{"local"}, @T{"method"}, -@T{"field"}, @T{"upvalue"}, or @T{""} (the empty string), +@T{"global"}, @T{"local"}, @T{"upvalue"}, +@T{"field"}, @T{""} (the empty string), plus some other options, according to how the function was called. (Lua uses the empty string when no other option seems to apply.) } @@ -4825,6 +5079,14 @@ true if this function invocation was called by a tail call. In this case, the caller of this level is not in the stack. } +@item{@id{extraargs}| +The number of extra arguments added by the call +to functions called through @idx{__call} metamethods. +(Each @idx{__call} metavalue adds a single extra argument, +the object being called, +but there may be a chain of @idx{__call} metavalues.) +} + @item{@id{nups}| the number of upvalues of the function. } @@ -4932,7 +5194,7 @@ fills in the fields @id{source}, @id{short_src}, @id{linedefined}, @id{lastlinedefined}, and @id{what}; } -@item{@Char{t}| fills in the field @id{istailcall}; +@item{@Char{t}| fills in the fields @id{istailcall} and @id{extraargs}; } @item{@Char{u}| fills in the fields @@ -5543,6 +5805,7 @@ It is defined as the following macro: } It @N{returns 0} (@Lid{LUA_OK}) if there are no errors, or 1 in case of errors. +(Except for out-of-memory errors, which are raised.) } @@ -5681,6 +5944,8 @@ This function returns the same results as @Lid{lua_load}. @id{name} is the chunk name, used for debug information and error messages. The string @id{mode} works as in the function @Lid{lua_load}. +In particular, this function supports mode @Char{B} for +fixed buffers. } @@ -5705,7 +5970,7 @@ The first line in the file is ignored if it starts with a @T{#}. The string @id{mode} works as in the function @Lid{lua_load}. -This function returns the same results as @Lid{lua_load} +This function returns the same results as @Lid{lua_load}, or @Lid{LUA_ERRFILE} for file-related errors. As @Lid{lua_load}, this function only loads the chunk; @@ -5727,6 +5992,15 @@ it does not run it. } +@APIEntry{unsigned int luaL_makeseed (lua_State *L);| +@apii{0,0,-} + +Returns a value with a weak attempt for randomness. +The parameter @id{L} can be @id{NULL} +if there is no Lua state available. + +} + @APIEntry{void luaL_newlib (lua_State *L, const luaL_Reg l[]);| @apii{0,1,m} @@ -5779,8 +6053,9 @@ with @id{tname} in the registry. @apii{0,0,-} Creates a new Lua state. -It calls @Lid{lua_newstate} with an -allocator based on the @N{standard C} allocation functions +It calls @Lid{lua_newstate} with @Lid{luaL_alloc} as +the allocator function and the result of @T{luaL_makeseed(NULL)} +as the seed, and then sets a warning function and a panic function @see{C-error} that print messages to the standard error output. @@ -5789,13 +6064,6 @@ or @id{NULL} if there is a @x{memory allocation error}. } -@APIEntry{void luaL_openlibs (lua_State *L);| -@apii{0,0,e} - -Opens all standard Lua libraries into the given state. - -} - @APIEntry{ T luaL_opt (L, func, arg, dflt);| @apii{0,0,-} @@ -5926,11 +6194,21 @@ Creates and returns a @def{reference}, in the table at index @id{t}, for the object on the top of the stack (and pops the object). -A reference is a unique integer key. -As long as you do not manually add integer keys into the table @id{t}, -@Lid{luaL_ref} ensures the uniqueness of the key it returns. +The reference system uses the integer keys of the table. +A reference is a unique integer key; +@Lid{luaL_ref} ensures the uniqueness of the keys it returns. +The entry 1 is reserved for internal use. +Before the first use of @Lid{luaL_ref}, +the integer keys of the table +should form a proper sequence (no holes), +and the value at entry 1 should be false: +@nil if the sequence is empty, +@false otherwise. +You should not manually set integer keys in the table +after the first use of @Lid{luaL_ref}. + You can retrieve an object referred by the reference @id{r} -by calling @T{lua_rawgeti(L, t, r)}. +by calling @T{lua_rawgeti(L, t, r)} or @T{lua_geti(L, t, r)}. The function @Lid{luaL_unref} frees a reference. If the object on the top of the stack is @nil, @@ -5967,7 +6245,7 @@ and sets the call result to @T{package.loaded[modname]}, as if that function has been called through @Lid{require}. If @id{glb} is true, -also stores the module into the global @id{modname}. +also stores the module into the global variable @id{modname}. Leaves a copy of the module on the stack. @@ -6001,6 +6279,15 @@ in the registry @seeC{luaL_newmetatable}. } +@APIEntry{ +void *luaL_alloc (void *ud, void *ptr, size_t osize, size_t nsize);| + +A standard allocator function for Lua @seeF{lua_Alloc}, +built on top of the C functions @id{realloc} and @id{free}. + +} + + @APIEntry{ typedef struct luaL_Stream { FILE *f; @@ -6019,8 +6306,8 @@ The metatable is created by the I/O library This userdata must start with the structure @id{luaL_Stream}; it can contain other data after this initial structure. -The field @id{f} points to the corresponding C stream -(or it can be @id{NULL} to indicate an incompletely created handle). +The field @id{f} points to the corresponding C stream, +or it is @id{NULL} to indicate an incompletely created handle. The field @id{closef} points to a Lua function that will be called to close the stream when the handle is closed or collected; @@ -6093,14 +6380,16 @@ Returns the name of the type of the value at the given index. @APIEntry{void luaL_unref (lua_State *L, int t, int ref);| @apii{0,0,-} -Releases the reference @id{ref} from the table at index @id{t} -@seeC{luaL_ref}. -The entry is removed from the table, -so that the referred object can be collected. -The reference @id{ref} is also freed to be used again. - -If @id{ref} is @Lid{LUA_NOREF} or @Lid{LUA_REFNIL}, -@Lid{luaL_unref} does nothing. +Releases a reference @see{luaL_ref}. +The integer @id{ref} must be either +@Lid{LUA_NOREF}, @Lid{LUA_REFNIL}, +or a reference previously returned by @Lid{luaL_ref} +and not already released. +If @id{ref} is either @Lid{LUA_NOREF} or @Lid{LUA_REFNIL} +this function does nothing. +Otherwise, the entry is removed from the table, +so that the referred object can be collected and +the reference @id{ref} can be used again by @Lid{luaL_ref}. } @@ -6184,23 +6473,61 @@ Except for the basic and the package libraries, each library provides all its functions as fields of a global table or as methods of its objects. -To have access to these libraries, -the @N{C host} program should call the @Lid{luaL_openlibs} function, -which opens all standard libraries. +} + + +@sect2{lualib-h| @title{Loading the Libraries in C code} + +A @N{C host} program must explicitly load +the standard libraries into a state, +if it wants its scripts to use them. +For that, +the host program can call the function @Lid{luaL_openlibs}. Alternatively, -the host program can open them individually by using -@Lid{luaL_requiref} to call -@defid{luaopen_base} (for the basic library), -@defid{luaopen_package} (for the package library), -@defid{luaopen_coroutine} (for the coroutine library), -@defid{luaopen_string} (for the string library), -@defid{luaopen_utf8} (for the UTF-8 library), -@defid{luaopen_table} (for the table library), -@defid{luaopen_math} (for the mathematical library), -@defid{luaopen_io} (for the I/O library), -@defid{luaopen_os} (for the operating system library), -and @defid{luaopen_debug} (for the debug library). -These functions are declared in @defid{lualib.h}. +the host can select which libraries to open, +by using @Lid{luaL_openselectedlibs}. +Both functions are defined in the header file @id{lualib.h}. +@index{lualib.h} + +The stand-alone interpreter @id{lua} @see{lua-sa} +already opens all standard libraries. + +@APIEntry{void luaL_openlibs (lua_State *L);| +@apii{0,0,e} + +Opens all standard Lua libraries into the given state. + +} + +@APIEntry{void luaL_openselectedlibs (lua_State *L, int load, int preload);| +@apii{0,0,e} + +Opens (loads) and preloads selected standard libraries into the state @id{L}. +(To @emph{preload} means to add +the library loader into the table @Lid{package.preload}, +so that the library can be required later by the program. +Keep in mind that @Lid{require} itself is provided +by the @emph{package} library. +If a program does not load that library, +it will be unable to require anything.) + +The integer @id{load} selects which libraries to load; +the integer @id{preload} selects which to preload, among those not loaded. +Both are masks formed by a bitwise OR of the following constants: +@description{ +@item{@defid{LUA_GLIBK} | the basic library.} +@item{@defid{LUA_LOADLIBK} | the package library.} +@item{@defid{LUA_COLIBK} | the coroutine library.} +@item{@defid{LUA_STRLIBK} | the string library.} +@item{@defid{LUA_UTF8LIBK} | the UTF-8 library.} +@item{@defid{LUA_TABLIBK} | the table library.} +@item{@defid{LUA_MATHLIBK} | the mathematical library.} +@item{@defid{LUA_IOLIBK} | the I/O library.} +@item{@defid{LUA_OSLIBK} | the operating system library.} +@item{@defid{LUA_DBLIBK} | the debug library.} +} + +} } @@ -6254,13 +6581,24 @@ gives the exact number of bytes in use by Lua. @item{@St{step}| Performs a garbage-collection step. -The step @Q{size} is controlled by @id{arg}. -With a zero value, -the collector will perform one basic (indivisible) step. -For non-zero values, -the collector will perform as if that amount of memory -(in Kbytes) had been allocated by Lua. -Returns @true if the step finished a collection cycle. +This option may be followed by an extra argument, +an integer with the step size. + +If the size is a positive @id{n}, +the collector acts as if @id{n} new bytes have been allocated. +If the size is zero, +the collector performs a basic step. +In incremental mode, +a basic step corresponds to the current step size. +In generational mode, +a basic step performs a full minor collection or +an incremental step, +if the collector has scheduled one. + +In incremental mode, +the function returns @true if the step finished a collection cycle. +In generational mode, +the function returns @true if the step finished a major collection. } @item{@St{isrunning}| @@ -6269,20 +6607,35 @@ Returns a boolean that tells whether the collector is running } @item{@St{incremental}| -Change the collector mode to incremental. -This option can be followed by three numbers: -the garbage-collector pause, -the step multiplier, -and the step size @see{incmode}. -A zero means to not change that value. +Changes the collector mode to incremental and returns the previous mode. } @item{@St{generational}| -Change the collector mode to generational. -This option can be followed by two numbers: -the garbage-collector minor multiplier -and the major multiplier @see{genmode}. -A zero means to not change that value. +Changes the collector mode to generational and returns the previous mode. +} + +@item{@St{param}| +Changes and/or retrieves the values of a parameter of the collector. +This option must be followed by one or two extra arguments: +The name of the parameter being changed or retrieved (a string) +and an optional new value for that parameter, +an integer in the range @M{[0,100000]}. +The first argument must have one of the following values: +@description{ +@item{@St{minormul}| The minor multiplier. } +@item{@St{majorminor}| The major-minor multiplier. } +@item{@St{minormajor}| The minor-major multiplier. } +@item{@St{pause}| The garbage-collector pause. } +@item{@St{stepmul}| The step multiplier. } +@item{@St{stepsize}| The step size. } +} +The call always returns the previous value of the parameter. +If the call does not give a new value, +the value is left unchanged. + +Lua stores these values in a compressed format, +so, the value returned as the previous value may not be +exactly the last value set. } } @@ -6294,10 +6647,10 @@ This function should not be called by a finalizer. } @LibEntry{dofile ([filename])| -Opens the named file and executes its content as a Lua chunk. +Opens the named file and executes its content as a Lua chunk, +returning all values returned by the chunk. When called without arguments, @id{dofile} executes the content of the standard input (@id{stdin}). -Returns all values returned by the chunk. In case of errors, @id{dofile} propagates the error to its caller. (That is, @id{dofile} does not run in protected mode.) @@ -6341,7 +6694,7 @@ Otherwise, returns the metatable of the given object. @LibEntry{ipairs (t)| -Returns three values (an iterator function, the table @id{t}, and 0) +Returns three values (an iterator function, the value @id{t}, and 0) so that the construction @verbatim{ for i,v in ipairs(t) do @rep{body} end @@ -6398,11 +6751,10 @@ It may be the string @St{b} (only @x{binary chunk}s), or @St{bt} (both binary and text). The default is @St{bt}. -It is safe to load malformed binary chunks; -@id{load} signals an appropriate error. -However, -Lua does not check the consistency of the code inside binary chunks; -running maliciously crafted bytecode can crash the interpreter. +Lua does not check the consistency of binary chunks. +Maliciously crafted binary chunks can crash +the interpreter. +You can use the @id{mode} parameter to prevent loading binary chunks. } @@ -6447,11 +6799,11 @@ In particular, you may set existing fields to nil. @LibEntry{pairs (t)| If @id{t} has a metamethod @idx{__pairs}, -calls it with @id{t} as argument and returns the first three +calls it with @id{t} as argument and returns the first four results from the call. Otherwise, -returns three values: the @Lid{next} function, the table @id{t}, and @nil, +returns the @Lid{next} function, the table @id{t}, plus two @nil values, so that the construction @verbatim{ for k,v in pairs(t) do @rep{body} end @@ -6614,7 +6966,7 @@ and @St{userdata}. A global variable (not a function) that holds a string containing the running Lua version. -The current value of this variable is @St{Lua 5.4}. +The current value of this variable is @St{Lua 5.5}. } @@ -6651,18 +7003,26 @@ which come inside the table @defid{coroutine}. See @See{coroutine} for a general description of coroutines. -@LibEntry{coroutine.close (co)| +@LibEntry{coroutine.close ([co])| Closes coroutine @id{co}, that is, closes all its pending to-be-closed variables and puts the coroutine in a dead state. -The given coroutine must be dead or suspended. -In case of error +The default for @id{co} is the running coroutine. + +The given coroutine must be dead, suspended, +or be the running coroutine. +For the running coroutine, +this function does not return. +Instead, the resume that (re)started the coroutine returns. + +For other coroutines, +in case of error (either the original error that stopped the coroutine or errors in closing methods), -returns @false plus the error object; -otherwise returns @true. +this function returns @false plus the error object; +otherwise it returns @true. } @@ -6852,7 +7212,7 @@ to search for a @N{C loader}. Lua initializes the @N{C path} @Lid{package.cpath} in the same way it initializes the Lua path @Lid{package.path}, -using the environment variable @defid{LUA_CPATH_5_4}, +using the environment variable @defid{LUA_CPATH_5_5}, or the environment variable @defid{LUA_CPATH}, or a default path defined in @id{luaconf.h}. @@ -6898,10 +7258,10 @@ including if necessary a path and an extension. @id{funcname} must be the exact name exported by the @N{C library} (which may depend on the @N{C compiler} and linker used). -This function is not supported by @N{Standard C}. -As such, it is only available on some platforms -(Windows, Linux, Mac OS X, Solaris, BSD, -plus other Unix systems that support the @id{dlfcn} standard). +This functionality is not supported by @N{ISO C}. +As such, @id{loadlib} is only available on some platforms: +Linux, Windows, Mac OS X, Solaris, BSD, +plus other Unix systems that support the @id{dlfcn} standard. This function is inherently insecure, as it allows Lua to call any function in any readable dynamic @@ -6921,7 +7281,7 @@ A string with the path used by @Lid{require} to search for a Lua loader. At start-up, Lua initializes this variable with -the value of the environment variable @defid{LUA_PATH_5_4} or +the value of the environment variable @defid{LUA_PATH_5_5} or the environment variable @defid{LUA_PATH} or with a default path defined in @id{luaconf.h}, if those environment variables are not defined. @@ -7147,9 +7507,12 @@ Returns a formatted version of its variable number of arguments following the description given in its first argument, which must be a string. The format string follows the same rules as the @ANSI{sprintf}. -The only differences are that the conversion specifiers and modifiers -@id{F}, @id{n}, @T{*}, @id{h}, @id{L}, and @id{l} are not supported -and that there is an extra specifier, @id{q}. +The accepted conversion specifiers are +@id{A}, @id{a}, @id{c}, @id{d}, @id{E}, @id{e}, @id{f}, @id{G}, @id{g}, +@id{i}, @id{o}, @id{p}, @id{s}, @id{u}, @id{X}, @id{x}, and @Char{%}, +plus a non-C specifier @id{q}. +The accepted flags are @Char{-}, @Char{+}, @Char{#}, +@Char{0}, and @Char{ } (space). Both width and precision, when present, are limited to two digits. @@ -7273,25 +7636,25 @@ then there is no replacement Here are some examples: @verbatim{ x = string.gsub("hello world", "(%w+)", "%1 %1") ---> x="hello hello world world" +-- x="hello hello world world" x = string.gsub("hello world", "%w+", "%0 %0", 1) ---> x="hello hello world" +-- x="hello hello world" x = string.gsub("hello world from Lua", "(%w+)%s*(%w+)", "%2 %1") ---> x="world hello Lua from" +-- x="world hello Lua from" x = string.gsub("home = $HOME, user = $USER", "%$(%w+)", os.getenv) ---> x="home = /home/roberto, user = roberto" +-- x="home = /home/roberto, user = roberto" x = string.gsub("4+5 = $return 4+5$", "%$(.-)%$", function (s) return load(s)() end) ---> x="4+5 = 9" +-- x="4+5 = 9" -local t = {name="lua", version="5.4"} +local t = {name="lua", version="5.5"} x = string.gsub("$name-$version.tar.gz", "%$(%w+)", t) ---> x="lua-5.4.tar.gz" +-- x="lua-5.5.tar.gz" } } @@ -7797,21 +8160,27 @@ returns @fail plus the position of the first invalid byte. @LibEntry{utf8.offset (s, n [, i])| -Returns the position (in bytes) where the encoding of the -@id{n}-th character of @id{s} -(counting from position @id{i}) starts. +Returns the position of the @id{n}-th character of @id{s} +(counting from byte position @id{i}) as two integers: +The index (in bytes) where its encoding starts and the +index (in bytes) where it ends. + +If the specified character is right after the end of @id{s}, +the function behaves as if there was a @Char{\0} there. +If the specified character is neither in the subject +nor right after its end, +the function returns @fail. + A negative @id{n} gets characters before position @id{i}. The default for @id{i} is 1 when @id{n} is non-negative and @T{#s + 1} otherwise, so that @T{utf8.offset(s, -n)} gets the offset of the @id{n}-th character from the end of the string. -If the specified character is neither in the subject -nor right after its end, -the function returns @fail. As a special case, -when @id{n} is 0 the function returns the start of the encoding -of the character that contains the @id{i}-th byte of @id{s}. +when @id{n} is 0 the function returns the start and end +of the encoding of the character that contains the +@id{i}-th byte of @id{s}. This function assumes that @id{s} is a valid UTF-8 string. @@ -7841,6 +8210,19 @@ If @id{i} is greater than @id{j}, returns the empty string. } +@LibEntry{table.create (nseq [, nrec])| + +Creates a new empty table, preallocating memory. +This preallocation may help performance and save memory +when you know in advance how many elements the table will have. + +Parameter @id{nseq} is a hint for how many elements the table +will have as a sequence. +Optional parameter @id{nrec} is a hint for how many other elements +the table will have; its default is zero. + +} + @LibEntry{table.insert (list, [pos,] value)| Inserts element @id{value} at position @id{pos} in @id{list}, @@ -7861,6 +8243,8 @@ multiple assignment: The default for @id{a2} is @id{a1}. The destination range can overlap with the source range. The number of elements to be moved must fit in a Lua integer. +If @id{f} is larger than @id{e}, +nothing is moved. Returns the destination table @id{a2}. @@ -8011,6 +8395,17 @@ that rounds the quotient towards zero. (integer/float) } +@LibEntry{math.frexp (x)| + +Returns two numbers @id{m} and @id{e} such that @M{x = m2@sp{e}}, +where @id{e} is an integer. +When @id{x} is zero, NaN, +inf, or -inf, +@id{m} is equal to @id{x}; +otherwise, the absolute value of @id{m} +is in the range @C{(} @M{[0.5, 1)} @C{]}. + +} + @LibEntry{math.huge| The float value @idx{HUGE_VAL}, @@ -8018,6 +8413,12 @@ a value greater than any other numeric value. } +@LibEntry{math.ldexp(m, e)| + +Returns @M{m2@sp{e}}, where @id{e} is an integer. + +} + @LibEntry{math.log (x [, base])| Returns the logarithm of @id{x} in the given base. @@ -8073,7 +8474,7 @@ Converts the angle @id{x} from degrees to radians. When called without arguments, returns a pseudo-random float with uniform distribution -in the range @C{(} @M{[0,1)}. @C{]} +in the range @C{(} @M{[0, 1)}. @C{]} When called with two integers @id{m} and @id{n}, @id{math.random} returns a pseudo-random integer with uniform distribution in the range @M{[m, n]}. @@ -8099,7 +8500,7 @@ different sequences of results each time the program runs. When called with at least one argument, the integer parameters @id{x} and @id{y} are -joined into a 128-bit @emphx{seed} that +joined into a @emphx{seed} that is used to reinitialize the pseudo-random generator; equal seeds produce equal sequences of numbers. The default for @id{y} is zero. @@ -8472,6 +8873,9 @@ Writes the value of each of its arguments to @id{file}. The arguments must be strings or numbers. In case of success, this function returns @id{file}. +Otherwise, it returns four values: +@fail, the error message, the error code, +and the number of bytes it was able to write. } @@ -8636,7 +9040,7 @@ because of its reliance on @CId{setlocale}. @LibEntry{os.time ([table])| -Returns the current time when called without arguments, +Returns the current local time when called without arguments, or a time representing the local date and time specified by the given table. This table must have fields @id{year}, @id{month}, and @id{day}, and may have fields @@ -8759,13 +9163,13 @@ The returned table can contain all the fields returned by @Lid{lua_getinfo}, with the string @id{what} describing which fields to fill in. The default for @id{what} is to get all information available, except the table of valid lines. -If present, -the option @Char{f} +The option @Char{f} adds a field named @id{func} with the function itself. -If present, -the option @Char{L} -adds a field named @id{activelines} with the table of -valid lines. +The option @Char{L} adds a field named @id{activelines} +with the table of valid lines, +provided the function is a Lua function. +If the function has no debug information, +the table is empty. For instance, the expression @T{debug.getinfo(1,"n").name} returns a name for the current function, @@ -8995,7 +9399,6 @@ The options are: @item{@T{--}| stop handling options;} @item{@T{-}| execute @id{stdin} as a file and stop handling options.} } -(The form @T{-l @rep{g=mod}} was introduced in @N{release 5.4.4}.) After handling its options, @id{lua} runs the given @emph{script}. When called without arguments, @@ -9004,7 +9407,7 @@ when the standard input (@id{stdin}) is a terminal, and as @T{lua -} otherwise. When called without the option @T{-E}, -the interpreter checks for an environment variable @defid{LUA_INIT_5_4} +the interpreter checks for an environment variable @defid{LUA_INIT_5_5} (or @defid{LUA_INIT} if the versioned name is not defined) before running any argument. If the variable content has the format @T{@At@rep{filename}}, @@ -9016,6 +9419,10 @@ Lua does not consult any environment variables. In particular, the values of @Lid{package.path} and @Lid{package.cpath} are set with the default paths defined in @id{luaconf.h}. +To signal to the libraries that this option is on, +the stand-alone interpreter sets the field +@idx{"LUA_NOENV"} in the registry to a true value. +Other libraries may consult this field for the same purpose. The options @T{-e}, @T{-l}, and @T{-W} are handled in the order they appear. @@ -9063,13 +9470,33 @@ the script is compiled as a variadic function. In interactive mode, Lua repeatedly prompts and waits for a line. After reading a line, -Lua first try to interpret the line as an expression. +Lua first tries to interpret the line as an expression. If it succeeds, it prints its value. -Otherwise, it interprets the line as a statement. -If you write an incomplete statement, +Otherwise, it interprets the line as a chunk. +If you write an incomplete chunk, the interpreter waits for its completion by issuing a different prompt. +Note that, as each complete line is read as a new chunk, +local variables do not outlive lines. +To steer clear of confusion, +the interpreter gives a warning if a line starts with the +reserved word @Rw{local}: +@verbatim{ +> x = 20 -- global 'x' +> local x = 10; print(x) + --> warning: locals do not survive across lines in interactive mode + --> 10 +> print(x) -- back to global 'x' + --> 20 +> do -- incomplete chunk +>> local x = 10; print(x) -- '>>' prompts for line completion +>> print(x) +>> end -- chunk completed + --> 10 + --> 10 +} + If the global variable @defid{_PROMPT} contains a string, then its value is used as the prompt. Similarly, if the global variable @defid{_PROMPT2} contains a string, @@ -9118,7 +9545,7 @@ is a more portable solution. @simplesect{ Here we list the incompatibilities that you may find when moving a program -from @N{Lua 5.3} to @N{Lua 5.4}. +from @N{Lua 5.4} to @N{Lua 5.5}. You can avoid some incompatibilities by compiling Lua with appropriate options (see file @id{luaconf.h}). @@ -9155,51 +9582,23 @@ change between versions. @itemize{ @item{ -The coercion of strings to numbers in -arithmetic and bitwise operations -has been removed from the core language. -The string library does a similar job -for arithmetic (but not for bitwise) operations -using the string metamethods. -However, unlike in previous versions, -the new implementation preserves the implicit type of the numeral -in the string. -For instance, the result of @T{"1" + "2"} now is an integer, -not a float. +The word @Rw{global} is a reserved word. +Do not use it as a regular name. } @item{ -Literal decimal integer constants that overflow are read as floats, -instead of wrapping around. -You can use hexadecimal notation for such constants if you -want the old behavior -(reading them as integers with wrap around). +The control variable in @Rw{for} loops is read only. +If you need to change it, +declare a local variable with the same name in the loop body. } @item{ -The use of the @idx{__lt} metamethod to emulate @idx{__le} -has been removed. -When needed, this metamethod must be explicitly defined. +A chain of @id{__call} metamethods can have at most 15 objects. } @item{ -The semantics of the numerical @Rw{for} loop -over integers changed in some details. -In particular, the control variable never wraps around. -} - -@item{ -A label for a @Rw{goto} cannot be declared where a label with the same -name is visible, even if this other label is declared in an enclosing -block. -} - -@item{ -When finalizing an object, -Lua does not ignore @idx{__gc} metamethods that are not functions. -Any value will be called, if present. -(Non-callable values will generate a warning, -like any other error when calling a finalizer.) +In an error, a @nil as the error object is replaced by a +string message. } } @@ -9210,90 +9609,63 @@ like any other error when calling a finalizer.) @itemize{ @item{ -The function @Lid{print} does not call @Lid{tostring} -to format its arguments; -instead, it has this functionality hardwired. -You should use @idx{__tostring} to modify how values are printed. +Parameters for the garbage collection are not set +with the options @St{incremental} and @St{generational}; +instead, there is a new option @St{param} to that end. +Moreover, there were some changes in the parameters themselves. } -@item{ -The pseudo-random number generator used by the function @Lid{math.random} -now starts with a somewhat random seed. -Moreover, it uses a different algorithm. } -@item{ -By default, the decoding functions in the @Lid{utf8} library -do not accept surrogates as valid code points. -An extra parameter in these functions makes them more permissive. } -@item{ -The options @St{setpause} and @St{setstepmul} -of the function @Lid{collectgarbage} are deprecated. -You should use the new option @St{incremental} to set them. -} +@sect2{@title{Incompatibilities in the API} -@item{ -The function @Lid{io.lines} now returns four values, -instead of just one. -That can be a problem when it is used as the sole -argument to another function that has optional parameters, -such as in @T{load(io.lines(filename, "L"))}. -To fix that issue, -you can wrap the call into parentheses, -to adjust its number of results to one. -} +@itemize{ +@item{ +In @Lid{lua_call} and related functions, +the maximum value for the number of required results +(@id{nresults}) is 250. +If you really need a larger value, +use @Lid{LUA_MULTRET} and then adjust the stack size. +Previously, this limit was unspecified. } +@item{ +@Lid{lua_newstate} has a third parameter, +a seed for the hashing of strings. } -@sect2{@title{Incompatibilities in the API} - -@itemize{ - @item{ -Full userdata now has an arbitrary number of associated user values. -Therefore, the functions @id{lua_newuserdata}, -@id{lua_setuservalue}, and @id{lua_getuservalue} were -replaced by @Lid{lua_newuserdatauv}, -@Lid{lua_setiuservalue}, and @Lid{lua_getiuservalue}, -which have an extra argument. - -For compatibility, the old names still work as macros assuming -one single user value. -Note, however, that userdata with zero user values -are more efficient memory-wise. +The function @id{lua_resetthread} is deprecated; +it is equivalent to @Lid{lua_closethread} with +@id{from} being @id{NULL}. } @item{ -The function @Lid{lua_resume} has an extra parameter. -This out parameter returns the number of values on -the top of the stack that were yielded or returned by the coroutine. -(In previous versions, -those values were the entire stack.) +The function @id{lua_setcstacklimit} is deprecated. +Calls to it can simply be removed. } @item{ -The function @Lid{lua_version} returns the version number, -instead of an address of the version number. -The Lua core should work correctly with libraries using their -own static copies of the same core, -so there is no need to check whether they are using the same -address space. +The function @Lid{lua_dump} changed the way it keeps the stack +through the calls to the writer function. +(That was not specified in previous versions.) +Also, it calls the writer function one extra time, +to signal the end of the dump. } @item{ -The constant @id{LUA_ERRGCMM} was removed. -Errors in finalizers are never propagated; -instead, they generate a warning. +Parameters for the garbage collection are not set +with the options @Lid{LUA_GCINC} and @Lid{LUA_GCGEN}; +instead, there is a new option @Lid{LUA_GCPARAM} to that end. +Moreover, there were some changes in the parameters themselves. } @item{ -The options @idx{LUA_GCSETPAUSE} and @idx{LUA_GCSETSTEPMUL} -of the function @Lid{lua_gc} are deprecated. -You should use the new option @id{LUA_GCINC} to set them. +The function @Lid{lua_pushvfstring} now reports errors, +instead of raising them. } } @@ -9341,13 +9713,17 @@ and @bnfNter{LiteralString}, see @See{lexical}.) @OrNL @Rw{for} namelist @Rw{in} explist @Rw{do} block @Rw{end} @OrNL @Rw{function} funcname funcbody @OrNL @Rw{local} @Rw{function} @bnfNter{Name} funcbody +@OrNL @Rw{global} @Rw{function} @bnfNter{Name} funcbody @OrNL @Rw{local} attnamelist @bnfopt{@bnfter{=} explist} +@OrNL @Rw{global} attnamelist +@OrNL @Rw{global} @bnfopt{attrib} @bnfter{*} } @producname{attnamelist}@producbody{ - @bnfNter{Name} attrib @bnfrep{@bnfter{,} @bnfNter{Name} attrib}} + @bnfopt{attrib} @bnfNter{Name} @bnfopt{attrib} + @bnfrep{@bnfter{,} @bnfNter{Name} @bnfopt{attrib}}} -@producname{attrib}@producbody{@bnfopt{@bnfter{<} @bnfNter{Name} @bnfter{>}}} +@producname{attrib}@producbody{@bnfter{<} @bnfNter{Name} @bnfter{>}} @producname{retstat}@producbody{@Rw{return} @bnfopt{explist} @bnfopt{@bnfter{;}}} @@ -9401,8 +9777,10 @@ and @bnfNter{LiteralString}, see @See{lexical}.) @producname{funcbody}@producbody{@bnfter{(} @bnfopt{parlist} @bnfter{)} block @Rw{end}} -@producname{parlist}@producbody{namelist @bnfopt{@bnfter{,} @bnfter{...}} - @Or @bnfter{...}} +@producname{parlist}@producbody{namelist @bnfopt{@bnfter{,} varargparam} @Or + varargparam} + +@producname{varargparam}@producbody{@bnfter{...} @bnfopt{@bnfNter{Name}}} @producname{tableconstructor}@producbody{@bnfter{@Open} @bnfopt{fieldlist} @bnfter{@Close}} diff --git a/onelua.c b/onelua.c index 3c605981f0..e717121391 100644 --- a/onelua.c +++ b/onelua.c @@ -1,5 +1,18 @@ /* -* one.c -- Lua core, libraries, and interpreter in a single file +** Lua core, libraries, and interpreter in a single file. +** Compiling just this file generates a complete Lua stand-alone +** program: +** +** $ gcc -O2 -std=c99 -o lua onelua.c -lm +** +** or (for C89) +** +** $ gcc -O2 -std=c89 -DLUA_USE_C89 -o lua onelua.c -lm +** +** or (for Linux) +** +** gcc -O2 -o lua -DLUA_USE_LINUX -Wl,-E onelua.c -lm -ldl +** */ /* default is to build the full interpreter */ @@ -11,15 +24,28 @@ #endif #endif -/* choose suitable platform-specific features */ -/* some of these may need extra libraries such as -ldl -lreadline -lncurses */ + +/* +** Choose suitable platform-specific features. Default is no +** platform-specific features. Some of these options may need extra +** libraries such as -ldl -lreadline -lncurses +*/ #if 0 #define LUA_USE_LINUX #define LUA_USE_MACOSX #define LUA_USE_POSIX -#define LUA_ANSI #endif + +/* +** Other specific features +*/ +#if 0 +#define LUA_32BITS +#define LUA_USE_C89 +#endif + + /* no need to change anything below this line ----------------------------- */ #include "lprefix.h" @@ -40,12 +66,10 @@ #include #include - /* setup for luaconf.h */ #define LUA_CORE #define LUA_LIB -#define ltable_c -#define lvm_c + #include "luaconf.h" /* do not export internal symbols */ @@ -96,6 +120,11 @@ #include "linit.c" #endif +/* test library -- used only for internal development */ +#if defined(LUA_DEBUG) +#include "ltests.c" +#endif + /* lua */ #ifdef MAKE_LUA #include "lua.c" diff --git a/testes/all.lua b/testes/all.lua old mode 100644 new mode 100755 index 5df0ff9bca..d3e2f12368 --- a/testes/all.lua +++ b/testes/all.lua @@ -1,9 +1,13 @@ #!../lua -- $Id: testes/all.lua $ --- See Copyright Notice at the end of this file +-- See Copyright Notice in file lua.h +global * -local version = "Lua 5.4" +global _soft, _port, _nomsg +global T + +local version = "Lua 5.5" if _VERSION ~= version then io.stderr:write("This test suite is for ", version, ", not for ", _VERSION, "\nExiting tests") @@ -28,14 +32,13 @@ _nomsg = rawget(_G, "_nomsg") or false local usertests = rawget(_G, "_U") if usertests then - -- tests for sissies ;) Avoid problems - _soft = true - _port = true - _nomsg = true + _soft = true -- avoid tests that take too long + _port = true -- avoid non-portable tests + _nomsg = true -- avoid messages about tests not performed end -- tests should require debug when needed -debug = nil +global debug; debug = nil if usertests then @@ -72,7 +75,7 @@ do -- ( -- track messages for tests not performed local msgs = {} -function Message (m) +global function Message (m) if not _nomsg then print(m) msgs[#msgs+1] = string.sub(m, 3, -3) @@ -183,6 +186,7 @@ dofile('nextvar.lua') dofile('pm.lua') dofile('utf8.lua') dofile('api.lua') +dofile('memerr.lua') assert(dofile('events.lua') == 12) dofile('vararg.lua') dofile('closure.lua') @@ -283,30 +287,3 @@ end print("final OK !!!") - - ---[[ -***************************************************************************** -* Copyright (C) 1994-2016 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 -* "Software"), to deal in the Software without restriction, including -* without limitation the rights to use, copy, modify, merge, publish, -* distribute, sublicense, and/or sell copies of the Software, and to -* permit persons to whom the Software is furnished to do so, subject to -* the following conditions: -* -* The above copyright notice and this permission notice shall be -* included in all copies or substantial portions of the Software. -* -* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -***************************************************************************** -]] - diff --git a/testes/api.lua b/testes/api.lua index 752ff18ff3..9855f5411d 100644 --- a/testes/api.lua +++ b/testes/api.lua @@ -1,5 +1,5 @@ -- $Id: testes/api.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h if T==nil then (Message or print)('\n >>> testC not active: skipping API tests <<<\n') @@ -11,9 +11,6 @@ local debug = require "debug" local pack = table.pack --- standard error message for memory errors -local MEMERRMSG = "not enough memory" - local function tcheck (t1, t2) assert(t1.n == (t2.n or #t2) + 1) for i = 2, t1.n do assert(t1[i] == t2[i - 1]) end @@ -117,7 +114,7 @@ end -- testing warnings T.testC([[ - warningC "#This shold be a" + warningC "#This should be a" warningC " single " warning "warning" warningC "#This should be " @@ -165,6 +162,23 @@ do -- test returning more results than fit in the caller stack end +do -- testing multiple returns + local function foo (n) + if n > 0 then return n, foo(n - 1) end + end + + local t = {T.testC("call 1 10; return 10", foo, 20)} + assert(t[1] == 20 and t[10] == 11 and t[11] == nil) + + local t = table.pack(T.testC("call 1 10; return 10", foo, 2)) + assert(t[1] == 2 and t[2] == 1 and t[3] == nil and t.n == 10) + + local t = {T.testC([[ + checkstack 300 "error"; call 1 250; return 250]], foo, 250)} + assert(t[1] == 250 and t[250] == 1 and t[251] == nil) +end + + -- testing globals _G.AA = 14; _G.BB = "a31" local a = {T.testC[[ @@ -232,7 +246,8 @@ assert(not T.testC("compare LT 1 4, return 1")) assert(not T.testC("compare LE 9 1, return 1")) assert(not T.testC("compare EQ 9 9, return 1")) -local b = {__lt = function (a,b) return a[1] < b[1] end} +local b = {__lt = function (a,b) return a[1] < b[1] end, + __le = function (a,b) return a[1] <= b[1] end} local a1,a3,a4 = setmetatable({1}, b), setmetatable({3}, b), setmetatable({4}, b) @@ -399,6 +414,10 @@ do -- trivial error assert(T.checkpanic("pushstring hi; error") == "hi") + -- thread status inside panic (bug in 5.4.4) + assert(T.checkpanic("pushstring hi; error", "threadstatus; return 2") == + "ERRRUN") + -- using the stack inside panic assert(T.checkpanic("pushstring hi; error;", [[checkstack 5 XX @@ -407,20 +426,30 @@ do concat 3]]) == "hi alo mundo") -- "argerror" without frames - assert(T.checkpanic("loadstring 4") == + assert(T.checkpanic("loadstring 4 name bt") == "bad argument #4 (string expected, got no value)") - -- memory error - T.totalmem(T.totalmem()+10000) -- set low memory limit (+10k) - assert(T.checkpanic("newuserdata 20000") == MEMERRMSG) - T.totalmem(0) -- restore high limit + -- memory error + thread status + local x = T.checkpanic( + [[ alloccount 0 # force a memory error in next line + newtable + ]], + [[ + alloccount -1 # allow free allocations again + pushstring XX + threadstatus + concat 2 # to make sure message came from here + return 1 + ]]) + T.alloccount() + assert(x == "XX" .. "not enough memory") -- stack error if not _soft then local msg = T.checkpanic[[ pushstring "function f() f() end" - loadstring -1; call 0 0 + loadstring -1 name t; call 0 0 getglobal f; call 0 0 ]] assert(string.find(msg, "stack overflow")) @@ -430,7 +459,7 @@ do assert(T.checkpanic([[ pushstring "return {__close = function () Y = 'ho'; end}" newtable - loadstring -2 + loadstring -2 name t call 0 1 setmetatable -2 toclose -1 @@ -458,6 +487,8 @@ if not _soft then print'+' end + + local lim = _soft and 500 or 12000 local prog = {"checkstack " .. (lim * 2 + 100) .. "msg", "newtable"} for i = 1,lim do @@ -465,7 +496,7 @@ for i = 1,lim do prog[#prog + 1] = "pushnum " .. i * 10 end -prog[#prog + 1] = "rawgeti R 2" -- get global table in registry +prog[#prog + 1] = "rawgeti R !G" -- get global table in registry prog[#prog + 1] = "insert " .. -(2*lim + 2) for i = 1,lim do @@ -481,10 +512,20 @@ for i = 1,lim do assert(t[i] == i*10); t[i] = undef end assert(next(t) == nil) prog, g, t = nil +do -- shrink stack + local m1, m2 = 0, collectgarbage"count" * 1024 + while m1 ~= m2 do -- repeat until stable + collectgarbage() + m1 = m2 + m2 = collectgarbage"count" * 1024 + end +end + + -- testing errors a = T.testC([[ - loadstring 2; pcall 0 1 0; + loadstring 2 name t; pcall 0 1 0; pushvalue 3; insert -2; pcall 1 1 0; pcall 0 0 0; return 1 @@ -498,7 +539,7 @@ local function check3(p, ...) assert(#arg == 3) assert(string.find(arg[3], p)) end -check3(":1:", T.testC("loadstring 2; return *", "x=")) +check3(":1:", T.testC("loadstring 2 name t; return *", "x=")) check3("%.", T.testC("loadfile 2; return *", ".")) check3("xxxx", T.testC("loadfile 2; return *", "xxxx")) @@ -509,6 +550,53 @@ local function checkerrnopro (code, msg) assert(not stt and string.find(err, msg)) end + +do + print("testing load of binaries in fixed buffers") + local source = {} + local N = 1000 + -- create a somewhat "large" source + for i = 1, N do source[i] = "X = X + 1; " end + -- add a long string to the source + source[#source + 1] = string.format("Y = '%s'", string.rep("a", N)); + source = table.concat(source) + -- give chunk an explicit name to avoid using source as name + source = load(source, "name1") + -- dump without debug information + source = string.dump(source, true) + -- each "X=X+1" generates 4 opcodes with 4 bytes each, plus the string + assert(#source > N * 4 * 4 + N) + collectgarbage(); collectgarbage() + local m1 = collectgarbage"count" * 1024 + -- load dump using fixed buffer + local code = T.testC([[ + loadstring 2 name B; + return 1 + ]], source) + collectgarbage() + local m2 = collectgarbage"count" * 1024 + -- load used fewer than 400 bytes. Code alone has more than 3*N bytes, + -- and string literal has N bytes. Both were not loaded. + assert(m2 > m1 and m2 - m1 < 400) + X = 0; code(); assert(X == N and Y == string.rep("a", N)) + X = nil; Y = nil + + -- testing debug info in fixed buffers + source = {"X = 0"} + for i = 2, 300 do source[i] = "X = X + 1" end + source[#source + 1] = "X = X + {}" -- error in last line + source = table.concat(source, "\n") + source = load(source, "name1") + source = string.dump(source) + -- load dump using fixed buffer + local code = T.testC([[ + loadstring 2 name B; + return 1 + ]], source) + checkerr(":301:", code) -- correct line information +end + + if not _soft then collectgarbage("stop") -- avoid __gc with full stack checkerrnopro("pushnum 3; call 0 0", "attempt to call") @@ -723,7 +811,7 @@ assert(debug.getuservalue(b) == 134) -- test barrier for uservalues do local oldmode = collectgarbage("incremental") - T.gcstate("atomic") + T.gcstate("enteratomic") assert(T.gccolor(b) == "black") debug.setuservalue(b, {x = 100}) T.gcstate("pause") -- complete collection @@ -815,7 +903,7 @@ F = function (x) assert(T.udataval(A) == B) debug.getmetatable(A) -- just access it end - A = x -- ressurect userdata + A = x -- resurrect userdata B = udval return 1,2,3 end @@ -871,28 +959,30 @@ checkerr("FILE%* expected, got userdata", io.input, x) assert(debug.getmetatable(x) == nil and debug.getmetatable(y) == nil) -local d = T.ref(a); -local e = T.ref(b); -local f = T.ref(c); -t = {T.getref(d), T.getref(e), T.getref(f)} +-- Test references in an arbitrary table +local reftable = {} +local d = T.ref(a, reftable); +local e = T.ref(b, reftable); +local f = T.ref(c, reftable); +t = {T.getref(d, reftable), T.getref(e, reftable), T.getref(f, reftable)} assert(t[1] == a and t[2] == b and t[3] == c) t=nil; a=nil; c=nil; -T.unref(e); T.unref(f) +T.unref(e, reftable); T.unref(f, reftable) collectgarbage() -- check that unref objects have been collected assert(#cl == 1 and cl[1] == nc) -x = T.getref(d) +x = T.getref(d, reftable) assert(type(x) == 'userdata' and debug.getmetatable(x) == tt) x =nil tt.b = b -- create cycle tt=nil -- frees tt for GC A = nil b = nil -T.unref(d); +T.unref(d, reftable); local n5 = T.newuserdata(0) debug.setmetatable(n5, {__gc=F}) n5 = T.udataval(n5) @@ -901,6 +991,21 @@ assert(#cl == 4) -- check order of collection assert(cl[2] == n5 and cl[3] == nb and cl[4] == na) +-- reuse a reference in 'reftable' +T.unref(T.ref(23, reftable), reftable) + +do -- check reftable + local count = 0 + local i = 1 + while reftable[i] ~= 0 do + i = reftable[i] -- traverse linked list of free references + count = count + 1 + end + -- maximum number of simultaneously locked objects was 3 + assert(count == 3 and #reftable == 3 + 1) -- +1 for reserved [1] +end + + collectgarbage"restart" @@ -1046,10 +1151,12 @@ assert(a == nil and c == 2) -- 2 == run-time error a, b, c = T.doremote(L1, "return a+") assert(a == nil and c == 3 and type(b) == "string") -- 3 == syntax error -T.loadlib(L1) +T.loadlib(L1, 2, ~2) -- load only 'package', preload all others a, b, c = T.doremote(L1, [[ string = require'string' - a = require'_G'; assert(a == _G and require("_G") == a) + local initialG = _G -- not loaded yet + local a = require'_G'; assert(a == _G and require("_G") == a) + assert(initialG == nil and io == nil) -- now we have 'assert' io = require'io'; assert(type(io.read) == "function") assert(require("io") == io) a = require'table'; assert(type(a.insert) == "function") @@ -1063,7 +1170,7 @@ T.closestate(L1); L1 = T.newstate() -T.loadlib(L1) +T.loadlib(L1, 0, 0) T.doremote(L1, "a = {}") T.testC(L1, [[getglobal "a"; pushstring "x"; pushint 1; settable -3]]) @@ -1115,7 +1222,8 @@ do local a, b = pcall(T.makeCfunc[[ call 0 1 # create resource toclose -1 # mark it to be closed - error # resource is the error object + pushvalue -1 # replicate it as error object + error # resource right after error object ]], newresource) assert(a == false and b[1] == 11) assert(#openresource == 0) -- was closed @@ -1191,241 +1299,6 @@ do end ---[[ -** {================================================================== -** Testing memory limits -** =================================================================== ---]] - -print("memory-allocation errors") - -checkerr("block too big", T.newuserdata, math.maxinteger) -collectgarbage() -local f = load"local a={}; for i=1,100000 do a[i]=i end" -T.alloccount(10) -checkerr(MEMERRMSG, f) -T.alloccount() -- remove limit - - --- test memory errors; increase limit for maximum memory by steps, --- o that we get memory errors in all allocations of a given --- task, until there is enough memory to complete the task without --- errors. -local function testbytes (s, f) - collectgarbage() - local M = T.totalmem() - local oldM = M - local a,b = nil - while true do - collectgarbage(); collectgarbage() - T.totalmem(M) - a, b = T.testC("pcall 0 1 0; pushstatus; return 2", f) - T.totalmem(0) -- remove limit - if a and b == "OK" then break end -- stop when no more errors - if b ~= "OK" and b ~= MEMERRMSG then -- not a memory error? - error(a, 0) -- propagate it - end - M = M + 7 -- increase memory limit - end - print(string.format("minimum memory for %s: %d bytes", s, M - oldM)) - return a -end - --- test memory errors; increase limit for number of allocations one --- by one, so that we get memory errors in all allocations of a given --- task, until there is enough allocations to complete the task without --- errors. - -local function testalloc (s, f) - collectgarbage() - local M = 0 - local a,b = nil - while true do - collectgarbage(); collectgarbage() - T.alloccount(M) - a, b = T.testC("pcall 0 1 0; pushstatus; return 2", f) - T.alloccount() -- remove limit - if a and b == "OK" then break end -- stop when no more errors - if b ~= "OK" and b ~= MEMERRMSG then -- not a memory error? - error(a, 0) -- propagate it - end - M = M + 1 -- increase allocation limit - end - print(string.format("minimum allocations for %s: %d allocations", s, M)) - return a -end - - -local function testamem (s, f) - testalloc(s, f) - return testbytes(s, f) -end - - --- doing nothing -b = testamem("doing nothing", function () return 10 end) -assert(b == 10) - --- testing memory errors when creating a new state - -testamem("state creation", function () - local st = T.newstate() - if st then T.closestate(st) end -- close new state - return st -end) - -testamem("empty-table creation", function () - return {} -end) - -testamem("string creation", function () - return "XXX" .. "YYY" -end) - -testamem("coroutine creation", function() - return coroutine.create(print) -end) - - --- testing to-be-closed variables -testamem("to-be-closed variables", function() - local flag - do - local x = - setmetatable({}, {__close = function () flag = true end}) - flag = false - local x = {} - end - return flag -end) - - --- testing threads - --- get main thread from registry (at index LUA_RIDX_MAINTHREAD == 1) -local mt = T.testC("rawgeti R 1; return 1") -assert(type(mt) == "thread" and coroutine.running() == mt) - - - -local function expand (n,s) - if n==0 then return "" end - local e = string.rep("=", n) - return string.format("T.doonnewstack([%s[ %s;\n collectgarbage(); %s]%s])\n", - e, s, expand(n-1,s), e) -end - -G=0; collectgarbage(); a =collectgarbage("count") -load(expand(20,"G=G+1"))() -assert(G==20); collectgarbage(); -- assert(gcinfo() <= a+1) -G = nil - -testamem("running code on new thread", function () - return T.doonnewstack("local x=1") == 0 -- try to create thread -end) - - --- testing memory x compiler - -testamem("loadstring", function () - return load("x=1") -- try to do load a string -end) - - -local testprog = [[ -local function foo () return end -local t = {"x"} -AA = "aaa" -for i = 1, #t do AA = AA .. t[i] end -return true -]] - --- testing memory x dofile -_G.AA = nil -local t =os.tmpname() -local f = assert(io.open(t, "w")) -f:write(testprog) -f:close() -testamem("dofile", function () - local a = loadfile(t) - return a and a() -end) -assert(os.remove(t)) -assert(_G.AA == "aaax") - - --- other generic tests - -testamem("gsub", function () - local a, b = string.gsub("alo alo", "(a)", function (x) return x..'b' end) - return (a == 'ablo ablo') -end) - -testamem("dump/undump", function () - local a = load(testprog) - local b = a and string.dump(a) - a = b and load(b) - return a and a() -end) - -_G.AA = nil - -local t = os.tmpname() -testamem("file creation", function () - local f = assert(io.open(t, 'w')) - assert (not io.open"nomenaoexistente") - io.close(f); - return not loadfile'nomenaoexistente' -end) -assert(os.remove(t)) - -testamem("table creation", function () - local a, lim = {}, 10 - for i=1,lim do a[i] = i; a[i..'a'] = {} end - return (type(a[lim..'a']) == 'table' and a[lim] == lim) -end) - -testamem("constructors", function () - local a = {10, 20, 30, 40, 50; a=1, b=2, c=3, d=4, e=5} - return (type(a) == 'table' and a.e == 5) -end) - -local a = 1 -local close = nil -testamem("closure creation", function () - function close (b) - return function (x) return b + x end - end - return (close(2)(4) == 6) -end) - -testamem("using coroutines", function () - local a = coroutine.wrap(function () - coroutine.yield(string.rep("a", 10)) - return {} - end) - assert(string.len(a()) == 10) - return a() -end) - -do -- auxiliary buffer - local lim = 100 - local a = {}; for i = 1, lim do a[i] = "01234567890123456789" end - testamem("auxiliary buffer", function () - return (#table.concat(a, ",") == 20*lim + lim - 1) - end) -end - -testamem("growing stack", function () - local function foo (n) - if n == 0 then return 1 else return 1 + foo(n - 1) end - end - return foo(100) -end) - --- }================================================================== - - do -- testing failing in 'lua_checkstack' local res = T.testC([[rawcheckstack 500000; return 1]]) assert(res == false) @@ -1446,10 +1319,10 @@ end do -- garbage collection with no extra memory local L = T.newstate() - T.loadlib(L) + T.loadlib(L, 1 | 2, 0) -- load _G and 'package' local res = (T.doremote(L, [[ - _ENV = require"_G" - local T = require"T" + _ENV = _G + assert(string == nil) local a = {} for i = 1, 1000 do a[i] = 'i' .. i end -- grow string table local stsize, stuse = T.querystr() diff --git a/testes/attrib.lua b/testes/attrib.lua index 458488a872..f415608699 100644 --- a/testes/attrib.lua +++ b/testes/attrib.lua @@ -1,5 +1,5 @@ -- $Id: testes/attrib.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print "testing require" @@ -236,7 +236,7 @@ package.path = oldpath local fname = "file_does_not_exist2" local m, err = pcall(require, fname) for t in string.gmatch(package.path..";"..package.cpath, "[^;]+") do - t = string.gsub(t, "?", fname) + local t = string.gsub(t, "?", fname) assert(string.find(err, t, 1, true)) end @@ -308,11 +308,11 @@ else _ENV.x, _ENV.y = nil end + _ENV = _G -- testing preload - do local p = package package = {} @@ -331,6 +331,26 @@ do assert(type(package.path) == "string") end + +do print("testing external strings") + package.cpath = DC"?" + local lib2 = require"lib2-v2" + local t = {} + for _, len in ipairs{0, 10, 39, 40, 41, 1000} do + local str = string.rep("a", len) + local str1 = lib2.newstr(str) + assert(str == str1) + assert(not T or T.hash(str) == T.hash(str1)) + t[str1] = 20; assert(t[str] == 20 and t[str1] == 20) + t[str] = 10; assert(t[str1] == 10) + local tt = {[str1] = str1} + assert(next(tt) == str1 and next(tt, str1) == nil) + assert(tt[str] == str) + local str2 = lib2.newstr(str1) + assert(str == str2 and t[str2] == 10 and tt[str2] == str) + end +end + print('+') end --] @@ -447,7 +467,7 @@ do end --- test of large float/integer indices +-- test of large float/integer indices -- compute maximum integer where all bits fit in a float local maxint = math.maxinteger diff --git a/testes/big.lua b/testes/big.lua index 46fd846674..119caa6c32 100644 --- a/testes/big.lua +++ b/testes/big.lua @@ -1,5 +1,5 @@ -- $Id: testes/big.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h if _soft then return 'a' diff --git a/testes/bitwise.lua b/testes/bitwise.lua index dd0a1a9a39..10afff432f 100644 --- a/testes/bitwise.lua +++ b/testes/bitwise.lua @@ -1,5 +1,5 @@ -- $Id: testes/bitwise.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print("testing bitwise operations") diff --git a/testes/bwcoercion.lua b/testes/bwcoercion.lua index cd735ab0b6..0544944d84 100644 --- a/testes/bwcoercion.lua +++ b/testes/bwcoercion.lua @@ -4,7 +4,7 @@ local strsub = string.sub local print = print -_ENV = nil +global none -- Try to convert a value to an integer, without assuming any coercion. local function toint (x) diff --git a/testes/calls.lua b/testes/calls.lua index a19385843b..0dacb85ab7 100644 --- a/testes/calls.lua +++ b/testes/calls.lua @@ -1,5 +1,7 @@ -- $Id: testes/calls.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * print("testing functions and calls") @@ -22,7 +24,7 @@ assert(not pcall(type)) -- testing local-function recursion -fact = false +global fact = false do local res = 1 local function fact (n) @@ -63,7 +65,7 @@ a.b.c:f2('k', 12); assert(a.b.c.k == 12) print('+') -t = nil -- 'declare' t +global t = nil -- 'declare' t function f(a,b,c) local d = 'a'; t={a,b,c,d} end f( -- this line change must be valid @@ -75,7 +77,7 @@ assert(t[1] == 1 and t[2] == 2 and t[3] == 3 and t[4] == 'a') t = nil -- delete 't' -function fat(x) +global function fat(x) if x <= 1 then return 1 else return x*load("return fat(" .. x-1 .. ")", "")() end @@ -107,7 +109,7 @@ end _G.deep = nil -- "declaration" (used by 'all.lua') -function deep (n) +global function deep (n) if n>0 then deep(n-1) end end deep(10) @@ -178,7 +180,7 @@ do -- tail calls x chain of __call end -- build a chain of __call metamethods ending in function 'foo' - for i = 1, 100 do + for i = 1, 15 do foo = setmetatable({}, {__call = foo}) end @@ -190,8 +192,8 @@ end print('+') -do -- testing chains of '__call' - local N = 20 +do print"testing chains of '__call'" + local N = 15 local u = table.pack for i = 1, N do u = setmetatable({i}, {__call = u}) @@ -204,9 +206,37 @@ do -- testing chains of '__call' assert(Res[i][1] == i) end assert(Res[N + 1] == "a" and Res[N + 2] == "b" and Res[N + 3] == "c") + + local function u (...) + local n = debug.getinfo(1, 't').extraargs + assert(select("#", ...) == n) + return n + end + + for i = 0, N do + assert(u() == i) + u = setmetatable({}, {__call = u}) + end end +do -- testing chains too long + local a = {} + for i = 1, 16 do -- one too many + a = setmetatable({}, {__call = a}) + end + local status, msg = pcall(a) + assert(not status and string.find(msg, "too long")) + + setmetatable(a, {__call = a}) -- infinite chain + local status, msg = pcall(a) + assert(not status and string.find(msg, "too long")) + + -- again, with a tail call + local status, msg = pcall(function () return a() end) + assert(not status and string.find(msg, "too long")) +end + a = nil (function (x) a=x end)(23) assert(a == 23 and (function (x) return x*2 end)(20) == 40) @@ -324,7 +354,7 @@ assert(not load(function () return true end)) -- small bug local t = {nil, "return ", "3"} -f, msg = load(function () return table.remove(t, 1) end) +local f, msg = load(function () return table.remove(t, 1) end) assert(f() == nil) -- should read the empty chunk -- another small bug (in 5.2.1) @@ -360,7 +390,8 @@ assert(load("return _ENV", nil, nil, 123)() == 123) -- load when _ENV is not first upvalue -local x; XX = 123 +global XX; local x +XX = 123 local function h () local y=x -- use 'x', so that it becomes 1st upvalue return XX -- global name @@ -452,15 +483,22 @@ assert((function (a) return a end)() == nil) print("testing binary chunks") do - local header = string.pack("c4BBc6BBB", - "\27Lua", -- signature - 0x54, -- version 5.4 (0x54) - 0, -- format - "\x19\x93\r\n\x1a\n", -- data - 4, -- size of instruction - string.packsize("j"), -- sizeof(lua integer) - string.packsize("n") -- sizeof(lua number) - ) + local headformat = "c4BBc6BiBI4BjBn" + local header = { -- header components + "\27Lua", -- signature + 0x55, -- version 5.5 (0x55) + 0, -- format + "\x19\x93\r\n\x1a\n", -- a binary string + string.packsize("i"), -- size of an int + -0x5678, -- an int + 4, -- size of an instruction + 0x12345678, -- an instruction (4 bytes) + string.packsize("j"), -- size of a Lua integer + -0x5678, -- a Lua integer + string.packsize("n"), -- size of a Lua float + -370.5, -- a Lua float + } + local c = string.dump(function () local a = 1; local b = 3; local f = function () return a + b + _ENV.c; end -- upvalues @@ -472,17 +510,23 @@ do assert(assert(load(c))() == 10) -- check header - assert(string.sub(c, 1, #header) == header) - -- check LUAC_INT and LUAC_NUM - local ci, cn = string.unpack("jn", c, #header + 1) - assert(ci == 0x5678 and cn == 370.5) - - -- corrupted header + local t = {string.unpack(headformat, c)} for i = 1, #header do + assert(t[i] == header[i]) + end + + -- Testing corrupted header. + -- A single wrong byte in the head invalidates the chunk, + -- except for the Lua float check. (If numbers are long double, + -- the representation may need padding, and changing that padding + -- will not invalidate the chunk.) + local headlen = string.packsize(headformat) + headlen = headlen - string.packsize("n") -- remove float check + for i = 1, headlen do local s = string.sub(c, 1, i - 1) .. - string.char(string.byte(string.sub(c, i, i)) + 1) .. + string.char((string.byte(string.sub(c, i, i)) + 1) & 0xFF) .. string.sub(c, i + 1, -1) - assert(#s == #c) + assert(#s == #c and s ~= c) assert(not load(s)) end @@ -493,5 +537,41 @@ do end end + +do -- check reuse of strings in dumps + local str = "|" .. string.rep("X", 50) .. "|" + local foo = load(string.format([[ + local str = "%s" + return { + function () return str end, + function () return str end, + function () return str end + } + ]], str)) + -- count occurrences of 'str' inside the dump + local dump = string.dump(foo) + local _, count = string.gsub(dump, str, {}) + -- there should be only two occurrences: + -- one inside the source, other the string itself. + assert(count == 2) + + if T then -- check reuse of strings in undump + local funcs = load(dump)() + assert(string.format("%p", T.listk(funcs[1])[1]) == + string.format("%p", T.listk(funcs[3])[1])) + end +end + + +do -- test limit of multiple returns (254 values) + local code = "return 10" .. string.rep(",10", 253) + local res = {assert(load(code))()} + assert(#res == 254 and res[254] == 10) + + code = code .. ",10" + local status, msg = load(code) + assert(not status and string.find(msg, "too many returns")) +end + print('OK') return deep diff --git a/testes/closure.lua b/testes/closure.lua index ea038e8245..0c2e96c0f1 100644 --- a/testes/closure.lua +++ b/testes/closure.lua @@ -1,8 +1,18 @@ -- $Id: testes/closure.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * print "testing closures" +do -- bug in 5.4.7 + _ENV[true] = 10 + local function aux () return _ENV[1 < 2] end + assert(aux() == 10) + _ENV[true] = nil +end + + local A,B = 0,{g=10} local function f(x) local a = {} @@ -60,32 +70,29 @@ end -- testing closures with 'for' control variable a = {} for i=1,10 do - a[i] = {set = function(x) i=x end, get = function () return i end} + a[i] = function () return i end if i == 3 then break end end assert(a[4] == undef) -a[1].set(10) -assert(a[2].get() == 2) -a[2].set('a') -assert(a[3].get() == 3) -assert(a[2].get() == 'a') +assert(a[2]() == 2) +assert(a[3]() == 3) a = {} local t = {"a", "b"} for i = 1, #t do local k = t[i] - a[i] = {set = function(x, y) i=x; k=y end, + a[i] = {set = function(x) k=x end, get = function () return i, k end} if i == 2 then break end end -a[1].set(10, 20) +a[1].set(10) local r,s = a[2].get() assert(r == 2 and s == 'b') r,s = a[1].get() -assert(r == 10 and s == 20) -a[2].set('a', 'b') +assert(r == 1 and s == 10) +a[2].set('a') r,s = a[2].get() -assert(r == "a" and s == "b") +assert(r == 2 and s == "a") -- testing closures with 'for' control variable x break diff --git a/testes/code.lua b/testes/code.lua index bd4b10d028..380ff70c1b 100644 --- a/testes/code.lua +++ b/testes/code.lua @@ -1,5 +1,7 @@ -- $Id: testes/code.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * if T==nil then (Message or print)('\n >>> testC not active: skipping opcode tests <<<\n') @@ -405,20 +407,29 @@ do -- tests for table access in upvalues end -- de morgan -checkequal(function () local a; if not (a or b) then b=a end end, - function () local a; if (not a and not b) then b=a end end) +checkequal(function () local a, b; if not (a or b) then b=a end end, + function () local a, b; if (not a and not b) then b=a end end) checkequal(function (l) local a; return 0 <= a and a <= l end, function (l) local a; return not (not(a >= 0) or not(a <= l)) end) --- if-break optimizations check(function (a, b) while a do if b then break else a = a + 1 end end end, -'TEST', 'JMP', 'TEST', 'JMP', 'ADDI', 'MMBINI', 'JMP', 'RETURN0') +'TEST', 'JMP', 'TEST', 'JMP', 'JMP', 'CLOSE', 'JMP', 'ADDI', 'MMBINI', 'JMP', 'RETURN0') + +check(function () + do + goto exit -- don't need to close + local x = nil + goto exit -- must close + end + ::exit:: + end, 'JMP', 'CLOSE', 'LOADNIL', 'TBC', + 'CLOSE', 'JMP', 'CLOSE', 'RETURN') checkequal(function () return 6 or true or nil end, function () return k6 or kTrue or kNil end) @@ -445,5 +456,49 @@ do -- string constants assert(T.listk(f2)[1] == nil) end + +do -- check number of available registers + -- 1 register for local + 1 for function + 252 arguments + local source = "local a; return a(" .. string.rep("a, ", 252) .. "a)" + local prog = T.listcode(assert(load(source))) + -- maximum valid register is 254 + for i = 1, 254 do + assert(string.find(prog[2 + i], "MOVE%s*" .. i)) + end + -- one more argument would need register #255 (but that is reserved) + source = "local a; return a(" .. string.rep("a, ", 253) .. "a)" + local _, msg = load(source) + assert(string.find(msg, "too many registers")) +end + + +do -- basic check for SETLIST + -- create a list constructor with 50 elements + local source = "local a; return {" .. string.rep("a, ", 50) .. "}" + local func = assert(load(source)) + local code = table.concat(T.listcode(func), "\n") + local _, count = string.gsub(code, "SETLIST", "") + -- code uses only 1 SETLIST for the constructor + assert(count == 1) +end + + +do print("testing code for integer limits") + local function checkints (n) + local source = string.format( + "local a = {[true] = 0X%x}; return a[true]", n) + local f = assert(load(source)) + checkKlist(f, {n}) + assert(f() == n) + f = load(string.dump(f)) + assert(f() == n) + end + + checkints(math.maxinteger) + checkints(math.mininteger) + checkints(-1) + +end + print 'OK' diff --git a/testes/constructs.lua b/testes/constructs.lua index 6ac6816671..94f670c7a5 100644 --- a/testes/constructs.lua +++ b/testes/constructs.lua @@ -1,5 +1,5 @@ -- $Id: testes/constructs.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h ;;print "testing syntax";; @@ -60,7 +60,7 @@ assert((x>y) and x or y == 2); assert(1234567890 == tonumber('1234567890') and 1234567890+1 == 1234567891) -do -- testing operators with diffent kinds of constants +do -- testing operators with different kinds of constants -- operands to consider: -- * fit in register -- * constant doesn't fit in register diff --git a/testes/coroutine.lua b/testes/coroutine.lua index de7e46fbd3..4881d96478 100644 --- a/testes/coroutine.lua +++ b/testes/coroutine.lua @@ -1,5 +1,5 @@ -- $Id: testes/coroutine.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print "testing coroutines" @@ -127,6 +127,18 @@ assert(#a == 22 and a[#a] == 79) x, a = nil +do -- "bug" in 5.4.2 + local function foo () foo () end -- just create a stack overflow + local co = coroutine.create(foo) + -- running this coroutine would overflow the unsigned short 'nci', the + -- counter of CallInfo structures available to the thread. + -- (The issue only manifests in an 'assert'.) + local st, msg = coroutine.resume(co) + assert(string.find(msg, "stack overflow")) + assert(coroutine.status(co) == "dead") +end + + print("to-be-closed variables in coroutines") local function func2close (f) @@ -144,12 +156,12 @@ do st, msg = coroutine.close(co) assert(st and msg == nil) + local main = coroutine.running() - -- cannot close the running coroutine - local st, msg = pcall(coroutine.close, coroutine.running()) - assert(not st and string.find(msg, "running")) + -- cannot close 'main' + local st, msg = pcall(coroutine.close, main); + assert(not st and string.find(msg, "main")) - local main = coroutine.running() -- cannot close a "normal" coroutine ;(coroutine.wrap(function () @@ -157,20 +169,19 @@ do assert(not st and string.find(msg, "normal")) end))() - -- cannot close a coroutine while closing it - do + do -- close a coroutine while closing it local co co = coroutine.create( function() local x = func2close(function() - coroutine.close(co) -- try to close it again + coroutine.close(co) -- close it again end) coroutine.yield(20) end) local st, msg = coroutine.resume(co) assert(st and msg == 20) st, msg = coroutine.close(co) - assert(not st and string.find(msg, "running coroutine")) + assert(st and msg == nil) end -- to-be-closed variables in coroutines @@ -277,6 +288,56 @@ do end +do print("coroutines closing itself") + global coroutine, string, os + global assert, error, pcall + + local X = nil + + local function new () + return coroutine.create(function (what) + + local var = func2close(function (t, err) + if what == "yield" then + coroutine.yield() + elseif what == "error" then + error(200) + else + X = "Ok" + return X + end + end) + + -- do an unprotected call so that coroutine becomes non-yieldable + string.gsub("a", "a", function () + assert(not coroutine.isyieldable()) + -- do protected calls while non-yieldable, to add recovery + -- entries (setjmp) to the stack + assert(pcall(pcall, function () + -- 'close' works even while non-yieldable + coroutine.close() -- close itself + os.exit(false) -- not reacheable + end)) + end) + end) + end + + local co = new() + local st, msg = coroutine.resume(co, "ret") + assert(st and msg == nil) + assert(X == "Ok") + + local co = new() + local st, msg = coroutine.resume(co, "error") + assert(not st and msg == 200) + + local co = new() + local st, msg = coroutine.resume(co, "yield") + assert(not st and string.find(msg, "attempt to yield")) + +end + + -- yielding across C boundaries local co = coroutine.wrap(function() @@ -493,6 +554,25 @@ assert(not pcall(a, a)) a = nil +do + -- bug in 5.4: thread can use message handler higher in the stack + -- than the variable being closed + local c = coroutine.create(function() + local clo = setmetatable({}, {__close=function() + local x = 134 -- will overwrite message handler + error(x) + end}) + -- yields coroutine but leaves a new message handler for it, + -- that would be used when closing the coroutine (except that it + -- will be overwritten) + xpcall(coroutine.yield, function() return "XXX" end) + end) + + assert(coroutine.resume(c)) -- start coroutine + local st, msg = coroutine.close(c) + assert(not st and msg == 134) +end + -- access to locals of erroneous coroutines local x = coroutine.create (function () local a = 10 @@ -515,7 +595,7 @@ else print "testing yields inside hooks" local turn - + local function fact (t, x) assert(turn == t) if x == 0 then return 1 @@ -610,18 +690,20 @@ else -- (bug in 5.2/5.3) c = coroutine.create(function (a, ...) T.sethook("yield 0", "l") -- will yield on next two lines - assert(a == 10) + local b = a return ... end) assert(coroutine.resume(c, 1, 2, 3)) -- start coroutine local n,v = debug.getlocal(c, 0, 1) -- check its local - assert(n == "a" and v == 1) + assert(n == "a" and v == 1 and debug.getlocal(c, 0, 2) ~= "b") assert(debug.setlocal(c, 0, 1, 10)) -- test 'setlocal' local t = debug.getinfo(c, 0) -- test 'getinfo' - assert(t.currentline == t.linedefined + 1) + assert(t.currentline == t.linedefined + 2) assert(not debug.getinfo(c, 1)) -- no other level assert(coroutine.resume(c)) -- run next line + local n,v = debug.getlocal(c, 0, 2) -- check next local + assert(n == "b" and v == 10) v = {coroutine.resume(c)} -- finish coroutine assert(v[1] == true and v[2] == 2 and v[3] == 3 and v[4] == undef) assert(not coroutine.resume(c)) @@ -640,7 +722,7 @@ else print "testing coroutine API" - + -- reusing a thread assert(T.testC([[ newthread # create thread @@ -681,7 +763,7 @@ else c == "ERRRUN" and d == 4) a, b, c, d = T.testC([[ - rawgeti R 1 # get main thread + rawgeti R !M # get main thread pushnum 10; pushnum 20; resume -3 2; @@ -699,11 +781,11 @@ else assert(T.testC(state, "newthread; isyieldable -1; remove 1; return 1")) -- main thread is not yieldable - assert(not T.testC(state, "rawgeti R 1; isyieldable -1; remove 1; return 1")) + assert(not T.testC(state, "rawgeti R !M; isyieldable -1; remove 1; return 1")) T.testC(state, "settop 0") - T.loadlib(state) + T.loadlib(state, 1 | 2, 4) -- load _G and 'package', preload 'coroutine' assert(T.doremote(state, [[ coroutine = require'coroutine'; @@ -711,7 +793,7 @@ else return 'ok']])) local t = table.pack(T.testC(state, [[ - rawgeti R 1 # get main thread + rawgeti R !M # get main thread pushstring 'XX' getglobal X # get function for body pushstring AA # arg @@ -720,7 +802,7 @@ else setglobal T # top setglobal B # second yielded value setglobal A # fist yielded value - rawgeti R 1 # get main thread + rawgeti R !M # get main thread pushnum 5 # arg (noise) resume 1 1 # after coroutine ends, previous stack is back pushstatus @@ -918,7 +1000,7 @@ do -- a few more tests for comparison operators until res ~= 10 return res end - + local function test () local a1 = setmetatable({x=1}, mt1) local a2 = setmetatable({x=2}, mt2) @@ -930,7 +1012,7 @@ do -- a few more tests for comparison operators assert(2 >= a2) return true end - + run(test) end @@ -1035,6 +1117,31 @@ f = T.makeCfunc([[ return * ]], 23, "huu") + +do -- testing bug introduced in commit f407b3c4a + local X = false -- flag "to be closed" + local coro = coroutine.wrap(T.testC) + -- runs it until 'pcallk' (that yields) + -- 4th argument (at index 4): object to be closed + local res1, res2 = coro( + [[ + toclose 3 # this could break the next 'pcallk' + pushvalue 2 # push function 'yield' to call it + pushint 22; pushint 33 # arguments to yield + # calls 'yield' (2 args; 2 results; continuation function at index 4) + pcallk 2 2 4 + invalid command (should not arrive here) + ]], -- 1st argument (at index 1): code; + coroutine.yield, -- (at index 2): function to be called + func2close(function () X = true end), -- (index 3): TBC slot + "pushint 43; return 3" -- (index 4): code for continuation function + ) + + assert(res1 == 22 and res2 == 33 and not X) + local res1, res2, res3 = coro(34, "hi") -- runs continuation function + assert(res1 == 34 and res2 == "hi" and res3 == 43 and X) +end + x = coroutine.wrap(f) assert(x() == 102) eqtab({x()}, {23, "huu"}) @@ -1092,11 +1199,11 @@ co = coroutine.wrap(function (...) return cannot be here! ]], [[ # 1st continuation - yieldk 0 3 + yieldk 0 3 cannot be here! ]], [[ # 2nd continuation - yieldk 0 4 + yieldk 0 4 cannot be here! ]], [[ # 3th continuation diff --git a/testes/cstack.lua b/testes/cstack.lua index 97afe9fd03..0a68a30ac2 100644 --- a/testes/cstack.lua +++ b/testes/cstack.lua @@ -1,5 +1,5 @@ -- $Id: testes/cstack.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h local tracegc = require"tracegc" diff --git a/testes/db.lua b/testes/db.lua index 02b96aca2e..0f174f17f7 100644 --- a/testes/db.lua +++ b/testes/db.lua @@ -1,5 +1,5 @@ -- $Id: testes/db.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h -- testing debug library @@ -49,6 +49,15 @@ do end +-- bug in 5.4.4-5.4.6: activelines in vararg functions +-- without debug information +do + local func = load(string.dump(load("print(10)"), true)) + local actl = debug.getinfo(func, "L").activelines + assert(#actl == 0) -- no line info +end + + -- test file and string names truncation local a = "function f () end" local function dostring (s, x) return load(s, x)() end @@ -119,7 +128,7 @@ then else a=2 end -]], {2,3,4,7}) +]], {2,4,7}) test([[ @@ -340,12 +349,15 @@ end, "crl") function f(a,b) + -- declare some globals to check that they don't interfere with 'getlocal' + global collectgarbage collectgarbage() local _, x = debug.getlocal(1, 1) + global assert, g, string local _, y = debug.getlocal(1, 2) assert(x == a and y == b) assert(debug.setlocal(2, 3, "pera") == "AA".."AA") - assert(debug.setlocal(2, 4, "maçã") == "B") + assert(debug.setlocal(2, 4, "manga") == "B") x = debug.getinfo(2) assert(x.func == g and x.what == "Lua" and x.name == 'g' and x.nups == 2 and string.find(x.source, "^@.*db%.lua$")) @@ -373,11 +385,13 @@ function g (...) local arg = {...} do local a,b,c; a=math.sin(40); end local feijao - local AAAA,B = "xuxu", "mamão" + local AAAA,B = "xuxu", "abacate" f(AAAA,B) - assert(AAAA == "pera" and B == "maçã") + assert(AAAA == "pera" and B == "manga") do + global * local B = 13 + global assert local x,y = debug.getlocal(1,5) assert(x == 'B' and y == 13) end @@ -422,7 +436,7 @@ do assert(a == nil and not b) end --- testing iteraction between multiple values x hooks +-- testing interaction between multiple values x hooks do local function f(...) return 3, ... end local count = 0 @@ -578,7 +592,7 @@ t = getupvalues(foo2) assert(t.a == 1 and t.b == 2 and t.c == 3) assert(debug.setupvalue(foo1, 1, "xuxu") == "b") assert(({debug.getupvalue(foo2, 3)})[2] == "xuxu") --- upvalues of C functions are allways "called" "" (the empty string) +-- upvalues of C functions are always named "" (the empty string) assert(debug.getupvalue(string.gmatch("x", "x"), 1) == "") @@ -615,6 +629,9 @@ local function f (x) end end +assert(debug.getinfo(print, 't').istailcall == false) +assert(debug.getinfo(print, 't').extraargs == 0) + function g(x) return f(x) end function g1(x) g(x) end @@ -689,7 +706,7 @@ assert(debug.traceback(print, 4) == print) assert(string.find(debug.traceback("hi", 4), "^hi\n")) assert(string.find(debug.traceback("hi"), "^hi\n")) assert(not string.find(debug.traceback("hi"), "'debug.traceback'")) -assert(string.find(debug.traceback("hi", 0), "'debug.traceback'")) +assert(string.find(debug.traceback("hi", 0), "'traceback'")) assert(string.find(debug.traceback(), "^stack traceback:\n")) do -- C-function names in traceback @@ -817,7 +834,7 @@ end co = coroutine.create(function (x) f(x) end) a, b = coroutine.resume(co, 3) -t = {"'coroutine.yield'", "'f'", "in function <"} +t = {"'yield'", "'f'", "in function <"} while coroutine.status(co) == "suspended" do checktraceback(co, t) a, b = coroutine.resume(co) @@ -827,7 +844,7 @@ t[1] = "'error'" checktraceback(co, t) --- test acessing line numbers of a coroutine from a resume inside +-- test accessing line numbers of a coroutine from a resume inside -- a C function (this is a known bug in Lua 5.0) local function g(x) @@ -928,7 +945,7 @@ do local cl = countlines(rest) -- at most 10 lines in first part, 11 in second, plus '...' assert(cl <= 10 + 11 + 1) - local brk = string.find(rest, "%.%.%.") + local brk = string.find(rest, "%.%.%.\t%(skip") if brk then -- does message have '...'? local rest1 = string.sub(rest, 1, brk) local rest2 = string.sub(rest, brk, #rest) @@ -954,9 +971,9 @@ local debug = require'debug' local a = 12 -- a local variable local n, v = debug.getlocal(1, 1) -assert(n == "(temporary)" and v == debug) -- unkown name but known value +assert(n == "(temporary)" and v == debug) -- unknown name but known value n, v = debug.getlocal(1, 2) -assert(n == "(temporary)" and v == 12) -- unkown name but known value +assert(n == "(temporary)" and v == 12) -- unknown name but known value -- a function with an upvalue local f = function () local x; return a end @@ -1006,7 +1023,7 @@ do -- bug in 5.4.0: line hooks in stripped code line = l end, "l") assert(s() == 2); debug.sethook(nil) - assert(line == nil) -- hook called withoug debug info for 1st instruction + assert(line == nil) -- hook called without debug info for 1st instruction end do -- tests for 'source' in binary dumps diff --git a/testes/errors.lua b/testes/errors.lua index cf0ab5265d..c9d850994b 100644 --- a/testes/errors.lua +++ b/testes/errors.lua @@ -1,5 +1,5 @@ -- $Id: testes/errors.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print("testing errors") @@ -45,8 +45,8 @@ end -- test error message with no extra info assert(doit("error('hi', 0)") == 'hi') --- test error message with no info -assert(doit("error()") == nil) +-- test nil error message +assert(doit("error()") == "") -- test common errors/errors that crashed in the past @@ -91,7 +91,7 @@ end if not T then (Message or print) - ('\n >>> testC not active: skipping memory message test <<<\n') + ('\n >>> testC not active: skipping tests for messages in C <<<\n') else print "testing memory error message" local a = {} @@ -104,6 +104,44 @@ else end) T.totalmem(0) assert(not st and msg == "not enough" .. " memory") + + -- stack space for luaL_traceback (bug in 5.4.6) + local res = T.testC[[ + # push 16 elements on the stack + pushnum 1; pushnum 1; pushnum 1; pushnum 1; pushnum 1; + pushnum 1; pushnum 1; pushnum 1; pushnum 1; pushnum 1; + pushnum 1; pushnum 1; pushnum 1; pushnum 1; pushnum 1; + pushnum 1; + # traceback should work with 4 remaining slots + traceback xuxu 1; + return 1 + ]] + assert(string.find(res, "xuxu.-main chunk")) + + do -- tests for error messages about extra arguments from __call + local function createobj (n) + -- function that raises an error on its n-th argument + local code = string.format("argerror %d 'msg'", n) + local func = T.makeCfunc(code) + -- create a chain of 2 __call objects + local M = setmetatable({}, {__call = func}) + M = setmetatable({}, {__call = M}) + -- put it as a method for a new object + return {foo = M} + end + + _G.a = createobj(1) -- error in first (extra) argument + checkmessage("a:foo()", "bad extra argument #1") + + _G.a = createobj(2) -- error in second (extra) argument + checkmessage("a:foo()", "bad extra argument #2") + + _G.a = createobj(3) -- error in self (after two extra arguments) + checkmessage("a:foo()", "bad self") + + _G.a = createobj(4) -- error in first regular argument (after self) + checkmessage("a:foo()", "bad argument #1") + end end @@ -121,6 +159,12 @@ assert(not string.find(doit"aaa={13}; local bbbb=1; aaa[bbbb](3)", "'bbbb'")) checkmessage("aaa={13}; local bbbb=1; aaa[bbbb](3)", "number") checkmessage("aaa=(1)..{}", "a table value") +-- bug in 5.4.6 +checkmessage("a = {_ENV = {}}; print(a._ENV.x + 1)", "field 'x'") + +-- a similar bug, since 5.4.0 +checkmessage("print(('_ENV').x + 1)", "field 'x'") + _G.aaa, _G.bbbb = nil -- calls @@ -259,14 +303,14 @@ do local f = function (a) return a + 1 end f = assert(load(string.dump(f, true))) assert(f(3) == 4) - checkerr("^%?:%-1:", f, {}) + checkerr("^%?:%?:", f, {}) -- code with a move to a local var ('OP_MOV A B' with A a, b +]], 1, "multiple") if not _soft then - -- several tests that exaust the Lua stack + -- several tests that exhaust the Lua stack collectgarbage() print"testing stack overflow" local C = 0 @@ -505,7 +586,7 @@ if not _soft then -- error in error handling local res, msg = xpcall(error, error) - assert(not res and type(msg) == 'string') + assert(not res and msg == 'error in error handling') print('+') local function f (x) @@ -536,6 +617,27 @@ if not _soft then end +do -- errors in error handle that not necessarily go forever + local function err (n) -- function to be used as message handler + -- generate an error unless n is zero, so that there is a limited + -- loop of errors + if type(n) ~= "number" then -- some other error? + return n -- report it + elseif n == 0 then + return "END" -- that will be the final message + else error(n - 1) -- does the loop + end + end + + local res, msg = xpcall(error, err, 170) + assert(not res and msg == "END") + + -- too many levels + local res, msg = xpcall(error, err, 300) + assert(not res and msg == "C stack overflow") +end + + do -- non string messages local t = {} @@ -543,7 +645,7 @@ do assert(not res and msg == t) res, msg = pcall(function () error(nil) end) - assert(not res and msg == nil) + assert(not res and msg == "") local function f() error{msg='x'} end res, msg = xpcall(f, function (r) return {msg=r.msg..'y'} end) @@ -563,7 +665,7 @@ do assert(not res and msg == t) res, msg = pcall(assert, nil, nil) - assert(not res and msg == nil) + assert(not res and type(msg) == "string") -- 'assert' without arguments res, msg = pcall(assert) @@ -607,21 +709,26 @@ end -- testing syntax limits local function testrep (init, rep, close, repc, finalresult) - local s = init .. string.rep(rep, 100) .. close .. string.rep(repc, 100) - local res, msg = load(s) - assert(res) -- 100 levels is OK + local function gencode (n) + return init .. string.rep(rep, n) .. close .. string.rep(repc, n) + end + local res, msg = load(gencode(100)) -- 100 levels is OK + assert(res) if (finalresult) then assert(res() == finalresult) end - s = init .. string.rep(rep, 500) - local res, msg = load(s) -- 500 levels not ok + local res, msg = load(gencode(500)) -- 500 levels not ok assert(not res and (string.find(msg, "too many") or string.find(msg, "overflow"))) end +testrep("local a", ",a", ";", "") -- local variables +testrep("local a", ",a", "= 1", ",1") -- local variables initialized +testrep("local a", ",a", "= f()", "") -- local variables initialized testrep("local a; a", ",a", "= 1", ",1") -- multiple assignment -testrep("local a; a=", "{", "0", "}") -testrep("return ", "(", "2", ")", 2) +testrep("local a; a=", "{", "0", "}") -- constructors +testrep("return ", "(", "2", ")", 2) -- parentheses +-- nested calls (a(a(a(a(...))))) testrep("local function a (x) return x end; return ", "a(", "2.2", ")", 2.2) testrep("", "do ", "", " end") testrep("", "while a do ", "", " end") @@ -660,7 +767,7 @@ assert(c > 255 and string.find(b, "too many upvalues") and -- local variables s = "\nfunction foo ()\n local " -for j = 1,300 do +for j = 1,200 do s = s.."a"..j..", " end s = s.."b\n" diff --git a/testes/events.lua b/testes/events.lua index 8d8563b952..7e434b1f6f 100644 --- a/testes/events.lua +++ b/testes/events.lua @@ -1,5 +1,5 @@ -- $Id: testes/events.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print('testing metatables') @@ -248,6 +248,15 @@ end test(Op(1), Op(2), Op(3)) +do -- test nil as false + local x = setmetatable({12}, {__eq= function (a,b) + return a[1] == b[1] or nil + end}) + assert(not (x == {20})) + assert(x == {12}) +end + + -- test `partial order' local function rawSet(x) @@ -370,6 +379,17 @@ x = 0 .."a".."b"..c..d.."e".."f".."g" assert(x.val == "0abcdefg") +do + -- bug since 5.4.1 (test needs T) + local mt = setmetatable({__newindex={}}, {__mode='v'}) + local t = setmetatable({}, mt) + + if T then T.allocfailnext() end + + -- seg. fault + for i=1, 10 do t[i] = 1 end +end + -- concat metamethod x numbers (bug in 5.1.1) c = {} local x @@ -472,7 +492,7 @@ assert(not pcall(function (a,b) return a[b] end, a, 10)) assert(not pcall(function (a,b,c) a[b] = c end, a, 10, true)) -- bug in 5.1 -T, K, V = nil +local T, K, V = nil grandparent = {} grandparent.__newindex = function(t,k,v) T=t; K=k; V=v end diff --git a/testes/files.lua b/testes/files.lua index be00bf3fd1..7146ac7ca2 100644 --- a/testes/files.lua +++ b/testes/files.lua @@ -1,5 +1,7 @@ -- $Id: testes/files.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * local debug = require "debug" @@ -74,6 +76,8 @@ io.input(io.stdin); io.output(io.stdout); os.remove(file) assert(not loadfile(file)) +-- Lua code cannot use chunks with fixed buffers +checkerr("invalid mode", load, "", "", "B") checkerr("", dofile, file) assert(not io.open(file)) io.output(file) @@ -92,8 +96,8 @@ assert(io.output():seek("end") == string.len("alo joao")) assert(io.output():seek("set") == 0) -assert(io.write('"álo"', "{a}\n", "second line\n", "third line \n")) -assert(io.write('çfourth_line')) +assert(io.write('"alo"', "{a}\n", "second line\n", "third line \n")) +assert(io.write('Xfourth_line')) io.output(io.stdout) collectgarbage() -- file should be closed by GC assert(io.input() == io.stdin and rawequal(io.output(), io.stdout)) @@ -300,14 +304,14 @@ do -- test error returns end checkerr("invalid format", io.read, "x") assert(io.read(0) == "") -- not eof -assert(io.read(5, 'l') == '"álo"') +assert(io.read(5, 'l') == '"alo"') assert(io.read(0) == "") assert(io.read() == "second line") local x = io.input():seek() assert(io.read() == "third line ") assert(io.input():seek("set", x)) assert(io.read('L') == "third line \n") -assert(io.read(1) == "ç") +assert(io.read(1) == "X") assert(io.read(string.len"fourth_line") == "fourth_line") assert(io.input():seek("cur", -string.len"fourth_line")) assert(io.read() == "fourth_line") @@ -345,7 +349,7 @@ collectgarbage() assert(io.write(' ' .. t .. ' ')) assert(io.write(';', 'end of file\n')) -f:flush(); io.flush() +assert(f:flush()); assert(io.flush()) f:close() print('+') @@ -427,12 +431,12 @@ do -- testing closing file in line iteration -- get the to-be-closed variable from a loop local function gettoclose (lv) lv = lv + 1 - local stvar = 0 -- to-be-closed is 4th state variable in the loop + local stvar = 0 -- to-be-closed is 3th state variable in the loop for i = 1, 1000 do local n, v = debug.getlocal(lv, i) if n == "(for state)" then stvar = stvar + 1 - if stvar == 4 then return v end + if stvar == 3 then return v end end end end @@ -459,7 +463,24 @@ do -- testing closing file in line iteration end --- test for multipe arguments in 'lines' +do print("testing flush") + local f = io.output("/dev/null") + assert(f:write("abcd")) -- write to buffer + assert(f:flush()) -- write to device + assert(f:write("abcd")) -- write to buffer + assert(io.flush()) -- write to device + assert(f:close()) + + local f = io.output("/dev/full") + assert(f:write("abcd")) -- write to buffer + assert(not f:flush()) -- cannot write to device + assert(f:write("abcd")) -- write to buffer + assert(not io.flush()) -- cannot write to device + assert(f:close()) +end + + +-- test for multiple arguments in 'lines' io.output(file); io.write"0123456789\n":close() for a,b in io.lines(file, 1, 1) do if a == "\n" then assert(not b) @@ -694,6 +715,37 @@ do end +if T and T.nonblock and not _port then + print("testing failed write") + + -- unable to write anything to /dev/full + local f = io.open("/dev/full", "w") + assert(f:setvbuf("no")) + local _, _, err, count = f:write("abcd") + assert(err > 0 and count == 0) + assert(f:close()) + + -- receiver will read a "few" bytes (enough to empty a large buffer) + local receiver = [[ + lua -e 'assert(io.stdin:setvbuf("no")); assert(#io.read(1e4) == 1e4)' ]] + + local f = io.popen(receiver, "w") + assert(f:setvbuf("no")) + T.nonblock(f) + + -- able to write a few bytes + assert(f:write(string.rep("a", 1e2))) + + -- Unable to write more bytes than the pipe buffer supports. + -- (In Linux, the pipe buffer size is 64K (2^16). Posix requires at + -- least 512 bytes.) + local _, _, err, count = f:write("abcd", string.rep("a", 2^17)) + assert(err > 0 and count >= 512 and count < 2^17) + + assert(f:close()) +end + + if not _soft then print("testing large files (> BUFSIZ)") io.output(file) @@ -764,6 +816,7 @@ if not _port then assert((v[3] == nil and z > 0) or v[3] == z) end end + print("(done)") end @@ -787,13 +840,13 @@ assert(os.date("!\0\0") == "\0\0") local x = string.rep("a", 10000) assert(os.date(x) == x) local t = os.time() -D = os.date("*t", t) +global D = os.date("*t", t) assert(os.date(string.rep("%d", 1000), t) == string.rep(os.date("%d", t), 1000)) assert(os.date(string.rep("%", 200)) == string.rep("%", 100)) local function checkDateTable (t) - _G.D = os.date("*t", t) + D = os.date("*t", t) assert(os.time(D) == t) load(os.date([[assert(D.year==%Y and D.month==%m and D.day==%d and D.hour==%H and D.min==%M and D.sec==%S and diff --git a/testes/gc.lua b/testes/gc.lua index 03093e34ff..62713dac64 100644 --- a/testes/gc.lua +++ b/testes/gc.lua @@ -1,5 +1,5 @@ -- $Id: testes/gc.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print('testing incremental garbage collection') @@ -27,27 +27,54 @@ end -- test weird parameters to 'collectgarbage' do - -- save original parameters - local a = collectgarbage("setpause", 200) - local b = collectgarbage("setstepmul", 200) + collectgarbage("incremental") + local opause = collectgarbage("param", "pause", 100) + local ostepmul = collectgarbage("param", "stepmul", 100) + assert(collectgarbage("param", "pause") == 100) + assert(collectgarbage("param", "stepmul") == 100) local t = {0, 2, 10, 90, 500, 5000, 30000, 0x7ffffffe} for i = 1, #t do - local p = t[i] + collectgarbage("param", "pause", t[i]) for j = 1, #t do - local m = t[j] - collectgarbage("setpause", p) - collectgarbage("setstepmul", m) - collectgarbage("step", 0) - collectgarbage("step", 10000) + collectgarbage("param", "stepmul", t[j]) + collectgarbage("step", t[j]) end end -- restore original parameters - collectgarbage("setpause", a) - collectgarbage("setstepmul", b) + collectgarbage("param", "pause", opause) + collectgarbage("param", "stepmul", ostepmul) collectgarbage() end +-- +-- test the "size" of basic GC steps (whatever they mean...) +-- +do print("steps") + + local function dosteps (siz) + collectgarbage() + local a = {} + for i=1,100 do a[i] = {{}}; local b = {} end + local x = gcinfo() + local i = 0 + repeat -- do steps until it completes a collection cycle + i = i+1 + until collectgarbage("step", siz) + assert(gcinfo() < x) + return i -- number of steps + end + + + if not _port then + collectgarbage"stop" + assert(dosteps(10) < dosteps(2)) + collectgarbage"restart" + end + +end + + _G["while"] = 234 @@ -174,45 +201,6 @@ do end --- --- test the "size" of basic GC steps (whatever they mean...) --- -do -print("steps") - - print("steps (2)") - - local function dosteps (siz) - collectgarbage() - local a = {} - for i=1,100 do a[i] = {{}}; local b = {} end - local x = gcinfo() - local i = 0 - repeat -- do steps until it completes a collection cycle - i = i+1 - until collectgarbage("step", siz) - assert(gcinfo() < x) - return i -- number of steps - end - - collectgarbage"stop" - - if not _port then - assert(dosteps(10) < dosteps(2)) - end - - -- collector should do a full collection with so many steps - assert(dosteps(20000) == 1) - assert(collectgarbage("step", 20000) == true) - assert(collectgarbage("step", 20000) == true) - - assert(not collectgarbage("isrunning")) - collectgarbage"restart" - assert(collectgarbage("isrunning")) - -end - - if not _port then -- test the pace of the collector collectgarbage(); collectgarbage() @@ -300,6 +288,21 @@ x,y,z=nil collectgarbage() assert(next(a) == string.rep('$', 11)) +do -- invalid mode + local a = setmetatable({}, {__mode = 34}) + collectgarbage() +end + + +if T then -- bug since 5.3: all-weak tables are not being revisited + T.gcstate("propagate") + local t = setmetatable({}, {__mode = "kv"}) + T.gcstate("enteratomic") -- 't' was visited + setmetatable(t, {__mode = "kv"}) + T.gcstate("pause") -- its new metatable is not being visited + assert(getmetatable(t).__mode == "kv") +end + -- 'bug' in 5.1 a = {} @@ -458,12 +461,9 @@ do -- tests for string keys in weak tables local m = collectgarbage("count") -- current memory local a = setmetatable({}, {__mode = "kv"}) a[string.rep("a", 2^22)] = 25 -- long string key -> number value - a[string.rep("b", 2^22)] = {} -- long string key -> colectable value - a[{}] = 14 -- colectable key - assert(collectgarbage("count") > m + 2^13) -- 2^13 == 2 * 2^22 in KB + a[string.rep("b", 2^22)] = {} -- long string key -> collectable value + a[{}] = 14 -- collectable key collectgarbage() - assert(collectgarbage("count") >= m + 2^12 and - collectgarbage("count") < m + 2^13) -- one key was collected local k, v = next(a) -- string key with number value preserved assert(k == string.rep("a", 2^22) and v == 25) assert(next(a, k) == nil) -- everything else cleared @@ -474,7 +474,7 @@ do -- tests for string keys in weak tables assert(next(a) == nil) -- make sure will not try to compare with dead key assert(a[string.rep("b", 100)] == undef) - assert(collectgarbage("count") <= m + 1) -- eveything collected + assert(collectgarbage("count") <= m + 1) -- everything collected end @@ -539,7 +539,7 @@ do local co = coroutine.create(f) assert(coroutine.resume(co, co)) end - -- Now, thread and closure are not reacheable any more. + -- Now, thread and closure are not reachable any more. collectgarbage() assert(collected) collectgarbage("restart") @@ -549,7 +549,7 @@ end do collectgarbage() collectgarbage"stop" - collectgarbage("step", 0) -- steps should not unblock the collector + collectgarbage("step") -- steps should not unblock the collector local x = gcinfo() repeat for i=1,1000 do _ENV.a = {} end -- no collection during the loop @@ -575,8 +575,8 @@ if T then -- tests for weird cases collecting upvalues -- create coroutine in a weak table, so it will never be marked t.co = coroutine.wrap(foo) local f = t.co() -- create function to access local 'a' - T.gcstate("atomic") -- ensure all objects are traversed - assert(T.gcstate() == "atomic") + T.gcstate("enteratomic") -- ensure all objects are traversed + assert(T.gcstate() == "enteratomic") assert(t.co() == 100) -- resume coroutine, creating new table for 'a' assert(T.gccolor(t.co) == "white") -- thread was not traversed T.gcstate("pause") -- collect thread, but should mark 'a' before that @@ -589,7 +589,7 @@ if T then -- tests for weird cases collecting upvalues collectgarbage() collectgarbage"stop" local a = {} -- avoid 'u' as first element in 'allgc' - T.gcstate"atomic" + T.gcstate"enteratomic" T.gcstate"sweepallgc" local x = {} assert(T.gccolor(u) == "black") -- userdata is "old" (black) @@ -615,6 +615,21 @@ if T then end +if T then + collectgarbage("stop") + T.gcstate("pause") + local sup = {x = 0} + local a = setmetatable({}, {__newindex = sup}) + T.gcstate("enteratomic") + assert(T.gccolor(sup) == "black") + a.x = {} -- should not break the invariant + assert(not (T.gccolor(sup) == "black" and T.gccolor(sup.x) == "white")) + T.gcstate("pause") -- complete the GC cycle + sup.x.y = 10 + collectgarbage("restart") +end + + if T then print("emergency collections") collectgarbage() @@ -644,7 +659,7 @@ do assert(getmetatable(o) == tt) -- create new objects during GC local a = 'xuxu'..(10+3)..'joao', {} - ___Glob = o -- ressurrect object! + ___Glob = o -- resurrect object! setmetatable({}, tt) -- creates a new one with same metatable print(">>> closing state " .. "<<<\n") end diff --git a/testes/gengc.lua b/testes/gengc.lua index 3d4f67f8bc..6509e39d8a 100644 --- a/testes/gengc.lua +++ b/testes/gengc.lua @@ -1,5 +1,5 @@ -- $Id: testes/gengc.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print('testing generational garbage collection') @@ -24,12 +24,12 @@ do assert(not T or (T.gcage(U) == "touched1" and T.gcage(U[1]) == "new")) -- both U and the table survive one more collection - collectgarbage("step", 0) + collectgarbage("step") assert(not T or (T.gcage(U) == "touched2" and T.gcage(U[1]) == "survival")) -- both U and the table survive yet another collection -- now everything is old - collectgarbage("step", 0) + collectgarbage("step") assert(not T or (T.gcage(U) == "old" and T.gcage(U[1]) == "old1")) -- data was not corrupted @@ -46,10 +46,10 @@ do assert(not T or T.gcage(old) == "old") setmetatable(old, {}) -- new table becomes OLD0 (barrier) assert(not T or T.gcage(getmetatable(old)) == "old0") - collectgarbage("step", 0) -- new table becomes OLD1 and firstold1 + collectgarbage("step") -- new table becomes OLD1 and firstold1 assert(not T or T.gcage(getmetatable(old)) == "old1") setmetatable(getmetatable(old), {__gc = foo}) -- get it out of allgc list - collectgarbage("step", 0) -- should not seg. fault + collectgarbage("step") -- should not seg. fault end @@ -65,18 +65,18 @@ do -- bug in 5.4.0 A[1] = obj -- anchor object assert(not T or T.gcage(obj) == "old1") obj = nil -- remove it from the stack - collectgarbage("step", 0) -- do a young collection + collectgarbage("step") -- do a young collection print(getmetatable(A[1]).x) -- metatable was collected end collectgarbage() -- make A old local obj = {} -- create a new object - collectgarbage("step", 0) -- make it a survival + collectgarbage("step") -- make it a survival assert(not T or T.gcage(obj) == "survival") setmetatable(obj, {__gc = gcf, x = "+"}) -- create its metatable assert(not T or T.gcage(getmetatable(obj)) == "new") obj = nil -- clear object - collectgarbage("step", 0) -- will call obj's finalizer + collectgarbage("step") -- will call obj's finalizer end @@ -94,13 +94,13 @@ do -- another bug in 5.4.0 end ) local _, f = coroutine.resume(co) -- create closure over 'x' in coroutine - collectgarbage("step", 0) -- make upvalue a survival + collectgarbage("step") -- make upvalue a survival old[1] = {"hello"} -- 'old' go to grayagain as 'touched1' coroutine.resume(co, {123}) -- its value will be new co = nil - collectgarbage("step", 0) -- hit the barrier + collectgarbage("step") -- hit the barrier assert(f() == 123 and old[1][1] == "hello") - collectgarbage("step", 0) -- run the collector once more + collectgarbage("step") -- run the collector once more -- make sure old[1] was not collected assert(f() == 123 and old[1][1] == "hello") end @@ -112,12 +112,12 @@ do -- bug introduced in commit 9cf3299fa assert(not T or T.gcage(t) == "old") t[1] = {10} assert(not T or (T.gcage(t) == "touched1" and T.gccolor(t) == "gray")) - collectgarbage("step", 0) -- minor collection + collectgarbage("step") -- minor collection assert(not T or (T.gcage(t) == "touched2" and T.gccolor(t) == "black")) - collectgarbage("step", 0) -- minor collection + collectgarbage("step") -- minor collection assert(not T or T.gcage(t) == "old") -- t should be black, but it was gray t[1] = {10} -- no barrier here, so t was still old - collectgarbage("step", 0) -- minor collection + collectgarbage("step") -- minor collection -- t, being old, is ignored by the collection, so it is not cleared assert(t[1] == nil) -- fails with the bug end @@ -144,13 +144,13 @@ do T.gcage(debug.getuservalue(U)) == "new") -- both U and the table survive one more collection - collectgarbage("step", 0) + collectgarbage("step") assert(T.gcage(U) == "touched2" and T.gcage(debug.getuservalue(U)) == "survival") -- both U and the table survive yet another collection -- now everything is old - collectgarbage("step", 0) + collectgarbage("step") assert(T.gcage(U) == "old" and T.gcage(debug.getuservalue(U)) == "old1") @@ -162,9 +162,33 @@ end assert(collectgarbage'isrunning') +do print"testing stop-the-world collection" + local step = collectgarbage("param", "stepsize", 0); + collectgarbage("incremental") + assert(collectgarbage("param", "stepsize") == 0) --- just to make sure -assert(collectgarbage'isrunning') + -- each step does a complete cycle + assert(collectgarbage("step")) + assert(collectgarbage("step")) + + -- back to default value + collectgarbage("param", "stepsize", step); + assert(collectgarbage("param", "stepsize") == step) +end + + +if T then -- test GC parameter codification + for _, percentage in ipairs{5, 10, 12, 20, 50, 100, 200, 500} do + local param = T.codeparam(percentage) -- codify percentage + for _, value in ipairs{1, 2, 10, 100, 257, 1023, 6500, 100000} do + local exact = value*percentage // 100 + local aprox = T.applyparam(param, value) -- apply percentage + -- difference is at most 10% (+1 compensates difference due to + -- rounding to integers) + assert(math.abs(aprox - exact) <= exact/10 + 1) + end + end +end collectgarbage(oldmode) diff --git a/testes/goto.lua b/testes/goto.lua index 4ac6d7d089..906208b553 100644 --- a/testes/goto.lua +++ b/testes/goto.lua @@ -1,5 +1,11 @@ -- $Id: testes/goto.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global require +global print, load, assert, string, setmetatable +global collectgarbage, error + +print("testing goto and global declarations") collectgarbage() @@ -17,15 +23,18 @@ errmsg([[ ::l1:: ::l1:: ]], "label 'l1'") errmsg([[ ::l1:: do ::l1:: end]], "label 'l1'") --- undefined label -errmsg([[ goto l1; local aa ::l1:: ::l2:: print(3) ]], "local 'aa'") --- jumping over variable definition +-- jumping over variable declaration +errmsg([[ goto l1; local aa ::l1:: ::l2:: print(3) ]], "scope of 'aa'") + +errmsg([[ goto l2; global *; ::l1:: ::l2:: print(3) ]], "scope of '*'") + errmsg([[ do local bb, cc; goto l1; end local aa ::l1:: print(3) -]], "local 'aa'") +]], "scope of 'aa'") + -- jumping into a block errmsg([[ do ::l1:: end goto l1 ]], "label 'l1'") @@ -38,7 +47,7 @@ errmsg([[ local xuxu = 10 ::cont:: until xuxu < x -]], "local 'xuxu'") +]], "scope of 'xuxu'") -- simple gotos local x @@ -250,22 +259,219 @@ assert(testG(3) == "3") assert(testG(4) == 5) assert(testG(5) == 10) -do - -- if x back goto out of scope of upvalue - local X +do -- test goto's around to-be-closed variable + + global * + + -- set 'var' and return an object that will reset 'var' when + -- it goes out of scope + local function newobj (var) + _ENV[var] = true + return setmetatable({}, {__close = function () + _ENV[var] = nil + end}) + end + goto L1 - ::L2:: goto L3 + ::L4:: assert(not varX); goto L5 -- varX dead here + + ::L1:: + local varX = newobj("X") + assert(varX); goto L2 -- varX alive here + + ::L3:: + assert(varX); goto L4 -- varX alive here + + ::L2:: assert(varX); goto L3 -- varX alive here + + ::L5:: -- return +end + + + +foo() +-------------------------------------------------------------------------- + +-- check for compilation errors +local function checkerr (code, err) + local st, msg = load(code) + assert(not st and string.find(msg, err)) +end + +do + global T + + -- globals must be declared, after a global declaration + checkerr("global none; X = 1", "variable 'X'") + checkerr("global none; function XX() end", "variable 'XX'") + + -- global variables cannot be to-be-closed + checkerr("global X", "cannot be") + checkerr("global *", "cannot be") + + do + local X = 10 + do global X; X = 20 end + assert(X == 10) -- local X + end + assert(_ENV.X == 20) -- global X + + -- '_ENV' cannot be global + checkerr("global _ENV, a; a = 10", "variable 'a'") + + -- global declarations inside functions + checkerr([[ + global none + local function foo () XXX = 1 end --< ERROR]], "variable 'XXX'") + + if not T then -- when not in "test mode", "global" isn't reserved + assert(load("global = 1; return global")() == 1) + print " ('global' is not a reserved word)" + else + -- "global" reserved, cannot be used as a variable + assert(not load("global = 1; return global")) + end + + local foo = 20 + do + global function foo (x) + if x == 0 then return 1 else return 2 * foo(x - 1) end + end + assert(foo == _ENV.foo and foo(4) == 16) + end + assert(_ENV.foo(4) == 16) + assert(foo == 20) -- local one is in context here - ::L1:: do - local a = setmetatable({}, {__close = function () X = true end}) - assert(X == nil) - if a then goto L2 end -- jumping back out of scope of 'a' + do + global foo; + function foo (x) return end -- Ok after declaration end - ::L3:: assert(X == true) -- checks that 'a' was correctly closed + checkerr([[ + global foo; + function foo (x) return end -- ERROR: foo is read-only + ]], "assign to const variable 'foo'") + + checkerr([[ + global foo ; + function foo (x) -- ERROR: foo is read-only + return + end + ]], "%:2%:") -- correct line in error message + + checkerr([[ + global *; + print(X) -- Ok to use + Y = 1 -- ERROR + ]], "assign to const variable 'Y'") + + checkerr([[ + global *; + Y = X -- Ok to use + global *; + Y = 1 -- ERROR + ]], "assign to const variable 'Y'") + + global * + Y = 10 + assert(_ENV.Y == 10) + global * + local x = Y + global * + Y = x + Y + assert(_ENV.Y == 20) + Y = nil end --------------------------------------------------------------------------------- +do -- Ok to declare hundreds of globals + global table + local code = {} + for i = 1, 1000 do + code[#code + 1] = ";global x" .. i + end + code[#code + 1] = "; return x990" + code = table.concat(code) + _ENV.x990 = 11 + assert(load(code)() == 11) + _ENV.x990 = nil +end + +do -- mixing lots of global/local declarations + global table + local code = {} + for i = 1, 200 do + code[#code + 1] = ";global x" .. i + code[#code + 1] = ";local y" .. i .. "=" .. (2*i) + end + code[#code + 1] = "; return x200 + y200" + code = table.concat(code) + _ENV.x200 = 11 + assert(assert(load(code))() == 2*200 + 11) + _ENV.x200 = nil +end + +do print "testing initialization in global declarations" + global a, b, c = 10, 20, 30 + assert(_ENV.a == 10 and b == 20 and c == 30) + _ENV.a = nil; _ENV.b = nil; _ENV.c = nil; + + global a, b, c = 10 + assert(_ENV.a == 10 and b == nil and c == nil) + _ENV.a = nil; _ENV.b = nil; _ENV.c = nil; + + global table + global a, b, c, d = table.unpack{1, 2, 3, 6, 5} + assert(_ENV.a == 1 and b == 2 and c == 3 and d == 6) + a = nil; b = nil; c = nil; d = nil + + local a, b = 100, 200 + do + global a, b = a, b + end + assert(_ENV.a == 100 and _ENV.b == 200) + _ENV.a = nil; _ENV.b = nil + + + assert(_ENV.a == nil and _ENV.b == nil and _ENV.c == nil and _ENV.d == nil) +end + +do + global table, string + -- global initialization when names don't fit in K + + -- to fill constant table + local code = {} + for i = 1, 300 do code[i] = "'" .. i .. "'" end + code = table.concat(code, ",") + code = string.format([[ + return function (_ENV) + local dummy = {%s} -- fill initial positions in constant table, + -- so that initialization must use registers for global names + global a, b, c = 10, 20, 30 + end]], code) + + local fun = assert(load(code))() + + local env = {} + fun(env) + assert(env.a == 10 and env.b == 20 and env.c == 30) +end + + +do -- testing global redefinitions + -- cannot use 'checkerr' as errors are not compile time + global pcall + local f = assert(load("global print = 10")) + local st, msg = pcall(f) + assert(string.find(msg, "global 'print' already defined")) + + local f = assert(load("local _ENV = {AA = false}; global AA = 10")) + local st, msg = pcall(f) + assert(string.find(msg, "global 'AA' already defined")) + +end + print'OK' + diff --git a/testes/heavy.lua b/testes/heavy.lua index 4731c7472f..3b4e4ce352 100644 --- a/testes/heavy.lua +++ b/testes/heavy.lua @@ -1,5 +1,5 @@ --- $Id: heavy.lua,v 1.7 2017/12/29 15:42:15 roberto Exp $ --- See Copyright Notice in file all.lua +-- $Id: testes/heavy.lua,v $ +-- See Copyright Notice in file lua.h local function teststring () print("creating a string too long") diff --git a/testes/libs/lib11.c b/testes/libs/lib11.c index 377d0c484f..6a85f4d621 100644 --- a/testes/libs/lib11.c +++ b/testes/libs/lib11.c @@ -1,7 +1,7 @@ #include "lua.h" /* function from lib1.c */ -int lib1_export (lua_State *L); +LUAMOD_API int lib1_export (lua_State *L); LUAMOD_API int luaopen_lib11 (lua_State *L) { return lib1_export(L); diff --git a/testes/libs/lib22.c b/testes/libs/lib22.c index 8e6565022e..b377cce520 100644 --- a/testes/libs/lib22.c +++ b/testes/libs/lib22.c @@ -1,3 +1,7 @@ +/* implementation for lib2-v2 */ + +#include + #include "lua.h" #include "lauxlib.h" @@ -8,8 +12,54 @@ static int id (lua_State *L) { } +struct STR { + void *ud; + lua_Alloc allocf; +}; + + +static void *t_freestr (void *ud, void *ptr, size_t osize, size_t nsize) { + struct STR *blk = (struct STR*)ptr - 1; + blk->allocf(blk->ud, blk, sizeof(struct STR) + osize, 0); + return NULL; +} + + +static int newstr (lua_State *L) { + size_t len; + const char *str = luaL_checklstring(L, 1, &len); + void *ud; + lua_Alloc allocf = lua_getallocf(L, &ud); + struct STR *blk = (struct STR*)allocf(ud, NULL, 0, + len + 1 + sizeof(struct STR)); + if (blk == NULL) { /* allocation error? */ + lua_pushliteral(L, "not enough memory"); + lua_error(L); /* raise a memory error */ + } + blk->ud = ud; blk->allocf = allocf; + memcpy(blk + 1, str, len + 1); + lua_pushexternalstring(L, (char *)(blk + 1), len, t_freestr, L); + return 1; +} + + +/* +** Create an external string and keep it in the registry, so that it +** will test that the library code is still available (to deallocate +** this string) when closing the state. +*/ +static void initstr (lua_State *L) { + lua_pushcfunction(L, newstr); + lua_pushstring(L, + "012345678901234567890123456789012345678901234567890123456789"); + lua_call(L, 1, 1); /* call newstr("0123...") */ + luaL_ref(L, LUA_REGISTRYINDEX); /* keep string in the registry */ +} + + static const struct luaL_Reg funcs[] = { {"id", id}, + {"newstr", newstr}, {NULL, NULL} }; @@ -18,6 +68,7 @@ LUAMOD_API int luaopen_lib2 (lua_State *L) { lua_settop(L, 2); lua_setglobal(L, "y"); /* y gets 2nd parameter */ lua_setglobal(L, "x"); /* x gets 1st parameter */ + initstr(L); luaL_newlib(L, funcs); return 1; } diff --git a/testes/libs/makefile b/testes/libs/makefile index 9c0c4e3f7f..cf4c688152 100644 --- a/testes/libs/makefile +++ b/testes/libs/makefile @@ -5,7 +5,7 @@ LUA_DIR = ../../ CC = gcc # compilation should generate Dynamic-Link Libraries -CFLAGS = -Wall -std=gnu99 -O2 -I$(LUA_DIR) -fPIC -shared +CFLAGS = -Wall -O2 -I$(LUA_DIR) -fPIC -shared # libraries used by the tests all: lib1.so lib11.so lib2.so lib21.so lib2-v2.so diff --git a/testes/literals.lua b/testes/literals.lua index 30ab9ab115..336ef585c5 100644 --- a/testes/literals.lua +++ b/testes/literals.lua @@ -1,8 +1,10 @@ -- $Id: testes/literals.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print('testing scanner') +global * + local debug = require "debug" diff --git a/testes/locals.lua b/testes/locals.lua index 2c48546d5d..6cd1054764 100644 --- a/testes/locals.lua +++ b/testes/locals.lua @@ -1,5 +1,7 @@ -- $Id: testes/locals.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * print('testing local variables and environments') @@ -39,9 +41,11 @@ f = nil local f local x = 1 -a = nil -load('local a = {}')() -assert(a == nil) +do + global a; a = nil + load('local a = {}')() + assert(a == nil) +end function f (a) local _1, _2, _3, _4, _5 @@ -154,7 +158,7 @@ local _ENV = (function (...) return ... end)(_G, dummy) -- { do local _ENV = {assert=assert}; assert(true) end local mt = {_G = _G} local foo,x -A = false -- "declare" A +global A; A = false -- "declare" A do local _ENV = mt function foo (x) A = x @@ -177,20 +181,27 @@ assert(x==20) A = nil -do -- constants +do print("testing local constants") + global assert, load, string, X + X = 1 -- not a constant local a, b, c = 10, 20, 30 b = a + c + b -- 'b' is not constant assert(a == 10 and b == 60 and c == 30) + local function checkro (name, code) local st, msg = load(code) local gab = string.format("attempt to assign to const variable '%s'", name) assert(not st and string.find(msg, gab)) end + checkro("y", "local x, y , z = 10, 20, 30; x = 11; y = 12") checkro("x", "local x , y, z = 10, 20, 30; x = 11") checkro("z", "local x , y, z = 10, 20, 30; y = 10; z = 11") - checkro("foo", "local foo = 10; function foo() end") - checkro("foo", "local foo = {}; function foo() end") + checkro("foo", "local foo = 10; function foo() end") + checkro("foo", "local foo = {}; function foo() end") + checkro("foo", "global foo ; function foo() end") + checkro("XX", "global XX ; XX = 10") + checkro("XX", "local _ENV; global XX ; XX = 10") checkro("z", [[ local a, z , b = 10; @@ -201,11 +212,26 @@ do -- constants local a, var1 = 10; function foo() a = 20; z = function () var1 = 12; end end ]]) + + checkro("var1", [[ + global a, var1 , z; + local function foo() a = 20; z = function () var1 = 12; end end + ]]) end + print"testing to-be-closed variables" + +do + local st, msg = load("local a, b") + assert(not st and string.find(msg, "multiple")) + + local st, msg = load("local a, b") + assert(not st and string.find(msg, "multiple")) +end + local function stack(n) n = ((n == 0) or stack(n - 1)) end local function func2close (f, x, y) @@ -280,6 +306,31 @@ do end +do -- testing presence of second argument + local function foo (howtoclose, obj, n) + local ca -- copy of 'a' visible inside its close metamethod + do + local a = func2close(function (...t) + assert(select("#", ...) == n) + assert(t.n == n and t[1] == ca and (t.n < 2 or t[2] == obj)) + ca = 15 -- final value to be returned if howtoclose=="scope" + end) + ca = a + if howtoclose == "ret" then return obj -- 'a' closed by return + elseif howtoclose == "err" then error(obj) -- 'a' closed by error + end + end -- 'a' closed by end of scope + return ca -- ca now should be 15 + end + -- with no errors, closing methods receive no extra argument + assert(foo("scope", nil, 1) == 15) -- close by end of scope + assert(foo("ret", 32, 1) == 32) -- close by return + -- with errors, they do + local st, msg = pcall(foo, "err", 23, 2) -- close by error + assert(not st and msg == 23) +end + + -- testing to-be-closed x compile-time constants -- (there were some bugs here in Lua 5.4-rc3, due to a confusion -- between compile levels and stack levels of variables) @@ -728,14 +779,8 @@ if rawget(_G, "T") then -- first buffer was released by 'toclose' assert(T.totalmem() - m <= extra) - -- error in creation of final string - T.totalmem(m + 2 * lim + extra) - assert(not pcall(table.concat, a)) - -- second buffer was released by 'toclose' - assert(T.totalmem() - m <= extra) - - -- userdata, buffer, buffer, final string - T.totalmem(m + 4*lim + extra) + -- userdata, buffer, final string + T.totalmem(m + 2*lim + extra) assert(#table.concat(a) == 2*lim) T.totalmem(0) -- remove memory limit @@ -865,14 +910,15 @@ do local extrares -- result from extra yield (if any) - local function check (body, extra, ...) - local t = table.pack(...) -- expected returns + local function check (body, extra, ...t) local co = coroutine.wrap(body) if extra then extrares = co() -- runs until first (extra) yield end - local res = table.pack(co()) -- runs until yield inside '__close' - assert(res.n == 2 and res[2] == nil) + local res = table.pack(co()) -- runs until "regular" yield + -- regular yield will yield all values passed to the close function; + -- without errors, that is only the object being closed. + assert(res.n == 1 and type(res[1]) == "table") local res2 = table.pack(co()) -- runs until end of function assert(res2.n == t.n) for i = 1, #t do @@ -885,10 +931,10 @@ do end local function foo () - local x = func2close(coroutine.yield) + local x = func2close(coroutine.yield) -- "regular" yield local extra = func2close(function (self) assert(self == extrares) - coroutine.yield(100) + coroutine.yield(100) -- first (extra) yield end) extrares = extra return table.unpack{10, x, 30} @@ -897,21 +943,21 @@ do assert(extrares == 100) local function foo () - local x = func2close(coroutine.yield) + local x = func2close(coroutine.yield) -- "regular" yield return end check(foo, false) local function foo () - local x = func2close(coroutine.yield) + local x = func2close(coroutine.yield) -- "regular" yield local y, z = 20, 30 return x end check(foo, false, "x") local function foo () - local x = func2close(coroutine.yield) - local extra = func2close(coroutine.yield) + local x = func2close(coroutine.yield) -- "regular" yield + local extra = func2close(coroutine.yield) -- extra yield return table.unpack({}, 1, 100) -- 100 nils end check(foo, true, table.unpack({}, 1, 100)) @@ -1140,7 +1186,7 @@ do local function open (x) numopen = numopen + 1 return - function () -- iteraction function + function () -- iteration function x = x - 1 if x > 0 then return x end end, diff --git a/testes/main.lua b/testes/main.lua index f59badcf88..dc48dc485f 100644 --- a/testes/main.lua +++ b/testes/main.lua @@ -1,6 +1,6 @@ # testing special comment on first line -- $Id: testes/main.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h -- most (all?) tests here assume a reasonable "Unix-like" shell if _port then return end @@ -27,17 +27,19 @@ do end print("progname: "..progname) -local prepfile = function (s, p) - p = p or prog - io.output(p) - io.write(s) - assert(io.close()) + +local prepfile = function (s, mod, p) + mod = mod and "wb" or "w" -- mod true means binary files + p = p or prog -- file to write the program + local f = io.open(p, mod) + f:write(s) + assert(f:close()) end local function getoutput () - io.input(out) - local t = io.read("a") - io.input():close() + local f = io.open(out) + local t = f:read("a") + f:close() assert(os.remove(out)) return t end @@ -65,10 +67,11 @@ local function RUN (p, ...) assert(os.execute(s)) end + local function NoRun (msg, p, ...) p = string.gsub(p, "lua", '"'..progname..'"', 1) local s = string.format(p, ...) - s = string.format("%s 2> %s", s, out) -- will send error to 'out' + s = string.format("%s >%s 2>&1", s, out) -- send output and error to 'out' assert(not os.execute(s)) assert(string.find(getoutput(), msg, 1, true)) -- check error message end @@ -87,7 +90,7 @@ prepfile[[ 1, a ) ]] -RUN('lua - < %s > %s', prog, out) +RUN('lua - -- < %s > %s', prog, out) checkout("1\tnil\n") RUN('echo "print(10)\nprint(2)\n" | lua > %s', out) @@ -108,17 +111,17 @@ RUN('lua %s > %s', prog, out) checkout("3\n") -- bad BOMs -prepfile("\xEF") -NoRun("unexpected symbol", 'lua %s > %s', prog, out) +prepfile("\xEF", true) +NoRun("unexpected symbol", 'lua %s', prog) -prepfile("\xEF\xBB") -NoRun("unexpected symbol", 'lua %s > %s', prog, out) +prepfile("\xEF\xBB", true) +NoRun("unexpected symbol", 'lua %s', prog) -prepfile("\xEFprint(3)") -NoRun("unexpected symbol", 'lua %s > %s', prog, out) +prepfile("\xEFprint(3)", true) +NoRun("unexpected symbol", 'lua %s', prog) -prepfile("\xEF\xBBprint(3)") -NoRun("unexpected symbol", 'lua %s > %s', prog, out) +prepfile("\xEF\xBBprint(3)", true) +NoRun("unexpected symbol", 'lua %s', prog) -- test option '-' @@ -130,11 +133,11 @@ checkout("-h\n") prepfile("print(package.path)") -- test LUA_PATH -RUN('env LUA_INIT= LUA_PATH=x lua %s > %s', prog, out) +RUN('env LUA_INIT= LUA_PATH=x lua -- %s > %s', prog, out) checkout("x\n") -- test LUA_PATH_version -RUN('env LUA_INIT= LUA_PATH_5_4=y LUA_PATH=x lua %s > %s', prog, out) +RUN('env LUA_INIT= LUA_PATH_5_5=y LUA_PATH=x lua %s > %s', prog, out) checkout("y\n") -- test LUA_CPATH @@ -143,7 +146,7 @@ RUN('env LUA_INIT= LUA_CPATH=xuxu lua %s > %s', prog, out) checkout("xuxu\n") -- test LUA_CPATH_version -RUN('env LUA_INIT= LUA_CPATH_5_4=yacc LUA_CPATH=x lua %s > %s', prog, out) +RUN('env LUA_INIT= LUA_CPATH_5_5=yacc LUA_CPATH=x lua %s > %s', prog, out) checkout("yacc\n") -- test LUA_INIT (and its access to 'arg' table) @@ -153,7 +156,7 @@ checkout("3.2\n") -- test LUA_INIT_version prepfile("print(X)") -RUN('env LUA_INIT_5_4="X=10" LUA_INIT="X=3" lua %s > %s', prog, out) +RUN('env LUA_INIT_5_5="X=10" LUA_INIT="X=3" lua %s > %s', prog, out) checkout("10\n") -- test LUA_INIT for files @@ -213,7 +216,7 @@ convert("a;b;;c") -- test -l over multiple libraries prepfile("print(1); a=2; return {x=15}") -prepfile(("print(a); print(_G['%s'].x)"):format(prog), otherprog) +prepfile(("print(a); print(_G['%s'].x)"):format(prog), false, otherprog) RUN('env LUA_PATH="?;;" lua -l %s -l%s -lstring -l io %s > %s', prog, otherprog, otherprog, out) checkout("1\n2\n15\n2\n15\n") @@ -222,6 +225,13 @@ prepfile("print(str.upper'alo alo', m.max(10, 20))") RUN("lua -l 'str=string' '-lm=math' -e 'print(m.sin(0))' %s > %s", prog, out) checkout("0.0\nALO ALO\t20\n") + +-- test module names with version suffix ("libs/lib2-v2") +RUN("env LUA_CPATH='./libs/?.so' lua -l lib2-v2 -e 'print(lib2.id())' > %s", + out) +checkout("true\n") + + -- test 'arg' table local a = [[ assert(#arg == 3 and arg[1] == 'a' and @@ -237,7 +247,7 @@ RUN('lua "-e " -- %s a b c', prog) -- "-e " runs an empty command -- test 'arg' availability in libraries prepfile"assert(arg)" -prepfile("assert(arg)", otherprog) +prepfile("assert(arg)", false, otherprog) RUN('env LUA_PATH="?;;" lua -l%s - < %s', prog, otherprog) -- test messing up the 'arg' table @@ -253,6 +263,15 @@ assert(string.find(getoutput(), "error calling 'print'")) RUN('echo "io.stderr:write(1000)\ncont" | lua -e "require\'debug\'.debug()" 2> %s', out) checkout("lua_debug> 1000lua_debug> ") +do -- test warning for locals + RUN('echo " local x" | lua -i > %s 2>&1', out) + assert(string.find(getoutput(), "warning: ")) + + RUN('echo "local1 = 10\nlocal1 + 3" | lua -i > %s 2>&1', out) + local t = getoutput() + assert(not string.find(t, "warning")) + assert(string.find(t, "13")) +end print("testing warnings") @@ -291,8 +310,11 @@ checkprogout("ZYX)\nXYZ)\n") -- bug since 5.2: finalizer called when closing a state could -- subvert finalization order prepfile[[ --- should be called last +-- ensure tables will be collected only at the end of the program +collectgarbage"stop" + print("creating 1") +-- this finalizer should be called last setmetatable({}, {__gc = function () print(1) end}) print("creating 2") @@ -302,7 +324,7 @@ setmetatable({}, {__gc = function () -- this finalizer should not be called, as object will be -- created after 'lua_close' has been called setmetatable({}, {__gc = function () print(3) end}) - print(collectgarbage()) -- cannot call collector here + print(collectgarbage() or false) -- cannot call collector here os.exit(0, true) end}) ]] @@ -312,7 +334,7 @@ creating 1 creating 2 2 creating 3 -nil +false 1 ]] @@ -325,7 +347,7 @@ checkout("a\n") RUN([[lua "-eprint(1)" -ea=3 -e "print(a)" > %s]], out) checkout("1\n3\n") --- test iteractive mode +-- test interactive mode prepfile[[ (6*2-6) -- === a = @@ -335,10 +357,15 @@ a]] RUN([[lua -e"_PROMPT='' _PROMPT2=''" -i < %s > %s]], prog, out) checkprogout("6\n10\n10\n\n") -prepfile("a = [[b\nc\nd\ne]]\n=a") -RUN([[lua -e"_PROMPT='' _PROMPT2=''" -i < %s > %s]], prog, out) +prepfile("a = [[b\nc\nd\ne]]\na") +RUN([[lua -e"_PROMPT='' _PROMPT2=''" -i -- < %s > %s]], prog, out) checkprogout("b\nc\nd\ne\n\n") +-- input interrupted in continuation line +prepfile("a.\n") +RUN([[lua -i < %s > /dev/null 2> %s]], prog, out) +checkprogout("near \n") + local prompt = "alo" prepfile[[ -- a = 2 @@ -358,20 +385,18 @@ assert(string.find(t, prompt .. ".*" .. prompt .. ".*" .. prompt)) -- non-string prompt -prompt = - "local C = 0;\z - _PROMPT=setmetatable({},{__tostring = function () \z - C = C + 1; return C end})" +prompt = [[ + local C = 'X'; + _PROMPT=setmetatable({},{__tostring = function () + C = C .. 'X'; return C end}) +]] prepfile[[ -- a = 2 ]] RUN([[lua -e "%s" -i < %s > %s]], prompt, prog, out) local t = getoutput() -assert(string.find(t, [[ -1 -- -2a = 2 -3 -]], 1, true)) +-- skip version line and then check the presence of the three prompts +assert(string.find(t, "^.-\nXX[^\nX]*\n?XXX[^\nX]*\n?XXXX\n?$")) -- test for error objects @@ -413,7 +438,7 @@ prepfile[[#comment in 1st line without \n at the end]] RUN('lua %s', prog) -- first-line comment with binary file -prepfile("#comment\n" .. string.dump(load("print(3)"))) +prepfile("#comment\n" .. string.dump(load("print(3)")), true) RUN('lua %s > %s', prog, out) checkout('3\n') @@ -463,12 +488,13 @@ assert(not os.remove(out)) -- invalid options NoRun("unrecognized option '-h'", "lua -h") NoRun("unrecognized option '---'", "lua ---") -NoRun("unrecognized option '-Ex'", "lua -Ex") +NoRun("unrecognized option '-Ex'", "lua -Ex --") NoRun("unrecognized option '-vv'", "lua -vv") NoRun("unrecognized option '-iv'", "lua -iv") NoRun("'-e' needs argument", "lua -e") NoRun("syntax error", "lua -e a") NoRun("'-l' needs argument", "lua -l") +NoRun("-i", "lua -- -i") -- handles -i as a script name if T then -- test library? diff --git a/testes/math.lua b/testes/math.lua index 0191f7ddad..54d19c4075 100644 --- a/testes/math.lua +++ b/testes/math.lua @@ -1,10 +1,17 @@ -- $Id: testes/math.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print("testing numbers and math lib") -local minint = math.mininteger -local maxint = math.maxinteger +local math = require "math" +local string = require "string" + +global none + +global print, assert, pcall, type, pairs, load +global tonumber, tostring, select + +local minint, maxint = math.mininteger, math.maxinteger local intbits = math.floor(math.log(maxint, 2) + 0.5) + 1 assert((1 << intbits) == 0) @@ -22,6 +29,18 @@ do end end + +-- maximum exponent for a floating-point number +local maxexp = 0 +do + local p = 2.0 + while p < math.huge do + maxexp = maxexp + 1 + p = p + p + end +end + + local function isNaN (x) return (x ~= x) end @@ -34,8 +53,8 @@ do local x = 2.0^floatbits assert(x > x - 1.0 and x == x + 1.0) - print(string.format("%d-bit integers, %d-bit (mantissa) floats", - intbits, floatbits)) + local msg = " %d-bit integers, %d-bit*2^%d floats" + print(string.format(msg, intbits, floatbits, maxexp)) end assert(math.type(0) == "integer" and math.type(0.0) == "float" @@ -172,7 +191,7 @@ do for i = -3, 3 do -- variables avoid constant folding for j = -3, 3 do -- domain errors (0^(-n)) are not portable - if not _port or i ~= 0 or j > 0 then + if not _ENV._port or i ~= 0 or j > 0 then assert(eq(i^j, 1 / i^(-j))) end end @@ -418,7 +437,7 @@ for i = 2,36 do assert(tonumber('\t10000000000\t', i) == i10) end -if not _soft then +if not _ENV._soft then -- tests with very long numerals assert(tonumber("0x"..string.rep("f", 13)..".0") == 2.0^(4*13) - 1) assert(tonumber("0x"..string.rep("f", 150)..".0") == 2.0^(4*150) - 1) @@ -620,7 +639,7 @@ assert(maxint % -2 == -1) -- non-portable tests because Windows C library cannot compute -- fmod(1, huge) correctly -if not _port then +if not _ENV._port then local function anan (x) assert(isNaN(x)) end -- assert Not a Number anan(0.0 % 0) anan(1.3 % 0) @@ -666,6 +685,18 @@ assert(eq(math.exp(0), 1)) assert(eq(math.sin(10), math.sin(10%(2*math.pi)))) +do print("testing ldexp/frexp") + global ipairs + for _, x in ipairs{0, 10, 32, -math.pi, 1e10, 1e-10, math.huge, -math.huge} do + local m, p = math.frexp(x) + assert(math.ldexp(m, p) == x) + local am = math.abs(m) + assert(m == x or (0.5 <= am and am < 1)) + end + +end + + assert(tonumber(' 1.3e-2 ') == 1.3e-2) assert(tonumber(' -1.00000000000001 ') == -1.00000000000001) @@ -767,6 +798,7 @@ assert(a == '10' and b == '20') do print("testing -0 and NaN") + global rawset, undef local mz = -0.0 local z = 0.0 assert(mz == z) @@ -803,7 +835,11 @@ do end -print("testing 'math.random'") +-- +-- [[================================================================== + print("testing 'math.random'") +-- -=================================================================== +-- local random, max, min = math.random, math.max, math.min @@ -1019,6 +1055,91 @@ assert(not pcall(random, minint + 1, minint)) assert(not pcall(random, maxint, maxint - 1)) assert(not pcall(random, maxint, minint)) +-- ]]================================================================== + + +-- +-- [[================================================================== + print("testing precision of 'tostring'") +-- -=================================================================== +-- + +-- number of decimal digits supported by float precision +local decdig = math.floor(floatbits * math.log(2, 10)) +print(string.format(" %d-digit float numbers with full precision", + decdig)) +-- number of decimal digits supported by integer precision +local Idecdig = math.floor(math.log(maxint, 10)) +print(string.format(" %d-digit integer numbers with full precision", + Idecdig)) + +do + -- Any number should print so that reading it back gives itself: + -- tonumber(tostring(x)) == x + + -- Mersenne fractions + local p = 1.0 + for i = 1, maxexp do + p = p + p + local x = 1 / (p - 1) + assert(x == tonumber(tostring(x))) + end + + -- some random numbers in [0,1) + for i = 1, 100 do + local x = math.random() + assert(x == tonumber(tostring(x))) + end + + -- different numbers should print differently. + -- check pairs of floats with minimum detectable difference + local p = floatbits - 1 + global ipairs + for i = 1, maxexp - 1 do + for _, i in ipairs{-i, i} do + local x = 2^i + local diff = 2^(i - p) -- least significant bit for 'x' + local y = x + diff + local fy = tostring(y) + assert(x ~= y and tostring(x) ~= fy) + assert(tonumber(fy) == y) + end + end + + + -- "reasonable" numerals should be printed like themselves + + -- create random float numerals with 5 digits, with a decimal point + -- inserted in all places. (With more than 5, things like "0.00001" + -- reformats like "1e-5".) + for i = 1, 1000 do + -- random numeral with 5 digits + local x = string.format("%.5d", math.random(0, 99999)) + for i = 2, #x do + -- insert decimal point at position 'i' + local y = string.sub(x, 1, i - 1) .. "." .. string.sub(x, i, -1) + y = string.gsub(y, "^0*(%d.-%d)0*$", "%1") -- trim extra zeros + assert(y == tostring(tonumber(y))) + end + end + + -- all-random floats + local Fsz = string.packsize("n") -- size of floats in bytes + + for i = 1, 400 do + local s = string.pack("j", math.random(0)) -- a random string of bits + while #s < Fsz do -- make 's' long enough + s = s .. string.pack("j", math.random(0)) + end + local n = string.unpack("n", s) -- read 's' as a float + s = tostring(n) + if string.find(s, "^%-?%d") then -- avoid NaN, inf, -inf + assert(tonumber(s) == n) + end + end + +end +-- ]]================================================================== print('OK') diff --git a/testes/memerr.lua b/testes/memerr.lua new file mode 100644 index 0000000000..9c940ca79a --- /dev/null +++ b/testes/memerr.lua @@ -0,0 +1,290 @@ +-- $Id: testes/memerr.lua $ +-- See Copyright Notice in file lua.h + + +local function checkerr (msg, f, ...) + local stat, err = pcall(f, ...) + assert(not stat and string.find(err, msg)) +end + +if T==nil then + (Message or print) + ('\n >>> testC not active: skipping memory error tests <<<\n') + return +end + +print("testing memory-allocation errors") + +local debug = require "debug" + +local pack = table.pack + +-- standard error message for memory errors +local MEMERRMSG = "not enough memory" + + +-- memory error in panic function +T.totalmem(T.totalmem()+10000) -- set low memory limit (+10k) +assert(T.checkpanic("newuserdata 20000") == MEMERRMSG) +T.totalmem(0) -- restore high limit + + + +-- {================================================================== +-- Testing memory limits +-- =================================================================== + +checkerr("block too big", T.newuserdata, math.maxinteger) +collectgarbage() +local f = load"local a={}; for i=1,100000 do a[i]=i end" +T.alloccount(10) +checkerr(MEMERRMSG, f) +T.alloccount() -- remove limit + + +-- preallocate stack space +local function deep (n) if n > 0 then deep(n - 1) end end + + +-- test memory errors; increase limit for maximum memory by steps, +-- so that we get memory errors in all allocations of a given +-- task, until there is enough memory to complete the task without +-- errors. +local function testbytes (s, f) + collectgarbage() + local M = T.totalmem() + local oldM = M + local a,b = nil + while true do + collectgarbage(); collectgarbage() + deep(4) + T.totalmem(M) + a, b = T.testC("pcall 0 1 0; pushstatus; return 2", f) + T.totalmem(0) -- remove limit + if a and b == "OK" then break end -- stop when no more errors + if b ~= "OK" and b ~= MEMERRMSG then -- not a memory error? + error(a, 0) -- propagate it + end + M = M + 7 -- increase memory limit + end + print(string.format("minimum memory for %s: %d bytes", s, M - oldM)) + return a +end + +-- test memory errors; increase limit for number of allocations one +-- by one, so that we get memory errors in all allocations of a given +-- task, until there is enough allocations to complete the task without +-- errors. + +local function testalloc (s, f) + collectgarbage() + local M = 0 + local a,b = nil + while true do + collectgarbage(); collectgarbage() + deep(4) + T.alloccount(M) + a, b = T.testC("pcall 0 1 0; pushstatus; return 2", f) + T.alloccount() -- remove limit + if a and b == "OK" then break end -- stop when no more errors + if b ~= "OK" and b ~= MEMERRMSG then -- not a memory error? + error(a, 0) -- propagate it + end + M = M + 1 -- increase allocation limit + end + print(string.format("minimum allocations for %s: %d allocations", s, M)) + return M +end + + +local function testamem (s, f) + local aloc = testalloc(s, f) + local res = testbytes(s, f) + return {aloc = aloc, res = res} +end + + +local b = testamem("function call", function () return 10 end) +assert(b.res == 10 and b.aloc == 0) + +testamem("state creation", function () + local st = T.newstate() + if st then T.closestate(st) end -- close new state + return st +end) + +testamem("empty-table creation", function () + return {} +end) + +testamem("string creation", function () + return "XXX" .. "YYY" +end) + +testamem("coroutine creation", function() + return coroutine.create(print) +end) + +do -- vararg tables + local function pack (...t) return t end + local b = testamem("vararg table", function () + return pack(10, 20, 30, 40, "hello") + end) + assert(b.aloc == 3) -- new table uses three memory blocks + -- table optimized away + local function sel (n, ...arg) return arg[n] + arg.n end + local b = testamem("optimized vararg table", + function () return sel(2.0, 20, 30) end) + assert(b.res == 32 and b.aloc == 0) -- no memory needed for this case +end + +-- testing to-be-closed variables +testamem("to-be-closed variables", function() + local flag + do + local x = + setmetatable({}, {__close = function () flag = true end}) + flag = false + local x = {} + end + return flag +end) + + +-- testing threads + +-- get main thread from registry +local mt = T.testC("rawgeti R !M; return 1") +assert(type(mt) == "thread" and coroutine.running() == mt) + + + +local function expand (n,s) + if n==0 then return "" end + local e = string.rep("=", n) + return string.format("T.doonnewstack([%s[ %s;\n collectgarbage(); %s]%s])\n", + e, s, expand(n-1,s), e) +end + +G=0; collectgarbage() +load(expand(20,"G=G+1"))() +assert(G==20); collectgarbage() +G = nil + +testamem("running code on new thread", function () + return T.doonnewstack("local x=1") == 0 -- try to create thread +end) + + +do -- external strings + local str = string.rep("a", 100) + testamem("creating external strings", function () + return T.externstr(str) + end) +end + + +-- testing memory x compiler + +testamem("loadstring", function () + return load("x=1") -- try to do load a string +end) + + +local testprog = [[ +local function foo () return end +local t = {"x"} +AA = "aaa" +for i = 1, #t do AA = AA .. t[i] end +return true +]] + +-- testing memory x dofile +_G.AA = nil +local t =os.tmpname() +local f = assert(io.open(t, "w")) +f:write(testprog) +f:close() +testamem("dofile", function () + local a = loadfile(t) + return a and a() +end) +assert(os.remove(t)) +assert(_G.AA == "aaax") + + +-- other generic tests + +testamem("gsub", function () + local a, b = string.gsub("alo alo", "(a)", function (x) return x..'b' end) + return (a == 'ablo ablo') +end) + +testamem("dump/undump", function () + local a = load(testprog) + local b = a and string.dump(a) + a = b and load(b) + return a and a() +end) + +_G.AA = nil + +local t = os.tmpname() +testamem("file creation", function () + local f = assert(io.open(t, 'w')) + assert (not io.open"nomenaoexistente") + io.close(f); + return not loadfile'nomenaoexistente' +end) +assert(os.remove(t)) + +testamem("table creation", function () + local a, lim = {}, 10 + for i=1,lim do a[i] = i; a[i..'a'] = {} end + return (type(a[lim..'a']) == 'table' and a[lim] == lim) +end) + +testamem("constructors", function () + local a = {10, 20, 30, 40, 50; a=1, b=2, c=3, d=4, e=5} + return (type(a) == 'table' and a.e == 5) +end) + +local a = 1 +local close = nil +testamem("closure creation", function () + function close (b) + return function (x) return b + x end + end + return (close(2)(4) == 6) +end) + +testamem("using coroutines", function () + local a = coroutine.wrap(function () + coroutine.yield(string.rep("a", 10)) + return {} + end) + assert(string.len(a()) == 10) + return a() +end) + +do -- auxiliary buffer + local lim = 100 + local a = {}; for i = 1, lim do a[i] = "01234567890123456789" end + testamem("auxiliary buffer", function () + return (#table.concat(a, ",") == 20*lim + lim - 1) + end) +end + +testamem("growing stack", function () + local function foo (n) + if n == 0 then return 1 else return 1 + foo(n - 1) end + end + return foo(100) +end) + +-- }================================================================== + + +print "Ok" + + diff --git a/testes/nextvar.lua b/testes/nextvar.lua index 02b7dea2ef..098e7891c9 100644 --- a/testes/nextvar.lua +++ b/testes/nextvar.lua @@ -1,5 +1,7 @@ -- $Id: testes/nextvar.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +global * print('testing tables, next, and for') @@ -9,6 +11,28 @@ local function checkerror (msg, f, ...) end + +---------------------------------------------------------------- +local function printTable (t) + local a, h = T.querytab(t) + print("array:") + for i = 1, a do + print("", T.querytab(t, i - 1)) + end + print("hash:") + for i = 1, h do + print("", T.querytab(t, a + i - 1)) + end +end +---------------------------------------------------------------- +local function countentries (t) + local e = 0 + for _ in pairs(t) do e = e + 1 end + return e +end +---------------------------------------------------------------- + + local function check (t, na, nh) if not T then return end local a, h = T.querytab(t) @@ -39,13 +63,32 @@ do -- rehash moving elements from array to hash for i = 5, 95 do a[i] = nil end check(a, 128, 0) - a.x = 1 -- force a re-hash - check(a, 4, 8) + a[129] = 1 -- force a re-hash + check(a, 4, 8) -- keys larger than 4 go to the hash part for i = 1, 4 do assert(a[i] == i) end for i = 5, 95 do assert(a[i] == nil) end for i = 96, 100 do assert(a[i] == i) end - assert(a.x == 1) + assert(a[129] == 1) +end + + +do -- growing hash part keeping array part + local a = table.create(1000) + check(a, 1000, 0) + a.x = 10 + check(a, 1000, 1) -- array part keeps its elements +end + + +do -- "growing" length of a prebuilt table + local N = 100 + local a = table.create(N) + for i = 1, N do + a[#a + 1] = true + assert(#a == i) + end + check(a, N, 0) end @@ -80,6 +123,24 @@ do -- overflow (must wrap-around) assert(k == nil) end + +do + -- alternate insertions and deletions in an almost full hash. + -- In versions pre-5.5, that causes constant rehashings and + -- takes a long time to complete. + local a = {} + for i = 1, 2^11 - 1 do + a[i .. ""] = true + end + + for i = 1, 1e5 do + local key = i .. "." + a[key] = true + a[key] = nil + end + assert(countentries(a) == 2^11 - 1) +end + if not T then (Message or print) ('\n >>> testC not active: skipping tests for table sizes <<<\n') @@ -87,9 +148,10 @@ else --[ -- testing table sizes -local function mp2 (n) -- minimum power of 2 >= n +-- minimum power of 2 (or zero) >= n +local function mp2 (n) local mp = 2^math.ceil(math.log(n, 2)) - assert(n == 0 or (mp/2 < n and n <= mp)) + assert((mp == 0 or mp/2 < n) and n <= mp) return mp end @@ -104,7 +166,7 @@ end -- testing constructor sizes local sizes = {0, 1, 2, 3, 4, 5, 7, 8, 9, 15, 16, 17, - 30, 31, 32, 33, 34, 254, 255, 256, 500, 1000} + 30, 31, 32, 33, 34, 254, 255, 256, 257, 500, 1001} for _, sa in ipairs(sizes) do -- 'sa' is size of the array part local arr = {"return {"} @@ -148,8 +210,9 @@ end -- testing tables dynamically built local lim = 130 -local a = {}; a[2] = 1; check(a, 0, 1) -a = {}; a[0] = 1; check(a, 0, 1); a[2] = 1; check(a, 0, 2) +local a = {}; a[2] = 1; check(a, 2, 0) +a = {}; a[0] = 1; check(a, 0, 1); +a[2] = 1; check(a, 2, 1) a = {}; a[0] = 1; a[1] = 1; check(a, 1, 1) a = {} for i = 1,lim do @@ -165,28 +228,82 @@ for i = 1,lim do check(a, 0, mp2(i)) end -a = {} -for i=1,16 do a[i] = i end -check(a, 16, 0) + +-- insert and delete elements until a rehash occur. Caller must ensure +-- that a rehash will change the shape of the table. Must repeat because +-- the insertion may collide with the deleted element, and then there is +-- no rehash. +local function forcerehash (t) + local na, nh = T.querytab(t) + local i = 10000 + repeat + i = i + 1 + t[i] = true + t[i] = undef + local nna, nnh = T.querytab(t) + until nna ~= na or nnh ~= nh +end + + do + local a = {} + for i=1,16 do a[i] = i end + check(a, 16, 0) for i=1,11 do a[i] = undef end - for i=30,50 do a[i] = true; a[i] = undef end -- force a rehash (?) - check(a, 0, 8) -- 5 elements in the table + check(a, 16, 0) + a[30] = true -- force a rehash + a[30] = undef + check(a, 0, 8) -- 5 elements in the hash part: [12]-[16] a[10] = 1 - for i=30,50 do a[i] = true; a[i] = undef end -- force a rehash (?) - check(a, 0, 8) -- only 6 elements in the table + forcerehash(a) + check(a, 16, 1) for i=1,14 do a[i] = true; a[i] = undef end - for i=18,50 do a[i] = true; a[i] = undef end -- force a rehash (?) - check(a, 0, 4) -- only 2 elements ([15] and [16]) + check(a, 16, 1) -- no rehash... + a[31] = true; a[32] = true -- force a rehash + check(a, 0, 4) -- [15], [16], [31], [32] end -- reverse filling -for i=1,lim do +do + local N = 2^10 local a = {} - for i=i,1,-1 do a[i] = i end -- fill in reverse - check(a, mp2(i), 0) + for i = N, 1, -1 do a[i] = i end -- fill in reverse + check(a, mp2(N), 0) +end + + +do -- "almost sparse" arrays + -- create table with holes in 1/3 of its entries; all its + -- elements are always in the array part + local a = {} + for i = 1, 257 do + if i % 3 ~= 1 then + a[i] = true + check(a, mp2(i), 0) + end + end +end + + +do + -- alternate insertions and deletions should give some extra + -- space for the hash part. Otherwise, a mix of insertions/deletions + -- could cause too many rehashes. (See the other test for "alternate + -- insertions and deletions" in this file.) + local a = {} + for i = 1, 256 do + a[i .. ""] = true + end + check(a, 0, 256) -- hash part is full + a["256"] = nil -- delete a key + forcerehash(a) + -- table has only 255 elements, but it got some extra space; + -- otherwise, almost each delete-insert would rehash the table again. + assert(countentries(a) == 255) + check(a, 0, 512) end + -- size tests for vararg lim = 35 local function foo (n, ...) @@ -201,21 +318,6 @@ end local a = {} for i=1,lim do a[i] = true; foo(i, table.unpack(a)) end - --- Table length with limit smaller than maximum value at array -local a = {} -for i = 1,64 do a[i] = true end -- make its array size 64 -for i = 1,64 do a[i] = nil end -- erase all elements -assert(T.querytab(a) == 64) -- array part has 64 elements -a[32] = true; a[48] = true; -- binary search will find these ones -a[51] = true -- binary search will miss this one -assert(#a == 48) -- this will set the limit -assert(select(4, T.querytab(a)) == 48) -- this is the limit now -a[50] = true -- this will set a new limit -assert(select(4, T.querytab(a)) == 50) -- this is the limit now --- but the size is larger (and still inside the array part) -assert(#a == 51) - end --] @@ -229,13 +331,36 @@ assert(#{1, 2, 3, nil, nil} == 3) print'+' -local nofind = {} +do + local s1, s2 = math.randomseed() + print(string.format( + "testing length for some random tables (seeds 0X%x:%x)", s1, s2)) + local N = 130 + for i = 1, 1e3 do -- create that many random tables + local a = table.create(math.random(N)) -- initiate with random size + for j = 1, math.random(N) do -- add random number of random entries + a[math.random(N)] = true + end + assert(#a == 0 or a[#a] and not a[#a + 1]) + end +end -a,b,c = 1,2,3 -a,b,c = nil + +do print("testing attack on table length") + local t = {} + local lim = math.floor(math.log(math.maxinteger, 2)) - 1 + for i = lim, 0, -1 do + t[2^i] = true + end + assert(t[1 << lim]) + -- next loop should not take forever + for i = 1, #t do end +end + +local nofind = {} --- next uses always the same iteraction function +-- next uses always the same iteration function assert(next{} == next{}) local function find (name) @@ -282,7 +407,7 @@ for i=0,10000 do end end -n = {n=0} +local n = {n=0} for i,v in pairs(a) do n.n = n.n+1 assert(i and v and a[i] == v) @@ -609,10 +734,12 @@ do a = 0; for i=1.0, 0.99999, -1 do a=a+1 end; assert(a==1) end -do -- changing the control variable - local a - a = 0; for i = 1, 10 do a = a + 1; i = "x" end; assert(a == 10) - a = 0; for i = 10.0, 1, -1 do a = a + 1; i = "x" end; assert(a == 10) +do -- attempt to change the control variable + local st, msg = load "for i = 1, 10 do i = 10 end" + assert(not st and string.find(msg, "assign to const variable 'i'")) + + local st, msg = load "for v, k in pairs{} do v = 10 end" + assert(not st and string.find(msg, "assign to const variable 'v'")) end -- conversion @@ -778,13 +905,18 @@ local function foo1 (e,i) if i <= e.n then return i,a[i] end end -setmetatable(a, {__pairs = function (x) return foo, x, 0 end}) +local closed = false +setmetatable(a, {__pairs = function (x) + local tbc = setmetatable({}, {__close = function () closed = true end}) + return foo, x, 0, tbc + end}) local i = 0 for k,v in pairs(a) do i = i + 1 assert(k == i and v == k+1) end +assert(closed) -- 'tbc' has been closed a.n = 5 a[3] = 30 @@ -819,7 +951,7 @@ do co() -- start coroutine co(1) -- continue after yield assert(res[1] == 30 and res[2] == 20 and res[3] == 10 and #res == 3) - + end print"OK" diff --git a/testes/packtests b/testes/packtests index 0dbb92fe5d..855c054a0c 100755 --- a/testes/packtests +++ b/testes/packtests @@ -28,6 +28,7 @@ $NAME/literals.lua \ $NAME/locals.lua \ $NAME/main.lua \ $NAME/math.lua \ +$NAME/memerr.lua \ $NAME/nextvar.lua \ $NAME/pm.lua \ $NAME/sort.lua \ diff --git a/testes/pm.lua b/testes/pm.lua index 795596d412..720d2a3562 100644 --- a/testes/pm.lua +++ b/testes/pm.lua @@ -1,8 +1,13 @@ -- $Id: testes/pm.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +-- UTF-8 file + print('testing pattern matching') +global * + local function checkerror (msg, f, ...) local s, err = pcall(f, ...) assert(not s and string.find(err, msg)) @@ -20,9 +25,9 @@ a,b = string.find('alo', '') assert(a == 1 and b == 0) a,b = string.find('a\0o a\0o a\0o', 'a', 1) -- first position assert(a == 1 and b == 1) -a,b = string.find('a\0o a\0o a\0o', 'a\0o', 2) -- starts in the midle +a,b = string.find('a\0o a\0o a\0o', 'a\0o', 2) -- starts in the middle assert(a == 5 and b == 7) -a,b = string.find('a\0o a\0o a\0o', 'a\0o', 9) -- starts in the midle +a,b = string.find('a\0o a\0o a\0o', 'a\0o', 9) -- starts in the middle assert(a == 9 and b == 11) a,b = string.find('a\0a\0a\0a\0\0ab', '\0ab', 2); -- finds at the end assert(a == 9 and b == 11); @@ -50,6 +55,20 @@ assert(f('aLo_ALO', '%a*') == 'aLo') assert(f(" \n\r*&\n\r xuxu \n\n", "%g%g%g+") == "xuxu") + +-- Adapt a pattern to UTF-8 +local function PU (p) + -- distribute '?' into each individual byte of a character. + -- (For instance, "á?" becomes "\195?\161?".) + p = string.gsub(p, "(" .. utf8.charpattern .. ")%?", function (c) + return string.gsub(c, ".", "%0?") + end) + -- change '.' to utf-8 character patterns + p = string.gsub(p, "%.", utf8.charpattern) + return p +end + + assert(f('aaab', 'a*') == 'aaa'); assert(f('aaa', '^.*$') == 'aaa'); assert(f('aaa', 'b*') == ''); @@ -73,16 +92,16 @@ assert(f('aaa', '^.-$') == 'aaa') assert(f('aabaaabaaabaaaba', 'b.*b') == 'baaabaaabaaab') assert(f('aabaaabaaabaaaba', 'b.-b') == 'baaab') assert(f('alo xo', '.o$') == 'xo') -assert(f(' \n isto é assim', '%S%S*') == 'isto') -assert(f(' \n isto é assim', '%S*$') == 'assim') -assert(f(' \n isto é assim', '[a-z]*$') == 'assim') +assert(f(' \n isto é assim', '%S%S*') == 'isto') +assert(f(' \n isto é assim', '%S*$') == 'assim') +assert(f(' \n isto é assim', '[a-z]*$') == 'assim') assert(f('um caracter ? extra', '[^%sa-z]') == '?') assert(f('', 'a?') == '') -assert(f('á', 'á?') == 'á') -assert(f('ábl', 'á?b?l?') == 'ábl') -assert(f(' ábl', 'á?b?l?') == '') +assert(f('á', PU'á?') == 'á') +assert(f('ábl', PU'á?b?l?') == 'ábl') +assert(f(' ábl', PU'á?b?l?') == '') assert(f('aa', '^aa?a?a') == 'aa') -assert(f(']]]áb', '[^]]') == 'á') +assert(f(']]]áb', '[^]]+') == 'áb') assert(f("0alo alo", "%x*") == "0a") assert(f("alo alo", "%C+") == "alo alo") print('+') @@ -136,28 +155,28 @@ assert(string.match("alo xyzK", "(%w+)K") == "xyz") assert(string.match("254 K", "(%d*)K") == "") assert(string.match("alo ", "(%w*)$") == "") assert(not string.match("alo ", "(%w+)$")) -assert(string.find("(álo)", "%(á") == 1) -local a, b, c, d, e = string.match("âlo alo", "^(((.).).* (%w*))$") -assert(a == 'âlo alo' and b == 'âl' and c == 'â' and d == 'alo' and e == nil) +assert(string.find("(álo)", "%(á") == 1) +local a, b, c, d, e = string.match("âlo alo", PU"^(((.).). (%w*))$") +assert(a == 'âlo alo' and b == 'âl' and c == 'â' and d == 'alo' and e == nil) a, b, c, d = string.match('0123456789', '(.+(.?)())') assert(a == '0123456789' and b == '' and c == 11 and d == nil) print('+') -assert(string.gsub('ülo ülo', 'ü', 'x') == 'xlo xlo') -assert(string.gsub('alo úlo ', ' +$', '') == 'alo úlo') -- trim +assert(string.gsub('ülo ülo', 'ü', 'x') == 'xlo xlo') +assert(string.gsub('alo úlo ', ' +$', '') == 'alo úlo') -- trim assert(string.gsub(' alo alo ', '^%s*(.-)%s*$', '%1') == 'alo alo') -- double trim assert(string.gsub('alo alo \n 123\n ', '%s+', ' ') == 'alo alo 123 ') -local t = "abç d" -a, b = string.gsub(t, '(.)', '%1@') -assert('@'..a == string.gsub(t, '', '@') and b == 5) -a, b = string.gsub('abçd', '(.)', '%0@', 2) -assert(a == 'a@b@çd' and b == 2) +local t = "abç d" +a, b = string.gsub(t, PU'(.)', '%1@') +assert(a == "a@b@ç@ @d@" and b == 5) +a, b = string.gsub('abçd', PU'(.)', '%0@', 2) +assert(a == 'a@b@çd' and b == 2) assert(string.gsub('alo alo', '()[al]', '%1') == '12o 56o') assert(string.gsub("abc=xyz", "(%w*)(%p)(%w+)", "%3%2%1-%0") == "xyz=abc-abc=xyz") assert(string.gsub("abc", "%w", "%1%0") == "aabbcc") assert(string.gsub("abc", "%w+", "%0%1") == "abcabc") -assert(string.gsub('áéí', '$', '\0óú') == 'áéí\0óú') +assert(string.gsub('áéí', '$', '\0óú') == 'áéí\0óú') assert(string.gsub('', '^', 'r') == 'r') assert(string.gsub('', '$', 'r') == 'r') print('+') @@ -188,8 +207,8 @@ do end function f(a,b) return string.gsub(a,'.',b) end -assert(string.gsub("trocar tudo em |teste|b| é |beleza|al|", "|([^|]*)|([^|]*)|", f) == - "trocar tudo em bbbbb é alalalalalal") +assert(string.gsub("trocar tudo em |teste|b| é |beleza|al|", "|([^|]*)|([^|]*)|", f) == + "trocar tudo em bbbbb é alalalalalal") local function dostring (s) return load(s, "")() or "" end assert(string.gsub("alo $a='x'$ novamente $return a$", diff --git a/testes/sort.lua b/testes/sort.lua index 52919b8cd2..b012766057 100644 --- a/testes/sort.lua +++ b/testes/sort.lua @@ -1,12 +1,8 @@ -- $Id: testes/sort.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print "testing (parts of) table library" -print "testing unpack" - -local unpack = table.unpack - local maxI = math.maxinteger local minI = math.mininteger @@ -17,6 +13,40 @@ local function checkerror (msg, f, ...) end +do print "testing 'table.create'" + local N = 10000 + collectgarbage() + local m = collectgarbage("count") * 1024 + local t = table.create(N) + local memdiff = collectgarbage("count") * 1024 - m + assert(memdiff > N * 4) + for i = 1, 20 do + assert(#t == i - 1) + t[i] = 0 + end + for i = 1, 20 do t[#t + 1] = i * 10 end + assert(#t == 40 and t[39] == 190) + assert(not T or T.querytab(t) == N) + t = nil + collectgarbage() + m = collectgarbage("count") * 1024 + t = table.create(0, 1024) + memdiff = collectgarbage("count") * 1024 - m + assert(memdiff > 1024 * 12) + assert(not T or select(2, T.querytab(t)) == 1024) + + local maxint1 = 1 << (string.packsize("i") * 8 - 1) + checkerror("out of range", table.create, maxint1) + checkerror("out of range", table.create, 0, maxint1) + checkerror("table overflow", table.create, 0, maxint1 - 1) +end + + +print "testing unpack" + +local unpack = table.unpack + + checkerror("wrong number of arguments", table.insert, {}, 2, 3, 4) local x,y,z,a,n @@ -169,7 +199,7 @@ do __index = function (_,k) pos1 = k end, __newindex = function (_,k) pos2 = k; error() end, }) local st, msg = pcall(table.move, a, f, e, t) - assert(not st and not msg and pos1 == x and pos2 == y) + assert(not st and pos1 == x and pos2 == y) end checkmove(1, maxI, 0, 1, 0) checkmove(0, maxI - 1, 1, maxI - 1, maxI) @@ -289,7 +319,7 @@ timesort(a, limit, function(x,y) return nil end, "equal") for i,v in pairs(a) do assert(v == false) end -AA = {"álo", "\0first :-)", "alo", "then this one", "45", "and a new"} +AA = {"\xE1lo", "\0first :-)", "alo", "then this one", "45", "and a new"} table.sort(AA) check(AA) diff --git a/testes/strings.lua b/testes/strings.lua index b033c6ab39..84ff115483 100644 --- a/testes/strings.lua +++ b/testes/strings.lua @@ -1,5 +1,9 @@ -- $Id: testes/strings.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +-- ISO Latin encoding + +global * print('testing strings and string library') @@ -106,10 +110,9 @@ assert(string.rep('teste', 0) == '') assert(string.rep('tés\00tê', 2) == 'tés\0têtés\000tê') assert(string.rep('', 10) == '') -if string.packsize("i") == 4 then - -- result length would be 2^31 (int overflow) - checkerror("too large", string.rep, 'aa', (1 << 30)) - checkerror("too large", string.rep, 'a', (1 << 30), ',') +do + checkerror("too large", string.rep, 'aa', math.maxinteger); + checkerror("too large", string.rep, 'a', math.maxinteger, ',') end -- repetitions with separator @@ -154,6 +157,12 @@ else -- compatible coercion assert(tostring(-1203 + 0.0) == "-1203") end + +local function topointer (s) + return string.format("%p", s) +end + + do -- tests for '%p' format -- not much to test, as C does not specify what '%p' does. -- ("The value of the pointer is converted to a sequence of printing @@ -177,18 +186,18 @@ do -- tests for '%p' format do local t1 = {}; local t2 = {} - assert(string.format("%p", t1) ~= string.format("%p", t2)) + assert(topointer(t1) ~= topointer(t2)) end do -- short strings are internalized local s1 = string.rep("a", 10) local s2 = string.rep("aa", 5) - assert(string.format("%p", s1) == string.format("%p", s2)) + assert(topointer(s1) == topointer(s2)) end do -- long strings aren't internalized local s1 = string.rep("a", 300); local s2 = string.rep("a", 300) - assert(string.format("%p", s1) ~= string.format("%p", s2)) + assert(topointer(s1) ~= topointer(s2)) end end @@ -518,6 +527,37 @@ else testpfs("P", str, {}) end +if T == nil then + (Message or print)('\n >>> testC not active: skipping external strings tests <<<\n') +else + print("testing external strings") + local x = T.externKstr("hello") -- external fixed short string + assert(x == "hello") + local x = T.externstr("hello") -- external allocated short string + assert(x == "hello") + x = string.rep("a", 100) -- long string + local y = T.externKstr(x) -- external fixed long string + assert(y == x) + local z = T.externstr(x) -- external allocated long string + assert(z == y) + + local e = T.externstr("") -- empty external string + assert(e .. "x" == "x" and "x" .. e == "x") + assert(e .. e == "" and #e == 0) + + -- external string as the "n" key in vararg table + local n = T.externstr("n") + local n0 = T.externstr("n\0") + local function aux (...t) assert(t[n0] == nil); return t[n] end + assert(aux(10, 20, 30) == 3) + + -- external string as mode in weak table + local t = setmetatable({}, {__mode = T.externstr("kv")}) + t[{}] = {} + assert(next(t)) + collectgarbage() + assert(next(t) == nil) +end print('OK') diff --git a/testes/tpack.lua b/testes/tpack.lua index bfa63fc40c..70386178c4 100644 --- a/testes/tpack.lua +++ b/testes/tpack.lua @@ -1,5 +1,5 @@ -- $Id: testes/tpack.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h local pack = string.pack local packsize = string.packsize @@ -135,15 +135,15 @@ checkerror("variable%-length format", packsize, "z") -- overflow in option size (error will be in digit after limit) checkerror("invalid format", packsize, "c1" .. string.rep("0", 40)) -if packsize("i") == 4 then - -- result would be 2^31 (2^3 repetitions of 2^28 strings) - local s = string.rep("c268435456", 2^3) - checkerror("too large", packsize, s) - -- one less is OK - s = string.rep("c268435456", 2^3 - 1) .. "c268435455" - assert(packsize(s) == 0x7fffffff) +do + local maxsize = (packsize("j") <= packsize("T")) and + math.maxinteger or (1 << (packsize("T") * 8)) + assert (packsize(string.format("c%d", maxsize - 9)) == maxsize - 9) + checkerror("too large", packsize, string.format("c%dc10", maxsize - 9)) + checkerror("too long", pack, string.format("xxxxxxxxxx c%d", maxsize - 9)) end + -- overflow in packing for i = 1, sizeLI - 1 do local umax = (1 << (i * 8)) - 1 @@ -229,8 +229,9 @@ do assert(pack("c3", "123") == "123") assert(pack("c0", "") == "") assert(pack("c8", "123456") == "123456\0\0") - assert(pack("c88", "") == string.rep("\0", 88)) - assert(pack("c188", "ab") == "ab" .. string.rep("\0", 188 - 2)) + assert(pack("c88 c1", "", "X") == string.rep("\0", 88) .. "X") + assert(pack("c188 c2", "ab", "X\1") == + "ab" .. string.rep("\0", 188 - 2) .. "X\1") local a, b, c = unpack("!4 z c3", "abcdefghi\0xyz") assert(a == "abcdefghi" and b == "xyz" and c == 14) checkerror("longer than", pack, "c3", "1234") diff --git a/testes/tracegc.lua b/testes/tracegc.lua index 9c5c1b3f51..a8c929dffd 100644 --- a/testes/tracegc.lua +++ b/testes/tracegc.lua @@ -6,7 +6,7 @@ local M = {} local setmetatable, stderr, collectgarbage = setmetatable, io.stderr, collectgarbage -_ENV = nil +global none local active = false diff --git a/testes/utf8.lua b/testes/utf8.lua index c5a9dd3f02..028995a478 100644 --- a/testes/utf8.lua +++ b/testes/utf8.lua @@ -1,5 +1,9 @@ -- $Id: testes/utf8.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h + +-- UTF-8 file + +global * print "testing UTF-8 library" @@ -50,24 +54,34 @@ local function check (s, t, nonstrict) for i = 1, #t do assert(t[i] == t1[i]) end -- 't' is equal to 't1' for i = 1, l do -- for all codepoints - local pi = utf8.offset(s, i) -- position of i-th char + local pi, pie = utf8.offset(s, i) -- position of i-th char local pi1 = utf8.offset(s, 2, pi) -- position of next char + assert(pi1 == pie + 1) assert(string.find(string.sub(s, pi, pi1 - 1), justone)) assert(utf8.offset(s, -1, pi1) == pi) assert(utf8.offset(s, i - l - 1) == pi) assert(pi1 - pi == #utf8.char(utf8.codepoint(s, pi, pi, nonstrict))) for j = pi, pi1 - 1 do - assert(utf8.offset(s, 0, j) == pi) + local off1, off2 = utf8.offset(s, 0, j) + assert(off1 == pi and off2 == pi1 - 1) end for j = pi + 1, pi1 - 1 do assert(not utf8.len(s, j)) end - assert(utf8.len(s, pi, pi, nonstrict) == 1) - assert(utf8.len(s, pi, pi1 - 1, nonstrict) == 1) - assert(utf8.len(s, pi, -1, nonstrict) == l - i + 1) - assert(utf8.len(s, pi1, -1, nonstrict) == l - i) - assert(utf8.len(s, 1, pi, nonstrict) == i) + assert(utf8.len(s, pi, pi, nonstrict) == 1) + assert(utf8.len(s, pi, pi1 - 1, nonstrict) == 1) + assert(utf8.len(s, pi, -1, nonstrict) == l - i + 1) + assert(utf8.len(s, pi1, -1, nonstrict) == l - i) + assert(utf8.len(s, 1, pi, nonstrict) == i) + end + + local expected = 1 -- expected position of "current" character + for i = 1, l + 1 do + local p, e = utf8.offset(s, i) + assert(p == expected) + expected = e + 1 end + assert(expected - 1 == #s + 1) local i = 0 for p, c in utf8.codes(s, nonstrict) do @@ -92,20 +106,20 @@ end do -- error indication in utf8.len - local function check (s, p) + local function checklen (s, p) local a, b = utf8.len(s) assert(not a and b == p) end - check("abc\xE3def", 4) - check("\xF4\x9F\xBF", 1) - check("\xF4\x9F\xBF\xBF", 1) + checklen("abc\xE3def", 4) + checklen("\xF4\x9F\xBF", 1) + checklen("\xF4\x9F\xBF\xBF", 1) -- spurious continuation bytes - check("汉字\x80", #("汉字") + 1) - check("\x80hello", 1) - check("hel\x80lo", 4) - check("汉字\xBF", #("汉字") + 1) - check("\xBFhello", 1) - check("hel\xBFlo", 4) + checklen("汉字\x80", #("汉字") + 1) + checklen("\x80hello", 1) + checklen("hel\x80lo", 4) + checklen("汉字\xBF", #("汉字") + 1) + checklen("\xBFhello", 1) + checklen("hel\xBFlo", 4) end -- errors in utf8.codes @@ -122,7 +136,7 @@ do errorcodes("\xbfinvalid") errorcodes("αλφ\xBFα") - -- calling interation function with invalid arguments + -- calling iteration function with invalid arguments local f = utf8.codes("") assert(f("", 2) == nil) assert(f("", -1) == nil) @@ -138,11 +152,20 @@ checkerror("position out of bounds", utf8.offset, "", 1, -1) checkerror("continuation byte", utf8.offset, "𦧺", 1, 2) checkerror("continuation byte", utf8.offset, "𦧺", 1, 2) checkerror("continuation byte", utf8.offset, "\x80", 1) +checkerror("continuation byte", utf8.offset, "\x9c", -1) -- error in indices for len checkerror("out of bounds", utf8.len, "abc", 0, 2) checkerror("out of bounds", utf8.len, "abc", 1, 4) +do -- missing continuation bytes + -- get what is available + local p, e = utf8.offset("\xE0", 1) + assert(p == 1 and e == 1) + local p, e = utf8.offset("\xE0\x9e", -1) + assert(p == 1 and e == 2) +end + local s = "hello World" local t = {string.byte(s, 1, -1)} diff --git a/testes/vararg.lua b/testes/vararg.lua index 1b02510244..a01598ff3b 100644 --- a/testes/vararg.lua +++ b/testes/vararg.lua @@ -1,11 +1,14 @@ -- $Id: testes/vararg.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print('testing vararg') -local function f (a, ...) +local function f (a, ...t) local x = {n = select('#', ...), ...} - for i = 1, x.n do assert(a[i] == x[i]) end + assert(x.n == t.n) + for i = 1, x.n do + assert(a[i] == x[i] and x[i] == t[i]) + end return x.n end @@ -17,7 +20,7 @@ local function c12 (...) return res, 2 end -local function vararg (...) return {n = select('#', ...), ...} end +local function vararg (... t) return t end local call = function (f, args) return f(table.unpack(args, 1, args.n)) end @@ -99,7 +102,7 @@ assert(a==nil and b==nil and c==nil and d==nil and e==nil) -- varargs for main chunks -local f = load[[ return {...} ]] +local f = assert(load[[ return {...} ]]) local x = f(2,3) assert(x[1] == 2 and x[2] == 3 and x[3] == undef) @@ -147,5 +150,78 @@ do local a, b = g() assert(a == nil and b == 2) end + + +do -- vararg parameter used in nested functions + local function foo (...tab1) + return function (...tab2) + return {tab1, tab2} + end + end + local f = foo(10, 20, 30) + local t = f("a", "b") + assert(t[1].n == 3 and t[1][1] == 10) + assert(t[2].n == 2 and t[2][1] == "a") +end + +do -- vararg parameter is read-only + local st, msg = load("return function (... t) t = 10 end") + assert(string.find(msg, "const variable 't'")) + + local st, msg = load[[ + local function foo (...extra) + return function (...) extra = nil end + end + ]] + assert(string.find(msg, "const variable 'extra'")) +end + + +do -- _ENV as vararg parameter + local st, msg = load[[ + local function aux (... _ENV) + global a + a = 10 + end ]] + assert(string.find(msg, "const variable 'a'")) + + local function aux (..._ENV) + global a; a = 10 + return a + end + assert(aux() == 10) + + local function aux (... _ENV) + global a = 10 + return a + end + assert(aux() == 10) +end + + +do -- access to vararg parameter + local function notab (keys, t, ...v) + for _, k in pairs(keys) do + assert(t[k] == v[k]) + end + assert(t.n == v.n) + end + + local t = table.pack(10, 20, 30) + local keys = {-1, 0, 1, t.n, t.n + 1, 1.0, 1.1, "n", print, "k", "1"} + notab(keys, t, 10, 20, 30) -- ensure stack space + local m = collectgarbage"count" + notab(keys, t, 10, 20, 30) + -- 'notab' does not create any table/object + assert(m == collectgarbage"count") + + -- writing to the vararg table + local function foo (...t) + t[1] = t[1] + 10 + return t[1] + end + assert(foo(10, 30) == 20) +end + print('OK') diff --git a/testes/verybig.lua b/testes/verybig.lua index 250ea79501..8163802c1d 100644 --- a/testes/verybig.lua +++ b/testes/verybig.lua @@ -1,5 +1,5 @@ -- $Id: testes/verybig.lua $ --- See Copyright Notice in file all.lua +-- See Copyright Notice in file lua.h print "testing RK"