void luaT_setfallback() {
static const char *oldnames [] = { "error", "getglobal", "arith", "order", NULL };
TObject oldfunc;
lua_CFunction replace;
if (!tmFBAdded) {
luaL_addlibtolist(tmFB, (sizeof(tmFB) / sizeof(tmFB[0])));
tmFBAdded = true;
}
const char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaO_findstring(name, oldnames)) {
case 0: // old error fallback
oldfunc = errorim;
errorim = *luaA_Address(func);
replace = errorFB;
break;
case 1: // old getglobal fallback
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
replace = nilFB;
break;
case 2:
{ // old arith fallback
int32 i;
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
for (i = IM_ADD; i <= IM_UNM; i++) // ORDER IM
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
case 3:
{ // old order fallback
int32 i;
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
for (i = IM_LT; i <= IM_GE; i++) // ORDER IM
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
default:
{
int32 e;
if ((e = luaO_findstring(name, luaT_eventname)) >= 0) {
oldfunc = *luaT_getim(LUA_T_NIL, e);
fillvalids(e, luaA_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
} else {
luaL_verror("`%.50s' is not a valid fallback name", name);
replace = NULL; // to avoid warnings
oldfunc.ttype = LUA_T_NIL; // to avoid warnings
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaA_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
static void next() {
lua_Object o = luaL_tablearg(1);
lua_Object r = luaL_nonnullarg(2);
Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
if (n) {
luaA_pushobject(&n->ref);
luaA_pushobject(&n->val);
}
}
void luaT_setfallback (void)
{
static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
TObject oldfunc;
lua_CFunction replace;
char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaL_findstring(name, oldnames)) {
case 0: /* old error fallback */
oldfunc = L->errorim;
L->errorim = *luaA_Address(func);
replace = errorFB;
break;
case 1: /* old getglobal fallback */
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
replace = nilFB;
break;
case 2: { /* old arith fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
case 3: { /* old order fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
default: {
int e;
if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
oldfunc = *luaT_getim(LUA_T_NIL, e);
fillvalids(e, luaA_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
}
else {
luaL_verror("`%.50s' is not a valid fallback name", name);
replace = NULL; /* to avoid warnings */
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaA_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
static void luaB_next (void) {
Hash *a = gethash(1);
TObject *k = luaA_Address(luaL_nonnullarg(2));
int i = (ttype(k) == LUA_T_NIL) ? 0 : luaH_pos(a, k)+1;
if (luaA_next(a, i) == 0)
lua_pushnil();
}
static void luaB_tostring (void) {
lua_Object obj = lua_getparam(1);
TObject *o = luaA_Address(obj);
char buff[64];
switch (ttype(o)) {
case LUA_T_NUMBER:
lua_pushstring(lua_getstring(obj));
return;
case LUA_T_STRING:
lua_pushobject(obj);
return;
case LUA_T_ARRAY:
sprintf(buff, "table: %p", (void *)o->value.a);
break;
case LUA_T_CLOSURE:
sprintf(buff, "function: %p", (void *)o->value.cl);
break;
case LUA_T_PROTO:
sprintf(buff, "function: %p", (void *)o->value.tf);
break;
case LUA_T_CPROTO:
sprintf(buff, "function: %p", (void *)o->value.f);
break;
case LUA_T_USERDATA:
sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
break;
case LUA_T_NIL:
lua_pushstring("nil");
return;
default:
LUA_INTERNALERROR("invalid type");
}
lua_pushstring(buff);
}
static void foreach (void)
{
TObject t = *luaA_Address(luaL_tablearg(1));
TObject f = *luaA_Address(luaL_functionarg(2));
int32 i;
for (i=0; i<avalue(&t)->nhash; i++) {
Node *nd = &(avalue(&t)->node[i]);
if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
luaA_pushobject(&f);
luaA_pushobject(ref(nd));
luaA_pushobject(val(nd));
luaD_call((L->stack.top-L->stack.stack)-2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--;
}
}
}
static const char *to_string(lua_Object obj) {
char *buff = luaL_openspace(30);
TObject *o = luaA_Address(obj);
switch (ttype(o)) {
case LUA_T_NUMBER:
case LUA_T_STRING:
return lua_getstring(obj);
case LUA_T_ARRAY:
{
sprintf(buff, "table: %p", (void *)o->value.a);
return buff;
}
case LUA_T_CLOSURE:
{
sprintf(buff, "function: %p", (void *)o->value.cl);
return buff;
}
case LUA_T_PROTO:
{
sprintf(buff, "function: %p", (void *)o->value.tf);
return buff;
}
case LUA_T_CPROTO:
{
// WORKAROUND: C++ forbids casting from a pointer-to-function to a
// pointer-to-object. We use a union to work around that.
union {
void *objPtr;
lua_CFunction funcPtr;
} ptrUnion;
ptrUnion.funcPtr = o->value.f;
sprintf(buff, "function: %p", ptrUnion.objPtr);
return buff;
}
case LUA_T_USERDATA:
{
sprintf(buff, "userdata: %d", o->value.ud.id);
return buff;
}
case LUA_T_TASK:
{
sprintf(buff, "task: %d", (int)o->value.n);
return buff;
}
case LUA_T_NIL:
return "nil";
default:
#ifdef LUA_DEBUG
LUA_INTERNALERROR("internal error");
#endif
return NULL;
}
}
static void luaB_nextvar (void) {
TObject *o = luaA_Address(luaL_nonnullarg(1));
TaggedString *g;
if (ttype(o) == LUA_T_NIL)
g = NULL;
else {
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
g = tsvalue(o);
}
if (!luaA_nextvar(g))
lua_pushnil();
}
static void luaB_tinsert (void) {
Hash *a = gethash(1);
lua_Object v = lua_getparam(3);
int n = (int)getnarg(a);
int pos;
if (v != LUA_NOOBJECT)
pos = luaL_check_int(2);
else { /* called with only 2 arguments */
v = luaL_nonnullarg(2);
pos = n+1;
}
luaV_setn(a, n+1); /* a.n = n+1 */
for ( ;n>=pos; n--)
luaH_move(a, n, n+1); /* a[n+1] = a[n] */
luaH_setint(a, pos, luaA_Address(v)); /* a[pos] = v */
}
static int sort_comp (lua_Object f, TObject *a, TObject *b) {
/* notice: the caller (auxsort) must check stack space */
if (f != LUA_NOOBJECT) {
*(L->stack.top) = *luaA_Address(f);
*(L->stack.top+1) = *a;
*(L->stack.top+2) = *b;
L->stack.top += 3;
luaD_calln(2, 1);
}
else { /* a < b? */
*(L->stack.top) = *a;
*(L->stack.top+1) = *b;
L->stack.top += 2;
luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
}
return ttype(--(L->stack.top)) != LUA_T_NIL;
}
static void luaB_foreach (void) {
Hash *a = gethash(1);
int i;
TObject f; /* see comment in 'foreachi' */
f = *luaA_Address(luaL_functionarg(2));
luaD_checkstack(3); /* for f, ref, and val */
for (i=0; i<a->nhash; i++) {
Node *nd = &(a->node[i]);
if (ttype(val(nd)) != LUA_T_NIL) {
*(L->stack.top++) = f;
*(L->stack.top++) = *ref(nd);
*(L->stack.top++) = *val(nd);
luaD_calln(2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--; /* remove result */
}
}
}
static void to_string (void) {
lua_Object obj = lua_getparam(1);
char *buff = luaL_openspace(30);
TObject *o = luaA_Address(obj);
switch (ttype(o)) {
case LUA_T_NUMBER:
lua_pushstring(lua_getstring(obj));
return;
case LUA_T_STRING:
lua_pushobject(obj);
return;
case LUA_T_ARRAY: {
sprintf(buff, "table: %p", (void *)o->value.a);
break;
}
case LUA_T_CLOSURE: {
sprintf(buff, "function: %p", (void *)o->value.cl);
break;
}
case LUA_T_PROTO: {
sprintf(buff, "function: %p", (void *)o->value.tf);
break;
}
case LUA_T_CPROTO: {
sprintf(buff, "function: %p", (void *)o->value.f);
break;
}
case LUA_T_USERDATA: {
sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
break;
}
case LUA_T_TASK: {
sprintf(buff, "task: %d", (int)o->value.n);
break;
}
case LUA_T_NIL:
lua_pushstring("nil");
return;
default:
LUA_INTERNALERROR("invalid type");
}
lua_pushstring(buff);
}
static void luaB_foreachi (void) {
Hash *t = gethash(1);
int i;
int n = (int)getnarg(t);
TObject f;
/* 'f' cannot be a pointer to TObject, because it is on the stack, and the
stack may be reallocated by the call. Moreover, some C compilers do not
initialize structs, so we must do the assignment after the declaration */
f = *luaA_Address(luaL_functionarg(2));
luaD_checkstack(3); /* for f, ref, and val */
for (i=1; i<=n; i++) {
*(L->stack.top++) = f;
ttype(L->stack.top) = LUA_T_NUMBER; nvalue(L->stack.top++) = i;
*(L->stack.top++) = *luaH_getint(t, i);
luaD_calln(2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--;
}
}
static void nextvar() {
TObject *o = luaA_Address(luaL_nonnullarg(1));
TaggedString *g;
if (ttype(o) == LUA_T_NIL)
g = (TaggedString *)rootglobal.next;
else {
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
g = tsvalue(o);
// check whether name is in global var list
luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
g = (TaggedString *)g->head.next;
}
while (g && g->globalval.ttype == LUA_T_NIL) {
// skip globals with nil
g = (TaggedString *)g->head.next;
}
if (g) {
pushstring(g);
luaA_pushobject(&g->globalval);
}
}
static void luaB_foreachvar (void) {
GCnode *g;
TObject f; /* see comment in 'foreachi' */
f = *luaA_Address(luaL_functionarg(1));
luaD_checkstack(4); /* for extra var name, f, var name, and globalval */
for (g = L->rootglobal.next; g; g = g->next) {
TaggedString *s = (TaggedString *)g;
if (s->u.s.globalval.ttype != LUA_T_NIL) {
pushtagstring(s); /* keep (extra) s on stack to avoid GC */
*(L->stack.top++) = f;
pushtagstring(s);
*(L->stack.top++) = s->u.s.globalval;
luaD_calln(2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL) {
L->stack.top--;
*(L->stack.top-1) = *L->stack.top; /* remove extra s */
return;
}
L->stack.top-=2; /* remove result and extra s */
}
}
}
static void foreachvar (void)
{
TObject f = *luaA_Address(luaL_functionarg(1));
GCnode *g;
StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */
ttype(L->stack.stack+name) = LUA_T_NIL;
L->stack.top++;
for (g = L->rootglobal.next; g; g = g->next) {
TaggedString *s = (TaggedString *)g;
if (s->u.s.globalval.ttype != LUA_T_NIL) {
ttype(L->stack.stack+name) = LUA_T_STRING;
tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */
luaA_pushobject(&f);
pushstring(s);
luaA_pushobject(&s->u.s.globalval);
luaD_call((L->stack.top-L->stack.stack)-2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--;
}
}
}
static void foreachvar() {
TObject f = *luaA_Address(luaL_functionarg(1));
GCnode *g;
StkId name = lua_state->Cstack.base++; // place to keep var name (to avoid GC)
ttype(lua_state->stack.stack + name) = LUA_T_NIL;
lua_state->stack.top++;
for (g = rootglobal.next; g; g = g->next) {
TaggedString *s = (TaggedString *)g;
if (s->globalval.ttype != LUA_T_NIL) {
ttype(lua_state->stack.stack + name) = LUA_T_STRING;
tsvalue(lua_state->stack.stack + name) = s; // keep s on stack to avoid GC
luaA_pushobject(&f);
pushstring(s);
luaA_pushobject(&s->globalval);
lua_state->state_counter1++;
luaD_call((lua_state->stack.top - lua_state->stack.stack) - 2, 1);
lua_state->state_counter1--;
if (ttype(lua_state->stack.top - 1) != LUA_T_NIL)
return;
lua_state->stack.top--;
}
}
}
int lua_nups (lua_Function func) {
TObject *o = luaA_Address(func);
return (!o || normalized_type(o) != LUA_T_CLOSURE) ? 0 : o->value.cl->nelems;
}
static void luaI_type() {
lua_Object o = luaL_nonnullarg(1);
lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
lua_pushnumber(lua_tag(o));
}
static Hash *gethash (int arg) {
return avalue(luaA_Address(luaL_tablearg(arg)));
}