"Fossies" - the Fresh Open Source Software Archive

Member "darktable-2.6.3/src/external/lua/src/lgc.c" (20 Oct 2019, 36479 Bytes) of package /linux/misc/darktable-2.6.3.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "lgc.c" see the Fossies "Dox" file reference documentation.

    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