- initial import of revision 374 from cnc
[apt.git] / lua / lgc.c
1 /*
2 ** $Id: lgc.c,v 1.171a 2003/04/03 13:35:34 roberto Exp $
3 ** Garbage Collector
4 ** See Copyright Notice in lua.h
5 */
6
7 #include <string.h>
8
9 #define lgc_c
10
11 #include "lua.h"
12
13 #include "ldebug.h"
14 #include "ldo.h"
15 #include "lfunc.h"
16 #include "lgc.h"
17 #include "lmem.h"
18 #include "lobject.h"
19 #include "lstate.h"
20 #include "lstring.h"
21 #include "ltable.h"
22 #include "ltm.h"
23
24
25 typedef struct GCState {
26   GCObject *tmark;  /* list of marked objects to be traversed */
27   GCObject *wk;  /* list of traversed key-weak tables (to be cleared) */
28   GCObject *wv;  /* list of traversed value-weak tables */
29   GCObject *wkv;  /* list of traversed key-value weak tables */
30   global_State *g;
31 } GCState;
32
33
34 /*
35 ** some userful bit tricks
36 */
37 #define setbit(x,b)     ((x) |= (1<<(b)))
38 #define resetbit(x,b)   ((x) &= cast(lu_byte, ~(1<<(b))))
39 #define testbit(x,b)    ((x) & (1<<(b)))
40
41 #define unmark(x)       resetbit((x)->gch.marked, 0)
42 #define ismarked(x)     ((x)->gch.marked & ((1<<4)|1))
43
44 #define stringmark(s)   setbit((s)->tsv.marked, 0)
45
46
47 #define isfinalized(u)          (!testbit((u)->uv.marked, 1))
48 #define markfinalized(u)        resetbit((u)->uv.marked, 1)
49
50
51 #define KEYWEAKBIT    1
52 #define VALUEWEAKBIT  2
53 #define KEYWEAK         (1<<KEYWEAKBIT)
54 #define VALUEWEAK       (1<<VALUEWEAKBIT)
55
56
57
58 #define markobject(st,o) { checkconsistency(o); \
59   if (iscollectable(o) && !ismarked(gcvalue(o))) reallymarkobject(st,gcvalue(o)); }
60
61 #define condmarkobject(st,o,c) { checkconsistency(o); \
62   if (iscollectable(o) && !ismarked(gcvalue(o)) && (c)) \
63     reallymarkobject(st,gcvalue(o)); }
64
65 #define markvalue(st,t) { if (!ismarked(valtogco(t))) \
66                 reallymarkobject(st, valtogco(t)); }
67
68
69
70 static void reallymarkobject (GCState *st, GCObject *o) {
71   lua_assert(!ismarked(o));
72   setbit(o->gch.marked, 0);  /* mark object */
73   switch (o->gch.tt) {
74     case LUA_TUSERDATA: {
75       markvalue(st, gcotou(o)->uv.metatable);
76       break;
77     }
78     case LUA_TFUNCTION: {
79       gcotocl(o)->c.gclist = st->tmark;
80       st->tmark = o;
81       break;
82     }
83     case LUA_TTABLE: {
84       gcotoh(o)->gclist = st->tmark;
85       st->tmark = o;
86       break;
87     }
88     case LUA_TTHREAD: {
89       gcototh(o)->gclist = st->tmark;
90       st->tmark = o;
91       break;
92     }
93     case LUA_TPROTO: {
94       gcotop(o)->gclist = st->tmark;
95       st->tmark = o;
96       break;
97     }
98     default: lua_assert(o->gch.tt == LUA_TSTRING);
99   }
100 }
101
102
103 static void marktmu (GCState *st) {
104   GCObject *u;
105   for (u = st->g->tmudata; u; u = u->gch.next) {
106     unmark(u);  /* may be marked, if left from previous GC */
107     reallymarkobject(st, u);
108   }
109 }
110
111
112 /* move `dead' udata that need finalization to list `tmudata' */
113 size_t luaC_separateudata (lua_State *L) {
114   size_t deadmem = 0;
115   GCObject **p = &G(L)->rootudata;
116   GCObject *curr;
117   GCObject *collected = NULL;  /* to collect udata with gc event */
118   GCObject **lastcollected = &collected;
119   while ((curr = *p) != NULL) {
120     lua_assert(curr->gch.tt == LUA_TUSERDATA);
121     if (ismarked(curr) || isfinalized(gcotou(curr)))
122       p = &curr->gch.next;  /* don't bother with them */
123
124     else if (fasttm(L, gcotou(curr)->uv.metatable, TM_GC) == NULL) {
125       markfinalized(gcotou(curr));  /* don't need finalization */
126       p = &curr->gch.next;
127     }
128     else {  /* must call its gc method */
129       deadmem += sizeudata(gcotou(curr)->uv.len);
130       *p = curr->gch.next;
131       curr->gch.next = NULL;  /* link `curr' at the end of `collected' list */
132       *lastcollected = curr;
133       lastcollected = &curr->gch.next;
134     }
135   }
136   /* insert collected udata with gc event into `tmudata' list */
137   *lastcollected = G(L)->tmudata;
138   G(L)->tmudata = collected;
139   return deadmem;
140 }
141
142
143 static void removekey (Node *n) {
144   setnilvalue(gval(n));  /* remove corresponding value ... */
145   if (iscollectable(gkey(n)))
146     setttype(gkey(n), LUA_TNONE);  /* dead key; remove it */
147 }
148
149
150 static void traversetable (GCState *st, Table *h) {
151   int i;
152   int weakkey = 0;
153   int weakvalue = 0;
154   const TObject *mode;
155   markvalue(st, h->metatable);
156   lua_assert(h->lsizenode || h->node == st->g->dummynode);
157   mode = gfasttm(st->g, h->metatable, TM_MODE);
158   if (mode && ttisstring(mode)) {  /* is there a weak mode? */
159     weakkey = (strchr(svalue(mode), 'k') != NULL);
160     weakvalue = (strchr(svalue(mode), 'v') != NULL);
161     if (weakkey || weakvalue) {  /* is really weak? */
162       GCObject **weaklist;
163       h->marked &= ~(KEYWEAK | VALUEWEAK);  /* clear bits */
164       h->marked |= cast(lu_byte, (weakkey << KEYWEAKBIT) |
165                                  (weakvalue << VALUEWEAKBIT));
166       weaklist = (weakkey && weakvalue) ? &st->wkv :
167                               (weakkey) ? &st->wk :
168                                           &st->wv;
169       h->gclist = *weaklist;  /* must be cleared after GC, ... */
170       *weaklist = valtogco(h);  /* ... so put in the appropriate list */
171     }
172   }
173   if (!weakvalue) {
174     i = h->sizearray;
175     while (i--)
176       markobject(st, &h->array[i]);
177   }
178   i = sizenode(h);
179   while (i--) {
180     Node *n = gnode(h, i);
181     if (!ttisnil(gval(n))) {
182       lua_assert(!ttisnil(gkey(n)));
183       condmarkobject(st, gkey(n), !weakkey);
184       condmarkobject(st, gval(n), !weakvalue);
185     }
186   }
187 }
188
189
190 static void traverseproto (GCState *st, Proto *f) {
191   int i;
192   stringmark(f->source);
193   for (i=0; i<f->sizek; i++) {  /* mark literal strings */
194     if (ttisstring(f->k+i))
195       stringmark(tsvalue(f->k+i));
196   }
197   for (i=0; i<f->sizeupvalues; i++)  /* mark upvalue names */
198     stringmark(f->upvalues[i]);
199   for (i=0; i<f->sizep; i++)  /* mark nested protos */
200     markvalue(st, f->p[i]);
201   for (i=0; i<f->sizelocvars; i++)  /* mark local-variable names */
202     stringmark(f->locvars[i].varname);
203   lua_assert(luaG_checkcode(f));
204 }
205
206
207
208 static void traverseclosure (GCState *st, Closure *cl) {
209   if (cl->c.isC) {
210     int i;
211     for (i=0; i<cl->c.nupvalues; i++)  /* mark its upvalues */
212       markobject(st, &cl->c.upvalue[i]);
213   }
214   else {
215     int i;
216     lua_assert(cl->l.nupvalues == cl->l.p->nups);
217     markvalue(st, hvalue(&cl->l.g));
218     markvalue(st, cl->l.p);
219     for (i=0; i<cl->l.nupvalues; i++) {  /* mark its upvalues */
220       UpVal *u = cl->l.upvals[i];
221       if (!u->marked) {
222         markobject(st, &u->value);
223         u->marked = 1;
224       }
225     }
226   }
227 }
228
229
230 static void checkstacksizes (lua_State *L, StkId max) {
231   int used = L->ci - L->base_ci;  /* number of `ci' in use */
232   if (4*used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci)
233     luaD_reallocCI(L, L->size_ci/2);  /* still big enough... */
234   else condhardstacktests(luaD_reallocCI(L, L->size_ci));
235   used = max - L->stack;  /* part of stack in use */
236   if (4*used < L->stacksize && 2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)
237     luaD_reallocstack(L, L->stacksize/2);  /* still big enough... */
238   else condhardstacktests(luaD_reallocstack(L, L->stacksize));
239 }
240
241
242 static void traversestack (GCState *st, lua_State *L1) {
243   StkId o, lim;
244   CallInfo *ci;
245   markobject(st, gt(L1));
246   lim = L1->top;
247   for (ci = L1->base_ci; ci <= L1->ci; ci++) {
248     lua_assert(ci->top <= L1->stack_last);
249     lua_assert(ci->state & (CI_C | CI_HASFRAME | CI_SAVEDPC));
250     if (lim < ci->top)
251       lim = ci->top;
252   }
253   for (o = L1->stack; o < L1->top; o++)
254     markobject(st, o);
255   for (; o <= lim; o++)
256     setnilvalue(o);
257   checkstacksizes(L1, lim);
258 }
259
260
261 static void propagatemarks (GCState *st) {
262   while (st->tmark) {  /* traverse marked objects */
263     switch (st->tmark->gch.tt) {
264       case LUA_TTABLE: {
265         Table *h = gcotoh(st->tmark);
266         st->tmark = h->gclist;
267         traversetable(st, h);
268         break;
269       }
270       case LUA_TFUNCTION: {
271         Closure *cl = gcotocl(st->tmark);
272         st->tmark = cl->c.gclist;
273         traverseclosure(st, cl);
274         break;
275       }
276       case LUA_TTHREAD: {
277         lua_State *th = gcototh(st->tmark);
278         st->tmark = th->gclist;
279         traversestack(st, th);
280         break;
281       }
282       case LUA_TPROTO: {
283         Proto *p = gcotop(st->tmark);
284         st->tmark = p->gclist;
285         traverseproto(st, p);
286         break;
287       }
288       default: lua_assert(0);
289     }
290   }
291 }
292
293
294 static int valismarked (const TObject *o) {
295   if (ttisstring(o))
296     stringmark(tsvalue(o));  /* strings are `values', so are never weak */
297   return !iscollectable(o) || testbit(o->value.gc->gch.marked, 0);
298 }
299
300
301 /*
302 ** clear collected keys from weaktables
303 */
304 static void cleartablekeys (GCObject *l) {
305   while (l) {
306     Table *h = gcotoh(l);
307     int i = sizenode(h);
308     lua_assert(h->marked & KEYWEAK);
309     while (i--) {
310       Node *n = gnode(h, i);
311       if (!valismarked(gkey(n)))  /* key was collected? */
312         removekey(n);  /* remove entry from table */
313     }
314     l = h->gclist;
315   }
316 }
317
318
319 /*
320 ** clear collected values from weaktables
321 */
322 static void cleartablevalues (GCObject *l) {
323   while (l) {
324     Table *h = gcotoh(l);
325     int i = h->sizearray;
326     lua_assert(h->marked & VALUEWEAK);
327     while (i--) {
328       TObject *o = &h->array[i];
329       if (!valismarked(o))  /* value was collected? */
330         setnilvalue(o);  /* remove value */
331     }
332     i = sizenode(h);
333     while (i--) {
334       Node *n = gnode(h, i);
335       if (!valismarked(gval(n)))  /* value was collected? */
336         removekey(n);  /* remove entry from table */
337     }
338     l = h->gclist;
339   }
340 }
341
342
343 static void freeobj (lua_State *L, GCObject *o) {
344   switch (o->gch.tt) {
345     case LUA_TPROTO: luaF_freeproto(L, gcotop(o)); break;
346     case LUA_TFUNCTION: luaF_freeclosure(L, gcotocl(o)); break;
347     case LUA_TUPVAL: luaM_freelem(L, gcotouv(o)); break;
348     case LUA_TTABLE: luaH_free(L, gcotoh(o)); break;
349     case LUA_TTHREAD: {
350       lua_assert(gcototh(o) != L && gcototh(o) != G(L)->mainthread);
351       luaE_freethread(L, gcototh(o));
352       break;
353     }
354     case LUA_TSTRING: {
355       luaM_free(L, o, sizestring(gcotots(o)->tsv.len));
356       break;
357     }
358     case LUA_TUSERDATA: {
359       luaM_free(L, o, sizeudata(gcotou(o)->uv.len));
360       break;
361     }
362     default: lua_assert(0);
363   }
364 }
365
366
367 static int sweeplist (lua_State *L, GCObject **p, int limit) {
368   GCObject *curr;
369   int count = 0;  /* number of collected items */
370   while ((curr = *p) != NULL) {
371     if (curr->gch.marked > limit) {
372       unmark(curr);
373       p = &curr->gch.next;
374     }
375     else {
376       count++;
377       *p = curr->gch.next;
378       freeobj(L, curr);
379     }
380   }
381   return count;
382 }
383
384
385 static void sweepstrings (lua_State *L, int all) {
386   int i;
387   for (i=0; i<G(L)->strt.size; i++) {  /* for each list */
388     G(L)->strt.nuse -= sweeplist(L, &G(L)->strt.hash[i], all);
389   }
390 }
391
392
393 static void checkSizes (lua_State *L, size_t deadmem) {
394   /* check size of string hash */
395   if (G(L)->strt.nuse < cast(ls_nstr, G(L)->strt.size/4) &&
396       G(L)->strt.size > MINSTRTABSIZE*2)
397     luaS_resize(L, G(L)->strt.size/2);  /* table is too big */
398   /* check size of buffer */
399   if (luaZ_sizebuffer(&G(L)->buff) > LUA_MINBUFFER*2) {  /* buffer too big? */
400     size_t newsize = luaZ_sizebuffer(&G(L)->buff) / 2;
401     luaZ_resizebuffer(L, &G(L)->buff, newsize);
402   }
403   G(L)->GCthreshold = 2*G(L)->nblocks - deadmem;  /* new threshold */
404 }
405
406
407 static void do1gcTM (lua_State *L, Udata *udata) {
408   const TObject *tm = fasttm(L, udata->uv.metatable, TM_GC);
409   if (tm != NULL) {
410     setobj2s(L->top, tm);
411     setuvalue(L->top+1, udata);
412     L->top += 2;
413     luaD_call(L, L->top - 2, 0);
414   }
415 }
416
417
418 void luaC_callGCTM (lua_State *L) {
419   lu_byte oldah = L->allowhook;
420   L->allowhook = 0;  /* stop debug hooks during GC tag methods */
421   L->top++;  /* reserve space to keep udata while runs its gc method */
422   while (G(L)->tmudata != NULL) {
423     GCObject *o = G(L)->tmudata;
424     Udata *udata = gcotou(o);
425     G(L)->tmudata = udata->uv.next;  /* remove udata from `tmudata' */
426     udata->uv.next = G(L)->rootudata;  /* return it to `root' list */
427     G(L)->rootudata = o;
428     setuvalue(L->top - 1, udata);  /* keep a reference to it */
429     unmark(o);
430     markfinalized(udata);
431     do1gcTM(L, udata);
432   }
433   L->top--;
434   L->allowhook = oldah;  /* restore hooks */
435 }
436
437
438 void luaC_sweep (lua_State *L, int all) {
439   if (all) all = 256;  /* larger than any mark */
440   sweeplist(L, &G(L)->rootudata, all);
441   sweepstrings(L, all);
442   sweeplist(L, &G(L)->rootgc, all);
443 }
444
445
446 /* mark root set */
447 static void markroot (GCState *st, lua_State *L) {
448   global_State *g = st->g;
449   markobject(st, defaultmeta(L));
450   markobject(st, registry(L));
451   traversestack(st, g->mainthread);
452   if (L != g->mainthread)  /* another thread is running? */
453     markvalue(st, L);  /* cannot collect it */
454 }
455
456
457 static size_t mark (lua_State *L) {
458   size_t deadmem;
459   GCState st;
460   GCObject *wkv;
461   st.g = G(L);
462   st.tmark = NULL;
463   st.wkv = st.wk = st.wv = NULL;
464   markroot(&st, L);
465   propagatemarks(&st);  /* mark all reachable objects */
466   cleartablevalues(st.wkv);
467   cleartablevalues(st.wv);
468   wkv = st.wkv;  /* keys must be cleared after preserving udata */
469   st.wkv = NULL;
470   st.wv = NULL;
471   deadmem = luaC_separateudata(L);  /* separate userdata to be preserved */
472   marktmu(&st);  /* mark `preserved' userdata */
473   propagatemarks(&st);  /* remark, to propagate `preserveness' */
474   cleartablekeys(wkv);
475   /* `propagatemarks' may resuscitate some weak tables; clear them too */
476   cleartablekeys(st.wk);
477   cleartablevalues(st.wv);
478   cleartablekeys(st.wkv);
479   cleartablevalues(st.wkv);
480   return deadmem;
481 }
482
483
484 void luaC_collectgarbage (lua_State *L) {
485   size_t deadmem = mark(L);
486   luaC_sweep(L, 0);
487   checkSizes(L, deadmem);
488   luaC_callGCTM(L);
489 }
490
491
492 void luaC_link (lua_State *L, GCObject *o, lu_byte tt) {
493   o->gch.next = G(L)->rootgc;
494   G(L)->rootgc = o;
495   o->gch.marked = 0;
496   o->gch.tt = tt;
497 }
498