Optimization for 'n^2'

Squares are much more common than other exponentiations, and 'n*n' is
much more efficient than 'pow'.

.gitignore

@@ -0,0 +1,15 @@
+.gitattributes
+
+*.so
+*.o
+*.a
+
+manual/manual.html
+
+testes/time.txt
+testes/time-debug.txt
+
+testes/libs/all
+
+temp
+lua

README.md

@@ -0,0 +1,7 @@
+# Lua
+
+This is the repository of Lua development code, as seen by the Lua team. It contains the full history of all commits but is mirrored irregularly. For complete information about Lua, visit [Lua.org](https://www.lua.org/).
+
+Please **do not** send pull requests. To report issues and send patches, post a message to the [Lua mailing list](https://www.lua.org/lua-l.html).
+
+Download official Lua releases from [Lua.org](https://www.lua.org/download.html).

all

@@ -1,7 +1,7 @@
 make -s -j
 cd testes/libs; make -s
 cd ..     # back to directory 'testes'
-ulimit -S -s 2000
+ulimit -S -s 1000
 if { ../lua -W all.lua; } then
   echo -e "\n\n    final OK!!!!\n\n"
 else

lapi.c

@@ -97,8 +97,9 @@ static StkId index2stack (lua_State *L, int idx) {
 
 LUA_API int lua_checkstack (lua_State *L, int n) {
   int res;
-  CallInfo *ci = L->ci;
+  CallInfo *ci;
   lua_lock(L);
+  ci = L->ci;
   api_check(L, n >= 0, "negative 'n'");
   if (L->stack_last - L->top > n)  /* stack large enough? */
     res = 1;  /* yes; check is OK */
@@ -170,10 +171,12 @@ LUA_API int lua_gettop (lua_State *L) {
 
 
 LUA_API void lua_settop (lua_State *L, int idx) {
-  CallInfo *ci = L->ci;
-  StkId func = ci->func;
+  CallInfo *ci;
+  StkId func;
   ptrdiff_t diff;  /* difference for new top */
   lua_lock(L);
+  ci = L->ci;
+  func = ci->func;
   if (idx >= 0) {
     api_check(L, idx <= ci->top - (func + 1), "new top too large");
     diff = ((func + 1) + idx) - L->top;
@@ -376,20 +379,22 @@ LUA_API int lua_toboolean (lua_State *L, int idx) {
 
 
 LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {
-  TValue *o = index2value(L, idx);
+  TValue *o;
+  lua_lock(L);
+  o = index2value(L, idx);
   if (!ttisstring(o)) {
     if (!cvt2str(o)) {  /* not convertible? */
       if (len != NULL) *len = 0;
+      lua_unlock(L);
       return NULL;
     }
-    lua_lock(L);  /* 'luaO_tostring' may create a new string */
     luaO_tostring(L, o);
     luaC_checkGC(L);
     o = index2value(L, idx);  /* previous call may reallocate the stack */
-    lua_unlock(L);
   }
   if (len != NULL)
     *len = vslen(o);
+  lua_unlock(L);
   return svalue(o);
 }
 
@@ -563,6 +568,7 @@ LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
     while (n--) {
       setobj2n(L, &cl->upvalue[n], s2v(L->top + n));
       /* does not need barrier because closure is white */
+      lua_assert(iswhite(cl));
     }
     setclCvalue(L, s2v(L->top), cl);
     api_incr_top(L);
@@ -624,8 +630,9 @@ static int auxgetstr (lua_State *L, const TValue *t, const char *k) {
 
 
 LUA_API int lua_getglobal (lua_State *L, const char *name) {
-  Table *reg = hvalue(&G(L)->l_registry);
+  Table *reg;
   lua_lock(L);
+  reg = hvalue(&G(L)->l_registry);
   return auxgetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
 }
 
@@ -804,8 +811,9 @@ static void auxsetstr (lua_State *L, const TValue *t, const char *k) {
 
 
 LUA_API void lua_setglobal (lua_State *L, const char *name) {
-  Table *reg = hvalue(&G(L)->l_registry);
+  Table *reg;
   lua_lock(L);  /* unlock done in 'auxsetstr' */
+  reg = hvalue(&G(L)->l_registry);
   auxsetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
 }
 
@@ -1093,8 +1101,9 @@ LUA_API int lua_status (lua_State *L) {
 LUA_API int lua_gc (lua_State *L, int what, ...) {
   va_list argp;
   int res = 0;
-  global_State *g = G(L);
+  global_State *g;
   lua_lock(L);
+  g = G(L);
   va_start(argp, what);
   switch (what) {
     case LUA_GCSTOP: {
@@ -1194,9 +1203,15 @@ LUA_API int lua_gc (lua_State *L, int what, ...) {
 
 
 LUA_API int lua_error (lua_State *L) {
+  TValue *errobj;
   lua_lock(L);
+  errobj = s2v(L->top - 1);
   api_checknelems(L, 1);
-  luaG_errormsg(L);
+  /* error object is the memory error message? */
+  if (ttisshrstring(errobj) && eqshrstr(tsvalue(errobj), G(L)->memerrmsg))
+    luaM_error(L);  /* raise a memory error */
+  else
+    luaG_errormsg(L);  /* raise a regular error */
   /* code unreachable; will unlock when control actually leaves the kernel */
   return 0;  /* to avoid warnings */
 }
@@ -1238,14 +1253,12 @@ 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 >= 2) {
+  if (n > 0)
     luaV_concat(L, n);
-  }
-  else if (n == 0) {  /* push empty string */
-    setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));
+  else {  /* nothing to concatenate */
+    setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));  /* push empty string */
     api_incr_top(L);
   }
-  /* else n == 1; nothing to do */
   luaC_checkGC(L);
   lua_unlock(L);
 }
@@ -1370,13 +1383,16 @@ LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
 
 
 static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
+  static const UpVal *const nullup = NULL;
   LClosure *f;
   TValue *fi = index2value(L, fidx);
   api_check(L, ttisLclosure(fi), "Lua function expected");
   f = clLvalue(fi);
-  api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index");
   if (pf) *pf = f;
-  return &f->upvals[n - 1];  /* get its upvalue pointer */
+  if (1 <= n && n <= f->p->sizeupvalues)
+    return &f->upvals[n - 1];  /* get its upvalue pointer */
+  else
+    return (UpVal**)&nullup;
 }
 
 
@@ -1388,11 +1404,14 @@ LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
     }
     case LUA_VCCL: {  /* C closure */
       CClosure *f = clCvalue(fi);
-      api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index");
-      return &f->upvalue[n - 1];
-    }
+      if (1 <= n && n <= f->nupvalues)
+        return &f->upvalue[n - 1];
+      /* else */
+    }  /* FALLTHROUGH */
+    case LUA_VLCF:
+      return NULL;  /* light C functions have no upvalues */
     default: {
-      api_check(L, 0, "closure expected");
+      api_check(L, 0, "function expected");
       return NULL;
     }
   }
@@ -1404,6 +1423,7 @@ LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,
   LClosure *f1;
   UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
   UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
+  api_check(L, *up1 != NULL && *up2 != NULL, "invalid upvalue index");
   *up1 = *up2;
   luaC_objbarrier(L, f1, *up1);
 }

lauxlib.c

@@ -283,10 +283,10 @@ LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {
 
 
 LUALIB_API int luaL_execresult (lua_State *L, int stat) {
-  const char *what = "exit";  /* type of termination */
   if (stat != 0 && errno != 0)  /* error with an 'errno'? */
     return luaL_fileresult(L, 0, NULL);
   else {
+    const char *what = "exit";  /* type of termination */
     l_inspectstat(stat, what);  /* interpret result */
     if (*what == 'e' && stat == 0)  /* successful termination? */
       lua_pushboolean(L, 1);
@@ -475,8 +475,10 @@ static void *resizebox (lua_State *L, int idx, size_t newsize) {
   lua_Alloc allocf = lua_getallocf(L, &ud);
   UBox *box = (UBox *)lua_touserdata(L, idx);
   void *temp = allocf(ud, box->box, box->bsize, newsize);
-  if (temp == NULL && newsize > 0)  /* allocation error? */
-    luaL_error(L, "not enough memory");
+  if (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;
@@ -1004,43 +1006,67 @@ static int panic (lua_State *L) {
 
 
 /*
-** Emit a warning. '*warnstate' means:
-** 0 - warning system is off;
-** 1 - ready to start a new message;
-** 2 - previous message is to be continued.
+** Warning functions:
+** warnfoff: warning system is off
+** warnfon: ready to start a new message
+** warnfcont: previous message is to be continued
 */
-static void warnf (void *ud, const char *message, int tocont) {
-  int *warnstate = (int *)ud;
-  if (*warnstate != 2 && !tocont && *message == '@') {  /* control message? */
-    if (strcmp(message, "@off") == 0)
-      *warnstate = 0;
-    else if (strcmp(message, "@on") == 0)
-      *warnstate = 1;
-    return;
+static void warnfoff (void *ud, const char *message, int tocont);
+static void warnfon (void *ud, const char *message, int tocont);
+static void warnfcont (void *ud, const char *message, int tocont);
+
+
+/*
+** Check whether message is a control message. If so, execute the
+** control or ignore it if unknown.
+*/
+static int checkcontrol (lua_State *L, const char *message, int tocont) {
+  if (tocont || *(message++) != '@')  /* not a control message? */
+    return 0;
+  else {
+    if (strcmp(message, "off") == 0)
+      lua_setwarnf(L, warnfoff, L);  /* turn warnings off */
+    else if (strcmp(message, "on") == 0)
+      lua_setwarnf(L, warnfon, L);   /* turn warnings on */
+    return 1;  /* it was a control message */
   }
-  else if (*warnstate == 0)  /* warnings off? */
-    return;
-  if (*warnstate == 1)  /* previous message was the last? */
-    lua_writestringerror("%s", "Lua warning: ");  /* start a new warning */
+}
+
+
+static void warnfoff (void *ud, const char *message, int tocont) {
+  checkcontrol((lua_State *)ud, message, tocont);
+}
+
+
+/*
+** Writes the message and handle 'tocont', finishing the message
+** if needed and setting the next warn function.
+*/
+static void warnfcont (void *ud, const char *message, int tocont) {
+  lua_State *L = (lua_State *)ud;
   lua_writestringerror("%s", message);  /* write message */
   if (tocont)  /* not the last part? */
-    *warnstate = 2;  /* to be continued */
+    lua_setwarnf(L, warnfcont, L);  /* to be continued */
   else {  /* last part */
     lua_writestringerror("%s", "\n");  /* finish message with end-of-line */
-    *warnstate = 1;  /* ready to start a new message */
+    lua_setwarnf(L, warnfon, L);  /* next call is a new message */
   }
 }
 
 
+static void warnfon (void *ud, const char *message, int tocont) {
+  if (checkcontrol((lua_State *)ud, message, tocont))  /* control message? */
+    return;  /* nothing else to be done */
+  lua_writestringerror("%s", "Lua warning: ");  /* start a new warning */
+  warnfcont(ud, message, tocont);  /* finish processing */
+}
+
+
 LUALIB_API lua_State *luaL_newstate (void) {
   lua_State *L = lua_newstate(l_alloc, NULL);
   if (L) {
-    int *warnstate;  /* space for warning state */
     lua_atpanic(L, &panic);
-    warnstate = (int *)lua_newuserdatauv(L, sizeof(int), 0);
-    luaL_ref(L, LUA_REGISTRYINDEX);  /* make sure it won't be collected */
-    *warnstate = 0;  /* default is warnings off */
-    lua_setwarnf(L, warnf, warnstate);
+    lua_setwarnf(L, warnfoff, L);  /* default is warnings off */
   }
   return L;
 }

lcode.c

@@ -753,7 +753,7 @@ void luaK_setoneret (FuncState *fs, expdesc *e) {
 
 
 /*
-** Ensure that expression 'e' is not a variable (nor a constant).
+** Ensure that expression 'e' is not a variable (nor a <const>).
 ** (Expression still may have jump lists.)
 */
 void luaK_dischargevars (FuncState *fs, expdesc *e) {
@@ -805,8 +805,8 @@ void luaK_dischargevars (FuncState *fs, expdesc *e) {
 
 
 /*
-** Ensures expression value is in register 'reg' (and therefore
-** 'e' will become a non-relocatable expression).
+** Ensure expression value is in register 'reg', making 'e' a
+** non-relocatable expression.
 ** (Expression still may have jump lists.)
 */
 static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
@@ -860,7 +860,8 @@ static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
 
 
 /*
-** Ensures expression value is in any register.
+** Ensure expression value is in a register, making 'e' a
+** non-relocatable expression.
 ** (Expression still may have jump lists.)
 */
 static void discharge2anyreg (FuncState *fs, expdesc *e) {
@@ -946,8 +947,11 @@ int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
       exp2reg(fs, e, e->u.info);  /* put final result in it */
       return e->u.info;
     }
+    /* else expression has jumps and cannot change its register
+       to hold the jump values, because it is a local variable.
+       Go through to the default case. */
   }
-  luaK_exp2nextreg(fs, e);  /* otherwise, use next available register */
+  luaK_exp2nextreg(fs, e);  /* default: use next available register */
   return e->u.info;
 }
 

lcorolib.c

@@ -73,11 +73,12 @@ static int luaB_coresume (lua_State *L) {
 static int luaB_auxwrap (lua_State *L) {
   lua_State *co = lua_tothread(L, lua_upvalueindex(1));
   int r = auxresume(L, co, lua_gettop(L));
-  if (r < 0) {
+  if (r < 0) {  /* error? */
     int stat = lua_status(co);
-    if (stat != LUA_OK && stat != LUA_YIELD)
-      lua_resetthread(co);  /* close variables in case of errors */
-    if (lua_type(L, -1) == LUA_TSTRING) {  /* error object is a string? */
+    if (stat != LUA_OK && stat != LUA_YIELD)  /* error in the coroutine? */
+      lua_resetthread(co);  /* close its tbc variables */
+    if (stat != LUA_ERRMEM &&  /* not a memory error and ... */
+        lua_type(L, -1) == LUA_TSTRING) {  /* ... error object is a string? */
       luaL_where(L, 1);  /* add extra info, if available */
       lua_insert(L, -2);
       lua_concat(L, 2);

lctype.h

@@ -13,7 +13,7 @@
 /*
 ** WARNING: the functions defined here do not necessarily correspond
 ** to the similar functions in the standard C ctype.h. They are
-** optimized for the specific needs of Lua
+** optimized for the specific needs of Lua.
 */
 
 #if !defined(LUA_USE_CTYPE)
@@ -61,13 +61,19 @@
 #define lisprint(c)	testprop(c, MASK(PRINTBIT))
 #define lisxdigit(c)	testprop(c, MASK(XDIGITBIT))
 
+
 /*
-** this 'ltolower' only works for alphabetic characters
+** In ASCII, this 'ltolower' is correct for alphabetic characters and
+** for '.'. That is enough for Lua needs. ('check_exp' ensures that
+** the character either is an upper-case letter or is unchanged by
+** the transformation, which holds for lower-case letters and '.'.)
 */
-#define ltolower(c)	((c) | ('A' ^ 'a'))
+#define ltolower(c)  \
+  check_exp(('A' <= (c) && (c) <= 'Z') || (c) == ((c) | ('A' ^ 'a')),  \
+            (c) | ('A' ^ 'a'))
 
 
-/* two more entries for 0 and -1 (EOZ) */
+/* one entry for each character and for -1 (EOZ) */
 LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
 
 

ldblib.c

@@ -281,25 +281,33 @@ static int db_setupvalue (lua_State *L) {
 ** Check whether a given upvalue from a given closure exists and
 ** returns its index
 */
-static int checkupval (lua_State *L, int argf, int argnup) {
+static void *checkupval (lua_State *L, int argf, int argnup, int *pnup) {
+  void *id;
   int nup = (int)luaL_checkinteger(L, argnup);  /* upvalue index */
   luaL_checktype(L, argf, LUA_TFUNCTION);  /* closure */
-  luaL_argcheck(L, (lua_getupvalue(L, argf, nup) != NULL), argnup,
-                   "invalid upvalue index");
-  return nup;
+  id = lua_upvalueid(L, argf, nup);
+  if (pnup) {
+    luaL_argcheck(L, id != NULL, argnup, "invalid upvalue index");
+    *pnup = nup;
+  }
+  return id;
 }
 
 
 static int db_upvalueid (lua_State *L) {
-  int n = checkupval(L, 1, 2);
-  lua_pushlightuserdata(L, lua_upvalueid(L, 1, n));
+  void *id = checkupval(L, 1, 2, NULL);
+  if (id != NULL)
+    lua_pushlightuserdata(L, id);
+  else
+    luaL_pushfail(L);
   return 1;
 }
 
 
 static int db_upvaluejoin (lua_State *L) {
-  int n1 = checkupval(L, 1, 2);
-  int n2 = checkupval(L, 3, 4);
+  int n1, n2;
+  checkupval(L, 1, 2, &n1);
+  checkupval(L, 3, 4, &n2);
   luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
   luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
   lua_upvaluejoin(L, 1, n1, 3, n2);
@@ -440,10 +448,7 @@ 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);
-  if (res == 0)
-    lua_pushboolean(L, 0);
-  else
-    lua_pushinteger(L, res);
+  lua_pushinteger(L, res);
   return 1;
 }
 

ldebug.c

@@ -33,10 +33,8 @@
 
 #define noLuaClosure(f)		((f) == NULL || (f)->c.tt == LUA_VCCL)
 
-
-/* Active Lua function (given call info) */
-#define ci_func(ci)		(clLvalue(s2v((ci)->func)))
-
+/* inverse of 'pcRel' */
+#define invpcRel(pc, p)		((p)->code + (pc) + 1)
 
 static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
                                     const char **name);
@@ -127,20 +125,18 @@ static void settraps (CallInfo *ci) {
 /*
 ** This function can be called during a signal, under "reasonable"
 ** assumptions.
-** Fields 'oldpc', 'basehookcount', and 'hookcount' (set by
-** 'resethookcount') are for debug only, and it is no problem if they
-** get arbitrary values (causes at most one wrong hook call). 'hookmask'
-** is an atomic value. We assume that pointers are atomic too (e.g., gcc
-** ensures that for all platforms where it runs). Moreover, 'hook' is
-** always checked before being called (see 'luaD_hook').
+** Fields 'basehookcount' and 'hookcount' (set by 'resethookcount')
+** are for debug only, and it is no problem if they get arbitrary
+** values (causes at most one wrong hook call). 'hookmask' is an atomic
+** value. We assume that pointers are atomic too (e.g., gcc ensures that
+** for all platforms where it runs). Moreover, 'hook' is always checked
+** before being called (see 'luaD_hook').
 */
 LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
   if (func == NULL || mask == 0) {  /* turn off hooks? */
     mask = 0;
     func = NULL;
   }
-  if (isLua(L->ci))
-    L->oldpc = L->ci->u.l.savedpc;
   L->hook = func;
   L->basehookcount = count;
   resethookcount(L);
@@ -192,8 +188,8 @@ 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->is_vararg) {
     int nextra = ci->u.l.nextraargs;
-    if (n <= nextra) {
-      *pos = ci->func - nextra + (n - 1);
+    if (n >= -nextra) {  /* 'n' is negative */
+      *pos = ci->func - nextra - (n + 1);
       return "(vararg)";  /* generic name for any vararg */
     }
   }
@@ -206,7 +202,7 @@ const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
   const char *name = NULL;
   if (isLua(ci)) {
     if (n < 0)  /* access to vararg values? */
-      return findvararg(ci, -n, pos);
+      return findvararg(ci, n, pos);
     else
       name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
   }
@@ -787,18 +783,34 @@ l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
 ** previous instruction 'oldpc'.
 */
 static int changedline (const Proto *p, int oldpc, int newpc) {
+  if (p->lineinfo == NULL)  /* no debug information? */
+    return 0;
   while (oldpc++ < newpc) {
     if (p->lineinfo[oldpc] != 0)
       return (luaG_getfuncline(p, oldpc - 1) != luaG_getfuncline(p, newpc));
   }
-  return 0;  /* no line changes in the way */
+  return 0;  /* no line changes between positions */
 }
 
 
+/*
+** Traces the execution of a Lua function. Called before the execution
+** of each opcode, when debug is on. 'L->oldpc' stores the last
+** instruction traced, to detect line changes. When entering a new
+** function, 'npci' will be zero and will test as a new line without
+** the need for 'oldpc'; so, 'oldpc' does not need to be initialized
+** before. Some exceptional conditions may return to a function without
+** updating 'oldpc'. In that case, 'oldpc' may be invalid; if so, it is
+** reset to zero.  (A wrong but valid 'oldpc' at most causes an extra
+** call to a line hook.)
+*/
 int luaG_traceexec (lua_State *L, const Instruction *pc) {
   CallInfo *ci = L->ci;
   lu_byte mask = L->hookmask;
+  const Proto *p = ci_func(ci)->p;
   int counthook;
+  /* 'L->oldpc' may be invalid; reset it in this case */
+  int oldpc = (L->oldpc < p->sizecode) ? L->oldpc : 0;
   if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) {  /* no hooks? */
     ci->u.l.trap = 0;  /* don't need to stop again */
     return 0;  /* turn off 'trap' */
@@ -819,15 +831,14 @@ int luaG_traceexec (lua_State *L, const Instruction *pc) {
   if (counthook)
     luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0);  /* call count hook */
   if (mask & LUA_MASKLINE) {
-    const Proto *p = ci_func(ci)->p;
     int npci = pcRel(pc, p);
     if (npci == 0 ||  /* call linehook when enter a new function, */
-        pc <= L->oldpc ||  /* when jump back (loop), or when */
-        changedline(p, pcRel(L->oldpc, p), npci)) {  /* enter new line */
+        pc <= invpcRel(oldpc, p) ||  /* when jump back (loop), or when */
+        changedline(p, oldpc, npci)) {  /* enter new line */
       int newline = luaG_getfuncline(p, npci);
       luaD_hook(L, LUA_HOOKLINE, newline, 0, 0);  /* call line hook */
     }
-    L->oldpc = pc;  /* 'pc' of last call to line hook */
+    L->oldpc = npci;  /* 'pc' of last call to line hook */
   }
   if (L->status == LUA_YIELD) {  /* did hook yield? */
     if (counthook)

ldebug.h

@@ -13,6 +13,11 @@
 
 #define pcRel(pc, p)	(cast_int((pc) - (p)->code) - 1)
 
+
+/* Active Lua function (given call info) */
+#define ci_func(ci)		(clLvalue(s2v((ci)->func)))
+
+
 #define resethookcount(L)	(L->hookcount = L->basehookcount)
 
 /*

ldo.c

@@ -139,8 +139,7 @@ l_noret luaD_throw (lua_State *L, int errcode) {
 
 
 int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
-  global_State *g = G(L);
-  l_uint32 oldnCcalls = g->Cstacklimit - (L->nCcalls + L->nci);
+  l_uint32 oldnCcalls = L->nCcalls;
   struct lua_longjmp lj;
   lj.status = LUA_OK;
   lj.previous = L->errorJmp;  /* chain new error handler */
@@ -149,7 +148,7 @@ int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
     (*f)(L, ud);
   );
   L->errorJmp = lj.previous;  /* restore old error handler */
-  L->nCcalls = g->Cstacklimit - oldnCcalls - L->nci;
+  L->nCcalls = oldnCcalls;
   return lj.status;
 }
 
@@ -183,21 +182,20 @@ static void correctstack (lua_State *L, StkId oldstack, StkId newstack) {
 
 
 int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
-  int lim = L->stacksize;
-  StkId newstack = luaM_reallocvector(L, L->stack, lim, newsize, StackValue);
+  int lim = stacksize(L);
+  StkId newstack = luaM_reallocvector(L, L->stack,
+                      lim + EXTRA_STACK, newsize + EXTRA_STACK, StackValue);
   lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);
-  lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK);
   if (unlikely(newstack == NULL)) {  /* reallocation failed? */
     if (raiseerror)
       luaM_error(L);
     else return 0;  /* do not raise an error */
   }
   for (; lim < newsize; lim++)
-    setnilvalue(s2v(newstack + lim)); /* erase new segment */
+    setnilvalue(s2v(newstack + lim + EXTRA_STACK)); /* erase new segment */
   correctstack(L, L->stack, newstack);
   L->stack = newstack;
-  L->stacksize = newsize;
-  L->stack_last = L->stack + newsize - EXTRA_STACK;
+  L->stack_last = L->stack + newsize;
   return 1;
 }
 
@@ -207,52 +205,73 @@ int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
 ** is true, raises any error; otherwise, return 0 in case of errors.
 */
 int luaD_growstack (lua_State *L, int n, int raiseerror) {
-  int size = L->stacksize;
-  int newsize = 2 * size;  /* tentative new size */
-  if (unlikely(size > LUAI_MAXSTACK)) {  /* need more space after extra size? */
+  int size = stacksize(L);
+  if (unlikely(size > LUAI_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 */
-    else return 0;
+    return 0;  /* if not 'raiseerror', just signal it */
   }
   else {
-    int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK;
+    int newsize = 2 * size;  /* tentative new size */
+    int needed = cast_int(L->top - L->stack) + n;
     if (newsize > LUAI_MAXSTACK)  /* cannot cross the limit */
       newsize = LUAI_MAXSTACK;
     if (newsize < needed)  /* but must respect what was asked for */
       newsize = needed;
-    if (unlikely(newsize > LUAI_MAXSTACK)) {  /* stack overflow? */
+    if (likely(newsize <= LUAI_MAXSTACK))
+      return luaD_reallocstack(L, newsize, raiseerror);
+    else {  /* stack overflow */
       /* add extra size to be able to handle the error message */
       luaD_reallocstack(L, ERRORSTACKSIZE, raiseerror);
       if (raiseerror)
         luaG_runerror(L, "stack overflow");
-      else return 0;
+      return 0;
     }
-  }  /* else no errors */
-  return luaD_reallocstack(L, newsize, raiseerror);
+  }
 }
 
 
 static int stackinuse (lua_State *L) {
   CallInfo *ci;
+  int res;
   StkId lim = L->top;
   for (ci = L->ci; ci != NULL; ci = ci->previous) {
     if (lim < ci->top) lim = ci->top;
   }
   lua_assert(lim <= L->stack_last);
-  return cast_int(lim - L->stack) + 1;  /* part of stack in use */
+  res = cast_int(lim - L->stack) + 1;  /* part of stack in use */
+  if (res < LUA_MINSTACK)
+    res = LUA_MINSTACK;  /* ensure a minimum size */
+  return res;
 }
 
 
+/*
+** If stack size is more than 3 times the current use, reduce that size
+** 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
+** 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 goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK;
-  if (goodsize > LUAI_MAXSTACK)
-    goodsize = LUAI_MAXSTACK;  /* respect stack limit */
+  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;
+  }
   /* if thread is currently not handling a stack overflow and its
-     good size is smaller than current size, shrink its stack */
-  if (inuse <= (LUAI_MAXSTACK - EXTRA_STACK) &&
-      goodsize < L->stacksize)
-    luaD_reallocstack(L, goodsize, 0);  /* ok if that fails */
+     size is larger than maximum "reasonable" size, shrink it */
+  if (inuse <= LUAI_MAXSTACK && stacksize(L) > max)
+    luaD_reallocstack(L, nsize, 0);  /* ok if that fails */
   else  /* don't change stack */
     condmovestack(L,{},{});  /* (change only for debugging) */
   luaE_shrinkCI(L);  /* shrink CI list */
@@ -328,7 +347,7 @@ static StkId rethook (lua_State *L, CallInfo *ci, StkId firstres, int nres) {
   ptrdiff_t oldtop = savestack(L, L->top);  /* hook may change top */
   int delta = 0;
   if (isLuacode(ci)) {
-    Proto *p = clLvalue(s2v(ci->func))->p;
+    Proto *p = ci_func(ci)->p;
     if (p->is_vararg)
       delta = ci->u.l.nextraargs + p->numparams + 1;
     if (L->top < ci->top)
@@ -341,15 +360,15 @@ static StkId rethook (lua_State *L, CallInfo *ci, StkId firstres, int nres) {
     luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres);  /* call it */
     ci->func -= delta;
   }
-  if (isLua(ci->previous))
-    L->oldpc = ci->previous->u.l.savedpc;  /* update 'oldpc' */
+  if (isLua(ci = ci->previous))
+    L->oldpc = pcRel(ci->u.l.savedpc, ci_func(ci)->p);  /* update 'oldpc' */
   return restorestack(L, oldtop);
 }
 
 
 /*
 ** Check whether 'func' has a '__call' metafield. If so, put it in the
-** stack, below original 'func', so that 'luaD_call' can call it. Raise
+** stack, below original 'func', so that 'luaD_precall' can call it. Raise
 ** an error if there is no '__call' metafield.
 */
 void luaD_tryfuncTM (lua_State *L, StkId func) {
@@ -450,12 +469,14 @@ void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int narg1) {
 
 
 /*
-** Call a function (C or Lua). The function to be called is at *func.
-** The arguments are on the stack, right after the function.
-** When returns, all the results are on the stack, starting at the original
-** function position.
+** Prepares the call to a function (C or Lua). For C functions, also do
+** the call. The function to be called is at '*func'.  The arguments
+** are on the stack, right after the function.  Returns the CallInfo
+** to be executed, if it was a Lua function. Otherwise (a C function)
+** returns NULL, with all the results on the stack, starting at the
+** original function position.
 */
-void luaD_call (lua_State *L, StkId func, int nresults) {
+CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) {
   lua_CFunction f;
  retry:
   switch (ttypetag(s2v(func))) {
@@ -466,13 +487,13 @@ void luaD_call (lua_State *L, StkId func, int nresults) {
       f = fvalue(s2v(func));
      Cfunc: {
       int n;  /* number of returns */
-      CallInfo *ci = next_ci(L);
-      checkstackp(L, LUA_MINSTACK, func);  /* ensure minimum stack size */
+      CallInfo *ci;
+      checkstackGCp(L, LUA_MINSTACK, func);  /* ensure minimum stack size */
+      L->ci = ci = next_ci(L);
       ci->nresults = nresults;
       ci->callstatus = CIST_C;
       ci->top = L->top + LUA_MINSTACK;
       ci->func = func;
-      L->ci = ci;
       lua_assert(ci->top <= L->stack_last);
       if (L->hookmask & LUA_MASKCALL) {
         int narg = cast_int(L->top - func) - 1;
@@ -483,29 +504,28 @@ void luaD_call (lua_State *L, StkId func, int nresults) {
       lua_lock(L);
       api_checknelems(L, n);
       luaD_poscall(L, ci, n);
-      break;
+      return NULL;
     }
     case LUA_VLCL: {  /* Lua function */
-      CallInfo *ci = next_ci(L);
+      CallInfo *ci;
       Proto *p = clLvalue(s2v(func))->p;
       int narg = cast_int(L->top - func) - 1;  /* number of real arguments */
       int nfixparams = p->numparams;
       int fsize = p->maxstacksize;  /* frame size */
-      checkstackp(L, fsize, func);
+      checkstackGCp(L, fsize, func);
+      L->ci = ci = next_ci(L);
       ci->nresults = nresults;
       ci->u.l.savedpc = p->code;  /* starting point */
-      ci->callstatus = 0;
       ci->top = func + 1 + fsize;
       ci->func = func;
       L->ci = ci;
       for (; narg < nfixparams; narg++)
         setnilvalue(s2v(L->top++));  /* complete missing arguments */
       lua_assert(ci->top <= L->stack_last);
-      luaV_execute(L, ci);  /* run the function */
-      break;
+      return ci;
     }
     default: {  /* not a function */
-      checkstackp(L, 1, func);  /* space for metamethod */
+      checkstackGCp(L, 1, func);  /* space for metamethod */
       luaD_tryfuncTM(L, func);  /* try to get '__call' metamethod */
       goto retry;  /* try again with metamethod */
     }
@@ -513,18 +533,37 @@ void luaD_call (lua_State *L, StkId func, int nresults) {
 }
 
 
+/*
+** Call a function (C or Lua) through C. 'inc' can be 1 (increment
+** number of recursive invocations in the C stack) or nyci (the same
+** plus increment number of non-yieldable calls).
+*/
+static void ccall (lua_State *L, StkId func, int nResults, int inc) {
+  CallInfo *ci;
+  L->nCcalls += inc;
+  if (unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
+    luaE_checkcstack(L);
+  if ((ci = luaD_precall(L, func, nResults)) != NULL) {  /* Lua function? */
+    ci->callstatus = CIST_FRESH;  /* mark that it is a "fresh" execute */
+    luaV_execute(L, ci);  /* call it */
+  }
+  L->nCcalls -= inc;
+}
+
+
+/*
+** External interface for 'ccall'
+*/
+void luaD_call (lua_State *L, StkId func, int nResults) {
+  ccall(L, func, nResults, 1);
+}
+
+
 /*
 ** Similar to 'luaD_call', but does not allow yields during the call.
-** If there is a stack overflow, freeing all CI structures will
-** force the subsequent call to invoke 'luaE_extendCI', which then
-** will raise any errors.
 */
 void luaD_callnoyield (lua_State *L, StkId func, int nResults) {
-  incXCcalls(L);
-  if (getCcalls(L) <= CSTACKERR)  /* possible stack overflow? */
-    luaE_freeCI(L);
-  luaD_call(L, func, nResults);
-  decXCcalls(L);
+  ccall(L, func, nResults, nyci);
 }
 
 
@@ -602,12 +641,12 @@ static int recover (lua_State *L, int status) {
   if (ci == NULL) return 0;  /* no recovery point */
   /* "finish" luaD_pcall */
   oldtop = restorestack(L, ci->u2.funcidx);
-  luaF_close(L, oldtop, status);  /* may change the stack */
-  oldtop = restorestack(L, ci->u2.funcidx);
-  luaD_seterrorobj(L, status, oldtop);
   L->ci = ci;
   L->allowhook = getoah(ci->callstatus);  /* restore original 'allowhook' */
-  luaD_shrinkstack(L);
+  status = luaF_close(L, oldtop, status);  /* may change the stack */
+  oldtop = restorestack(L, ci->u2.funcidx);
+  luaD_seterrorobj(L, status, oldtop);
+  luaD_shrinkstack(L);   /* restore stack size in case of overflow */
   L->errfunc = ci->u.c.old_errfunc;
   return 1;  /* continue running the coroutine */
 }
@@ -638,12 +677,12 @@ static void resume (lua_State *L, void *ud) {
   int n = *(cast(int*, ud));  /* number of arguments */
   StkId firstArg = L->top - n;  /* first argument */
   CallInfo *ci = L->ci;
-  if (L->status == LUA_OK) {  /* starting a coroutine? */
-    luaD_call(L, firstArg - 1, LUA_MULTRET);
-  }
+  if (L->status == LUA_OK)  /* starting a coroutine? */
+    ccall(L, firstArg - 1, LUA_MULTRET, 1);  /* just call its body */
   else {  /* resuming from previous yield */
     lua_assert(L->status == LUA_YIELD);
     L->status = LUA_OK;  /* mark that it is running (again) */
+    luaE_incCstack(L);  /* control the C stack */
     if (isLua(ci))  /* yielded inside a hook? */
       luaV_execute(L, ci);  /* just continue running Lua code */
     else {  /* 'common' yield */
@@ -671,12 +710,7 @@ LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs,
   }
   else if (L->status != LUA_YIELD)  /* ended with errors? */
     return resume_error(L, "cannot resume dead coroutine", nargs);
-  if (from == NULL)
-    L->nCcalls = CSTACKTHREAD;
-  else  /* correct 'nCcalls' for this thread */
-    L->nCcalls = getCcalls(from) + from->nci - L->nci - CSTACKCF;
-  if (L->nCcalls <= CSTACKERR)
-    return resume_error(L, "C stack overflow", nargs);
+  L->nCcalls = (from) ? getCcalls(from) : 0;
   luai_userstateresume(L, nargs);
   api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
   status = luaD_rawrunprotected(L, resume, &nargs);
@@ -706,9 +740,10 @@ LUA_API int lua_isyieldable (lua_State *L) {
 
 LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx,
                         lua_KFunction k) {
-  CallInfo *ci = L->ci;
+  CallInfo *ci;
   luai_userstateyield(L, nresults);
   lua_lock(L);
+  ci = L->ci;
   api_checknelems(L, nresults);
   if (unlikely(!yieldable(L))) {
     if (L != G(L)->mainthread)
@@ -754,7 +789,7 @@ int luaD_pcall (lua_State *L, Pfunc func, void *u,
     status = luaF_close(L, oldtop, status);
     oldtop = restorestack(L, old_top);  /* previous call may change stack */
     luaD_seterrorobj(L, status, oldtop);
-    luaD_shrinkstack(L);
+    luaD_shrinkstack(L);   /* restore stack size in case of overflow */
   }
   L->errfunc = old_errfunc;
   return status;

ldo.h

@@ -17,6 +17,8 @@
 ** Macro to check stack size and grow stack if needed.  Parameters
 ** 'pre'/'pos' allow the macro to preserve a pointer into the
 ** stack across reallocations, doing the work only when needed.
+** It also allows the running of one GC step when the stack is
+** reallocated.
 ** 'condmovestack' is used in heavy tests to force a stack reallocation
 ** at every check.
 */
@@ -35,7 +37,7 @@
 
 
 /* macro to check stack size, preserving 'p' */
-#define checkstackp(L,n,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 */ \
@@ -44,7 +46,7 @@
 
 /* macro to check stack size and GC */
 #define checkstackGC(L,fsize)  \
-	luaD_checkstackaux(L, (fsize), (void)0, luaC_checkGC(L))
+	luaD_checkstackaux(L, (fsize), luaC_checkGC(L), (void)0)
 
 
 /* type of protected functions, to be ran by 'runprotected' */
@@ -57,6 +59,7 @@ LUAI_FUNC void luaD_hook (lua_State *L, int event, int line,
                                         int fTransfer, int nTransfer);
 LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
 LUAI_FUNC void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int n);
+LUAI_FUNC 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 void luaD_tryfuncTM (lua_State *L, StkId func);

lfunc.c

@@ -53,7 +53,7 @@ void luaF_initupvals (lua_State *L, LClosure *cl) {
     uv->v = &uv->u.value;  /* make it closed */
     setnilvalue(uv->v);
     cl->upvals[i] = uv;
-    luaC_objbarrier(L, cl, o);
+    luaC_objbarrier(L, cl, uv);
   }
 }
 
@@ -234,9 +234,10 @@ int luaF_close (lua_State *L, StkId level, int status) {
     luaF_unlinkupval(uv);
     setobj(L, slot, uv->v);  /* move value to upvalue slot */
     uv->v = slot;  /* now current value lives here */
-    if (!iswhite(uv))
-      gray2black(uv);  /* closed upvalues cannot be gray */
-    luaC_barrier(L, uv, slot);
+    if (!iswhite(uv)) {  /* neither white nor dead? */
+      nw2black(uv);  /* closed upvalues cannot be gray */
+      luaC_barrier(L, uv, slot);
+    }
   }
   return status;
 }

lgc.c

@@ -60,16 +60,24 @@
 #define PAUSEADJ		100
 
 
-/* mask to erase all color bits (plus gen. related stuff) */
-#define maskcolors	(~(bitmask(BLACKBIT) | WHITEBITS | AGEBITS))
+/* mask with all color bits */
+#define maskcolors	(bitmask(BLACKBIT) | WHITEBITS)
+
+/* mask with all GC bits */
+#define maskgcbits      (maskcolors | AGEBITS)
 
 
-/* macro to erase all color bits then sets only the current white bit */
+/* macro to erase all color bits then set only the current white bit */
 #define makewhite(g,x)	\
- (x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g)))
+  (x->marked = cast_byte((x->marked & ~maskcolors) | luaC_white(g)))
 
-#define white2gray(x)	resetbits(x->marked, WHITEBITS)
-#define black2gray(x)	resetbit(x->marked, BLACKBIT)
+/* make an object gray (neither white nor black) */
+#define set2gray(x)	resetbits(x->marked, maskcolors)
+
+
+/* make an object black (coming from any color) */
+#define set2black(x)  \
+  (x->marked = cast_byte((x->marked & ~WHITEBITS) | bitmask(BLACKBIT)))
 
 
 #define valiswhite(x)   (iscollectable(x) && iswhite(gcvalue(x)))
@@ -77,16 +85,13 @@
 #define keyiswhite(n)   (keyiscollectable(n) && iswhite(gckey(n)))
 
 
-#define checkconsistency(obj)  \
-  lua_longassert(!iscollectable(obj) || righttt(obj))
-
 /*
 ** Protected access to objects in values
 */
 #define gcvalueN(o)     (iscollectable(o) ? gcvalue(o) : NULL)
 
 
-#define markvalue(g,o) { checkconsistency(o); \
+#define markvalue(g,o) { checkliveness(g->mainthread,o); \
   if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
 
 #define markkey(g, n)	{ if keyiswhite(n) reallymarkobject(g,gckey(n)); }
@@ -135,31 +140,38 @@ static GCObject **getgclist (GCObject *o) {
 
 
 /*
-** Link a collectable object 'o' with a known type into list pointed by 'p'.
+** Link a collectable object 'o' with a known type into the list 'p'.
+** (Must be a macro to access the 'gclist' field in different types.)
 */
-#define linkgclist(o,p)	((o)->gclist = (p), (p) = obj2gco(o))
+#define linkgclist(o,p)	linkgclist_(obj2gco(o), &(o)->gclist, &(p))
+
+static void linkgclist_ (GCObject *o, GCObject **pnext, GCObject **list) {
+  lua_assert(!isgray(o));  /* cannot be in a gray list */
+  *pnext = *list;
+  *list = o;
+  set2gray(o);  /* now it is */
+}
 
 
 /*
-** Link a generic collectable object 'o' into list pointed by 'p'.
+** Link a generic collectable object 'o' into the list 'p'.
 */
-#define linkobjgclist(o,p) (*getgclist(o) = (p), (p) = obj2gco(o))
+#define linkobjgclist(o,p) linkgclist_(obj2gco(o), getgclist(o), &(p))
 
 
 
 /*
-** Clear keys for empty entries in tables. If entry is empty
-** and its key is not marked, mark its entry as dead. This allows the
-** collection of the key, but keeps its entry in the table (its removal
-** could break a chain). The main feature of a dead key is that it must
-** be different from any other value, to do not disturb searches.
-** Other places never manipulate dead keys, because its associated empty
-** value is enough to signal that the entry is logically empty.
+** Clear keys for empty entries in tables. If entry is empty, mark its
+** entry as dead. This allows the collection of the key, but keeps its
+** entry in the table: its removal could break a chain and could break
+** a table traversal.  Other places never manipulate dead keys, because
+** its associated empty value is enough to signal that the entry is
+** logically empty.
 */
 static void clearkey (Node *n) {
   lua_assert(isempty(gval(n)));
-  if (keyiswhite(n))
-    setdeadkey(n);  /* unused and unmarked key; remove it */
+  if (keyiscollectable(n))
+    setdeadkey(n);  /* unused key; remove it */
 }
 
 
@@ -181,14 +193,17 @@ static int iscleared (global_State *g, const GCObject *o) {
 
 
 /*
-** barrier that moves collector forward, that is, mark the white object
-** 'v' being pointed by the black object 'o'. (If in sweep phase, clear
-** the black object to white [sweep it] to avoid other barrier calls for
-** this same object.) In the generational mode, 'v' must also become
-** old, if 'o' is old; however, it cannot be changed directly to OLD,
-** because it may still point to non-old objects. So, it is marked as
-** OLD0. In the next cycle it will become OLD1, and in the next it
-** will finally become OLD (regular old).
+** Barrier that moves collector forward, that is, marks the white object
+** 'v' being pointed by the black object 'o'.  In the generational
+** mode, 'v' must also become old, if 'o' is old; however, it cannot
+** be changed directly to OLD, because it may still point to non-old
+** objects. So, it is marked as OLD0. In the next cycle it will become
+** OLD1, and in the next it will finally become OLD (regular old). By
+** then, any object it points to will also be old.  If called in the
+** 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.)
 */
 void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
   global_State *g = G(L);
@@ -202,7 +217,8 @@ void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
   }
   else {  /* sweep phase */
     lua_assert(issweepphase(g));
-    makewhite(g, o);  /* mark main obj. as white to avoid other barriers */
+    if (g->gckind == KGC_INC)  /* incremental mode? */
+      makewhite(g, o);  /* mark 'o' as white to avoid other barriers */
   }
 }
 
@@ -214,18 +230,20 @@ 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));
-  if (getage(o) != G_TOUCHED2)  /* not already in gray list? */
-    linkobjgclist(o, g->grayagain);  /* link it in 'grayagain' */
-  black2gray(o);  /* make object gray (again) */
-  setage(o, G_TOUCHED1);  /* touched in current cycle */
+  lua_assert((g->gckind == KGC_GEN) == (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 */
+    linkobjgclist(o, g->grayagain);
+  if (isold(o))  /* generational mode? */
+    setage(o, G_TOUCHED1);  /* touched in current cycle */
 }
 
 
 void luaC_fix (lua_State *L, GCObject *o) {
   global_State *g = G(L);
   lua_assert(g->allgc == o);  /* object must be 1st in 'allgc' list! */
-  white2gray(o);  /* they will be gray forever */
+  set2gray(o);  /* they will be gray forever */
   setage(o, G_OLD);  /* and old forever */
   g->allgc = o->next;  /* remove object from 'allgc' list */
   o->next = g->fixedgc;  /* link it to 'fixedgc' list */
@@ -259,24 +277,30 @@ GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {
 
 
 /*
-** Mark an object. Userdata, strings, and closed upvalues are visited
-** and turned black here. Other objects are marked gray and added
-** to appropriate list to be visited (and turned black) later. (Open
-** upvalues are already linked in 'headuv' list. They are kept gray
-** to avoid barriers, as their values will be revisited by the thread.)
+** Mark an object.  Userdata with no user values, strings, and closed
+** upvalues are visited and turned black here.  Open upvalues are
+** already indirectly linked through their respective threads in the
+** 'twups' list, so they don't go to the gray list; nevertheless, they
+** are kept gray to avoid barriers, as their values will be revisited
+** by the thread or by 'remarkupvals'.  Other objects are added to the
+** gray list to be visited (and turned black) later.  Both userdata and
+** upvalues can call this function recursively, but this recursion goes
+** for at most two levels: An upvalue cannot refer to another upvalue
+** (only closures can), and a userdata's metatable must be a table.
 */
 static void reallymarkobject (global_State *g, GCObject *o) {
-  white2gray(o);
   switch (o->tt) {
     case LUA_VSHRSTR:
     case LUA_VLNGSTR: {
-      gray2black(o);
+      set2black(o);  /* nothing to visit */
       break;
     }
     case LUA_VUPVAL: {
       UpVal *uv = gco2upv(o);
-      if (!upisopen(uv))  /* open upvalues are kept gray */
-        gray2black(o);
+      if (upisopen(uv))
+        set2gray(uv);  /* open upvalues are kept gray */
+      else
+        set2black(uv);  /* closed upvalues are visited here */
       markvalue(g, uv->v);  /* mark its content */
       break;
     }
@@ -284,14 +308,14 @@ static void reallymarkobject (global_State *g, GCObject *o) {
       Udata *u = gco2u(o);
       if (u->nuvalue == 0) {  /* no user values? */
         markobjectN(g, u->metatable);  /* mark its metatable */
-        gray2black(o);  /* nothing else to mark */
+        set2black(u);  /* nothing else to mark */
         break;
       }
       /* else... */
     }  /* FALLTHROUGH */
     case LUA_VLCL: case LUA_VCCL: case LUA_VTABLE:
     case LUA_VTHREAD: case LUA_VPROTO: {
-      linkobjgclist(o, g->gray);
+      linkobjgclist(o, g->gray);  /* to be visited later */
       break;
     }
     default: lua_assert(0); break;
@@ -324,28 +348,36 @@ static lu_mem markbeingfnz (global_State *g) {
 
 
 /*
-** Mark all values stored in marked open upvalues from non-marked threads.
-** (Values from marked threads were already marked when traversing the
-** thread.) Remove from the list threads that no longer have upvalues and
-** not-marked threads.
+** For each non-marked thread, simulates a barrier between each open
+** upvalue and its value. (If the thread is collected, the value will be
+** assigned to the upvalue, but then it can be too late for the barrier
+** to act. The "barrier" does not need to check colors: A non-marked
+** thread must be young; upvalues cannot be older than their threads; so
+** any visited upvalue must be young too.) Also removes the thread from
+** the list, as it was already visited. Removes also threads with no
+** 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) {
   lua_State *thread;
   lua_State **p = &g->twups;
-  int work = 0;
+  int work = 0;  /* estimate of how much work was done here */
   while ((thread = *p) != NULL) {
     work++;
-    lua_assert(!isblack(thread));  /* threads are never black */
-    if (isgray(thread) && thread->openupval != NULL)
+    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 */
       UpVal *uv;
+      lua_assert(!isold(thread) || thread->openupval == NULL);
       *p = thread->twups;  /* remove thread from the list */
       thread->twups = thread;  /* mark that it is out of list */
       for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
+        lua_assert(getage(uv) <= getage(thread));
         work++;
-        if (!iswhite(uv))  /* upvalue already visited? */
+        if (!iswhite(uv)) {  /* upvalue already visited? */
+          lua_assert(upisopen(uv) && isgray(uv));
           markvalue(g, uv->v);  /* mark its value */
+        }
       }
     }
   }
@@ -353,12 +385,17 @@ static int remarkupvals (global_State *g) {
 }
 
 
+static void cleargraylists (global_State *g) {
+  g->gray = g->grayagain = NULL;
+  g->weak = g->allweak = g->ephemeron = NULL;
+}
+
+
 /*
 ** mark root set and reset all gray lists, to start a new collection
 */
 static void restartcollection (global_State *g) {
-  g->gray = g->grayagain = NULL;
-  g->weak = g->allweak = g->ephemeron = NULL;
+  cleargraylists(g);
   markobject(g, g->mainthread);
   markvalue(g, &g->l_registry);
   markmt(g);
@@ -374,6 +411,26 @@ static void restartcollection (global_State *g) {
 ** =======================================================
 */
 
+
+/*
+** Check whether object 'o' should be kept in the 'grayagain' list for
+** post-processing by 'correctgraylist'. (It could put all old objects
+** in the list and leave all the work to 'correctgraylist', but it is
+** more efficient to avoid adding elements that will be removed.) Only
+** 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.)
+*/
+static void genlink (global_State *g, GCObject *o) {
+  lua_assert(isblack(o));
+  if (getage(o) == G_TOUCHED1) {  /* touched in this cycle? */
+    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 */
+}
+
+
 /*
 ** 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
@@ -410,8 +467,9 @@ static void traverseweakvalue (global_State *g, Table *h) {
 ** the atomic phase, if table has any white->white entry, it has to
 ** be revisited during ephemeron convergence (as that key may turn
 ** black). Otherwise, if it has any white key, table has to be cleared
-** (in the atomic phase). In generational mode, it (like all visited
-** tables) must be kept in some gray list for post-processing.
+** (in the atomic phase). In generational mode, some tables
+** must be kept in some gray list for post-processing; this is done
+** by 'genlink'.
 */
 static int traverseephemeron (global_State *g, Table *h, int inv) {
   int marked = 0;  /* true if an object is marked in this traversal */
@@ -450,10 +508,8 @@ static int traverseephemeron (global_State *g, Table *h, int inv) {
     linkgclist(h, g->ephemeron);  /* have to propagate again */
   else if (hasclears)  /* table has white keys? */
     linkgclist(h, g->allweak);  /* may have to clean white keys */
-  else if (g->gckind == KGC_GEN)
-    linkgclist(h, g->grayagain);  /* keep it in some list */
   else
-    gray2black(h);
+    genlink(g, obj2gco(h));  /* check whether collector still needs to see it */
   return marked;
 }
 
@@ -473,10 +529,7 @@ static void traversestrongtable (global_State *g, Table *h) {
       markvalue(g, gval(n));
     }
   }
-  if (g->gckind == KGC_GEN) {
-    linkgclist(h, g->grayagain);  /* keep it in some gray list */
-    black2gray(h);
-  }
+  genlink(g, obj2gco(h));
 }
 
 
@@ -488,7 +541,6 @@ static lu_mem traversetable (global_State *g, Table *h) {
       (cast_void(weakkey = strchr(svalue(mode), 'k')),
        cast_void(weakvalue = strchr(svalue(mode), 'v')),
        (weakkey || weakvalue))) {  /* is really weak? */
-    black2gray(h);  /* keep table gray */
     if (!weakkey)  /* strong keys? */
       traverseweakvalue(g, h);
     else if (!weakvalue)  /* strong values? */
@@ -507,10 +559,7 @@ static int traverseudata (global_State *g, Udata *u) {
   markobjectN(g, u->metatable);  /* mark its metatable */
   for (i = 0; i < u->nuvalue; i++)
     markvalue(g, &u->uv[i].uv);
-  if (g->gckind == KGC_GEN) {
-    linkgclist(u, g->grayagain);  /* keep it in some gray list */
-    black2gray(u);
-  }
+  genlink(g, obj2gco(u));
   return 1 + u->nuvalue;
 }
 
@@ -559,12 +608,21 @@ static int traverseLclosure (global_State *g, LClosure *cl) {
 
 /*
 ** Traverse a thread, marking the elements in the stack up to its top
-** and cleaning the rest of the stack in the final traversal.
-** That ensures that the entire stack have valid (non-dead) objects.
+** and cleaning the rest of the stack in the final traversal. That
+** ensures that the entire stack have valid (non-dead) objects.
+** Threads have no barriers. In gen. mode, old threads must be visited
+** at every cycle, because they might point to young objects.  In inc.
+** mode, the thread can still be modified before the end of the cycle,
+** and therefore it must be visited again in the atomic phase. To ensure
+** these visits, threads must return to a gray list if they are not new
+** (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) {
   UpVal *uv;
   StkId o = th->stack;
+  if (isold(th) || g->gcstate == GCSpropagate)
+    linkgclist(th, g->grayagain);  /* insert into 'grayagain' list */
   if (o == NULL)
     return 1;  /* stack not completely built yet */
   lua_assert(g->gcstate == GCSatomic ||
@@ -574,9 +632,8 @@ 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? */
-    StkId lim = th->stack + th->stacksize;  /* real end of stack */
-    for (; o < lim; o++)  /* clear not-marked stack slice */
-      setnilvalue(s2v(o));
+    for (; o < th->stack_last + EXTRA_STACK; o++)
+      setnilvalue(s2v(o));  /* clear dead stack slice */
     /* 'remarkupvals' may have removed thread from 'twups' list */
     if (!isintwups(th) && th->openupval != NULL) {
       th->twups = g->twups;  /* link it back to the list */
@@ -585,17 +642,16 @@ static int traversethread (global_State *g, lua_State *th) {
   }
   else if (!g->gcemergency)
     luaD_shrinkstack(th); /* do not change stack in emergency cycle */
-  return 1 + th->stacksize;
+  return 1 + stacksize(th);
 }
 
 
 /*
-** traverse one gray object, turning it to black (except for threads,
-** which are always gray).
+** traverse one gray object, turning it to black.
 */
 static lu_mem propagatemark (global_State *g) {
   GCObject *o = g->gray;
-  gray2black(o);
+  nw2black(o);
   g->gray = *getgclist(o);  /* remove from 'gray' list */
   switch (o->tt) {
     case LUA_VTABLE: return traversetable(g, gco2t(o));
@@ -603,12 +659,7 @@ static lu_mem propagatemark (global_State *g) {
     case LUA_VLCL: return traverseLclosure(g, gco2lcl(o));
     case LUA_VCCL: return traverseCclosure(g, gco2ccl(o));
     case LUA_VPROTO: return traverseproto(g, gco2p(o));
-    case LUA_VTHREAD: {
-      lua_State *th = gco2th(o);
-      linkgclist(th, g->grayagain);  /* insert into 'grayagain' list */
-      black2gray(o);
-      return traversethread(g, th);
-    }
+    case LUA_VTHREAD: return traversethread(g, gco2th(o));
     default: lua_assert(0); return 0;
   }
 }
@@ -638,8 +689,10 @@ static void convergeephemerons (global_State *g) {
     g->ephemeron = NULL;  /* tables may return to this list when traversed */
     changed = 0;
     while ((w = next) != NULL) {  /* for each ephemeron table */
-      next = gco2t(w)->gclist;  /* list is rebuilt during loop */
-      if (traverseephemeron(g, gco2t(w), dir)) {  /* marked some value? */
+      Table *h = gco2t(w);
+      next = h->gclist;  /* list is rebuilt during loop */
+      nw2black(h);  /* out of the list (for now) */
+      if (traverseephemeron(g, h, dir)) {  /* marked some value? */
         propagateall(g);  /* propagate changes */
         changed = 1;  /* will have to revisit all ephemeron tables */
       }
@@ -716,12 +769,16 @@ static void freeobj (lua_State *L, GCObject *o) {
     case LUA_VUPVAL:
       freeupval(L, gco2upv(o));
       break;
-    case LUA_VLCL:
-      luaM_freemem(L, o, sizeLclosure(gco2lcl(o)->nupvalues));
+    case LUA_VLCL: {
+      LClosure *cl = gco2lcl(o);
+      luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));
       break;
-    case LUA_VCCL:
-      luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));
+    }
+    case LUA_VCCL: {
+      CClosure *cl = gco2ccl(o);
+      luaM_freemem(L, cl, sizeCclosure(cl->nupvalues));
       break;
+    }
     case LUA_VTABLE:
       luaH_free(L, gco2t(o));
       break;
@@ -733,13 +790,17 @@ static void freeobj (lua_State *L, GCObject *o) {
       luaM_freemem(L, o, sizeudata(u->nuvalue, u->len));
       break;
     }
-    case LUA_VSHRSTR:
-      luaS_remove(L, gco2ts(o));  /* remove it from hash table */
-      luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen));
+    case LUA_VSHRSTR: {
+      TString *ts = gco2ts(o);
+      luaS_remove(L, ts);  /* remove it from hash table */
+      luaM_freemem(L, ts, sizelstring(ts->shrlen));
       break;
-    case LUA_VLNGSTR:
-      luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen));
+    }
+    case LUA_VLNGSTR: {
+      TString *ts = gco2ts(o);
+      luaM_freemem(L, ts, sizelstring(ts->u.lnglen));
       break;
+    }
     default: lua_assert(0);
   }
 }
@@ -766,7 +827,7 @@ static GCObject **sweeplist (lua_State *L, GCObject **p, int countin,
       freeobj(L, curr);  /* erase 'curr' */
     }
     else {  /* change mark to 'white' */
-      curr->marked = cast_byte((marked & maskcolors) | white);
+      curr->marked = cast_byte((marked & ~maskgcbits) | white);
       p = &curr->next;  /* go to next element */
     }
   }
@@ -823,6 +884,8 @@ static GCObject *udata2finalize (global_State *g) {
   resetbit(o->marked, FINALIZEDBIT);  /* object is "normal" again */
   if (issweepphase(g))
     makewhite(g, o);  /* "sweep" object */
+  else if (getage(o) == G_OLD1)
+    g->firstold1 = o;  /* it is the first OLD1 object in the list */
   return o;
 }
 
@@ -896,15 +959,15 @@ static GCObject **findlast (GCObject **p) {
 /*
 ** Move all unreachable objects (or 'all' objects) that need
 ** finalization from list 'finobj' to list 'tobefnz' (to be finalized).
-** (Note that objects after 'finobjold' cannot be white, so they
-** don't need to be traversed. In incremental mode, 'finobjold' is NULL,
+** (Note that objects after 'finobjold1' cannot be white, so they
+** don't need to be traversed. In incremental mode, 'finobjold1' is NULL,
 ** so the whole list is traversed.)
 */
 static void separatetobefnz (global_State *g, int all) {
   GCObject *curr;
   GCObject **p = &g->finobj;
   GCObject **lastnext = findlast(&g->tobefnz);
-  while ((curr = *p) != g->finobjold) {  /* traverse all finalizable objects */
+  while ((curr = *p) != g->finobjold1) {  /* traverse all finalizable objects */
     lua_assert(tofinalize(curr));
     if (!(iswhite(curr) || all))  /* not being collected? */
       p = &curr->next;  /* don't bother with it */
@@ -920,6 +983,27 @@ static void separatetobefnz (global_State *g, int all) {
 }
 
 
+/*
+** If pointer 'p' points to 'o', move it to the next element.
+*/
+static void checkpointer (GCObject **p, GCObject *o) {
+  if (o == *p)
+    *p = o->next;
+}
+
+
+/*
+** Correct pointers to objects inside 'allgc' list when
+** object 'o' is being removed from the list.
+*/
+static void correctpointers (global_State *g, GCObject *o) {
+  checkpointer(&g->survival, o);
+  checkpointer(&g->old1, o);
+  checkpointer(&g->reallyold, o);
+  checkpointer(&g->firstold1, o);
+}
+
+
 /*
 ** if object 'o' has a finalizer, remove it from 'allgc' list (must
 ** search the list to find it) and link it in 'finobj' list.
@@ -936,14 +1020,8 @@ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
       if (g->sweepgc == &o->next)  /* should not remove 'sweepgc' object */
         g->sweepgc = sweeptolive(L, g->sweepgc);  /* change 'sweepgc' */
     }
-    else {  /* correct pointers into 'allgc' list, if needed */
-      if (o == g->survival)
-        g->survival = o->next;
-      if (o == g->old)
-        g->old = o->next;
-      if (o == g->reallyold)
-        g->reallyold = o->next;
-    }
+    else
+      correctpointers(g, o);
     /* search for pointer pointing to 'o' */
     for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
     *p = o->next;  /* remove 'o' from 'allgc' list */
@@ -965,24 +1043,31 @@ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
 static void setpause (global_State *g);
 
 
-/* mask to erase all color bits, not changing gen-related stuff */
-#define maskgencolors	(~(bitmask(BLACKBIT) | WHITEBITS))
-
-
 /*
-** Sweep a list of objects, deleting dead ones and turning
-** the non dead to old (without changing their colors).
+** Sweep a list of objects to enter generational mode.  Deletes dead
+** objects and turns the non dead to old. All non-dead threads---which
+** are now old---must be in a gray list. Everything else is not in a
+** gray list. Open upvalues are also kept gray.
 */
 static void sweep2old (lua_State *L, GCObject **p) {
   GCObject *curr;
+  global_State *g = G(L);
   while ((curr = *p) != NULL) {
     if (iswhite(curr)) {  /* is 'curr' dead? */
-      lua_assert(isdead(G(L), curr));
+      lua_assert(isdead(g, curr));
       *p = curr->next;  /* remove 'curr' from list */
       freeobj(L, curr);  /* erase 'curr' */
     }
     else {  /* all surviving objects become old */
       setage(curr, G_OLD);
+      if (curr->tt == LUA_VTHREAD) {  /* threads must be watched */
+        lua_State *th = gco2th(curr);
+        linkgclist(th, g->grayagain);  /* insert into 'grayagain' list */
+      }
+      else if (curr->tt == LUA_VUPVAL && upisopen(gco2upv(curr)))
+        set2gray(curr);  /* open upvalues are always gray */
+      else  /* everything else is black */
+        nw2black(curr);
       p = &curr->next;  /* go to next element */
     }
   }
@@ -995,9 +1080,13 @@ static void sweep2old (lua_State *L, GCObject **p) {
 ** during the sweep. So, any white object must be dead.) For
 ** non-dead objects, advance their ages and clear the color of
 ** new objects. (Old objects keep their colors.)
+** The ages of G_TOUCHED1 and G_TOUCHED2 objects cannot be advanced
+** here, because these old-generation objects are usually not swept
+** here.  They will all be advanced in 'correctgraylist'. That function
+** 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 *limit, GCObject **pfirstold1) {
   static const lu_byte nextage[] = {
     G_SURVIVAL,  /* from G_NEW */
     G_OLD1,      /* from G_SURVIVAL */
@@ -1016,9 +1105,15 @@ 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)
-        curr->marked = cast_byte((curr->marked & maskgencolors) | white);
-      setage(curr, nextage[getage(curr)]);
+      if (getage(curr) == 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 */
+      }
       p = &curr->next;  /* go to next element */
     }
   }
@@ -1028,58 +1123,50 @@ static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
 
 /*
 ** Traverse a list making all its elements white and clearing their
-** age.
+** 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 & maskcolors) | white);
+    p->marked = cast_byte((p->marked & ~maskgcbits) | white);
 }
 
 
 /*
-** Correct a list of gray objects.
+** Correct a list of gray objects. Return pointer to where rest of the
+** list should be linked.
 ** Because this correction is done after sweeping, young objects might
 ** be turned white and still be in the list. They are only removed.
-** For tables and userdata, advance 'touched1' to 'touched2'; 'touched2'
-** objects become regular old and are removed from the list.
-** For threads, just remove white ones from the list.
+** '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.
 */
 static GCObject **correctgraylist (GCObject **p) {
   GCObject *curr;
   while ((curr = *p) != NULL) {
-    switch (curr->tt) {
-      case LUA_VTABLE: case LUA_VUSERDATA: {
-        GCObject **next = getgclist(curr);
-        if (getage(curr) == G_TOUCHED1) {  /* touched in this cycle? */
-          lua_assert(isgray(curr));
-          gray2black(curr);  /* make it black, for next barrier */
-          changeage(curr, G_TOUCHED1, G_TOUCHED2);
-          p = next;  /* go to next element */
-        }
-        else {  /* not touched in this cycle */
-          if (!iswhite(curr)) {  /* not white? */
-            lua_assert(isold(curr));
-            if (getage(curr) == G_TOUCHED2)  /* advance from G_TOUCHED2... */
-              changeage(curr, G_TOUCHED2, G_OLD);  /* ... to G_OLD */
-            gray2black(curr);  /* make it black */
-          }
-          /* else, object is white: just remove it from this list */
-          *p = *next;  /* remove 'curr' from gray list */
-        }
-        break;
-      }
-      case LUA_VTHREAD: {
-        lua_State *th = gco2th(curr);
-        lua_assert(!isblack(th));
-        if (iswhite(th))  /* new object? */
-          *p = th->gclist;  /* remove from gray list */
-        else  /* old threads remain gray */
-          p = &th->gclist;  /* go to next element */
-        break;
-      }
-      default: lua_assert(0);  /* nothing more could be gray here */
+    GCObject **next = getgclist(curr);
+    if (iswhite(curr))
+      goto remove;  /* remove all white objects */
+    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);
+      goto remain;  /* keep it in the list and go to next element */
     }
+    else if (curr->tt == LUA_VTHREAD) {
+      lua_assert(isgray(curr));
+      goto remain;  /* keep non-white threads on the list */
+    }
+    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 */
+      nw2black(curr);  /* make object black (to be removed) */
+      goto remove;
+    }
+    remove: *p = *next; continue;
+    remain: p = next; continue;
   }
   return p;
 }
@@ -1100,7 +1187,7 @@ static void correctgraylists (global_State *g) {
 
 
 /*
-** Mark 'OLD1' objects when starting a new young collection.
+** 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.
 */
@@ -1109,10 +1196,9 @@ static void markold (global_State *g, GCObject *from, GCObject *to) {
   for (p = from; p != to; p = p->next) {
     if (getage(p) == G_OLD1) {
       lua_assert(!iswhite(p));
-      if (isblack(p)) {
-        black2gray(p);  /* should be '2white', but gray works too */
+      changeage(p, G_OLD1, G_OLD);  /* now they are old */
+      if (isblack(p))
         reallymarkobject(g, p);
-      }
     }
   }
 }
@@ -1131,50 +1217,63 @@ static void finishgencycle (lua_State *L, global_State *g) {
 
 
 /*
-** Does a young collection. First, mark 'OLD1' objects.  (Only survival
-** and "recent old" lists can contain 'OLD1' objects. New lists cannot
-** contain 'OLD1' objects, at most 'OLD0' objects that were already
-** visited when marked old.) Then does the atomic step. Then,
-** sweep all lists and advance pointers. Finally, finish the collection.
+** Does a young collection. First, mark 'OLD1' objects. Then does the
+** atomic step. Then, sweep all lists and advance pointers. Finally,
+** finish the collection.
 */
 static void youngcollection (lua_State *L, global_State *g) {
   GCObject **psurvival;  /* to point to first non-dead survival object */
+  GCObject *dummy;  /* dummy out parameter to 'sweepgen' */
   lua_assert(g->gcstate == GCSpropagate);
-  markold(g, g->survival, g->reallyold);
+  if (g->firstold1) {  /* are there regular OLD1 objects? */
+    markold(g, g->firstold1, g->reallyold);  /* mark them */
+    g->firstold1 = NULL;  /* no more OLD1 objects (for now) */
+  }
   markold(g, g->finobj, g->finobjrold);
+  markold(g, g->tobefnz, NULL);
   atomic(L);
 
   /* sweep nursery and get a pointer to its last live element */
-  psurvival = sweepgen(L, g, &g->allgc, g->survival);
-  /* sweep 'survival' and 'old' */
-  sweepgen(L, g, psurvival, g->reallyold);
-  g->reallyold = g->old;
-  g->old = *psurvival;  /* 'survival' survivals are old now */
+  g->gcstate = GCSswpallgc;
+  psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1);
+  /* sweep 'survival' */
+  sweepgen(L, g, psurvival, g->old1, &g->firstold1);
+  g->reallyold = g->old1;
+  g->old1 = *psurvival;  /* 'survival' survivals are old now */
   g->survival = g->allgc;  /* all news are survivals */
 
   /* repeat for 'finobj' lists */
-  psurvival = sweepgen(L, g, &g->finobj, g->finobjsur);
-  /* sweep 'survival' and 'old' */
-  sweepgen(L, g, psurvival, g->finobjrold);
-  g->finobjrold = g->finobjold;
-  g->finobjold = *psurvival;  /* 'survival' survivals are old now */
+  dummy = NULL;  /* no 'firstold1' optimization for 'finobj' lists */
+  psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy);
+  /* sweep 'survival' */
+  sweepgen(L, g, psurvival, g->finobjold1, &dummy);
+  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);
-
+  sweepgen(L, g, &g->tobefnz, NULL, &dummy);
   finishgencycle(L, g);
 }
 
 
+/*
+** Clears all gray lists, sweeps objects, and prepare sublists to enter
+** generational mode. The sweeps remove dead objects and turn all
+** surviving objects to old. Threads go back to 'grayagain'; everything
+** else is turned black (not in any gray list).
+*/
 static void atomic2gen (lua_State *L, global_State *g) {
+  cleargraylists(g);
   /* sweep all elements making them old */
+  g->gcstate = GCSswpallgc;
   sweep2old(L, &g->allgc);
   /* everything alive now is old */
-  g->reallyold = g->old = g->survival = g->allgc;
+  g->reallyold = g->old1 = g->survival = g->allgc;
+  g->firstold1 = NULL;  /* there are no OLD1 objects anywhere */
 
   /* repeat for 'finobj' lists */
   sweep2old(L, &g->finobj);
-  g->finobjrold = g->finobjold = g->finobjsur = g->finobj;
+  g->finobjrold = g->finobjold1 = g->finobjsur = g->finobj;
 
   sweep2old(L, &g->tobefnz);
 
@@ -1187,8 +1286,9 @@ static void atomic2gen (lua_State *L, global_State *g) {
 
 /*
 ** Enter generational mode. Must go until the end of an atomic cycle
-** to ensure that all threads and weak tables are in the gray lists.
-** Then, turn all objects into old and finishes the collection.
+** to ensure that all objects are correctly marked and weak tables
+** 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;
@@ -1207,10 +1307,10 @@ static lu_mem entergen (lua_State *L, global_State *g) {
 */
 static void enterinc (global_State *g) {
   whitelist(g, g->allgc);
-  g->reallyold = g->old = g->survival = NULL;
+  g->reallyold = g->old1 = g->survival = NULL;
   whitelist(g, g->finobj);
   whitelist(g, g->tobefnz);
-  g->finobjrold = g->finobjold = g->finobjsur = NULL;
+  g->finobjrold = g->finobjold1 = g->finobjsur = NULL;
   g->gcstate = GCSpause;
   g->gckind = KGC_INC;
   g->lastatomic = 0;

lgc.h

@@ -12,16 +12,16 @@
 #include "lstate.h"
 
 /*
-** Collectable objects may have one of three colors: white, which
-** means the object is not marked; gray, which means the
-** object is marked, but its references may be not marked; and
-** black, which means that the object and all its references are marked.
-** The main invariant of the garbage collector, while marking objects,
-** is that a black object can never point to a white one. Moreover,
-** any gray object must be in a "gray list" (gray, grayagain, weak,
-** allweak, ephemeron) so that it can be visited again before finishing
-** the collection cycle. These lists have no meaning when the invariant
-** is not being enforced (e.g., sweep phase).
+** Collectable objects may have one of three colors: white, which means
+** the object is not marked; gray, which means the object is marked, but
+** its references may be not marked; and black, which means that the
+** object and all its references are marked.  The main invariant of the
+** garbage collector, while marking objects, is that a black object can
+** never point to a white one. Moreover, any gray object must be in a
+** "gray list" (gray, grayagain, weak, allweak, ephemeron) so that it
+** can be visited again before finishing the collection cycle. (Open
+** upvalues are an exception to this rule.)  These lists have no meaning
+** when the invariant is not being enforced (e.g., sweep phase).
 */
 
 
@@ -69,14 +69,16 @@
 
 /*
 ** Layout for bit use in 'marked' field. First three bits are
-** used for object "age" in generational mode. Last bit is free
-** to be used by respective objects.
+** used for object "age" in generational mode. Last bit is used
+** by tests.
 */
 #define WHITE0BIT	3  /* object is white (type 0) */
 #define WHITE1BIT	4  /* object is white (type 1) */
 #define BLACKBIT	5  /* object is black */
 #define FINALIZEDBIT	6  /* object has been marked for finalization */
 
+#define TESTBIT		7
+
 
 
 #define WHITEBITS	bit2mask(WHITE0BIT, WHITE1BIT)
@@ -94,7 +96,8 @@
 #define isdead(g,v)	isdeadm(otherwhite(g), (v)->marked)
 
 #define changewhite(x)	((x)->marked ^= WHITEBITS)
-#define gray2black(x)	l_setbit((x)->marked, BLACKBIT)
+#define nw2black(x)  \
+	check_exp(!iswhite(x), l_setbit((x)->marked, BLACKBIT))
 
 #define luaC_white(g)	cast_byte((g)->currentwhite & WHITEBITS)
 

liolib.c

@@ -52,6 +52,12 @@ static int l_checkmode (const char *mode) {
 ** =======================================================
 */
 
+#if !defined(l_checkmodep)
+/* By default, Lua accepts only "r" or "w" as mode */
+#define l_checkmodep(m)	((m[0] == 'r' || m[0] == 'w') && m[1] == '\0')
+#endif
+
+
 #if !defined(l_popen)		/* { */
 
 #if defined(LUA_USE_POSIX)	/* { */
@@ -279,6 +285,7 @@ static int io_popen (lua_State *L) {
   const char *filename = luaL_checkstring(L, 1);
   const char *mode = luaL_optstring(L, 2, "r");
   LStream *p = newprefile(L);
+  luaL_argcheck(L, l_checkmodep(mode), 2, "invalid mode");
   p->f = l_popen(L, filename, mode);
   p->closef = &io_pclose;
   return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;

llex.c

@@ -81,7 +81,6 @@ void luaX_init (lua_State *L) {
 
 const char *luaX_token2str (LexState *ls, int token) {
   if (token < FIRST_RESERVED) {  /* single-byte symbols? */
-    lua_assert(token == cast_uchar(token));
     if (lisprint(token))
       return luaO_pushfstring(ls->L, "'%c'", token);
     else  /* control character */
@@ -255,9 +254,10 @@ static int read_numeral (LexState *ls, SemInfo *seminfo) {
 
 
 /*
-** reads a sequence '[=*[' or ']=*]', leaving the last bracket.
-** If sequence is well formed, return its number of '='s + 2; otherwise,
-** return 1 if there is no '='s or 0 otherwise (an unfinished '[==...').
+** read a sequence '[=*[' or ']=*]', leaving the last bracket. If
+** sequence is well formed, return its number of '='s + 2; otherwise,
+** return 1 if it is a single bracket (no '='s and no 2nd bracket);
+** otherwise (an unfinished '[==...') return 0.
 */
 static size_t skip_sep (LexState *ls) {
   size_t count = 0;
@@ -482,34 +482,34 @@ static int llex (LexState *ls, SemInfo *seminfo) {
       }
       case '=': {
         next(ls);
-        if (check_next1(ls, '=')) return TK_EQ;
+        if (check_next1(ls, '=')) return TK_EQ;  /* '==' */
         else return '=';
       }
       case '<': {
         next(ls);
-        if (check_next1(ls, '=')) return TK_LE;
-        else if (check_next1(ls, '<')) return TK_SHL;
+        if (check_next1(ls, '=')) return TK_LE;  /* '<=' */
+        else if (check_next1(ls, '<')) return TK_SHL;  /* '<<' */
         else return '<';
       }
       case '>': {
         next(ls);
-        if (check_next1(ls, '=')) return TK_GE;
-        else if (check_next1(ls, '>')) return TK_SHR;
+        if (check_next1(ls, '=')) return TK_GE;  /* '>=' */
+        else if (check_next1(ls, '>')) return TK_SHR;  /* '>>' */
         else return '>';
       }
       case '/': {
         next(ls);
-        if (check_next1(ls, '/')) return TK_IDIV;
+        if (check_next1(ls, '/')) return TK_IDIV;  /* '//' */
         else return '/';
       }
       case '~': {
         next(ls);
-        if (check_next1(ls, '=')) return TK_NE;
+        if (check_next1(ls, '=')) return TK_NE;  /* '~=' */
         else return '~';
       }
       case ':': {
         next(ls);
-        if (check_next1(ls, ':')) return TK_DBCOLON;
+        if (check_next1(ls, ':')) return TK_DBCOLON;  /* '::' */
         else return ':';
       }
       case '"': case '\'': {  /* short literal strings */
@@ -548,7 +548,7 @@ static int llex (LexState *ls, SemInfo *seminfo) {
             return TK_NAME;
           }
         }
-        else {  /* single-char tokens (+ - / ...) */
+        else {  /* single-char tokens ('+', '*', '%', '{', '}', ...) */
           int c = ls->current;
           next(ls);
           return c;

llex.h

@@ -7,11 +7,17 @@
 #ifndef llex_h
 #define llex_h
 
+#include <limits.h>
+
 #include "lobject.h"
 #include "lzio.h"
 
 
-#define FIRST_RESERVED	257
+/*
+** Single-char tokens (terminal symbols) are represented by their own
+** numeric code. Other tokens start at the following value.
+*/
+#define FIRST_RESERVED	(UCHAR_MAX + 1)
 
 
 #if !defined(LUA_ENV)

llimits.h

@@ -84,7 +84,15 @@ typedef LUAI_UACNUMBER l_uacNumber;
 typedef LUAI_UACINT l_uacInt;
 
 
-/* internal assertions for in-house debugging */
+/*
+** Internal assertions for in-house debugging
+*/
+#if defined LUAI_ASSERT
+#undef NDEBUG
+#include <assert.h>
+#define lua_assert(c)           assert(c)
+#endif
+
 #if defined(lua_assert)
 #define check_exp(c,e)		(lua_assert(c), (e))
 /* to avoid problems with conditions too long */
@@ -226,6 +234,17 @@ typedef l_uint32 Instruction;
 #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')
@@ -307,7 +326,8 @@ typedef l_uint32 Instruction;
 
 /* exponentiation */
 #if !defined(luai_numpow)
-#define luai_numpow(L,a,b)      ((void)L, l_mathop(pow)(a,b))
+#define luai_numpow(L,a,b)  \
+  ((void)L, (b == 2) ? (a)*(a) : l_mathop(pow)(a,b))
 #endif
 
 /* the others are quite standard operations */
@@ -336,7 +356,7 @@ typedef l_uint32 Instruction;
 #else
 /* realloc stack keeping its size */
 #define condmovestack(L,pre,pos)  \
-  { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_, 0); pos; }
+  { int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; }
 #endif
 
 #if !defined(HARDMEMTESTS)

lmem.c

@@ -22,7 +22,7 @@
 #include "lstate.h"
 
 
-#if defined(HARDMEMTESTS)
+#if defined(EMERGENCYGCTESTS)
 /*
 ** First allocation will fail whenever not building initial state
 ** and not shrinking a block. (This fail will trigger 'tryagain' and

lobject.c

@@ -215,37 +215,42 @@ static lua_Number lua_strx2number (const char *s, char **endptr) {
 /* }====================================================== */
 
 
-/* maximum length of a numeral */
+/* maximum length of a numeral to be converted to a number */
 #if !defined (L_MAXLENNUM)
 #define L_MAXLENNUM	200
 #endif
 
+/*
+** Convert string 's' to a Lua number (put in 'result'). Return NULL on
+** fail or the address of the ending '\0' on success. ('mode' == 'x')
+** means a hexadecimal numeral.
+*/
 static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {
   char *endptr;
   *result = (mode == 'x') ? lua_strx2number(s, &endptr)  /* try to convert */
                           : lua_str2number(s, &endptr);
   if (endptr == s) return NULL;  /* nothing recognized? */
   while (lisspace(cast_uchar(*endptr))) endptr++;  /* skip trailing spaces */
-  return (*endptr == '\0') ? endptr : NULL;  /* OK if no trailing characters */
+  return (*endptr == '\0') ? endptr : NULL;  /* OK iff no trailing chars */
 }
 
 
 /*
-** Convert string 's' to a Lua number (put in 'result'). Return NULL
-** on fail or the address of the ending '\0' on success.
-** 'pmode' points to (and 'mode' contains) special things in the string:
-** - 'x'/'X' means a hexadecimal numeral
-** - 'n'/'N' means 'inf' or 'nan' (which should be rejected)
-** - '.' just optimizes the search for the common case (nothing special)
+** Convert string 's' to a Lua number (put in 'result') handling the
+** current locale.
 ** This function accepts both the current locale or a dot as the radix
 ** mark. If the conversion fails, it may mean number has a dot but
 ** locale accepts something else. In that case, the code copies 's'
 ** to a buffer (because 's' is read-only), changes the dot to the
 ** current locale radix mark, and tries to convert again.
+** The variable 'mode' checks for special characters in the string:
+** - 'n' means 'inf' or 'nan' (which should be rejected)
+** - 'x' means a hexadecimal numeral
+** - '.' just optimizes the search for the common case (no special chars)
 */
 static const char *l_str2d (const char *s, lua_Number *result) {
   const char *endptr;
-  const char *pmode = strpbrk(s, ".xXnN");
+  const char *pmode = strpbrk(s, ".xXnN");  /* look for special chars */
   int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;
   if (mode == 'n')  /* reject 'inf' and 'nan' */
     return NULL;
@@ -253,7 +258,7 @@ static const char *l_str2d (const char *s, lua_Number *result) {
   if (endptr == NULL) {  /* failed? may be a different locale */
     char buff[L_MAXLENNUM + 1];
     const char *pdot = strchr(s, '.');
-    if (strlen(s) > L_MAXLENNUM || pdot == NULL)
+    if (pdot == NULL || strlen(s) > L_MAXLENNUM)
       return NULL;  /* string too long or no dot; fail */
     strcpy(buff, s);  /* copy string to buffer */
     buff[pdot - s] = lua_getlocaledecpoint();  /* correct decimal point */
@@ -333,8 +338,15 @@ int luaO_utf8esc (char *buff, unsigned long x) {
 }
 
 
-/* maximum length of the conversion of a number to a string */
-#define MAXNUMBER2STR	50
+/*
+** 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.)
+*/
+#define MAXNUMBER2STR	44
 
 
 /*
@@ -375,7 +387,7 @@ void luaO_tostring (lua_State *L, TValue *obj) {
 */
 
 /* size for buffer space used by 'luaO_pushvfstring' */
-#define BUFVFS		400
+#define BUFVFS		200
 
 /* buffer used by 'luaO_pushvfstring' */
 typedef struct BuffFS {
@@ -387,18 +399,16 @@ typedef struct BuffFS {
 
 
 /*
-** Push given string to the stack, as part of the buffer. If the stack
-** is almost full, join all partial strings in the stack into one.
+** Push given string to the stack, as part of the buffer, and
+** join the partial strings in the stack into one.
 */
 static void pushstr (BuffFS *buff, const char *str, size_t l) {
   lua_State *L = buff->L;
   setsvalue2s(L, L->top, luaS_newlstr(L, str, l));
   L->top++;  /* may use one extra slot */
   buff->pushed++;
-  if (buff->pushed > 1 && L->top + 1 >= L->stack_last) {
-    luaV_concat(L, buff->pushed);  /* join all partial results into one */
-    buff->pushed = 1;
-  }
+  luaV_concat(L, buff->pushed);  /* join partial results into one */
+  buff->pushed = 1;
 }
 
 
@@ -521,8 +531,7 @@ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
   }
   addstr2buff(&buff, fmt, strlen(fmt));  /* rest of 'fmt' */
   clearbuff(&buff);  /* empty buffer into the stack */
-  if (buff.pushed > 1)
-    luaV_concat(L, buff.pushed);  /* join all partial results */
+  lua_assert(buff.pushed == 1);
   return svalue(s2v(L->top - 1));
 }
 

lobject.h

@@ -21,10 +21,12 @@
 */
 #define LUA_TUPVAL	LUA_NUMTYPES  /* upvalues */
 #define LUA_TPROTO	(LUA_NUMTYPES+1)  /* function prototypes */
+#define LUA_TDEADKEY	(LUA_NUMTYPES+2)  /* removed keys in tables */
+
 
 
 /*
-** number of all possible types (including LUA_TNONE)
+** number of all possible types (including LUA_TNONE but excluding DEADKEY)
 */
 #define LUA_TOTALTYPES		(LUA_TPROTO + 2)
 
@@ -96,7 +98,8 @@ typedef struct TValue {
 /*
 ** Any value being manipulated by the program either is non
 ** collectable, or the collectable object has the right tag
-** and it is not dead.
+** and it is not dead. The option 'L == NULL' allows other
+** macros using this one to be used where L is not available.
 */
 #define checkliveness(L,obj) \
 	((void)L, lua_longassert(!iscollectable(obj) || \
@@ -554,7 +557,7 @@ typedef struct Proto {
 
 /*
 ** {==================================================================
-** Closures
+** Functions
 ** ===================================================================
 */
 
@@ -703,9 +706,9 @@ typedef union Node {
 */
 
 #define BITRAS		(1 << 7)
-#define isrealasize(t)		(!((t)->marked & BITRAS))
-#define setrealasize(t)		((t)->marked &= cast_byte(~BITRAS))
-#define setnorealasize(t)	((t)->marked |= BITRAS)
+#define isrealasize(t)		(!((t)->flags & BITRAS))
+#define setrealasize(t)		((t)->flags &= cast_byte(~BITRAS))
+#define setnorealasize(t)	((t)->flags |= BITRAS)
 
 
 typedef struct Table {
@@ -742,13 +745,13 @@ typedef struct Table {
 
 
 /*
-** Use a "nil table" to mark dead keys in a table. Those keys serve
-** to keep space for removed entries, which may still be part of
-** chains. Note that the 'keytt' does not have the BIT_ISCOLLECTABLE
-** set, so these values are considered not collectable and are different
-** from any valid value.
+** Dead keys in tables have the tag DEADKEY but keep their original
+** gcvalue. This distinguishes them from regular keys but allows them to
+** be found when searched in a special way. ('next' needs that to find
+** keys removed from a table during a traversal.)
 */
-#define setdeadkey(n)	(keytt(n) = LUA_TTABLE, gckey(n) = NULL)
+#define setdeadkey(node)	(keytt(node) = LUA_TDEADKEY)
+#define keyisdead(node)		(keytt(node) == LUA_TDEADKEY)
 
 /* }================================================================== */
 

lopcodes.h

@@ -261,7 +261,7 @@ OP_MMBINK,/*	A B C k		call C metamethod over R[A] and K[B]	*/
 OP_UNM,/*	A B	R[A] := -R[B]					*/
 OP_BNOT,/*	A B	R[A] := ~R[B]					*/
 OP_NOT,/*	A B	R[A] := not R[B]				*/
-OP_LEN,/*	A B	R[A] := length of R[B]				*/
+OP_LEN,/*	A B	R[A] := #R[B] (length operator)			*/
 
 OP_CONCAT,/*	A B	R[A] := R[A].. ... ..R[A + B - 1]		*/
 
@@ -297,7 +297,7 @@ OP_TFORPREP,/*	A Bx	create upvalue for R[A + 3]; pc+=Bx		*/
 OP_TFORCALL,/*	A C	R[A+4], ... ,R[A+3+C] := R[A](R[A+1], R[A+2]);	*/
 OP_TFORLOOP,/*	A Bx	if R[A+2] ~= nil then { R[A]=R[A+2]; pc -= Bx }	*/
 
-OP_SETLIST,/*	A B C k	R[A][(C-1)*FPF+i] := R[A+i], 1 <= i <= B	*/
+OP_SETLIST,/*	A B C k	R[A][C+i] := R[A+i], 1 <= i <= B		*/
 
 OP_CLOSURE,/*	A Bx	R[A] := closure(KPROTO[Bx])			*/
 

lparser.c

@@ -489,12 +489,10 @@ static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {
 }
 
 
-/*
-** Macros to limit the maximum recursion depth while parsing
-*/
-#define enterlevel(ls)	luaE_enterCcall((ls)->L)
+#define enterlevel(ls)	luaE_incCstack(ls->L)
 
-#define leavelevel(ls)	luaE_exitCcall((ls)->L)
+
+#define leavelevel(ls) ((ls)->L->nCcalls--)
 
 
 /*
@@ -947,7 +945,7 @@ static void setvararg (FuncState *fs, int nparams) {
 
 
 static void parlist (LexState *ls) {
-  /* parlist -> [ param { ',' param } ] */
+  /* parlist -> [ {NAME ','} (NAME | '...') ] */
   FuncState *fs = ls->fs;
   Proto *f = fs->f;
   int nparams = 0;
@@ -955,12 +953,12 @@ static void parlist (LexState *ls) {
   if (ls->t.token != ')') {  /* is 'parlist' not empty? */
     do {
       switch (ls->t.token) {
-        case TK_NAME: {  /* param -> NAME */
+        case TK_NAME: {
           new_localvar(ls, str_checkname(ls));
           nparams++;
           break;
         }
-        case TK_DOTS: {  /* param -> '...' */
+        case TK_DOTS: {
           luaX_next(ls);
           isvararg = 1;
           break;
@@ -1625,59 +1623,21 @@ static void forstat (LexState *ls, int line) {
 }
 
 
-/*
-** Check whether next instruction is a single jump (a 'break', a 'goto'
-** to a forward label, or a 'goto' to a backward label with no variable
-** to close). If so, set the name of the 'label' it is jumping to
-** ("break" for a 'break') or to where it is jumping to ('target') and
-** return true. If not a single jump, leave input unchanged, to be
-** handled as a regular statement.
-*/
-static int issinglejump (LexState *ls, TString **label, int *target) {
-  if (testnext(ls, TK_BREAK)) {  /* a break? */
-    *label = luaS_newliteral(ls->L, "break");
-    return 1;
-  }
-  else if (ls->t.token != TK_GOTO || luaX_lookahead(ls) != TK_NAME)
-    return 0;  /* not a valid goto */
-  else {
-    TString *lname = ls->lookahead.seminfo.ts;  /* label's id */
-    Labeldesc *lb = findlabel(ls, lname);
-    if (lb) {  /* a backward jump? */
-      /* does it need to close variables? */
-      if (luaY_nvarstack(ls->fs) > stacklevel(ls->fs, lb->nactvar))
-        return 0;  /* not a single jump; cannot optimize */
-      *target = lb->pc;
-    }
-    else  /* jump forward */
-      *label = lname;
-    luaX_next(ls);  /* skip goto */
-    luaX_next(ls);  /* skip name */
-    return 1;
-  }
-}
-
-
 static void test_then_block (LexState *ls, int *escapelist) {
   /* test_then_block -> [IF | ELSEIF] cond THEN block */
   BlockCnt bl;
-  int line;
   FuncState *fs = ls->fs;
-  TString *jlb = NULL;
-  int target = NO_JUMP;
   expdesc v;
   int jf;  /* instruction to skip 'then' code (if condition is false) */
   luaX_next(ls);  /* skip IF or ELSEIF */
   expr(ls, &v);  /* read condition */
   checknext(ls, TK_THEN);
-  line = ls->linenumber;
-  if (issinglejump(ls, &jlb, &target)) {  /* 'if x then goto' ? */
-    luaK_goiffalse(ls->fs, &v);  /* will jump to label if condition is true */
+  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' */
-    if (jlb != NULL)  /* forward jump? */
-      newgotoentry(ls, jlb, line, v.t);  /* will be resolved later */
-    else  /* backward jump */
-      luaK_patchlist(fs, v.t, target);  /* jump directly to 'target' */
+    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);
@@ -1686,7 +1646,7 @@ static void test_then_block (LexState *ls, int *escapelist) {
     else  /* must skip over 'then' part if condition is false */
       jf = luaK_jump(fs);
   }
-  else {  /* regular case (not a jump) */
+  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;
@@ -1754,7 +1714,7 @@ static void checktoclose (LexState *ls, int level) {
 
 
 static void localstat (LexState *ls) {
-  /* stat -> LOCAL ATTRIB NAME {',' ATTRIB NAME} ['=' 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 */

lparser.h

@@ -23,7 +23,7 @@
 
 /* kinds of variables/expressions */
 typedef enum {
-  VVOID,  /* when 'expdesc' describes the last expression a list,
+  VVOID,  /* when 'expdesc' describes the last expression of a list,
              this kind means an empty list (so, no expression) */
   VNIL,  /* constant nil */
   VTRUE,  /* constant true */
@@ -38,7 +38,8 @@ typedef enum {
   VLOCAL,  /* local variable; var.sidx = stack index (local register);
               var.vidx = relative index in 'actvar.arr'  */
   VUPVAL,  /* upvalue variable; info = index of upvalue in 'upvalues' */
-  VCONST,  /* compile-time constant; info = absolute index in 'actvar.arr'  */
+  VCONST,  /* compile-time <const> variable;
+              info = absolute index in 'actvar.arr'  */
   VINDEXED,  /* indexed variable;
                 ind.t = table register;
                 ind.idx = key's R index */

lstate.c

@@ -76,7 +76,7 @@ static unsigned int luai_makeseed (lua_State *L) {
   addbuff(buff, p, &h);  /* local variable */
   addbuff(buff, p, &lua_newstate);  /* public function */
   lua_assert(p == sizeof(buff));
-  return luaS_hash(buff, p, h, 1);
+  return luaS_hash(buff, p, h);
 }
 
 #endif
@@ -97,66 +97,14 @@ void luaE_setdebt (global_State *g, l_mem debt) {
 
 
 LUA_API int lua_setcstacklimit (lua_State *L, unsigned int limit) {
-  global_State *g = G(L);
-  int ccalls;
-  luaE_freeCI(L);  /* release unused CIs */
-  ccalls = getCcalls(L);
-  if (limit >= 40000)
-    return 0;  /* out of bounds */
-  limit += CSTACKERR;
-  if (L != g-> mainthread)
-    return 0;  /* only main thread can change the C stack */
-  else if (ccalls <= CSTACKERR)
-    return 0;  /* handling overflow */
-  else {
-    int diff = limit - g->Cstacklimit;
-    if (ccalls + diff <= CSTACKERR)
-      return 0;  /* new limit would cause an overflow */
-    g->Cstacklimit = limit;  /* set new limit */
-    L->nCcalls += diff;  /* correct 'nCcalls' */
-    return limit - diff - CSTACKERR;  /* success; return previous limit */
-  }
-}
-
-
-/*
-** Decrement count of "C calls" and check for overflows. In case of
-** a stack overflow, check appropriate error ("regular" overflow or
-** overflow while handling stack overflow).  If 'nCcalls' is smaller
-** than CSTACKERR but larger than CSTACKMARK, it means it has just
-** entered the "overflow zone", so the function raises an overflow
-** error.  If 'nCcalls' is smaller than CSTACKMARK (which means it is
-** already handling an overflow) but larger than CSTACKERRMARK, does
-** not report an error (to allow message handling to work). Otherwise,
-** report a stack overflow while handling a stack overflow (probably
-** caused by a repeating error in the message handling function).
-*/
-
-void luaE_enterCcall (lua_State *L) {
-  int ncalls = getCcalls(L);
-  L->nCcalls--;
-  if (ncalls <= CSTACKERR) {  /* possible overflow? */
-    luaE_freeCI(L);  /* release unused CIs */
-    ncalls = getCcalls(L);  /* update call count */
-    if (ncalls <= CSTACKERR) {  /* still overflow? */
-      if (ncalls <= CSTACKERRMARK)  /* below error-handling zone? */
-        luaD_throw(L, LUA_ERRERR);  /* error while handling stack error */
-      else if (ncalls >= CSTACKMARK) {
-        /* not in error-handling zone; raise the error now */
-        L->nCcalls = (CSTACKMARK - 1);  /* enter error-handling zone */
-        luaG_runerror(L, "C stack overflow");
-      }
-      /* else stack is in the error-handling zone;
-         allow message handler to work */
-    }
-  }
+  UNUSED(L); UNUSED(limit);
+  return LUAI_MAXCCALLS;  /* warning?? */
 }
 
 
 CallInfo *luaE_extendCI (lua_State *L) {
   CallInfo *ci;
   lua_assert(L->ci->next == NULL);
-  luaE_enterCcall(L);
   ci = luaM_new(L, CallInfo);
   lua_assert(L->ci->next == NULL);
   L->ci->next = ci;
@@ -175,13 +123,11 @@ void luaE_freeCI (lua_State *L) {
   CallInfo *ci = L->ci;
   CallInfo *next = ci->next;
   ci->next = NULL;
-  L->nCcalls += L->nci;  /* add removed elements back to 'nCcalls' */
   while ((ci = next) != NULL) {
     next = ci->next;
     luaM_free(L, ci);
     L->nci--;
   }
-  L->nCcalls -= L->nci;  /* adjust result */
 }
 
 
@@ -194,7 +140,6 @@ void luaE_shrinkCI (lua_State *L) {
   CallInfo *next;
   if (ci == NULL)
     return;  /* no extra elements */
-  L->nCcalls += L->nci;  /* add removed elements back to 'nCcalls' */
   while ((next = ci->next) != NULL) {  /* two extra elements? */
     CallInfo *next2 = next->next;  /* next's next */
     ci->next = next2;  /* remove next from the list */
@@ -207,19 +152,39 @@ void luaE_shrinkCI (lua_State *L) {
       ci = next2;  /* continue */
     }
   }
-  L->nCcalls -= L->nci;  /* adjust result */
+}
+
+
+/*
+** Called when 'getCcalls(L)' larger or equal to LUAI_MAXCCALLS.
+** If equal, raises an overflow error. If value is larger than
+** LUAI_MAXCCALLS (which means it is handling an overflow) but
+** not much larger, does not report an error (to allow overflow
+** handling to work).
+*/
+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 handing stack error */
+}
+
+
+LUAI_FUNC void luaE_incCstack (lua_State *L) {
+  L->nCcalls++;
+  if (unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
+    luaE_checkcstack(L);
 }
 
 
 static void stack_init (lua_State *L1, lua_State *L) {
   int i; CallInfo *ci;
   /* initialize stack array */
-  L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, StackValue);
-  L1->stacksize = BASIC_STACK_SIZE;
-  for (i = 0; i < BASIC_STACK_SIZE; i++)
+  L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, StackValue);
+  for (i = 0; i < BASIC_STACK_SIZE + EXTRA_STACK; i++)
     setnilvalue(s2v(L1->stack + i));  /* erase new stack */
   L1->top = L1->stack;
-  L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK;
+  L1->stack_last = L1->stack + BASIC_STACK_SIZE;
   /* initialize first ci */
   ci = &L1->base_ci;
   ci->next = ci->previous = NULL;
@@ -240,7 +205,7 @@ static void freestack (lua_State *L) {
   L->ci = &L->base_ci;  /* free the entire 'ci' list */
   luaE_freeCI(L);
   lua_assert(L->nci == 0);
-  luaM_freearray(L, L->stack, L->stacksize);  /* free stack array */
+  luaM_freearray(L, L->stack, stacksize(L) + EXTRA_STACK);  /* free stack */
 }
 
 
@@ -290,7 +255,6 @@ static void preinit_thread (lua_State *L, global_State *g) {
   L->stack = NULL;
   L->ci = NULL;
   L->nci = 0;
-  L->stacksize = 0;
   L->twups = L;  /* thread has no upvalues */
   L->errorJmp = NULL;
   L->hook = NULL;
@@ -301,6 +265,7 @@ static void preinit_thread (lua_State *L, global_State *g) {
   L->openupval = NULL;
   L->status = LUA_OK;
   L->errfunc = 0;
+  L->oldpc = 0;
 }
 
 
@@ -318,9 +283,10 @@ static void close_state (lua_State *L) {
 
 
 LUA_API lua_State *lua_newthread (lua_State *L) {
-  global_State *g = G(L);
+  global_State *g;
   lua_State *L1;
   lua_lock(L);
+  g = G(L);
   luaC_checkGC(L);
   /* create new thread */
   L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;
@@ -333,7 +299,7 @@ LUA_API lua_State *lua_newthread (lua_State *L) {
   setthvalue2s(L, L->top, L1);
   api_incr_top(L);
   preinit_thread(L1, g);
-  L1->nCcalls = getCcalls(L);
+  L1->nCcalls = 0;
   L1->hookmask = L->hookmask;
   L1->basehookcount = L->basehookcount;
   L1->hook = L->hook;
@@ -394,7 +360,8 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   preinit_thread(L, g);
   g->allgc = obj2gco(L);  /* by now, only object is the main thread */
   L->next = NULL;
-  g->Cstacklimit = L->nCcalls = LUAI_MAXCSTACK + CSTACKERR;
+  L->nCcalls = 0;
+  incnny(L);  /* main thread is always non yieldable */
   g->frealloc = f;
   g->ud = ud;
   g->warnf = NULL;
@@ -410,8 +377,8 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   g->gckind = KGC_INC;
   g->gcemergency = 0;
   g->finobj = g->tobefnz = g->fixedgc = NULL;
-  g->survival = g->old = g->reallyold = NULL;
-  g->finobjsur = g->finobjold = g->finobjrold = NULL;
+  g->firstold1 = g->survival = g->old1 = g->reallyold = NULL;
+  g->finobjsur = g->finobjold1 = g->finobjrold = NULL;
   g->sweepgc = NULL;
   g->gray = g->grayagain = NULL;
   g->weak = g->ephemeron = g->allweak = NULL;
@@ -436,8 +403,8 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
 
 
 LUA_API void lua_close (lua_State *L) {
-  L = G(L)->mainthread;  /* only the main thread can be closed */
   lua_lock(L);
+  L = G(L)->mainthread;  /* only the main thread can be closed */
   close_state(L);
 }
 

lstate.h

@@ -32,13 +32,29 @@
 **
 ** 'allgc' -> 'survival': new objects;
 ** 'survival' -> 'old': objects that survived one collection;
-** 'old' -> 'reallyold': objects that became old in last collection;
+** 'old1' -> 'reallyold': objects that became old in last collection;
 ** 'reallyold' -> NULL: objects old for more than one cycle.
 **
 ** 'finobj' -> 'finobjsur': new objects marked for finalization;
-** 'finobjsur' -> 'finobjold': survived   """";
-** 'finobjold' -> 'finobjrold': just old  """";
+** 'finobjsur' -> 'finobjold1': survived   """";
+** 'finobjold1' -> 'finobjrold': just old  """";
 ** 'finobjrold' -> NULL: really old       """".
+**
+** All lists can contain elements older than their main ages, due
+** to 'luaC_checkfinalizer' and 'udata2finalize', which move
+** objects between the normal lists and the "marked for finalization"
+** lists. Moreover, barriers can age young objects in young lists as
+** OLD0, which then become OLD1. However, a list never contains
+** elements younger than their main ages.
+**
+** The generational collector also uses a pointer 'firstold1', which
+** points to the first OLD1 object in the list. It is used to optimize
+** 'markold'. (Potentially OLD1 objects can be anywhere between 'allgc'
+** and 'reallyold', but often the list has no OLD1 objects or they are
+** after 'old1'.) Note the difference between it and 'old1':
+** 'firstold1': no OLD1 objects before this point; there can be all
+**   ages after it.
+** 'old1': no objects younger than OLD1 after this point.
 */
 
 /*
@@ -47,7 +63,7 @@
 ** can become gray have such a field. The field is not the same
 ** in all objects, but it always has this name.)  Any gray object
 ** must belong to one of these lists, and all objects in these lists
-** must be gray:
+** must be gray (with two exceptions explained below):
 **
 ** 'gray': regular gray objects, still waiting to be visited.
 ** 'grayagain': objects that must be revisited at the atomic phase.
@@ -58,54 +74,26 @@
 ** 'weak': tables with weak values to be cleared;
 ** 'ephemeron': ephemeron tables with white->white entries;
 ** 'allweak': tables with weak keys and/or weak values to be cleared.
+**
+** The exceptions to that "gray rule" are:
+** - TOUCHED2 objects in generational mode stay in a gray list (because
+** 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
+** of gray lists. (They don't even have a 'gclist' field.)
 */
 
 
 
 /*
-** About 'nCcalls': each thread in Lua (a lua_State) keeps a count of
-** how many "C calls" it still can do in the C stack, to avoid C-stack
-** overflow.  This count is very rough approximation; it considers only
-** recursive functions inside the interpreter, as non-recursive calls
-** can be considered using a fixed (although unknown) amount of stack
-** space.
-**
-** The count has two parts: the lower part is the count itself; the
-** higher part counts the number of non-yieldable calls in the stack.
-** (They are together so that we can change both with one instruction.)
-**
-** Because calls to external C functions can use an unknown amount
-** of space (e.g., functions using an auxiliary buffer), calls
-** to these functions add more than one to the count (see CSTACKCF).
-**
-** The proper count excludes the number of CallInfo structures allocated
-** by Lua, as a kind of "potential" calls. So, when Lua calls a function
-** (and "consumes" one CallInfo), it needs neither to decrement nor to
-** check 'nCcalls', as its use of C stack is already accounted for.
+** About 'nCcalls':  This count has two parts: the lower 16 bits counts
+** the number of recursive invocations in the C stack; the higher
+** 16 bits counts the number of non-yieldable calls in the stack.
+** (They are together so that we can change and save both with one
+** instruction.)
 */
 
-/* number of "C stack slots" used by an external C function */
-#define CSTACKCF	10
-
-
-/*
-** The C-stack size is sliced in the following zones:
-** - larger than CSTACKERR: normal stack;
-** - [CSTACKMARK, CSTACKERR]: buffer zone to signal a stack overflow;
-** - [CSTACKCF, CSTACKERRMARK]: error-handling zone;
-** - below CSTACKERRMARK: buffer zone to signal overflow during overflow;
-** (Because the counter can be decremented CSTACKCF at once, we need
-** the so called "buffer zones", with at least that size, to properly
-** detect a change from one zone to the next.)
-*/
-#define CSTACKERR	(8 * CSTACKCF)
-#define CSTACKMARK	(CSTACKERR - (CSTACKCF + 2))
-#define CSTACKERRMARK	(CSTACKCF + 2)
-
-
-/* initial limit for the C-stack of threads */
-#define CSTACKTHREAD	(2 * CSTACKERR)
-
 
 /* true if this thread does not have non-yieldable calls in the stack */
 #define yieldable(L)		(((L)->nCcalls & 0xffff0000) == 0)
@@ -120,13 +108,8 @@
 /* Decrement the number of non-yieldable calls */
 #define decnny(L)	((L)->nCcalls -= 0x10000)
 
-/* Increment the number of non-yieldable calls and decrement nCcalls */
-#define incXCcalls(L)	((L)->nCcalls += 0x10000 - CSTACKCF)
-
-/* Decrement the number of non-yieldable calls and increment nCcalls */
-#define decXCcalls(L)	((L)->nCcalls -= 0x10000 - CSTACKCF)
-
-
+/* Non-yieldable call increment */
+#define nyci	(0x10000 | 1)
 
 
 
@@ -144,12 +127,20 @@ struct lua_longjmp;  /* defined in ldo.c */
 #endif
 
 
-/* extra stack space to handle TM calls and some other extras */
+/*
+** Extra stack space to handle TM calls and some other extras. This
+** space is not included in 'stack_last'. It is used only to avoid stack
+** checks, either because the element will be promptly popped or because
+** there will be a stack check soon after the push. Function frames
+** never use this extra space, so it does not need to be kept clean.
+*/
 #define EXTRA_STACK   5
 
 
 #define BASIC_STACK_SIZE        (2*LUA_MINSTACK)
 
+#define stacksize(th)	cast_int((th)->stack_last - (th)->stack)
+
 
 /* kinds of Garbage Collection */
 #define KGC_INC		0	/* incremental gc */
@@ -200,14 +191,15 @@ typedef struct CallInfo {
 */
 #define CIST_OAH	(1<<0)	/* original value of 'allowhook' */
 #define CIST_C		(1<<1)	/* call is running a C function */
-#define CIST_HOOKED	(1<<2)	/* call is running a debug hook */
-#define CIST_YPCALL	(1<<3)	/* call is a yieldable protected call */
-#define CIST_TAIL	(1<<4)	/* call was tail called */
-#define CIST_HOOKYIELD	(1<<5)	/* last hook called yielded */
-#define CIST_FIN	(1<<6)  /* call is running a finalizer */
-#define CIST_TRAN	(1<<7)	/* 'ci' has transfer information */
+#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)	/* call is a yieldable protected call */
+#define CIST_TAIL	(1<<5)	/* call was tail called */
+#define CIST_HOOKYIELD	(1<<6)	/* last hook called yielded */
+#define CIST_FIN	(1<<7)  /* call is running a finalizer */
+#define CIST_TRAN	(1<<8)	/* 'ci' has transfer information */
 #if defined(LUA_COMPAT_LT_LE)
-#define CIST_LEQ	(1<<8)  /* using __lt for __le */
+#define CIST_LEQ	(1<<9)  /* using __lt for __le */
 #endif
 
 /* active function is a Lua function */
@@ -257,10 +249,11 @@ typedef struct global_State {
   GCObject *fixedgc;  /* list of objects not to be collected */
   /* fields for generational collector */
   GCObject *survival;  /* start of objects that survived one GC cycle */
-  GCObject *old;  /* start of old objects */
-  GCObject *reallyold;  /* old objects with more than one cycle */
+  GCObject *old1;  /* start of old1 objects */
+  GCObject *reallyold;  /* objects more than one cycle old ("really old") */
+  GCObject *firstold1;  /* first OLD1 object in the list (if any) */
   GCObject *finobjsur;  /* list of survival objects with finalizers */
-  GCObject *finobjold;  /* list of old objects with finalizers */
+  GCObject *finobjold1;  /* list of old1 objects with finalizers */
   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 */
@@ -271,7 +264,6 @@ typedef struct global_State {
   TString *strcache[STRCACHE_N][STRCACHE_M];  /* cache for strings in API */
   lua_WarnFunction warnf;  /* warning function */
   void *ud_warn;         /* auxiliary data to 'warnf' */
-  unsigned int Cstacklimit;  /* current limit for the C stack */
 } global_State;
 
 
@@ -286,8 +278,7 @@ struct lua_State {
   StkId top;  /* first free slot in the stack */
   global_State *l_G;
   CallInfo *ci;  /* call info for current function */
-  const Instruction *oldpc;  /* last pc traced */
-  StkId stack_last;  /* last free slot in the stack */
+  StkId stack_last;  /* end of stack (last element + 1) */
   StkId stack;  /* stack base */
   UpVal *openupval;  /* list of open upvalues in this stack */
   GCObject *gclist;
@@ -296,8 +287,8 @@ struct lua_State {
   CallInfo base_ci;  /* CallInfo for first level (C calling Lua) */
   volatile lua_Hook hook;
   ptrdiff_t errfunc;  /* current error handling function (stack index) */
-  l_uint32 nCcalls;  /* number of allowed nested C calls - 'nci' */
-  int stacksize;
+  l_uint32 nCcalls;  /* number of nested (non-yieldable | C)  calls */
+  int oldpc;  /* last pc traced */
   int basehookcount;
   int hookcount;
   volatile l_signalT hookmask;
@@ -309,6 +300,12 @@ struct lua_State {
 
 /*
 ** Union of all collectable objects (only for conversions)
+** ISO C99, 6.5.2.3 p.5:
+** "if a union contains several structures that share a common initial
+** sequence [...], and if the union object currently contains one
+** of these structures, it is permitted to inspect the common initial
+** part of any of them anywhere that a declaration of the complete type
+** of the union is visible."
 */
 union GCUnion {
   GCObject gc;  /* common header */
@@ -322,6 +319,11 @@ union GCUnion {
 };
 
 
+/*
+** ISO C99, 6.7.2.1 p.14:
+** "A pointer to a union object, suitably converted, points to each of
+** its members [...], and vice versa."
+*/
 #define cast_u(o)	cast(union GCUnion *, (o))
 
 /* macros to convert a GCObject into a specific value */
@@ -353,12 +355,11 @@ LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
 LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);
 LUAI_FUNC void luaE_freeCI (lua_State *L);
 LUAI_FUNC void luaE_shrinkCI (lua_State *L);
-LUAI_FUNC void luaE_enterCcall (lua_State *L);
+LUAI_FUNC void luaE_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);
 
 
-#define luaE_exitCcall(L)	((L)->nCcalls++)
-
 #endif
 

lstring.c

@@ -22,16 +22,6 @@
 #include "lstring.h"
 
 
-/*
-** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a long string to
-** compute its hash
-*/
-#if !defined(LUAI_HASHLIMIT)
-#define LUAI_HASHLIMIT		5
-#endif
-
-
-
 /*
 ** Maximum size for string table.
 */
@@ -50,10 +40,9 @@ int luaS_eqlngstr (TString *a, TString *b) {
 }
 
 
-unsigned int luaS_hash (const char *str, size_t l, unsigned int seed,
-                        size_t step) {
+unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) {
   unsigned int h = seed ^ cast_uint(l);
-  for (; l >= step; l -= step)
+  for (; l > 0; l--)
     h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
   return h;
 }
@@ -63,8 +52,7 @@ unsigned int luaS_hashlongstr (TString *ts) {
   lua_assert(ts->tt == LUA_VLNGSTR);
   if (ts->extra == 0) {  /* no hash? */
     size_t len = ts->u.lnglen;
-    size_t step = (len >> LUAI_HASHLIMIT) + 1;
-    ts->hash = luaS_hash(getstr(ts), len, ts->hash, step);
+    ts->hash = luaS_hash(getstr(ts), len, ts->hash);
     ts->extra = 1;  /* now it has its hash */
   }
   return ts->hash;
@@ -201,7 +189,7 @@ static TString *internshrstr (lua_State *L, const char *str, size_t l) {
   TString *ts;
   global_State *g = G(L);
   stringtable *tb = &g->strt;
-  unsigned int h = luaS_hash(str, l, g->seed, 1);
+  unsigned int h = luaS_hash(str, l, g->seed);
   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) {

lstring.h

@@ -41,8 +41,7 @@
 #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, size_t step);
+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 void luaS_resize (lua_State *L, int newsize);

lstrlib.c

@@ -1365,7 +1365,6 @@ typedef union Ftypes {
   float f;
   double d;
   lua_Number n;
-  char buff[5 * sizeof(lua_Number)];  /* enough for any float type */
 } Ftypes;
 
 
@@ -1535,12 +1534,10 @@ static void packint (luaL_Buffer *b, lua_Unsigned n,
 ** Copy 'size' bytes from 'src' to 'dest', correcting endianness if
 ** given 'islittle' is different from native endianness.
 */
-static void copywithendian (volatile char *dest, volatile const char *src,
+static void copywithendian (char *dest, const char *src,
                             int size, int islittle) {
-  if (islittle == nativeendian.little) {
-    while (size-- != 0)
-      *(dest++) = *(src++);
-  }
+  if (islittle == nativeendian.little)
+    memcpy(dest, src, size);
   else {
     dest += size - 1;
     while (size-- != 0)
@@ -1584,14 +1581,14 @@ static int str_pack (lua_State *L) {
         break;
       }
       case Kfloat: {  /* floating-point options */
-        volatile Ftypes u;
+        Ftypes u;
         char *buff = luaL_prepbuffsize(&b, size);
         lua_Number n = luaL_checknumber(L, arg);  /* get argument */
         if (size == sizeof(u.f)) u.f = (float)n;  /* copy it into 'u' */
         else if (size == sizeof(u.d)) u.d = (double)n;
         else u.n = n;
         /* move 'u' to final result, correcting endianness if needed */
-        copywithendian(buff, u.buff, size, h.islittle);
+        copywithendian(buff, (char *)&u, size, h.islittle);
         luaL_addsize(&b, size);
         break;
       }
@@ -1717,9 +1714,9 @@ static int str_unpack (lua_State *L) {
         break;
       }
       case Kfloat: {
-        volatile Ftypes u;
+        Ftypes u;
         lua_Number num;
-        copywithendian(u.buff, data + pos, size, h.islittle);
+        copywithendian((char *)&u, data + pos, size, h.islittle);
         if (size == sizeof(u.f)) num = (lua_Number)u.f;
         else if (size == sizeof(u.d)) num = (lua_Number)u.d;
         else num = u.n;
@@ -1738,7 +1735,7 @@ static int str_unpack (lua_State *L) {
         break;
       }
       case Kzstr: {
-        size_t len = (int)strlen(data + pos);
+        size_t len = strlen(data + pos);
         luaL_argcheck(L, pos + len < ld, 2,
                          "unfinished string for format 'z'");
         lua_pushlstring(L, data + pos, len);

ltable.c

@@ -166,17 +166,30 @@ static Node *mainpositionTV (const Table *t, const TValue *key) {
 
 
 /*
-** Check whether key 'k1' is equal to the key in node 'n2'.
-** This equality is raw, so there are no metamethods. Floats
-** with integer values have been normalized, so integers cannot
-** be equal to floats. It is assumed that 'eqshrstr' is simply
-** pointer equality, so that short strings are handled in the
-** default case.
+** 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.)
 */
-static int equalkey (const TValue *k1, const Node *n2) {
-  if (rawtt(k1) != keytt(n2))  /* not the same variants? */
+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 (ttypetag(k1)) {
+  switch (keytt(n2)) {
     case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
       return 1;
     case LUA_VNUMINT:
@@ -187,7 +200,7 @@ static int equalkey (const TValue *k1, const Node *n2) {
       return pvalue(k1) == pvalueraw(keyval(n2));
     case LUA_VLCF:
       return fvalue(k1) == fvalueraw(keyval(n2));
-    case LUA_VLNGSTR:
+    case ctb(LUA_VLNGSTR):
       return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
     default:
       return gcvalue(k1) == gcvalueraw(keyval(n2));
@@ -251,11 +264,12 @@ static unsigned int setlimittosize (Table *t) {
 /*
 ** "Generic" get version. (Not that generic: not valid for integers,
 ** which may be in array part, nor for floats with integral values.)
+** See explanation about 'deadok' in function 'equalkey'.
 */
-static const TValue *getgeneric (Table *t, const TValue *key) {
+static const TValue *getgeneric (Table *t, const TValue *key, int deadok) {
   Node *n = mainpositionTV(t, key);
   for (;;) {  /* check whether 'key' is somewhere in the chain */
-    if (equalkey(key, n))
+    if (equalkey(key, n, deadok))
       return gval(n);  /* that's it */
     else {
       int nx = gnext(n);
@@ -292,7 +306,7 @@ static unsigned int findindex (lua_State *L, Table *t, TValue *key,
   if (i - 1u < asize)  /* is 'key' inside array part? */
     return i;  /* yes; that's the index */
   else {
-    const TValue *n = getgeneric(t, key);
+    const TValue *n = getgeneric(t, key, 1);
     if (unlikely(isabstkey(n)))
       luaG_runerror(L, "invalid key to 'next'");  /* key not found */
     i = cast_int(nodefromval(n) - gnode(t, 0));  /* key index in hash table */
@@ -583,7 +597,7 @@ 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(~0);
+  t->flags = cast_byte(maskflags);  /* table has no metamethod fields */
   t->array = NULL;
   t->alimit = 0;
   setnodevector(L, t, 0);
@@ -730,7 +744,7 @@ const TValue *luaH_getstr (Table *t, TString *key) {
   else {  /* for long strings, use generic case */
     TValue ko;
     setsvalue(cast(lua_State *, NULL), &ko, key);
-    return getgeneric(t, &ko);
+    return getgeneric(t, &ko, 0);
   }
 }
 
@@ -750,7 +764,7 @@ const TValue *luaH_get (Table *t, const TValue *key) {
       /* else... */
     }  /* FALLTHROUGH */
     default:
-      return getgeneric(t, key);
+      return getgeneric(t, key, 0);
   }
 }
 

ltable.h

@@ -15,7 +15,12 @@
 #define gnext(n)	((n)->u.next)
 
 
-#define invalidateTMcache(t)	((t)->flags = 0)
+/*
+** Clear all bits of fast-access metamethods, which means that the table
+** may have any of these metamethods. (First access that fails after the
+** clearing will set the bit again.)
+*/
+#define invalidateTMcache(t)	((t)->flags &= ~maskflags)
 
 
 /* true when 't' is using 'dummynode' as its hash part */

ltests.c

@@ -121,7 +121,8 @@ static void warnf (void *ud, const char *msg, int tocont) {
   strcat(buff, msg);  /* add new message to current warning */
   if (!tocont) {  /* message finished? */
     lua_unlock(L);
-    if (lua_getglobal(L, "_WARN") == LUA_TNIL)
+    lua_getglobal(L, "_WARN");
+    if (!lua_toboolean(L, -1))
       lua_pop(L, 1);  /* ok, no previous unexpected warning */
     else {
       badexit("Unhandled warning in store mode: %s\naborting...\n",
@@ -144,7 +145,6 @@ static void warnf (void *ud, const char *msg, int tocont) {
         lua_pushstring(L, buff);
         lua_setglobal(L, "_WARN");  /* assign message to global '_WARN' */
         lua_lock(L);
-        buff[0] = '\0';  /* prepare buffer for next warning */
         break;
       }
     }
@@ -186,7 +186,8 @@ typedef union Header {
 
 
 Memcontrol l_memcontrol =
-  {0UL, 0UL, 0UL, 0UL, (~0UL), {0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL}};
+  {0, 0UL, 0UL, 0UL, 0UL, (~0UL),
+   {0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL}};
 
 
 static void freeblock (Memcontrol *mc, Header *block) {
@@ -225,6 +226,10 @@ void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) {
     freeblock(mc, block);
     return NULL;
   }
+  if (mc->failnext) {
+    mc->failnext = 0;
+    return NULL;  /* fake a single memory allocation error */
+  }
   if (mc->countlimit != ~0UL && size != oldsize) {  /* count limit in use? */
     if (mc->countlimit == 0)
       return NULL;  /* fake a memory allocation error */
@@ -309,6 +314,10 @@ static void printobj (global_State *g, GCObject *o) {
 }
 
 
+void lua_printobj (lua_State *L, struct GCObject *o) {
+  printobj(G(L), o);
+}
+
 static int testobjref (global_State *g, GCObject *f, GCObject *t) {
   int r1 = testobjref1(g, f, t);
   if (!r1) {
@@ -421,17 +430,17 @@ static void checkstack (global_State *g, lua_State *L1) {
   UpVal *uv;
   lua_assert(!isdead(g, L1));
   if (L1->stack == NULL) {  /* incomplete thread? */
-    lua_assert(L1->stacksize == 0 && L1->openupval == NULL &&
-               L1->ci == NULL);
+    lua_assert(L1->openupval == NULL && L1->ci == NULL);
     return;
   }
   for (uv = L1->openupval; uv != NULL; uv = uv->u.open.next)
     lua_assert(upisopen(uv));  /* must be open */
+  lua_assert(L1->top <= L1->stack_last);
   for (ci = L1->ci; ci != NULL; ci = ci->previous) {
     lua_assert(ci->top <= L1->stack_last);
     lua_assert(lua_checkpc(ci));
   }
-  for (o = L1->stack; o < L1->stack_last + EXTRA_STACK; o++)
+  for (o = L1->stack; o < L1->stack_last; o++)
     checkliveness(L1, s2v(o));  /* entire stack must have valid values */
 }
 
@@ -509,10 +518,15 @@ static void checkobject (global_State *g, GCObject *o, int maybedead,
 }
 
 
-static void checkgraylist (global_State *g, GCObject *o) {
+static lu_mem checkgraylist (global_State *g, GCObject *o) {
+  int total = 0;  /* count number of elements in the list */
   ((void)g);  /* better to keep it available if we need to print an object */
   while (o) {
-    lua_assert(isgray(o) || getage(o) == G_TOUCHED2);
+    lua_assert(!!isgray(o) ^ (getage(o) == G_TOUCHED2));
+    lua_assert(!testbit(o->marked, TESTBIT));
+    if (keepinvariant(g))
+      l_setbit(o->marked, TESTBIT);  /* mark that object is in a gray list */
+    total++;
     switch (o->tt) {
       case LUA_VTABLE: o = gco2t(o)->gclist; break;
       case LUA_VLCL: o = gco2lcl(o)->gclist; break;
@@ -526,40 +540,72 @@ static void checkgraylist (global_State *g, GCObject *o) {
       default: lua_assert(0);  /* other objects cannot be in a gray list */
     }
   }
+  return total;
 }
 
 
 /*
 ** Check objects in gray lists.
 */
-static void checkgrays (global_State *g) {
-  if (!keepinvariant(g)) return;
-  checkgraylist(g, g->gray);
-  checkgraylist(g, g->grayagain);
-  checkgraylist(g, g->weak);
-  checkgraylist(g, g->ephemeron);
+static lu_mem checkgrays (global_State *g) {
+  int total = 0;  /* count number of elements in all lists */
+  if (!keepinvariant(g)) return total;
+  total += checkgraylist(g, g->gray);
+  total += checkgraylist(g, g->grayagain);
+  total += checkgraylist(g, g->weak);
+  total += checkgraylist(g, g->allweak);
+  total += checkgraylist(g, g->ephemeron);
+  return total;
 }
 
 
-static void checklist (global_State *g, int maybedead, int tof,
+/*
+** Check whether 'o' should be in a gray list. If so, increment
+** 'count' and check its TESTBIT. (It must have been previously set by
+** 'checkgraylist'.)
+*/
+static void incifingray (global_State *g, GCObject *o, lu_mem *count) {
+  if (!keepinvariant(g))
+    return;  /* gray lists not being kept in these phases */
+  if (o->tt == LUA_VUPVAL) {
+    /* only open upvalues can be gray */
+    lua_assert(!isgray(o) || upisopen(gco2upv(o)));
+    return;  /* upvalues are never in gray lists */
+  }
+  /* these are the ones that must be in gray lists */
+  if (isgray(o) || getage(o) == G_TOUCHED2) {
+    (*count)++;
+    lua_assert(testbit(o->marked, TESTBIT));
+    resetbit(o->marked, TESTBIT);  /* prepare for next cycle */
+  }
+}
+
+
+static lu_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 */
   for (o = newl; o != survival; o = o->next) {
     checkobject(g, o, maybedead, G_NEW);
+    incifingray(g, o, &total);
     lua_assert(!tof == !tofinalize(o));
   }
   for (o = survival; o != old; o = o->next) {
     checkobject(g, o, 0, G_SURVIVAL);
+    incifingray(g, o, &total);
     lua_assert(!tof == !tofinalize(o));
   }
   for (o = old; o != reallyold; o = o->next) {
     checkobject(g, o, 0, G_OLD1);
+    incifingray(g, o, &total);
     lua_assert(!tof == !tofinalize(o));
   }
   for (o = reallyold; o != NULL; o = o->next) {
     checkobject(g, o, 0, G_OLD);
+    incifingray(g, o, &total);
     lua_assert(!tof == !tofinalize(o));
   }
+  return total;
 }
 
 
@@ -567,13 +613,15 @@ 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 */
   if (keepinvariant(g)) {
     lua_assert(!iswhite(g->mainthread));
     lua_assert(!iswhite(gcvalue(&g->l_registry)));
   }
   lua_assert(!isdead(g, gcvalue(&g->l_registry)));
   lua_assert(g->sweepgc == NULL || issweepphase(g));
-  checkgrays(g);
+  totalin = checkgrays(g);
 
   /* check 'fixedgc' list */
   for (o = g->fixedgc; o != NULL; o = o->next) {
@@ -582,17 +630,22 @@ int lua_checkmemory (lua_State *L) {
 
   /* check 'allgc' list */
   maybedead = (GCSatomic < g->gcstate && g->gcstate <= GCSswpallgc);
-  checklist(g, maybedead, 0, g->allgc, g->survival, g->old, g->reallyold);
+  totalshould = checklist(g, maybedead, 0, g->allgc,
+                             g->survival, g->old1, g->reallyold);
 
   /* check 'finobj' list */
-  checklist(g, 0, 1, g->finobj, g->finobjsur, g->finobjold, g->finobjrold);
+  totalshould += checklist(g, 0, 1, g->finobj,
+                              g->finobjsur, g->finobjold1, g->finobjrold);
 
   /* check 'tobefnz' list */
   for (o = g->tobefnz; o != NULL; o = o->next) {
     checkobject(g, o, 0, G_NEW);
+    incifingray(g, o, &totalshould);
     lua_assert(tofinalize(o));
     lua_assert(o->tt == LUA_VUSERDATA || o->tt == LUA_VTABLE);
   }
+  if (keepinvariant(g))
+    lua_assert(totalin == totalshould);
   return 0;
 }
 
@@ -748,11 +801,12 @@ static int listlocals (lua_State *L) {
 static void 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("\n");
+  printf("<<\n");
 }
 
 
@@ -802,7 +856,14 @@ static int alloc_count (lua_State *L) {
     l_memcontrol.countlimit = luaL_checkinteger(L, 1);
   return 0;
 }
-  
+
+
+static int alloc_failnext (lua_State *L) {
+  UNUSED(L);
+  l_memcontrol.failnext = 1;
+  return 0;
+}
+
 
 static int settrick (lua_State *L) {
   if (ttisnil(obj_at(L, 1)))
@@ -907,7 +968,7 @@ static int hash_query (lua_State *L) {
 static int stacklevel (lua_State *L) {
   unsigned long a = 0;
   lua_pushinteger(L, (L->top - L->stack));
-  lua_pushinteger(L, (L->stack_last - L->stack));
+  lua_pushinteger(L, stacksize(L));
   lua_pushinteger(L, L->nCcalls);
   lua_pushinteger(L, L->nci);
   lua_pushinteger(L, (unsigned long)&a);
@@ -1282,10 +1343,19 @@ static int getindex_aux (lua_State *L, lua_State *L1, const char **pc) {
 }
 
 
-static void pushcode (lua_State *L, int code) {
-  static const char *const codes[] = {"OK", "YIELD", "ERRRUN",
-                   "ERRSYNTAX", MEMERRMSG, "ERRGCMM", "ERRERR"};
-  lua_pushstring(L, codes[code]);
+static const char *const statcodes[] = {"OK", "YIELD", "ERRRUN",
+    "ERRSYNTAX", MEMERRMSG, "ERRGCMM", "ERRERR"};
+
+/*
+** Avoid these stat codes from being collected, to avoid possible
+** memory error when pushing them.
+*/
+static void regcodes (lua_State *L) {
+  unsigned int i;
+  for (i = 0; i < sizeof(statcodes) / sizeof(statcodes[0]); i++) {
+    lua_pushboolean(L, 1);
+    lua_setfield(L, LUA_REGISTRYINDEX, statcodes[i]);
+  }
 }
 
 
@@ -1508,7 +1578,7 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
       lua_pushnumber(L1, (lua_Number)getnum);
     }
     else if EQ("pushstatus") {
-      pushcode(L1, status);
+      lua_pushstring(L1, statcodes[status]);
     }
     else if EQ("pushstring") {
       lua_pushstring(L1, getstring);
@@ -1668,6 +1738,9 @@ static struct X { int x; } x;
       if (n == 0) n = lua_gettop(fs);
       lua_xmove(fs, ts, n);
     }
+    else if EQ("isyieldable") {
+      lua_pushboolean(L1, lua_isyieldable(lua_tothread(L1, getindex)));
+    }
     else if EQ("yield") {
       return lua_yield(L1, getnum);
     }
@@ -1710,7 +1783,7 @@ static int Cfunc (lua_State *L) {
 
 
 static int Cfunck (lua_State *L, int status, lua_KContext ctx) {
-  pushcode(L, status);
+  lua_pushstring(L, statcodes[status]);
   lua_setglobal(L, "status");
   lua_pushinteger(L, ctx);
   lua_setglobal(L, "ctx");
@@ -1847,6 +1920,7 @@ static const struct luaL_Reg tests_funcs[] = {
   {"makeCfunc", makeCfunc},
   {"totalmem", mem_query},
   {"alloccount", alloc_count},
+  {"allocfailnext", alloc_failnext},
   {"trick", settrick},
   {"udataval", udataval},
   {"unref", unref},
@@ -1865,6 +1939,9 @@ int luaB_opentests (lua_State *L) {
   void *ud;
   lua_atpanic(L, &tpanic);
   lua_setwarnf(L, &warnf, L);
+  lua_pushboolean(L, 0);
+  lua_setglobal(L, "_WARN");  /* _WARN = false */
+  regcodes(L);
   atexit(checkfinalmem);
   lua_assert(lua_getallocf(L, &ud) == debug_realloc);
   lua_assert(ud == cast_voidp(&l_memcontrol));

ltests.h

@@ -20,16 +20,9 @@
 
 
 /* turn on assertions */
-#undef NDEBUG
-#include <assert.h>
-#define lua_assert(c)           assert(c)
+#define LUAI_ASSERT
 
 
-
-/* compiled with -O0, Lua uses a lot of C stack space... */
-#undef LUAI_MAXCSTACK
-#define LUAI_MAXCSTACK		400
-
 /* to avoid warnings, and to make sure value is really unused */
 #define UNUSED(x)       (x=0, (void)(x))
 
@@ -53,6 +46,7 @@
 
 /* memory-allocator control variables */
 typedef struct Memcontrol {
+  int failnext;
   unsigned long numblocks;
   unsigned long total;
   unsigned long maxmem;
@@ -74,7 +68,13 @@ extern void *l_Trick;
 /*
 ** Function to traverse and check all memory used by Lua
 */
-int lua_checkmemory (lua_State *L);
+LUAI_FUNC 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);
 
 
 /* test for lock/unlock */

ltm.c

@@ -240,7 +240,7 @@ void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
   int actual = cast_int(L->top - ci->func) - 1;  /* number of arguments */
   int nextra = actual - nfixparams;  /* number of extra arguments */
   ci->u.l.nextraargs = nextra;
-  checkstackGC(L, p->maxstacksize + 1);
+  luaD_checkstack(L, p->maxstacksize + 1);
   /* copy function to the top of the stack */
   setobjs2s(L, L->top++, ci->func);
   /* move fixed parameters to the top of the stack */
@@ -259,7 +259,7 @@ void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
   int nextra = ci->u.l.nextraargs;
   if (wanted < 0) {
     wanted = nextra;  /* get all extra arguments available */
-    checkstackp(L, nextra, where);  /* ensure stack space */
+    checkstackGCp(L, nextra, where);  /* ensure stack space */
     L->top = where + nextra;  /* next instruction will need top */
   }
   for (i = 0; i < wanted && i < nextra; i++)

ltm.h

@@ -45,6 +45,15 @@ typedef enum {
 } TMS;
 
 
+/*
+** 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'.)
+*/
+#define maskflags	(~(~0u << (TM_EQ + 1)))
+
+
 /*
 ** Test whether there is no tagmethod.
 ** (Because tagmethods use raw accesses, the result may be an "empty" nil.)

lua.c

@@ -416,14 +416,18 @@ static int handle_luainit (lua_State *L) {
 
 
 /*
-** Returns the string to be used as a prompt by the interpreter.
+** Return the string to be used as a prompt by the interpreter. Leave
+** the string (or nil, if using the default value) on the stack, to keep
+** it anchored.
 */
 static const char *get_prompt (lua_State *L, int firstline) {
-  const char *p;
-  lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2");
-  p = lua_tostring(L, -1);
-  if (p == NULL) p = (firstline ? LUA_PROMPT : LUA_PROMPT2);
-  return p;
+  if (lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2") == LUA_TNIL)
+    return (firstline ? LUA_PROMPT : LUA_PROMPT2);  /* use the default */
+  else {  /* apply 'tostring' over the value */
+    const char *p = luaL_tolstring(L, -1, NULL);
+    lua_remove(L, -2);  /* remove original value */
+    return p;
+  }
 }
 
 /* mark in error messages for incomplete statements */

lua.h

@@ -18,7 +18,7 @@
 
 #define LUA_VERSION_MAJOR	"5"
 #define LUA_VERSION_MINOR	"4"
-#define LUA_VERSION_RELEASE	"0"
+#define LUA_VERSION_RELEASE	"2"
 
 #define LUA_VERSION_NUM			504
 #define LUA_VERSION_RELEASE_NUM		(LUA_VERSION_NUM * 100 + 0)

luaconf.h

@@ -36,21 +36,6 @@
 ** =====================================================================
 */
 
-/*
-@@ LUAI_MAXCSTACK defines the maximum depth for nested calls and
-** also limits the maximum depth of other recursive algorithms in
-** the implementation, such as syntactic analysis. A value too
-** large may allow the interpreter to crash (C-stack overflow).
-** The default value seems ok for regular machines, but may be
-** too high for restricted hardware.
-** The test file 'cstack.lua' may help finding a good limit.
-** (It will crash with a limit too high.)
-*/
-#if !defined(LUAI_MAXCSTACK)
-#define LUAI_MAXCSTACK		2000
-#endif
-
-
 /*
 @@ LUA_USE_C89 controls the use of non-ISO-C89 features.
 ** Define it if you want Lua to avoid the use of a few C99 features

lundump.c

@@ -120,7 +120,10 @@ static TString *loadStringN (LoadState *S, Proto *p) {
   }
   else {  /* long string */
     ts = luaS_createlngstrobj(L, size);  /* create string */
+    setsvalue2s(L, L->top, ts);  /* anchor it ('loadVector' can GC) */
+    luaD_inctop(L);
     loadVector(S, getstr(ts), size);  /* load directly in final place */
+    L->top--;  /* pop string */
   }
   luaC_objbarrier(L, p, ts);
   return ts;
@@ -200,13 +203,20 @@ static void loadProtos (LoadState *S, Proto *f) {
 }
 
 
+/*
+** Load the upvalues for a function. The names must be filled first,
+** because the filling of the other fields can raise read errors and
+** the creation of the error message can call an emergency collection;
+** in that case all prototypes must be consistent for the GC.
+*/
 static void loadUpvalues (LoadState *S, Proto *f) {
   int i, n;
   n = loadInt(S);
   f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
   f->sizeupvalues = n;
-  for (i = 0; i < n; i++) {
+  for (i = 0; i < n; i++)  /* make array valid for GC */
     f->upvalues[i].name = NULL;
+  for (i = 0; i < n; i++) {  /* following calls can raise errors */
     f->upvalues[i].instack = loadByte(S);
     f->upvalues[i].idx = loadByte(S);
     f->upvalues[i].kind = loadByte(S);

lvm.c

@@ -229,7 +229,7 @@ static int forprep (lua_State *L, StkId ra) {
         count /= l_castS2U(-(step + 1)) + 1u;
       }
       /* store the counter in place of the limit (which won't be
-         needed anymore */
+         needed anymore) */
       setivalue(plimit, l_castU2S(count));
     }
   }
@@ -634,7 +634,8 @@ static void copy2buff (StkId top, int n, char *buff) {
 ** from 'L->top - total' up to 'L->top - 1'.
 */
 void luaV_concat (lua_State *L, int total) {
-  lua_assert(total >= 2);
+  if (total == 1)
+    return;  /* "all" values already concatenated */
   do {
     StkId top = L->top;
     int n = 2;  /* number of elements handled in this pass (at least 2) */
@@ -840,10 +841,8 @@ void luaV_finishOp (lua_State *L) {
       int a = GETARG_A(inst);      /* first element to concatenate */
       int total = cast_int(top - 1 - (base + a));  /* yet to concatenate */
       setobjs2s(L, top - 2, top);  /* put TM result in proper position */
-      if (total > 1) {  /* are there elements to concat? */
-        L->top = top - 1;  /* top is one after last element (at top-2) */
-        luaV_concat(L, total);  /* concat them (may yield again) */
-      }
+      L->top = top - 1;  /* top is one after last element (at top-2) */
+      luaV_concat(L, total);  /* concat them (may yield again) */
       break;
     }
     default: {
@@ -1093,18 +1092,14 @@ void luaV_finishOp (lua_State *L) {
 #define ProtectNT(exp)  (savepc(L), (exp), updatetrap(ci))
 
 /*
-** Protect code that will finish the loop (returns) or can only raise
-** errors. (That is, it will not return to the interpreter main loop
-** after changing the stack or hooks.)
+** Protect code that can only raise errors. (That is, it cannnot change
+** the stack or hooks.)
 */
 #define halfProtect(exp)  (savestate(L,ci), (exp))
 
-/* idem, but without changing the stack */
-#define halfProtectNT(exp)  (savepc(L), (exp))
-
-
+/* 'c' is the limit of live values in the stack */
 #define checkGC(L,c)  \
-	{ luaC_condGC(L, L->top = (c),  /* limit of live values */ \
+	{ luaC_condGC(L, (savepc(L), L->top = (c)), \
                          updatetrap(ci)); \
            luai_threadyield(L); }
 
@@ -1133,17 +1128,20 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
 #if LUA_USE_JUMPTABLE
 #include "ljumptab.h"
 #endif
- tailcall:
+ startfunc:
   trap = L->hookmask;
+ returning:  /* trap already set */
   cl = clLvalue(s2v(ci->func));
   k = cl->p->k;
   pc = ci->u.l.savedpc;
   if (trap) {
-    if (cl->p->is_vararg)
-      trap = 0;  /* hooks will start after VARARGPREP instruction */
-    else if (pc == cl->p->code)  /* first instruction (not resuming)? */
-      luaD_hookcall(L, ci);
-    ci->u.l.trap = 1;  /* there may be other hooks */
+    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 */
   }
   base = ci->func + 1;
   /* main loop of interpreter */
@@ -1152,7 +1150,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
     StkId ra;  /* instruction's A register */
     vmfetch();
     lua_assert(base == ci->func + 1);
-    lua_assert(base <= L->top && L->top < L->stack + L->stacksize);
+    lua_assert(base <= L->top && L->top < L->stack_last);
     /* invalidate top for instructions not expecting it */
     lua_assert(isIT(i) || (cast_void(L->top = base), 1));
     vmdispatch (GET_OPCODE(i)) {
@@ -1607,24 +1605,32 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         vmbreak;
       }
       vmcase(OP_CALL) {
+        CallInfo *newci;
         int b = GETARG_B(i);
         int nresults = GETARG_C(i) - 1;
         if (b != 0)  /* fixed number of arguments? */
           L->top = ra + b;  /* top signals number of arguments */
         /* else previous instruction set top */
-        ProtectNT(luaD_call(L, ra, nresults));
+        savepc(L);  /* 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 */
+          ci = newci;
+          ci->callstatus = 0;  /* call re-uses 'luaV_execute' */
+          goto startfunc;
+        }
         vmbreak;
       }
       vmcase(OP_TAILCALL) {
         int b = GETARG_B(i);  /* number of arguments + 1 (function) */
         int nparams1 = GETARG_C(i);
-        /* delat is virtual 'func' - real 'func' (vararg functions) */
+        /* delta is virtual 'func' - real 'func' (vararg functions) */
         int delta = (nparams1) ? ci->u.l.nextraargs + nparams1 : 0;
         if (b != 0)
           L->top = ra + b;
         else  /* previous instruction set top */
           b = cast_int(L->top - ra);
-        savepc(ci);  /* some calls here can raise errors */
+        savepc(ci);  /* several calls here can raise errors */
         if (TESTARG_k(i)) {
           /* close upvalues from current call; the compiler ensures
              that there are no to-be-closed variables here, so this
@@ -1635,19 +1641,20 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         while (!ttisfunction(s2v(ra))) {  /* not a function? */
           luaD_tryfuncTM(L, ra);  /* try '__call' metamethod */
           b++;  /* there is now one extra argument */
-          checkstackp(L, 1, ra);
+          checkstackGCp(L, 1, ra);
         }
         if (!ttisLclosure(s2v(ra))) {  /* C function? */
-          luaD_call(L, ra, LUA_MULTRET);  /* call it */
+          luaD_precall(L, ra, LUA_MULTRET);  /* call it */
           updatetrap(ci);
           updatestack(ci);  /* stack may have been relocated */
-          ci->func -= delta;
-          luaD_poscall(L, ci, cast_int(L->top - ra));
-          return;
+          ci->func -= delta;  /* restore 'func' (if vararg) */
+          luaD_poscall(L, ci, cast_int(L->top - ra));  /* finish caller */
+          updatetrap(ci);  /* 'luaD_poscall' can change hooks */
+          goto ret;  /* caller returns after the tail call */
         }
-        ci->func -= delta;
+        ci->func -= delta;  /* restore 'func' (if vararg) */
         luaD_pretailcall(L, ci, ra, b);  /* prepare call frame */
-        goto tailcall;
+        goto startfunc;  /* execute the callee */
       }
       vmcase(OP_RETURN) {
         int n = GETARG_B(i) - 1;  /* number of results */
@@ -1666,12 +1673,15 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
           ci->func -= ci->u.l.nextraargs + nparams1;
         L->top = ra + n;  /* set call for 'luaD_poscall' */
         luaD_poscall(L, ci, n);
-        return;
+        updatetrap(ci);  /* 'luaD_poscall' can change hooks */
+        goto ret;
       }
       vmcase(OP_RETURN0) {
         if (L->hookmask) {
           L->top = ra;
-          halfProtectNT(luaD_poscall(L, ci, 0));  /* no hurry... */
+          savepc(ci);
+          luaD_poscall(L, ci, 0);  /* no hurry... */
+          trap = 1;
         }
         else {  /* do the 'poscall' here */
           int nres = ci->nresults;
@@ -1680,12 +1690,14 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
           while (nres-- > 0)
             setnilvalue(s2v(L->top++));  /* all results are nil */
         }
-        return;
+        goto ret;
       }
       vmcase(OP_RETURN1) {
         if (L->hookmask) {
           L->top = ra + 1;
-          halfProtectNT(luaD_poscall(L, ci, 1));  /* no hurry... */
+          savepc(ci);
+          luaD_poscall(L, ci, 1);  /* no hurry... */
+          trap = 1;
         }
         else {  /* do the 'poscall' here */
           int nres = ci->nresults;
@@ -1699,7 +1711,13 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
               setnilvalue(s2v(L->top++));
           }
         }
-        return;
+       ret:  /* return from a Lua function */
+        if (ci->callstatus & CIST_FRESH)
+          return;  /* end this frame */
+        else {
+          ci = ci->previous;
+          goto returning;  /* continue running caller in this frame */
+        }
       }
       vmcase(OP_FORLOOP) {
         if (ttisinteger(s2v(ra + 2))) {  /* integer loop? */
@@ -1792,11 +1810,10 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         vmbreak;
       }
       vmcase(OP_VARARGPREP) {
-        luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p);
-        updatetrap(ci);
+        ProtectNT(luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p));
         if (trap) {
           luaD_hookcall(L, ci);
-          L->oldpc = pc + 1;  /* next opcode will be seen as a "new" line */
+          L->oldpc = 1;  /* next opcode will be seen as a "new" line */
         }
         updatebase(ci);  /* function has new base after adjustment */
         vmbreak;

makefile

@@ -37,10 +37,18 @@ CWARNSC= -Wdeclaration-after-statement \
 
 CWARNS= $(CWARNSCPP) $(CWARNSC)
 
+# Some useful compiler options for internal tests:
+# -DLUAI_ASSERT turns on all assertions inside Lua.
+# -DHARDSTACKTESTS forces a reallocation of the stack at every point where
+# the stack can be reallocated.
+# -DHARDMEMTESTS forces a full collection at all points where the collector
+# can run.
+# -DEMERGENCYGCTESTS forces an emergency collection at every single allocation.
+# -DEXTERNMEMCHECK removes internal consistency checking of blocks being
+# deallocated (useful when an external tool like valgrind does the check).
+# -DMAXINDEXRK=k limits range of constants in RK instruction operands.
+# -DLUA_COMPAT_5_3
 
-# -DEXTERNMEMCHECK -DHARDSTACKTESTS -DHARDMEMTESTS -DTRACEMEM='"tempmem"'
-# -DMAXINDEXRK=1 -DLUA_COMPAT_5_3
-# -g -DLUA_USER_H='"ltests.h"'
 # -pg -malign-double
 # -DLUA_USE_CTYPE -DLUA_USE_APICHECK
 # ('-ftrapv' for runtime checks of integer overflows)
@@ -81,11 +89,9 @@ LIB_O=	lbaselib.o ldblib.o liolib.o lmathlib.o loslib.o ltablib.o lstrlib.o \
 LUA_T=	lua
 LUA_O=	lua.o
 
-# LUAC_T=	luac
-# LUAC_O=	luac.o print.o
 
-ALL_T= $(CORE_T) $(LUA_T) $(LUAC_T)
-ALL_O= $(CORE_O) $(LUA_O) $(LUAC_O) $(AUX_O) $(LIB_O)
+ALL_T= $(CORE_T) $(LUA_T)
+ALL_O= $(CORE_O) $(LUA_O) $(AUX_O) $(LIB_O)
 ALL_A= $(CORE_T)
 
 all:	$(ALL_T)
@@ -102,18 +108,6 @@ $(CORE_T): $(CORE_O) $(AUX_O) $(LIB_O)
 $(LUA_T): $(LUA_O) $(CORE_T)
 	$(CC) -o $@ $(MYLDFLAGS) $(LUA_O) $(CORE_T) $(LIBS) $(MYLIBS) $(DL)
 
-$(LUAC_T): $(LUAC_O) $(CORE_T)
-	$(CC) -o $@ $(MYLDFLAGS) $(LUAC_O) $(CORE_T) $(LIBS) $(MYLIBS)
-
-llex.o:
-	$(CC) $(CFLAGS) -Os -c llex.c
-
-lparser.o:
-	$(CC) $(CFLAGS) -Os -c lparser.c
-
-lcode.o:
-	$(CC) $(CFLAGS) -Os -c lcode.c
-
 
 clean:
 	$(RM) $(ALL_T) $(ALL_O)

manual/manual.of

@@ -2436,22 +2436,27 @@ When you interact with the Lua API,
 you are responsible for ensuring consistency.
 In particular,
 @emph{you are responsible for controlling stack overflow}.
-You can use the function @Lid{lua_checkstack}
-to ensure that the stack has enough space for pushing new elements.
+When you call any API function,
+you must ensure the stack has enough room to accommodate the results.
+
+There is one exception to the above rule:
+When you call a Lua function
+without a fixed number of results @seeF{lua_call},
+Lua ensures that the stack has enough space for all results.
+However, it does not ensure any extra space.
+So, before pushing anything on the stack after such a call
+you should use @Lid{lua_checkstack}.
 
 Whenever Lua calls C,
 it ensures that the stack has space for
-at least @defid{LUA_MINSTACK} extra slots.
+at least @defid{LUA_MINSTACK} extra elements;
+that is, you can safely push up to @id{LUA_MINSTACK} values into it.
 @id{LUA_MINSTACK} is defined as 20,
 so that usually you do not have to worry about stack space
 unless your code has loops pushing elements onto the stack.
-
-When you call a Lua function
-without a fixed number of results @seeF{lua_call},
-Lua ensures that the stack has enough space for all results,
-but it does not ensure any extra space.
-So, before pushing anything in the stack after such a call
-you should use @Lid{lua_checkstack}.
+Whenever necessary,
+you can use the function @Lid{lua_checkstack}
+to ensure that the stack has enough space for pushing new elements.
 
 }
 
@@ -2497,6 +2502,40 @@ which behaves like a nil value.
 
 }
 
+@sect3{constchar|@title{Pointers to strings}
+
+Several functions in the API return pointers (@T{const char*})
+to Lua strings in the stack.
+(See @Lid{lua_pushfstring}, @Lid{lua_pushlstring},
+@Lid{lua_pushstring}, and @Lid{lua_tolstring}.
+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.
+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.
+(It can be moved to another index, though.)
+When the index is a pseudo-index (referring to an upvalue),
+the pointer is valid while the corresponding call is active and
+the corresponding upvalue is not modified.
+
+Some functions in the debug interface
+also return pointers to strings,
+namely @Lid{lua_getlocal}, @Lid{lua_getupvalue},
+@Lid{lua_setlocal}, and @Lid{lua_setupvalue}.
+For these functions, the pointer is guaranteed to
+be valid while the caller function is active and
+the given closure (if one was given) is in the stack.
+
+Except for these guarantees,
+the garbage collector is free to invalidate
+any pointer to internal strings.
+
+}
+
 }
 
 @sect2{c-closure| @title{C Closures}
@@ -2661,7 +2700,7 @@ Therefore, if a @N{C function} @id{foo} calls an API function
 and this API function yields
 (directly or indirectly by calling another function that yields),
 Lua cannot return to @id{foo} any more,
-because the @id{longjmp} removes its frame from the C stack.
+because the @id{longjmp} removes its frame from the @N{C stack}.
 
 To avoid this kind of problem,
 Lua raises an error whenever it tries to yield across an API call,
@@ -2685,7 +2724,7 @@ After the thread resumes,
 it eventually will finish running the callee function.
 However,
 the callee function cannot return to the original function,
-because its frame in the C stack was destroyed by the yield.
+because its frame in the @N{C stack} was destroyed by the yield.
 Instead, Lua calls a @def{continuation function},
 which was given as an argument to the callee function.
 As the name implies,
@@ -2791,7 +2830,7 @@ depending on the situation;
 an interrogation mark @Char{?} means that
 we cannot know how many elements the function pops/pushes
 by looking only at its arguments.
-(For instance, they may depend on what is on the stack.)
+(For instance, they may depend on what is in the stack.)
 The third field, @T{x},
 tells whether the function may raise errors:
 @Char{-} means the function never raises any error;
@@ -2807,7 +2846,7 @@ and therefore may raise any errors.
 
 Converts the @x{acceptable index} @id{idx}
 into an equivalent @x{absolute index}
-(that is, one that does not depend on the stack top).
+(that is, one that does not depend on the stack size).
 
 }
 
@@ -3028,7 +3067,7 @@ static int foo (lua_State *L) {
 @APIEntry{int lua_checkstack (lua_State *L, int n);|
 @apii{0,0,-}
 
-Ensures that the stack has space for at least @id{n} extra slots,
+Ensures that the stack has space for at least @id{n} extra elements,
 that is, that you can safely push up to @id{n} values into it.
 It returns false if it cannot fulfill the request,
 either because it would cause the stack
@@ -3036,7 +3075,7 @@ to be greater than a fixed maximum size
 (typically at least several thousand elements) or
 because it cannot allocate memory for the extra space.
 This function never shrinks the stack;
-if the stack already has space for the extra slots,
+if the stack already has space for the extra elements,
 it is left unchanged.
 
 }
@@ -3584,6 +3623,10 @@ plus an associated block of raw memory with @id{size} bytes.
 @Lid{lua_setiuservalue} and @Lid{lua_getiuservalue}.)
 
 The function returns the address of the block of memory.
+Lua ensures that this address is valid as long as
+the corresponding userdata is alive @see{GC}.
+Moreover, if the userdata is marked for finalization @see{finalizers},
+its address is valid at least until the call to its finalizer.
 
 }
 
@@ -3702,10 +3745,13 @@ except that it allows the called function to yield @see{continuations}.
 }
 
 @APIEntry{void lua_pop (lua_State *L, int n);|
-@apii{n,0,-}
+@apii{n,0,e}
 
 Pops @id{n} elements from the stack.
 
+This function can run arbitrary code when removing an index
+marked as to-be-closed from the stack.
+
 }
 
 @APIEntry{void lua_pushboolean (lua_State *L, int b);|
@@ -3764,7 +3810,7 @@ This function is equivalent to @Lid{lua_pushcclosure} with no upvalues.
 @apii{0,1,v}
 
 Pushes onto the stack a formatted string
-and returns a pointer to this string.
+and returns a pointer to this string @see{constchar}.
 It is similar to the @ANSI{sprintf},
 but has two important differences.
 First,
@@ -3838,7 +3884,7 @@ the function returns.
 The string can contain any binary data,
 including @x{embedded zeros}.
 
-Returns a pointer to the internal copy of the string.
+Returns a pointer to the internal copy of the string @see{constchar}.
 
 }
 
@@ -3865,7 +3911,7 @@ Lua will make or reuse an internal copy of the given string,
 so the memory at @id{s} can be freed or reused immediately after
 the function returns.
 
-Returns a pointer to the internal copy of the string.
+Returns a pointer to the internal copy of the string @see{constchar}.
 
 If @id{s} is @id{NULL}, pushes @nil and returns @id{NULL}.
 
@@ -4185,7 +4231,7 @@ for the @Q{newindex} event @see{metatable}.
 }
 
 @APIEntry{void lua_settop (lua_State *L, int index);|
-@apii{?,?,-}
+@apii{?,?,e}
 
 Accepts any index, @N{or 0},
 and sets the stack top to this index.
@@ -4193,6 +4239,9 @@ If the new top is greater than the old one,
 then the new elements are filled with @nil.
 If @id{index} @N{is 0}, then all stack elements are removed.
 
+This function can run arbitrary code when removing an index
+marked as to-be-closed from the stack.
+
 }
 
 @APIEntry{void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud);|
@@ -4277,7 +4326,7 @@ otherwise, returns @id{NULL}.
 }
 
 @APIEntry{void lua_toclose (lua_State *L, int index);|
-@apii{0,0,v}
+@apii{0,0,m}
 
 Marks the given index in the stack as a
 to-be-closed @Q{variable} @see{to-be-closed}.
@@ -4295,10 +4344,16 @@ by any other function in the API except @Lid{lua_settop} or @Lid{lua_pop}.
 This function should not be called for an index
 that is equal to or below an active to-be-closed index.
 
-This function can raise an out-of-memory error.
-In that case, the value in the given index is immediately closed,
+In the case of an out-of-memory error,
+the value in the given index is immediately closed,
 as if it was already marked.
 
+Note that, both in case of errors and of a regular return,
+by the time the @idx{__close} metamethod runs,
+the @N{C stack} was already unwound,
+so that any automatic @N{C variable} declared in the calling function
+will be out of scope.
+
 }
 
 @APIEntry{lua_Integer lua_tointeger (lua_State *L, int index);|
@@ -4338,15 +4393,11 @@ then @id{lua_tolstring} also
 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.
+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}),
 but can contain other zeros in its body.
 
-Because Lua has garbage collection,
-there is no guarantee that the pointer returned by @id{lua_tolstring}
-will be valid after the corresponding Lua value is removed from the stack.
-
 }
 
 @APIEntry{lua_Number lua_tonumber (lua_State *L, int index);|
@@ -4708,7 +4759,7 @@ true if the function is a vararg function
 }
 
 @item{@id{ftransfer}|
-the index on the stack of the first value being @Q{transferred},
+the index in the stack of the first value being @Q{transferred},
 that is, parameters in a call or return values in a return.
 (The other values are in consecutive indices.)
 Using this index, you can access and modify these values
@@ -4860,7 +4911,7 @@ an identification of the @emph{activation record}
 of the function executing at a given level.
 @N{Level 0} is the current running function,
 whereas level @M{n+1} is the function that has called level @M{n}
-(except for tail calls, which do not count on the stack).
+(except for tail calls, which do not count in the stack).
 When called with a level greater than the stack depth,
 @Lid{lua_getstack} returns 0;
 otherwise it returns 1.
@@ -4915,20 +4966,6 @@ calling @Lid{lua_yield} with @id{nresults} equal to zero
 
 }
 
-@APIEntry{int (lua_setcstacklimit) (lua_State *L, unsigned int limit);|
-@apii{0,0,-}
-
-Sets a new limit for the C stack.
-This limit controls how deeply nested calls can go in Lua,
-with the intent of avoiding a stack overflow.
-Returns the old limit in case of success,
-or zero in case of error.
-For more details about this function,
-see @Lid{debug.setcstacklimit},
-its equivalent in the standard library.
-
-}
-
 @APIEntry{void lua_sethook (lua_State *L, lua_Hook f, int mask, int count);|
 @apii{0,0,-}
 
@@ -4947,8 +4984,7 @@ For each event, the hook is called as explained below:
 @description{
 
 @item{The call hook| is called when the interpreter calls a function.
-The hook is called just after Lua enters the new function,
-before the function gets its arguments.
+The hook is called just after Lua enters the new function.
 }
 
 @item{The return hook| is called when the interpreter returns from a function.
@@ -5038,7 +5074,7 @@ refer to the @id{n2}-th upvalue of the Lua closure at index @id{funcindex2}.
 
 
 @C{-------------------------------------------------------------------------}
-@sect1{@title{The Auxiliary Library}
+@sect1{auxlib|@title{The Auxiliary Library}
 
 @simplesect{
 
@@ -5925,7 +5961,7 @@ it returns @id{NULL} instead of raising an error.
 Converts any Lua value at the given index to a @N{C string}
 in a reasonable format.
 The resulting string is pushed onto the stack and also
-returned by the function.
+returned by the function @see{constchar}.
 If @id{len} is not @id{NULL},
 the function also sets @T{*len} with the string length.
 
@@ -6275,9 +6311,11 @@ It may be the string @St{b} (only @x{binary chunk}s),
 or @St{bt} (both binary and text).
 The default is @St{bt}.
 
-Lua does not check the consistency of binary chunks.
-Maliciously crafted binary chunks can crash
-the interpreter.
+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.
 
 }
 
@@ -6775,6 +6813,16 @@ 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 function is inherently insecure,
+as it allows Lua to call any function in any readable dynamic
+library in the system.
+(Lua calls any function assuming the function
+has a proper prototype and respects a proper protocol
+@see{lua_CFunction}.
+Therefore,
+calling an arbitrary function in an arbitrary dynamic library
+more often than not results in an access violation.)
+
 }
 
 @LibEntry{package.path|
@@ -8608,7 +8656,7 @@ which means the function running at level @id{f} of the call stack
 of the given thread:
 @N{level 0} is the current function (@id{getinfo} itself);
 @N{level 1} is the function that called @id{getinfo}
-(except for tail calls, which do not count on the stack);
+(except for tail calls, which do not count in the stack);
 and so on.
 If @id{f} is a number greater than the number of active functions,
 then @id{getinfo} returns @fail.
@@ -8705,34 +8753,6 @@ to the userdata @id{u} plus a boolean,
 
 }
 
-@LibEntry{debug.setcstacklimit (limit)|
-
-Sets a new limit for the C stack.
-This limit controls how deeply nested calls can go in Lua,
-with the intent of avoiding a stack overflow.
-A limit too small restricts recursive calls pointlessly;
-a limit too large exposes the interpreter to stack-overflow crashes.
-Unfortunately, there is no way to know a priori
-the maximum safe limit for a platform.
-
-Each call made from Lua code counts one unit.
-Other operations (e.g., calls made from C to Lua or resuming a coroutine)
-may have a higher cost.
-
-This function has the following restrictions:
-@description{
-@item{It can only be called from the main coroutine (thread);}
-@item{It cannot be called while handling a stack-overflow error;}
-@item{@id{limit} must be less than 40000;}
-@item{@id{limit} cannot be less than the amount of C stack in use.}
-}
-If a call does not respect some restriction,
-it returns a false value.
-Otherwise,
-the call returns the old limit.
-
-}
-
 @LibEntry{debug.sethook ([thread,] hook, mask [, count])|
 
 Sets the given function as the debug hook.

testes/all.lua

@@ -127,8 +127,8 @@ else
   end
 
   Cstacklevel = function ()
-    local _, _, ncalls, nci = T.stacklevel()
-    return ncalls  + nci   -- number of free slots in the C stack
+    local _, _, ncalls = T.stacklevel()
+    return ncalls    -- number of C calls
   end
 end
 

testes/api.lua

@@ -11,6 +11,9 @@ local debug = require "debug"
 local pack = table.pack
 
 
+-- standard error message for memory errors
+local MEMERRMSG = "not enough memory"
+
 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
@@ -408,7 +411,7 @@ do
 
   -- memory error
   T.totalmem(T.totalmem()+10000)   -- set low memory limit (+10k)
-  assert(T.checkpanic("newuserdata 20000") == "not enough memory")
+  assert(T.checkpanic("newuserdata 20000") == MEMERRMSG)
   T.totalmem(0)          -- restore high limit
 
   -- stack error
@@ -1153,40 +1156,74 @@ do
 end
 
 
--------------------------------------------------------------------------
--- testing memory limits
--------------------------------------------------------------------------
+--[[
+** {==================================================================
+** 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("not enough memory", f)
+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.
+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.
 
-function testamem (s, f)
-  collectgarbage(); collectgarbage()
+function testalloc (s, f)
+  collectgarbage()
   local M = 0
   local a,b = nil
   while true do
+    collectgarbage(); collectgarbage()
     T.alloccount(M)
-    a, b = pcall(f)
+    a, b = T.testC("pcall 0 1 0; pushstatus; return 2", f)
     T.alloccount()  -- remove limit
-    if a and b then break end       -- stop when no more errors
-    if not a and not    -- `real' error?
-      (string.find(b, "memory") or string.find(b, "overflow")) then
-      error(b, 0)   -- propagate it
+    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("limit for %s: %d allocations", s, M))
-  return b
+  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
 
 
@@ -1196,8 +1233,11 @@ assert(b == 10)
 
 -- testing memory errors when creating a new state
 
-b = testamem("state creation", T.newstate)
-T.closestate(b);  -- close 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 {}
@@ -1345,6 +1385,9 @@ testamem("growing stack", function ()
   return foo(100)
 end)
 
+-- }==================================================================
+
+
 do   -- testing failing in 'lua_checkstack'
   local res = T.testC([[rawcheckstack 500000; return 1]])
   assert(res == false)

testes/calls.lua

@@ -317,6 +317,16 @@ f = load(string.dump(function () return 1 end), nil, "b", {})
 assert(type(f) == "function" and f() == 1)
 
 
+do   -- another bug (in 5.4.0)
+  -- loading a binary long string interrupted by GC cycles
+  local f = string.dump(function ()
+    return '01234567890123456789012345678901234567890123456789'
+  end)
+  f = load(read1(f))
+  assert(f() == '01234567890123456789012345678901234567890123456789')
+end
+
+
 x = string.dump(load("x = 1; return x"))
 a = assert(load(read1(x), nil, "b"))
 assert(a() == 1 and _G.x == 1)
@@ -358,8 +368,12 @@ x = [[
    end
   end
 ]]
+a = assert(load(read1(x), "read", "t"))
+assert(a()(2)(3)(10) == 15)
 
-a = assert(load(read1(x)))
+-- repeat the test loading a binary chunk
+x = string.dump(a)
+a = assert(load(read1(x), "read", "b"))
 assert(a()(2)(3)(10) == 15)
 
 
@@ -422,20 +436,30 @@ assert((function (a) return a end)() == nil)
 
 print("testing binary chunks")
 do
-  local header = string.pack("c4BBc6BBBj",
+  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)
-    0x5678                                     -- LUAC_INT
-    -- LUAC_NUM may not have a unique binary representation (padding...)
+    string.packsize("n")                       -- sizeof(lua number)
   )
-  local c = string.dump(function () local a = 1; local b = 3; return a+b*3 end)
+  local c = string.dump(function ()
+    local a = 1; local b = 3;
+    local f = function () return a + b + _ENV.c; end    -- upvalues
+    local s1 = "a constant"
+    local s2 = "another constant"
+    return a + b * 3
+  end)
 
+  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
   for i = 1, #header do
@@ -451,7 +475,6 @@ do
     local st, msg = load(string.sub(c, 1, i))
     assert(not st and string.find(msg, "truncated"))
   end
-  assert(assert(load(c))() == 10)
 end
 
 print('OK')

testes/closure.lua

@@ -242,7 +242,7 @@ end
 
 assert(debug.upvalueid(foo1, 1))
 assert(debug.upvalueid(foo1, 2))
-assert(not pcall(debug.upvalueid, foo1, 3))
+assert(not debug.upvalueid(foo1, 3))
 assert(debug.upvalueid(foo1, 1) == debug.upvalueid(foo2, 2))
 assert(debug.upvalueid(foo1, 2) == debug.upvalueid(foo2, 1))
 assert(debug.upvalueid(foo3, 1))

testes/code.lua

@@ -392,28 +392,6 @@ check(function (a, b)
       end,
 'TEST', 'JMP', 'TEST', 'JMP', 'ADDI', 'MMBINI', 'JMP', 'RETURN0')
 
-checkequal(
-function (a) while a < 10 do a = a + 1 end end,
-function (a)
-  ::loop::
-  if not (a < 10) then goto exit end
-  a = a + 1
-  goto loop
-::exit::
-end
-)
-
-checkequal(
-function (a) repeat local x = a + 1; a = x until a > 0 end,
-function (a)
-  ::loop:: do
-    local x = a + 1
-    a = x
-  end
-  if not (a > 0) then goto loop end
-end
-)
-
 checkequal(function () return 6 or true or nil end,
            function () return k6 or kTrue or kNil end)
 

testes/coroutine.lua

@@ -124,6 +124,11 @@ x, a = nil
 
 
 -- coroutine closing
+
+local function func2close (f)
+  return setmetatable({}, {__close = f})
+end
+
 do
   -- ok to close a dead coroutine
   local co = coroutine.create(print)
@@ -146,10 +151,6 @@ do
   -- to-be-closed variables in coroutines
   local X
 
-  local function func2close (f)
-    return setmetatable({}, {__close = f})
-  end
-
   co = coroutine.create(function ()
     local x <close> = func2close(function (self, err)
       assert(err == nil); X = false
@@ -184,7 +185,7 @@ do
   if not T then
     warn("@on")
   else   -- test library
-    assert(string.find(_WARN, "200")); _WARN = nil
+    assert(string.find(_WARN, "200")); _WARN = false
     warn("@normal")
   end
   assert(st == false and coroutine.status(co) == "dead" and msg == 111)
@@ -192,6 +193,23 @@ do
 
 end
 
+do
+  -- <close> versus pcall in coroutines
+  local X = false
+  local Y = false
+  function foo ()
+    local x <close> = func2close(function (self, err)
+      Y = debug.getinfo(2)
+      X = err
+    end)
+    error(43)
+  end
+  co = coroutine.create(function () return pcall(foo) end)
+  local st1, st2, err = coroutine.resume(co)
+  assert(st1 and not st2 and err == 43)
+  assert(X == 43 and Y.name == "pcall")
+end
+
 
 -- yielding across C boundaries
 
@@ -407,7 +425,8 @@ assert(_G.f() == 12)
 
 
 if not T then
-  (Message or print)('\n >>> testC not active: skipping yield/hook tests <<<\n')
+  (Message or print)
+      ('\n >>> testC not active: skipping coroutine API tests <<<\n')
 else
   print "testing yields inside hooks"
 
@@ -564,8 +583,17 @@ else
          c == "ERRRUN" and d == 4)
 
 
-  -- using a main thread as a coroutine
+  -- using a main thread as a coroutine  (dubious use!)
   local state = T.newstate()
+
+  -- check that yielddable is working correctly
+  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"))
+
+  T.testC(state, "settop 0")
+
   T.loadlib(state)
 
   assert(T.doremote(state, [[

testes/cstack.lua

@@ -1,73 +1,29 @@
 -- $Id: testes/cstack.lua $
 -- See Copyright Notice in file all.lua
 
-local debug = require "debug"
 
-print"testing C-stack overflow detection"
-print"If this test crashes, see its file ('cstack.lua')"
+print"testing stack overflow detection"
 
 -- Segmentation faults in these tests probably result from a C-stack
--- overflow. To avoid these errors, you can use the function
--- 'debug.setcstacklimit' to set a smaller limit for the use of
--- C stack by Lua. After finding a reliable limit, you might want
--- to recompile Lua with this limit as the value for
--- the constant 'LUAI_MAXCCALLS', which defines the default limit.
--- (The default limit is printed by this test.)
+-- overflow. To avoid these errors, you should set a smaller limit for
+-- the use of C stack by Lua, by changing the constant 'LUAI_MAXCCALLS'.
 -- Alternatively, you can ensure a larger stack for the program.
 
--- For Linux, a limit up to 30_000 seems Ok. Windows cannot go much
--- higher than 2_000.
-
-
--- get and print original limit
-local origlimit <const> = debug.setcstacklimit(400)
-print("default stack limit: " .. origlimit)
-
-
--- Do the tests using the original limit. Or else you may want to change
--- 'currentlimit' to lower values to avoid a seg. fault or to higher
--- values to check whether they are reliable.
-local currentlimit <const> =  origlimit
-debug.setcstacklimit(currentlimit)
-print("current stack limit: " .. currentlimit)
-
 
 local function checkerror (msg, f, ...)
   local s, err = pcall(f, ...)
   assert(not s and string.find(err, msg))
 end
 
--- auxiliary function to keep 'count' on the screen even if the program
--- crashes.
-local count
-local back = string.rep("\b", 8)
-local function progress ()
-  count = count + 1
-  local n = string.format("%-8d", count)
-  io.stderr:write(back, n)   -- erase previous value and write new one
-end
-
-
-do    print("testing simple recursion:")
-  count = 0
-  local function foo ()
-    progress()
-    foo()   -- do recursive calls until a stack error (or crash)
-  end
-  checkerror("stack overflow", foo)
-  print("\tfinal count: ", count)
-end
-
-
 do  print("testing stack overflow in message handling")
-  count = 0
+  local count = 0
   local function loop (x, y, z)
-    progress()
+    count = count + 1
     return 1 + loop(x, y, z)
   end
   local res, msg = xpcall(loop, loop)
   assert(msg == "error in error handling")
-  print("\tfinal count: ", count)
+  print("final count: ", count)
 end
 
 
@@ -80,81 +36,114 @@ do  print("testing recursion inside pattern matching")
   end
   local m = f(80)
   assert(#m == 80)
-  checkerror("too complex", f, 200000)
+  checkerror("too complex", f, 2000)
 end
 
 
 do  print("testing stack-overflow in recursive 'gsub'")
-  count = 0
+  local count = 0
   local function foo ()
-    progress()
+    count = count + 1
     string.gsub("a", ".", foo)
   end
   checkerror("stack overflow", foo)
-  print("\tfinal count: ", count)
+  print("final count: ", count)
 
   print("testing stack-overflow in recursive 'gsub' with metatables")
-  count = 0
+  local count = 0
   local t = setmetatable({}, {__index = foo})
   foo = function ()
     count = count + 1
-    progress(count)
     string.gsub("a", ".", t)
   end
   checkerror("stack overflow", foo)
-  print("\tfinal count: ", count)
+  print("final count: ", count)
 end
 
 
-do  print("testing changes in C-stack limit")
-
-  -- Just an alternative limit, different from the current one
-  -- (smaller to avoid stack overflows)
-  local alterlimit <const> = currentlimit * 8 // 10
-
-  assert(not debug.setcstacklimit(0))        -- limit too small
-  assert(not debug.setcstacklimit(50000))    -- limit too large
-  local co = coroutine.wrap (function ()
-               return debug.setcstacklimit(alterlimit)
-             end)
-  assert(not co())         -- cannot change C stack inside coroutine
-
-  local n
-  local function foo () n = n + 1; foo () end
-
-  local function check ()
-    n = 0
-    pcall(foo)
-    return n
+do   -- bug in 5.4.0
+  print("testing limits in coroutines inside deep calls")
+  local count = 0
+  local lim = 1000
+  local function stack (n)
+    if n > 0 then return stack(n - 1) + 1
+    else coroutine.wrap(function ()
+           count = count + 1
+           stack(lim)
+         end)()
+    end
   end
 
-  -- set limit to 'alterlimit'
-  assert(debug.setcstacklimit(alterlimit) == currentlimit)
-  local limalter <const> = check()
-  -- set a very low limit (given that there are already several active
-  -- calls to arrive here)
-  local lowlimit <const> = 38
-  assert(debug.setcstacklimit(lowlimit) == alterlimit)
-  -- usable limit is much lower, due to active calls
-  local actuallow = check()
-  assert(actuallow < lowlimit - 30)
-  -- now, add 'lowlimit' extra slots, which should all be available
-  assert(debug.setcstacklimit(lowlimit + lowlimit) == lowlimit)
-  local lim2 <const> = check()
-  assert(lim2 == actuallow + lowlimit)
-
-
-  -- 'setcstacklimit' works inside protected calls. (The new stack
-  -- limit is kept when 'pcall' returns.)
-  assert(pcall(function ()
-    assert(debug.setcstacklimit(alterlimit) == lowlimit * 2)
-    assert(check() <= limalter)
-  end))
-
-  assert(check() == limalter)
-  -- restore original limit
-  assert(debug.setcstacklimit(origlimit) == alterlimit)
+  local st, msg = xpcall(stack, function () return "ok" end, lim)
+  assert(not st and msg == "ok")
+  print("final count: ", count)
 end
 
 
+do
+  print("nesting of resuming yielded coroutines")
+  local count = 0
+
+  local function body ()
+    coroutine.yield()
+    local f = coroutine.wrap(body)
+    f();  -- start new coroutine (will stop in previous yield)
+    count = count + 1
+    f()   -- call it recursively
+  end
+
+  local f = coroutine.wrap(body)
+  f()
+  assert(not pcall(f))
+  print("final count: ", count)
+end
+
+
+if T then
+  print("testing stack recovery")
+  local N = 0      -- trace number of calls
+  local LIM = -1   -- will store N just before stack overflow
+
+  -- trace stack size; after stack overflow, it should be
+  -- the maximum allowed stack size.
+  local stack1
+  local dummy
+
+  local function err(msg)
+    assert(string.find(msg, "stack overflow"))
+    local _, stacknow = T.stacklevel()
+    assert(stacknow == stack1 + 200)
+  end
+
+  -- When LIM==-1, the 'if' is not executed, so this function only
+  -- counts and stores the stack limits up to overflow.  Then, LIM
+  -- becomes N, and then the 'if' code is run when the stack is
+  -- full. Then, there is a stack overflow inside 'xpcall', after which
+  -- the stack must have been restored back to its maximum normal size.
+  local function f()
+    dummy, stack1 = T.stacklevel()
+    if N == LIM then
+      xpcall(f, err)
+      local _, stacknow = T.stacklevel()
+      assert(stacknow == stack1)
+      return
+    end
+    N = N + 1
+    f()
+  end
+
+  local topB, sizeB   -- top and size Before overflow
+  local topA, sizeA   -- top and size After overflow
+  topB, sizeB = T.stacklevel()
+  xpcall(f, err)
+  topA, sizeA = T.stacklevel()
+  -- sizes should be comparable
+  assert(topA == topB and sizeA < sizeB * 2)
+  print(string.format("maximum stack size: %d", stack1))
+  LIM = N      -- will stop recursion at maximum level
+  N = 0        -- to count again
+  f()
+  print"+"
+end
+
 print'OK'

testes/db.lua

@@ -119,6 +119,16 @@ else
 end
 ]], {2,3,4,7})
 
+test([[
+local function foo()
+end
+foo()
+A = 1
+A = 2
+A = 3
+]], {2, 3, 2, 4, 5, 6})
+
+
 test([[--
 if nil then
   a=1
@@ -884,7 +894,7 @@ end
 
 
 print("testing debug functions on chunk without debug info")
-prog = [[-- program to be loaded without debug information
+prog = [[-- program to be loaded without debug information (strip)
 local debug = require'debug'
 local a = 12  -- a local variable
 
@@ -927,6 +937,23 @@ local f = assert(load(string.dump(load(prog), true)))
 
 assert(f() == 13)
 
+do   -- bug in 5.4.0: line hooks in stripped code
+  local function foo ()
+    local a = 1
+    local b = 2
+    return b
+  end
+
+  local s = load(string.dump(foo, true))
+  local line = true
+  debug.sethook(function (e, l)
+    assert(e == "line")
+    line = l
+  end, "l")
+  assert(s() == 2); debug.sethook(nil)
+  assert(line == nil)  -- hook called withoug debug info for 1st instruction
+end
+
 do   -- tests for 'source' in binary dumps
   local prog = [[
     return function (x)

testes/errors.lua

@@ -386,25 +386,33 @@ if not _soft then
   collectgarbage()
   print"testing stack overflow"
   C = 0
-  local l = debug.getinfo(1, "l").currentline; function y () C=C+1; y() end
+  -- get line where stack overflow will happen
+  local l = debug.getinfo(1, "l").currentline + 1
+  local function auxy () C=C+1; auxy() end     -- produce a stack overflow
+  function y ()
+    collectgarbage("stop")   -- avoid running finalizers without stack space
+    auxy()
+    collectgarbage("restart")
+  end
 
   local function checkstackmessage (m)
+    print("(expected stack overflow after " .. C .. " calls)")
+    C = 0    -- prepare next count
     return (string.find(m, "stack overflow"))
   end
   -- repeated stack overflows (to check stack recovery)
   assert(checkstackmessage(doit('y()')))
-  print('+')
   assert(checkstackmessage(doit('y()')))
-  print('+')
   assert(checkstackmessage(doit('y()')))
-  print('+')
 
 
   -- error lines in stack overflow
-  C = 0
   local l1
   local function g(x)
-    l1 = debug.getinfo(x, "l").currentline; y()
+    l1 = debug.getinfo(x, "l").currentline + 2
+    collectgarbage("stop")   -- avoid running finalizers without stack space
+    auxy()
+    collectgarbage("restart")
   end
   local _, stackmsg = xpcall(g, debug.traceback, 1)
   print('+')
@@ -530,10 +538,10 @@ local function testrep (init, rep, close, repc, finalresult)
   if (finalresult) then
     assert(res() == finalresult)
   end
-  s = init .. string.rep(rep, 10000)
-  local res, msg = load(s)   -- 10000 levels not ok
-  assert(not res and (string.find(msg, "too many registers") or
-                      string.find(msg, "stack overflow")))
+  s = init .. string.rep(rep, 500)
+  local res, msg = load(s)   -- 500 levels not ok
+  assert(not res and (string.find(msg, "too many") or
+                      string.find(msg, "overflow")))
 end
 
 testrep("local a; a", ",a", "= 1", ",1")    -- multiple assignment

testes/events.lua

@@ -305,6 +305,17 @@ t[Set{1,3,5}] = 1
 assert(t[Set{1,3,5}] == undef)
 
 
+do   -- test invalidating flags
+  local mt = {__eq = true}
+  local a = setmetatable({10}, mt)
+  local b = setmetatable({10}, mt)
+  mt.__eq = nil
+  assert(a ~= b)   -- no metamethod
+  mt.__eq = function (x,y) return x[1] == y[1] end
+  assert(a == b)   -- must use metamethod now
+end
+
+
 if not T then
   (Message or print)('\n >>> testC not active: skipping tests for \z
 userdata <<<\n')

testes/files.lua

@@ -721,6 +721,21 @@ if not _port then
     progname = '"' .. arg[i + 1] .. '"'
   end
   print("testing popen/pclose and execute")
+  -- invalid mode for popen
+  checkerr("invalid mode", io.popen, "cat", "")
+  checkerr("invalid mode", io.popen, "cat", "r+")
+  checkerr("invalid mode", io.popen, "cat", "rw")
+  do  -- basic tests for popen
+    local file = os.tmpname()
+    local f = assert(io.popen("cat - > " .. file, "w"))
+    f:write("a line")
+    assert(f:close())
+    local f = assert(io.popen("cat - < " .. file, "r"))
+    assert(f:read("a") == "a line")
+    assert(f:close())
+    assert(os.remove(file))
+  end
+
   local tests = {
     -- command,   what,  code
     {"ls > /dev/null", "ok"},

testes/gc.lua

@@ -372,7 +372,7 @@ if T then
   warn("@on"); warn("@store")
   collectgarbage()
   assert(string.find(_WARN, "error in __gc metamethod"))
-  assert(string.match(_WARN, "@(.-)@") == "expected"); _WARN = nil
+  assert(string.match(_WARN, "@(.-)@") == "expected"); _WARN = false
   for i = 8, 10 do assert(s[i]) end
 
   for i = 1, 5 do
@@ -481,7 +481,7 @@ if T then
   u = setmetatable({}, {__gc = function () error "@expected error" end})
   u = nil
   collectgarbage()
-  assert(string.find(_WARN, "@expected error")); _WARN = nil
+  assert(string.find(_WARN, "@expected error")); _WARN = false
   warn("@normal")
 end
 
@@ -657,14 +657,14 @@ if T then
     n = n + 1
     assert(n == o[1])
     if n == 1 then
-      _WARN = nil
+      _WARN = false
     elseif n == 2 then
       assert(find(_WARN, "@expected warning"))
       lastmsg = _WARN    -- get message from previous error (first 'o')
     else
       assert(lastmsg == _WARN)  -- subsequent error messages are equal
     end
-    warn("@store"); _WARN = nil
+    warn("@store"); _WARN = false
     error"@expected warning"
   end}
   for i = 10, 1, -1 do

testes/gengc.lua

@@ -37,6 +37,92 @@ do
 end
 
 
+do
+  -- ensure that 'firstold1' is corrected when object is removed from
+  -- the 'allgc' list
+  local function foo () end
+  local old = {10}
+  collectgarbage()    -- make 'old' old
+  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
+  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
+end
+
+
+do   -- bug in 5.4.0
+-- When an object aged OLD1 is finalized, it is moved from the list
+-- 'finobj' to the *beginning* of the list 'allgc', but that part of the
+-- list was not being visited by 'markold'.
+  local A = {}
+  A[1] = false     -- old anchor for object
+
+  -- obj finalizer
+  local function gcf (obj)
+    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
+    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
+  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
+end
+
+
+do   -- another bug in 5.4.0
+  local old = {10}
+  collectgarbage()   -- make 'old' old
+  local co = coroutine.create(
+    function ()
+      local x = nil
+      local f = function ()
+                  return x[1]
+                end
+      x = coroutine.yield(f)
+      coroutine.yield()
+    end
+  )
+  local _, f = coroutine.resume(co)   -- create closure over 'x' in coroutine
+  collectgarbage("step", 0)   -- 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
+  assert(f() == 123 and old[1][1] == "hello")
+  collectgarbage("step", 0)   -- run the collector once more
+  -- make sure old[1] was not collected
+  assert(f() == 123 and old[1][1] == "hello")
+end
+
+
+do   -- bug introduced in commit 9cf3299fa
+  local t = setmetatable({}, {__mode = "kv"})   -- all-weak table
+  collectgarbage()   -- full collection
+  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
+  assert(not T or (T.gcage(t) == "touched2" and T.gccolor(t) == "black"))
+  collectgarbage("step", 0)   -- 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
+  -- t, being old, is ignored by the collection, so it is not cleared
+  assert(t[1] == nil)   -- fails with the bug
+end
+
+
 if T == nil then
   (Message or print)('\n >>> testC not active: \z
                              skipping some generational tests <<<\n')
@@ -72,6 +158,9 @@ do
   assert(debug.getuservalue(U).x[1] == 234)
 end
 
+-- just to make sure
+assert(collectgarbage'isrunning')
+
 
 
 -- just to make sure

testes/locals.lua

@@ -246,6 +246,11 @@ do
 
   X = false
   foo = function (x)
+    local _<close> = func2close(function ()
+      -- without errors, enclosing function should be still active when
+      -- __close is called
+      assert(debug.getinfo(2).name == "foo")
+    end)
     local  _<close> = closescope
     local y = 15
     return y
@@ -337,16 +342,28 @@ local function endwarn ()
   if not T then
     warn("@on")          -- back to normal
   else
-    assert(_WARN == nil)
+    assert(_WARN == false)
     warn("@normal")
   end
 end
 
 
+-- errors inside __close can generate a warning instead of an
+-- error. This new 'assert' force them to appear.
+local function assert(cond, msg)
+  if not cond then
+    local line = debug.getinfo(2).currentline or "?"
+    msg = string.format("assertion failed! line %d (%s)\n", line, msg or "")
+    io.stderr:write(msg)
+    os.exit(1)
+  end
+end
+
+
 local function checkwarn (msg)
   if T then
     assert(string.find(_WARN, msg))
-    _WARN = nil    -- reset variable to check next warning
+    _WARN = false    -- reset variable to check next warning
   end
 end
 
@@ -406,11 +423,15 @@ do print("testing errors in __close")
 
     local x <close> =
       func2close(function (self, msg)
+        -- after error, 'foo' was discarded, so caller now
+        -- must be 'pcall'
+        assert(debug.getinfo(2).name == "pcall")
         assert(msg == 4)
       end)
 
     local x1 <close> =
       func2close(function (self, msg)
+        assert(debug.getinfo(2).name == "pcall")
         checkwarn("@y")
         assert(msg == 4)
         error("@x1")
@@ -420,6 +441,7 @@ do print("testing errors in __close")
 
     local y <close> =
       func2close(function (self, msg)
+        assert(debug.getinfo(2).name == "pcall")
         assert(msg == 4)   -- error in body
         checkwarn("@z")
         error("@y")
@@ -428,6 +450,7 @@ do print("testing errors in __close")
     local first = true
     local z <close> =
       func2close(function (self, msg)
+        assert(debug.getinfo(2).name == "pcall")
         -- 'z' close is called once
         assert(first and msg == 4)
         first = false

testes/main.lua

@@ -287,6 +287,33 @@ RUN([[lua "-e_PROMPT='%s'" -i < %s > %s]], prompt, prog, out)
 local t = getoutput()
 assert(string.find(t, prompt .. ".*" .. prompt .. ".*" .. prompt))
 
+-- using the prompt default
+prepfile[[ --
+a = 2
+]]
+RUN([[lua -i < %s > %s]], prog, out)
+local t = getoutput()
+prompt = "> "    -- the default
+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})"
+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))
+
+
 -- test for error objects
 prepfile[[
 debug = require "debug"
@@ -393,12 +420,12 @@ if T then   -- test library?
   -- testing 'warn'
   warn("@store")
   warn("@123", "456", "789")
-  assert(_WARN == "@123456789"); _WARN = nil
+  assert(_WARN == "@123456789"); _WARN = false
 
   warn("zip", "", " ", "zap")
-  assert(_WARN == "zip zap"); _WARN = nil
+  assert(_WARN == "zip zap"); _WARN = false
   warn("ZIP", "", " ", "ZAP")
-  assert(_WARN == "ZIP ZAP"); _WARN = nil
+  assert(_WARN == "ZIP ZAP"); _WARN = false
   warn("@normal")
 end
 

testes/nextvar.lua

@@ -88,6 +88,7 @@ for _, sa in ipairs(sizes) do    -- 'sa' is size of the array part
     arr[1 + sa + sh + 1] = "}"
     local prog = table.concat(arr)
     local f = assert(load(prog))
+    collectgarbage("stop")
     f()    -- call once to ensure stack space
     -- make sure table is not resized after being created
     if sa == 0 or sh == 0 then
@@ -97,6 +98,7 @@ for _, sa in ipairs(sizes) do    -- 'sa' is size of the array part
     end
     local t = f()
     T.alloccount();
+    collectgarbage("restart")
     assert(#t == sa)
     check(t, sa, mp2(sh))
   end
@@ -357,6 +359,38 @@ end
 assert(n == 5)
 
 
+do
+  print("testing next x GC of deleted keys")
+  -- bug in 5.4.1
+  local co = coroutine.wrap(function (t)
+    for k, v in pairs(t) do
+        local k1 = next(t)    -- all previous keys were deleted
+        assert(k == k1)       -- current key is the first in the table
+        t[k] = nil
+        local expected = (type(k) == "table" and k[1] or
+                          type(k) == "function" and k() or
+                          string.sub(k, 1, 1))
+        assert(expected == v)
+        coroutine.yield(v)
+    end
+  end)
+  local t = {}
+  t[{1}] = 1    -- add several unanchored, collectable keys
+  t[{2}] = 2
+  t[string.rep("a", 50)] = "a"    -- long string
+  t[string.rep("b", 50)] = "b"
+  t[{3}] = 3
+  t[string.rep("c", 10)] = "c"    -- short string
+  t[function () return 10 end] = 10
+  local count = 7
+  while co(t) do
+    collectgarbage("collect")   -- collect dead keys
+    count = count - 1
+  end
+  assert(count == 0 and next(t) == nil)    -- traversed the whole table
+end
+
+
 local function test (a)
   assert(not pcall(table.insert, a, 2, 20));
   table.insert(a, 10); table.insert(a, 2, 20);

testes/strings.lua

@@ -438,7 +438,7 @@ else
 
   -- formats %U, %f, %I already tested elsewhere
 
-  local blen = 400    -- internal buffer length in 'luaO_pushfstring'
+  local blen = 200    -- internal buffer length in 'luaO_pushfstring'
 
   local function callpfs (op, fmt, n)
     local x = {T.testC("pushfstring" .. op .. "; return *", fmt, n)}