static void luaB_call (void) {
lua_Object f = luaL_nonnullarg(1);
Hash *arg = gethash(2);
char *options = luaL_opt_string(3, "");
lua_Object err = lua_getparam(4);
int narg = (int)getnarg(arg);
int i, status;
if (err != LUA_NOOBJECT) { /* set new error method */
lua_pushobject(err);
err = lua_seterrormethod();
}
/* push arg[1...n] */
luaD_checkstack(narg);
for (i=0; i<narg; i++)
*(L->stack.top++) = *luaH_getint(arg, i+1);
status = lua_callfunction(f);
if (err != LUA_NOOBJECT) { /* restore old error method */
lua_pushobject(err);
lua_seterrormethod();
}
if (status != 0) { /* error in call? */
if (strchr(options, 'x')) {
lua_pushnil();
return; /* return nil to signal the error */
}
else
lua_error(NULL);
}
else { /* no errors */
if (strchr(options, 'p'))
luaA_packresults();
else
luaA_passresults();
}
}
LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {
StkId t;
lua_lock(L);
t = index2addr(L, idx);
api_check(L, ttistable(t), "table expected");
setobj2s(L, L->top, luaH_getint(hvalue(t), n));
api_incr_top(L);
lua_unlock(L);
}
LUA_API void lua_getglobal (lua_State *L, const char *var) {
Table *reg = hvalue(&G(L)->l_registry);
const TValue *gt; /* global table */
lua_lock(L);
gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
setsvalue2s(L, L->top++, luaS_new(L, var));
luaV_gettable(L, gt, L->top - 1, L->top - 1);
lua_unlock(L);
}
LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {
StkId t;
lua_lock(L);
t = index2addr(L, idx);
api_check(ttistable(t), "table expected");
setobj2s(L, L->top, luaH_getint(hvalue(t), n));
api_incr_top(L);
lua_unlock(L);
return ttnov(L->top - 1);
}
LUA_API void lua_setglobal (lua_State *L, const char *name) {
Table *reg = hvalue(&G(L)->l_registry);
const TValue *gt; /* global table */
lua_lock(L);
api_checknelems(L, 1);
gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
setsvalue2s(L, L->top++, luaS_new(L, name));
luaV_settable(L, gt, L->top - 1, L->top - 2);
L->top -= 2; /* pop value and key */
lua_unlock(L);
}
LUA_API int lua_getglobal (lua_State *L, const char *name) {
Table *reg = hvalue(&G(L)->l_registry);
const TValue *gt; /* global table */
lua_lock(L);
gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
setsvalue2s(L, L->top, luaS_new(L, name));
api_incr_top(L);
luaV_gettable(L, gt, L->top - 1, L->top - 1);
lua_unlock(L);
return ttnov(L->top - 1);
}
static void luaB_tremove (void) {
Hash *a = gethash(1);
int n = (int)getnarg(a);
int pos = luaL_opt_int(2, n);
if (n <= 0) return; /* table is "empty" */
luaA_pushobject(luaH_getint(a, pos)); /* result = a[pos] */
for ( ;pos<n; pos++)
luaH_move(a, pos+1, pos); /* a[pos] = a[pos+1] */
luaV_setn(a, n-1); /* a.n = n-1 */
luaH_setint(a, n, &luaO_nilobject); /* a[n] = nil */
}
static void auxsort (Hash *a, int l, int u, lua_Object f) {
while (l < u) { /* for tail recursion */
TObject *P;
int i, j;
/* sort elements a[l], a[(l+u)/2] and a[u] */
if (sort_comp(f, luaH_getint(a, u), luaH_getint(a, l))) /* a[l]>a[u]? */
swap(a, l, u);
if (u-l == 1) break; /* only 2 elements */
i = (l+u)/2;
P = luaH_getint(a, i);
if (sort_comp(f, P, luaH_getint(a, l))) /* a[l]>a[i]? */
swap(a, l, i);
else if (sort_comp(f, luaH_getint(a, u), P)) /* a[i]>a[u]? */
swap(a, i, u);
if (u-l == 2) break; /* only 3 elements */
P = L->stack.top++;
*P = *luaH_getint(a, i); /* save pivot on stack (for GC) */
swap(a, i, u-1); /* put median element as pivot (a[u-1]) */
/* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */
i = l; j = u-1;
for (;;) {
/* invariant: a[l..i] <= P <= a[j..u] */
while (sort_comp(f, luaH_getint(a, ++i), P)) /* stop when a[i] >= P */
if (i>u) lua_error("invalid order function for sorting");
while (sort_comp(f, P, luaH_getint(a, --j))) /* stop when a[j] <= P */
if (j<l) lua_error("invalid order function for sorting");
if (j<i) break;
swap(a, i, j);
}
swap(a, u-1, i); /* swap pivot (a[u-1]) with a[i] */
L->stack.top--; /* remove pivot from stack */
/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
/* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
if (i-l < u-i) {
j=l; i=i-1; l=i+2;
}
else {
j=i+1; i=u; u=j-2;
}
auxsort(a, j, i, f); /* call recursively the smaller one */
} /* repeat the routine for the larger one */
}
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--;
}
}
LUA_API void lua_setglobal (lua_State *L, const char *name) {
Table *reg = hvalue(&G(L)->l_registry);
lua_lock(L); /* unlock done in 'auxsetstr' */
auxsetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
}
LUA_API int lua_getglobal (lua_State *L, const char *name) {
Table *reg = hvalue(&G(L)->l_registry);
lua_lock(L);
return auxgetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
}
static void swap (Hash *a, int i, int j) {
TObject temp;
temp = *luaH_getint(a, i);
luaH_move(a, j, i);
luaH_setint(a, j, &temp);
}
