/*** $Id: lgc.c,v 2.38 2006/05/24 14:34:06 roberto Exp $** Garbage Collector** See Copyright Notice in lua.h*/#include <string.h>#define lgc_c#define LUA_CORE#include "lua.h"#include "ldebug.h"#include "ldo.h"#include "lfunc.h"#include "lgc.h"#include "lmem.h"#include "lobject.h"#include "lstate.h"#include "lstring.h"#include "ltable.h"#include "ltm.h"#define GCSTEPSIZE	1024u#define GCSWEEPMAX	40#define GCSWEEPCOST	10#define GCFINALIZECOST	100#define maskmarks	cast_byte(~(bitmask(BLACKBIT)|WHITEBITS))#define makewhite(g,x)	\   ((x)->gch.marked = cast_byte(((x)->gch.marked & maskmarks) | luaC_white(g)))#define white2gray(x)	reset2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT)#define black2gray(x)	resetbit((x)->gch.marked, BLACKBIT)#define stringmark(s)	reset2bits((s)->tsv.marked, WHITE0BIT, WHITE1BIT)#define isfinalized(u)		testbit((u)->marked, FINALIZEDBIT)#define markfinalized(u)	l_setbit((u)->marked, FINALIZEDBIT)#define KEYWEAK         bitmask(KEYWEAKBIT)#define VALUEWEAK       bitmask(VALUEWEAKBIT)#define markvalue(g,o) { checkconsistency(o); \  if (iscollectable(o) && iswhite(gcvalue(o))) reallymarkobject(g,gcvalue(o)); }#define markobject(g,t) { if (iswhite(obj2gco(t))) \		reallymarkobject(g, obj2gco(t)); }#define setthreshold(g)  (g->GCthreshold = (g->estimate/100) * g->gcpause)static void removeentry (Node *n) {  lua_assert(ttisnil(gval(n)));  if (iscollectable(gkey(n)))    setttype(gkey(n), LUA_TDEADKEY);  /* dead key; remove it */}static void reallymarkobject (global_State *g, GCObject *o) {  lua_assert(iswhite(o) && !isdead(g, o));  white2gray(o);  switch (o->gch.tt) {    case LUA_TSTRING: {      return;    }    case LUA_TUSERDATA: {      Table *mt = gco2u(o)->metatable;      gray2black(o);  /* udata are never gray */      if (mt) markobject(g, mt);      markobject(g, gco2u(o)->env);      return;    }    case LUA_TUPVAL: {      UpVal *uv = gco2uv(o);      markvalue(g, uv->v);      if (uv->v == &uv->u.value)  /* closed? */        gray2black(o);  /* open upvalues are never black */      return;    }    case LUA_TFUNCTION: {      gco2cl(o)->c.gclist = g->gray;      g->gray = o;      break;    }    case LUA_TTABLE: {      gco2h(o)->gclist = g->gray;      g->gray = o;      break;    }    case LUA_TTHREAD: {      gco2th(o)->gclist = g->gray;      g->gray = o;      break;    }    case LUA_TPROTO: {      gco2p(o)->gclist = g->gray;      g->gray = o;      break;    }    default: lua_assert(0);  }}static void marktmu (global_State *g) {  GCObject *u = g->tmudata;  if (u) {    do {      u = u->gch.next;      makewhite(g, u);  /* may be marked, if left from previous GC */      reallymarkobject(g, u);    } while (u != g->tmudata);  }}/* move `dead' udata that need finalization to list `tmudata' */size_t luaC_separateudata (lua_State *L, int all) {  global_State *g = G(L);  size_t deadmem = 0;  GCObject **p = &g->mainthread->next;  GCObject *curr;  while ((curr = *p) != NULL) {    if (!(iswhite(curr) || all) || isfinalized(gco2u(curr)))      p = &curr->gch.next;  /* don't bother with them */    else if (fasttm(L, gco2u(curr)->metatable, TM_GC) == NULL) {      markfinalized(gco2u(curr));  /* don't need finalization */      p = &curr->gch.next;    }    else {  /* must call its gc method */      deadmem += sizeudata(gco2u(curr));      markfinalized(gco2u(curr));      *p = curr->gch.next;      /* link `curr' at the end of `tmudata' list */      if (g->tmudata == NULL)  /* list is empty? */        g->tmudata = curr->gch.next = curr;  /* creates a circular list */      else {        curr->gch.next = g->tmudata->gch.next;        g->tmudata->gch.next = curr;        g->tmudata = curr;      }    }  }  return deadmem;}static int traversetable (global_State *g, Table *h) {  int i;  int weakkey = 0;  int weakvalue = 0;  const TValue *mode;  if (h->metatable)    markobject(g, h->metatable);  mode = gfasttm(g, h->metatable, TM_MODE);  if (mode && ttisstring(mode)) {  /* is there a weak mode? */    weakkey = (strchr(svalue(mode), 'k') != NULL);    weakvalue = (strchr(svalue(mode), 'v') != NULL);    if (weakkey || weakvalue) {  /* is really weak? */      h->marked &= ~(KEYWEAK | VALUEWEAK);  /* clear bits */      h->marked |= cast_byte((weakkey << KEYWEAKBIT) |                             (weakvalue << VALUEWEAKBIT));      h->gclist = g->weak;  /* must be cleared after GC, ... */      g->weak = obj2gco(h);  /* ... so put in the appropriate list */    }  }  if (weakkey && weakvalue) return 1;  if (!weakvalue) {    i = h->sizearray;    while (i--)      markvalue(g, &h->array[i]);  }  i = sizenode(h);  while (i--) {    Node *n = gnode(h, i);    lua_assert(ttype(gkey(n)) != LUA_TDEADKEY || ttisnil(gval(n)));    if (ttisnil(gval(n)))      removeentry(n);  /* remove empty entries */    else {      lua_assert(!ttisnil(gkey(n)));      if (!weakkey) markvalue(g, gkey(n));      if (!weakvalue) markvalue(g, gval(n));    }  }  return weakkey || weakvalue;}/*** All marks are conditional because a GC may happen while the** prototype is still being created*/static void traverseproto (global_State *g, Proto *f) {  int i;  if (f->source) stringmark(f->source);  for (i=0; i<f->sizek; i++)  /* mark literals */    markvalue(g, &f->k[i]);  for (i=0; i<f->sizeupvalues; i++) {  /* mark upvalue names */    if (f->upvalues[i])      stringmark(f->upvalues[i]);  }  for (i=0; i<f->sizep; i++) {  /* mark nested protos */    if (f->p[i])      markobject(g, f->p[i]);  }  for (i=0; i<f->sizelocvars; i++) {  /* mark local-variable names */    if (f->locvars[i].varname)      stringmark(f->locvars[i].varname);  }}static void traverseclosure (global_State *g, Closure *cl) {  markobject(g, cl->c.env);  if (cl->c.isC) {    int i;    for (i=0; i<cl->c.nupvalues; i++)  /* mark its upvalues */      markvalue(g, &cl->c.upvalue[i]);  }  else {    int i;    lua_assert(cl->l.nupvalues == cl->l.p->nups);    markobject(g, cl->l.p);    for (i=0; i<cl->l.nupvalues; i++)  /* mark its upvalues */      markobject(g, cl->l.upvals[i]);  }}static void checkstacksizes (lua_State *L, StkId max) {  int ci_used = cast_int(L->ci - L->base_ci);  /* number of `ci' in use */  int s_used = cast_int(max - L->stack);  /* part of stack in use */  if (L->size_ci > LUAI_MAXCALLS)  /* handling overflow? */    return;  /* do not touch the stacks */  if (4*ci_used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci)    luaD_reallocCI(L, L->size_ci/2);  /* still big enough... */  condhardstacktests(luaD_reallocCI(L, ci_used + 1));  if (4*s_used < L->stacksize &&      2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)    luaD_reallocstack(L, L->stacksize/2);  /* still big enough... */  condhardstacktests(luaD_reallocstack(L, s_used));}static void traversestack (global_State *g, lua_State *l) {  StkId o, lim;  CallInfo *ci;  markvalue(g, gt(l));  lim = l->top;  for (ci = l->base_ci; ci <= l->ci; ci++) {    lua_assert(ci->top <= l->stack_last);    if (lim < ci->top) lim = ci->top;  }  for (o = l->stack; o < l->top; o++)    markvalue(g, o);  for (; o <= lim; o++)    setnilvalue(o);  checkstacksizes(l, lim);}/*** traverse one gray object, turning it to black.** Returns `quantity' traversed.*/static l_mem propagatemark (global_State *g) {  GCObject *o = g->gray;  lua_assert(isgray(o));  gray2black(o);  switch (o->gch.tt) {    case LUA_TTABLE: {      Table *h = gco2h(o);      g->gray = h->gclist;      if (traversetable(g, h))  /* table is weak? */        black2gray(o);  /* keep it gray */      return sizeof(Table) + sizeof(TValue) * h->sizearray +                             sizeof(Node) * sizenode(h);    }    case LUA_TFUNCTION: {      Closure *cl = gco2cl(o);      g->gray = cl->c.gclist;      traverseclosure(g, cl);      return (cl->c.isC) ? sizeCclosure(cl->c.nupvalues) :                           sizeLclosure(cl->l.nupvalues);    }    case LUA_TTHREAD: {      lua_State *th = gco2th(o);      g->gray = th->gclist;      th->gclist = g->grayagain;      g->grayagain = o;      black2gray(o);      traversestack(g, th);      return sizeof(lua_State) + sizeof(TValue) * th->stacksize +                                 sizeof(CallInfo) * th->size_ci;    }    case LUA_TPROTO: {      Proto *p = gco2p(o);      g->gray = p->gclist;      traverseproto(g, p);      return sizeof(Proto) + sizeof(Instruction) * p->sizecode +                             sizeof(Proto *) * p->sizep +                             sizeof(TValue) * p->sizek +                              sizeof(int) * p->sizelineinfo +                             sizeof(LocVar) * p->sizelocvars +                             sizeof(TString *) * p->sizeupvalues;    }    default: lua_assert(0); return 0;  }}static size_t propagateall (global_State *g) {  size_t m = 0;  while (g->gray) m += propagatemark(g);  return m;}/*** The next function tells whether a key or value can be cleared from** a weak table. Non-collectable objects are never removed from weak** tables. Strings behave as `values', so are never removed too. for** other objects: if really collected, cannot keep them; for userdata** being finalized, keep them in keys, but not in values*/static int iscleared (const TValue *o, int iskey) {  if (!iscollectable(o)) return 0;  if (ttisstring(o)) {    stringmark(rawtsvalue(o));  /* strings are `values', so are never weak */    return 0;  }  return iswhite(gcvalue(o)) ||    (ttisuserdata(o) && (!iskey && isfinalized(uvalue(o))));}/*** clear collected entries from weaktables*/static void cleartable (GCObject *l) {  while (l) {    Table *h = gco2h(l);    int i = h->sizearray;    lua_assert(testbit(h->marked, VALUEWEAKBIT) ||               testbit(h->marked, KEYWEAKBIT));