allocator function receives the tag of object being allocated in 'osize'

when 'ptr' is NULL.

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 2.17 2009/11/26 11:39:20 roberto Exp roberto $
+** $Id: lfunc.c,v 2.18 2009/12/11 13:39:34 roberto Exp roberto $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -21,30 +21,27 @@
 
 
 
-Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e) {
-  Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
-  luaC_link(L, obj2gco(c), LUA_TFUNCTION);
+Closure *luaF_newCclosure (lua_State *L, int n, Table *e) {
+  Closure *c = &luaC_newobj(L, LUA_TFUNCTION, sizeCclosure(n), NULL, 0)->cl;
   c->c.isC = 1;
   c->c.env = e;
-  c->c.nupvalues = cast_byte(nelems);
+  c->c.nupvalues = cast_byte(n);
   return c;
 }
 
 
-Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e) {
-  Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
-  luaC_link(L, obj2gco(c), LUA_TFUNCTION);
+Closure *luaF_newLclosure (lua_State *L, int n, Table *e) {
+  Closure *c = &luaC_newobj(L, LUA_TFUNCTION, sizeLclosure(n), NULL, 0)->cl;
   c->l.isC = 0;
   c->l.env = e;
-  c->l.nupvalues = cast_byte(nelems);
-  while (nelems--) c->l.upvals[nelems] = NULL;
+  c->l.nupvalues = cast_byte(n);
+  while (n--) c->l.upvals[n] = NULL;
   return c;
 }
 
 
 UpVal *luaF_newupval (lua_State *L) {
-  UpVal *uv = luaM_new(L, UpVal);
-  luaC_link(L, obj2gco(uv), LUA_TUPVAL);
+  UpVal *uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), NULL, 0)->uv;
   uv->v = &uv->u.value;
   setnilvalue(uv->v);
   return uv;
@@ -65,12 +62,9 @@ UpVal *luaF_findupval (lua_State *L, StkId level) {
     }
     pp = &p->next;
   }
-  uv = luaM_new(L, UpVal);  /* not found: create a new one */
-  uv->tt = LUA_TUPVAL;
-  uv->marked = luaC_white(g);
+  /* not found: create a new one */
+  uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), pp, 0)->uv;
   uv->v = level;  /* current value lives in the stack */
-  uv->next = *pp;  /* chain it in the proper position */
-  *pp = obj2gco(uv);
   uv->u.l.prev = &g->uvhead;  /* double link it in `uvhead' list */
   uv->u.l.next = g->uvhead.u.l.next;
   uv->u.l.next->u.l.prev = uv;
@@ -114,8 +108,7 @@ void luaF_close (lua_State *L, StkId level) {
 
 
 Proto *luaF_newproto (lua_State *L) {
-  Proto *f = luaM_new(L, Proto);
-  luaC_link(L, obj2gco(f), LUA_TPROTO);
+  Proto *f = &luaC_newobj(L, LUA_TPROTO, sizeof(Proto), NULL, 0)->p;
   f->k = NULL;
   f->sizek = 0;
   f->p = NULL;

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 2.64 2009/12/11 19:14:59 roberto Exp roberto $
+** $Id: lgc.c,v 2.65 2009/12/11 21:31:14 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -116,12 +116,20 @@ void luaC_barrierback (lua_State *L, Table *t) {
 }
 
 
-void luaC_link (lua_State *L, GCObject *o, lu_byte tt) {
+/*
+** create a new collectable object and link it to '*list'
+*/
+GCObject *luaC_newobj (lua_State *L, int tt, size_t sz, GCObject **list,
+                       int offset) {
   global_State *g = G(L);
+  GCObject *o = obj2gco(cast(char *, luaM_newobject(L, tt, sz)) + offset);
+  if (list == NULL)
+    list = &g->rootgc;  /* standard list for collectable objects */
   gch(o)->marked = luaC_white(g);
   gch(o)->tt = tt;
-  gch(o)->next = g->rootgc;
-  g->rootgc = o;
+  gch(o)->next = *list;
+  *list = o;
+  return o;
 }
 
 

lgc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 2.25 2009/12/11 19:14:59 roberto Exp roberto $
+** $Id: lgc.h,v 2.26 2009/12/11 21:31:14 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -98,7 +98,8 @@ LUAI_FUNC void luaC_freeallobjects (lua_State *L);
 LUAI_FUNC void luaC_step (lua_State *L);
 LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
 LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
-LUAI_FUNC void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
+LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz,
+                                 GCObject **list, int offset);
 LUAI_FUNC void luaC_linkupval (lua_State *L, UpVal *uv);
 LUAI_FUNC void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v);
 LUAI_FUNC void luaC_barrierback (lua_State *L, Table *t);

lmem.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.c,v 1.72 2006/09/14 12:59:06 roberto Exp roberto $
+** $Id: lmem.c,v 1.73 2006/09/14 18:42:28 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -26,12 +26,11 @@
 ** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
 ** (`osize' is the old size, `nsize' is the new size)
 **
-** Lua ensures that (ptr == NULL) iff (osize == 0).
-**
-** * frealloc(ud, NULL, 0, x) creates a new block of size `x'
+** * frealloc(ud, NULL, x, s) creates a new block of size `s' (no
+** matter 'x').
 **
 ** * frealloc(ud, p, x, 0) frees the block `p'
-** (in this specific case, frealloc must return NULL).
+** (in this specific case, frealloc must return NULL);
 ** particularly, frealloc(ud, NULL, 0, 0) does nothing
 ** (which is equivalent to free(NULL) in ANSI C)
 **
@@ -77,14 +76,15 @@ void *luaM_toobig (lua_State *L) {
 void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
   void *newblock;
   global_State *g = G(L);
-  lua_assert((osize == 0) == (block == NULL));
+  size_t realosize = (block) ? osize : 0;
+  lua_assert((realosize == 0) == (block == NULL));
 #if defined(HARDMEMTESTS)
-  if (nsize > osize && g->GCthreshold != MAX_LUMEM)
+  if (nsize > realosize && g->GCthreshold != MAX_LUMEM)
     luaC_fullgc(L, 1);  /* force a GC whenever possible */
 #endif
   newblock = (*g->frealloc)(g->ud, block, osize, nsize);
   if (newblock == NULL && nsize > 0) {
-    lua_assert(nsize > osize);  /* cannot fail when shrinking a block */
+    lua_assert(nsize > realosize);  /* cannot fail when shrinking a block */
     if (g->GCthreshold != MAX_LUMEM) {
       luaC_fullgc(L, 1);  /* try to free some memory... */
       newblock = (*g->frealloc)(g->ud, block, osize, nsize);  /* try again */
@@ -93,7 +93,7 @@ void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
       luaD_throw(L, LUA_ERRMEM);
   }
   lua_assert((nsize == 0) == (newblock == NULL));
-  g->totalbytes = (g->totalbytes - osize) + nsize;
+  g->totalbytes = (g->totalbytes - realosize) + nsize;
   return newblock;
 }
 

lmem.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.h,v 1.33 2007/02/09 13:04:52 roberto Exp roberto $
+** $Id: lmem.h,v 1.34 2009/04/17 14:40:13 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -25,11 +25,13 @@
 #define luaM_free(L, b)		luaM_realloc_(L, (b), sizeof(*(b)), 0)
 #define luaM_freearray(L, b, n)   luaM_reallocv(L, (b), n, 0, sizeof((b)[0]))
 
-#define luaM_malloc(L,t)	luaM_realloc_(L, NULL, 0, (t))
+#define luaM_malloc(L,s)	luaM_realloc_(L, NULL, 0, (s))
 #define luaM_new(L,t)		cast(t *, luaM_malloc(L, sizeof(t)))
 #define luaM_newvector(L,n,t) \
 		cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t)))
 
+#define luaM_newobject(L,tag,s)	luaM_realloc_(L, NULL, tag, (s))
+
 #define luaM_growvector(L,v,nelems,size,t,limit,e) \
           if ((nelems)+1 > (size)) \
             ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e)))

lstring.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.c,v 2.14 2009/12/11 19:14:59 roberto Exp roberto $
+** $Id: lstring.c,v 2.15 2009/12/11 21:31:14 roberto Exp roberto $
 ** String table (keeps all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -51,23 +51,22 @@ void luaS_resize (lua_State *L, int newsize) {
 
 static TString *newlstr (lua_State *L, const char *str, size_t l,
                                        unsigned int h) {
+  size_t totalsize;  /* total size of TString object */
+  GCObject **list;  /* (pointer to) list where it will be inserted */
   TString *ts;
   stringtable *tb = &G(L)->strt;
   if (l+1 > (MAX_SIZET - sizeof(TString))/sizeof(char))
     luaM_toobig(L);
   if (tb->nuse >= cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
     luaS_resize(L, tb->size*2);  /* too crowded */
-  ts = cast(TString *, luaM_malloc(L, (l+1)*sizeof(char)+sizeof(TString)));
+  totalsize = sizeof(TString) + ((l + 1) * sizeof(char));
+  list = &tb->hash[lmod(h, tb->size)];
+  ts = &luaC_newobj(L, LUA_TSTRING, totalsize, list, 0)->ts;
   ts->tsv.len = l;
   ts->tsv.hash = h;
-  ts->tsv.marked = luaC_white(G(L));
-  ts->tsv.tt = LUA_TSTRING;
   ts->tsv.reserved = 0;
   memcpy(ts+1, str, l*sizeof(char));
   ((char *)(ts+1))[l] = '\0';  /* ending 0 */
-  h = lmod(h, tb->size);
-  ts->tsv.next = tb->hash[h];  /* chain new entry */
-  tb->hash[h] = obj2gco(ts);
   tb->nuse++;
   return ts;
 }
@@ -99,8 +98,7 @@ Udata *luaS_newudata (lua_State *L, size_t s, Table *e) {
   Udata *u;
   if (s > MAX_SIZET - sizeof(Udata))
     luaM_toobig(L);
-  u = cast(Udata *, luaM_malloc(L, s + sizeof(Udata)));
-  luaC_link(L, obj2gco(u), LUA_TUSERDATA);
+  u = &luaC_newobj(L, LUA_TUSERDATA, sizeof(Udata) + s, NULL, 0)->u;
   u->uv.len = s;
   u->uv.metatable = NULL;
   u->uv.env = e;

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 2.45 2009/11/19 17:54:07 roberto Exp roberto $
+** $Id: ltable.c,v 2.46 2009/11/26 11:39:20 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -357,8 +357,7 @@ static void rehash (lua_State *L, Table *t, const TValue *ek) {
 
 
 Table *luaH_new (lua_State *L) {
-  Table *t = luaM_new(L, Table);
-  luaC_link(L, obj2gco(t), LUA_TTABLE);
+  Table *t = &luaC_newobj(L, LUA_TTABLE, sizeof(Table), NULL, 0)->h;
   t->metatable = NULL;
   t->flags = cast_byte(~0);
   t->array = NULL;

ltests.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.c,v 2.82 2009/12/10 18:21:28 roberto Exp roberto $
+** $Id: ltests.c,v 2.83 2009/12/11 19:14:59 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -92,8 +92,7 @@ static int tpanic (lua_State *L) {
 #define fillmem(mem,size)	/* empty */
 #endif
 
-
-Memcontrol l_memcontrol = {0L, 0L, 0L, 0L};
+Memcontrol l_memcontrol = {0L, 0L, 0L, 0L, {0L, 0L, 0L, 0L, 0L}};
 
 
 static void *checkblock (void *block, size_t size) {
@@ -119,6 +118,11 @@ static void freeblock (Memcontrol *mc, void *block, size_t size) {
 
 void *debug_realloc (void *ud, void *block, size_t oldsize, size_t size) {
   Memcontrol *mc = cast(Memcontrol *, ud);
+  if (block == NULL) {
+    if (LUA_TSTRING <= oldsize && oldsize <= LUA_TTHREAD)
+      mc->objcount[oldsize - LUA_TSTRING]++;
+    oldsize = 0;
+  }
   lua_assert((oldsize == 0) ? block == NULL :
                               block && checkblocksize(block, oldsize));
   if (mc->memlimit == 0) {  /* first time? */
@@ -506,10 +510,12 @@ static int get_limits (lua_State *L) {
 
 static int mem_query (lua_State *L) {
   if (lua_isnone(L, 1)) {
+    int i;
     lua_pushinteger(L, l_memcontrol.total);
     lua_pushinteger(L, l_memcontrol.numblocks);
     lua_pushinteger(L, l_memcontrol.maxmem);
-    return 3;
+    for (i = 0; i < 5; i++) lua_pushinteger(L, l_memcontrol.objcount[i]);
+    return 3 + 5;
   }
   else {
     l_memcontrol.memlimit = luaL_checkint(L, 1);