GC parameters encoded as floating-point bytes

This encoding brings more precision and a larger range for these
parameters.

8 files changed, 113 insertions, 57 deletions

diff --git a/lapi.c b/lapi.c
index fd9ec4e4..3ea3d0aa 100644
--- a/lapi.c
+++ b/lapi.c
@@ -1190,12 +1190,9 @@ LUA_API int lua_gc (lua_State *L, int what, ...) {
       int minormajor = va_arg(argp, int);
       int majorminor = va_arg(argp, int);
       res = (g->gckind == KGC_INC) ? LUA_GCINC : LUA_GCGEN;
-      if (minormul >= 0)
-        setgcparam(g, genminormul, minormul);
-      if (minormajor >= 0)
-        setgcparam(g, minormajor, minormajor);
-      if (majorminor >= 0)
-        setgcparam(g, majorminor, majorminor);
+      setgcparam(g, gcpgenminormul, minormul);
+      setgcparam(g, gcpminormajor, minormajor);
+      setgcparam(g, gcpmajorminor, majorminor);
       luaC_changemode(L, KGC_GENMINOR);
       break;
     }
@@ -1204,13 +1201,9 @@ LUA_API int lua_gc (lua_State *L, int what, ...) {
       int stepmul = va_arg(argp, int);
       int stepsize = va_arg(argp, int);
       res = (g->gckind == KGC_INC) ? LUA_GCINC : LUA_GCGEN;
-      if (pause >= 0)
-        setgcparam(g, gcpause, pause);
-      if (stepmul >= 0)
-        setgcparam(g, gcstepmul, stepmul);
-      if (stepsize >= 0)
-        g->gcstepsize = (stepsize <= log2maxs(l_obj)) ? stepsize
-                                                      : log2maxs(l_obj);
+      setgcparam(g, gcppause, pause);
+      setgcparam(g, gcpstepmul, stepmul);
+      setgcparam(g, gcpstepsize, stepsize);
       luaC_changemode(L, KGC_INC);
       break;
     }
diff --git a/lgc.c b/lgc.c
index 114b32d3..149dddf6 100644
--- a/lgc.c
+++ b/lgc.c
@@ -1049,7 +1049,7 @@ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
 ** approximately (marked * pause / 100).
 */
 static void setpause (global_State *g) {
-  l_obj threshold = applygcparam(g, gcpause, g->marked);
+  l_obj threshold = luaO_applyparam(g->gcppause, g->marked);
   l_obj debt = threshold - gettotalobjs(g);
   if (debt < 0) debt = 0;
   luaE_setdebt(g, debt);
@@ -1233,13 +1233,13 @@ static void finishgencycle (lua_State *L, global_State *g) {
 ** in generational mode.
 */
 static void minor2inc (lua_State *L, global_State *g, int kind) {
-  l_obj stepsize = cast(l_obj, 1) << g->gcstepsize;
   g->GCmajorminor = g->marked;  /* number of live objects */
   g->gckind = kind;
   g->reallyold = g->old1 = g->survival = NULL;
   g->finobjrold = g->finobjold1 = g->finobjsur = NULL;
   entersweep(L);  /* continue as an incremental cycle */
-  luaE_setdebt(g, stepsize);
+  /* set a debt equal to the step size */
+  luaE_setdebt(g, luaO_applyparam(g->gcpstepsize, 100));
 }
 
 
@@ -1255,8 +1255,8 @@ static void minor2inc (lua_State *L, global_State *g, int kind) {
 ** major collection. (That percentage is computed in 'limit'.)
 */
 static int checkminormajor (lua_State *L, global_State *g, l_obj addedold1) {
-  l_obj step = applygcparam(g, genminormul, g->GCmajorminor);
-  l_obj limit = applygcparam(g, minormajor, g->GCmajorminor);
+  l_obj step = luaO_applyparam(g->gcpgenminormul, g->GCmajorminor);
+  l_obj limit = luaO_applyparam(g->gcpminormajor, g->GCmajorminor);
 //printf("-> major? %ld %ld %ld %ld (%ld)\n", g->marked, limit, step, addedold1, gettotalobjs(g));
   if (addedold1 >= (step >> 1) || g->marked >= limit) {
     minor2inc(L, g, KGC_GENMAJOR);  /* go to major mode */
@@ -1347,7 +1347,7 @@ static void atomic2gen (lua_State *L, global_State *g) {
 ** total number of objects grows 'genminormul'%.
 */
 static void setminordebt (global_State *g) {
-  luaE_setdebt(g, applygcparam(g, genminormul, g->GCmajorminor));
+  luaE_setdebt(g, luaO_applyparam(g->gcpgenminormul, g->GCmajorminor));
 }
 
 
@@ -1404,7 +1404,7 @@ static int checkmajorminor (lua_State *L, global_State *g) {
   if (g->gckind == KGC_GENMAJOR) {
     l_obj numobjs = gettotalobjs(g);
     l_obj addedobjs = numobjs - g->GCmajorminor;
-    l_obj limit = applygcparam(g, majorminor, addedobjs);
+    l_obj limit = luaO_applyparam(g->gcpmajorminor, addedobjs);
     l_obj tobecollected = numobjs - g->marked;
 //printf("-> minor? %ld %ld %ld\n", tobecollected, limit, numobjs);
     if (tobecollected > limit) {
@@ -1634,8 +1634,8 @@ void luaC_runtilstate (lua_State *L, int state, int fast) {
 ** controls when next step will be performed.
 */
 static void incstep (lua_State *L, global_State *g) {
-  l_obj stepsize = cast(l_obj, 1) << g->gcstepsize;
-  l_obj work2do = applygcparam(g, gcstepmul, stepsize);
+  l_obj stepsize = luaO_applyparam(g->gcpstepsize, 100);
+  l_obj work2do = luaO_applyparam(g->gcpstepmul, stepsize);
   int fast = 0;
   if (work2do == 0) {  /* special case: do a full collection */
     work2do = MAX_LOBJ;  /* do unlimited work */
diff --git a/lgc.h b/lgc.h
index e8dee8a0..6a03f787 100644
--- a/lgc.h
+++ b/lgc.h
@@ -189,10 +189,12 @@
    for each new allocated object.) */
 #define LUAI_GCMUL      200
 
-/* How many objects to allocate before next GC step (log2) */
-#define LUAI_GCSTEPSIZE 8      /* 256 objects */
+/* How many objects to allocate before next GC step */
+#define LUAI_GCSTEPSIZE 250
 
 
+#define setgcparam(g,p,v)       if ((v) >= 0) {g->p = luaO_codeparam(v);}
+
 /*
 ** Control when GC is running:
 */
@@ -201,20 +203,6 @@
 #define GCSTPCLS        4  /* bit true when closing Lua state */
 #define gcrunning(g)    ((g)->gcstp == 0)
 
-/*
-** Macros to set and apply GC parameters. GC parameters are given in
-** percentage points, but are stored as lu_byte. To avoid repeated
-** divisions by 100, these macros store the original parameter
-** multiplied by 128 and divided by 100.  To apply them, if it first
-** divides the value by 128 it may lose precision; if it first
-** multiplies by the parameter, it may overflow.  So, it first divides
-** by 32, then multiply by the parameter, and then divides the result by
-** 4.
-*/
-
-#define setgcparam(g,p,v)       (g->gcp##p = (cast_uint(v) << 7) / 100u)
-#define applygcparam(g,p,v)     ((((v) >> 5) * g->gcp##p) >> 2)
-
 
 /*
 ** Does one step of collection when debt becomes zero. 'pre'/'pos'
diff --git a/lobject.c b/lobject.c
index 9cfa5227..4091b9d7 100644
--- a/lobject.c
+++ b/lobject.c
@@ -33,7 +33,7 @@
 ** Computes ceil(log2(x))
 */
 int luaO_ceillog2 (unsigned int x) {
-  static const lu_byte log_2[256] = {  /* log_2[i] = ceil(log2(i - 1)) */
+  static const lu_byte log_2[256] = {  /* log_2[i - 1] = ceil(log2(i)) */
     0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
     6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
     7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
@@ -49,6 +49,57 @@ int luaO_ceillog2 (unsigned int x) {
   return l + log_2[x];
 }
 
+/*
+** Encodes 'p'% as a floating-point byte, represented as (eeeeexxx).
+** The exponent is represented using excess-7. Mimicking IEEE 754, the
+** representation normalizes the number when possible, assuming an extra
+** 1 before the mantissa (xxx) and adding one to the exponent (eeeeexxx)
+** to signal that. So, the real value is (1xxx) * 2^(eeeee - 8) if
+** eeeee != 0, and (xxx) * 2^-7 otherwise.
+*/
+unsigned int luaO_codeparam (unsigned int p) {
+  if (p >= (cast(lu_mem, 0xF) << 0xF) / 128 * 100)  /* overflow? */
+    return 0xFF;  /* return maximum value */
+  else {
+    p = (p * 128u) / 100;
+    if (p <= 0xF)
+      return p;
+    else {
+      int log = luaO_ceillog2(p + 1) - 5;
+      return ((p >> log) - 0x10) | ((log + 1) << 4);
+    }
+  }
+}
+
+
+/*
+** Computes 'p' times 'x', where 'p' is a floating-point byte.
+*/
+l_obj luaO_applyparam (unsigned int p, l_obj x) {
+  unsigned int m = p & 0xF;  /* mantissa */
+  int e = (p >> 4);  /* exponent */
+  if (e > 0) {  /* normalized? */
+    e--;
+    m += 0x10;  /* maximum 'm' is 0x1F */
+  }
+  e -= 7;  /* correct excess-7 */
+  if (e < 0) {
+    e = -e;
+    if (x < MAX_LOBJ / 0x1F)  /* multiplication cannot overflow? */
+      return (x * m) >> e;  /* multiplying first gives more precision */
+    else if ((x >> e) <  MAX_LOBJ / 0x1F)  /* cannot overflow after shift? */
+      return (x >> e) * m;
+    else  /* real overflow */
+      return MAX_LOBJ;
+  }
+  else {
+    if (x < (MAX_LOBJ / 0x1F) >> e)  /* no overflow? */
+      return (x * m) << e;  /* order doesn't matter here */
+    else  /* real overflow */
+      return MAX_LOBJ;
+  }
+}
+
 
 static lua_Integer intarith (lua_State *L, int op, lua_Integer v1,
                                                    lua_Integer v2) {
diff --git a/lobject.h b/lobject.h
index 6da50215..a7d85762 100644
--- a/lobject.h
+++ b/lobject.h
@@ -826,6 +826,9 @@ typedef struct Table {
 
 LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);
 LUAI_FUNC int luaO_ceillog2 (unsigned int x);
+LUAI_FUNC unsigned int luaO_codeparam (unsigned int p);
+LUAI_FUNC l_obj luaO_applyparam (unsigned int p, l_obj x);
+
 LUAI_FUNC int luaO_rawarith (lua_State *L, int op, const TValue *p1,
                              const TValue *p2, TValue *res);
 LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,
diff --git a/lstate.c b/lstate.c
index aab90e34..19505845 100644
--- a/lstate.c
+++ b/lstate.c
@@ -365,12 +365,12 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud, unsigned int seed) {
   g->marked = 0;
   g->GCdebt = 0;
   setivalue(&g->nilvalue, 0);  /* to signal that state is not yet built */
-  setgcparam(g, gcpause, LUAI_GCPAUSE);
-  setgcparam(g, gcstepmul, LUAI_GCMUL);
-  g->gcstepsize = LUAI_GCSTEPSIZE;
-  setgcparam(g, genminormul, LUAI_GENMINORMUL);
-  setgcparam(g, minormajor, LUAI_MINORMAJOR);
-  setgcparam(g, majorminor, LUAI_MAJORMINOR);
+  setgcparam(g, gcppause, LUAI_GCPAUSE);
+  setgcparam(g, gcpstepmul, LUAI_GCMUL);
+  setgcparam(g, gcpstepsize, LUAI_GCSTEPSIZE);
+  setgcparam(g, gcpgenminormul, LUAI_GENMINORMUL);
+  setgcparam(g, gcpminormajor, LUAI_MINORMAJOR);
+  setgcparam(g, gcpmajorminor, LUAI_MAJORMINOR);
   for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;
   if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
     /* memory allocation error: free partial state */
diff --git a/lstate.h b/lstate.h
index 49acfb7e..5e2020e7 100644
--- a/lstate.h
+++ b/lstate.h
@@ -264,18 +264,18 @@ typedef struct global_State {
   TValue l_registry;
   TValue nilvalue;  /* a nil value */
   unsigned int seed;  /* randomized seed for hashes */
-  unsigned short gcpgenminormul;  /* control minor generational collections */
-  unsigned short gcpmajorminor;  /* control shift major->minor */
-  unsigned short gcpminormajor;  /* control shift minor->major */
-  unsigned short gcpgcpause;  /* size of pause between successive GCs */
-  unsigned short gcpgcstepmul;  /* GC "speed" */
+  lu_byte gcpgenminormul;  /* control minor generational collections */
+  lu_byte gcpmajorminor;  /* control shift major->minor */
+  lu_byte gcpminormajor;  /* control shift minor->major */
+  lu_byte gcppause;  /* size of pause between successive GCs */
+  lu_byte gcpstepmul;  /* GC "speed" */
+  lu_byte gcpstepsize;  /* GC granularity */
   lu_byte currentwhite;
   lu_byte gcstate;  /* state of garbage collector */
   lu_byte gckind;  /* kind of GC running */
   lu_byte gcstopem;  /* stops emergency collections */
   lu_byte gcstp;  /* control whether GC is running */
   lu_byte gcemergency;  /* true if this is an emergency collection */
-  lu_byte gcstepsize;  /* (log2 of) GC granularity */
   GCObject *allgc;  /* list of all collectable objects */
   GCObject **sweepgc;  /* current position of sweep in list */
   GCObject *finobj;  /* list of collectable objects with finalizers */
diff --git a/ltests.c b/ltests.c
index 51e4ff9b..93af528e 100644
--- a/ltests.c
+++ b/ltests.c
@@ -1033,16 +1033,35 @@ static int table_query (lua_State *L) {
 }
 
 
-static int query_inc (lua_State *L) {
+static int query_GCparams (lua_State *L) {
   global_State *g = G(L);
   lua_pushinteger(L, gettotalobjs(g));
   lua_pushinteger(L, g->GCdebt);
-  lua_pushinteger(L, applygcparam(g, gcpause, 100));
-  lua_pushinteger(L, applygcparam(g, gcstepmul, 100));
-  lua_pushinteger(L, cast(l_obj, 1) << g->gcstepsize);
-  return 5;
+  lua_pushinteger(L, luaO_applyparam(g->gcpgenminormul, 100));
+  lua_pushinteger(L, luaO_applyparam(g->gcpmajorminor, 100));
+  lua_pushinteger(L, luaO_applyparam(g->gcpminormajor, 100));
+  lua_pushinteger(L, luaO_applyparam(g->gcppause, 100));
+  lua_pushinteger(L, luaO_applyparam(g->gcpstepmul, 100));
+  lua_pushinteger(L, luaO_applyparam(g->gcpstepsize, 100));
+  return 8;
+}
+
+
+static int test_codeparam (lua_State *L) {
+  lua_Integer p = luaL_checkinteger(L, 1);
+  lua_pushinteger(L, luaO_codeparam(p));
+  return 1;
 }
 
+
+static int test_applyparam (lua_State *L) {
+  lua_Integer p = luaL_checkinteger(L, 1);
+  lua_Integer x = luaL_checkinteger(L, 2);
+  lua_pushinteger(L, luaO_applyparam(p, x));
+  return 1;
+}
+
+
 static int string_query (lua_State *L) {
   stringtable *tb = &G(L)->strt;
   int s = cast_int(luaL_optinteger(L, 1, 0)) - 1;
@@ -1974,7 +1993,9 @@ static const struct luaL_Reg tests_funcs[] = {
   {"pushuserdata", pushuserdata},
   {"querystr", string_query},
   {"querytab", table_query},
-  {"queryinc", query_inc},
+  {"queryGCparams", query_GCparams},
+  {"codeparam", test_codeparam},
+  {"applyparam", test_applyparam},
   {"ref", tref},
   {"resume", coresume},
   {"s2d", s2d},