first step in implementing internal methods.

fallback.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.24 1996/04/22 18:00:37 roberto Exp roberto $";
+char *rcs_fallback="$Id: fallback.c,v 1.25 1996/04/25 14:10:00 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -13,6 +13,8 @@ char *rcs_fallback="$Id: fallback.c,v 1.24 1996/04/22 18:00:37 roberto Exp rober
 #include "opcode.h"
 #include "lua.h"
 #include "table.h"
+#include "tree.h"
+#include "hash.h"
 
 
 static void errorFB (void);
@@ -29,8 +31,6 @@ static void funcFB (void);
 ** Warning: This list must be in the same order as the #define's
 */
 struct FB  luaI_fallBacks[] = {
-{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0},
-{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
 {"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
 {"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
 {"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
@@ -39,12 +39,26 @@ struct FB  luaI_fallBacks[] = {
 {"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
 {"function", {LUA_T_CFUNCTION, {funcFB}}, -1, -1},
                                 /* no fixed number of params or results */
-{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1}
+{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1},
                                 /* same default behavior of index FB */
+{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
+{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0}
 };
 
 #define N_FB  (sizeof(luaI_fallBacks)/sizeof(struct FB))
 
+static int luaI_findevent (char *name)
+{
+  int i;
+  for (i=0; i<N_FB; i++)
+    if (strcmp(luaI_fallBacks[i].kind, name) == 0)
+      return i;
+  /* name not found */
+  lua_error("invalid event name");
+  return 0;  /* to avoid warnings */
+}
+
+
 void luaI_setfallback (void)
 {
   int i;
@@ -52,17 +66,9 @@ void luaI_setfallback (void)
   lua_Object func = lua_getparam(2);
   if (name == NULL || !lua_isfunction(func))
     lua_error("incorrect argument to function `setfallback'");
-  for (i=0; i<N_FB; i++)
-  {
-    if (strcmp(luaI_fallBacks[i].kind, name) == 0)
-    {
-      luaI_pushobject(&luaI_fallBacks[i].function);
-      luaI_fallBacks[i].function = *luaI_Address(func);
-      return;
-    }
-  }
-  /* name not found */
-  lua_error("incorrect argument to function `setfallback'");
+  i = luaI_findevent(name);
+  luaI_pushobject(&luaI_fallBacks[i].function);
+  luaI_fallBacks[i].function = *luaI_Address(func);
 }
 
 
@@ -112,7 +118,7 @@ static void funcFB (void)
 }
 
 
-/*
+/* -------------------------------------------
 ** Reference routines
 */
 
@@ -189,3 +195,95 @@ char *luaI_travfallbacks (int (*fn)(Object *))
       return luaI_fallBacks[i].kind;
   return NULL;
 }
+
+
+/* -------------------------------------------
+* Internal Methods 
+*/
+#define BASE_TAG 1000
+
+static struct IM {
+  lua_Type tp;
+  Object int_method[FB_N];
+ } *luaI_IMtable = NULL;
+static int IMtable_size = 0;
+static int last_tag = BASE_TAG-1;
+
+int lua_newtag (char *t)
+{
+  int i;
+  ++last_tag;
+  if ((last_tag-BASE_TAG) >= IMtable_size)
+    IMtable_size = growvector(&luaI_IMtable, IMtable_size,
+                              struct IM, memEM, MAX_INT);
+  if (strcmp(t, "table") == 0)
+    luaI_IMtable[last_tag-BASE_TAG].tp = LUA_T_ARRAY;
+  else if (strcmp(t, "userdata") == 0)
+    luaI_IMtable[last_tag-BASE_TAG].tp = LUA_T_USERDATA;
+  else
+    lua_error("invalid type for new tag");
+  for (i=0; i<FB_N; i++)
+    luaI_IMtable[last_tag-BASE_TAG].int_method[i].tag = LUA_T_NIL;
+  return last_tag;
+}
+
+static int validtag (int tag)
+{
+  return (BASE_TAG <= tag && tag <= last_tag);
+}
+
+static void checktag (int tag)
+{
+  if (!validtag(tag))
+    lua_error("invalid tag");
+}
+
+void luaI_settag (int tag, Object *o)
+{
+  checktag(tag);
+  if (tag(o) != luaI_IMtable[tag-BASE_TAG].tp)
+    lua_error("Tag is not compatible with this type");
+  if (o->tag == LUA_T_ARRAY)
+    o->value.a->htag = tag;
+  else  /* must be userdata */
+    o->value.ts->tag = tag;
+}
+
+int luaI_tag (Object *o)
+{
+  lua_Type t = tag(o);
+  if (t == LUA_T_USERDATA)
+    return o->value.ts->tag;
+  else if (t == LUA_T_ARRAY)
+    return o->value.a->htag;
+  else return t;
+}
+
+Object *luaI_getim (int tag, int event)
+{
+  if (tag == 0)
+    return &luaI_fallBacks[event].function;
+  else if (validtag(tag)) {
+    Object *func = &luaI_IMtable[tag-BASE_TAG].int_method[event];
+    if (func->tag == LUA_T_NIL)
+      return NULL;
+    else
+      return func;
+  }
+  else return NULL;
+}
+
+void luaI_setintmethod (void)
+{
+  lua_Object tag = lua_getparam(1);
+  lua_Object event = lua_getparam(2);
+  lua_Object func = lua_getparam(3);
+  if (!(lua_isnumber(tag) && lua_isstring(event) && lua_isfunction(func)))
+    lua_error("incorrect arguments to function `setintmethod'");
+  else {
+    int i = luaI_findevent(lua_getstring(event));
+    int t = lua_getnumber(tag);
+    checktag(t);
+    luaI_IMtable[t-BASE_TAG].int_method[i] = *luaI_Address(func);
+  }
+}

fallback.h

@@ -1,5 +1,5 @@
 /*
-** $Id: fallback.h,v 1.12 1996/04/22 18:00:37 roberto Exp roberto $
+** $Id: fallback.h,v 1.13 1996/04/25 14:10:00 roberto Exp roberto $
 */
  
 #ifndef fallback_h
@@ -15,16 +15,17 @@ extern struct FB {
   int nResults;
 } luaI_fallBacks[];
 
-#define FB_ERROR  0
-#define FB_INDEX  1
-#define FB_GETTABLE  2
-#define FB_ARITH  3
-#define FB_ORDER  4
-#define FB_CONCAT  5
-#define FB_SETTABLE  6
-#define FB_GC 7
-#define FB_FUNCTION 8
-#define FB_GETGLOBAL 9
+#define FB_GETTABLE  0
+#define FB_ARITH  1
+#define FB_ORDER  2
+#define FB_CONCAT  3
+#define FB_SETTABLE  4
+#define FB_GC 5
+#define FB_FUNCTION 6
+#define FB_GETGLOBAL 7
+#define FB_INDEX  8
+#define FB_ERROR  9
+#define FB_N 10
 
 void luaI_setfallback (void);
 int luaI_ref (Object *object, int lock);
@@ -33,5 +34,10 @@ void luaI_travlock (int (*fn)(Object *));
 void luaI_invalidaterefs (void);
 char *luaI_travfallbacks (int (*fn)(Object *));
 
+void luaI_settag (int tag, Object *o);
+Object *luaI_getim (int tag, int event);
+int luaI_tag (Object *o);
+void luaI_setintmethod (void);
+
 #endif
 

hash.c

@@ -3,7 +3,7 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.32 1996/11/18 13:48:44 roberto Exp roberto $";
+char *rcs_hash="$Id: hash.c,v 2.33 1997/02/11 11:35:05 roberto Exp roberto $";
 
 
 #include "mem.h"
@@ -24,6 +24,8 @@ char *rcs_hash="$Id: hash.c,v 2.32 1996/11/18 13:48:44 roberto Exp roberto $";
 
 #define REHASH_LIMIT    0.70    /* avoid more than this % full */
 
+#define TagDefault LUA_T_ARRAY;
+
 
 static Hash *listhead = NULL;
 
@@ -121,6 +123,7 @@ static Hash *hashcreate (int nhash)
  nhash(t) = nhash;
  nuse(t) = 0;
  markarray(t) = 0;
+ t->htag = TagDefault;
  return t;
 }
 

hash.h

@@ -1,7 +1,7 @@
 /*
 ** hash.h
 ** hash manager for lua
-** $Id: hash.h,v 2.11 1996/03/08 12:04:04 roberto Exp roberto $
+** $Id: hash.h,v 2.12 1996/05/06 14:30:27 roberto Exp roberto $
 */
 
 #ifndef hash_h
@@ -10,19 +10,18 @@
 #include "types.h"
 #include "opcode.h"
 
-typedef struct node
-{
+typedef struct node {
  Object ref;
  Object val;
 } Node;
 
-typedef struct Hash
-{
- struct Hash   *next;
- Node          *node;
- int           nhash;
- int            nuse;
- char           mark;
+typedef struct Hash {
+  struct Hash *next;
+  Node *node;
+  int nhash;
+  int nuse;
+  int htag;
+  char mark;
 } Hash;
 
 

inout.c

@@ -5,7 +5,7 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.42 1996/09/24 21:46:44 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.43 1996/09/25 12:57:22 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -16,7 +16,9 @@ char *rcs_inout="$Id: inout.c,v 2.42 1996/09/24 21:46:44 roberto Exp roberto $";
 #include "table.h"
 #include "tree.h"
 #include "lua.h"
+#include "hash.h"
 #include "mem.h"
+#include "fallback.h"
 
 
 /* Exported variables */
@@ -109,6 +111,21 @@ static void check_arg (int cond, char *func)
   }
 }
 
+static char *check_string (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  check_arg(lua_isstring(o), funcname);
+  return lua_getstring(o);
+}
+
+static int check_number (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  check_arg(lua_isnumber(o), funcname);
+  return (int)lua_getnumber(o);
+}
+
+
 
 static int passresults (void)
 {
@@ -122,10 +139,9 @@ static int passresults (void)
 /*
 ** Internal function: do a string
 */
-void lua_internaldostring (void)
+static void lua_internaldostring (void)
 {
-  lua_Object obj = lua_getparam (1);
-  if (lua_isstring(obj) && lua_dostring(lua_getstring(obj)) == 0)
+  if (lua_dostring(check_string(1, "dostring")) == 0)
     if (passresults() == 0)
       lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 }
@@ -133,7 +149,7 @@ void lua_internaldostring (void)
 /*
 ** Internal function: do a file
 */
-void lua_internaldofile (void)
+static void lua_internaldofile (void)
 {
  lua_Object obj = lua_getparam (1);
  char *fname = NULL;
@@ -150,36 +166,24 @@ void lua_internaldofile (void)
 
 static char *tostring (lua_Object obj)
 {
-  char *buff = luaI_buffer(20);
   if (lua_isstring(obj))   /* get strings and numbers */
     return lua_getstring(obj);
-  else switch(lua_type(obj))
-  {
-    case LUA_T_FUNCTION:
-      sprintf(buff, "function: %p", (luaI_Address(obj))->value.tf);
-      break;
-    case LUA_T_CFUNCTION:
-      sprintf(buff, "cfunction: %p", lua_getcfunction(obj));
-      break;
-    case LUA_T_ARRAY:
-      sprintf(buff, "table: %p", avalue(luaI_Address(obj)));
-      break;
-    case LUA_T_NIL:
-      sprintf(buff, "nil");
-      break;
-    default:
-      sprintf(buff, "userdata: %p", lua_getuserdata(obj));
-      break;
-  }
-  return buff;
+  else if (lua_istable(obj))
+    return "<table>";
+  else if (lua_isfunction(obj))
+    return "<function>";
+  else if (lua_isnil(obj))
+    return "nil";
+  else /* if (lua_isuserdata(obj)) */
+    return "<userdata>";
 }
 
-void luaI_tostring (void)
+static void luaI_tostring (void)
 {
   lua_pushstring(tostring(lua_getparam(1)));
 }
 
-void luaI_print (void)
+static void luaI_print (void)
 {
   int i = 1;
   lua_Object obj;
@@ -190,42 +194,35 @@ void luaI_print (void)
 /*
 ** Internal function: return an object type.
 */
-void luaI_type (void)
+static void luaI_type (void)
 {
   lua_Object o = lua_getparam(1);
-  int t;
-  if (o == LUA_NOOBJECT)
+  int t = lua_tag(o);
+  char *s;
+  if (t == LUA_T_NUMBER)
+    s = "number";
+  else if (lua_isstring(o))
+    s = "string";
+  else if (lua_istable(o))
+    s = "table";
+  else if (lua_isnil(o))
+    s = "nil";
+  else if (lua_isfunction(o))
+    s = "function";
+  else if (lua_isuserdata(o))
+    s = "userdata";
+  else {
     lua_error("no parameter to function 'type'");
-  t = lua_type(o);
-  switch (t)
-  {
-    case LUA_T_NIL :
-      lua_pushliteral("nil");
-      break;
-    case LUA_T_NUMBER :
-      lua_pushliteral("number");
-      break;
-    case LUA_T_STRING :
-      lua_pushliteral("string");
-      break;
-    case LUA_T_ARRAY :
-      lua_pushliteral("table");
-      break;
-    case LUA_T_FUNCTION :
-    case LUA_T_CFUNCTION :
-      lua_pushliteral("function");
-      break;
-    default :
-      lua_pushliteral("userdata");
-      break;
+    return; /* to avoid warnings */
   }
+  lua_pushliteral(s);
   lua_pushnumber(t);
 }
  
 /*
 ** Internal function: convert an object to a number
 */
-void lua_obj2number (void)
+static void lua_obj2number (void)
 {
   lua_Object o = lua_getparam(1);
   if (lua_isnumber(o))
@@ -233,39 +230,36 @@ void lua_obj2number (void)
 }
 
 
-void luaI_error (void)
+static void luaI_error (void)
 {
   char *s = lua_getstring(lua_getparam(1));
   if (s == NULL) s = "(no message)";
   lua_error(s);
 }
 
-void luaI_assert (void)
+static void luaI_assert (void)
 {
   lua_Object p = lua_getparam(1);
   if (p == LUA_NOOBJECT || lua_isnil(p))
     lua_error("assertion failed!");
 }
 
-void luaI_setglobal (void)
+static void luaI_setglobal (void)
 {
-  lua_Object name = lua_getparam(1);
   lua_Object value = lua_getparam(2);
-  check_arg(lua_isstring(name), "setglobal");
+  check_arg(value != LUA_NOOBJECT, "setglobal");
   lua_pushobject(value);
-  lua_storeglobal(lua_getstring(name));
+  lua_storeglobal(check_string(1, "setglobal"));
   lua_pushobject(value);  /* return given value */
 }
 
-void luaI_getglobal (void)
+static void luaI_getglobal (void)
 {
-  lua_Object name = lua_getparam(1);
-  check_arg(lua_isstring(name), "getglobal");
-  lua_pushobject(lua_getglobal(lua_getstring(name)));
+  lua_pushobject(lua_getglobal(check_string(1, "getglobal")));
 }
 
 #define MAXPARAMS	256
-void luaI_call (void)
+static void luaI_call (void)
 {
   lua_Object f = lua_getparam(1);
   lua_Object arg = lua_getparam(2);
@@ -298,3 +292,86 @@ void luaI_call (void)
   else
     passresults();
 }
+
+static void luaIl_settag (void)
+{
+  lua_Object o = lua_getparam(1);
+  check_arg(o != LUA_NOOBJECT, "settag");
+  lua_pushobject(o);
+  lua_settag(check_number(2, "settag"));
+}
+
+static void luaIl_newtag (void)
+{
+  lua_pushnumber(lua_newtag(check_string(1, "newtag")));
+}
+
+static void basicindex (void)
+{
+  lua_Object t = lua_getparam(1);
+  lua_Object i = lua_getparam(2);
+  check_arg(t != LUA_NOOBJECT && i != LUA_NOOBJECT, "basicindex");
+  lua_pushobject(t);
+  lua_pushobject(i);
+  lua_pushobject(lua_basicindex());
+}
+
+static void basicstoreindex (void)
+{
+  lua_Object t = lua_getparam(1);
+  lua_Object i = lua_getparam(2);
+  lua_Object v = lua_getparam(3);
+  check_arg(t != LUA_NOOBJECT && i != LUA_NOOBJECT && v != LUA_NOOBJECT,
+            "basicindex");
+  lua_pushobject(t);
+  lua_pushobject(i);
+  lua_pushobject(v);
+  lua_basicstoreindex();
+}
+
+
+
+/*
+** Internal functions
+*/
+static struct {
+  char *name;
+  lua_CFunction func;
+} int_funcs[] = {
+  {"assert", luaI_assert},
+  {"call", luaI_call},
+  {"basicindex", basicindex},
+  {"basicstoreindex", basicstoreindex},
+  {"settag", luaIl_settag},
+  {"dofile", lua_internaldofile},
+  {"dostring", lua_internaldostring},
+  {"error", luaI_error},
+  {"getglobal", luaI_getglobal},
+  {"next", lua_next},
+  {"nextvar", luaI_nextvar},
+  {"newtag", luaIl_newtag},
+  {"print", luaI_print},
+  {"setfallback", luaI_setfallback},
+  {"setintmethod", luaI_setintmethod},
+  {"setglobal", luaI_setglobal},
+  {"tonumber", lua_obj2number},
+  {"tostring", luaI_tostring},
+  {"type", luaI_type}
+};
+ 
+#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+
+
+void luaI_predefine (void)
+{
+  int i;
+  Word n;
+  for (i=0; i<INTFUNCSIZE; i++) {
+    n = luaI_findsymbolbyname(int_funcs[i].name);
+    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
+  }
+  n = luaI_findsymbolbyname("_VERSION_");
+  s_tag(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
+}
+
+

inout.h

@@ -1,5 +1,5 @@
 /*
-** $Id: inout.h,v 1.15 1996/03/15 18:21:58 roberto Exp roberto $
+** $Id: inout.h,v 1.16 1996/05/28 21:07:32 roberto Exp roberto $
 */
 
 
@@ -19,16 +19,6 @@ void lua_closefile    (void);
 void lua_openstring   (char *s);
 void lua_closestring  (void);
 
-void    lua_internaldofile (void);
-void    lua_internaldostring (void);
-void    luaI_tostring   (void);
-void    luaI_print      (void);
-void    luaI_type       (void);
-void    lua_obj2number (void);
-void	luaI_error     (void);
-void    luaI_assert    (void);
-void	luaI_setglobal (void);
-void	luaI_getglobal (void);
-void	luaI_call	(void);
+void luaI_predefine (void);
 
 #endif

lua.h

@@ -2,7 +2,7 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lua.h,v 3.33 1997/02/11 11:40:01 roberto Exp roberto $
+** $Id: lua.h,v 3.34 1997/02/20 15:51:14 roberto Exp roberto $
 */
 
 
@@ -19,13 +19,19 @@
 typedef void (*lua_CFunction) (void);
 typedef unsigned int lua_Object;
 
-lua_Object     lua_setfallback		(char *name, lua_CFunction fallback);
+lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
+void           lua_setintmethod	(int tag, char *event, lua_CFunction method);
+
+int            lua_newtag		(char *t);
+void           lua_settag		(int tag); /* In: object */
 
 void           lua_error		(char *s);
-int            lua_dofile 		(char *filename);
-int            lua_dostring 		(char *string);
-int            lua_callfunction		(lua_Object function);
+int            lua_dofile 		(char *filename); /* Out: returns */
+int            lua_dostring 		(char *string); /* Out: returns */
+int            lua_callfunction		(lua_Object f);
+					  /* In: parameters; Out: returns */
 int	       lua_call			(char *funcname);
+					  /* In: parameters; Out: returns */
 
 void	       lua_beginblock		(void);
 void	       lua_endblock		(void);
@@ -56,15 +62,17 @@ void           lua_pushusertag     	(void *u, int tag);
 void           lua_pushobject       	(lua_Object object);
 
 lua_Object     lua_getglobal 		(char *name);
-void           lua_storeglobal		(char *name);
+void           lua_storeglobal		(char *name); /* In: value */
 
-void           lua_storesubscript	(void);
-lua_Object     lua_getsubscript         (void);
+void           lua_storesubscript	(void); /* In: table, index, value */
+void           lua_basicstoreindex	(void); /* In: table, index, value */
+lua_Object     lua_getsubscript		(void); /* In: table, index */
+lua_Object     lua_basicindex		(void); /* In: table, index */
 
-int            lua_type 		(lua_Object object);
+int            lua_tag			(lua_Object object);
 
 
-int            lua_ref			(int lock);
+int            lua_ref			(int lock); /* In: value */
 lua_Object     lua_getref		(int ref);
 void	       lua_pushref		(int ref);
 void	       lua_unref		(int ref);
@@ -84,6 +92,8 @@ lua_Object     lua_createtable		(void);
 
 /* for compatibility with old versions. Avoid using these macros */
 
+#define lua_type(o)		(lua_tag(o))
+
 #define lua_getuserdata(o)      (*(void **)lua_getbinarydata(o))
 
 #define lua_lockobject(o)  lua_refobject(o,1)

opcode.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.80 1997/02/11 11:35:05 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.81 1997/02/20 15:51:14 roberto Exp roberto $";
 
 #include <setjmp.h>
 #include <stdio.h>
@@ -261,15 +261,20 @@ static StkId callC (lua_CFunction func, StkId base)
   return firstResult;
 }
 
+static void callIM (Object *f, int nParams, int nResults)
+{
+  open_stack(nParams);
+  *(top-nParams-1) = *f;
+  do_call((top-stack)-nParams, nResults);
+}
+
 /*
 ** Call the specified fallback, putting it on the stack below its arguments
 */
 static void callFB (int fb)
 {
-  int nParams = luaI_fallBacks[fb].nParams;
-  open_stack(nParams);
-  *(top-nParams-1) = luaI_fallBacks[fb].function;
-  do_call((top-stack)-nParams, luaI_fallBacks[fb].nResults);
+  callIM(&luaI_fallBacks[fb].function, luaI_fallBacks[fb].nParams,
+         luaI_fallBacks[fb].nResults);
 }
 
 
@@ -320,35 +325,77 @@ static void do_call (StkId base, int nResults)
 */
 static void pushsubscript (void)
 {
+  int tg = luaI_tag(top-2);
+  Object *im = luaI_getim(tg, FB_GETTABLE);
+  if (tag(top-2) == LUA_T_ARRAY && im == NULL) {
+      Object *h = lua_hashget(avalue(top-2), top-1);
+      if (h != NULL && tag(h) != LUA_T_NIL) {
+        --top;
+        *(top-1) = *h;
+      }
+      else if (tg == LUA_T_ARRAY &&
+              (im=luaI_getim(0, FB_INDEX)) != NULL)
+        callIM(im, 2, 1);
+      else {
+        --top;
+        tag(top-1) = LUA_T_NIL;
+      }
+  }
+  else {  /* object is not a table, and/or has a specific "gettable" method */
+    if (im)
+      callIM(im, 2, 1);
+    else
+      lua_error("indexed expression not a table");
+  }
+}
+
+
+lua_Object lua_basicindex (void)
+{
+  adjustC(2);
   if (tag(top-2) != LUA_T_ARRAY)
-    callFB(FB_GETTABLE);
-  else 
-  {
+    lua_error("indexed expression not a table in basic indexing");
+  else {
     Object *h = lua_hashget(avalue(top-2), top-1);
-    if (h == NULL || tag(h) == LUA_T_NIL)
-      callFB(FB_INDEX);
-    else
-    {
-      --top;
+    --top;
+    if (h != NULL)
       *(top-1) = *h;
-    }
+    else
+      tag(top-1) = LUA_T_NIL;
   }
+  CLS_current.base++;  /* incorporate object in the stack */
+  return (Ref(top-1));
 }
 
 
 /*
 ** Function to store indexed based on values at the top
+** mode = 0: basic store (without internal methods)
+** mode = 1: normal store (with internal methods)
+** mode = 2: "deep stack" store (with internal methods)
 */
-static void storesubscript (void)
+static void storesubscript (Object *t, int mode)
 {
- if (tag(top-3) != LUA_T_ARRAY)
-   callFB(FB_SETTABLE);
- else
- {
-  Object *h = lua_hashdefine (avalue(top-3), top-2);
-  *h = *(top-1);
-  top -= 3;
- }
+  Object *im = (mode == 0) ? NULL : luaI_getim(luaI_tag(t), FB_SETTABLE);
+  if (tag(t) == LUA_T_ARRAY && im == NULL) {
+    Object *h = lua_hashdefine(avalue(t), t+1);
+    *h = *(top-1);
+    top -= (mode == 2) ? 1 : 3;
+  }
+  else {  /* object is not a table, and/or has a specific "settable" method */
+    if (im) {
+      if (mode == 2) {
+        lua_checkstack(top+2);
+        *(top+1) = *(top-1);
+        *(top) = *(t+1);
+        *(top-1) = *t;
+        top += 2;
+      }
+      callIM(im, 3, 0);
+    }
+    else
+      lua_error("indexed expression not a table");
+  }
 }
 
 
@@ -450,6 +497,26 @@ int lua_setlocal (lua_Function func, int local_number)
     return 0;
 }
 
+/*
+** Call the function at CLS_current.base, and incorporate results on
+** the Lua2C structure.
+*/
+static void do_callinc (int nResults)
+{
+  do_call(CLS_current.base+1, nResults);
+  CLS_current.num = (top-stack) - CLS_current.base;  /* number of results */
+  CLS_current.base += CLS_current.num;  /* incorporate results on the stack */
+}
+
+static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
+{
+  adjustC(nParams);
+  open_stack((top-stack)-CLS_current.base);
+  stack[CLS_current.base].tag = LUA_T_CFUNCTION;
+  stack[CLS_current.base].value.f = f;
+  do_callinc(nResults);
+}
+
 
 /*
 ** Execute a protected call. Assumes that function is at CLS_current.base and
@@ -462,15 +529,11 @@ static int do_protectedrun (int nResults)
   struct C_Lua_Stack oldCLS = CLS_current;
   jmp_buf *oldErr = errorJmp;
   errorJmp = &myErrorJmp;
-  if (setjmp(myErrorJmp) == 0)
-  {
-    do_call(CLS_current.base+1, nResults);
-    CLS_current.num = (top-stack) - CLS_current.base;  /* number of results */
-    CLS_current.base += CLS_current.num;  /* incorporate results on the stack */
+  if (setjmp(myErrorJmp) == 0) {
+    do_callinc(nResults);
     status = 0;
   }
-  else
-  { /* an error occurred: restore CLS_current and top */
+  else { /* an error occurred: restore CLS_current and top */
     CLS_current = oldCLS;
     top = stack+CLS_current.base;
     status = 1;
@@ -586,15 +649,18 @@ int lua_dostring (char *str)
 */
 lua_Object lua_setfallback (char *name, lua_CFunction fallback)
 {
-  adjustC(1);  /* one slot for the pseudo-function */
-  stack[CLS_current.base].tag = LUA_T_CFUNCTION;
-  stack[CLS_current.base].value.f = luaI_setfallback;
   lua_pushstring(name);
   lua_pushcfunction(fallback);
-  if (do_protectedrun(1) == 0)
-    return (Ref(top-1));
-  else
-    return LUA_NOOBJECT;
+  do_unprotectedrun(luaI_setfallback, 2, 1);
+  return (Ref(top-1));
+}
+
+void lua_setintmethod (int tag, char *event, lua_CFunction method)
+{
+  lua_pushnumber(tag);
+  lua_pushstring(event);
+  lua_pushcfunction (method);
+  do_unprotectedrun(luaI_setintmethod, 3, 0);
 }
 
 
@@ -637,13 +703,25 @@ void lua_endblock (void)
   adjustC(0);
 }
 
+void lua_settag (int tag)
+{
+  adjustC(1);
+  luaI_settag(tag, --top);
+}
+
 /* 
 ** API: receives on the stack the table, the index, and the new value.
 */
 void lua_storesubscript (void)
 {
   adjustC(3);
-  storesubscript();
+  storesubscript(top-3, 1);
+}
+
+void lua_basicstoreindex (void)
+{
+  adjustC(3);
+  storesubscript(top-3, 0);
 }
 
 /*
@@ -688,7 +766,7 @@ int lua_isuserdata (lua_Object o)
 
 int lua_iscfunction (lua_Object o)
 {
-  int t = lua_type(o);
+  int t = lua_tag(o);
   return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION);
 }
 
@@ -699,13 +777,13 @@ int lua_isnumber (lua_Object o)
 
 int lua_isstring (lua_Object o)
 {
-  int t = lua_type(o);
+  int t = lua_tag(o);
   return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
 }
 
 int lua_isfunction (lua_Object o)
 {
-  int t = lua_type(o);
+  int t = lua_tag(o);
   return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION) ||
          (t == LUA_T_MARK) || (t == LUA_T_CMARK);
 }
@@ -893,16 +971,9 @@ void lua_pushobject (lua_Object o)
   incr_top;
 }
 
-int lua_type (lua_Object o)
+int lua_tag (lua_Object o)
 {
-  if (o == LUA_NOOBJECT)
-    return LUA_T_NIL;
-  else {
-    lua_Type t = tag(Address(o));
-    if (t == LUA_T_USERDATA)
-      return (Address(o))->value.ts->tag;
-    else return t;
-  }
+  return (o == LUA_NOOBJECT) ?  LUA_T_NIL : luaI_tag(Address(o));
 }
 
 
@@ -1085,29 +1156,14 @@ static StkId lua_execute (Byte *pc, StkId base)
    break;
 
    case STOREINDEXED0:
-    storesubscript();
+    storesubscript(top-3, 1);
     break;
 
-   case STOREINDEXED:
-   {
-    int n = *pc++;
-    if (tag(top-3-n) != LUA_T_ARRAY)
-    {
-      lua_checkstack(top+2);
-      *(top+1) = *(top-1);
-      *(top) = *(top-2-n);
-      *(top-1) = *(top-3-n);
-      top += 2;
-      callFB(FB_SETTABLE);
-    }
-    else
-    {
-     Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
-     *h = *(top-1);
-     top--;
-    }
+   case STOREINDEXED: {
+     int n = *pc++;
+     storesubscript(top-3-n, 2);
+     break;
    }
-   break;
 
    case STORELIST0:
    case STORELIST:

table.c

@@ -3,7 +3,7 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.57 1996/07/12 20:00:26 roberto Exp roberto $";
+char *rcs_table="$Id: table.c,v 2.58 1996/11/01 12:47:45 roberto Exp roberto $";
 
 #include "mem.h"
 #include "opcode.h"
@@ -29,47 +29,12 @@ static Long lua_maxconstant = 0;
 
 #define GARBAGE_BLOCK 50
 
-static void lua_nextvar (void);
-
-/*
-** Internal functions
-*/
-static struct {
-  char *name;
-  lua_CFunction func;
-} int_funcs[] = {
-  {"assert", luaI_assert},
-  {"call", luaI_call},
-  {"dofile", lua_internaldofile},
-  {"dostring", lua_internaldostring},
-  {"error", luaI_error},
-  {"getglobal", luaI_getglobal},
-  {"next", lua_next},
-  {"nextvar", lua_nextvar},
-  {"print", luaI_print},
-  {"setfallback", luaI_setfallback},
-  {"setglobal", luaI_setglobal},
-  {"tonumber", lua_obj2number},
-  {"tostring", luaI_tostring},
-  {"type", luaI_type}
-};
-
-#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
-
 
 void luaI_initsymbol (void)
 {
-  int i;
-  Word n;
   lua_maxsymbol = BUFFER_BLOCK;
   lua_table = newvector(lua_maxsymbol, Symbol);
-  for (i=0; i<INTFUNCSIZE; i++)
-  {
-    n = luaI_findsymbolbyname(int_funcs[i].name);
-    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
-  }
-  n = luaI_findsymbolbyname("_VERSION_");
-  s_tag(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
+  luaI_predefine();
 }
 
 
@@ -225,7 +190,7 @@ void lua_pack (void)
 /*
 ** Internal function: return next global variable
 */
-static void lua_nextvar (void)
+void luaI_nextvar (void)
 {
  Word next;
  lua_Object o = lua_getparam(1);

table.h

@@ -1,7 +1,7 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.20 1996/03/14 15:57:19 roberto Exp roberto $
+** $Id: table.h,v 2.21 1996/04/22 18:00:37 roberto Exp roberto $
 */
 
 #ifndef table_h
@@ -28,6 +28,7 @@ Word  luaI_findsymbolbyname (char *name);
 Word  luaI_findsymbol      (TaggedString *t);
 Word  luaI_findconstant    (TaggedString *t);
 Word  luaI_findconstantbyname (char *name);
+void luaI_nextvar (void);
 TaggedString *luaI_createfixedstring  (char *str);
 int   lua_markobject      (Object *o);
 int luaI_ismarked (Object *o);