first full implementation of internal methods

fallback.c

@@ -3,11 +3,12 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.26 1997/02/26 17:38:41 roberto Unstable roberto $";
+char *rcs_fallback="$Id: fallback.c,v 1.27 1997/03/11 18:44:28 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
  
+#include "auxlib.h"
 #include "mem.h"
 #include "fallback.h"
 #include "opcode.h"
@@ -17,105 +18,6 @@ char *rcs_fallback="$Id: fallback.c,v 1.26 1997/02/26 17:38:41 roberto Unstable
 #include "hash.h"
 
 
-static void errorFB (void);
-static void indexFB (void);
-static void gettableFB (void);
-static void arithFB (void);
-static void concatFB (void);
-static void orderFB (void);
-static void GDFB (void);
-static void funcFB (void);
-
-
-/*
-** Warning: This list must be in the same order as the #define's
-*/
-struct FB  luaI_fallBacks[] = {
-{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
-{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
-{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
-{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
-{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
-{"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},
-                                /* 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;
-  char *name = lua_getstring(lua_getparam(1));
-  lua_Object func = lua_getparam(2);
-  if (name == NULL || !lua_isfunction(func))
-    lua_error("incorrect argument to function `setfallback'");
-  i = luaI_findevent(name);
-  luaI_pushobject(&luaI_fallBacks[i].function);
-  luaI_fallBacks[i].function = *luaI_Address(func);
-}
-
-
-static void errorFB (void)
-{
-  lua_Object o = lua_getparam(1);
-  if (lua_isstring(o))
-    fprintf (stderr, "lua: %s\n", lua_getstring(o));
-  else
-    fprintf(stderr, "lua: unknown error\n");
-}
- 
-
-static void indexFB (void)
-{
-  lua_pushnil();
-}
- 
-
-static void gettableFB (void)
-{
-  lua_error("indexed expression not a table");
-}
- 
-
-static void arithFB (void)
-{
-  lua_error("unexpected type at conversion to number");
-}
-
-static void concatFB (void)
-{
-  lua_error("unexpected type at conversion to string");
-}
-
-
-static void orderFB (void)
-{
-  lua_error("unexpected type at comparison");
-}
-
-static void GDFB (void) { }
-
-static void funcFB (void)
-{
-  lua_error("call expression not a function");
-}
 
 
 /* -------------------------------------------
@@ -187,50 +89,127 @@ void luaI_invalidaterefs (void)
       refArray[i].status = COLLECTED;
 }
 
-char *luaI_travfallbacks (int (*fn)(Object *))
-{
-  int i;
-  for (i=0; i<N_FB; i++)
-    if (fn(&luaI_fallBacks[i].function))
-      return luaI_fallBacks[i].kind;
-  return NULL;
-}
-
 
 /* -------------------------------------------
 * Internal Methods 
 */
-#define BASE_TAG 1000
+
+char *eventname[] = {
+  "gettable",  /* IM_GETTABLE */
+  "arith",  /* IM_ARITH */
+  "order",  /* IM_ORDER */
+  "concat",  /* IM_CONCAT */
+  "settable",  /* IM_SETTABLE */
+  "gc",  /* IM_GC */
+  "function",  /* IM_FUNCTION */
+  "index",  /* IM_INDEX */
+  NULL
+};
+
+
+char *geventname[] = {
+  "error",  /* GIM_ERROR */
+  "getglobal",  /* GIM_GETGLOBAL */
+  "setglobal",  /* GIM_SETGLOBAL */
+  NULL
+};
+
+static int luaI_findevent (char *name, char *list[])
+{
+  int i;
+  for (i=0; list[i]; i++)
+    if (strcmp(list[i], name) == 0)
+      return i;
+  /* name not found */
+  return -1;
+}
+
+static int luaI_checkevent (char *name, char *list[])
+{
+  int e = luaI_findevent(name, list);
+  if (e < 0)
+    lua_error("invalid event name");
+  return e;
+}
+
 
 static struct IM {
   lua_Type tp;
-  Object int_method[FB_N];
+  Object int_method[IM_N];
- } *luaI_IMtable = NULL;
+} *luaI_IMtable = NULL;
+
 static int IMtable_size = 0;
-static int last_tag = BASE_TAG-1;
+static int last_tag = LUA_T_NIL;
+
+static struct {
+  lua_Type t;
+  int event;
+} exceptions[] = {  /* list of events that cannot be modified */
+    {LUA_T_NUMBER, IM_ARITH},
+    {LUA_T_NUMBER, IM_ORDER},
+    {LUA_T_NUMBER, IM_GC},
+    {LUA_T_STRING, IM_ARITH},
+    {LUA_T_STRING, IM_ORDER},
+    {LUA_T_STRING, IM_CONCAT},
+    {LUA_T_STRING, IM_GC},
+    {LUA_T_ARRAY, IM_GETTABLE},
+    {LUA_T_ARRAY, IM_SETTABLE},
+    {LUA_T_FUNCTION, IM_FUNCTION},
+    {LUA_T_FUNCTION, IM_GC},
+    {LUA_T_CFUNCTION, IM_FUNCTION},
+    {LUA_T_CFUNCTION, IM_GC},
+    {LUA_T_NIL, 0}  /* flag end of list */
+};
+
+
+static int validevent (int t, int event)
+{
+  int i;
+  if (t == LUA_T_NIL)  /* cannot modify any event for nil */
+    return 0;
+  for (i=0; exceptions[i].t != LUA_T_NIL; i++)
+    if (exceptions[i].t == t && exceptions[i].event == event)
+      return 0;
+  return 1;
+}
+
+static void init_entry (int tag)
+{
+  int i;
+  for (i=0; i<IM_N; i++)
+    luaI_IMtable[-tag].int_method[i].ttype = LUA_T_NIL;
+}
+
+void luaI_initfallbacks (void)
+{
+  int i;
+  IMtable_size = NUM_TYPES+10;
+  luaI_IMtable = newvector(IMtable_size, struct IM);
+  for (i=LUA_T_NIL; i<=LUA_T_USERDATA; i++) {
+    luaI_IMtable[-i].tp = (lua_Type)i;
+    init_entry(i);
+  }
+}
 
 int lua_newtag (char *t)
 {
-  int i;
+  --last_tag;
-  ++last_tag;
+  if ((-last_tag) >= IMtable_size)
-  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;
+    luaI_IMtable[-last_tag].tp = LUA_T_ARRAY;
   else if (strcmp(t, "userdata") == 0)
-    luaI_IMtable[last_tag-BASE_TAG].tp = LUA_T_USERDATA;
+    luaI_IMtable[-last_tag].tp = LUA_T_USERDATA;
   else
     lua_error("invalid type for new tag");
-  for (i=0; i<FB_N; i++)
+  init_entry(last_tag);
-    luaI_IMtable[last_tag-BASE_TAG].int_method[i].ttype = LUA_T_NIL;
   return last_tag;
 }
 
-static int validtag (int tag)
+
-{
+#define validtag(tag)  (last_tag <= (tag) && (tag) <= 0)
-  return (BASE_TAG <= tag && tag <= last_tag);
+
-}
 
 static void checktag (int tag)
 {
@@ -238,10 +217,18 @@ static void checktag (int tag)
     lua_error("invalid tag");
 }
 
+lua_Type luaI_typetag (int tag)
+{
+  if (tag >= 0) return LUA_T_USERDATA;
+  else {
+    checktag(tag);
+    return luaI_IMtable[-tag].tp;
+  }
+}
+
 void luaI_settag (int tag, Object *o)
 {
-  checktag(tag);
+  if (ttype(o) != luaI_typetag(tag))
-  if (ttype(o) != luaI_IMtable[tag-BASE_TAG].tp)
     lua_error("Tag is not compatible with this type");
   if (o->ttype == LUA_T_ARRAY)
     o->value.a->htag = tag;
@@ -261,29 +248,123 @@ int luaI_tag (Object *o)
 
 Object *luaI_getim (int tag, int event)
 {
-  if (tag == 0)
+  if (tag > LUA_T_USERDATA)
-    return &luaI_fallBacks[event].function;
+    tag = LUA_T_USERDATA;  /* default for non-registered tags */
-  else if (validtag(tag)) {
+  return &luaI_IMtable[-tag].int_method[event];
-    Object *func = &luaI_IMtable[tag-BASE_TAG].int_method[event];
+}
-    if (func->ttype == LUA_T_NIL)
+
-      return NULL;
+Object *luaI_getimbyObj (Object *o, int event)
-    else
+{
-      return func;
+  return luaI_getim(luaI_tag(o), event);
-  }
-  else return NULL;
 }
 
 void luaI_setintmethod (void)
 {
-  lua_Object tag = lua_getparam(1);
+  int t = (int)luaL_check_number(1, "setintmethod");
-  lua_Object event = lua_getparam(2);
+  int e = luaI_checkevent(luaL_check_string(2, "setintmethod"), eventname);
   lua_Object func = lua_getparam(3);
-  if (!(lua_isnumber(tag) && lua_isstring(event) && lua_isfunction(func)))
+  if (!validevent(t, e))
-    lua_error("incorrect arguments to function `setintmethod'");
+    lua_error("cannot change this internal method");
-  else {
+  luaL_arg_check(lua_isnil(func) || lua_isfunction(func), "setintmethod",
-    int i = luaI_findevent(lua_getstring(event));
+                 3, "function expected");
-    int t = lua_getnumber(tag);
   checktag(t);
-    luaI_IMtable[t-BASE_TAG].int_method[i] = *luaI_Address(func);
+  luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
+}
+
+static Object gmethod[GIM_N] = {
+  {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}
+};
+
+Object *luaI_getgim (int event)
+{
+  return &gmethod[event];
+}
+
+void luaI_setglobalmethod (void)
+{
+  int e = luaI_checkevent(luaL_check_string(1, "setintmethod"), geventname);
+  lua_Object func = lua_getparam(2);
+  luaL_arg_check(lua_isnil(func) || lua_isfunction(func), "setintmethod",
+                 2, "function expected");
+  gmethod[e] = *luaI_Address(func);
+}
+
+char *luaI_travfallbacks (int (*fn)(Object *))
+{ /* ??????????
+  int i;
+  for (i=0; i<N_FB; i++)
+    if (fn(&luaI_fallBacks[i].function))
+      return luaI_fallBacks[i].kind; */
+  return NULL;
+}
+
+
+/*
+* ===================================================================
+* compatibility with old fallback system
+*/
+
+
+static void errorFB (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isstring(o))
+    fprintf (stderr, "lua: %s\n", lua_getstring(o));
+  else
+    fprintf(stderr, "lua: unknown error\n");
+}
+ 
+
+static void nilFB (void) { }
+ 
+
+static void typeFB (void)
+{
+  lua_error("unexpected type");
+}
+
+
+void luaI_setfallback (void)
+{
+  int e;
+  char *name = luaL_check_string(1, "setfallback");
+  lua_Object func = lua_getparam(2);
+  luaL_arg_check(lua_isfunction(func), "setfallback", 2, "function expected");
+  e = luaI_findevent(name, geventname);
+  if (e >= 0) {  /* global event */
+    switch (e) {
+      case GIM_ERROR:
+        gmethod[e] = *luaI_Address(func);
+        lua_pushcfunction(errorFB);
+        break;
+      case GIM_GETGLOBAL:  /* goes through */
+      case GIM_SETGLOBAL:
+        gmethod[e] = *luaI_Address(func);
+        lua_pushcfunction(nilFB);
+        break;
+      default: lua_error("internal error");
+    }
+  }
+  else {  /* tagged name? */
+    int t;
+    Object oldfunc;
+    e = luaI_checkevent(name, eventname);
+    oldfunc = luaI_IMtable[LUA_T_USERDATA].int_method[e];
+    for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
+      if (validevent(t, e))
+        luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
+    if (oldfunc.ttype != LUA_T_NIL)
+      luaI_pushobject(&oldfunc);
+    else {
+      switch (e) {
+       case IM_GC:  case IM_INDEX:
+         lua_pushcfunction(nilFB);
+         break;
+       default:
+         lua_pushcfunction(typeFB);
+         break;
+      }
+    }
   }
 }
+ 

fallback.h

@@ -1,5 +1,5 @@
 /*
-** $Id: fallback.h,v 1.13 1996/04/25 14:10:00 roberto Exp roberto $
+** $Id: fallback.h,v 1.14 1997/02/26 17:38:41 roberto Unstable roberto $
 */
  
 #ifndef fallback_h
@@ -8,24 +8,20 @@
 #include "lua.h"
 #include "opcode.h"
 
-extern struct FB {
+#define IM_GETTABLE  0
-  char *kind;
+#define IM_ARITH  1
-  Object function;
+#define IM_ORDER  2
-  int nParams;
+#define IM_CONCAT  3
-  int nResults;
+#define IM_SETTABLE  4
-} luaI_fallBacks[];
+#define IM_GC 5
+#define IM_FUNCTION 6
+#define IM_INDEX  7
+#define IM_N 8
 
-#define FB_GETTABLE  0
+#define GIM_ERROR 0
-#define FB_ARITH  1
+#define GIM_GETGLOBAL 1
-#define FB_ORDER  2
+#define GIM_SETGLOBAL 2
-#define FB_CONCAT  3
+#define GIM_N 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);
@@ -35,9 +31,14 @@ void luaI_invalidaterefs (void);
 char *luaI_travfallbacks (int (*fn)(Object *));
 
 void luaI_settag (int tag, Object *o);
+lua_Type luaI_typetag (int tag);
 Object *luaI_getim (int tag, int event);
+Object *luaI_getgim (int event);
+Object *luaI_getimbyObj (Object *o, int event);
 int luaI_tag (Object *o);
 void luaI_setintmethod (void);
+void luaI_setglobalmethod (void);
+void luaI_initfallbacks (void);
 
 #endif
 

hash.c

@@ -3,7 +3,7 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.34 1997/02/26 17:38:41 roberto Unstable roberto $";
+char *rcs_hash="$Id: hash.c,v 2.35 1997/03/11 18:44:28 roberto Exp roberto $";
 
 
 #include "mem.h"
@@ -159,7 +159,7 @@ void lua_hashmark (Hash *h)
 }
 
 
-static void call_fallbacks (void)
+void luaI_hashcallIM (void)
 {
   Hash *curr_array;
   Object t;
@@ -168,10 +168,10 @@ static void call_fallbacks (void)
     if (markarray(curr_array) != 1)
     {
       avalue(&t) = curr_array;
-      luaI_gcFB(&t);
+      luaI_gcIM(&t);
     }
   ttype(&t) = LUA_T_NIL;
-  luaI_gcFB(&t);  /* end of list */
+  luaI_gcIM(&t);  /* end of list */
 }
 
  
@@ -183,7 +183,6 @@ Long lua_hashcollector (void)
 {
  Hash *curr_array = listhead, *prev = NULL;
  Long counter = 0;
- call_fallbacks();
  while (curr_array != NULL)
  {
   Hash *next = curr_array->next;

hash.h

@@ -1,7 +1,7 @@
 /*
 ** hash.h
 ** hash manager for lua
-** $Id: hash.h,v 2.12 1996/05/06 14:30:27 roberto Exp roberto $
+** $Id: hash.h,v 2.13 1997/02/26 17:38:41 roberto Unstable roberto $
 */
 
 #ifndef hash_h
@@ -30,6 +30,7 @@ int      luaI_redimension (int nhash);
 Hash    *lua_createarray (int nhash);
 void     lua_hashmark (Hash *h);
 Long     lua_hashcollector (void);
+void	 luaI_hashcallIM (void);
 Object  *lua_hashget (Hash *t, Object *ref);
 Object 	*lua_hashdefine (Hash *t, Object *ref);
 void     lua_next (void);

inout.c

@@ -5,11 +5,12 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.45 1997/03/11 18:44:28 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.46 1997/03/17 17:01:10 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
 
+#include "auxlib.h"
 #include "lex.h"
 #include "opcode.h"
 #include "inout.h"
@@ -322,6 +323,7 @@ static struct {
   {"print", luaI_print},
   {"setfallback", luaI_setfallback},
   {"setintmethod", luaI_setintmethod},
+  {"setglobalmethod", luaI_setglobalmethod},
   {"setglobal", luaI_setglobal},
   {"tonumber", lua_obj2number},
   {"tostring", luaI_tostring},

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.35 1997/02/26 17:38:41 roberto Unstable roberto $
+** $Id: lua.h,v 3.36 1997/03/17 17:01:10 roberto Exp roberto $
 */
 
 
@@ -21,6 +21,7 @@ typedef unsigned int lua_Object;
 
 lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
 void           lua_setintmethod	(int tag, char *event, lua_CFunction method);
+void           lua_setglobalmethod (char *event, lua_CFunction method);
 
 int            lua_newtag		(char *t);
 void           lua_settag		(int tag); /* In: object */
@@ -36,8 +37,9 @@ int	       lua_call			(char *funcname);
 void	       lua_beginblock		(void);
 void	       lua_endblock		(void);
 
-lua_Object     lua_getparam 		(int number);
+lua_Object     lua_lua2C 		(int number);
-#define	       lua_getresult(_)		lua_getparam(_)
+#define	       lua_getparam(_)		lua_lua2C(_)
+#define	       lua_getresult(_)		lua_lua2C(_)
 
 int            lua_isnil                (lua_Object object);
 int            lua_istable              (lua_Object object);
@@ -62,7 +64,9 @@ void           lua_pushusertag     	(void *u, int tag);
 void           lua_pushobject       	(lua_Object object);
 
 lua_Object     lua_getglobal 		(char *name);
+lua_Object     lua_basicgetglobal	(char *name);
 void           lua_storeglobal		(char *name); /* In: value */
+void           lua_basicstoreglobal	(char *name); /* In: value */
 
 void           lua_storesubscript	(void); /* In: table, index, value */
 void           lua_basicstoreindex	(void); /* In: table, index, value */
@@ -90,16 +94,6 @@ lua_Object     lua_createtable		(void);
 #define lua_pushuserdata(u)     lua_pushusertag(u, 0)
 
 
-/* =============================================================== */
-/* Auxiliar functions for libraries */
-
-void luaL_arg_check(int cond, char *funcname, int numarg, char *extramsg);
-char *luaL_check_string (int numArg, char *funcname);
-char *luaL_opt_string (int numArg, char *def, char *funcname);
-double luaL_check_number (int numArg, char *funcname);
-double luaL_opt_number (int numArg, double def, char *funcname);
-
-
 /* =============================================================== */
 /* for compatibility with old versions. Avoid using these macros */
 

opcode.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.83 1997/03/06 17:30:55 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.84 1997/03/11 18:44:28 roberto Exp roberto $";
 
 #include <setjmp.h>
 #include <stdio.h>
@@ -268,15 +268,6 @@ static void callIM (Object *f, int nParams, int nResults)
   do_call((top-stack)-nParams, nResults);
 }
 
-/*
-** Call the specified fallback, putting it on the stack below its arguments
-*/
-static void callFB (int fb)
-{
-  callIM(&luaI_fallBacks[fb].function, luaI_fallBacks[fb].nParams,
-         luaI_fallBacks[fb].nResults);
-}
-
 
 /*
 ** Call a function (C or Lua). The parameters must be on the stack,
@@ -289,21 +280,21 @@ static void do_call (StkId base, int nResults)
   StkId firstResult;
   Object *func = stack+base-1;
   int i;
-  if (ttype(func) == LUA_T_CFUNCTION)
+  if (ttype(func) == LUA_T_CFUNCTION) {
-  {
     ttype(func) = LUA_T_CMARK;
     firstResult = callC(fvalue(func), base);
   }
-  else if (ttype(func) == LUA_T_FUNCTION)
+  else if (ttype(func) == LUA_T_FUNCTION) {
-  {
     ttype(func) = LUA_T_MARK;
     firstResult = lua_execute(func->value.tf->code, base);
   }
-  else
+  else { /* func is not a function */
-  { /* func is not a function */
+    /* Check the fallback for invalid functions */
-    /* Call the fallback for invalid functions */
+    Object *im = luaI_getimbyObj(func, IM_FUNCTION);
+    if (ttype(im) == LUA_T_NIL)
+      lua_error("call expression not a function");
     open_stack((top-stack)-(base-1));
-    stack[base-1] = luaI_fallBacks[FB_FUNCTION].function;
+    stack[base-1] = *im;
     do_call(base, nResults);
     return;
   }
@@ -326,15 +317,14 @@ 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);
+  Object *im = luaI_getim(tg, IM_GETTABLE);
-  if (ttype(top-2) == LUA_T_ARRAY && im == NULL) {
+  if (ttype(top-2) == LUA_T_ARRAY && ttype(im) == LUA_T_NIL) {
       Object *h = lua_hashget(avalue(top-2), top-1);
       if (h != NULL && ttype(h) != LUA_T_NIL) {
         --top;
         *(top-1) = *h;
       }
-      else if (tg == LUA_T_ARRAY &&
+      else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL)
-              (im=luaI_getim(0, FB_INDEX)) != NULL)
         callIM(im, 2, 1);
       else {
         --top;
@@ -376,14 +366,14 @@ lua_Object lua_basicindex (void)
 */
 static void storesubscript (Object *t, int mode)
 {
-  Object *im = (mode == 0) ? NULL : luaI_getim(luaI_tag(t), FB_SETTABLE);
+  Object *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE);
-  if (ttype(t) == LUA_T_ARRAY && im == NULL) {
+  if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
     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 (im && ttype(im) != LUA_T_NIL) {
       if (mode == 2) {
         lua_checkstack(top+2);
         *(top+1) = *(top-1);
@@ -403,11 +393,13 @@ static void getglobal (Word n)
 {
   *top = lua_table[n].object;
   incr_top;
-  if (ttype(top-1) == LUA_T_NIL)
+  if (ttype(top-1) == LUA_T_NIL) {  /* check i.m. */
-  { /* must call getglobal fallback */
+    Object *im = luaI_getgim(GIM_GETGLOBAL);
+    if (ttype(im) != LUA_T_NIL) {
       ttype(top-1) = LUA_T_STRING;
       tsvalue(top-1) = lua_table[n].varname;
-    callFB(FB_GETGLOBAL);
+      callIM(im, 1, 1);
+    }
   }
 }
 
@@ -428,8 +420,13 @@ void lua_travstack (int (*fn)(Object *))
 
 static void lua_message (char *s)
 {
+  Object *im = luaI_getgim(GIM_ERROR);
+  if (ttype(im) == LUA_T_NIL)
+    fprintf(stderr, "lua: %s\n", s);
+  else {
     lua_pushstring(s);
-  callFB(FB_ERROR);
+    callIM(im, 1, 0);
+  }
 }
 
 /*
@@ -659,10 +656,20 @@ void lua_setintmethod (int tag, char *event, lua_CFunction method)
 {
   lua_pushnumber(tag);
   lua_pushstring(event);
+  if (method)
     lua_pushcfunction (method);
+  else
+    lua_pushnil();
   do_unprotectedrun(luaI_setintmethod, 3, 0);
 }
 
+void lua_setglobalmethod (char *event, lua_CFunction method)
+{
+  lua_pushstring(event);
+  lua_pushcfunction (method);
+  do_unprotectedrun(luaI_setglobalmethod, 3, 0);
+}
+
 
 /* 
 ** API: receives on the stack the table and the index.
@@ -741,7 +748,7 @@ lua_Object lua_createtable (void)
 ** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
 ** 'number' must be 1 to get the first parameter.
 */
-lua_Object lua_getparam (int number)
+lua_Object lua_lua2C (int number)
 {
  if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT;
  /* Ref(stack+(CLS_current.base-CLS_current.num+number-1)) ==
@@ -874,6 +881,17 @@ lua_Object lua_getglobal (char *name)
  return Ref(top-1);
 }
 
+
+lua_Object lua_basicgetglobal (char *name)
+{
+  adjustC(0);
+  *top = lua_table[luaI_findsymbolbyname(name)].object;
+  incr_top;
+  CLS_current.base++;  /* incorporate object in the stack */
+  return Ref(top-1);
+}
+
+
 /*
 ** Store top of the stack at a global variable array field.
 */
@@ -944,7 +962,7 @@ void lua_pushbinarydata (void *buff, int size, int tag)
 */
 void lua_pushusertag (void *u, int tag)
 {
-  if (tag < LUA_T_USERDATA) 
+  if (luaI_typetag(tag) != LUA_T_USERDATA)
     lua_error("invalid tag in `lua_pushusertag'");
   lua_pushbinarydata(&u, sizeof(void *), tag);
 }
@@ -977,18 +995,47 @@ int lua_tag (lua_Object o)
 }
 
 
-void luaI_gcFB (Object *o)
+void luaI_gcIM (Object *o)
 {
+  Object *im = luaI_getimbyObj(o, IM_GC);
+  if (ttype(im) != LUA_T_NIL) {
     *top = *o;
     incr_top;
-  callFB(FB_GC);
+    callIM(im, 1, 0);
+  }
 }
 
 
 static void call_arith (char *op)
 {
+  Object *im = luaI_getimbyObj(top-2, IM_ARITH);  /* try first operand */
+  if (ttype(im) == LUA_T_NIL) {
+    im = luaI_getimbyObj(top-1, IM_ARITH);  /* try second operand */
+    if (ttype(im) == LUA_T_NIL) {
+      im = luaI_getim(0, IM_ARITH);  /* try a 'global' i.m. */
+      if (ttype(im) == LUA_T_NIL)
+        lua_error("unexpected type at conversion to number");
+    }
+  }
   lua_pushstring(op);
-  callFB(FB_ARITH);
+  callIM(im, 3, 1);
+}
+
+static void concim (Object *o)
+{
+  Object *im = luaI_getimbyObj(o, IM_CONCAT);
+  if (ttype(im) == LUA_T_NIL)
+    lua_error("unexpected type at conversion to string");
+  callIM(im, 2, 1);
+}
+
+static void ordim (Object *o, char *op)
+{
+  Object *im = luaI_getimbyObj(o, IM_ORDER);
+  if (ttype(im) == LUA_T_NIL)
+    lua_error("unexpected type at comparison");
+  lua_pushstring(op);
+  callIM(im, 3, 1);
 }
 
 static void comparison (lua_Type ttype_less, lua_Type ttype_equal, 
@@ -999,10 +1046,12 @@ static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
   int result;
   if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
     result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
-  else if (tostring(l) || tostring(r))
+  else if (tostring(l)) {
-  {
+    ordim(l, op);
-    lua_pushstring(op);
+    return;
-    callFB(FB_ORDER);
+  }
+  else if (tostring(r)) {
+    ordim(r, op);
     return;
   }
   else
@@ -1318,15 +1367,15 @@ static StkId lua_execute (Byte *pc, StkId base)
     call_arith("pow");
     break;
 
-   case CONCOP:
+   case CONCOP: {
-   {
      Object *l = top-2;
      Object *r = top-1;
-    if (tostring(r) || tostring(l))
+     if (tostring(l))  /* first argument is not a string */
-      callFB(FB_CONCAT);
+       concim(l);
-    else
+     else if (tostring(r))  /* second argument is not a string */
-    {
+       concim(r);
-      tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
+     else {
+       tsvalue(l) = lua_createstring(lua_strconc(svalue(l),svalue(r)));
        --top;
      }
    }

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.27 1997/03/06 17:30:55 roberto Exp roberto $
+** $Id: opcode.h,v 3.28 1997/03/11 18:44:28 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -16,18 +16,20 @@
 
 typedef enum
 {
- LUA_T_NIL      = -1,
+ LUA_T_NIL      = -9,
- LUA_T_NUMBER   = -2,
+ LUA_T_NUMBER   = -8,
- LUA_T_STRING   = -3,
+ LUA_T_STRING   = -7,
- LUA_T_ARRAY    = -4,  /* array==table */
+ LUA_T_ARRAY    = -6,  /* array==table */
  LUA_T_FUNCTION = -5,
- LUA_T_CFUNCTION= -6,
+ LUA_T_CFUNCTION= -4,
- LUA_T_MARK     = -7,
+ LUA_T_MARK     = -3,
- LUA_T_CMARK    = -8,
+ LUA_T_CMARK    = -2,
- LUA_T_LINE     = -9,
+ LUA_T_LINE     = -1,
  LUA_T_USERDATA = 0
 } lua_Type;
 
+#define NUM_TYPES 10
+
 
 typedef enum {
 /* name          parm    before          after           side effect
@@ -156,7 +158,7 @@ void	luaI_codedebugline (int line);  /* from "lua.stx" module */
 void    lua_travstack (int (*fn)(Object *));
 Object *luaI_Address (lua_Object o);
 void	luaI_pushobject (Object *o);
-void    luaI_gcFB       (Object *o);
+void    luaI_gcIM       (Object *o);
 int     luaI_dorun (TFunc *tf);
 
 #endif

table.c

@@ -3,7 +3,7 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.59 1997/02/26 17:38:41 roberto Unstable roberto $";
+char *rcs_table="$Id: table.c,v 2.60 1997/03/11 18:44:28 roberto Exp roberto $";
 
 #include "mem.h"
 #include "opcode.h"
@@ -168,6 +168,8 @@ Long luaI_collectgarbage (void)
   lua_travsymbol(lua_markobject); /* mark symbol table objects */
   luaI_travlock(lua_markobject); /* mark locked objects */
   luaI_travfallbacks(lua_markobject);  /* mark fallbacks */
+  luaI_hashcallIM();
+  luaI_strcallIM();
   luaI_invalidaterefs();
   recovered += lua_strcollector();
   recovered += lua_hashcollector();

tree.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: tree.c,v 1.20 1996/03/14 15:56:26 roberto Exp roberto $";
+char *rcs_tree="$Id: tree.c,v 1.21 1997/02/11 11:35:05 roberto Exp roberto $";
 
 
 #include <string.h>
@@ -14,6 +14,7 @@ char *rcs_tree="$Id: tree.c,v 1.20 1996/03/14 15:56:26 roberto Exp roberto $";
 #include "lex.h"
 #include "hash.h"
 #include "table.h"
+#include "fallback.h"
 
 
 #define NUM_HASHS  64
@@ -45,6 +46,7 @@ static void initialize (void)
   luaI_addReserved();
   luaI_initsymbol();
   luaI_initconstant();
+  luaI_initfallbacks();
 }
 
 
@@ -120,6 +122,25 @@ TaggedString *lua_createstring (char *str)
 }
 
 
+void luaI_strcallIM (void)
+{
+  int i;
+  Object o;
+  ttype(&o) = LUA_T_USERDATA;
+  for (i=0; i<NUM_HASHS; i++) {
+    stringtable *tb = &string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++) {
+      TaggedString *t = tb->hash[j];
+      if (t != NULL && t->tag != LUA_T_STRING && t->marked == 0) {
+        tsvalue(&o) = t;
+        luaI_gcIM(&o);
+      }
+    }
+  }
+}
+
+
 /*
 ** Garbage collection function.
 ** This function traverse the string list freeing unindexed strings

tree.h

@@ -1,7 +1,7 @@
 /*
 ** tree.h
 ** TecCGraf - PUC-Rio
-** $Id: tree.h,v 1.14 1996/02/26 17:07:49 roberto Exp roberto $
+** $Id: tree.h,v 1.15 1997/02/11 11:35:05 roberto Exp roberto $
 */
 
 #ifndef tree_h
@@ -27,5 +27,6 @@ typedef struct TaggedString
 TaggedString *lua_createstring (char *str);
 TaggedString *luaI_createuserdata (char *buff, long size, int tag);
 Long lua_strcollector (void);
+void luaI_strcallIM (void);
 
 #endif