new functions to identify and join upvalues

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 2.93 2009/10/05 16:44:33 roberto Exp roberto $
+** $Id: lapi.c,v 2.94 2009/10/23 19:12:19 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -1088,6 +1088,50 @@ LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
 }
 
 
+static UpVal **getupvalref (lua_State *L, int fidx, int n, Closure **pf) {
+  Closure *f;
+  Proto *p;
+  StkId fi = index2addr(L, fidx);
+  if (!ttisfunction(fi)) return NULL;  /* not a function? */
+  f = clvalue(fi);
+  if (f->c.isC) return NULL;  /* not a Lua function? */
+  p = f->l.p;
+  if (!(1 <= n && n <= p->sizeupvalues)) return NULL;
+  else {
+    if (pf) *pf = f;
+    return &f->l.upvals[n - 1];  /* get its upvalue pointer */
+  }
+}
+
+
+LUA_API void *(lua_upvaladdr) (lua_State *L, int fidx, int n) {
+  Closure *f;
+  StkId fi = index2addr(L, fidx);
+  if (!ttisfunction(fi)) return NULL;
+  f = clvalue(fi);
+  if (f->c.isC) {
+    if (!(1 <= n && n <= f->c.nupvalues)) return NULL;
+    else return &f->c.upvalue[n - 1];
+  }
+  else {
+    UpVal **uv = getupvalref(L, fidx, n, NULL);
+    return (uv == NULL) ? NULL : *uv;
+  }
+}
+
+
+LUA_API int (lua_upvaljoin) (lua_State *L, int fidx1, int n1,
+                                           int fidx2, int n2) {
+  Closure *f1;
+  UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
+  UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
+  if (up1 == NULL || up2 == NULL) return 0;
+  *up1 = *up2;
+  luaC_objbarrier(L, f1, *up2);
+  return 1;
+}
+
+
 LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud) {
   lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_CPCALL);
   lua_pushlightuserdata(L, &func);

ldblib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldblib.c,v 1.111 2009/08/04 18:27:57 roberto Exp roberto $
+** $Id: ldblib.c,v 1.112 2009/09/09 20:32:19 roberto Exp roberto $
 ** Interface from Lua to its debug API
 ** See Copyright Notice in lua.h
 */
@@ -199,6 +199,37 @@ static int db_setupvalue (lua_State *L) {
 }
 
 
+static int db_upvaladdr (lua_State *L) {
+  void *addr;
+  int n = luaL_checkint(L, 2);
+  luaL_checktype(L, 1, LUA_TFUNCTION);
+  addr = lua_upvaladdr(L, 1, n);
+  if (addr == NULL) lua_pushnil(L);
+  else lua_pushlightuserdata(L, addr);
+  return 1;
+}
+
+
+static int checkupval (lua_State *L, int argf, int argnup) {
+  lua_Debug ar;
+  int nup = luaL_checkint(L, argnup);
+  luaL_checktype(L, argf, LUA_TFUNCTION);
+  luaL_argcheck(L, !lua_iscfunction(L, argf), argf,
+                   "cannot join upvalues of a C function");
+  lua_pushvalue(L, argf);
+  lua_getinfo(L, ">u", &ar);
+  luaL_argcheck(L, 1 <= nup && nup <= ar.nups, argnup, "invalid upvalue index");
+  return nup;
+}
+
+
+static int db_joinupval (lua_State *L) {
+  int n1 = checkupval(L, 1, 2);
+  int n2 = checkupval(L, 3, 4);
+  lua_upvaljoin(L, 1, n1, 3, n2);
+  return 0;
+}
+
 
 static const char KEY_HOOK = 'h';
 
@@ -338,6 +369,8 @@ static const luaL_Reg dblib[] = {
   {"getregistry", db_getregistry},
   {"getmetatable", db_getmetatable},
   {"getupvalue", db_getupvalue},
+  {"joinupval", db_joinupval},
+  {"upvaladdr", db_upvaladdr},
   {"setfenv", db_setfenv},
   {"sethook", db_sethook},
   {"setlocal", db_setlocal},

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.245 2009/10/05 16:44:33 roberto Exp roberto $
+** $Id: lua.h,v 1.246 2009/10/11 20:02:19 roberto Exp roberto $
 ** Lua - A Scripting Language
 ** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
 ** See Copyright Notice at the end of this file
@@ -380,6 +380,10 @@ LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);
 LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);
 LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);
 
+LUA_API void *(lua_upvaladdr) (lua_State *L, int fidx, int n);
+LUA_API int (lua_upvaljoin) (lua_State *L, int fidx1, int n1,
+                                           int fidx2, int n2);
+
 LUA_API int (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);
 LUA_API lua_Hook (lua_gethook) (lua_State *L);
 LUA_API int (lua_gethookmask) (lua_State *L);