issue #139 some more merge

include/ltests.h

@@ -8,6 +8,7 @@
 #define ltests_h
 
 
+#include <stdio.h>
 #include <stdlib.h>
 
 /* test Lua with no compatibility code */
@@ -32,6 +33,7 @@
 #include <assert.h>
 #define lua_assert(c)           assert(c)
 
+
 #if !defined(RAVI_OPTION_STRING1)
 #define RAVI_OPTION_STRING1 " assertions"
 #endif
@@ -57,6 +59,7 @@ typedef struct Memcontrol {
   unsigned long total;
   unsigned long maxmem;
   unsigned long memlimit;
+  unsigned long countlimit;
   unsigned long objcount[LUA_NUMTAGS];
 } Memcontrol;
 

src/lapi.c

@@ -194,6 +194,8 @@ LUA_API void lua_settop (lua_State *L, int idx) {
 /*
 ** Reverse the stack segment from 'from' to 'to'
 ** (auxiliary to 'lua_rotate')
+** Note that we move(copy) only the value inside the stack.
+** (We do not move additional fields that may exist.)
 */
 static void reverse (lua_State *L, StkId from, StkId to) {
   for (; from < to; from++, to--) {
@@ -571,6 +573,7 @@ LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
   lua_lock(L);
   if (n == 0) {
     setfvalue(L->top, fn);
+    api_incr_top(L);
   }
   else {
     CClosure *cl;
@@ -586,9 +589,9 @@ LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
       /* does not need barrier because closure is white */
     }
     setclCvalue(L, L->top, cl);
+    api_incr_top(L);
+    luaC_checkGC(L);
   }
-  api_incr_top(L);
-  luaC_checkGC(L);
   lua_unlock(L);
 }
 
@@ -1541,7 +1544,7 @@ LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
 
 
 static const char *aux_upvalue (StkId fi, int n, TValue **val,
-                                GCObject **owner, UpVal **uv, ravitype_t *type) {
+                                GCObject **owner, ravitype_t *type) {
   *type = RAVI_TANY;
   switch (ttype(fi)) {
     case LUA_TCCL: {  /* C closure */
@@ -1572,7 +1575,7 @@ LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
   ravitype_t type;
   TValue *val = NULL;  /* to avoid warnings */
   lua_lock(L);
-  name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL, NULL, &type);
+  name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL, &type);
   if (name) {
     setobj2s(L, L->top, val);
     api_incr_top(L);
@@ -1586,13 +1589,12 @@ LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
   const char *name;
   TValue *val = NULL;  /* to avoid warnings */
   GCObject *owner = NULL;  /* to avoid warnings */
-  UpVal *uv = NULL;
   StkId fi;
   ravitype_t type; /* RAVI upvalue type will be obtained if possible */
   lua_lock(L);
   fi = index2addr(L, funcindex);
   api_checknelems(L, 1);
-  name = aux_upvalue(fi, n, &val, &owner, &uv, &type);
+  name = aux_upvalue(fi, n, &val, &owner, &type);
   if (name) {
     /* RAVI extension
     ** We need to ensure that this function does

src/ldebug.c

@@ -694,6 +694,7 @@ l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
   CallInfo *ci = L->ci;
   const char *msg;
   va_list argp;
+  luaC_checkGC(L);  /* error message uses memory */
   va_start(argp, fmt);
   msg = luaO_pushvfstring(L, fmt, argp);  /* format message */
   va_end(argp);

src/lgc.c

@@ -9,7 +9,7 @@
 
 #include "lprefix.h"
 
-
+#include <stdio.h>
 #include <string.h>
 
 #include "lua.h"
@@ -47,9 +47,9 @@
 
 /*
 ** The equivalent, in bytes, of one unit of "work" (visiting a slot,
-** sweeping an object, etc.) * 10 (for scaling)
+** sweeping an object, etc.)
 */
-#define WORK2MEM	(sizeof(TValue) * 10)
+#define WORK2MEM	sizeof(TValue)
 
 
 /*
@@ -117,7 +117,8 @@ static lu_mem atomic (lua_State *L);
 
 
 /*
-** If key is not marked, mark its entry as dead. This allows the
+** 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). Other places never manipulate dead keys,
 ** because its associated nil value is enough to signal that the entry
@@ -508,7 +509,7 @@ static lu_mem traversetable (global_State *g, Table *h) {
 ** mode, check the generational invariant. If the cache is old,
 ** everything is ok. If the prototype is 'old0', everything
 ** is ok too. (It will naturally be visited again.) If the
-** prototype is older than 'old0', then its cache (whith is new)
+** prototype is older than 'old0', then its cache (which is new)
 ** must be visited again in the next collection, so the prototype
 ** goes to the 'protogray' list. (If the prototype has a cache,
 ** it is already immutable and does not need other barriers;
@@ -570,6 +571,11 @@ 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.
+*/
 static int traversethread (global_State *g, lua_State *th) {
   StkId o = th->stack;
   if (o == NULL)
@@ -820,14 +826,14 @@ static GCObject **sweeptolive (lua_State *L, GCObject **p) {
 */
 
 /*
-** If possible, shrink string table
+** If possible, shrink string table.
 */
 static void checkSizes (lua_State *L, global_State *g) {
   if (!g->gcemergency) {
     l_mem olddebt = g->GCdebt;
     if (g->strt.nuse < g->strt.size / 4)  /* string table too big? */
-      luaS_resize(L, g->strt.size / 2);  /* shrink it a little */
-    g->GCestimate += g->GCdebt - olddebt;  /* update estimate */
+      luaS_resize(L, g->strt.size / 2);
+    g->GCestimate += g->GCdebt - olddebt;  /* correct estimate */
   }
 }
 
@@ -1201,7 +1207,7 @@ static void entergen (lua_State *L, global_State *g) {
   luaC_runtilstate(L, bitmask(GCSpause));  /* prepare to start a new cycle */
   luaC_runtilstate(L, bitmask(GCSpropagate));  /* start new cycle */
   atomic(L);
-  /* sweep all ellements making them old */
+  /* sweep all elements making them old */
   sweep2old(L, &g->allgc);
   /* everything alive now is old */
   g->reallyold = g->old = g->survival = g->allgc;
@@ -1276,7 +1282,7 @@ static void genstep (lua_State *L, global_State *g) {
     lu_mem mem;
     youngcollection(L, g);
     mem = gettotalbytes(g);
-    luaE_setdebt(g, -((mem / 100) * g->genminormul));
+    luaE_setdebt(g, -(cast(l_mem, (mem / 100)) * g->genminormul));
     g->GCestimate = majorbase;  /* preserve base value */
   }
 }
@@ -1293,7 +1299,7 @@ static void genstep (lua_State *L, global_State *g) {
 
 /*
 ** Set the "time" to wait before starting a new GC cycle; cycle will
-** start when memory use hits the threshold of ('estimate' * gcpause /
+** start when memory use hits the threshold of ('estimate' * pause /
 ** PAUSEADJ). (Division by 'estimate' should be OK: it cannot be zero,
 ** because Lua cannot even start with less than PAUSEADJ bytes).
 */
@@ -1490,9 +1496,8 @@ static void incstep (lua_State *L, global_State *g) {
   int stepmul = (getgcparam(g->gcstepmul) | 1);  /* avoid division by 0 */
   l_mem debt = (g->GCdebt / WORK2MEM) * stepmul;
   l_mem stepsize = (g->gcstepsize <= log2maxs(l_mem))
-                   ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
-                   : MAX_LMEM;  /* overflow; keep maximum value */
-  stepsize = -((stepsize / WORK2MEM) * stepmul);
+                 ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
+                 : MAX_LMEM;  /* overflow; keep maximum value */
   do {  /* repeat until pause or enough "credit" (negative debt) */
     lu_mem work = singlestep(L);  /* perform one single step */
     debt -= work;

src/ltests.c

@@ -105,7 +105,7 @@ typedef union Header {
 
 
 static Memcontrol l_memcontrol =
-  {0L, 0L, 0L, 0L, {0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L}};
+  {0L, 0L, 0L, 0L, (~0L), {0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L}};
 
 LUA_API Memcontrol* luaB_getmemcontrol(void) {
   return &l_memcontrol;
@@ -147,7 +147,12 @@ LUA_API void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) {
     freeblock(mc, block);
     return NULL;
   }
-  else if (size > oldsize && mc->total+size-oldsize > mc->memlimit)
+  if (mc->countlimit != ~0UL && size > 0) {  /* count limit in use? */
+    if (mc->countlimit == 0)
+      return NULL;  /* fake a memory allocation error */
+    mc->countlimit--;
+  }
+  if (size > oldsize && mc->total+size-oldsize > mc->memlimit)
     return NULL;  /* fake a memory allocation error */
   else {
     Header *newblock;
@@ -598,6 +603,22 @@ static int listcode (lua_State *L) {
 }
 
 
+static int printcode (lua_State *L) {
+  int pc;
+  Proto *p;
+  luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
+                 1, "Lua function expected");
+  p = getproto(obj_at(L, 1));
+  printf("maxstack: %d\n", p->maxstacksize);
+  printf("numparams: %d\n", p->numparams);
+  for (pc=0; pc<p->sizecode; pc++) {
+    char buff[100];
+    printf("%d\t%s\n", pc + 1, buildop(p, pc, buff));
+  }
+  return 0;
+}
+
+
 static int listk (lua_State *L) {
   Proto *p;
   int i;
@@ -682,6 +703,15 @@ static int mem_query (lua_State *L) {
 }
 
 
+static int alloc_count (lua_State *L) {
+  if (lua_isnone(L, 1))
+    l_memcontrol.countlimit = ~0L;
+  else
+    l_memcontrol.countlimit = luaL_checkinteger(L, 1);
+  return 0;
+}
+  
+
 static int settrick (lua_State *L) {
   if (ttisnil(obj_at(L, 1)))
     l_Trick = NULL;
@@ -786,8 +816,10 @@ 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, (intptr_t)&a);
-  return 3;
+  lua_pushinteger(L, L->nCcalls);
+  lua_pushinteger(L, L->nci);
+  lua_pushinteger(L, (unsigned long)&a);
+  return 5;
 }
 
 
@@ -972,6 +1004,7 @@ static int loadlib (lua_State *L) {
     {"math", luaopen_math},
     {"string", luaopen_string},
     {"table", luaopen_table},
+    {"T", luaB_opentests},
     {NULL, NULL}
   };
   lua_State *L1 = getstate(L);
@@ -1226,6 +1259,10 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
         msg = NULL;  /* to test 'luaL_checkstack' with no message */
       luaL_checkstack(L1, sz, msg);
     }
+    else if EQ("rawcheckstack") {
+      int sz = getnum;
+      lua_pushboolean(L1, lua_checkstack(L1, sz));
+    }
     else if EQ("compare") {
       const char *opt = getstring;  /* EQ, LT, or LE */
       int op = (opt[0] == 'E') ? LUA_OPEQ
@@ -1343,7 +1380,7 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
     else if EQ("pop") {
       lua_pop(L1, getnum);
     }
-    else if EQ("print") {
+    else if EQ("printstack") {
       int n = getnum;
       if (n != 0) {
         printf("%s\n", luaL_tolstring(L1, n, NULL));
@@ -1351,6 +1388,10 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
       }
       else printstack(L1);
     }
+    else if EQ("print") {
+      const char *msg = getstring;
+      printf("%s\n", msg);
+    }
     else if EQ("pushbool") {
       lua_pushboolean(L1, getnum);
     }
@@ -1404,8 +1445,17 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
       int n = getnum;
       if (L1 != L) {
         int i;
-        for (i = 0; i < n; i++)
-          lua_pushstring(L, lua_tostring(L1, -(n - i)));
+        for (i = 0; i < n; i++) {
+          int idx = -(n - i);
+          switch (lua_type(L1, idx)) {
+            case LUA_TBOOLEAN:
+              lua_pushboolean(L, lua_toboolean(L1, idx));
+              break;
+            default:
+              lua_pushstring(L, lua_tostring(L1, idx));
+              break;
+          }
+        }
       }
       return n;
     }
@@ -1638,6 +1688,7 @@ static const struct luaL_Reg tests_funcs[] = {
   {"log2", log2_aux},
   {"limits", get_limits},
   {"listcode", listcode},
+  {"printcode", printcode},
   {"listk", listk},
   {"listlocals", listlocals},
   {"loadlib", loadlib},
@@ -1656,6 +1707,7 @@ static const struct luaL_Reg tests_funcs[] = {
   {"testC", testC},
   {"makeCfunc", makeCfunc},
   {"totalmem", mem_query},
+  {"alloccount", alloc_count},
   {"trick", settrick},
   {"udataval", udataval},
   {"unref", unref},