int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
int res;
if (ttype(l) != ttype(r))
return luaG_ordererror(L, l, r);
else if (ttisnumber(l))
return nvalue(l) < nvalue(r);
else if (ttisstring(l))
return luaV_strcmp(tsvalue(l), tsvalue(r)) < 0;
else if ((res = call_orderTM(L, l, r, TM_LT)) != -1)
return res;
return luaG_ordererror(L, l, r);
}
/*
** Main operation for equality of Lua values; return 't1 == t2'.
** L == NULL means raw equality (no metamethods)
*/
int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
const TValue *tm;
if (ttype(t1) != ttype(t2)) { /* not the same variant? */
#ifndef _KERNEL
if (ttnov(t1) != ttnov(t2) || ttnov(t1) != LUA_TNUMBER)
return 0; /* only numbers can be equal with different variants */
else { /* two numbers with different variants */
lua_Integer i1, i2; /* compare them as integers */
return (tointeger(t1, &i1) && tointeger(t2, &i2) && i1 == i2);
}
#else /* _KERNEL */
return 0; /* numbers have only the integer variant */
#endif /* _KERNEL */
}
/* values have same type and same variant */
switch (ttype(t1)) {
case LUA_TNIL: return 1;
case LUA_TNUMINT: return (ivalue(t1) == ivalue(t2));
#ifndef _KERNEL
case LUA_TNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
#endif /* _KERNEL */
case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */
case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
case LUA_TLCF: return fvalue(t1) == fvalue(t2);
case LUA_TSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
case LUA_TLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
case LUA_TUSERDATA: {
if (uvalue(t1) == uvalue(t2)) return 1;
else if (L == NULL) return 0;
tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
if (tm == NULL)
tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
break; /* will try TM */
}
case LUA_TTABLE: {
if (hvalue(t1) == hvalue(t2)) return 1;
else if (L == NULL) return 0;
tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
if (tm == NULL)
tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);
break; /* will try TM */
}
default:
return gcvalue(t1) == gcvalue(t2);
}
if (tm == NULL) /* no TM? */
return 0; /* objects are different */
luaT_callTM(L, tm, t1, t2, L->top, 1); /* call TM */
return !l_isfalse(L->top);
}
static int luaV_lessequal (lua_State *L, const TObject *l, const TObject *r) {
int res;
if (ttype(l) != ttype(r))
return luaG_ordererror(L, l, r);
else if (ttisnumber(l))
return nvalue(l) <= nvalue(r);
else if (ttisstring(l))
return luaV_strcmp(tsvalue(l), tsvalue(r)) <= 0;
else if ((res = call_orderTM(L, l, r, TM_LE)) != -1) /* first try `le' */
return res;
else if ((res = call_orderTM(L, r, l, TM_LT)) != -1) /* else try `lt' */
return !res;
return luaG_ordererror(L, l, r);
}
LUA_API size_t lua_strlen (lua_State *L, int idx) {
StkId o = luaA_indexAcceptable(L, idx);
if (o == NULL)
return 0;
else if (ttisstring(o))
return tsvalue(o)->tsv.len;
else {
size_t l;
lua_lock(L); /* `luaV_tostring' may create a new string */
l = (luaV_tostring(L, o) ? tsvalue(o)->tsv.len : 0);
lua_unlock(L);
return l;
}
}
/*
** Main operation less than; return 'l < r'.
*/
int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
int res;
#ifndef _KERNEL
if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
return LTnum(l, r);
#else /* _KERNEL */
if (ttisinteger(l) && ttisinteger(r)) /* both operands are integers? */
return (ivalue(l) < ivalue(r));
#endif /* _KERNEL */
else if (ttisstring(l) && ttisstring(r)) /* both are strings? */
return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
else if ((res = luaT_callorderTM(L, l, r, TM_LT)) < 0) /* no metamethod? */
luaG_ordererror(L, l, r); /* error */
return res;
}
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top) {
if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
return (nvalue(l) < nvalue(r));
else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0);
else { /* call TM */
luaD_checkstack(L, 2);
*top++ = *l;
*top++ = *r;
if (!call_binTM(L, top, TM_LT))
luaG_ordererror(L, top-2);
L->top--;
return (ttype(L->top) != LUA_TNIL);
}
}
static int32 hashindex(TObject *r) {
int32 h;
switch (ttype(r)) {
case LUA_T_NUMBER:
h = (int32)nvalue(r);
break;
case LUA_T_USERDATA:
h = (int32)r->value.ud.id;
case LUA_T_STRING:
h = (int32)tsvalue(r);
break;
case LUA_T_ARRAY:
h = (int32)avalue(r);
break;
case LUA_T_PROTO:
h = (int32)tfvalue(r);
break;
case LUA_T_CPROTO:
h = (int32)fvalue(r);
break;
case LUA_T_CLOSURE:
h = (int32)clvalue(r);
break;
case LUA_T_TASK:
h = (int32)nvalue(r);
break;
default:
lua_error("unexpected type to index table");
h = 0; // to avoid warnings
}
return (h >= 0 ? h : -(h + 1));
}
void lua_pushlstring (char *s, long len)
{
tsvalue(L->stack.top) = luaS_newlstr(s, len);
ttype(L->stack.top) = LUA_T_STRING;
incr_top;
luaC_checkGC();
}
long lua_strlen (lua_Object object)
{
luaC_checkGC(); /* "tostring" may create a new string */
if (object == LUA_NOOBJECT || tostring(Address(object)))
return 0L;
else return (tsvalue(Address(object))->u.s.len);
}
static long int hashindex (TObject *ref)
{
long int h;
switch (ttype(ref)) {
case LUA_T_NUMBER:
h = (long int)nvalue(ref);
break;
case LUA_T_STRING: case LUA_T_USERDATA:
h = (IntPoint)tsvalue(ref);
break;
case LUA_T_ARRAY:
h = (IntPoint)avalue(ref);
break;
case LUA_T_PROTO:
h = (IntPoint)tfvalue(ref);
break;
case LUA_T_CPROTO:
h = (IntPoint)fvalue(ref);
break;
case LUA_T_CLOSURE:
h = (IntPoint)clvalue(ref);
break;
default:
lua_error("unexpected type to index table");
h = 0; /* to avoid warnings */
}
return (h >= 0 ? h : -(h+1));
}
static void DumpConstants(TProtoFunc* tf, FILE* D) {
int i,n;
n = tf->nconsts;
DumpWord(n,D);
for (i=0; i<n; i++) {
TObject* o=tf->consts+i;
switch (ttype(o)) {
case LUA_T_NUMBER:
fputc('N',D);
DumpNumber(nvalue(o),D);
break;
case LUA_T_STRING:
fputc('S',D);
DumpTString(tsvalue(o),D);
break;
case LUA_T_PROTO:
fputc('F',D);
break;
case LUA_T_NIL:
fputc(-ttype(o),D);
break;
default: /* cannot happen */
luaL_verror("cannot dump constant #%d: type=%d [%s]",
i,ttype(o),luaO_typename(o));
break;
}
}
}
bool cmp(const TObject *a, const TObject *b) {
if (ttype(a) != ttype(b))
return false;
if (ttype(a) == LUA_T_PROTO)
return true;
if (ttype(a) == LUA_T_NUMBER) {
//A simple fp comparision
double diff, fa, fb, largest;
diff = fabs(nvalue(a) - nvalue(b));
fa = fabs(nvalue(a));
fb = fabs(nvalue(b));
largest = (fb > fa) ? fb : fa;
if (diff <= largest * 1e-5) //Ten parts in a million should be enough
return true;
else
return false;
}
if (ttype(a) == LUA_T_STRING)
if (strncmp(svalue(a), svalue(b), tsvalue(a)->u.s.len) == 0)
return true;
return false;
}
static void DumpConstants(const Proto* f, DumpState* D)
{
int i,n;
DumpInt(n=f->sizek,D);
for (i=0; i<n; i++)
{
const TObject* o=&f->k[i];
DumpByte(ttype(o),D);
switch (ttype(o))
{
case LUA_TNUMBER:
DumpNumber(nvalue(o),D);
break;
case LUA_TSTRING:
DumpString(tsvalue(o),D);
break;
case LUA_TNIL:
break;
default:
lua_assert(0); /* cannot happen */
break;
}
}
DumpInt(n=f->sizep,D);
for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D);
}
LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
TString *ts = luaS_newudata(L, size, NULL);
tsvalue(L->top) = ts;
ttype(L->top) = LUA_TUSERDATA;
api_incr_top(L);
return ts->u.d.value;
}
int luaO_equalObj (const TObject *t1, const TObject *t2) {
if (ttype(t1) != ttype(t2)) return 0;
switch (ttype(t1)) {
case LUA_TNUMBER:
return nvalue(t1) == nvalue(t2);
case LUA_TSTRING: case LUA_TUSERDATA:
return tsvalue(t1) == tsvalue(t2);
case LUA_TTABLE:
return hvalue(t1) == hvalue(t2);
case LUA_TFUNCTION:
return clvalue(t1) == clvalue(t2);
default:
LUA_ASSERT(ttype(t1) == LUA_TNIL, "invalid type");
return 1; /* LUA_TNIL */
}
}
static void PrintConstant(const Proto* f, int i)
{
const TValue* o=&f->k[i];
switch (ttype(o))
{
case LUA_TNIL:
printf("nil");
break;
case LUA_TBOOLEAN:
printf(bvalue(o) ? "true" : "false");
break;
case LUA_TNUMFLT:
{
char buff[100];
sprintf(buff,LUA_NUMBER_FMT,fltvalue(o));
printf("%s",buff);
if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0");
break;
}
case LUA_TNUMINT:
printf(LUA_INTEGER_FMT,ivalue(o));
break;
case LUA_TSHRSTR: case LUA_TLNGSTR:
PrintString(tsvalue(o));
break;
default: /* cannot happen */
printf("? type=%d",ttype(o));
break;
}
}
const TObject *luaH_get (lua_State *L, const Hash *t, const TObject *key) {
switch (ttype(key)) {
case LUA_TNUMBER: return luaH_getnum(t, nvalue(key));
case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));
default: return luaH_getany(L, t, key);
}
}
static void DumpConstants (const Proto *f, DumpState *D) {
int i;
int n = f->sizek;
DumpInt(n, D);
for (i = 0; i < n; i++) {
const TValue *o = &f->k[i];
DumpByte(ttype(o), D);
switch (ttype(o)) {
case LUA_TNIL:
break;
case LUA_TBOOLEAN:
DumpByte(bvalue(o), D);
break;
case LUA_TNUMFLT:
DumpNumber(fltvalue(o), D);
break;
case LUA_TNUMINT:
DumpInteger(ivalue(o), D);
break;
case LUA_TSHRSTR:
case LUA_TLNGSTR:
DumpString(tsvalue(o), D);
break;
default:
lua_assert(0);
}
}
}
static void PackConstants(Proto* tf, Hash* map)
{
int i,j,k,n;
TObject o;
#ifdef DEBUG
printf("%p before pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr);
#endif
j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER;
for (i=0; i<n; i++)
{
nvalue(&o)=tf->knum[i];
k=MapConstant(map,-1,&o);
if (k==j) tf->knum[j++]=tf->knum[i];
}
tf->nknum=j;
j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING;
for (i=0; i<n; i++)
{
tsvalue(&o)=tf->kstr[i];
k=MapConstant(map,-1,&o);
if (k==j) tf->kstr[j++]=tf->kstr[i];
}
tf->nkstr=j;
#ifdef DEBUG
printf("%p after pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr);
#endif
}
static void adjust_varargs (StkId first_extra_arg)
{
Object arg;
Object *firstelem = stack+first_extra_arg;
int nvararg = top-firstelem;
int i;
if (nvararg < 0) nvararg = 0;
avalue(&arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */
tag(&arg) = LUA_T_ARRAY;
for (i=0; i<nvararg; i++) {
Object index;
tag(&index) = LUA_T_NUMBER;
nvalue(&index) = i+1;
*(lua_hashdefine(avalue(&arg), &index)) = *(firstelem+i);
}
/* store counter in field "n" */ {
Object index, extra;
tag(&index) = LUA_T_STRING;
tsvalue(&index) = lua_createstring("n");
tag(&extra) = LUA_T_NUMBER;
nvalue(&extra) = nvararg;
*(lua_hashdefine(avalue(&arg), &index)) = extra;
}
adjust_top(first_extra_arg);
*top = arg; incr_top;
}
/*
** tells whether a key or value can be cleared from a weak
** table. Non-collectable objects are never removed from weak
** tables. Strings behave as 'values', so are never removed too. for
** other objects: if really collected, cannot keep them; for objects
** being finalized, keep them in keys, but not in values
*/
static int iscleared (global_State *g, const TValue *o) {
if (!iscollectable(o)) return 0;
else if (ttisstring(o)) {
markobject(g, tsvalue(o)); /* strings are 'values', so are never weak */
return 0;
}
else return iswhite(gcvalue(o));
}
void luaH_setstrnum (lua_State *L, Hash *t, TString *key, Number val) {
TObject *value, index;
ttype(&index) = LUA_TSTRING;
tsvalue(&index) = key;
value = luaH_set(L, t, &index);
ttype(value) = LUA_TNUMBER;
nvalue(value) = val;
}
void lua_pushusertag(void *u, int32 tag) {
if (tag < 0 && tag != LUA_ANYTAG)
luaT_realtag(tag); // error if tag is not valid
tsvalue(lua_state->stack.top) = luaS_createudata(u, tag);
ttype(lua_state->stack.top) = LUA_T_USERDATA;
incr_top;
luaC_checkGC();
}
void lua_pushusertag (void *u, int tag)
{
if (tag < 0 && tag != LUA_ANYTAG)
luaI_realtag(tag); /* error if tag is not valid */
tsvalue(top) = luaI_createudata(u, tag);
ttype(top) = LUA_T_USERDATA;
incr_top;
}
LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
/* TString *ts = luaS_newudata(L, size, NULL); */
TString *ts = luaS_newudata(L, (size==0) ? 1 : size, NULL); /* change in version 4.0.1 reported by VP */
tsvalue(L->top) = ts;
ttype(L->top) = LUA_TUSERDATA;
api_incr_top(L);
return ts->u.d.value;
}
/*
** Main operation less than or equal to; return 'l <= r'. If it needs
** a metamethod and there is no '__le', try '__lt', based on
** l <= r iff !(r < l) (assuming a total order). If the metamethod
** yields during this substitution, the continuation has to know
** about it (to negate the result of r<l); bit CIST_LEQ in the call
** status keeps that information.
*/
int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
int res;
if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
return LEnum(l, r);
else if (ttisstring(l) && ttisstring(r)) /* both are strings? */
return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0) /* try 'le' */
return res;
else { /* try 'lt': */
L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
res = luaT_callorderTM(L, r, l, TM_LT);
L->ci->callstatus ^= CIST_LEQ; /* clear mark */
if (res < 0)
luaG_ordererror(L, l, r);
return !res; /* result is negated */
}
}
LUA_API void lua_pushusertag (lua_State *L, void *u, int tag) {
/* ORDER LUA_T */
if (!(tag == LUA_ANYTAG || tag == LUA_TUSERDATA || validtag(tag)))
luaO_verror(L, "invalid tag for a userdata (%d)", tag);
tsvalue(L->top) = luaS_createudata(L, u, tag);
ttype(L->top) = LUA_TUSERDATA;
api_incr_top(L);
}
void luaV_concat (lua_State *L, int total, int last) {
lu_mem max_sizet = MAX_SIZET;
if (G(L)->memlimit < max_sizet) max_sizet = G(L)->memlimit;
do {
/* Any call which does a memory allocation may trim the stack,
invalidating top unless the stack is fixed duri ng the allocation */
StkId top = L->base + last + 1;
fixedstack(L);
int n = 2; /* number of elements handled in this pass (at least 2) */
if (!(ttisstring(top-2) || ttisnumber(top-2)) || !tostring(L, top-1)) {
unfixedstack(L);
if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT)) {
/* restore 'top' pointer, since stack might have been reallocted */
top = L->base + last + 1;
luaG_concaterror(L, top-2, top-1);
}
} else if (tsvalue(top-1)->len == 0) { /* second op is empty? */
(void)tostring(L, top - 2); /* result is first op (as string) */
} else {
/* at least two string values; get as many as possible */
size_t tl = tsvalue(top-1)->len;
char *buffer;
int i;
/* collect total length */
for (n = 1; n < total && tostring(L, top-n-1); n++) {
size_t l = tsvalue(top-n-1)->len;
if (l >= max_sizet - tl) luaG_runerror(L, "string length overflow");
tl += l;
}
G(L)->buff.n = tl;
buffer = luaZ_openspace(L, &G(L)->buff, tl);
tl = 0;
for (i=n; i>0; i--) { /* concat all strings */
size_t l = tsvalue(top-i)->len;
c_memcpy(buffer+tl, svalue(top-i), l);
tl += l;
}
setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl));
luaZ_resetbuffer(&G(L)->buff);
}
total -= n-1; /* got `n' strings to create 1 new */
last -= n-1;
unfixedstack(L);
} while (total > 1); /* repeat until only 1 result left */
}
void luaV_strconc (lua_State *L, int total, StkId top) {
do {
int n = 2; /* number of elements handled in this pass (at least 2) */
if (tostring(L, top-2) || tostring(L, top-1)) {
if (!call_binTM(L, top, TM_CONCAT))
luaG_binerror(L, top-2, LUA_TSTRING, "concat");
}
else if (tsvalue(top-1)->len > 0) { /* if len=0, do nothing */
/* at least two string values; get as many as possible */
lint32 tl = (lint32)tsvalue(top-1)->len +
(lint32)tsvalue(top-2)->len;
char *buffer;
int i;
while (n < total && !tostring(L, top-n-1)) { /* collect total length */
tl += tsvalue(top-n-1)->len;
n++;
}
if (tl > MAX_SIZET) lua_error(L, "string size overflow");
buffer = luaO_openspace(L, tl);
tl = 0;
for (i=n; i>0; i--) { /* concat all strings */
size_t l = tsvalue(top-i)->len;
memcpy(buffer+tl, tsvalue(top-i)->str, l);
tl += l;
}
tsvalue(top-n) = luaS_newlstr(L, buffer, tl);
}
total -= n-1; /* got `n' strings to create 1 new */
top -= n-1;
} while (total > 1); /* repeat until only 1 result left */
}
LUA_API size_t lua_rawlen (lua_State *L, int idx) {
StkId o = index2addr(L, idx);
switch (ttypenv(o)) {
case LUA_TSTRING: return tsvalue(o)->len;
case LUA_TUSERDATA: return uvalue(o)->len;
case LUA_TTABLE: return luaH_getn(hvalue(o));
default: return 0;
}
}
