src/lgc.c

   1 /*
   2 ** $Id: lgc.c,v 2.212 2016/03/31 19:02:03 roberto Exp $
   3 ** Garbage Collector
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7 #define lgc_c
   8 #define LUA_CORE
   9
  10 #include "lprefix.h"
  11
  12
  13 #include <string.h>
  14
  15 #include "lua.h"
  16
  17 #include "ldebug.h"
  18 #include "ldo.h"
  19 #include "lfunc.h"
  20 #include "lgc.h"
  21 #include "lmem.h"
  22 #include "lobject.h"
  23 #include "lstate.h"
  24 #include "lstring.h"
  25 #include "ltable.h"
  26 #include "ltm.h"
  27
  28
  29 /*
  30 ** internal state for collector while inside the atomic phase. The
  31 ** collector should never be in this state while running regular code.
  32 */
  33 #define GCSinsideatomic         (GCSpause + 1)
  34
  35 /*
  36 ** cost of sweeping one element (the size of a small object divided
  37 ** by some adjust for the sweep speed)
  38 */
  39 #define GCSWEEPCOST     ((sizeof(TString) + 4) / 4)
  40
  41 /* maximum number of elements to sweep in each single step */
  42 #define GCSWEEPMAX      (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4))
  43
  44 /* cost of calling one finalizer */
  45 #define GCFINALIZECOST  GCSWEEPCOST
  46
  47
  48 /*
  49 ** macro to adjust 'stepmul': 'stepmul' is actually used like
  50 ** 'stepmul / STEPMULADJ' (value chosen by tests)
  51 */
  52 #define STEPMULADJ              200
  53
  54
  55 /*
  56 ** macro to adjust 'pause': 'pause' is actually used like
  57 ** 'pause / PAUSEADJ' (value chosen by tests)
  58 */
  59 #define PAUSEADJ                100
  60
  61
  62 /*
  63 ** 'makewhite' erases all color bits then sets only the current white
  64 ** bit
  65 */
  66 #define maskcolors      (~(bitmask(BLACKBIT) | WHITEBITS))
  67 #define makewhite(g,x)  \
  68  (x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g)))
  69
  70 #define white2gray(x)   resetbits(x->marked, WHITEBITS)
  71 #define black2gray(x)   resetbit(x->marked, BLACKBIT)
  72
  73
  74 #define valiswhite(x)   (iscollectable(x) && iswhite(gcvalue(x)))
  75
  76 #define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n)))
  77
  78
  79 #define checkconsistency(obj)  \
  80   lua_longassert(!iscollectable(obj) || righttt(obj))
  81
  82
  83 #define markvalue(g,o) { checkconsistency(o); \
  84   if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
  85
  86 #define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }
  87
  88 /*
  89 ** mark an object that can be NULL (either because it is really optional,
  90 ** or it was stripped as debug info, or inside an uncompleted structure)
  91 */
  92 #define markobjectN(g,t)        { if (t) markobject(g,t); }
  93
  94 static void reallymarkobject (global_State *g, GCObject *o);
  95
  96
  97 /*
  98 ** {======================================================
  99 ** Generic functions
 100 ** =======================================================
 101 */
 102
 103
 104 /*
 105 ** one after last element in a hash array
 106 */
 107 #define gnodelast(h)    gnode(h, cast(size_t, sizenode(h)))
 108
 109
 110 /*
 111 ** link collectable object 'o' into list pointed by 'p'
 112 */
 113 #define linkgclist(o,p) ((o)->gclist = (p), (p) = obj2gco(o))
 114
 115
 116 /*
 117 ** If key is not marked, mark its entry as dead. This allows key to be
 118 ** collected, but keeps its entry in the table.  A dead node is needed
 119 ** when Lua looks up for a key (it may be part of a chain) and when
 120 ** traversing a weak table (key might be removed from the table during
 121 ** traversal). Other places never manipulate dead keys, because its
 122 ** associated nil value is enough to signal that the entry is logically
 123 ** empty.
 124 */
 125 static void removeentry (Node *n) {
 126   lua_assert(ttisnil(gval(n)));
 127   if (valiswhite(gkey(n)))
 128     setdeadvalue(wgkey(n));  /* unused and unmarked key; remove it */
 129 }
 130
 131
 132 /*
 133 ** tells whether a key or value can be cleared from a weak
 134 ** table. Non-collectable objects are never removed from weak
 135 ** tables. Strings behave as 'values', so are never removed too. for
 136 ** other objects: if really collected, cannot keep them; for objects
 137 ** being finalized, keep them in keys, but not in values
 138 */
 139 static int iscleared (global_State *g, const TValue *o) {
 140   if (!iscollectable(o)) return 0;
 141   else if (ttisstring(o)) {
 142     markobject(g, tsvalue(o));  /* strings are 'values', so are never weak */
 143     return 0;
 144   }
 145   else return iswhite(gcvalue(o));
 146 }
 147
 148
 149 /*
 150 ** barrier that moves collector forward, that is, mark the white object
 151 ** being pointed by a black object. (If in sweep phase, clear the black
 152 ** object to white [sweep it] to avoid other barrier calls for this
 153 ** same object.)
 154 */
 155 void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
 156   global_State *g = G(L);
 157   lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
 158   if (keepinvariant(g))  /* must keep invariant? */
 159     reallymarkobject(g, v);  /* restore invariant */
 160   else {  /* sweep phase */
 161     lua_assert(issweepphase(g));
 162     makewhite(g, o);  /* mark main obj. as white to avoid other barriers */
 163   }
 164 }
 165
 166
 167 /*
 168 ** barrier that moves collector backward, that is, mark the black object
 169 ** pointing to a white object as gray again.
 170 */
 171 void luaC_barrierback_ (lua_State *L, Table *t) {
 172   global_State *g = G(L);
 173   lua_assert(isblack(t) && !isdead(g, t));
 174   black2gray(t);  /* make table gray (again) */
 175   linkgclist(t, g->grayagain);
 176 }
 177
 178
 179 /*
 180 ** barrier for assignments to closed upvalues. Because upvalues are
 181 ** shared among closures, it is impossible to know the color of all
 182 ** closures pointing to it. So, we assume that the object being assigned
 183 ** must be marked.
 184 */
 185 void luaC_upvalbarrier_ (lua_State *L, UpVal *uv) {
 186   global_State *g = G(L);
 187   GCObject *o = gcvalue(uv->v);
 188   lua_assert(!upisopen(uv));  /* ensured by macro luaC_upvalbarrier */
 189   if (keepinvariant(g))
 190     markobject(g, o);
 191 }
 192
 193
 194 void luaC_fix (lua_State *L, GCObject *o) {
 195   global_State *g = G(L);
 196   lua_assert(g->allgc == o);  /* object must be 1st in 'allgc' list! */
 197   white2gray(o);  /* they will be gray forever */
 198   g->allgc = o->next;  /* remove object from 'allgc' list */
 199   o->next = g->fixedgc;  /* link it to 'fixedgc' list */
 200   g->fixedgc = o;
 201 }
 202
 203
 204 /*
 205 ** create a new collectable object (with given type and size) and link
 206 ** it to 'allgc' list.
 207 */
 208 GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {
 209   global_State *g = G(L);
 210   GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz));
 211   o->marked = luaC_white(g);
 212   o->tt = tt;
 213   o->next = g->allgc;
 214   g->allgc = o;
 215   return o;
 216 }
 217
 218 /* }====================================================== */
 219
 220
 221
 222 /*
 223 ** {======================================================
 224 ** Mark functions
 225 ** =======================================================
 226 */
 227
 228
 229 /*
 230 ** mark an object. Userdata, strings, and closed upvalues are visited
 231 ** and turned black here. Other objects are marked gray and added
 232 ** to appropriate list to be visited (and turned black) later. (Open
 233 ** upvalues are already linked in 'headuv' list.)
 234 */
 235 static void reallymarkobject (global_State *g, GCObject *o) {
 236  reentry:
 237   white2gray(o);
 238   switch (o->tt) {
 239     case LUA_TSHRSTR: {
 240       gray2black(o);
 241       g->GCmemtrav += sizelstring(gco2ts(o)->shrlen);
 242       break;
 243     }
 244     case LUA_TLNGSTR: {
 245       gray2black(o);
 246       g->GCmemtrav += sizelstring(gco2ts(o)->u.lnglen);
 247       break;
 248     }
 249     case LUA_TUSERDATA: {
 250       TValue uvalue;
 251       markobjectN(g, gco2u(o)->metatable);  /* mark its metatable */
 252       gray2black(o);
 253       g->GCmemtrav += sizeudata(gco2u(o));
 254       getuservalue(g->mainthread, gco2u(o), &uvalue);
 255       if (valiswhite(&uvalue)) {  /* markvalue(g, &uvalue); */
 256         o = gcvalue(&uvalue);
 257         goto reentry;
 258       }
 259       break;
 260     }
 261     case LUA_TLCL: {
 262       linkgclist(gco2lcl(o), g->gray);
 263       break;
 264     }
 265     case LUA_TCCL: {
 266       linkgclist(gco2ccl(o), g->gray);
 267       break;
 268     }
 269     case LUA_TTABLE: {
 270       linkgclist(gco2t(o), g->gray);
 271       break;
 272     }
 273     case LUA_TTHREAD: {
 274       linkgclist(gco2th(o), g->gray);
 275       break;
 276     }
 277     case LUA_TPROTO: {
 278       linkgclist(gco2p(o), g->gray);
 279       break;
 280     }
 281     default: lua_assert(0); break;
 282   }
 283 }
 284
 285
 286 /*
 287 ** mark metamethods for basic types
 288 */
 289 static void markmt (global_State *g) {
 290   int i;
 291   for (i=0; i < LUA_NUMTAGS; i++)
 292     markobjectN(g, g->mt[i]);
 293 }
 294
 295
 296 /*
 297 ** mark all objects in list of being-finalized
 298 */
 299 static void markbeingfnz (global_State *g) {
 300   GCObject *o;
 301   for (o = g->tobefnz; o != NULL; o = o->next)
 302     markobject(g, o);
 303 }
 304
 305
 306 /*
 307 ** Mark all values stored in marked open upvalues from non-marked threads.
 308 ** (Values from marked threads were already marked when traversing the
 309 ** thread.) Remove from the list threads that no longer have upvalues and
 310 ** not-marked threads.
 311 */
 312 static void remarkupvals (global_State *g) {
 313   lua_State *thread;
 314   lua_State **p = &g->twups;
 315   while ((thread = *p) != NULL) {
 316     lua_assert(!isblack(thread));  /* threads are never black */
 317     if (isgray(thread) && thread->openupval != NULL)
 318       p = &thread->twups;  /* keep marked thread with upvalues in the list */
 319     else {  /* thread is not marked or without upvalues */
 320       UpVal *uv;
 321       *p = thread->twups;  /* remove thread from the list */
 322       thread->twups = thread;  /* mark that it is out of list */
 323       for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
 324         if (uv->u.open.touched) {
 325           markvalue(g, uv->v);  /* remark upvalue's value */
 326           uv->u.open.touched = 0;
 327         }
 328       }
 329     }
 330   }
 331 }
 332
 333
 334 /*
 335 ** mark root set and reset all gray lists, to start a new collection
 336 */
 337 static void restartcollection (global_State *g) {
 338   g->gray = g->grayagain = NULL;
 339   g->weak = g->allweak = g->ephemeron = NULL;
 340   markobject(g, g->mainthread);
 341   markvalue(g, &g->l_registry);
 342   markmt(g);
 343   markbeingfnz(g);  /* mark any finalizing object left from previous cycle */
 344 }
 345
 346 /* }====================================================== */
 347
 348
 349 /*
 350 ** {======================================================
 351 ** Traverse functions
 352 ** =======================================================
 353 */
 354
 355 /*
 356 ** Traverse a table with weak values and link it to proper list. During
 357 ** propagate phase, keep it in 'grayagain' list, to be revisited in the
 358 ** atomic phase. In the atomic phase, if table has any white value,
 359 ** put it in 'weak' list, to be cleared.
 360 */
 361 static void traverseweakvalue (global_State *g, Table *h) {
 362   Node *n, *limit = gnodelast(h);
 363   /* if there is array part, assume it may have white values (it is not
 364      worth traversing it now just to check) */
 365   int hasclears = (h->sizearray > 0);
 366   for (n = gnode(h, 0); n < limit; n++) {  /* traverse hash part */
 367     checkdeadkey(n);
 368     if (ttisnil(gval(n)))  /* entry is empty? */
 369       removeentry(n);  /* remove it */
 370     else {
 371       lua_assert(!ttisnil(gkey(n)));
 372       markvalue(g, gkey(n));  /* mark key */
 373       if (!hasclears && iscleared(g, gval(n)))  /* is there a white value? */
 374         hasclears = 1;  /* table will have to be cleared */
 375     }
 376   }
 377   if (g->gcstate == GCSpropagate)
 378     linkgclist(h, g->grayagain);  /* must retraverse it in atomic phase */
 379   else if (hasclears)
 380     linkgclist(h, g->weak);  /* has to be cleared later */
 381 }
 382
 383
 384 /*
 385 ** Traverse an ephemeron table and link it to proper list. Returns true
 386 ** iff any object was marked during this traversal (which implies that
 387 ** convergence has to continue). During propagation phase, keep table
 388 ** in 'grayagain' list, to be visited again in the atomic phase. In
 389 ** the atomic phase, if table has any white->white entry, it has to
 390 ** be revisited during ephemeron convergence (as that key may turn
 391 ** black). Otherwise, if it has any white key, table has to be cleared
 392 ** (in the atomic phase).
 393 */
 394 static int traverseephemeron (global_State *g, Table *h) {
 395   int marked = 0;  /* true if an object is marked in this traversal */
 396   int hasclears = 0;  /* true if table has white keys */
 397   int hasww = 0;  /* true if table has entry "white-key -> white-value" */
 398   Node *n, *limit = gnodelast(h);
 399   unsigned int i;
 400   /* traverse array part */
 401   for (i = 0; i < h->sizearray; i++) {
 402     if (valiswhite(&h->array[i])) {
 403       marked = 1;
 404       reallymarkobject(g, gcvalue(&h->array[i]));
 405     }
 406   }
 407   /* traverse hash part */
 408   for (n = gnode(h, 0); n < limit; n++) {
 409     checkdeadkey(n);
 410     if (ttisnil(gval(n)))  /* entry is empty? */
 411       removeentry(n);  /* remove it */
 412     else if (iscleared(g, gkey(n))) {  /* key is not marked (yet)? */
 413       hasclears = 1;  /* table must be cleared */
 414       if (valiswhite(gval(n)))  /* value not marked yet? */
 415         hasww = 1;  /* white-white entry */
 416     }
 417     else if (valiswhite(gval(n))) {  /* value not marked yet? */
 418       marked = 1;
 419       reallymarkobject(g, gcvalue(gval(n)));  /* mark it now */
 420     }
 421   }
 422   /* link table into proper list */
 423   if (g->gcstate == GCSpropagate)
 424     linkgclist(h, g->grayagain);  /* must retraverse it in atomic phase */
 425   else if (hasww)  /* table has white->white entries? */
 426     linkgclist(h, g->ephemeron);  /* have to propagate again */
 427   else if (hasclears)  /* table has white keys? */
 428     linkgclist(h, g->allweak);  /* may have to clean white keys */
 429   return marked;
 430 }
 431
 432
 433 static void traversestrongtable (global_State *g, Table *h) {
 434   Node *n, *limit = gnodelast(h);
 435   unsigned int i;
 436   for (i = 0; i < h->sizearray; i++)  /* traverse array part */
 437     markvalue(g, &h->array[i]);
 438   for (n = gnode(h, 0); n < limit; n++) {  /* traverse hash part */
 439     checkdeadkey(n);
 440     if (ttisnil(gval(n)))  /* entry is empty? */
 441       removeentry(n);  /* remove it */
 442     else {
 443       lua_assert(!ttisnil(gkey(n)));
 444       markvalue(g, gkey(n));  /* mark key */
 445       markvalue(g, gval(n));  /* mark value */
 446     }
 447   }
 448 }
 449
 450
 451 static lu_mem traversetable (global_State *g, Table *h) {
 452   const char *weakkey, *weakvalue;
 453   const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
 454   markobjectN(g, h->metatable);
 455   if (mode && ttisstring(mode) &&  /* is there a weak mode? */
 456       ((weakkey = strchr(svalue(mode), 'k')),
 457        (weakvalue = strchr(svalue(mode), 'v')),
 458        (weakkey || weakvalue))) {  /* is really weak? */
 459     black2gray(h);  /* keep table gray */
 460     if (!weakkey)  /* strong keys? */
 461       traverseweakvalue(g, h);
 462     else if (!weakvalue)  /* strong values? */
 463       traverseephemeron(g, h);
 464     else  /* all weak */
 465       linkgclist(h, g->allweak);  /* nothing to traverse now */
 466   }
 467   else  /* not weak */
 468     traversestrongtable(g, h);
 469   return sizeof(Table) + sizeof(TValue) * h->sizearray +
 470                          sizeof(Node) * cast(size_t, sizenode(h));
 471 }
 472
 473
 474 /*
 475 ** Traverse a prototype. (While a prototype is being build, its
 476 ** arrays can be larger than needed; the extra slots are filled with
 477 ** NULL, so the use of 'markobjectN')
 478 */
 479 static int traverseproto (global_State *g, Proto *f) {
 480   int i;
 481   if (f->cache && iswhite(f->cache))
 482     f->cache = NULL;  /* allow cache to be collected */
 483   markobjectN(g, f->source);
 484   for (i = 0; i < f->sizek; i++)  /* mark literals */
 485     markvalue(g, &f->k[i]);
 486   for (i = 0; i < f->sizeupvalues; i++)  /* mark upvalue names */
 487     markobjectN(g, f->upvalues[i].name);
 488   for (i = 0; i < f->sizep; i++)  /* mark nested protos */
 489     markobjectN(g, f->p[i]);
 490   for (i = 0; i < f->sizelocvars; i++)  /* mark local-variable names */
 491     markobjectN(g, f->locvars[i].varname);
 492   return sizeof(Proto) + sizeof(Instruction) * f->sizecode +
 493                          sizeof(Proto *) * f->sizep +
 494                          sizeof(TValue) * f->sizek +
 495                          sizeof(int) * f->sizelineinfo +
 496                          sizeof(LocVar) * f->sizelocvars +
 497                          sizeof(Upvaldesc) * f->sizeupvalues;
 498 }
 499
 500
 501 static lu_mem traverseCclosure (global_State *g, CClosure *cl) {
 502   int i;
 503   for (i = 0; i < cl->nupvalues; i++)  /* mark its upvalues */
 504     markvalue(g, &cl->upvalue[i]);
 505   return sizeCclosure(cl->nupvalues);
 506 }
 507
 508 /*
 509 ** open upvalues point to values in a thread, so those values should
 510 ** be marked when the thread is traversed except in the atomic phase
 511 ** (because then the value cannot be changed by the thread and the
 512 ** thread may not be traversed again)
 513 */
 514 static lu_mem traverseLclosure (global_State *g, LClosure *cl) {
 515   int i;
 516   markobjectN(g, cl->p);  /* mark its prototype */
 517   for (i = 0; i < cl->nupvalues; i++) {  /* mark its upvalues */
 518     UpVal *uv = cl->upvals[i];
 519     if (uv != NULL) {
 520       if (upisopen(uv) && g->gcstate != GCSinsideatomic)
 521         uv->u.open.touched = 1;  /* can be marked in 'remarkupvals' */
 522       else
 523         markvalue(g, uv->v);
 524     }
 525   }
 526   return sizeLclosure(cl->nupvalues);
 527 }
 528
 529
 530 static lu_mem traversethread (global_State *g, lua_State *th) {
 531   StkId o = th->stack;
 532   if (o == NULL)
 533     return 1;  /* stack not completely built yet */
 534   lua_assert(g->gcstate == GCSinsideatomic ||
 535              th->openupval == NULL || isintwups(th));
 536   for (; o < th->top; o++)  /* mark live elements in the stack */
 537     markvalue(g, o);
 538   if (g->gcstate == GCSinsideatomic) {  /* final traversal? */
 539     StkId lim = th->stack + th->stacksize;  /* real end of stack */
 540     for (; o < lim; o++)  /* clear not-marked stack slice */
 541       setnilvalue(o);
 542     /* 'remarkupvals' may have removed thread from 'twups' list */
 543     if (!isintwups(th) && th->openupval != NULL) {
 544       th->twups = g->twups;  /* link it back to the list */
 545       g->twups = th;
 546     }
 547   }
 548   else if (g->gckind != KGC_EMERGENCY)
 549     luaD_shrinkstack(th); /* do not change stack in emergency cycle */
 550   return (sizeof(lua_State) + sizeof(TValue) * th->stacksize +
 551           sizeof(CallInfo) * th->nci);
 552 }
 553
 554
 555 /*
 556 ** traverse one gray object, turning it to black (except for threads,
 557 ** which are always gray).
 558 */
 559 static void propagatemark (global_State *g) {
 560   lu_mem size;
 561   GCObject *o = g->gray;
 562   lua_assert(isgray(o));
 563   gray2black(o);
 564   switch (o->tt) {
 565     case LUA_TTABLE: {
 566       Table *h = gco2t(o);
 567       g->gray = h->gclist;  /* remove from 'gray' list */
 568       size = traversetable(g, h);
 569       break;
 570     }
 571     case LUA_TLCL: {
 572       LClosure *cl = gco2lcl(o);
 573       g->gray = cl->gclist;  /* remove from 'gray' list */
 574       size = traverseLclosure(g, cl);
 575       break;
 576     }
 577     case LUA_TCCL: {
 578       CClosure *cl = gco2ccl(o);
 579       g->gray = cl->gclist;  /* remove from 'gray' list */
 580       size = traverseCclosure(g, cl);
 581       break;
 582     }
 583     case LUA_TTHREAD: {
 584       lua_State *th = gco2th(o);
 585       g->gray = th->gclist;  /* remove from 'gray' list */
 586       linkgclist(th, g->grayagain);  /* insert into 'grayagain' list */
 587       black2gray(o);
 588       size = traversethread(g, th);
 589       break;
 590     }
 591     case LUA_TPROTO: {
 592       Proto *p = gco2p(o);
 593       g->gray = p->gclist;  /* remove from 'gray' list */
 594       size = traverseproto(g, p);
 595       break;
 596     }
 597     default: lua_assert(0); return;
 598   }
 599   g->GCmemtrav += size;
 600 }
 601
 602
 603 static void propagateall (global_State *g) {
 604   while (g->gray) propagatemark(g);
 605 }
 606
 607
 608 static void convergeephemerons (global_State *g) {
 609   int changed;
 610   do {
 611     GCObject *w;
 612     GCObject *next = g->ephemeron;  /* get ephemeron list */
 613     g->ephemeron = NULL;  /* tables may return to this list when traversed */
 614     changed = 0;
 615     while ((w = next) != NULL) {
 616       next = gco2t(w)->gclist;
 617       if (traverseephemeron(g, gco2t(w))) {  /* traverse marked some value? */
 618         propagateall(g);  /* propagate changes */
 619         changed = 1;  /* will have to revisit all ephemeron tables */
 620       }
 621     }
 622   } while (changed);
 623 }
 624
 625 /* }====================================================== */
 626
 627
 628 /*
 629 ** {======================================================
 630 ** Sweep Functions
 631 ** =======================================================
 632 */
 633
 634
 635 /*
 636 ** clear entries with unmarked keys from all weaktables in list 'l' up
 637 ** to element 'f'
 638 */
 639 static void clearkeys (global_State *g, GCObject *l, GCObject *f) {
 640   for (; l != f; l = gco2t(l)->gclist) {
 641     Table *h = gco2t(l);
 642     Node *n, *limit = gnodelast(h);
 643     for (n = gnode(h, 0); n < limit; n++) {
 644       if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) {
 645         setnilvalue(gval(n));  /* remove value ... */
 646         removeentry(n);  /* and remove entry from table */
 647       }
 648     }
 649   }
 650 }
 651
 652
 653 /*
 654 ** clear entries with unmarked values from all weaktables in list 'l' up
 655 ** to element 'f'
 656 */
 657 static void clearvalues (global_State *g, GCObject *l, GCObject *f) {
 658   for (; l != f; l = gco2t(l)->gclist) {
 659     Table *h = gco2t(l);
 660     Node *n, *limit = gnodelast(h);
 661     unsigned int i;
 662     for (i = 0; i < h->sizearray; i++) {
 663       TValue *o = &h->array[i];
 664       if (iscleared(g, o))  /* value was collected? */
 665         setnilvalue(o);  /* remove value */
 666     }
 667     for (n = gnode(h, 0); n < limit; n++) {
 668       if (!ttisnil(gval(n)) && iscleared(g, gval(n))) {
 669         setnilvalue(gval(n));  /* remove value ... */
 670         removeentry(n);  /* and remove entry from table */
 671       }
 672     }
 673   }
 674 }
 675
 676
 677 void luaC_upvdeccount (lua_State *L, UpVal *uv) {
 678   lua_assert(uv->refcount > 0);
 679   uv->refcount--;
 680   if (uv->refcount == 0 && !upisopen(uv))
 681     luaM_free(L, uv);
 682 }
 683
 684
 685 static void freeLclosure (lua_State *L, LClosure *cl) {
 686   int i;
 687   for (i = 0; i < cl->nupvalues; i++) {
 688     UpVal *uv = cl->upvals[i];
 689     if (uv)
 690       luaC_upvdeccount(L, uv);
 691   }
 692   luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));
 693 }
 694
 695
 696 static void freeobj (lua_State *L, GCObject *o) {
 697   switch (o->tt) {
 698     case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break;
 699     case LUA_TLCL: {
 700       freeLclosure(L, gco2lcl(o));
 701       break;
 702     }
 703     case LUA_TCCL: {
 704       luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));
 705       break;
 706     }
 707     case LUA_TTABLE: luaH_free(L, gco2t(o)); break;
 708     case LUA_TTHREAD: luaE_freethread(L, gco2th(o)); break;
 709     case LUA_TUSERDATA: luaM_freemem(L, o, sizeudata(gco2u(o))); break;
 710     case LUA_TSHRSTR:
 711       luaS_remove(L, gco2ts(o));  /* remove it from hash table */
 712       luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen));
 713       break;
 714     case LUA_TLNGSTR: {
 715       luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen));
 716       break;
 717     }
 718     default: lua_assert(0);
 719   }
 720 }
 721
 722
 723 #define sweepwholelist(L,p)     sweeplist(L,p,MAX_LUMEM)
 724 static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count);
 725
 726
 727 /*
 728 ** sweep at most 'count' elements from a list of GCObjects erasing dead
 729 ** objects, where a dead object is one marked with the old (non current)
 730 ** white; change all non-dead objects back to white, preparing for next
 731 ** collection cycle. Return where to continue the traversal or NULL if
 732 ** list is finished.
 733 */
 734 static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {
 735   global_State *g = G(L);
 736   int ow = otherwhite(g);
 737   int white = luaC_white(g);  /* current white */
 738   while (*p != NULL && count-- > 0) {
 739     GCObject *curr = *p;
 740     int marked = curr->marked;
 741     if (isdeadm(ow, marked)) {  /* is 'curr' dead? */
 742       *p = curr->next;  /* remove 'curr' from list */
 743       freeobj(L, curr);  /* erase 'curr' */
 744     }
 745     else {  /* change mark to 'white' */
 746       curr->marked = cast_byte((marked & maskcolors) | white);
 747       p = &curr->next;  /* go to next element */
 748     }
 749   }
 750   return (*p == NULL) ? NULL : p;
 751 }
 752
 753
 754 /*
 755 ** sweep a list until a live object (or end of list)
 756 */
 757 static GCObject **sweeptolive (lua_State *L, GCObject **p) {
 758   GCObject **old = p;
 759   do {
 760     p = sweeplist(L, p, 1);
 761   } while (p == old);
 762   return p;
 763 }
 764
 765 /* }====================================================== */
 766
 767
 768 /*
 769 ** {======================================================
 770 ** Finalization
 771 ** =======================================================
 772 */
 773
 774 /*
 775 ** If possible, shrink string table
 776 */
 777 static void checkSizes (lua_State *L, global_State *g) {
 778   if (g->gckind != KGC_EMERGENCY) {
 779     l_mem olddebt = g->GCdebt;
 780     if (g->strt.nuse < g->strt.size / 4)  /* string table too big? */
 781       luaS_resize(L, g->strt.size / 2);  /* shrink it a little */
 782     g->GCestimate += g->GCdebt - olddebt;  /* update estimate */
 783   }
 784 }
 785
 786
 787 static GCObject *udata2finalize (global_State *g) {
 788   GCObject *o = g->tobefnz;  /* get first element */
 789   lua_assert(tofinalize(o));
 790   g->tobefnz = o->next;  /* remove it from 'tobefnz' list */
 791   o->next = g->allgc;  /* return it to 'allgc' list */
 792   g->allgc = o;
 793   resetbit(o->marked, FINALIZEDBIT);  /* object is "normal" again */
 794   if (issweepphase(g))
 795     makewhite(g, o);  /* "sweep" object */
 796   return o;
 797 }
 798
 799
 800 static void dothecall (lua_State *L, void *ud) {
 801   UNUSED(ud);
 802   luaD_callnoyield(L, L->top - 2, 0);
 803 }
 804
 805
 806 static void GCTM (lua_State *L, int propagateerrors) {
 807   global_State *g = G(L);
 808   const TValue *tm;
 809   TValue v;
 810   setgcovalue(L, &v, udata2finalize(g));
 811   tm = luaT_gettmbyobj(L, &v, TM_GC);
 812   if (tm != NULL && ttisfunction(tm)) {  /* is there a finalizer? */
 813     int status;
 814     lu_byte oldah = L->allowhook;
 815     int running  = g->gcrunning;
 816     L->allowhook = 0;  /* stop debug hooks during GC metamethod */
 817     g->gcrunning = 0;  /* avoid GC steps */
 818     setobj2s(L, L->top, tm);  /* push finalizer... */
 819     setobj2s(L, L->top + 1, &v);  /* ... and its argument */
 820     L->top += 2;  /* and (next line) call the finalizer */
 821     status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
 822     L->allowhook = oldah;  /* restore hooks */
 823     g->gcrunning = running;  /* restore state */
 824     if (status != LUA_OK && propagateerrors) {  /* error while running __gc? */
 825       if (status == LUA_ERRRUN) {  /* is there an error object? */
 826         const char *msg = (ttisstring(L->top - 1))
 827                             ? svalue(L->top - 1)
 828                             : "no message";
 829         luaO_pushfstring(L, "error in __gc metamethod (%s)", msg);
 830         status = LUA_ERRGCMM;  /* error in __gc metamethod */
 831       }
 832       luaD_throw(L, status);  /* re-throw error */
 833     }
 834   }
 835 }
 836
 837
 838 /*
 839 ** call a few (up to 'g->gcfinnum') finalizers
 840 */
 841 static int runafewfinalizers (lua_State *L) {
 842   global_State *g = G(L);
 843   unsigned int i;
 844   lua_assert(!g->tobefnz || g->gcfinnum > 0);
 845   for (i = 0; g->tobefnz && i < g->gcfinnum; i++)
 846     GCTM(L, 1);  /* call one finalizer */
 847   g->gcfinnum = (!g->tobefnz) ? 0  /* nothing more to finalize? */
 848                     : g->gcfinnum * 2;  /* else call a few more next time */
 849   return i;
 850 }
 851
 852
 853 /*
 854 ** call all pending finalizers
 855 */
 856 static void callallpendingfinalizers (lua_State *L) {
 857   global_State *g = G(L);
 858   while (g->tobefnz)
 859     GCTM(L, 0);
 860 }
 861
 862
 863 /*
 864 ** find last 'next' field in list 'p' list (to add elements in its end)
 865 */
 866 static GCObject **findlast (GCObject **p) {
 867   while (*p != NULL)
 868     p = &(*p)->next;
 869   return p;
 870 }
 871
 872
 873 /*
 874 ** move all unreachable objects (or 'all' objects) that need
 875 ** finalization from list 'finobj' to list 'tobefnz' (to be finalized)
 876 */
 877 static void separatetobefnz (global_State *g, int all) {
 878   GCObject *curr;
 879   GCObject **p = &g->finobj;
 880   GCObject **lastnext = findlast(&g->tobefnz);
 881   while ((curr = *p) != NULL) {  /* traverse all finalizable objects */
 882     lua_assert(tofinalize(curr));
 883     if (!(iswhite(curr) || all))  /* not being collected? */
 884       p = &curr->next;  /* don't bother with it */
 885     else {
 886       *p = curr->next;  /* remove 'curr' from 'finobj' list */
 887       curr->next = *lastnext;  /* link at the end of 'tobefnz' list */
 888       *lastnext = curr;
 889       lastnext = &curr->next;
 890     }
 891   }
 892 }
 893
 894
 895 /*
 896 ** if object 'o' has a finalizer, remove it from 'allgc' list (must
 897 ** search the list to find it) and link it in 'finobj' list.
 898 */
 899 void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
 900   global_State *g = G(L);
 901   if (tofinalize(o) ||                 /* obj. is already marked... */
 902       gfasttm(g, mt, TM_GC) == NULL)   /* or has no finalizer? */
 903     return;  /* nothing to be done */
 904   else {  /* move 'o' to 'finobj' list */
 905     GCObject **p;
 906     if (issweepphase(g)) {
 907       makewhite(g, o);  /* "sweep" object 'o' */
 908       if (g->sweepgc == &o->next)  /* should not remove 'sweepgc' object */
 909         g->sweepgc = sweeptolive(L, g->sweepgc);  /* change 'sweepgc' */
 910     }
 911     /* search for pointer pointing to 'o' */
 912     for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
 913     *p = o->next;  /* remove 'o' from 'allgc' list */
 914     o->next = g->finobj;  /* link it in 'finobj' list */
 915     g->finobj = o;
 916     l_setbit(o->marked, FINALIZEDBIT);  /* mark it as such */
 917   }
 918 }
 919
 920 /* }====================================================== */
 921
 922
 923
 924 /*
 925 ** {======================================================
 926 ** GC control
 927 ** =======================================================
 928 */
 929
 930
 931 /*
 932 ** Set a reasonable "time" to wait before starting a new GC cycle; cycle
 933 ** will start when memory use hits threshold. (Division by 'estimate'
 934 ** should be OK: it cannot be zero (because Lua cannot even start with
 935 ** less than PAUSEADJ bytes).
 936 */
 937 static void setpause (global_State *g) {
 938   l_mem threshold, debt;
 939   l_mem estimate = g->GCestimate / PAUSEADJ;  /* adjust 'estimate' */
 940   lua_assert(estimate > 0);
 941   threshold = (g->gcpause < MAX_LMEM / estimate)  /* overflow? */
 942             ? estimate * g->gcpause  /* no overflow */
 943             : MAX_LMEM;  /* overflow; truncate to maximum */
 944   debt = gettotalbytes(g) - threshold;
 945   luaE_setdebt(g, debt);
 946 }
 947
 948
 949 /*
 950 ** Enter first sweep phase.
 951 ** The call to 'sweeplist' tries to make pointer point to an object
 952 ** inside the list (instead of to the header), so that the real sweep do
 953 ** not need to skip objects created between "now" and the start of the
 954 ** real sweep.
 955 */
 956 static void entersweep (lua_State *L) {
 957   global_State *g = G(L);
 958   g->gcstate = GCSswpallgc;
 959   lua_assert(g->sweepgc == NULL);
 960   g->sweepgc = sweeplist(L, &g->allgc, 1);
 961 }
 962
 963
 964 void luaC_freeallobjects (lua_State *L) {
 965   global_State *g = G(L);
 966   separatetobefnz(g, 1);  /* separate all objects with finalizers */
 967   lua_assert(g->finobj == NULL);
 968   callallpendingfinalizers(L);
 969   lua_assert(g->tobefnz == NULL);
 970   g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */
 971   g->gckind = KGC_NORMAL;
 972   sweepwholelist(L, &g->finobj);
 973   sweepwholelist(L, &g->allgc);
 974   sweepwholelist(L, &g->fixedgc);  /* collect fixed objects */
 975   lua_assert(g->strt.nuse == 0);
 976 }
 977
 978
 979 static l_mem atomic (lua_State *L) {
 980   global_State *g = G(L);
 981   l_mem work;
 982   GCObject *origweak, *origall;
 983   GCObject *grayagain = g->grayagain;  /* save original list */
 984   lua_assert(g->ephemeron == NULL && g->weak == NULL);
 985   lua_assert(!iswhite(g->mainthread));
 986   g->gcstate = GCSinsideatomic;
 987   g->GCmemtrav = 0;  /* start counting work */
 988   markobject(g, L);  /* mark running thread */
 989   /* registry and global metatables may be changed by API */
 990   markvalue(g, &g->l_registry);
 991   markmt(g);  /* mark global metatables */
 992   /* remark occasional upvalues of (maybe) dead threads */
 993   remarkupvals(g);
 994   propagateall(g);  /* propagate changes */
 995   work = g->GCmemtrav;  /* stop counting (do not recount 'grayagain') */
 996   g->gray = grayagain;
 997   propagateall(g);  /* traverse 'grayagain' list */
 998   g->GCmemtrav = 0;  /* restart counting */
 999   convergeephemerons(g);
1000   /* at this point, all strongly accessible objects are marked. */
1001   /* Clear values from weak tables, before checking finalizers */
1002   clearvalues(g, g->weak, NULL);
1003   clearvalues(g, g->allweak, NULL);
1004   origweak = g->weak; origall = g->allweak;
1005   work += g->GCmemtrav;  /* stop counting (objects being finalized) */
1006   separatetobefnz(g, 0);  /* separate objects to be finalized */
1007   g->gcfinnum = 1;  /* there may be objects to be finalized */
1008   markbeingfnz(g);  /* mark objects that will be finalized */
1009   propagateall(g);  /* remark, to propagate 'resurrection' */
1010   g->GCmemtrav = 0;  /* restart counting */
1011   convergeephemerons(g);
1012   /* at this point, all resurrected objects are marked. */
1013   /* remove dead objects from weak tables */
1014   clearkeys(g, g->ephemeron, NULL);  /* clear keys from all ephemeron tables */
1015   clearkeys(g, g->allweak, NULL);  /* clear keys from all 'allweak' tables */
1016   /* clear values from resurrected weak tables */
1017   clearvalues(g, g->weak, origweak);
1018   clearvalues(g, g->allweak, origall);
1019   luaS_clearcache(g);
1020   g->currentwhite = cast_byte(otherwhite(g));  /* flip current white */
1021   work += g->GCmemtrav;  /* complete counting */
1022   return work;  /* estimate of memory marked by 'atomic' */
1023 }
1024
1025
1026 static lu_mem sweepstep (lua_State *L, global_State *g,
1027                          int nextstate, GCObject **nextlist) {
1028   if (g->sweepgc) {
1029     l_mem olddebt = g->GCdebt;
1030     g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);
1031     g->GCestimate += g->GCdebt - olddebt;  /* update estimate */
1032     if (g->sweepgc)  /* is there still something to sweep? */
1033       return (GCSWEEPMAX * GCSWEEPCOST);
1034   }
1035   /* else enter next state */
1036   g->gcstate = nextstate;
1037   g->sweepgc = nextlist;
1038   return 0;
1039 }
1040
1041
1042 static lu_mem singlestep (lua_State *L) {
1043   global_State *g = G(L);
1044   switch (g->gcstate) {
1045     case GCSpause: {
1046       g->GCmemtrav = g->strt.size * sizeof(GCObject*);
1047       restartcollection(g);
1048       g->gcstate = GCSpropagate;
1049       return g->GCmemtrav;
1050     }
1051     case GCSpropagate: {
1052       g->GCmemtrav = 0;
1053       lua_assert(g->gray);
1054       propagatemark(g);
1055        if (g->gray == NULL)  /* no more gray objects? */
1056         g->gcstate = GCSatomic;  /* finish propagate phase */
1057       return g->GCmemtrav;  /* memory traversed in this step */
1058     }
1059     case GCSatomic: {
1060       lu_mem work;
1061       propagateall(g);  /* make sure gray list is empty */
1062       work = atomic(L);  /* work is what was traversed by 'atomic' */
1063       entersweep(L);
1064       g->GCestimate = gettotalbytes(g);  /* first estimate */;
1065       return work;
1066     }
1067     case GCSswpallgc: {  /* sweep "regular" objects */
1068       return sweepstep(L, g, GCSswpfinobj, &g->finobj);
1069     }
1070     case GCSswpfinobj: {  /* sweep objects with finalizers */
1071       return sweepstep(L, g, GCSswptobefnz, &g->tobefnz);
1072     }
1073     case GCSswptobefnz: {  /* sweep objects to be finalized */
1074       return sweepstep(L, g, GCSswpend, NULL);
1075     }
1076     case GCSswpend: {  /* finish sweeps */
1077       makewhite(g, g->mainthread);  /* sweep main thread */
1078       checkSizes(L, g);
1079       g->gcstate = GCScallfin;
1080       return 0;
1081     }
1082     case GCScallfin: {  /* call remaining finalizers */
1083       if (g->tobefnz && g->gckind != KGC_EMERGENCY) {
1084         int n = runafewfinalizers(L);
1085         return (n * GCFINALIZECOST);
1086       }
1087       else {  /* emergency mode or no more finalizers */
1088         g->gcstate = GCSpause;  /* finish collection */
1089         return 0;
1090       }
1091     }
1092     default: lua_assert(0); return 0;
1093   }
1094 }
1095
1096
1097 /*
1098 ** advances the garbage collector until it reaches a state allowed
1099 ** by 'statemask'
1100 */
1101 void luaC_runtilstate (lua_State *L, int statesmask) {
1102   global_State *g = G(L);
1103   while (!testbit(statesmask, g->gcstate))
1104     singlestep(L);
1105 }
1106
1107
1108 /*
1109 ** get GC debt and convert it from Kb to 'work units' (avoid zero debt
1110 ** and overflows)
1111 */
1112 static l_mem getdebt (global_State *g) {
1113   l_mem debt = g->GCdebt;
1114   int stepmul = g->gcstepmul;
1115   if (debt <= 0) return 0;  /* minimal debt */
1116   else {
1117     debt = (debt / STEPMULADJ) + 1;
1118     debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM;
1119     return debt;
1120   }
1121 }
1122
1123 /*
1124 ** performs a basic GC step when collector is running
1125 */
1126 void luaC_step (lua_State *L) {
1127   global_State *g = G(L);
1128   l_mem debt = getdebt(g);  /* GC deficit (be paid now) */
1129   if (!g->gcrunning) {  /* not running? */
1130     luaE_setdebt(g, -GCSTEPSIZE * 10);  /* avoid being called too often */
1131     return;
1132   }
1133   do {  /* repeat until pause or enough "credit" (negative debt) */
1134     lu_mem work = singlestep(L);  /* perform one single step */
1135     debt -= work;
1136   } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause);
1137   if (g->gcstate == GCSpause)
1138     setpause(g);  /* pause until next cycle */
1139   else {
1140     debt = (debt / g->gcstepmul) * STEPMULADJ;  /* convert 'work units' to Kb */
1141     luaE_setdebt(g, debt);
1142     runafewfinalizers(L);
1143   }
1144 }
1145
1146
1147 /*
1148 ** Performs a full GC cycle; if 'isemergency', set a flag to avoid
1149 ** some operations which could change the interpreter state in some
1150 ** unexpected ways (running finalizers and shrinking some structures).
1151 ** Before running the collection, check 'keepinvariant'; if it is true,
1152 ** there may be some objects marked as black, so the collector has
1153 ** to sweep all objects to turn them back to white (as white has not
1154 ** changed, nothing will be collected).
1155 */
1156 void luaC_fullgc (lua_State *L, int isemergency) {
1157   global_State *g = G(L);
1158   lua_assert(g->gckind == KGC_NORMAL);
1159   if (isemergency) g->gckind = KGC_EMERGENCY;  /* set flag */
1160   if (keepinvariant(g)) {  /* black objects? */
1161     entersweep(L); /* sweep everything to turn them back to white */
1162   }
1163   /* finish any pending sweep phase to start a new cycle */
1164   luaC_runtilstate(L, bitmask(GCSpause));
1165   luaC_runtilstate(L, ~bitmask(GCSpause));  /* start new collection */
1166   luaC_runtilstate(L, bitmask(GCScallfin));  /* run up to finalizers */
1167   /* estimate must be correct after a full GC cycle */
1168   lua_assert(g->GCestimate == gettotalbytes(g));
1169   luaC_runtilstate(L, bitmask(GCSpause));  /* finish collection */
1170   g->gckind = KGC_NORMAL;
1171   setpause(g);
1172 }
1173
1174 /* }====================================================== */
1175
1176