/*

** $Id: ltests.c,v 2.237 2017/12/15 18:53:48 roberto Exp roberto $

** Internal Module for Debugging of the Lua Implementation

** See Copyright Notice in lua.h

*/

#define ltests_c

#define LUA_CORE

#include "lprefix.h"

#include <limits.h>

#include <setjmp.h>

#include <stdio.h>

#include <stdlib.h>

#include <string.h>

#include "lua.h"

#include "lapi.h"

#include "lauxlib.h"

#include "lcode.h"

#include "lctype.h"

#include "ldebug.h"

#include "ldo.h"

#include "lfunc.h"

#include "lmem.h"

#include "lopcodes.h"

#include "lstate.h"

#include "lstring.h"

#include "ltable.h"

#include "lualib.h"

/*

** The whole module only makes sense with LUA_DEBUG on

*/

#if defined(LUA_DEBUG)

void *l_Trick = 0;

#define obj_at(L,k) s2v(L->ci->func + (k))

static int runC (lua_State *L, lua_State *L1, const char *pc);

static void setnameval (lua_State *L, const char *name, int val) {

lua_pushstring(L, name);

lua_pushinteger(L, val);

lua_settable(L, -3);

}

static void pushobject (lua_State *L, const TValue *o) {

setobj2s(L, L->top, o);

api_incr_top(L);

}

static int tpanic (lua_State *L) {

fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",

lua_tostring(L, -1));

return (exit(EXIT_FAILURE), 0); /* do not return to Lua */

}

/*

** {======================================================================

** Controlled version for realloc.

** =======================================================================

*/

#define MARK 0x55 /* 01010101 (a nice pattern) */

typedef union Header {

LUAI_MAXALIGN;

struct {

size_t size;

int type;

} d;

} Header;

#if !defined(EXTERNMEMCHECK)

/* full memory check */

#define MARKSIZE 16 /* size of marks after each block */

#define fillmem(mem,size) memset(mem, -MARK, size)

#else

/* external memory check: don't do it twice */

#define MARKSIZE 0

#define fillmem(mem,size) /* empty */

#endif

Memcontrol l_memcontrol =

{0L, 0L, 0L, 0L, (~0L), {0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L}};

static void freeblock (Memcontrol *mc, Header *block) {

if (block) {

size_t size = block->d.size;

int i;

for (i = 0; i < MARKSIZE; i++) /* check marks after block */

lua_assert(*(cast(char *, block + 1) + size + i) == MARK);

mc->objcount[block->d.type]--;

fillmem(block, sizeof(Header) + size + MARKSIZE); /* erase block */

free(block); /* actually free block */

mc->numblocks--; /* update counts */

mc->total -= size;

}

}

void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) {

Memcontrol *mc = cast(Memcontrol *, ud);

Header *block = cast(Header *, b);

int type;

if (mc->memlimit == 0) { /* first time? */

char *limit = getenv("MEMLIMIT"); /* initialize memory limit */

mc->memlimit = limit ? strtoul(limit, NULL, 10) : ULONG_MAX;

}

if (block == NULL) {

type = (oldsize < LUA_NUMTAGS) ? oldsize : 0;

oldsize = 0;

}

else {

block--; /* go to real header */

type = block->d.type;

lua_assert(oldsize == block->d.size);

}

if (size == 0) {

freeblock(mc, block);

return NULL;

}

if (mc->countlimit != ~0UL && size > 0) { /* count limit in use? */

if (mc->countlimit == 0)

return NULL; /* fake a memory allocation error */

mc->countlimit--;

}

if (size > oldsize && mc->total+size-oldsize > mc->memlimit)

return NULL; /* fake a memory allocation error */

else {

Header *newblock;

int i;

size_t commonsize = (oldsize < size) ? oldsize : size;

size_t realsize = sizeof(Header) + size + MARKSIZE;

if (realsize < size) return NULL; /* arithmetic overflow! */

newblock = cast(Header *, malloc(realsize)); /* alloc a new block */

if (newblock == NULL) return NULL; /* really out of memory? */

if (block) {

memcpy(newblock + 1, block + 1, commonsize); /* copy old contents */

freeblock(mc, block); /* erase (and check) old copy */

}

/* initialize new part of the block with something weird */

fillmem(cast(char *, newblock + 1) + commonsize, size - commonsize);

/* initialize marks after block */

for (i = 0; i < MARKSIZE; i++)

*(cast(char *, newblock + 1) + size + i) = MARK;

newblock->d.size = size;

newblock->d.type = type;

mc->total += size;

if (mc->total > mc->maxmem)

mc->maxmem = mc->total;

mc->numblocks++;

mc->objcount[type]++;

return newblock + 1;

}

}

/* }====================================================================== */

/*

** {======================================================

** Functions to check memory consistency

** =======================================================

*/

/*

** Check GC invariants. For incremental mode, a black object cannot

** point to a white one. For generational mode, really old objects

** cannot point to young objects. Both old1 and touched2 objects

** cannot point to new objects (but can point to survivals).

** (Threads and open upvalues, despite being marked "really old",

** continue to be visited in all collections, and therefore can point to

** new objects. They, and only they, are old but gray.)

*/

static int testobjref1 (global_State *g, GCObject *f, GCObject *t) {

if (isdead(g,t)) return 0;

if (issweepphase(g))

return 1; /* no invariants */

else if (g->gckind == KGC_INC)

return !(isblack(f) && iswhite(t)); /* basic incremental invariant */

else { /* generational mode */

if ((getage(f) == G_OLD && isblack(f)) && !isold(t))

return 0;

if (((getage(f) == G_OLD1 || getage(f) == G_TOUCHED2) && isblack(f)) &&

getage(t) == G_NEW)

return 0;

return 1;

}

}

static void printobj (global_State *g, GCObject *o) {

printf("||%s(%p)-%c%c(%02X)||",

ttypename(novariant(o->tt)), (void *)o,

isdead(g,o) ? 'd' : isblack(o) ? 'b' : iswhite(o) ? 'w' : 'g',

"ns01oTt"[getage(o)], o->marked);

if (o->tt == LUA_TSHRSTR || o->tt == LUA_TLNGSTR)

printf(" '%s'", getstr(gco2ts(o)));

}

static int testobjref (global_State *g, GCObject *f, GCObject *t) {

int r1 = testobjref1(g, f, t);

if (!r1) {

printf("%d(%02X) - ", g->gcstate, g->currentwhite);

printobj(g, f);

printf(" -> ");

printobj(g, t);

printf("\n");

}

return r1;

}

#define checkobjref(g,f,t) \

{ if (t) lua_longassert(testobjref(g,f,obj2gco(t))); }

static void checkvalref (global_State *g, GCObject *f, const TValue *t) {

lua_assert(!iscollectable(t) ||

(righttt(t) && testobjref(g, f, gcvalue(t))));

}

static void checktable (global_State *g, Table *h) {

unsigned int i;

Node *n, *limit = gnode(h, sizenode(h));

GCObject *hgc = obj2gco(h);

checkobjref(g, hgc, h->metatable);

for (i = 0; i < h->sizearray; i++)

checkvalref(g, hgc, &h->array[i]);

for (n = gnode(h, 0); n < limit; n++) {

if (!ttisnil(gval(n))) {

TValue k;

getnodekey(g->mainthread, &k, n);

lua_assert(!keyisnil(n));

checkvalref(g, hgc, &k);

checkvalref(g, hgc, gval(n));

}

}

}

/*

** All marks are conditional because a GC may happen while the

** prototype is still being created

*/

static void checkproto (global_State *g, Proto *f) {

int i;

GCObject *fgc = obj2gco(f);

checkobjref(g, fgc, f->cache);

checkobjref(g, fgc, f->source);

for (i=0; i<f->sizek; i++) {

if (ttisstring(f->k + i))

checkobjref(g, fgc, tsvalue(f->k + i));

}

for (i=0; i<f->sizeupvalues; i++)

checkobjref(g, fgc, f->upvalues[i].name);

for (i=0; i<f->sizep; i++)

checkobjref(g, fgc, f->p[i]);

for (i=0; i<f->sizelocvars; i++)

checkobjref(g, fgc, f->locvars[i].varname);

}

static void checkCclosure (global_State *g, CClosure *cl) {

GCObject *clgc = obj2gco(cl);

int i;

for (i = 0; i < cl->nupvalues; i++)

checkvalref(g, clgc, &cl->upvalue[i]);

}

static void checkLclosure (global_State *g, LClosure *cl) {

GCObject *clgc = obj2gco(cl);

int i;

checkobjref(g, clgc, cl->p);

for (i=0; i<cl->nupvalues; i++) {

UpVal *uv = cl->upvals[i];

if (uv) {

checkobjref(g, clgc, uv);

if (!upisopen(uv))

checkvalref(g, obj2gco(uv), uv->v);

}

}

}

static int lua_checkpc (CallInfo *ci) {

if (!isLua(ci)) return 1;

else {

StkId f = ci->func;

Proto *p = clLvalue(s2v(f))->p;

return p->code <= ci->u.l.savedpc &&

ci->u.l.savedpc <= p->code + p->sizecode;

}

}

static void checkstack (global_State *g, lua_State *L1) {

StkId o;

CallInfo *ci;

UpVal *uv;

lua_assert(!isdead(g, L1));

for (uv = L1->openupval; uv != NULL; uv = uv->u.open.next)

lua_assert(upisopen(uv)); /* must be open */

for (ci = L1->ci; ci != NULL; ci = ci->previous) {

lua_assert(ci->top <= L1->stack_last);

lua_assert(lua_checkpc(ci));

}

if (L1->stack) { /* complete thread? */

for (o = L1->stack; o < L1->stack_last + EXTRA_STACK; o++)

checkliveness(L1, s2v(o)); /* entire stack must have valid values */

}

else lua_assert(L1->stacksize == 0);

}

static void checkrefs (global_State *g, GCObject *o) {

switch (o->tt) {

case LUA_TUSERDATA: {

TValue uservalue;

Table *mt = gco2u(o)->metatable;

checkobjref(g, o, mt);

getuservalue(g->mainthread, gco2u(o), &uservalue);

checkvalref(g, o, &uservalue);

break;

}

case LUA_TUPVAL: {

checkvalref(g, o, gco2upv(o)->v);

break;

}

case LUA_TTABLE: {

checktable(g, gco2t(o));

break;

}

case LUA_TTHREAD: {

checkstack(g, gco2th(o));

break;

}

case LUA_TLCL: {

checkLclosure(g, gco2lcl(o));

break;

}

case LUA_TCCL: {

checkCclosure(g, gco2ccl(o));

break;

}

case LUA_TPROTO: {

checkproto(g, gco2p(o));

break;

}

case LUA_TSHRSTR:

case LUA_TLNGSTR: {

lua_assert(!isgray(o)); /* strings are never gray */

break;

}

default: lua_assert(0);

}

}

/*

** Check consistency of an object:

** - Dead objects can only happen in the 'allgc' list during a sweep

** phase (controled by the caller through 'maybedead').

** - During pause, all objects must be white.

** - In generational mode:

** * objects must be old enough for their lists ('listage').

** * old objects cannot be white.

** * old objects must be black, except for 'touched1', 'old0',

** threads, and open upvalues.

*/

static void checkobject (global_State *g, GCObject *o, int maybedead,

int listage) {

if (isdead(g, o))

lua_assert(maybedead);

else {

lua_assert(g->gcstate != GCSpause || iswhite(o));

if (g->gckind == KGC_GEN) { /* generational mode? */

lua_assert(getage(o) >= listage);

lua_assert(!iswhite(o) || !isold(o));

if (isold(o)) {

lua_assert(isblack(o) ||

getage(o) == G_TOUCHED1 ||

getage(o) == G_OLD0 ||

o->tt == LUA_TTHREAD ||

(o->tt == LUA_TPROTO &&

(gco2p(o)->cache != NULL || gco2p(o)->cachemiss >= MAXMISS)) ||

(o->tt == LUA_TUPVAL && upisopen(gco2upv(o))));

}

}

checkrefs(g, o);

}

}

static void checkgraylist (global_State *g, GCObject *o) {

((void)g); /* better to keep it available if we need to print an object */

while (o) {

lua_assert(isgray(o) || getage(o) == G_TOUCHED2);

lua_assert(!testbit(o->marked, TESTGRAYBIT));

l_setbit(o->marked, TESTGRAYBIT);

switch (o->tt) {

case LUA_TTABLE: o = gco2t(o)->gclist; break;

case LUA_TLCL: o = gco2lcl(o)->gclist; break;

case LUA_TCCL: o = gco2ccl(o)->gclist; break;

case LUA_TTHREAD: o = gco2th(o)->gclist; break;

case LUA_TPROTO: o = gco2p(o)->gclist; break;

default: lua_assert(0); /* other objects cannot be in a gray list */

}

}

}

/*

** mark all objects in gray lists with the TESTGRAYBIT, so that

** 'checkmemory' can check that all gray objects are in a gray list

*/

static void markgrays (global_State *g) {

if (!keepinvariant(g)) return;

checkgraylist(g, g->gray);

checkgraylist(g, g->grayagain);

checkgraylist(g, g->weak);

checkgraylist(g, g->ephemeron);

checkgraylist(g, g->protogray);

}

static void checkgray (global_State *g, GCObject *o) {

for (; o != NULL; o = o->next) {

if ((isgray(o) && o->tt != LUA_TUPVAL) || getage(o) == G_TOUCHED2) {

lua_assert(!keepinvariant(g) || testbit(o->marked, TESTGRAYBIT));

resetbit(o->marked, TESTGRAYBIT);

}

lua_assert(!testbit(o->marked, TESTGRAYBIT));

}

}

static void checklist (global_State *g, int maybedead, int tof,

GCObject *newl, GCObject *survival, GCObject *old, GCObject *reallyold) {

GCObject *o;

for (o = newl; o != survival; o = o->next) {

checkobject(g, o, maybedead, G_NEW);

lua_assert(!tof == !tofinalize(o));

}

for (o = survival; o != old; o = o->next) {

checkobject(g, o, 0, G_SURVIVAL);

lua_assert(!tof == !tofinalize(o));

}

for (o = old; o != reallyold; o = o->next) {

checkobject(g, o, 0, G_OLD1);

lua_assert(!tof == !tofinalize(o));

}

for (o = reallyold; o != NULL; o = o->next) {

checkobject(g, o, 0, G_OLD);

lua_assert(!tof == !tofinalize(o));

}

}

int lua_checkmemory (lua_State *L) {

global_State *g = G(L);

GCObject *o;

int maybedead;

if (keepinvariant(g)) {

lua_assert(!iswhite(g->mainthread));

lua_assert(!iswhite(gcvalue(&g->l_registry)));

}

lua_assert(!isdead(g, gcvalue(&g->l_registry)));

lua_assert(g->sweepgc == NULL || issweepphase(g));

markgrays(g);

/* check 'fixedgc' list */

for (o = g->fixedgc; o != NULL; o = o->next) {

lua_assert(o->tt == LUA_TSHRSTR && isgray(o) && getage(o) == G_OLD);

}

/* check 'allgc' list */

checkgray(g, g->allgc);

maybedead = (GCSatomic < g->gcstate && g->gcstate <= GCSswpallgc);

checklist(g, maybedead, 0, g->allgc, g->survival, g->old, g->reallyold);

/* check 'finobj' list */

checkgray(g, g->finobj);

checklist(g, 0, 1, g->finobj, g->finobjsur, g->finobjold, g->finobjrold);

/* check 'tobefnz' list */

checkgray(g, g->tobefnz);

for (o = g->tobefnz; o != NULL; o = o->next) {

checkobject(g, o, 0, G_NEW);

lua_assert(tofinalize(o));

lua_assert(o->tt == LUA_TUSERDATA || o->tt == LUA_TTABLE);

}

return 0;

}

/* }====================================================== */

/*

** {======================================================

** Disassembler

** =======================================================

*/

static char *buildop (Proto *p, int pc, char *buff) {

Instruction i = p->code[pc];

OpCode o = GET_OPCODE(i);

const char *name = luaP_opnames[o];

int line = luaG_getfuncline(p, pc);

sprintf(buff, "(%4d) %4d - ", line, pc);

switch (getOpMode(o)) {

case iABC:

sprintf(buff+strlen(buff), "%-12s%4d %4d %4d%s", name,

GETARG_A(i), GETARG_B(i), GETARG_C(i),

GETARG_k(i) ? " (k)" : "");

break;

case iABx:

sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i),

GETARG_Bx(i));

break;

case iAsBx:

sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i),

GETARG_sBx(i));

break;

case iAx:

sprintf(buff+strlen(buff), "%-12s%4d", name, GETARG_Ax(i));

break;

case isJ:

sprintf(buff+strlen(buff), "%-12s%4d (%1d)", name, GETARG_sJ(i),

!!GETARG_k(i));

break;

}

return buff;

}

#if 0

void luaI_printcode (Proto *pt, int size) {

int pc;

for (pc=0; pc<size; pc++) {

char buff[100];

printf("%s\n", buildop(pt, pc, buff));

}

printf("-------\n");

}

void luaI_printinst (Proto *pt, int pc) {

char buff[100];

printf("%s\n", buildop(pt, pc, buff));

}

#endif

static int listcode (lua_State *L) {

int pc;

Proto *p;

luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),

1, "Lua function expected");

p = getproto(obj_at(L, 1));

lua_newtable(L);

setnameval(L, "maxstack", p->maxstacksize);

setnameval(L, "numparams", p->numparams);

for (pc=0; pc<p->sizecode; pc++) {

char buff[100];

lua_pushinteger(L, pc+1);

lua_pushstring(L, buildop(p, pc, buff));

lua_settable(L, -3);

}

return 1;

}

static int printcode (lua_State *L) {

int pc;

Proto *p;

luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),

1, "Lua function expected");

p = getproto(obj_at(L, 1));

printf("maxstack: %d\n", p->maxstacksize);

printf("numparams: %d\n", p->numparams);

for (pc=0; pc<p->sizecode; pc++) {

char buff[100];

printf("%d\t%s\n", pc + 1, buildop(p, pc, buff));

}

return 0;

}

static int listk (lua_State *L) {

Proto *p;

int i;

luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),

1, "Lua function expected");

p = getproto(obj_at(L, 1));

lua_createtable(L, p->sizek, 0);

for (i=0; i<p->sizek; i++) {

pushobject(L, p->k+i);

lua_rawseti(L, -2, i+1);

}

return 1;

}

static int listlocals (lua_State *L) {

Proto *p;

int pc = cast_int(luaL_checkinteger(L, 2)) - 1;

int i = 0;

const char *name;

luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),

1, "Lua function expected");

p = getproto(obj_at(L, 1));

while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)

lua_pushstring(L, name);

return i-1;

}

/* }====================================================== */

static void printstack (lua_State *L) {

int i;

int n = lua_gettop(L);

for (i = 1; i <= n; i++) {

printf("%3d: %s\n", i, luaL_tolstring(L, i, NULL));

lua_pop(L, 1);

}

printf("\n");

}

static int get_limits (lua_State *L) {

lua_createtable(L, 0, 5);

setnameval(L, "BITS_INT", LUAI_BITSINT);

setnameval(L, "MAXARG_Ax", MAXARG_Ax);

setnameval(L, "MAXARG_Bx", MAXARG_Bx);

setnameval(L, "OFFSET_sBx", OFFSET_sBx);

setnameval(L, "BITS_INT", LUAI_BITSINT);

setnameval(L, "LFPF", LFIELDS_PER_FLUSH);

setnameval(L, "NUM_OPCODES", NUM_OPCODES);

return 1;

}

static int mem_query (lua_State *L) {

if (lua_isnone(L, 1)) {

lua_pushinteger(L, l_memcontrol.total);

lua_pushinteger(L, l_memcontrol.numblocks);

lua_pushinteger(L, l_memcontrol.maxmem);

return 3;

}

else if (lua_isnumber(L, 1)) {

unsigned long limit = cast(unsigned long, luaL_checkinteger(L, 1));

if (limit == 0) limit = ULONG_MAX;

l_memcontrol.memlimit = limit;

return 0;

}

else {

const char *t = luaL_checkstring(L, 1);

int i;

for (i = LUA_NUMTAGS - 1; i >= 0; i--) {

if (strcmp(t, ttypename(i)) == 0) {

lua_pushinteger(L, l_memcontrol.objcount[i]);

return 1;

}

}

return luaL_error(L, "unkown type '%s'", t);

}

}

static int alloc_count (lua_State *L) {

if (lua_isnone(L, 1))

l_memcontrol.countlimit = ~0L;

else

l_memcontrol.countlimit = luaL_checkinteger(L, 1);

return 0;

}

static int settrick (lua_State *L) {

if (ttisnil(obj_at(L, 1)))

l_Trick = NULL;

else

l_Trick = gcvalue(obj_at(L, 1));

return 0;

}

static int gc_color (lua_State *L) {

TValue *o;

luaL_checkany(L, 1);

o = obj_at(L, 1);

if (!iscollectable(o))

lua_pushstring(L, "no collectable");

else {

GCObject *obj = gcvalue(o);

lua_pushstring(L, isdead(G(L), obj) ? "dead" :

iswhite(obj) ? "white" :

isblack(obj) ? "black" : "grey");

}

return 1;

}

static int gc_age (lua_State *L) {

TValue *o;

luaL_checkany(L, 1);

o = obj_at(L, 1);

if (!iscollectable(o))

lua_pushstring(L, "no collectable");

else {

static const char *gennames[] = {"new", "survival", "old0", "old1",

"old", "touched1", "touched2"};

GCObject *obj = gcvalue(o);

lua_pushstring(L, gennames[getage(obj)]);

}

return 1;

}

static int gc_printobj (lua_State *L) {

TValue *o;

luaL_checkany(L, 1);

o = obj_at(L, 1);

if (!iscollectable(o))

printf("no collectable\n");

else {

GCObject *obj = gcvalue(o);

printobj(G(L), obj);

printf("\n");

}

return 0;

}

static int gc_state (lua_State *L) {

static const char *statenames[] = {

"propagate", "atomic", "enteratomic", "sweepallgc", "sweepfinobj",

"sweeptobefnz", "sweepend", "callfin", "pause", ""};

static const int states[] = {

GCSpropagate, GCSenteratomic, GCSatomic, GCSswpallgc, GCSswpfinobj,

GCSswptobefnz, GCSswpend, GCScallfin, GCSpause, -1};

int option = states[luaL_checkoption(L, 1, "", statenames)];

if (option == -1) {

lua_pushstring(L, statenames[G(L)->gcstate]);

return 1;

}

else {

global_State *g = G(L);

if (G(L)->gckind == KGC_GEN)

luaL_error(L, "cannot change states in generational mode");

lua_lock(L);

if (option < g->gcstate) { /* must cross 'pause'? */

luaC_runtilstate(L, bitmask(GCSpause)); /* run until pause */

}

luaC_runtilstate(L, bitmask(option));

lua_assert(G(L)->gcstate == option);

lua_unlock(L);

return 0;

}

}

static int hash_query (lua_State *L) {

if (lua_isnone(L, 2)) {

luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected");

lua_pushinteger(L, tsvalue(obj_at(L, 1))->hash);

}

else {

TValue *o = obj_at(L, 1);

Table *t;

luaL_checktype(L, 2, LUA_TTABLE);

t = hvalue(obj_at(L, 2));

lua_pushinteger(L, luaH_mainposition(t, o) - t->node);

}

return 1;

}

static int stacklevel (lua_State *L) {

unsigned long a = 0;

lua_pushinteger(L, (L->top - L->stack));

lua_pushinteger(L, (L->stack_last - L->stack));

lua_pushinteger(L, L->nCcalls);

lua_pushinteger(L, L->nci);

lua_pushinteger(L, (unsigned long)&a);

return 5;

}

static int table_query (lua_State *L) {

const Table *t;

int i = cast_int(luaL_optinteger(L, 2, -1));

luaL_checktype(L, 1, LUA_TTABLE);

t = hvalue(obj_at(L, 1));

if (i == -1) {

lua_pushinteger(L, t->sizearray);

lua_pushinteger(L, allocsizenode(t));

lua_pushinteger(L, isdummy(t) ? 0 : t->lastfree - t->node);

}

else if ((unsigned int)i < t->sizearray) {

lua_pushinteger(L, i);

pushobject(L, &t->array[i]);

lua_pushnil(L);

}

else if ((i -= t->sizearray) < sizenode(t)) {

TValue k;

getnodekey(L, &k, gnode(t, i));

if (!ttisnil(gval(gnode(t, i))) ||

ttisnil(&k) ||

ttisnumber(&k)) {

pushobject(L, &k);

}

else

lua_pushliteral(L, "<undef>");

pushobject(L, gval(gnode(t, i)));

if (gnext(&t->node[i]) != 0)

lua_pushinteger(L, gnext(&t->node[i]));

else

lua_pushnil(L);

}

return 3;

}

static int string_query (lua_State *L) {

stringtable *tb = &G(L)->strt;

int s = cast_int(luaL_optinteger(L, 1, 0)) - 1;

if (s == -1) {

lua_pushinteger(L ,tb->size);

lua_pushinteger(L ,tb->nuse);

return 2;

}

else if (s < tb->size) {

TString *ts;

int n = 0;

for (ts = tb->hash[s]; ts != NULL; ts = ts->u.hnext) {

setsvalue2s(L, L->top, ts);

api_incr_top(L);

n++;

}

return n;

}

else return 0;

}

static int tref (lua_State *L) {

int level = lua_gettop(L);

luaL_checkany(L, 1);

lua_pushvalue(L, 1);

lua_pushinteger(L, luaL_ref(L, LUA_REGISTRYINDEX));

lua_assert(lua_gettop(L) == level+1); /* +1 for result */

return 1;

}

static int getref (lua_State *L) {

int level = lua_gettop(L);

lua_rawgeti(L, LUA_REGISTRYINDEX, luaL_checkinteger(L, 1));

lua_assert(lua_gettop(L) == level+1);

return 1;

}

static int unref (lua_State *L) {

int level = lua_gettop(L);

luaL_unref(L, LUA_REGISTRYINDEX, cast_int(luaL_checkinteger(L, 1)));

lua_assert(lua_gettop(L) == level);

return 0;

}

static int upvalue (lua_State *L) {

int n = cast_int(luaL_checkinteger(L, 2));

luaL_checktype(L, 1, LUA_TFUNCTION);

if (lua_isnone(L, 3)) {

const char *name = lua_getupvalue(L, 1, n);

if (name == NULL) return 0;

lua_pushstring(L, name);

return 2;

}

else {

const char *name = lua_setupvalue(L, 1, n);

lua_pushstring(L, name);

return 1;

}

}

static int newuserdata (lua_State *L) {

size_t size = cast(size_t, luaL_checkinteger(L, 1));

char *p = cast(char *, lua_newuserdata(L, size));

while (size--) *p++ = '\0';

return 1;

}

static int pushuserdata (lua_State *L) {

lua_Integer u = luaL_checkinteger(L, 1);

lua_pushlightuserdata(L, cast(void *, cast(size_t, u)));

return 1;

}

static int udataval (lua_State *L) {

lua_pushinteger(L, cast(long, lua_touserdata(L, 1)));

return 1;

}

static int doonnewstack (lua_State *L) {

lua_State *L1 = lua_newthread(L);

size_t l;

const char *s = luaL_checklstring(L, 1, &l);

int status = luaL_loadbuffer(L1, s, l, s);

if (status == LUA_OK)

status = lua_pcall(L1, 0, 0, 0);

lua_pushinteger(L, status);

return 1;

}

static int s2d (lua_State *L) {

lua_pushnumber(L, *cast(const double *, luaL_checkstring(L, 1)));

return 1;

}

static int d2s (lua_State *L) {

double d = luaL_checknumber(L, 1);

lua_pushlstring(L, cast(char *, &d), sizeof(d));

return 1;

}

static int num2int (lua_State *L) {

lua_pushinteger(L, lua_tointeger(L, 1));

return 1;

}

static int newstate (lua_State *L) {

void *ud;

lua_Alloc f = lua_getallocf(L, &ud);

lua_State *L1 = lua_newstate(f, ud);

if (L1) {

lua_atpanic(L1, tpanic);

lua_pushlightuserdata(L, L1);

}

else

lua_pushnil(L);

return 1;

}

static lua_State *getstate (lua_State *L) {

lua_State *L1 = cast(lua_State *, lua_touserdata(L, 1));

luaL_argcheck(L, L1 != NULL, 1, "state expected");

return L1;

}

static int loadlib (lua_State *L) {

static const luaL_Reg libs[] = {

{LUA_GNAME, luaopen_base},

{"coroutine", luaopen_coroutine},

{"debug", luaopen_debug},

{"io", luaopen_io},

{"os", luaopen_os},