Optimization in 'markold'

OLD1 objects can be potentially anywhere in the 'allgc' list (up
to 'reallyold'), but frequently they are all after 'old1' (natural
evolution of survivals) or do not exist at all (when all objects die
young). So, instead of 'markold' starts looking for them always
from the start of 'allgc', the collector keeps an extra pointer,
'firstold1', that points to the first OLD1 object in the 'allgc' list,
or is NULL if there are no OLD1 objects in that list.

4 files changed, 76 insertions, 19 deletions

diff --git a/lgc.c b/lgc.c
index 347b6778..9973c9db 100644
--- a/lgc.c
+++ b/lgc.c
@@ -859,6 +859,8 @@ static GCObject *udata2finalize (global_State *g) {
   resetbit(o->marked, FINALIZEDBIT);  /* object is "normal" again */
   if (issweepphase(g))
     makewhite(g, o);  /* "sweep" object */
+  else if (getage(o) == G_OLD1)
+    g->firstold1 = o;  /* it is the first OLD1 object in the list */
   return o;
 }
 
@@ -957,6 +959,27 @@ static void separatetobefnz (global_State *g, int all) {
 
 
 /*
+** If pointer 'p' points to 'o', move it to the next element.
+*/
+static void checkpointer (GCObject **p, GCObject *o) {
+  if (o == *p)
+    *p = o->next;
+}
+
+
+/*
+** Correct pointers to objects inside 'allgc' list when
+** object 'o' is being removed from the list.
+*/
+static void correctpointers (global_State *g, GCObject *o) {
+  checkpointer(&g->survival, o);
+  checkpointer(&g->old1, o);
+  checkpointer(&g->reallyold, o);
+  checkpointer(&g->firstold1, o);
+}
+
+
+/*
 ** if object 'o' has a finalizer, remove it from 'allgc' list (must
 ** search the list to find it) and link it in 'finobj' list.
 */
@@ -972,14 +995,8 @@ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
       if (g->sweepgc == &o->next)  /* should not remove 'sweepgc' object */
         g->sweepgc = sweeptolive(L, g->sweepgc);  /* change 'sweepgc' */
     }
-    else {  /* correct pointers into 'allgc' list, if needed */
-      if (o == g->survival)
-        g->survival = o->next;
-      if (o == g->old1)
-        g->old1 = o->next;
-      if (o == g->reallyold)
-        g->reallyold = o->next;
-    }
+    else
+      correctpointers(g, o);
     /* search for pointer pointing to 'o' */
     for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
     *p = o->next;  /* remove 'o' from 'allgc' list */
@@ -1033,7 +1050,7 @@ static void sweep2old (lua_State *L, GCObject **p) {
 ** will also remove objects turned white here from any gray list.
 */
 static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
-                            GCObject *limit) {
+                            GCObject *limit, GCObject **pfirstold1) {
   static const lu_byte nextage[] = {
     G_SURVIVAL,  /* from G_NEW */
     G_OLD1,      /* from G_SURVIVAL */
@@ -1056,8 +1073,11 @@ static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
         int marked = curr->marked & maskgcbits;  /* erase GC bits */
         curr->marked = cast_byte(marked | G_SURVIVAL | white);
       }
-      else  /* all other objects will be old, and so keep their color */
+      else {  /* all other objects will be old, and so keep their color */
         setage(curr, nextage[getage(curr)]);
+        if (getage(curr) == G_OLD1 && *pfirstold1 == NULL)
+          *pfirstold1 = curr;  /* first OLD1 object in the list */
+      }
       p = &curr->next;  /* go to next element */
     }
   }
@@ -1169,30 +1189,34 @@ static void finishgencycle (lua_State *L, global_State *g) {
 */
 static void youngcollection (lua_State *L, global_State *g) {
   GCObject **psurvival;  /* to point to first non-dead survival object */
+  GCObject *dummy;  /* dummy out parameter to 'sweepgen' */
   lua_assert(g->gcstate == GCSpropagate);
-  markold(g, g->allgc, g->reallyold);
+  if (g->firstold1) {  /* are there OLD1 objects? */
+    markold(g, g->firstold1, g->reallyold);  /* mark them */
+    g->firstold1 = NULL;  /* no more OLD1 objects (for now) */
+  }
   markold(g, g->finobj, g->finobjrold);
   atomic(L);
 
   /* sweep nursery and get a pointer to its last live element */
   g->gcstate = GCSswpallgc;
-  psurvival = sweepgen(L, g, &g->allgc, g->survival);
+  psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1);
   /* sweep 'survival' */
-  sweepgen(L, g, psurvival, g->old1);
+  sweepgen(L, g, psurvival, g->old1, &g->firstold1);
   g->reallyold = g->old1;
   g->old1 = *psurvival;  /* 'survival' survivals are old now */
   g->survival = g->allgc;  /* all news are survivals */
 
   /* repeat for 'finobj' lists */
-  psurvival = sweepgen(L, g, &g->finobj, g->finobjsur);
+  dummy = NULL;  /* no 'firstold1' optimization for 'finobj' lists */
+  psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy);
   /* sweep 'survival' */
-  sweepgen(L, g, psurvival, g->finobjold1);
+  sweepgen(L, g, psurvival, g->finobjold1, &dummy);
   g->finobjrold = g->finobjold1;
   g->finobjold1 = *psurvival;  /* 'survival' survivals are old now */
   g->finobjsur = g->finobj;  /* all news are survivals */
 
-  sweepgen(L, g, &g->tobefnz, NULL);
-
+  sweepgen(L, g, &g->tobefnz, NULL, &dummy);
   finishgencycle(L, g);
 }
 
@@ -1203,6 +1227,7 @@ static void atomic2gen (lua_State *L, global_State *g) {
   sweep2old(L, &g->allgc);
   /* everything alive now is old */
   g->reallyold = g->old1 = g->survival = g->allgc;
+  g->firstold1 = NULL;  /* there are no OLD1 objects anywhere */
 
   /* repeat for 'finobj' lists */
   sweep2old(L, &g->finobj);
diff --git a/lstate.c b/lstate.c
index 38a2b45a..86b3761f 100644
--- a/lstate.c
+++ b/lstate.c
@@ -413,7 +413,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   g->gckind = KGC_INC;
   g->gcemergency = 0;
   g->finobj = g->tobefnz = g->fixedgc = NULL;
-  g->survival = g->old1 = g->reallyold = NULL;
+  g->firstold1 = g->survival = g->old1 = g->reallyold = NULL;
   g->finobjsur = g->finobjold1 = g->finobjrold = NULL;
   g->sweepgc = NULL;
   g->gray = g->grayagain = NULL;
diff --git a/lstate.h b/lstate.h
index c02b4c8b..697d73b2 100644
--- a/lstate.h
+++ b/lstate.h
@@ -46,6 +46,15 @@
 ** lists. Moreover, barriers can age young objects in young lists as
 ** OLD0, which then become OLD1. However, a list never contains
 ** elements younger than their main ages.
+**
+** The generational collector also uses a pointer 'firstold1', which
+** points to the first OLD1 object in the list. It is used to optimize
+** 'markold'. (Potentially OLD1 objects can be anywhere between 'allgc'
+** and 'reallyold', but often the list has no OLD1 objects or they are
+** after 'old1'.) Note the difference between it and 'old1':
+** 'firstold1': no OLD1 objects before this point; there can be all
+**   ages after it.
+** 'old1': no objects younger than OLD1 after this point.
 */
 
 /*
@@ -54,7 +63,7 @@
 ** can become gray have such a field. The field is not the same
 ** in all objects, but it always has this name.)  Any gray object
 ** must belong to one of these lists, and all objects in these lists
-** must be gray:
+** must be gray (with one exception explained below):
 **
 ** 'gray': regular gray objects, still waiting to be visited.
 ** 'grayagain': objects that must be revisited at the atomic phase.
@@ -65,6 +74,12 @@
 ** 'weak': tables with weak values to be cleared;
 ** 'ephemeron': ephemeron tables with white->white entries;
 ** 'allweak': tables with weak keys and/or weak values to be cleared.
+**
+** The exception to that "gray rule" is the TOUCHED2 objects in
+** generational mode. Those objects stay in a gray list (because they
+** must be visited again at the end of the cycle), but they are marked
+** black (because assignments to them must activate barriers, to move
+** them back to TOUCHED1).
 */
 
 
@@ -266,6 +281,7 @@ typedef struct global_State {
   GCObject *survival;  /* start of objects that survived one GC cycle */
   GCObject *old1;  /* start of old1 objects */
   GCObject *reallyold;  /* objects more than one cycle old ("really old") */
+  GCObject *firstold1;  /* first OLD1 object in the list (if any) */
   GCObject *finobjsur;  /* list of survival objects with finalizers */
   GCObject *finobjold1;  /* list of old1 objects with finalizers */
   GCObject *finobjrold;  /* list of really old objects with finalizers */
diff --git a/testes/gengc.lua b/testes/gengc.lua
index 7a7dabdd..93b5afd7 100644
--- a/testes/gengc.lua
+++ b/testes/gengc.lua
@@ -37,6 +37,22 @@ do
 end
 
 
+do
+  -- ensure that 'firstold1' is corrected when object is removed from
+  -- the 'allgc' list
+  local function foo () end
+  local old = {10}
+  collectgarbage()    -- make 'old' old
+  assert(not T or T.gcage(old) == "old")
+  setmetatable(old, {})    -- new table becomes OLD0 (barrier)
+  assert(not T or T.gcage(getmetatable(old)) == "old0")
+  collectgarbage("step", 0)   -- new table becomes OLD1 and firstold1
+  assert(not T or T.gcage(getmetatable(old)) == "old1")
+  setmetatable(getmetatable(old), {__gc = foo})  -- get it out of allgc list
+  collectgarbage("step", 0)   -- should not seg. fault
+end
+
+
 do   -- bug in 5.4.0
 -- When an object aged OLD1 is finalized, it is moved from the list
 -- 'finobj' to the *beginning* of the list 'allgc', but that part of the