external/mit/lua/dist/src/ltm.c

   1 /*      $NetBSD: ltm.c,v 1.4 2015/10/08 13:21:00 mbalmer Exp $  */
   2
   3 /*
   4 ** Id: ltm.c,v 2.34 2015/03/30 15:42:27 roberto Exp
   5 ** Tag methods
   6 ** See Copyright Notice in lua.h
   7 */
   8
   9 #define ltm_c
  10 #define LUA_CORE
  11
  12 #include "lprefix.h"
  13
  14
  15 #ifndef _KERNEL
  16 #include <string.h>
  17 #endif
  18
  19 #include "lua.h"
  20
  21 #include "ldebug.h"
  22 #include "ldo.h"
  23 #include "lobject.h"
  24 #include "lstate.h"
  25 #include "lstring.h"
  26 #include "ltable.h"
  27 #include "ltm.h"
  28 #include "lvm.h"
  29
  30
  31 static const char udatatypename[] = "userdata";
  32
  33 LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTAGS] = {
  34   "no value",
  35   "nil", "boolean", udatatypename, "number",
  36   "string", "table", "function", udatatypename, "thread",
  37   "proto" /* this last case is used for tests only */
  38 };
  39
  40
  41 void luaT_init (lua_State *L) {
  42   static const char *const luaT_eventname[] = {  /* ORDER TM */
  43     "__index", "__newindex",
  44     "__gc", "__mode", "__len", "__eq",
  45 #ifndef _KERNEL
  46     "__add", "__sub", "__mul", "__mod", "__pow",
  47     "__div", "__idiv",
  48 #else
  49     "__add", "__sub", "__mul", "__mod",
  50     "__idiv",
  51 #endif
  52     "__band", "__bor", "__bxor", "__shl", "__shr",
  53     "__unm", "__bnot", "__lt", "__le",
  54     "__concat", "__call"
  55   };
  56   int i;
  57   for (i=0; i<TM_N; i++) {
  58     G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
  59     luaC_fix(L, obj2gco(G(L)->tmname[i]));  /* never collect these names */
  60   }
  61 }
  62
  63
  64 /*
  65 ** function to be used with macro "fasttm": optimized for absence of
  66 ** tag methods
  67 */
  68 const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
  69   const TValue *tm = luaH_getstr(events, ename);
  70   lua_assert(event <= TM_EQ);
  71   if (ttisnil(tm)) {  /* no tag method? */
  72     events->flags |= cast_byte(1u<<event);  /* cache this fact */
  73     return NULL;
  74   }
  75   else return tm;
  76 }
  77
  78
  79 const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
  80   Table *mt;
  81   switch (ttnov(o)) {
  82     case LUA_TTABLE:
  83       mt = hvalue(o)->metatable;
  84       break;
  85     case LUA_TUSERDATA:
  86       mt = uvalue(o)->metatable;
  87       break;
  88     default:
  89       mt = G(L)->mt[ttnov(o)];
  90   }
  91   return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject);
  92 }
  93
  94
  95 void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
  96                   const TValue *p2, TValue *p3, int hasres) {
  97   ptrdiff_t result = savestack(L, p3);
  98   setobj2s(L, L->top++, f);  /* push function (assume EXTRA_STACK) */
  99   setobj2s(L, L->top++, p1);  /* 1st argument */
 100   setobj2s(L, L->top++, p2);  /* 2nd argument */
 101   if (!hasres)  /* no result? 'p3' is third argument */
 102     setobj2s(L, L->top++, p3);  /* 3rd argument */
 103   /* metamethod may yield only when called from Lua code */
 104   luaD_call(L, L->top - (4 - hasres), hasres, isLua(L->ci));
 105   if (hasres) {  /* if has result, move it to its place */
 106     p3 = restorestack(L, result);
 107     setobjs2s(L, p3, --L->top);
 108   }
 109 }
 110
 111
 112 int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
 113                     StkId res, TMS event) {
 114   const TValue *tm = luaT_gettmbyobj(L, p1, event);  /* try first operand */
 115   if (ttisnil(tm))
 116     tm = luaT_gettmbyobj(L, p2, event);  /* try second operand */
 117   if (ttisnil(tm)) return 0;
 118   luaT_callTM(L, tm, p1, p2, res, 1);
 119   return 1;
 120 }
 121
 122
 123 void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
 124                     StkId res, TMS event) {
 125   if (!luaT_callbinTM(L, p1, p2, res, event)) {
 126     switch (event) {
 127       case TM_CONCAT:
 128         luaG_concaterror(L, p1, p2);
 129       /* call never returns, but to avoid warnings: *//* FALLTHROUGH */
 130       case TM_BAND: case TM_BOR: case TM_BXOR:
 131       case TM_SHL: case TM_SHR: case TM_BNOT: {
 132         lua_Number dummy;
 133         if (tonumber(p1, &dummy) && tonumber(p2, &dummy))
 134           luaG_tointerror(L, p1, p2);
 135         else
 136           luaG_opinterror(L, p1, p2, "perform bitwise operation on");
 137       }
 138       /* calls never return, but to avoid warnings: *//* FALLTHROUGH */
 139       default:
 140         luaG_opinterror(L, p1, p2, "perform arithmetic on");
 141     }
 142   }
 143 }
 144
 145
 146 int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
 147                       TMS event) {
 148   if (!luaT_callbinTM(L, p1, p2, L->top, event))
 149     return -1;  /* no metamethod */
 150   else
 151     return !l_isfalse(L->top);
 152 }
 153