point2uint for blua interning string cache

will optimize away or inline the extra loops)

src/blua/lapi.c

@@ -519,6 +519,22 @@ LUA_API int lua_pushthread (lua_State *L) {
 ** get functions (Lua -> stack)
 */
 
+static void auxgetstr (lua_State *L, TValue *t, const char *k) {
+  TValue *slot;
+  TValue key;
+  TString *str = luaS_new(L, k);
+  api_checkvalidindex(L, t);
+  if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
+    setobj2s(L, L->top, slot);
+  }
+  else {
+    setsvalue(L, &key, str);
+    luaV_finishget(L, t, &key, L->top, slot);
+  }
+  api_incr_top(L);
+  lua_unlock(L);
+}
+
 
 LUA_API void lua_gettable (lua_State *L, int idx) {
   StkId t;
@@ -531,15 +547,8 @@ LUA_API void lua_gettable (lua_State *L, int idx) {
 
 
 LUA_API void lua_getfield (lua_State *L, int idx, const char *k) {
-  StkId t;
-  TValue key;
   lua_lock(L);
-  t = index2adr(L, idx);
-  api_checkvalidindex(L, t);
-  setsvalue(L, &key, luaS_new(L, k));
-  luaV_gettable(L, t, &key, L->top);
-  api_incr_top(L);
-  lua_unlock(L);
+  auxgetstr(L, index2adr(L, idx), k);
 }
 
 

src/blua/ldo.c

@@ -55,8 +55,8 @@ struct lua_longjmp {
 
 void luaD_seterrorobj (lua_State *L, int lerrcode, StkId oldtop) {
   switch (lerrcode) {
-    case LUA_ERRMEM: {
-      setsvalue2s(L, oldtop, luaS_newliteral(L, MEMERRMSG));
+    case LUA_ERRMEM: {  /* memory error? */
+      setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
       break;
     }
     case LUA_ERRERR: {

src/blua/lgc.c

@@ -544,6 +544,7 @@ static void atomic (lua_State *L) {
   marktmu(g);  /* mark `preserved' userdata */
   udsize += propagateall(g);  /* remark, to propagate `preserveness' */
   cleartable(g->weak);  /* remove collected objects from weak tables */
+  luaS_clearcache(g);
   /* flip current white */
   g->currentwhite = cast_byte(otherwhite(g));
   g->sweepstrgc = 0;

src/blua/llimits.h

@@ -41,6 +41,25 @@ typedef unsigned char lu_byte;
 */
 #define IntPoint(p)  ((unsigned int)(lu_mem)(p))
 
+/*
+** conversion of pointer to unsigned integer: this is for hashing only;
+** there is no problem if the integer cannot hold the whole pointer
+** value. (In strict ISO C this may cause undefined behavior, but no
+** actual machine seems to bother.)
+*/
+#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
+    __STDC_VERSION__ >= 199901L
+#include <stdint.h>
+#if defined(UINTPTR_MAX)  /* even in C99 this type is optional */
+#define L_P2I	uintptr_t
+#else  /* no 'intptr'? */
+#define L_P2I	uintmax_t  /* use the largest available integer */
+#endif
+#else  /* C89 option */
+#define L_P2I	size_t
+#endif
+
+#define point2uint(p)	((unsigned int)((L_P2I)(p) & UINT_MAX))
 
 
 /* type to ensure maximum alignment */
@@ -100,6 +119,17 @@ typedef lu_int32 Instruction;
 #endif
 
 
+/*
+** Size of cache for strings in the API. 'N' is the number of
+** sets (better be a prime) and "M" is the size of each set (M == 1
+** makes a direct cache.)
+*/
+#ifndef STRCACHE_N
+#define STRCACHE_N	53
+#define STRCACHE_M	2
+#endif
+
+
 /* minimum size for string buffer */
 #ifndef LUA_MINBUFFER
 #define LUA_MINBUFFER	32

src/blua/lmem.h

@@ -13,8 +13,6 @@
 #include "llimits.h"
 #include "lua.h"
 
-#define MEMERRMSG	"not enough memory"
-
 
 #define luaM_reallocv(L,b,on,n,e) \
 	((cast(size_t, (n)+1) <= MAX_SIZET/(e)) ?  /* +1 to avoid warnings */ \

src/blua/lstate.c

@@ -73,10 +73,9 @@ static void f_luaopen (lua_State *L, void *ud) {
   stack_init(L, L);  /* init stack */
   sethvalue(L, gt(L), luaH_new(L, 0, 2));  /* table of globals */
   sethvalue(L, registry(L), luaH_new(L, 0, 2));  /* registry */
-  luaS_resize(L, MINSTRTABSIZE);  /* initial size of string table */
+  luaS_init(L);
   luaT_init(L);
   luaX_init(L);
-  luaS_fix(luaS_newliteral(L, MEMERRMSG));
   g->GCthreshold = 4*g->totalbytes;
 }
 

src/blua/lstate.h

@@ -88,9 +88,11 @@ typedef struct global_State {
   lua_CFunction panic;  /* to be called in unprotected errors */
   TValue l_registry;
   struct lua_State *mainthread;
+  TString *memerrmsg;  /* memory-error message */
   UpVal uvhead;  /* head of double-linked list of all open upvalues */
   struct Table *mt[NUM_TAGS];  /* metatables for basic types */
   TString *tmname[TM_N];  /* array with tag-method names */
+  TString *strcache[STRCACHE_N][STRCACHE_M];  /* cache for strings in API */
 } global_State;
 
 

src/blua/lstring.c

@@ -18,6 +18,9 @@
 #include "lstring.h"
 
 
+#define MEMERRMSG       "not enough memory"
+
+
 
 void luaS_resize (lua_State *L, int newsize) {
   GCObject **newhash;
@@ -72,6 +75,36 @@ static TString *newlstr (lua_State *L, const char *str, size_t l,
 }
 
 
+/*
+** Clear API string cache. (Entries cannot be empty, so fill them with
+** a non-collectable string.)
+*/
+void luaS_clearcache (global_State *g) {
+  int i, j;
+  for (i = 0; i < STRCACHE_N; i++)
+    for (j = 0; j < STRCACHE_M; j++) {
+      if (luaS_iswhite(g->strcache[i][j]))  /* will entry be collected? */
+        g->strcache[i][j] = g->memerrmsg;  /* replace it with something fixed */
+    }
+}
+
+
+/*
+** Initialize the string table and the string cache
+*/
+void luaS_init (lua_State *L) {
+  global_State *g = G(L);
+  int i, j;
+  luaS_resize(L, MINSTRTABSIZE);  /* initial size of string table */
+  /* pre-create memory-error message */
+  g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
+  luaS_fix(g->memerrmsg);  /* it should never be collected */
+  for (i = 0; i < STRCACHE_N; i++)  /* fill cache with valid strings */
+    for (j = 0; j < STRCACHE_M; j++)
+      g->strcache[i][j] = g->memerrmsg;
+}
+
+
 // string hash taken from luaJIT
 
 /* Unaligned load of uint32_t. */
@@ -128,6 +161,10 @@ static inline __attribute__((always_inline)) unsigned luaS_hash (const char *str
 #endif
 }
 
+
+/*
+** new string (with explicit length)
+*/
 TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
   GCObject *o;
   unsigned int h = luaS_hash(str, l);
@@ -147,6 +184,29 @@ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
 }
 
 
+/*
+** Create or reuse a zero-terminated string, first checking in the
+** cache (using the string address as a key). The cache can contain
+** only zero-terminated strings, so it is safe to use 'strcmp' to
+** check hits.
+*/
+TString *luaS_new (lua_State *L, const char *str) {
+  unsigned int i = point2uint(str) % STRCACHE_N;  /* hash */
+  int j;
+  TString **p = G(L)->strcache[i];
+  for (j = 0; j < STRCACHE_M; j++) {
+    if (strcmp(str, getstr(p[j])) == 0)  /* hit? */
+      return p[j];  /* that is it */
+  }
+  /* normal route */
+  for (j = STRCACHE_M - 1; j > 0; j--)
+    p[j] = p[j - 1];  /* move out last element */
+  /* new element is first in the list */
+  p[0] = luaS_newlstr(L, str, strlen(str));
+  return p[0];
+}
+
+
 Udata *luaS_newudata (lua_State *L, size_t s, Table *e) {
   Udata *u;
   if (l_unlikely(s > MAX_SIZET - sizeof(Udata)))

src/blua/lstring.h

@@ -17,15 +17,19 @@
 
 #define sizeudata(u)	(sizeof(union Udata)+(u)->len)
 
-#define luaS_new(L, s)	(luaS_newlstr(L, s, strlen(s)))
+//#define luaS_new(L, s)	(luaS_newlstr(L, s, strlen(s)))
 #define luaS_newliteral(L, s)	(luaS_newlstr(L, "" s, \
                                  (sizeof(s)/sizeof(char))-1))
 
-#define luaS_fix(s)	l_setbit((s)->tsv.marked, FIXEDBIT)
+#define luaS_iswhite(x)      test2bits((x)->tsv.marked, WHITE0BIT, WHITE1BIT)
+#define luaS_fix(s)	         l_setbit((s)->tsv.marked, FIXEDBIT)
 
 LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
+LUAI_FUNC void luaS_clearcache (global_State *g);
+LUAI_FUNC void luaS_init (lua_State *L);
 LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, Table *e);
 LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
+LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
 
 
 #endif

src/blua/lvm.c

@@ -105,27 +105,42 @@ static void callTM (lua_State *L, const TValue *f, const TValue *p1,
 }
 
 
-void luaV_gettable (lua_State *L, TValue *t, TValue *key, StkId val) {
-  int loop;
+/*
+** Finish the table access 'val = t[key]'.
+** if 'slot' is NULL, 't' is not a table; otherwise, 'slot' points to
+** t[k] entry (which must be nil).
+*/
+void luaV_finishget (lua_State *L, TValue *t, TValue *key, StkId val,
+                     TValue *slot) {
+  int loop;  /* counter to avoid infinite loops */
+  TValue *tm;  /* metamethod */
   for (loop = 0; loop < MAXTAGLOOP; loop++) {
-    TValue *tm;
-    if (ttistable(t)) {  /* `t' is a table? */
-      Table *h = hvalue(t);
-      const TValue *res = luaH_get(h, key); /* do a primitive get */
-      if (!ttisnil(res) ||  /* result is no nil? */
-          (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */
-        setobj2s(L, val, res);
+    if (slot == NULL) {  /* 't' is not a table? */
+      lua_assert(!ttistable(t));
+      tm = luaT_gettmbyobj(L, t, TM_INDEX);
+      if (l_unlikely(ttisnil(tm)))
+        luaG_typeerror(L, t, "index");  /* no metamethod */
+      /* else will try the metamethod */
+    }
+    else {  /* 't' is a table */
+      lua_assert(ttisnil(slot));
+      tm = fasttm(L, hvalue(t)->metatable, TM_INDEX);  /* table's metamethod */
+      if (tm == NULL) {  /* no metamethod? */
+        setnilvalue(val);  /* result is nil */
         return;
       }
-      /* else will try the tag method */
+      /* else will try the metamethod */
     }
-    else if (l_unlikely(ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX))))
-      luaG_typeerror(L, t, "index");
-    if (ttisfunction(tm)) {
-      callTMres(L, val, tm, t, key);
+    if (ttisfunction(tm)) {  /* is metamethod a function? */
+      callTMres(L, val, tm, t, key);  /* call it */
       return;
     }
-    t = tm;  /* else repeat with `tm' */
+    t = tm;  /* else try to access 'tm[key]' */
+    if (luaV_fastget(L, t, key, slot, luaH_get)) {  /* fast track? */
+      setobj2s(L, val, slot);  /* done */
+      return;
+    }
+    /* else repeat (tail call 'luaV_finishget') */
   }
   luaG_runerror(L, "loop in gettable");
 }
@@ -139,8 +154,12 @@ void luaV_settable (lua_State *L, TValue *t, TValue *key, StkId val) {
       Table *h = hvalue(t);
       TValue *oldval = luaH_set(L, h, key); /* do a primitive set */
       /* oldval is nil=> look for newindex, oldval is not nil => look for usedindex */
-      if (!((ttisnil(oldval) && ((tm = fasttm(L, h->metatable, TM_NEWINDEX)) != NULL)) ||
-         ((!ttisnil(oldval)) && ((tm = fasttm(L, h->metatable, TM_USEDINDEX)) != NULL)))) {
+      if (ttisnil(oldval)) {
+        tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */
+      } else {
+        tm = fasttm(L, h->metatable, TM_USEDINDEX);
+      }
+      if (tm == NULL) { /* no metamethod? */
         setobj2t(L, oldval, val);
         luaC_barriert(L, h, val);
         return;
@@ -378,6 +397,14 @@ static void Arith (lua_State *L, StkId ra, TValue *rb,
       }
 
 
+/*
+** copy of 'luaV_gettable', but protecting call to potential metamethod
+** (which can reallocate the stack)
+*/
+#define gettableProtected(L,t,k,v)  { TValue *slot; \
+  if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \
+  else Protect(luaV_finishget(L,t,k,v,slot)); }
+
 
 void luaV_execute (lua_State *L, int nexeccalls) {
   LClosure *cl;
@@ -387,9 +414,9 @@ void luaV_execute (lua_State *L, int nexeccalls) {
  reentry:  /* entry point */
   lua_assert(isLua(L->ci));
   pc = L->savedpc;
-  cl = &clvalue(L->ci->func)->l;
-  base = L->base;
-  k = cl->p->k;
+  cl = &clvalue(L->ci->func)->l;  /* local reference to function's closure */
+  k = cl->p->k;  /* local reference to function's constant table */
+  base = L->base;  /* local copy of function's base */
   /* main loop of interpreter */
   for (;;) {
     const Instruction i = *pc++;
@@ -449,7 +476,7 @@ void luaV_execute (lua_State *L, int nexeccalls) {
         StkId ra = RA(i);
         StkId rb = RB(i);
         TValue *rc = RKC(i);
-        Protect(luaV_gettable(L, rb, rc, ra));
+        gettableProtected(L, rb, rc, ra);
         continue;
       }
       case OP_SETGLOBAL: {
@@ -485,8 +512,9 @@ void luaV_execute (lua_State *L, int nexeccalls) {
       case OP_SELF: {
         StkId ra = RA(i);
         StkId rb = RB(i);
-        setobjs2s(L, ra+1, rb);
-        Protect(luaV_gettable(L, rb, RKC(i), ra));
+        TValue *rc = RKC(i);
+        setobjs2s(L, ra + 1, rb);
+        gettableProtected(L, rb, rc, ra);
         continue;
       }
       case OP_ADD: {

src/blua/lvm.h

@@ -22,12 +22,34 @@
 	(ttype(o1) == ttype(o2) && luaV_equalval(L, o1, o2))
 
 
+/*
+** fast track for 'gettable': if 't' is a table and 't[k]' is not nil,
+** return 1 with 'slot' pointing to 't[k]' (final result).  Otherwise,
+** return 0 (meaning it will have to check metamethod) with 'slot'
+** pointing to a nil 't[k]' (if 't' is a table) or NULL (otherwise).
+** 'f' is the raw get function to use.
+*/
+#define luaV_fastget(L,t,k,slot,f) \
+  (!ttistable(t)  \
+   ? (slot = NULL, 0)  /* not a table; 'slot' is NULL and result is 0 */  \
+   : (slot = f(hvalue(t), k),  /* else, do raw access */  \
+      !ttisnil(slot)))  /* result not nil? */
+
+/*
+** standard implementation for 'gettable'
+*/
+#define luaV_gettable(L,t,k,v) { TValue *slot; \
+  if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \
+  else luaV_finishget(L,t,k,v,slot); }
+
+
+
 LUAI_FUNC int luaV_lessthan (lua_State *L, TValue *l, TValue *r);
 LUAI_FUNC int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2);
 LUAI_FUNC const TValue *luaV_tonumber (const TValue *obj, TValue *n);
 LUAI_FUNC int luaV_tostring (lua_State *L, StkId obj);
-LUAI_FUNC void luaV_gettable (lua_State *L, TValue *t, TValue *key,
-                                            StkId val);
+LUAI_FUNC void luaV_finishget (lua_State *L, TValue *t, TValue *key,
+                               StkId val, TValue *tm);
 LUAI_FUNC void luaV_settable (lua_State *L, TValue *t, TValue *key,
                                             StkId val);
 LUAI_FUNC void luaV_execute (lua_State *L, int nexeccalls);