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