libs/lua/lua-5.3.4/lgc.c

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