6 char *rcs_fallback
="$Id: fallback.c,v 2.9 1997/06/23 18:27:53 roberto Exp $";
22 /* -------------------------------------------
28 enum {LOCK
, HOLD
, FREE
, COLLECTED
} status
;
30 static int refSize
= 0;
32 int luaI_ref (TObject
*object
, int lock
)
36 if (ttype(object
) == LUA_T_NIL
)
37 return -1; /* special ref for nil */
38 for (i
=0; i
<refSize
; i
++)
39 if (refArray
[i
].status
== FREE
)
41 /* no more empty spaces */
43 refSize
= growvector(&refArray
, refSize
, struct ref
, refEM
, MAX_WORD
);
44 for (i
=oldSize
; i
<refSize
; i
++)
45 refArray
[i
].status
= FREE
;
48 refArray
[i
].o
= *object
;
49 refArray
[i
].status
= lock
? LOCK
: HOLD
;
54 void lua_unref (int ref
)
56 if (ref
>= 0 && ref
< refSize
)
57 refArray
[ref
].status
= FREE
;
61 TObject
*luaI_getref (int ref
)
63 static TObject nul
= {LUA_T_NIL
, {0}};
66 if (ref
>= 0 && ref
< refSize
&&
67 (refArray
[ref
].status
== LOCK
|| refArray
[ref
].status
== HOLD
))
68 return &refArray
[ref
].o
;
74 void luaI_travlock (int (*fn
)(TObject
*))
77 for (i
=0; i
<refSize
; i
++)
78 if (refArray
[i
].status
== LOCK
)
83 void luaI_invalidaterefs (void)
86 for (i
=0; i
<refSize
; i
++)
87 if (refArray
[i
].status
== HOLD
&& !luaI_ismarked(&refArray
[i
].o
))
88 refArray
[i
].status
= COLLECTED
;
92 /* -------------------------------------------
96 char *luaI_eventname
[] = { /* ORDER IM */
97 "gettable", "settable", "index", "getglobal", "setglobal", "add",
98 "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
99 "concat", "gc", "function",
105 static int luaI_checkevent (char *name
, char *list
[])
107 int e
= luaI_findstring(name
, list
);
109 luaL_verror("`%s' is not a valid event name", name
);
114 struct IM
*luaI_IMtable
= NULL
;
116 static int IMtable_size
= 0;
117 static int last_tag
= LUA_T_NIL
; /* ORDER LUA_T */
120 /* events in LUA_T_LINE are all allowed, since this is used as a
121 * 'placeholder' for "default" fallbacks
123 static char validevents
[NUM_TYPES
][IM_N
] = { /* ORDER LUA_T, ORDER IM */
124 {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
125 {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_LINE */
126 {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_CMARK */
127 {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_MARK */
128 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CFUNCTION */
129 {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_FUNCTION */
130 {0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
131 {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
132 {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
133 {1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
136 static int validevent (lua_Type t
, int e
)
138 return (t
< LUA_T_NIL
) ? 1 : validevents
[-t
][e
];
142 static void init_entry (int tag
)
145 for (i
=0; i
<IM_N
; i
++)
146 ttype(luaI_getim(tag
, i
)) = LUA_T_NIL
;
149 void luaI_initfallbacks (void)
151 if (luaI_IMtable
== NULL
) {
153 IMtable_size
= NUM_TYPES
+10;
154 luaI_IMtable
= newvector(IMtable_size
, struct IM
);
155 for (i
=LUA_T_NIL
; i
<=LUA_T_USERDATA
; i
++)
160 int lua_newtag (void)
163 if ((-last_tag
) >= IMtable_size
) {
164 luaI_initfallbacks();
165 IMtable_size
= growvector(&luaI_IMtable
, IMtable_size
,
166 struct IM
, memEM
, MAX_INT
);
168 init_entry(last_tag
);
173 static void checktag (int tag
)
175 if (!(last_tag
<= tag
&& tag
<= 0))
176 luaL_verror("%d is not a valid tag", tag
);
179 void luaI_realtag (int tag
)
181 if (!(last_tag
<= tag
&& tag
< LUA_T_NIL
))
182 luaL_verror("tag %d is not result of `newtag'", tag
);
186 void luaI_settag (int tag
, TObject
*o
)
191 o
->value
.a
->htag
= tag
;
194 o
->value
.ts
->tag
= tag
;
197 luaL_verror("cannot change the tag of a %s", luaI_typenames
[-ttype(o
)]);
202 int luaI_efectivetag (TObject
*o
)
204 lua_Type t
= ttype(o
);
205 if (t
== LUA_T_USERDATA
) {
206 int tag
= o
->value
.ts
->tag
;
207 return (tag
>= 0) ? LUA_T_USERDATA
: tag
;
209 else if (t
== LUA_T_ARRAY
)
210 return o
->value
.a
->htag
;
215 void luaI_gettagmethod (void)
217 int t
= (int)luaL_check_number(1);
218 int e
= luaI_checkevent(luaL_check_string(2), luaI_eventname
);
220 if (validevent(t
, e
))
221 luaI_pushobject(luaI_getim(t
,e
));
225 void luaI_settagmethod (void)
227 int t
= (int)luaL_check_number(1);
228 int e
= luaI_checkevent(luaL_check_string(2), luaI_eventname
);
229 lua_Object func
= lua_getparam(3);
231 if (!validevent(t
, e
))
232 luaL_verror("cannot change internal method `%s' for tag %d",
233 luaI_eventname
[e
], t
);
234 luaL_arg_check(lua_isnil(func
) || lua_isfunction(func
),
235 3, "function expected");
236 luaI_pushobject(luaI_getim(t
,e
));
237 *luaI_getim(t
, e
) = *luaI_Address(func
);
241 static void stderrorim (void)
243 lua_Object s
= lua_getparam(1);
245 fprintf(stderr
, "lua: %s\n", lua_getstring(s
));
248 static TObject errorim
= {LUA_T_CFUNCTION
, {stderrorim
}};
251 TObject
*luaI_geterrorim (void)
256 void luaI_seterrormethod (void)
258 lua_Object func
= lua_getparam(1);
259 luaL_arg_check(lua_isnil(func
) || lua_isfunction(func
),
260 1, "function expected");
261 luaI_pushobject(&errorim
);
262 errorim
= *luaI_Address(func
);
265 char *luaI_travfallbacks (int (*fn
)(TObject
*))
270 for (e
=IM_GETTABLE
; e
<=IM_FUNCTION
; e
++) { /* ORDER IM */
272 for (t
=0; t
>=last_tag
; t
--)
273 if (fn(luaI_getim(t
,e
)))
274 return luaI_eventname
[e
];
281 * ===================================================================
282 * compatibility with old fallback system
286 static void errorFB (void)
288 lua_Object o
= lua_getparam(1);
290 fprintf (stderr
, "lua: %s\n", lua_getstring(o
));
292 fprintf(stderr
, "lua: unknown error\n");
296 static void nilFB (void) { }
299 static void typeFB (void)
301 lua_error("unexpected type");
305 static void fillvalids (IMS e
, TObject
*func
)
308 for (t
=LUA_T_NIL
; t
<=LUA_T_USERDATA
; t
++)
309 if (validevent(t
, e
))
310 *luaI_getim(t
, e
) = *func
;
314 void luaI_setfallback (void)
316 static char *oldnames
[] = {"error", "getglobal", "arith", "order", NULL
};
318 lua_CFunction replace
;
319 char *name
= luaL_check_string(1);
320 lua_Object func
= lua_getparam(2);
321 luaI_initfallbacks();
322 luaL_arg_check(lua_isfunction(func
), 2, "function expected");
323 switch (luaI_findstring(name
, oldnames
)) {
324 case 0: /* old error fallback */
326 errorim
= *luaI_Address(func
);
329 case 1: /* old getglobal fallback */
330 oldfunc
= *luaI_getim(LUA_T_NIL
, IM_GETGLOBAL
);
331 *luaI_getim(LUA_T_NIL
, IM_GETGLOBAL
) = *luaI_Address(func
);
334 case 2: { /* old arith fallback */
336 oldfunc
= *luaI_getim(LUA_T_NUMBER
, IM_POW
);
337 for (i
=IM_ADD
; i
<=IM_UNM
; i
++) /* ORDER IM */
338 fillvalids(i
, luaI_Address(func
));
342 case 3: { /* old order fallback */
344 oldfunc
= *luaI_getim(LUA_T_LINE
, IM_LT
);
345 for (i
=IM_LT
; i
<=IM_GE
; i
++) /* ORDER IM */
346 fillvalids(i
, luaI_Address(func
));
352 if ((e
= luaI_findstring(name
, luaI_eventname
)) >= 0) {
353 oldfunc
= *luaI_getim(LUA_T_LINE
, e
);
354 fillvalids(e
, luaI_Address(func
));
355 replace
= (e
== IM_GC
|| e
== IM_INDEX
) ? nilFB
: typeFB
;
358 luaL_verror("`%s' is not a valid fallback name", name
);
359 replace
= NULL
; /* to avoid warnings */
363 if (oldfunc
.ttype
!= LUA_T_NIL
)
364 luaI_pushobject(&oldfunc
);
366 lua_pushcfunction(replace
);