2 ** $Id: ltm.c,v 1.25 1999/05/21 19:41:49 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
[]) {
26 int e
= luaL_findstring(name
, list
);
28 luaL_verror("`%.50s' is not a valid event name", name
);
34 /* events in LUA_T_NIL are all allowed, since this is used as a
35 * 'placeholder' for "default" fallbacks
37 static char luaT_validevents
[NUM_TAGS
][IM_N
] = { /* ORDER LUA_T, ORDER IM */
38 {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
39 {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
40 {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
41 {0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
42 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */
43 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */
44 {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
47 static int luaT_validevent (int t
, int e
) { /* ORDER LUA_T */
48 return (t
< LUA_T_NIL
) ? 1 : luaT_validevents
[-t
][e
];
52 static void init_entry (int tag
) {
54 for (i
=0; i
<IM_N
; i
++)
55 ttype(luaT_getim(tag
, i
)) = LUA_T_NIL
;
59 void luaT_init (void) {
61 L
->last_tag
= -(NUM_TAGS
-1);
62 luaM_growvector(L
->IMtable
, 0, NUM_TAGS
, struct IM
, arrEM
, MAX_INT
);
63 for (t
=L
->last_tag
; t
<=0; t
++)
68 int lua_newtag (void) {
70 luaM_growvector(L
->IMtable
, -(L
->last_tag
), 1, struct IM
, arrEM
, MAX_INT
);
71 init_entry(L
->last_tag
);
76 static void checktag (int tag
) {
77 if (!(L
->last_tag
<= tag
&& tag
<= 0))
78 luaL_verror("%d is not a valid tag", tag
);
81 void luaT_realtag (int tag
) {
82 if (!(L
->last_tag
<= tag
&& tag
< LUA_T_NIL
))
83 luaL_verror("tag %d was not created by `newtag'", tag
);
87 int lua_copytagmethods (int tagto
, int tagfrom
) {
91 for (e
=0; e
<IM_N
; e
++) {
92 if (luaT_validevent(tagto
, e
))
93 *luaT_getim(tagto
, e
) = *luaT_getim(tagfrom
, e
);
99 int luaT_effectivetag (TObject
*o
) {
101 switch (t
= ttype(o
)) {
103 return o
->value
.a
->htag
;
104 case LUA_T_USERDATA
: {
105 int tag
= o
->value
.ts
->u
.d
.tag
;
106 return (tag
>= 0) ? LUA_T_USERDATA
: tag
;
109 return o
->value
.cl
->consts
[0].ttype
;
111 case LUA_T_PMARK
: case LUA_T_CMARK
:
112 case LUA_T_CLMARK
: case LUA_T_LINE
:
113 LUA_INTERNALERROR("invalid type");
121 TObject
*luaT_gettagmethod (int t
, char *event
) {
122 int e
= luaI_checkevent(event
, luaT_eventname
);
124 if (luaT_validevent(t
, e
))
125 return luaT_getim(t
,e
);
127 return &luaO_nilobject
;
131 void luaT_settagmethod (int t
, char *event
, TObject
*func
) {
133 int e
= luaI_checkevent(event
, luaT_eventname
);
135 if (!luaT_validevent(t
, e
))
136 luaL_verror("cannot change tag method `%.20s' for type `%.20s'%.20s",
137 luaT_eventname
[e
], luaO_typenames
[-t
],
138 (t
== LUA_T_ARRAY
|| t
== LUA_T_USERDATA
) ? " with default tag"
141 *func
= *luaT_getim(t
,e
);
142 *luaT_getim(t
, e
) = temp
;
146 char *luaT_travtagmethods (int (*fn
)(TObject
*)) { /* ORDER IM */
148 for (e
=IM_GETTABLE
; e
<=IM_FUNCTION
; e
++) {
150 for (t
=0; t
>=L
->last_tag
; t
--)
151 if (fn(luaT_getim(t
,e
)))
152 return luaT_eventname
[e
];
159 * ===================================================================
160 * compatibility with old fallback system
167 static void errorFB (void)
169 lua_Object o
= lua_getparam(1);
171 fprintf(stderr
, "lua: %s\n", lua_getstring(o
));
173 fprintf(stderr
, "lua: unknown error\n");
177 static void nilFB (void) { }
180 static void typeFB (void) {
181 lua_error("unexpected type");
185 static void fillvalids (IMS e
, TObject
*func
) {
187 for (t
=LUA_T_NIL
; t
<=LUA_T_USERDATA
; t
++)
188 if (luaT_validevent(t
, e
))
189 *luaT_getim(t
, e
) = *func
;
193 void luaT_setfallback (void) {
194 static char *oldnames
[] = {"error", "getglobal", "arith", "order", NULL
};
196 lua_CFunction replace
;
197 char *name
= luaL_check_string(1);
198 lua_Object func
= lua_getparam(2);
199 luaL_arg_check(lua_isfunction(func
), 2, "function expected");
200 switch (luaL_findstring(name
, oldnames
)) {
201 case 0: { /* old error fallback */
202 TObject
*em
= &(luaS_new("_ERRORMESSAGE")->u
.s
.globalval
);
204 *em
= *luaA_Address(func
);
208 case 1: /* old getglobal fallback */
209 oldfunc
= *luaT_getim(LUA_T_NIL
, IM_GETGLOBAL
);
210 *luaT_getim(LUA_T_NIL
, IM_GETGLOBAL
) = *luaA_Address(func
);
213 case 2: { /* old arith fallback */
215 oldfunc
= *luaT_getim(LUA_T_NUMBER
, IM_POW
);
216 for (i
=IM_ADD
; i
<=IM_UNM
; i
++) /* ORDER IM */
217 fillvalids(i
, luaA_Address(func
));
221 case 3: { /* old order fallback */
223 oldfunc
= *luaT_getim(LUA_T_NIL
, IM_LT
);
224 for (i
=IM_LT
; i
<=IM_GE
; i
++) /* ORDER IM */
225 fillvalids(i
, luaA_Address(func
));
231 if ((e
= luaL_findstring(name
, luaT_eventname
)) >= 0) {
232 oldfunc
= *luaT_getim(LUA_T_NIL
, e
);
233 fillvalids(e
, luaA_Address(func
));
234 replace
= (e
== IM_GC
|| e
== IM_INDEX
) ? nilFB
: typeFB
;
237 luaL_verror("`%.50s' is not a valid fallback name", name
);
238 replace
= NULL
; /* to avoid warnings */
242 if (oldfunc
.ttype
!= LUA_T_NIL
)
243 luaA_pushobject(&oldfunc
);
245 lua_pushcfunction(replace
);