2 ** $Id: ltm.c,v 1.16 1998/06/18 16:57:03 roberto Exp $
4 ** See Copyright Notice in lua.h
18 char *luaT_eventname
[] = { /* ORDER IM */
19 "gettable", "settable", "index", "getglobal", "setglobal", "add",
20 "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
21 "concat", "gc", "function", NULL
25 static int luaI_checkevent (char *name
, char *list
[])
27 int e
= luaL_findstring(name
, list
);
29 luaL_verror("`%.50s' is not a valid event name", name
);
35 /* events in LUA_T_NIL are all allowed, since this is used as a
36 * 'placeholder' for "default" fallbacks
38 static char validevents
[NUM_TAGS
][IM_N
] = { /* ORDER LUA_T, ORDER IM */
39 {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
40 {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
41 {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
42 {0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
43 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */
44 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */
45 {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
49 static int validevent (int t
, int e
)
51 return (t
< LUA_T_NIL
) ? 1 : validevents
[-t
][e
];
55 static void init_entry (int tag
)
58 for (i
=0; i
<IM_N
; i
++)
59 ttype(luaT_getim(tag
, i
)) = LUA_T_NIL
;
66 L
->IMtable_size
= NUM_TAGS
*2;
67 L
->last_tag
= -(NUM_TAGS
-1);
68 L
->IMtable
= luaM_newvector(L
->IMtable_size
, struct IM
);
69 for (t
=L
->last_tag
; t
<=0; t
++)
77 if ((-L
->last_tag
) >= L
->IMtable_size
)
78 L
->IMtable_size
= luaM_growvector(&L
->IMtable
, L
->IMtable_size
,
79 struct IM
, memEM
, MAX_INT
);
80 init_entry(L
->last_tag
);
85 static void checktag (int tag
)
87 if (!(L
->last_tag
<= tag
&& tag
<= 0))
88 luaL_verror("%d is not a valid tag", tag
);
91 void luaT_realtag (int tag
)
93 if (!(L
->last_tag
<= tag
&& tag
< LUA_T_NIL
))
94 luaL_verror("tag %d is not result of `newtag'", tag
);
98 int lua_copytagmethods (int tagto
, int tagfrom
)
103 for (e
=0; e
<IM_N
; e
++) {
104 if (validevent(tagto
, e
))
105 *luaT_getim(tagto
, e
) = *luaT_getim(tagfrom
, e
);
111 int luaT_efectivetag (TObject
*o
)
114 switch (t
= ttype(o
)) {
116 return o
->value
.a
->htag
;
117 case LUA_T_USERDATA
: {
118 int tag
= o
->value
.ts
->u
.d
.tag
;
119 return (tag
>= 0) ? LUA_T_USERDATA
: tag
;
122 return o
->value
.cl
->consts
[0].ttype
;
124 case LUA_T_PMARK
: case LUA_T_CMARK
:
125 case LUA_T_CLMARK
: case LUA_T_LINE
:
126 LUA_INTERNALERROR("invalid type");
134 TObject
*luaT_gettagmethod (int t
, char *event
)
136 int e
= luaI_checkevent(event
, luaT_eventname
);
138 if (validevent(t
, e
))
139 return luaT_getim(t
,e
);
141 return &luaO_nilobject
;
145 void luaT_settagmethod (int t
, char *event
, TObject
*func
)
147 TObject temp
= *func
;
148 int e
= luaI_checkevent(event
, luaT_eventname
);
150 if (!validevent(t
, e
))
151 luaL_verror("settagmethod: cannot change tag method `%.20s' for tag %d",
152 luaT_eventname
[e
], t
);
153 *func
= *luaT_getim(t
,e
);
154 *luaT_getim(t
, e
) = temp
;
158 char *luaT_travtagmethods (int (*fn
)(TObject
*))
163 for (e
=IM_GETTABLE
; e
<=IM_FUNCTION
; e
++) { /* ORDER IM */
165 for (t
=0; t
>=L
->last_tag
; t
--)
166 if (fn(luaT_getim(t
,e
)))
167 return luaT_eventname
[e
];
174 * ===================================================================
175 * compatibility with old fallback system
181 static void errorFB (void)
183 lua_Object o
= lua_getparam(1);
185 fprintf(stderr
, "lua: %s\n", lua_getstring(o
));
187 fprintf(stderr
, "lua: unknown error\n");
191 static void nilFB (void) { }
194 static void typeFB (void)
196 lua_error("unexpected type");
200 static void fillvalids (IMS e
, TObject
*func
)
203 for (t
=LUA_T_NIL
; t
<=LUA_T_USERDATA
; t
++)
204 if (validevent(t
, e
))
205 *luaT_getim(t
, e
) = *func
;
209 void luaT_setfallback (void)
211 static char *oldnames
[] = {"error", "getglobal", "arith", "order", NULL
};
213 lua_CFunction replace
;
214 char *name
= luaL_check_string(1);
215 lua_Object func
= lua_getparam(2);
216 luaL_arg_check(lua_isfunction(func
), 2, "function expected");
217 switch (luaL_findstring(name
, oldnames
)) {
218 case 0: /* old error fallback */
219 oldfunc
= L
->errorim
;
220 L
->errorim
= *luaA_Address(func
);
223 case 1: /* old getglobal fallback */
224 oldfunc
= *luaT_getim(LUA_T_NIL
, IM_GETGLOBAL
);
225 *luaT_getim(LUA_T_NIL
, IM_GETGLOBAL
) = *luaA_Address(func
);
228 case 2: { /* old arith fallback */
230 oldfunc
= *luaT_getim(LUA_T_NUMBER
, IM_POW
);
231 for (i
=IM_ADD
; i
<=IM_UNM
; i
++) /* ORDER IM */
232 fillvalids(i
, luaA_Address(func
));
236 case 3: { /* old order fallback */
238 oldfunc
= *luaT_getim(LUA_T_NIL
, IM_LT
);
239 for (i
=IM_LT
; i
<=IM_GE
; i
++) /* ORDER IM */
240 fillvalids(i
, luaA_Address(func
));
246 if ((e
= luaL_findstring(name
, luaT_eventname
)) >= 0) {
247 oldfunc
= *luaT_getim(LUA_T_NIL
, e
);
248 fillvalids(e
, luaA_Address(func
));
249 replace
= (e
== IM_GC
|| e
== IM_INDEX
) ? nilFB
: typeFB
;
252 luaL_verror("`%.50s' is not a valid fallback name", name
);
253 replace
= NULL
; /* to avoid warnings */
257 if (oldfunc
.ttype
!= LUA_T_NIL
)
258 luaA_pushobject(&oldfunc
);
260 lua_pushcfunction(replace
);