ltm.c (8528B)
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_Hgetshortstr(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_Hgetshortstr(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_Hgetshortstr(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 lu_byte 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 return ttypetag(s2v(res)); /* return tag of the result */ 135 } 136 137 138 static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2, 139 StkId res, TMS event) { 140 const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ 141 if (notm(tm)) 142 tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ 143 if (notm(tm)) 144 return -1; /* tag method not found */ 145 else /* call tag method and return the tag of the result */ 146 return luaT_callTMres(L, tm, p1, p2, res); 147 } 148 149 150 void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2, 151 StkId res, TMS event) { 152 if (l_unlikely(callbinTM(L, p1, p2, res, event) < 0)) { 153 switch (event) { 154 case TM_BAND: case TM_BOR: case TM_BXOR: 155 case TM_SHL: case TM_SHR: case TM_BNOT: { 156 if (ttisnumber(p1) && ttisnumber(p2)) 157 luaG_tointerror(L, p1, p2); 158 else 159 luaG_opinterror(L, p1, p2, "perform bitwise operation on"); 160 } 161 /* calls never return, but to avoid warnings: *//* FALLTHROUGH */ 162 default: 163 luaG_opinterror(L, p1, p2, "perform arithmetic on"); 164 } 165 } 166 } 167 168 169 /* 170 ** The use of 'p1' after 'callbinTM' is safe because, when a tag 171 ** method is not found, 'callbinTM' cannot change the stack. 172 */ 173 void luaT_tryconcatTM (lua_State *L) { 174 StkId p1 = L->top.p - 2; /* first argument */ 175 if (l_unlikely(callbinTM(L, s2v(p1), s2v(p1 + 1), p1, TM_CONCAT) < 0)) 176 luaG_concaterror(L, s2v(p1), s2v(p1 + 1)); 177 } 178 179 180 void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2, 181 int flip, StkId res, TMS event) { 182 if (flip) 183 luaT_trybinTM(L, p2, p1, res, event); 184 else 185 luaT_trybinTM(L, p1, p2, res, event); 186 } 187 188 189 void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2, 190 int flip, StkId res, TMS event) { 191 TValue aux; 192 setivalue(&aux, i2); 193 luaT_trybinassocTM(L, p1, &aux, flip, res, event); 194 } 195 196 197 /* 198 ** Calls an order tag method. 199 ** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old 200 ** behavior: if there is no '__le', try '__lt', based on l <= r iff 201 ** !(r < l) (assuming a total order). If the metamethod yields during 202 ** this substitution, the continuation has to know about it (to negate 203 ** the result of r<l); bit CIST_LEQ in the call status keeps that 204 ** information. 205 */ 206 int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2, 207 TMS event) { 208 int tag = callbinTM(L, p1, p2, L->top.p, event); /* try original event */ 209 if (tag >= 0) /* found tag method? */ 210 return !tagisfalse(tag); 211 #if defined(LUA_COMPAT_LT_LE) 212 else if (event == TM_LE) { 213 /* try '!(p2 < p1)' for '(p1 <= p2)' */ 214 L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */ 215 tag = callbinTM(L, p2, p1, L->top.p, TM_LT); 216 L->ci->callstatus ^= CIST_LEQ; /* clear mark */ 217 if (tag >= 0) /* found tag method? */ 218 return tagisfalse(tag); 219 } 220 #endif 221 luaG_ordererror(L, p1, p2); /* no metamethod found */ 222 return 0; /* to avoid warnings */ 223 } 224 225 226 int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2, 227 int flip, int isfloat, TMS event) { 228 TValue aux; const TValue *p2; 229 if (isfloat) { 230 setfltvalue(&aux, cast_num(v2)); 231 } 232 else 233 setivalue(&aux, v2); 234 if (flip) { /* arguments were exchanged? */ 235 p2 = p1; p1 = &aux; /* correct them */ 236 } 237 else 238 p2 = &aux; 239 return luaT_callorderTM(L, p1, p2, event); 240 } 241 242 243 void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci, 244 const Proto *p) { 245 int i; 246 int actual = cast_int(L->top.p - ci->func.p) - 1; /* number of arguments */ 247 int nextra = actual - nfixparams; /* number of extra arguments */ 248 ci->u.l.nextraargs = nextra; 249 luaD_checkstack(L, p->maxstacksize + 1); 250 /* copy function to the top of the stack */ 251 setobjs2s(L, L->top.p++, ci->func.p); 252 /* move fixed parameters to the top of the stack */ 253 for (i = 1; i <= nfixparams; i++) { 254 setobjs2s(L, L->top.p++, ci->func.p + i); 255 setnilvalue(s2v(ci->func.p + i)); /* erase original parameter (for GC) */ 256 } 257 ci->func.p += actual + 1; 258 ci->top.p += actual + 1; 259 lua_assert(L->top.p <= ci->top.p && ci->top.p <= L->stack_last.p); 260 } 261 262 263 void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) { 264 int i; 265 int nextra = ci->u.l.nextraargs; 266 if (wanted < 0) { 267 wanted = nextra; /* get all extra arguments available */ 268 checkstackp(L, nextra, where); /* ensure stack space */ 269 L->top.p = where + nextra; /* next instruction will need top */ 270 } 271 for (i = 0; i < wanted && i < nextra; i++) 272 setobjs2s(L, where + i, ci->func.p - nextra + i); 273 for (; i < wanted; i++) /* complete required results with nil */ 274 setnilvalue(s2v(where + i)); 275 } 276