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