Browse Source

first implementation of light C functions

Roberto Ierusalimschy 15 years ago
parent
commit
7dfa4cd655
11 changed files with 141 additions and 88 deletions
  1. 41 27
      lapi.c
  2. 17 15
      ldebug.c
  3. 31 23
      ldo.c
  4. 3 1
      lobject.c
  5. 30 9
      lobject.h
  6. 1 2
      lstate.h
  7. 3 1
      ltable.c
  8. 6 3
      ltests.c
  9. 2 2
      ltm.c
  10. 3 2
      ltm.h
  11. 4 3
      lvm.c

+ 41 - 27
lapi.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: lapi.c,v 2.119 2010/04/02 15:19:19 roberto Exp roberto $
+** $Id: lapi.c,v 2.120 2010/04/05 14:21:38 roberto Exp roberto $
 ** Lua API
 ** Lua API
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -54,12 +54,16 @@ static TValue *index2addr (lua_State *L, int idx) {
   else if (idx == LUA_REGISTRYINDEX)
   else if (idx == LUA_REGISTRYINDEX)
     return &G(L)->l_registry;
     return &G(L)->l_registry;
   else {  /* upvalues */
   else {  /* upvalues */
-    Closure *func = curr_func(L);
     idx = LUA_REGISTRYINDEX - idx;
     idx = LUA_REGISTRYINDEX - idx;
     api_check(L, idx <= UCHAR_MAX + 1, "upvalue index too large");
     api_check(L, idx <= UCHAR_MAX + 1, "upvalue index too large");
-    return (idx <= func->c.nupvalues)
-              ? &func->c.upvalue[idx-1]
-              : cast(TValue *, luaO_nilobject);
+    if (ttiscfp(ci->func))  /* C-function pointer? */
+      return cast(TValue *, luaO_nilobject);  /* it has no upvalues */
+    else {
+      Closure *func = clvalue(ci->func);
+      return (idx <= func->c.nupvalues)
+                ? &func->c.upvalue[idx-1]
+                : cast(TValue *, luaO_nilobject);
+    }
   }
   }
 }
 }
 
 
@@ -181,8 +185,10 @@ static void moveto (lua_State *L, TValue *fr, int idx) {
   TValue *to = index2addr(L, idx);
   TValue *to = index2addr(L, idx);
   api_checkvalidindex(L, to);
   api_checkvalidindex(L, to);
   setobj(L, to, fr);
   setobj(L, to, fr);
-  if (idx < LUA_REGISTRYINDEX)  /* function upvalue? */
-    luaC_barrier(L, curr_func(L), fr);
+  if (idx < LUA_REGISTRYINDEX) {  /* function upvalue? */
+    lua_assert(ttisclosure(L->ci->func));
+    luaC_barrier(L, clvalue(L->ci->func), fr);
+  }
   /* LUA_REGISTRYINDEX does not need gc barrier
   /* LUA_REGISTRYINDEX does not need gc barrier
      (collector revisits it before finishing collection) */
      (collector revisits it before finishing collection) */
 }
 }
@@ -223,19 +229,19 @@ LUA_API void lua_pushvalue (lua_State *L, int idx) {
 
 
 LUA_API int lua_type (lua_State *L, int idx) {
 LUA_API int lua_type (lua_State *L, int idx) {
   StkId o = index2addr(L, idx);
   StkId o = index2addr(L, idx);
-  return (o == luaO_nilobject) ? LUA_TNONE : ttype(o);
+  return (o == luaO_nilobject) ? LUA_TNONE : ttypenv(o);
 }
 }
 
 
 
 
 LUA_API const char *lua_typename (lua_State *L, int t) {
 LUA_API const char *lua_typename (lua_State *L, int t) {
   UNUSED(L);
   UNUSED(L);
-  return typename(t);
+  return ttypename(t);
 }
 }
 
 
 
 
 LUA_API int lua_iscfunction (lua_State *L, int idx) {
 LUA_API int lua_iscfunction (lua_State *L, int idx) {
   StkId o = index2addr(L, idx);
   StkId o = index2addr(L, idx);
-  return iscfunction(o);
+  return (ttiscfp(o) || (ttisclosure(o) && clvalue(o)->c.isC));
 }
 }
 
 
 
 
@@ -361,7 +367,10 @@ LUA_API size_t lua_rawlen (lua_State *L, int idx) {
 
 
 LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
 LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
   StkId o = index2addr(L, idx);
   StkId o = index2addr(L, idx);
-  return (!iscfunction(o)) ? NULL : clvalue(o)->c.f;
+  if (ttiscfp(o)) return fvalue(o);
+  else if (ttisclosure(o) && clvalue(o)->c.isC)
+    return clvalue(o)->c.f;
+  else return NULL;  /* not a C function */
 }
 }
 
 
 
 
@@ -386,6 +395,7 @@ LUA_API const void *lua_topointer (lua_State *L, int idx) {
   switch (ttype(o)) {
   switch (ttype(o)) {
     case LUA_TTABLE: return hvalue(o);
     case LUA_TTABLE: return hvalue(o);
     case LUA_TFUNCTION: return clvalue(o);
     case LUA_TFUNCTION: return clvalue(o);
+    case LUA_TCFP: return cast(void *, cast(size_t, fvalue(o)));
     case LUA_TTHREAD: return thvalue(o);
     case LUA_TTHREAD: return thvalue(o);
     case LUA_TUSERDATA:
     case LUA_TUSERDATA:
     case LUA_TLIGHTUSERDATA:
     case LUA_TLIGHTUSERDATA:
@@ -480,18 +490,22 @@ LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {
 
 
 
 
 LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
 LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
-  Closure *cl;
   lua_lock(L);
   lua_lock(L);
-  api_checknelems(L, n);
-  api_check(L, n <= UCHAR_MAX, "upvalue index too large");
-  luaC_checkGC(L);
-  cl = luaF_newCclosure(L, n);
-  cl->c.f = fn;
-  L->top -= n;
-  while (n--)
-    setobj2n(L, &cl->c.upvalue[n], L->top+n);
-  setclvalue(L, L->top, cl);
-  lua_assert(iswhite(obj2gco(cl)));
+  if (n == 0) {
+    setfvalue(L->top, fn);
+  }
+  else {
+    Closure *cl;
+    api_checknelems(L, n);
+    api_check(L, n <= UCHAR_MAX, "upvalue index too large");
+    luaC_checkGC(L);
+    cl = luaF_newCclosure(L, n);
+    cl->c.f = fn;
+    L->top -= n;
+    while (n--)
+      setobj2n(L, &cl->c.upvalue[n], L->top + n);
+    setclvalue(L, L->top, cl);
+  }
   api_incr_top(L);
   api_incr_top(L);
   lua_unlock(L);
   lua_unlock(L);
 }
 }
@@ -598,7 +612,7 @@ LUA_API int lua_getmetatable (lua_State *L, int objindex) {
       mt = uvalue(obj)->metatable;
       mt = uvalue(obj)->metatable;
       break;
       break;
     default:
     default:
-      mt = G(L)->mt[ttype(obj)];
+      mt = G(L)->mt[ttypenv(obj)];
       break;
       break;
   }
   }
   if (mt == NULL)
   if (mt == NULL)
@@ -713,7 +727,7 @@ LUA_API int lua_setmetatable (lua_State *L, int objindex) {
       break;
       break;
     }
     }
     default: {
     default: {
-      G(L)->mt[ttype(obj)] = mt;
+      G(L)->mt[ttypenv(obj)] = mt;
       break;
       break;
     }
     }
   }
   }
@@ -1063,7 +1077,7 @@ LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
 
 
 static const char *aux_upvalue (StkId fi, int n, TValue **val) {
 static const char *aux_upvalue (StkId fi, int n, TValue **val) {
   Closure *f;
   Closure *f;
-  if (!ttisfunction(fi)) return NULL;
+  if (!ttisclosure(fi)) return NULL;
   f = clvalue(fi);
   f = clvalue(fi);
   if (f->c.isC) {
   if (f->c.isC) {
     if (!(1 <= n && n <= f->c.nupvalues)) return NULL;
     if (!(1 <= n && n <= f->c.nupvalues)) return NULL;
@@ -1115,7 +1129,7 @@ static UpVal **getupvalref (lua_State *L, int fidx, int n, Closure **pf) {
   Closure *f;
   Closure *f;
   Proto *p;
   Proto *p;
   StkId fi = index2addr(L, fidx);
   StkId fi = index2addr(L, fidx);
-  api_check(L, ttisfunction(fi), "function expected");
+  api_check(L, ttisclosure(fi), "Lua function expected");
   f = clvalue(fi);
   f = clvalue(fi);
   api_check(L, !f->c.isC, "Lua function expected");
   api_check(L, !f->c.isC, "Lua function expected");
   p = f->l.p;
   p = f->l.p;
@@ -1128,7 +1142,7 @@ static UpVal **getupvalref (lua_State *L, int fidx, int n, Closure **pf) {
 LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
 LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
   Closure *f;
   Closure *f;
   StkId fi = index2addr(L, fidx);
   StkId fi = index2addr(L, fidx);
-  api_check(L, ttisfunction(fi), "function expected");
+  api_check(L, ttisclosure(fi), "function expected");
   f = clvalue(fi);
   f = clvalue(fi);
   if (f->c.isC) {
   if (f->c.isC) {
     api_check(L, 1 <= n && n <= f->c.nupvalues, "invalid upvalue index");
     api_check(L, 1 <= n && n <= f->c.nupvalues, "invalid upvalue index");

+ 17 - 15
ldebug.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ldebug.c,v 2.68 2010/04/05 16:26:37 roberto Exp roberto $
+** $Id: ldebug.c,v 2.69 2010/04/08 17:06:33 roberto Exp roberto $
 ** Debug Interface
 ** Debug Interface
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -144,7 +144,7 @@ LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
 
 
 
 
 static void funcinfo (lua_Debug *ar, Closure *cl) {
 static void funcinfo (lua_Debug *ar, Closure *cl) {
-  if (cl->c.isC) {
+  if (cl == NULL || cl->c.isC) {
     ar->source = "=[C]";
     ar->source = "=[C]";
     ar->linedefined = -1;
     ar->linedefined = -1;
     ar->lastlinedefined = -1;
     ar->lastlinedefined = -1;
@@ -191,8 +191,8 @@ static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
         break;
         break;
       }
       }
       case 'u': {
       case 'u': {
-        ar->nups = f->c.nupvalues;
-        if (f->c.isC) {
+        ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
+        if (f == NULL || f->c.isC) {
           ar->isvararg = 1;
           ar->isvararg = 1;
           ar->nparams = 0;
           ar->nparams = 0;
         }
         }
@@ -226,28 +226,30 @@ static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
 
 
 LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
 LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
   int status;
   int status;
-  Closure *f = NULL;
-  CallInfo *ci = NULL;
+  Closure *cl;
+  CallInfo *ci;
+  StkId func;
   lua_lock(L);
   lua_lock(L);
   if (*what == '>') {
   if (*what == '>') {
-    StkId func = L->top - 1;
+    ci = NULL;
+    func = L->top - 1;
     luai_apicheck(L, ttisfunction(func));
     luai_apicheck(L, ttisfunction(func));
     what++;  /* skip the '>' */
     what++;  /* skip the '>' */
-    f = clvalue(func);
     L->top--;  /* pop function */
     L->top--;  /* pop function */
   }
   }
   else {
   else {
     ci = ar->i_ci;
     ci = ar->i_ci;
+    func = ci->func;
     lua_assert(ttisfunction(ci->func));
     lua_assert(ttisfunction(ci->func));
-    f = clvalue(ci->func);
   }
   }
-  status = auxgetinfo(L, what, ar, f, ci);
+  cl = ttisclosure(func) ? clvalue(func) : NULL;
+  status = auxgetinfo(L, what, ar, cl, ci);
   if (strchr(what, 'f')) {
   if (strchr(what, 'f')) {
-    setclvalue(L, L->top, f);
+    setobjs2s(L, L->top, func);
     incr_top(L);
     incr_top(L);
   }
   }
   if (strchr(what, 'L'))
   if (strchr(what, 'L'))
-    collectvalidlines(L, f);
+    collectvalidlines(L, cl);
   lua_unlock(L);
   lua_unlock(L);
   return status;
   return status;
 }
 }
@@ -439,7 +441,7 @@ static const char *getupvalname (CallInfo *ci, const TValue *o,
 void luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
 void luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
   CallInfo *ci = L->ci;
   CallInfo *ci = L->ci;
   const char *name = NULL;
   const char *name = NULL;
-  const char *t = typename(ttype(o));
+  const char *t = objtypename(o);
   const char *kind = NULL;
   const char *kind = NULL;
   if (isLua(ci)) {
   if (isLua(ci)) {
     kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
     kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
@@ -470,8 +472,8 @@ void luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
 
 
 
 
 int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
 int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
-  const char *t1 = typename(ttype(p1));
-  const char *t2 = typename(ttype(p2));
+  const char *t1 = objtypename(p1);
+  const char *t2 = objtypename(p2);
   if (t1 == t2)
   if (t1 == t2)
     luaG_runerror(L, "attempt to compare two %s values", t1);
     luaG_runerror(L, "attempt to compare two %s values", t1);
   else
   else

+ 31 - 23
ldo.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ldo.c,v 2.82 2010/03/26 20:58:11 roberto Exp roberto $
+** $Id: ldo.c,v 2.83 2010/04/08 17:16:46 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -293,18 +293,43 @@ static StkId tryfuncTM (lua_State *L, StkId func) {
 ** returns true if function has been executed (C function)
 ** returns true if function has been executed (C function)
 */
 */
 int luaD_precall (lua_State *L, StkId func, int nresults) {
 int luaD_precall (lua_State *L, StkId func, int nresults) {
-  LClosure *cl;
+  Closure *cl;
+  lua_CFunction f;
   ptrdiff_t funcr;
   ptrdiff_t funcr;
   if (!ttisfunction(func)) /* `func' is not a function? */
   if (!ttisfunction(func)) /* `func' is not a function? */
     func = tryfuncTM(L, func);  /* check the `function' tag method */
     func = tryfuncTM(L, func);  /* check the `function' tag method */
   funcr = savestack(L, func);
   funcr = savestack(L, func);
-  cl = &clvalue(func)->l;
   L->ci->nresults = nresults;
   L->ci->nresults = nresults;
-  if (!cl->isC) {  /* Lua function? prepare its call */
+  if (ttiscfp(func)) {  /* C function pointer? */
+    f = fvalue(func);  /* get it */
+    goto isCfunc;  /* go to call it */
+  }
+  cl = clvalue(func);
+  if (cl->c.isC) {  /* C closure? */
+    CallInfo *ci;
+    int n;
+    f = cl->c.f;
+  isCfunc:  /* call C function 'f' */
+    luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
+    ci = next_ci(L);  /* now 'enter' new function */
+    ci->func = restorestack(L, funcr);
+    ci->top = L->top + LUA_MINSTACK;
+    lua_assert(ci->top <= L->stack_last);
+    ci->callstatus = 0;
+    if (L->hookmask & LUA_MASKCALL)
+      luaD_hook(L, LUA_HOOKCALL, -1);
+    lua_unlock(L);
+    n = (*f)(L);  /* do the actual call */
+    lua_lock(L);
+    api_checknelems(L, n);
+    luaD_poscall(L, L->top - n);
+    return 1;
+  }
+  else {  /* Lua function: prepare its call */
     CallInfo *ci;
     CallInfo *ci;
     int nparams, nargs;
     int nparams, nargs;
     StkId base;
     StkId base;
-    Proto *p = cl->p;
+    Proto *p = cl->l.p;
     luaD_checkstack(L, p->maxstacksize);
     luaD_checkstack(L, p->maxstacksize);
     func = restorestack(L, funcr);
     func = restorestack(L, funcr);
     nargs = cast_int(L->top - func) - 1;  /* number of real arguments */
     nargs = cast_int(L->top - func) - 1;  /* number of real arguments */
@@ -327,24 +352,6 @@ int luaD_precall (lua_State *L, StkId func, int nresults) {
       callhook(L, ci);
       callhook(L, ci);
     return 0;
     return 0;
   }
   }
-  else {  /* if is a C function, call it */
-    CallInfo *ci;
-    int n;
-    luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
-    ci = next_ci(L);  /* now 'enter' new function */
-    ci->func = restorestack(L, funcr);
-    ci->top = L->top + LUA_MINSTACK;
-    lua_assert(ci->top <= L->stack_last);
-    ci->callstatus = 0;
-    if (L->hookmask & LUA_MASKCALL)
-      luaD_hook(L, LUA_HOOKCALL, -1);
-    lua_unlock(L);
-    n = (*curr_func(L)->c.f)(L);  /* do the actual call */
-    lua_lock(L);
-    api_checknelems(L, n);
-    luaD_poscall(L, L->top - n);
-    return 1;
-  }
 }
 }
 
 
 
 
@@ -526,6 +533,7 @@ LUA_API int lua_resume (lua_State *L, int nargs) {
   luai_userstateresume(L, nargs);
   luai_userstateresume(L, nargs);
   ++G(L)->nCcalls;  /* count resume */
   ++G(L)->nCcalls;  /* count resume */
   L->nny = 0;  /* allow yields */
   L->nny = 0;  /* allow yields */
+  api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
   status = luaD_rawrunprotected(L, resume, L->top - nargs);
   status = luaD_rawrunprotected(L, resume, L->top - nargs);
   if (status == -1)  /* error calling 'lua_resume'? */
   if (status == -1)  /* error calling 'lua_resume'? */
     status = LUA_ERRRUN;
     status = LUA_ERRRUN;

+ 3 - 1
lobject.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: lobject.c,v 2.36 2010/04/02 15:30:27 roberto Exp roberto $
+** $Id: lobject.c,v 2.37 2010/04/05 16:26:37 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -83,6 +83,8 @@ int luaO_rawequalObj (const TValue *t1, const TValue *t2) {
       return pvalue(t1) == pvalue(t2);
       return pvalue(t1) == pvalue(t2);
     case LUA_TSTRING:
     case LUA_TSTRING:
       return rawtsvalue(t1) == rawtsvalue(t2);
       return rawtsvalue(t1) == rawtsvalue(t2);
+    case LUA_TCFP:
+      return fvalue(t1) == fvalue(t2);
     default:
     default:
       lua_assert(iscollectable(t1));
       lua_assert(iscollectable(t1));
       return gcvalue(t1) == gcvalue(t2);
       return gcvalue(t1) == gcvalue(t2);

+ 30 - 9
lobject.h

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: lobject.h,v 2.36 2010/03/26 20:58:11 roberto Exp roberto $
+** $Id: lobject.h,v 2.37 2010/04/12 16:07:06 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -24,6 +24,12 @@
 #define LUA_TDEADKEY	(LUA_NUMTAGS+2)
 #define LUA_TDEADKEY	(LUA_NUMTAGS+2)
 
 
 
 
+/*
+** Variant tag for C-function pointers (negative to be considered
+** non collectable by 'iscollectable')
+*/
+#define LUA_TCFP	(~0x0F | LUA_TFUNCTION)
+
 /*
 /*
 ** Union of all collectable objects
 ** Union of all collectable objects
 */
 */
@@ -54,6 +60,7 @@ typedef union {
   void *p;
   void *p;
   lua_Number n;
   lua_Number n;
   int b;
   int b;
+  lua_CFunction f;
 } Value;
 } Value;
 
 
 
 
@@ -73,12 +80,26 @@ typedef struct lua_TValue {
 #define NILCONSTANT    {NULL}, LUA_TNIL
 #define NILCONSTANT    {NULL}, LUA_TNIL
 
 
 
 
+/*
+** type tag of a TValue
+*/
+#define ttype(o)	((o)->tt_)
+
+
+/*
+** type tag of a TValue with no variants
+*/
+#define ttypenv(o)	(ttype(o) & 0x0F)
+
+
 /* Macros to test type */
 /* Macros to test type */
 #define ttisnil(o)	(ttype(o) == LUA_TNIL)
 #define ttisnil(o)	(ttype(o) == LUA_TNIL)
 #define ttisnumber(o)	(ttype(o) == LUA_TNUMBER)
 #define ttisnumber(o)	(ttype(o) == LUA_TNUMBER)
 #define ttisstring(o)	(ttype(o) == LUA_TSTRING)
 #define ttisstring(o)	(ttype(o) == LUA_TSTRING)
 #define ttistable(o)	(ttype(o) == LUA_TTABLE)
 #define ttistable(o)	(ttype(o) == LUA_TTABLE)
-#define ttisfunction(o)	(ttype(o) == LUA_TFUNCTION)
+#define ttisfunction(o)	(ttypenv(o) == LUA_TFUNCTION)
+#define ttisclosure(o)	(ttype(o) == LUA_TFUNCTION)
+#define ttiscfp(o)	(ttype(o) == LUA_TCFP)
 #define ttisboolean(o)	(ttype(o) == LUA_TBOOLEAN)
 #define ttisboolean(o)	(ttype(o) == LUA_TBOOLEAN)
 #define ttisuserdata(o)	(ttype(o) == LUA_TUSERDATA)
 #define ttisuserdata(o)	(ttype(o) == LUA_TUSERDATA)
 #define ttisthread(o)	(ttype(o) == LUA_TTHREAD)
 #define ttisthread(o)	(ttype(o) == LUA_TTHREAD)
@@ -86,7 +107,6 @@ typedef struct lua_TValue {
 #define ttisdeadkey(o)	(ttype(o) == LUA_TDEADKEY)
 #define ttisdeadkey(o)	(ttype(o) == LUA_TDEADKEY)
 
 
 /* Macros to access values */
 /* Macros to access values */
-#define ttype(o)	((o)->tt_)
 #define gcvalue(o)	check_exp(iscollectable(o), (o)->value_.gc)
 #define gcvalue(o)	check_exp(iscollectable(o), (o)->value_.gc)
 #define pvalue(o)	check_exp(ttislightuserdata(o), (o)->value_.p)
 #define pvalue(o)	check_exp(ttislightuserdata(o), (o)->value_.p)
 #define nvalue(o)	check_exp(ttisnumber(o), (o)->value_.n)
 #define nvalue(o)	check_exp(ttisnumber(o), (o)->value_.n)
@@ -94,16 +114,15 @@ typedef struct lua_TValue {
 #define tsvalue(o)	(&rawtsvalue(o)->tsv)
 #define tsvalue(o)	(&rawtsvalue(o)->tsv)
 #define rawuvalue(o)	check_exp(ttisuserdata(o), &(o)->value_.gc->u)
 #define rawuvalue(o)	check_exp(ttisuserdata(o), &(o)->value_.gc->u)
 #define uvalue(o)	(&rawuvalue(o)->uv)
 #define uvalue(o)	(&rawuvalue(o)->uv)
-#define clvalue(o)	check_exp(ttisfunction(o), &(o)->value_.gc->cl)
+#define clvalue(o)	check_exp(ttisclosure(o), &(o)->value_.gc->cl)
+#define fvalue(o)	check_exp(ttiscfp(o), (o)->value_.f)
 #define hvalue(o)	check_exp(ttistable(o), &(o)->value_.gc->h)
 #define hvalue(o)	check_exp(ttistable(o), &(o)->value_.gc->h)
 #define bvalue(o)	check_exp(ttisboolean(o), (o)->value_.b)
 #define bvalue(o)	check_exp(ttisboolean(o), (o)->value_.b)
 #define thvalue(o)	check_exp(ttisthread(o), &(o)->value_.gc->th)
 #define thvalue(o)	check_exp(ttisthread(o), &(o)->value_.gc->th)
 
 
 #define l_isfalse(o)	(ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
 #define l_isfalse(o)	(ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
 
 
-/*
-** for internal debug only
-*/
+
 #define iscollectable(o)	(ttype(o) >= LUA_TSTRING)
 #define iscollectable(o)	(ttype(o) >= LUA_TSTRING)
 
 
 #define righttt(obj)		(ttype(obj) == gcvalue(obj)->gch.tt)
 #define righttt(obj)		(ttype(obj) == gcvalue(obj)->gch.tt)
@@ -120,6 +139,9 @@ typedef struct lua_TValue {
 #define setnvalue(obj,x) \
 #define setnvalue(obj,x) \
   { TValue *i_o=(obj); i_o->value_.n=(x); i_o->tt_=LUA_TNUMBER; }
   { TValue *i_o=(obj); i_o->value_.n=(x); i_o->tt_=LUA_TNUMBER; }
 
 
+#define setfvalue(obj,x) \
+  { TValue *i_o=(obj); i_o->value_.f=(x); i_o->tt_=LUA_TCFP; }
+
 #define changenvalue(obj,x) \
 #define changenvalue(obj,x) \
   ( lua_assert((obj)->tt_==LUA_TNUMBER), (obj)->value_.n=(x) )
   ( lua_assert((obj)->tt_==LUA_TNUMBER), (obj)->value_.n=(x) )
 
 
@@ -313,8 +335,7 @@ typedef union Closure {
 } Closure;
 } Closure;
 
 
 
 
-#define iscfunction(o)	(ttisfunction(o) && clvalue(o)->c.isC)
-#define isLfunction(o)	(ttisfunction(o) && !clvalue(o)->c.isC)
+#define isLfunction(o)	(ttisclosure(o) && !clvalue(o)->c.isC)
 
 
 #define getproto(o)	(clvalue(o)->l.p)
 #define getproto(o)	(clvalue(o)->l.p)
 
 

+ 1 - 2
lstate.h

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: lstate.h,v 2.61 2010/04/08 17:16:46 roberto Exp roberto $
+** $Id: lstate.h,v 2.62 2010/04/12 16:07:06 roberto Exp roberto $
 ** Global State
 ** Global State
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -105,7 +105,6 @@ typedef struct CallInfo {
 #define CIST_TAIL	(1<<6)	/* call was tail called */
 #define CIST_TAIL	(1<<6)	/* call was tail called */
 
 
 
 
-#define curr_func(L)	(clvalue(L->ci->func))
 #define ci_func(ci)	(clvalue((ci)->func))
 #define ci_func(ci)	(clvalue((ci)->func))
 #define isLua(ci)	((ci)->callstatus & CIST_LUA)
 #define isLua(ci)	((ci)->callstatus & CIST_LUA)
 
 

+ 3 - 1
ltable.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ltable.c,v 2.47 2009/12/17 15:46:44 roberto Exp roberto $
+** $Id: ltable.c,v 2.48 2010/04/05 16:26:37 roberto Exp roberto $
 ** Lua tables (hash)
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -109,6 +109,8 @@ static Node *mainposition (const Table *t, const TValue *key) {
       return hashboolean(t, bvalue(key));
       return hashboolean(t, bvalue(key));
     case LUA_TLIGHTUSERDATA:
     case LUA_TLIGHTUSERDATA:
       return hashpointer(t, pvalue(key));
       return hashpointer(t, pvalue(key));
+    case LUA_TCFP:
+      return hashpointer(t, fvalue(key));
     default:
     default:
       return hashpointer(t, gcvalue(key));
       return hashpointer(t, gcvalue(key));
   }
   }

+ 6 - 3
ltests.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ltests.c,v 2.92 2010/04/12 12:42:07 roberto Exp roberto $
+** $Id: ltests.c,v 2.93 2010/04/12 16:07:39 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -191,7 +191,7 @@ static void printobj (global_State *g, GCObject *o) {
   GCObject *p;
   GCObject *p;
   for (p = g->allgc; p != o && p != NULL; p = gch(p)->next) i++;
   for (p = g->allgc; p != o && p != NULL; p = gch(p)->next) i++;
   if (p == NULL) i = -1;
   if (p == NULL) i = -1;
-  printf("%d:%s(%p)-%c(%02X)", i, typename(gch(o)->tt), (void *)o,
+  printf("%d:%s(%p)-%c(%02X)", i, ttypename(gch(o)->tt), (void *)o,
            isdead(g,o)?'d':isblack(o)?'b':iswhite(o)?'w':'g', gch(o)->marked);
            isdead(g,o)?'d':isblack(o)?'b':iswhite(o)?'w':'g', gch(o)->marked);
 }
 }
 
 
@@ -519,7 +519,7 @@ static int mem_query (lua_State *L) {
     const char *t = luaL_checkstring(L, 1);
     const char *t = luaL_checkstring(L, 1);
     int i;
     int i;
     for (i = LUA_NUMTAGS - 1; i >= 0; i--) {
     for (i = LUA_NUMTAGS - 1; i >= 0; i--) {
-      if (strcmp(t, typename(i)) == 0) {
+      if (strcmp(t, ttypename(i)) == 0) {
         lua_pushinteger(L, l_memcontrol.objcount[i]);
         lua_pushinteger(L, l_memcontrol.objcount[i]);
         return 1;
         return 1;
       }
       }
@@ -944,6 +944,9 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
     else if EQ("tonumber") {
     else if EQ("tonumber") {
       lua_pushnumber(L1, lua_tonumber(L1, getindex));
       lua_pushnumber(L1, lua_tonumber(L1, getindex));
     }
     }
+    else if EQ("topointer") {
+      lua_pushlightuserdata(L1, cast(void *, lua_topointer(L1, getindex)));
+    }
     else if EQ("tostring") {
     else if EQ("tostring") {
       const char *s = lua_tostring(L1, getindex);
       const char *s = lua_tostring(L1, getindex);
       const char *s1 = lua_pushstring(L1, s);
       const char *s1 = lua_pushstring(L1, s);

+ 2 - 2
ltm.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ltm.c,v 2.10 2009/11/19 19:06:52 roberto Exp roberto $
+** $Id: ltm.c,v 2.11 2010/01/13 16:18:25 roberto Exp roberto $
 ** Tag methods
 ** Tag methods
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -70,7 +70,7 @@ const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
       mt = uvalue(o)->metatable;
       mt = uvalue(o)->metatable;
       break;
       break;
     default:
     default:
-      mt = G(L)->mt[ttype(o)];
+      mt = G(L)->mt[ttypenv(o)];
   }
   }
   return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject);
   return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject);
 }
 }

+ 3 - 2
ltm.h

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: ltm.h,v 2.8 2009/11/19 19:06:52 roberto Exp roberto $
+** $Id: ltm.h,v 2.9 2010/01/13 16:18:25 roberto Exp roberto $
 ** Tag methods
 ** Tag methods
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -43,7 +43,8 @@ typedef enum {
 
 
 #define fasttm(l,et,e)	gfasttm(G(l), et, e)
 #define fasttm(l,et,e)	gfasttm(G(l), et, e)
 
 
-#define typename(x)	luaT_typenames_[(x) + 1]
+#define ttypename(x)	luaT_typenames_[(x) + 1]
+#define objtypename(x)	ttypename(ttypenv(x))
 
 
 LUAI_DDEC const char *const luaT_typenames_[];
 LUAI_DDEC const char *const luaT_typenames_[];
 
 

+ 4 - 3
lvm.c

@@ -1,5 +1,5 @@
 /*
 /*
-** $Id: lvm.c,v 2.109 2010/04/02 15:39:07 roberto Exp roberto $
+** $Id: lvm.c,v 2.110 2010/04/05 16:26:37 roberto Exp roberto $
 ** Lua virtual machine
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 ** See Copyright Notice in lua.h
 */
 */
@@ -218,7 +218,7 @@ static int l_strcmp (const TString *ls, const TString *rs) {
 
 
 int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
 int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
   int res;
   int res;
-  if (ttype(l) != ttype(r))
+  if (ttypenv(l) != ttypenv(r))
     return luaG_ordererror(L, l, r);
     return luaG_ordererror(L, l, r);
   else if (ttisnumber(l))
   else if (ttisnumber(l))
     return luai_numlt(L, nvalue(l), nvalue(r));
     return luai_numlt(L, nvalue(l), nvalue(r));
@@ -232,7 +232,7 @@ int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
 
 
 int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
 int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
   int res;
   int res;
-  if (ttype(l) != ttype(r))
+  if (ttypenv(l) != ttypenv(r))
     return luaG_ordererror(L, l, r);
     return luaG_ordererror(L, l, r);
   else if (ttisnumber(l))
   else if (ttisnumber(l))
     return luai_numle(L, nvalue(l), nvalue(r));
     return luai_numle(L, nvalue(l), nvalue(r));
@@ -254,6 +254,7 @@ int luaV_equalval_ (lua_State *L, const TValue *t1, const TValue *t2) {
     case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2));
     case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2));
     case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */
     case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */
     case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
     case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
+    case LUA_TCFP: return fvalue(t1) == fvalue(t2);
     case LUA_TSTRING: return eqstr(rawtsvalue(t1), rawtsvalue(t2));
     case LUA_TSTRING: return eqstr(rawtsvalue(t1), rawtsvalue(t2));
     case LUA_TUSERDATA: {
     case LUA_TUSERDATA: {
       if (uvalue(t1) == uvalue(t2)) return 1;
       if (uvalue(t1) == uvalue(t2)) return 1;