i.m. "arith" and "order" splited for different operations

fallback.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.28 1997/03/19 19:41:10 roberto Exp roberto $";
+char *rcs_fallback="$Id: fallback.c,v 1.29 1997/03/19 21:12:34 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -18,6 +18,19 @@ char *rcs_fallback="$Id: fallback.c,v 1.28 1997/03/19 19:41:10 roberto Exp rober
 #include "hash.h"
 
 
+static char *typenames[] = { /* ORDER LUA_T */
+  "userdata", "line", "cmark", "mark", "function",
+  "function", "table", "string", "number", "nil",
+  NULL
+};
+
+
+void luaI_type (void)
+{
+  lua_Object o = lua_getparam(1);
+  lua_pushstring(typenames[-ttype(luaI_Address(o))]);
+  lua_pushnumber(lua_tag(o));
+}
 
 
 /* -------------------------------------------
@@ -94,27 +107,19 @@ void luaI_invalidaterefs (void)
 * Internal Methods 
 */
 
-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 */
+char *luaI_eventname[] = {  /* ORDER IM */
+  "gettable", "settable", "index", "add", "sub", "mul", "div",
+  "pow", "unm", "lt", "le", "gt", "ge", "concat", "gc", "function",
   NULL
 };
 
 
-char *geventname[] = {
-  "error",  /* GIM_ERROR */
-  "getglobal",  /* GIM_GETGLOBAL */
-  "setglobal",  /* GIM_SETGLOBAL */
+static char *geventname[] = {  /* ORDER GIM */
+  "error", "getglobal", "setglobal",
   NULL
 };
 
-static int luaI_findevent (char *name, char *list[])
+static int findstring (char *name, char *list[])
 {
   int i;
   for (i=0; list[i]; i++)
@@ -126,7 +131,7 @@ static int luaI_findevent (char *name, char *list[])
 
 static int luaI_checkevent (char *name, char *list[])
 {
-  int e = luaI_findevent(name, list);
+  int e = findstring(name, list);
   if (e < 0)
     lua_error("invalid event name");
   return e;
@@ -141,38 +146,25 @@ static struct IM {
 static int IMtable_size = 0;
 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 char validevents[NUM_TYPES][IM_N] = { /* ORDER LUA_T, ORDER IM */
+{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_USERDATA */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* LUA_T_LINE */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* LUA_T_CMARK */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* LUA_T_MARK */
+{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CFUNCTION */
+{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_FUNCTION */
+{0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_ARRAY */
+{1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
+{1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1},  /* LUA_T_NUMBER */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}   /* LUA_T_NIL */
 };
 
-
-static int validevent (int t, int event)
+static int validevent (lua_Type t, int e)
 {
-  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;
+  return (t < LUA_T_NIL) ?  1 : validevents[-t][e];
 }
 
+
 static void init_entry (int tag)
 {
   int i;
@@ -193,14 +185,14 @@ void luaI_initfallbacks (void)
 
 int lua_newtag (char *t)
 {
+  int tp;
   --last_tag;
   if ((-last_tag) >= IMtable_size)
     IMtable_size = growvector(&luaI_IMtable, IMtable_size,
                               struct IM, memEM, MAX_INT);
-  if (strcmp(t, "table") == 0)
-    luaI_IMtable[-last_tag].tp = LUA_T_ARRAY;
-  else if (strcmp(t, "userdata") == 0)
-    luaI_IMtable[-last_tag].tp = LUA_T_USERDATA;
+  tp = -findstring(t, typenames);
+  if (tp == LUA_T_ARRAY || tp == LUA_T_USERDATA)
+    luaI_IMtable[-last_tag].tp = tp;
   else
     lua_error("invalid type for new tag");
   init_entry(last_tag);
@@ -246,14 +238,14 @@ int luaI_tag (Object *o)
   else return t;
 }
 
-Object *luaI_getim (int tag, int event)
+Object *luaI_getim (int tag, IMS event)
 {
   if (tag > LUA_T_USERDATA)
     tag = LUA_T_USERDATA;  /* default for non-registered tags */
   return &luaI_IMtable[-tag].int_method[event];
 }
 
-Object *luaI_getimbyObj (Object *o, int event)
+Object *luaI_getimbyObj (Object *o, IMS event)
 {
   return luaI_getim(luaI_tag(o), event);
 }
@@ -261,13 +253,13 @@ Object *luaI_getimbyObj (Object *o, int event)
 void luaI_setintmethod (void)
 {
   int t = (int)luaL_check_number(1, "setintmethod");
-  int e = luaI_checkevent(luaL_check_string(2, "setintmethod"), eventname);
+  int e = luaI_checkevent(luaL_check_string(2, "setintmethod"), luaI_eventname);
   lua_Object func = lua_getparam(3);
+  checktag(t);
   if (!validevent(t, e))
     lua_error("cannot change this internal method");
   luaL_arg_check(lua_isnil(func) || lua_isfunction(func), "setintmethod",
                  3, "function expected");
-  checktag(t);
   luaI_pushobject(&luaI_IMtable[-t].int_method[e]);
   luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
 }
@@ -276,7 +268,7 @@ static Object gmethod[GIM_N] = {
   {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}
 };
 
-Object *luaI_getgim (int event)
+Object *luaI_getgim (IMGS event)
 {
   return &gmethod[event];
 }
@@ -326,47 +318,54 @@ static void typeFB (void)
 }
 
 
+static void fillvalids (IMS e, Object *func)
+{
+  int t;
+  for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
+    if (validevent(t, e))
+      luaI_IMtable[-t].int_method[e] = *func;
+}
+
 void luaI_setfallback (void)
 {
   int e;
+  Object oldfunc;
+  lua_CFunction replace;
   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);
+  e = findstring(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");
-    }
+    oldfunc = gmethod[e];
+    gmethod[e] = *luaI_Address(func);
+    replace = (e == GIM_ERROR) ? errorFB : nilFB;
   }
-  else {  /* tagged name? */
-    int t;
-    Object oldfunc;
-    e = luaI_checkevent(name, eventname);
+  else if ((e = findstring(name, luaI_eventname)) >= 0) {
     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;
-      }
-    }
+    fillvalids(e, luaI_Address(func));
+    replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
   }
+  else if (strcmp(name, "arith") == 0) {  /* old arith fallback */
+    int i;
+    oldfunc = luaI_IMtable[LUA_T_USERDATA].int_method[IM_ADD];
+    for (i=IM_ADD; i<=IM_UNM; i++)  /* ORDER IM */
+      fillvalids(i, luaI_Address(func));
+    replace = typeFB;
+  }
+  else if (strcmp(name, "order") == 0) {  /* old order fallback */
+    int i;
+    oldfunc = luaI_IMtable[LUA_T_USERDATA].int_method[IM_LT];
+    for (i=IM_LT; i<=IM_GE; i++)  /* ORDER IM */
+      fillvalids(i, luaI_Address(func));
+    replace = typeFB;
+  }
+  else {
+    lua_error("invalid fallback name");
+    replace = NULL;  /* to avoid warnings */
+  }
+  if (oldfunc.ttype != LUA_T_NIL)
+    luaI_pushobject(&oldfunc);
+  else
+    lua_pushcfunction(replace);
 }
  

fallback.h

@@ -1,5 +1,5 @@
 /*
-** $Id: fallback.h,v 1.14 1997/02/26 17:38:41 roberto Unstable roberto $
+** $Id: fallback.h,v 1.15 1997/03/19 19:41:10 roberto Exp roberto $
 */
  
 #ifndef fallback_h
@@ -8,19 +8,44 @@
 #include "lua.h"
 #include "opcode.h"
 
-#define IM_GETTABLE  0
-#define IM_ARITH  1
-#define IM_ORDER  2
-#define IM_CONCAT  3
-#define IM_SETTABLE  4
-#define IM_GC 5
-#define IM_FUNCTION 6
-#define IM_INDEX  7
-#define IM_N 8
-
-#define GIM_ERROR 0
-#define GIM_GETGLOBAL 1
-#define GIM_SETGLOBAL 2
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER IM"
+*/
+typedef enum {
+  IM_GETTABLE = 0,
+  IM_SETTABLE,
+  IM_INDEX,
+  IM_ADD,
+  IM_SUB,
+  IM_MUL,
+  IM_DIV,
+  IM_POW,
+  IM_UNM,
+  IM_LT,
+  IM_LE,
+  IM_GT,
+  IM_GE,
+  IM_CONCAT,
+  IM_GC,
+  IM_FUNCTION
+} IMS;
+
+#define IM_N 16
+
+extern char *luaI_eventname[];
+
+
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER GIM"
+*/
+typedef enum {
+  GIM_ERROR = 0,
+  GIM_GETGLOBAL,
+  GIM_SETGLOBAL
+} IMGS;
+
 #define GIM_N 3
 
 void luaI_setfallback (void);
@@ -30,11 +55,12 @@ void luaI_travlock (int (*fn)(Object *));
 void luaI_invalidaterefs (void);
 char *luaI_travfallbacks (int (*fn)(Object *));
 
+void luaI_type (void);
 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);
+Object *luaI_getim (int tag, IMS event);
+Object *luaI_getgim (IMGS event);
+Object *luaI_getimbyObj (Object *o, IMS event);
 int luaI_tag (Object *o);
 void luaI_setintmethod (void);
 void luaI_setglobalmethod (void);

opcode.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.84 1997/03/11 18:44:28 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.85 1997/03/19 19:41:10 roberto Exp roberto $";
 
 #include <setjmp.h>
 #include <stdio.h>
@@ -1006,18 +1006,18 @@ void luaI_gcIM (Object *o)
 }
 
 
-static void call_arith (char *op)
+static void call_arith (IMS event)
 {
-  Object *im = luaI_getimbyObj(top-2, IM_ARITH);  /* try first operand */
+  Object *im = luaI_getimbyObj(top-2, event);  /* try first operand */
   if (ttype(im) == LUA_T_NIL) {
-    im = luaI_getimbyObj(top-1, IM_ARITH);  /* try second operand */
+    im = luaI_getimbyObj(top-1, event);  /* try second operand */
     if (ttype(im) == LUA_T_NIL) {
-      im = luaI_getim(0, IM_ARITH);  /* try a 'global' i.m. */
+      im = luaI_getim(0, event);  /* try a 'global' i.m. */
       if (ttype(im) == LUA_T_NIL)
         lua_error("unexpected type at conversion to number");
     }
   }
-  lua_pushstring(op);
+  lua_pushstring(luaI_eventname[event]);
   callIM(im, 3, 1);
 }
 
@@ -1029,17 +1029,17 @@ static void concim (Object *o)
   callIM(im, 2, 1);
 }
 
-static void ordim (Object *o, char *op)
+static void ordim (Object *o, IMS event)
 {
-  Object *im = luaI_getimbyObj(o, IM_ORDER);
+  Object *im = luaI_getimbyObj(o, event);
   if (ttype(im) == LUA_T_NIL)
     lua_error("unexpected type at comparison");
-  lua_pushstring(op);
+  lua_pushstring(luaI_eventname[event]);
   callIM(im, 3, 1);
 }
 
 static void comparison (lua_Type ttype_less, lua_Type ttype_equal, 
-                        lua_Type ttype_great, char *op)
+                        lua_Type ttype_great, IMS op)
 {
   Object *l = top-2;
   Object *r = top-1;
@@ -1292,19 +1292,19 @@ static StkId lua_execute (Byte *pc, StkId base)
    break;
 
     case LTOP:
-      comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, "lt");
+      comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
       break;
 
    case LEOP:
-      comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "le");
+      comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
       break;
 
    case GTOP:
-      comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, "gt");
+      comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
       break;
 
    case GEOP:
-      comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, "ge");
+      comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
       break;
 
    case ADDOP:
@@ -1312,7 +1312,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *l = top-2;
     Object *r = top-1;
     if (tonumber(r) || tonumber(l))
-      call_arith("add");
+      call_arith(IM_ADD);
     else
     {
       nvalue(l) += nvalue(r);
@@ -1326,7 +1326,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *l = top-2;
     Object *r = top-1;
     if (tonumber(r) || tonumber(l))
-      call_arith("sub");
+      call_arith(IM_SUB);
     else
     {
       nvalue(l) -= nvalue(r);
@@ -1340,7 +1340,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *l = top-2;
     Object *r = top-1;
     if (tonumber(r) || tonumber(l))
-      call_arith("mul");
+      call_arith(IM_MUL);
     else
     {
       nvalue(l) *= nvalue(r);
@@ -1354,7 +1354,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *l = top-2;
     Object *r = top-1;
     if (tonumber(r) || tonumber(l))
-      call_arith("div");
+      call_arith(IM_DIV);
     else
     {
       nvalue(l) /= nvalue(r);
@@ -1364,7 +1364,7 @@ static StkId lua_execute (Byte *pc, StkId base)
    break;
 
    case POWOP:
-    call_arith("pow");
+    call_arith(IM_POW);
     break;
 
    case CONCOP: {
@@ -1386,7 +1386,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     {
       ttype(top) = LUA_T_NIL;
       incr_top;
-      call_arith("unm");
+      call_arith(IM_UNM);
     }
     else
       nvalue(top-1) = - nvalue(top-1);

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.28 1997/03/11 18:44:28 roberto Exp roberto $
+** $Id: opcode.h,v 3.29 1997/03/19 19:41:10 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -14,6 +14,10 @@
 
 #define FIELDS_PER_FLUSH 40
 
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER LUA_T"
+*/
 typedef enum
 {
  LUA_T_NIL      = -9,