nanocoat/lib/3rdparty/lua/ltm.c

   1 /*
   2 ** $Id: ltm.c $
   3 ** Tag methods
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7 #define ltm_c
   8 #define LUA_CORE
   9
  10 #include "lprefix.h"
  11
  12
  13 #include <string.h>
  14
  15 #include "lua.h"
  16
  17 #include "ldebug.h"
  18 #include "ldo.h"
  19 #include "lgc.h"
  20 #include "lobject.h"
  21 #include "lstate.h"
  22 #include "lstring.h"
  23 #include "ltable.h"
  24 #include "ltm.h"
  25 #include "lvm.h"
  26
  27
  28 static const char udatatypename[] = "userdata";
  29
  30 LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTYPES] = {
  31   "no value",
  32   "nil", "boolean", udatatypename, "number",
  33   "string", "table", "function", udatatypename, "thread",
  34   "upvalue", "proto" /* these last cases are used for tests only */
  35 };
  36
  37
  38 void luaT_init (lua_State *L) {
  39   static const char *const luaT_eventname[] = {  /* ORDER TM */
  40     "__index", "__newindex",
  41     "__gc", "__mode", "__len", "__eq",
  42     "__add", "__sub", "__mul", "__mod", "__pow",
  43     "__div", "__idiv",
  44     "__band", "__bor", "__bxor", "__shl", "__shr",
  45     "__unm", "__bnot", "__lt", "__le",
  46     "__concat", "__call", "__close"
  47   };
  48   int i;
  49   for (i=0; i<TM_N; i++) {
  50     G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
  51     luaC_fix(L, obj2gco(G(L)->tmname[i]));  /* never collect these names */
  52   }
  53 }
  54
  55
  56 /*
  57 ** function to be used with macro "fasttm": optimized for absence of
  58 ** tag methods
  59 */
  60 const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
  61   const TValue *tm = luaH_getshortstr(events, ename);
  62   lua_assert(event <= TM_EQ);
  63   if (notm(tm)) {  /* no tag method? */
  64     events->flags |= cast_byte(1u<<event);  /* cache this fact */
  65     return NULL;
  66   }
  67   else return tm;
  68 }
  69
  70
  71 const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
  72   Table *mt;
  73   switch (ttype(o)) {
  74     case LUA_TTABLE:
  75       mt = hvalue(o)->metatable;
  76       break;
  77     case LUA_TUSERDATA:
  78       mt = uvalue(o)->metatable;
  79       break;
  80     default:
  81       mt = G(L)->mt[ttype(o)];
  82   }
  83   return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue);
  84 }
  85
  86
  87 /*
  88 ** Return the name of the type of an object. For tables and userdata
  89 ** with metatable, use their '__name' metafield, if present.
  90 */
  91 const char *luaT_objtypename (lua_State *L, const TValue *o) {
  92   Table *mt;
  93   if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) ||
  94       (ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) {
  95     const TValue *name = luaH_getshortstr(mt, luaS_new(L, "__name"));
  96     if (ttisstring(name))  /* is '__name' a string? */
  97       return getstr(tsvalue(name));  /* use it as type name */
  98   }
  99   return ttypename(ttype(o));  /* else use standard type name */
 100 }
 101
 102
 103 void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
 104                   const TValue *p2, const TValue *p3) {
 105   StkId func = L->top.p;
 106   setobj2s(L, func, f);  /* push function (assume EXTRA_STACK) */
 107   setobj2s(L, func + 1, p1);  /* 1st argument */
 108   setobj2s(L, func + 2, p2);  /* 2nd argument */
 109   setobj2s(L, func + 3, p3);  /* 3rd argument */
 110   L->top.p = func + 4;
 111   /* metamethod may yield only when called from Lua code */
 112   if (isLuacode(L->ci))
 113     luaD_call(L, func, 0);
 114   else
 115     luaD_callnoyield(L, func, 0);
 116 }
 117
 118
 119 void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
 120                      const TValue *p2, StkId res) {
 121   ptrdiff_t result = savestack(L, res);
 122   StkId func = L->top.p;
 123   setobj2s(L, func, f);  /* push function (assume EXTRA_STACK) */
 124   setobj2s(L, func + 1, p1);  /* 1st argument */
 125   setobj2s(L, func + 2, p2);  /* 2nd argument */
 126   L->top.p += 3;
 127   /* metamethod may yield only when called from Lua code */
 128   if (isLuacode(L->ci))
 129     luaD_call(L, func, 1);
 130   else
 131     luaD_callnoyield(L, func, 1);
 132   res = restorestack(L, result);
 133   setobjs2s(L, res, --L->top.p);  /* move result to its place */
 134 }
 135
 136
 137 static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
 138                       StkId res, TMS event) {
 139   const TValue *tm = luaT_gettmbyobj(L, p1, event);  /* try first operand */
 140   if (notm(tm))
 141     tm = luaT_gettmbyobj(L, p2, event);  /* try second operand */
 142   if (notm(tm)) return 0;
 143   luaT_callTMres(L, tm, p1, p2, res);
 144   return 1;
 145 }
 146
 147
 148 void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
 149                     StkId res, TMS event) {
 150   if (l_unlikely(!callbinTM(L, p1, p2, res, event))) {
 151     switch (event) {
 152       case TM_BAND: case TM_BOR: case TM_BXOR:
 153       case TM_SHL: case TM_SHR: case TM_BNOT: {
 154         if (ttisnumber(p1) && ttisnumber(p2))
 155           luaG_tointerror(L, p1, p2);
 156         else
 157           luaG_opinterror(L, p1, p2, "perform bitwise operation on");
 158       }
 159       /* calls never return, but to avoid warnings: *//* FALLTHROUGH */
 160       default:
 161         luaG_opinterror(L, p1, p2, "perform arithmetic on");
 162     }
 163   }
 164 }
 165
 166
 167 void luaT_tryconcatTM (lua_State *L) {
 168   StkId top = L->top.p;
 169   if (l_unlikely(!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2,
 170                                TM_CONCAT)))
 171     luaG_concaterror(L, s2v(top - 2), s2v(top - 1));
 172 }
 173
 174
 175 void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
 176                                        int flip, StkId res, TMS event) {
 177   if (flip)
 178     luaT_trybinTM(L, p2, p1, res, event);
 179   else
 180     luaT_trybinTM(L, p1, p2, res, event);
 181 }
 182
 183
 184 void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
 185                                    int flip, StkId res, TMS event) {
 186   TValue aux;
 187   setivalue(&aux, i2);
 188   luaT_trybinassocTM(L, p1, &aux, flip, res, event);
 189 }
 190
 191
 192 /*
 193 ** Calls an order tag method.
 194 ** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old
 195 ** behavior: if there is no '__le', try '__lt', based on l <= r iff
 196 ** !(r < l) (assuming a total order). If the metamethod yields during
 197 ** this substitution, the continuation has to know about it (to negate
 198 ** the result of r<l); bit CIST_LEQ in the call status keeps that
 199 ** information.
 200 */
 201 int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
 202                       TMS event) {
 203   if (callbinTM(L, p1, p2, L->top.p, event))  /* try original event */
 204     return !l_isfalse(s2v(L->top.p));
 205 #if defined(LUA_COMPAT_LT_LE)
 206   else if (event == TM_LE) {
 207       /* try '!(p2 < p1)' for '(p1 <= p2)' */
 208       L->ci->callstatus |= CIST_LEQ;  /* mark it is doing 'lt' for 'le' */
 209       if (callbinTM(L, p2, p1, L->top.p, TM_LT)) {
 210         L->ci->callstatus ^= CIST_LEQ;  /* clear mark */
 211         return l_isfalse(s2v(L->top.p));
 212       }
 213       /* else error will remove this 'ci'; no need to clear mark */
 214   }
 215 #endif
 216   luaG_ordererror(L, p1, p2);  /* no metamethod found */
 217   return 0;  /* to avoid warnings */
 218 }
 219
 220
 221 int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
 222                        int flip, int isfloat, TMS event) {
 223   TValue aux; const TValue *p2;
 224   if (isfloat) {
 225     setfltvalue(&aux, cast_num(v2));
 226   }
 227   else
 228     setivalue(&aux, v2);
 229   if (flip) {  /* arguments were exchanged? */
 230     p2 = p1; p1 = &aux;  /* correct them */
 231   }
 232   else
 233     p2 = &aux;
 234   return luaT_callorderTM(L, p1, p2, event);
 235 }
 236
 237
 238 void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
 239                          const Proto *p) {
 240   int i;
 241   int actual = cast_int(L->top.p - ci->func.p) - 1;  /* number of arguments */
 242   int nextra = actual - nfixparams;  /* number of extra arguments */
 243   ci->u.l.nextraargs = nextra;
 244   luaD_checkstack(L, p->maxstacksize + 1);
 245   /* copy function to the top of the stack */
 246   setobjs2s(L, L->top.p++, ci->func.p);
 247   /* move fixed parameters to the top of the stack */
 248   for (i = 1; i <= nfixparams; i++) {
 249     setobjs2s(L, L->top.p++, ci->func.p + i);
 250     setnilvalue(s2v(ci->func.p + i));  /* erase original parameter (for GC) */
 251   }
 252   ci->func.p += actual + 1;
 253   ci->top.p += actual + 1;
 254   lua_assert(L->top.p <= ci->top.p && ci->top.p <= L->stack_last.p);
 255 }
 256
 257
 258 void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
 259   int i;
 260   int nextra = ci->u.l.nextraargs;
 261   if (wanted < 0) {
 262     wanted = nextra;  /* get all extra arguments available */
 263     checkstackGCp(L, nextra, where);  /* ensure stack space */
 264     L->top.p = where + nextra;  /* next instruction will need top */
 265   }
 266   for (i = 0; i < wanted && i < nextra; i++)
 267     setobjs2s(L, where + i, ci->func.p - nextra + i);
 268   for (; i < wanted; i++)   /* complete required results with nil */
 269     setnilvalue(s2v(where + i));
 270 }
 271