/*
** $Id: lapi.c $
** Lua API
** See Copyright Notice in lua.h
*/
#define lapi_c
#define LUA_CORE
#include "lprefix.h"
#include <limits.h>
#include <stdarg.h>
#include <string.h>
#include "lua.h"
#include "lapi.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lundump.h"
#include "lvm.h"
const char lua_ident
[] =
"$LuaVersion: " LUA_COPYRIGHT
" $"
"$LuaAuthors: " LUA_AUTHORS
" $";
/*
** Test for a valid index (one that is not the 'nilvalue').
** '!ttisnil(o)' implies 'o != &G(L)->nilvalue', so it is not needed.
** However, it covers the most common cases in a faster way.
*/
#define isvalid(L, o) (!ttisnil(o) || o != &G(L)->nilvalue)
/* test for pseudo index */
#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)
/* test for upvalue */
#define isupvalue(i) ((i) < LUA_REGISTRYINDEX)
/*
** Convert an acceptable index to a pointer to its respective value.
** Non-valid indices return the special nil value 'G(L)->nilvalue'.
*/
static TValue
*index2value
(lua_State
*L
, int idx
) {
CallInfo
*ci
= L
->ci
;
if (idx
> 0) {
StkId o
= ci
->func
+ idx
;
api_check
(L
, idx
<= L
->ci
->top
- (ci
->func
+ 1), "unacceptable index");
if (o
>= L
->top
) return &G
(L
)->nilvalue
;
else return s2v
(o
);
}
else if (!ispseudo
(idx
)) { /* negative index */
api_check
(L
, idx
!= 0 && -idx
<= L
->top
- (ci
->func
+ 1), "invalid index");
return s2v
(L
->top
+ idx
);
}
else if (idx
== LUA_REGISTRYINDEX
)
return &G
(L
)->l_registry
;
else { /* upvalues */
idx
= LUA_REGISTRYINDEX
- idx
;
api_check
(L
, idx
<= MAXUPVAL
+ 1, "upvalue index too large");
if (ttisCclosure
(s2v
(ci
->func
))) { /* C closure? */
CClosure
*func
= clCvalue
(s2v
(ci
->func
));
return (idx
<= func
->nupvalues
) ? &func
->upvalue
[idx
-1]
: &G
(L
)->nilvalue
;
}
else { /* light C function or Lua function (through a hook)?) */
api_check
(L
, ttislcf
(s2v
(ci
->func
)), "caller not a C function");
return &G
(L
)->nilvalue
; /* no upvalues */
}
}
}
/*
** Convert a valid actual index (not a pseudo-index) to its address.
*/
l_sinline StkId index2stack
(lua_State
*L
, int idx
) {
CallInfo
*ci
= L
->ci
;
if (idx
> 0) {
StkId o
= ci
->func
+ idx
;
api_check
(L
, o
< L
->top
, "invalid index");
return o
;
}
else { /* non-positive index */
api_check
(L
, idx
!= 0 && -idx
<= L
->top
- (ci
->func
+ 1), "invalid index");
api_check
(L
, !ispseudo
(idx
), "invalid index");
return L
->top
+ idx
;
}
}
LUA_API
int lua_checkstack
(lua_State
*L
, int n
) {
int res
;
CallInfo
*ci
;
lua_lock
(L
);
ci
= L
->ci
;
api_check
(L
, n
>= 0, "negative 'n'");
if (L
->stack_last
- L
->top
> n
) /* stack large enough? */
res
= 1; /* yes; check is OK */
else { /* no; need to grow stack */
int inuse
= cast_int
(L
->top
- L
->stack
) + EXTRA_STACK
;
if (inuse
> LUAI_MAXSTACK
- n
) /* can grow without overflow? */
res
= 0; /* no */
else /* try to grow stack */
res
= luaD_growstack
(L
, n
, 0);
}
if (res
&& ci
->top
< L
->top
+ n
)
ci
->top
= L
->top
+ n
; /* adjust frame top */
lua_unlock
(L
);
return res
;
}
LUA_API
void lua_xmove
(lua_State
*from
, lua_State
*to
, int n
) {
int i
;
if (from
== to
) return;
lua_lock
(to
);
api_checknelems
(from
, n
);
api_check
(from
, G
(from
) == G
(to
), "moving among independent states");
api_check
(from
, to
->ci
->top
- to
->top
>= n
, "stack overflow");
from
->top
-= n
;
for (i
= 0; i
< n
; i
++) {
setobjs2s
(to
, to
->top
, from
->top
+ i
);
to
->top
++; /* stack already checked by previous 'api_check' */
}
lua_unlock
(to
);
}
LUA_API lua_CFunction lua_atpanic
(lua_State
*L
, lua_CFunction panicf
) {
lua_CFunction old
;
lua_lock
(L
);
old
= G
(L
)->panic
;
G
(L
)->panic
= panicf
;
lua_unlock
(L
);
return old
;
}
LUA_API lua_Number lua_version
(lua_State
*L
) {
UNUSED
(L
);
return LUA_VERSION_NUM
;
}
/*
** basic stack manipulation
*/
/*
** convert an acceptable stack index into an absolute index
*/
LUA_API
int lua_absindex
(lua_State
*L
, int idx
) {
return (idx
> 0 || ispseudo
(idx
))
? idx
: cast_int
(L
->top
- L
->ci
->func
) + idx
;
}
LUA_API
int lua_gettop
(lua_State
*L
) {
return cast_int
(L
->top
- (L
->ci
->func
+ 1));
}
LUA_API
void lua_settop
(lua_State
*L
, int idx
) {
CallInfo
*ci
;
StkId func
, newtop
;
ptrdiff_t diff
; /* difference for new top */
lua_lock
(L
);
ci
= L
->ci
;
func
= ci
->func
;
if (idx
>= 0) {
api_check
(L
, idx
<= ci
->top
- (func
+ 1), "new top too large");
diff
= ((func
+ 1) + idx
) - L
->top
;
for (; diff
> 0; diff
--)
setnilvalue
(s2v
(L
->top
++)); /* clear new slots */
}
else {
api_check
(L
, -(idx
+1) <= (L
->top
- (func
+ 1)), "invalid new top");
diff
= idx
+ 1; /* will "subtract" index (as it is negative) */
}
api_check
(L
, L
->tbclist
< L
->top
, "previous pop of an unclosed slot");
newtop
= L
->top
+ diff
;
if (diff
< 0 && L
->tbclist
>= newtop
) {
lua_assert
(hastocloseCfunc
(ci
->nresults
));
luaF_close
(L
, newtop
, CLOSEKTOP
, 0);
}
L
->top
= newtop
; /* correct top only after closing any upvalue */
lua_unlock
(L
);
}
LUA_API
void lua_closeslot
(lua_State
*L
, int idx
) {
StkId level
;
lua_lock
(L
);
level
= index2stack
(L
, idx
);
api_check
(L
, hastocloseCfunc
(L
->ci
->nresults
) && L
->tbclist
== level
,
"no variable to close at given level");
luaF_close
(L
, level
, CLOSEKTOP
, 0);
level
= index2stack
(L
, idx
); /* stack may be moved */
setnilvalue
(s2v
(level
));
lua_unlock
(L
);
}
/*
** Reverse the stack segment from 'from' to 'to'
** (auxiliary to 'lua_rotate')
** Note that we move(copy) only the value inside the stack.
** (We do not move additional fields that may exist.)
*/
l_sinline
void reverse
(lua_State
*L
, StkId from
, StkId to
) {
for (; from
< to
; from
++, to
--) {
TValue temp
;
setobj
(L
, &temp
, s2v
(from
));
setobjs2s
(L
, from
, to
);
setobj2s
(L
, to
, &temp
);
}
}
/*
** Let x = AB, where A is a prefix of length 'n'. Then,
** rotate x n == BA. But BA == (A^r . B^r)^r.
*/
LUA_API
void lua_rotate
(lua_State
*L
, int idx
, int n
) {
StkId p
, t
, m
;
lua_lock
(L
);
t
= L
->top
- 1; /* end of stack segment being rotated */
p
= index2stack
(L
, idx
); /* start of segment */
api_check
(L
, (n
>= 0 ? n
: -n
) <= (t
- p
+ 1), "invalid 'n'");
m
= (n
>= 0 ? t
- n
: p
- n
- 1); /* end of prefix */
reverse
(L
, p
, m
); /* reverse the prefix with length 'n' */
reverse
(L
, m
+ 1, t
); /* reverse the suffix */
reverse
(L
, p
, t
); /* reverse the entire segment */
lua_unlock
(L
);
}
LUA_API
void lua_copy
(lua_State
*L
, int fromidx
, int toidx
) {
TValue
*fr
, *to
;
lua_lock
(L
);
fr
= index2value
(L
, fromidx
);
to
= index2value
(L
, toidx
);
api_check
(L
, isvalid
(L
, to
), "invalid index");
setobj
(L
, to
, fr
);
if (isupvalue
(toidx
)) /* function upvalue? */
luaC_barrier
(L
, clCvalue
(s2v
(L
->ci
->func
)), fr
);
/* LUA_REGISTRYINDEX does not need gc barrier
(collector revisits it before finishing collection) */
lua_unlock
(L
);
}
LUA_API
void lua_pushvalue
(lua_State
*L
, int idx
) {
lua_lock
(L
);
setobj2s
(L
, L
->top
, index2value
(L
, idx
));
api_incr_top
(L
);
lua_unlock
(L
);
}
/*
** access functions (stack -> C)
*/
LUA_API
int lua_type
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return (isvalid
(L
, o
) ? ttype
(o
) : LUA_TNONE
);
}
LUA_API
const char *lua_typename
(lua_State
*L
, int t
) {
UNUSED
(L
);
api_check
(L
, LUA_TNONE
<= t
&& t
< LUA_NUMTYPES
, "invalid type");
return ttypename
(t
);
}
LUA_API
int lua_iscfunction
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return (ttislcf
(o
) || (ttisCclosure
(o
)));
}
LUA_API
int lua_isinteger
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return ttisinteger
(o
);
}
LUA_API
int lua_isnumber
(lua_State
*L
, int idx
) {
lua_Number n
;
const TValue
*o
= index2value
(L
, idx
);
return tonumber
(o
, &n
);
}
LUA_API
int lua_isstring
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return (ttisstring
(o
) || cvt2str
(o
));
}
LUA_API
int lua_isuserdata
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return (ttisfulluserdata
(o
) || ttislightuserdata
(o
));
}
LUA_API
int lua_rawequal
(lua_State
*L
, int index1
, int index2
) {
const TValue
*o1
= index2value
(L
, index1
);
const TValue
*o2
= index2value
(L
, index2
);
return (isvalid
(L
, o1
) && isvalid
(L
, o2
)) ? luaV_rawequalobj
(o1
, o2
) : 0;
}
LUA_API
void lua_arith
(lua_State
*L
, int op
) {
lua_lock
(L
);
if (op
!= LUA_OPUNM
&& op
!= LUA_OPBNOT
)
api_checknelems
(L
, 2); /* all other operations expect two operands */
else { /* for unary operations, add fake 2nd operand */
api_checknelems
(L
, 1);
setobjs2s
(L
, L
->top
, L
->top
- 1);
api_incr_top
(L
);
}
/* first operand at top - 2, second at top - 1; result go to top - 2 */
luaO_arith
(L
, op
, s2v
(L
->top
- 2), s2v
(L
->top
- 1), L
->top
- 2);
L
->top
--; /* remove second operand */
lua_unlock
(L
);
}
LUA_API
int lua_compare
(lua_State
*L
, int index1
, int index2
, int op
) {
const TValue
*o1
;
const TValue
*o2
;
int i
= 0;
lua_lock
(L
); /* may call tag method */
o1
= index2value
(L
, index1
);
o2
= index2value
(L
, index2
);
if (isvalid
(L
, o1
) && isvalid
(L
, o2
)) {
switch (op
) {
case LUA_OPEQ
: i
= luaV_equalobj
(L
, o1
, o2
); break;
case LUA_OPLT
: i
= luaV_lessthan
(L
, o1
, o2
); break;
case LUA_OPLE
: i
= luaV_lessequal
(L
, o1
, o2
); break;
default: api_check
(L
, 0, "invalid option");
}
}
lua_unlock
(L
);
return i
;
}
LUA_API
size_t lua_stringtonumber
(lua_State
*L
, const char *s
) {
size_t sz
= luaO_str2num
(s
, s2v
(L
->top
));
if (sz
!= 0)
api_incr_top
(L
);
return sz
;
}
LUA_API lua_Number lua_tonumberx
(lua_State
*L
, int idx
, int *pisnum
) {
lua_Number n
= 0;
const TValue
*o
= index2value
(L
, idx
);
int isnum
= tonumber
(o
, &n
);
if (pisnum
)
*pisnum
= isnum
;
return n
;
}
LUA_API lua_Integer lua_tointegerx
(lua_State
*L
, int idx
, int *pisnum
) {
lua_Integer res
= 0;
const TValue
*o
= index2value
(L
, idx
);
int isnum
= tointeger
(o
, &res
);
if (pisnum
)
*pisnum
= isnum
;
return res
;
}
LUA_API
int lua_toboolean
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return !l_isfalse
(o
);
}
LUA_API
const char *lua_tolstring
(lua_State
*L
, int idx
, size_t *len
) {
TValue
*o
;
lua_lock
(L
);
o
= index2value
(L
, idx
);
if (!ttisstring
(o
)) {
if (!cvt2str
(o
)) { /* not convertible? */
if (len
!= NULL
) *len
= 0;
lua_unlock
(L
);
return NULL
;
}
luaO_tostring
(L
, o
);
luaC_checkGC
(L
);
o
= index2value
(L
, idx
); /* previous call may reallocate the stack */
}
if (len
!= NULL
)
*len
= vslen
(o
);
lua_unlock
(L
);
return svalue
(o
);
}
LUA_API lua_Unsigned lua_rawlen
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
switch (ttypetag
(o
)) {
case LUA_VSHRSTR
: return tsvalue
(o
)->shrlen
;
case LUA_VLNGSTR
: return tsvalue
(o
)->u.
lnglen;
case LUA_VUSERDATA
: return uvalue
(o
)->len
;
case LUA_VTABLE
: return luaH_getn
(hvalue
(o
));
default: return 0;
}
}
LUA_API lua_CFunction lua_tocfunction
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
if (ttislcf
(o
)) return fvalue
(o
);
else if (ttisCclosure
(o
))
return clCvalue
(o
)->f
;
else return NULL
; /* not a C function */
}
l_sinline
void *touserdata
(const TValue
*o
) {
switch (ttype
(o
)) {
case LUA_TUSERDATA
: return getudatamem
(uvalue
(o
));
case LUA_TLIGHTUSERDATA
: return pvalue
(o
);
default: return NULL
;
}
}
LUA_API
void *lua_touserdata
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return touserdata
(o
);
}
LUA_API lua_State
*lua_tothread
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
return (!ttisthread
(o
)) ? NULL
: thvalue
(o
);
}
/*
** Returns a pointer to the internal representation of an object.
** Note that ANSI C does not allow the conversion of a pointer to
** function to a 'void*', so the conversion here goes through
** a 'size_t'. (As the returned pointer is only informative, this
** conversion should not be a problem.)
*/
LUA_API
const void *lua_topointer
(lua_State
*L
, int idx
) {
const TValue
*o
= index2value
(L
, idx
);
switch (ttypetag
(o
)) {
case LUA_VLCF
: return cast_voidp
(cast_sizet
(fvalue
(o
)));
case LUA_VUSERDATA
: case LUA_VLIGHTUSERDATA
:
return touserdata
(o
);
default: {
if (iscollectable
(o
))
return gcvalue
(o
);
else
return NULL
;
}
}
}
/*
** push functions (C -> stack)
*/
LUA_API
void lua_pushnil
(lua_State
*L
) {
lua_lock
(L
);
setnilvalue
(s2v
(L
->top
));
api_incr_top
(L
);
lua_unlock
(L
);
}
LUA_API
void lua_pushnumber
(lua_State
*L
, lua_Number n
) {
lua_lock
(L
);
setfltvalue
(s2v
(L
->top
), n
);
api_incr_top
(L
);
lua_unlock
(L
);
}
LUA_API
void lua_pushinteger
(lua_State
*L
, lua_Integer n
) {
lua_lock
(L
);
setivalue
(s2v
(L
->top
), n
);
api_incr_top
(L
);
lua_unlock
(L
);
}
/*
** Pushes on the stack a string with given length. Avoid using 's' when
** 'len' == 0 (as 's' can be NULL in that case), due to later use of
** 'memcmp' and 'memcpy'.
*/
LUA_API
const char *lua_pushlstring
(lua_State
*L
, const char *s
, size_t len
) {
TString
*ts
;
lua_lock
(L
);
ts
= (len
== 0) ? luaS_new
(L
, "") : luaS_newlstr
(L
, s
, len
);
setsvalue2s
(L
, L
->top
, ts
);
api_incr_top
(L
);
luaC_checkGC
(L
);
lua_unlock
(L
);
return getstr
(ts
);
}
LUA_API
const char *lua_pushstring
(lua_State
*L
, const char *s
) {
lua_lock
(L
);
if (s
== NULL
)
setnilvalue
(s2v
(L
->top
));
else {
TString
*ts
;
ts
= luaS_new
(L
, s
);
setsvalue2s
(L
, L
->top
, ts
);
s
= getstr
(ts
); /* internal copy's address */
}
api_incr_top
(L
);
luaC_checkGC
(L
);
lua_unlock
(L
);
return s
;
}
LUA_API
const char *lua_pushvfstring
(lua_State
*L
, const char *fmt
,
va_list argp
) {
const char *ret
;
lua_lock
(L
);
ret
= luaO_pushvfstring
(L
, fmt
, argp
);
luaC_checkGC
(L
);
lua_unlock
(L
);
return ret
;
}
LUA_API
const char *lua_pushfstring
(lua_State
*L
, const char *fmt
, ...
) {
const char *ret
;
va_list argp
;
lua_lock
(L
);
va_start(argp
, fmt
);
ret
= luaO_pushvfstring
(L
, fmt
, argp
);
va_end(argp
);
luaC_checkGC
(L
);
lua_unlock
(L
);
return ret
;
}
LUA_API
void lua_pushcclosure
(lua_State
*L
, lua_CFunction fn
, int n
) {
lua_lock
(L
);
if (n
== 0) {
setfvalue
(s2v
(L
->top
), fn
);
api_incr_top
(L
);
}
else {
CClosure
*cl
;
api_checknelems
(L
, n
);
api_check
(L
, n
<= MAXUPVAL
, "upvalue index too large");
cl
= luaF_newCclosure
(L
, n
);
cl
->f
= fn
;
L
->top
-= n
;
while (n
--) {
setobj2n
(L
, &cl
->upvalue
[n
], s2v
(L
->top
+ n
));
/* does not need barrier because closure is white */
lua_assert
(iswhite
(cl
));
}
setclCvalue
(L
, s2v
(L
->top
), cl
);
api_incr_top
(L
);
luaC_checkGC
(L
);
}
lua_unlock
(L
);
}
LUA_API
void lua_pushboolean
(lua_State
*L
, int b
) {
lua_lock
(L
);
if (b
)
setbtvalue
(s2v
(L
->top
));
else
setbfvalue
(s2v
(L
->top
));
api_incr_top
(L
);
lua_unlock
(L
);
}
LUA_API
void lua_pushlightuserdata
(lua_State
*L
, void *p
) {
lua_lock
(L
);
setpvalue
(s2v
(L
->top
), p
);
api_incr_top
(L
);
lua_unlock
(L
);
}
LUA_API
int lua_pushthread
(lua_State
*L
) {
lua_lock
(L
);
setthvalue
(L
, s2v
(L
->top
), L
);
api_incr_top
(L
);
lua_unlock
(L
);
return (G
(L
)->mainthread
== L
);
}
/*
** get functions (Lua -> stack)
*/
l_sinline
int auxgetstr
(lua_State
*L
, const TValue
*t
, const char *k
) {
const TValue
*slot
;
TString
*str
= luaS_new
(L
, k
);
if (luaV_fastget
(L
, t
, str
, slot
, luaH_getstr
)) {
setobj2s
(L
, L
->top
, slot
);
api_incr_top
(L
);
}
else {
setsvalue2s
(L
, L
->top
, str
);
api_incr_top
(L
);
luaV_finishget
(L
, t
, s2v
(L
->top
- 1), L
->top
- 1, slot
);
}
lua_unlock
(L
);
return ttype
(s2v
(L
->top
- 1));
}
/*
** Get the global table in the registry. Since all predefined
** indices in the registry were inserted right when the registry
** was created and never removed, they must always be in the array
** part of the registry.
*/
#define getGtable(L) \
(&hvalue(&G(L)->l_registry)->array[LUA_RIDX_GLOBALS - 1])
LUA_API
int lua_getglobal
(lua_State
*L
, const char *name
) {
const TValue
*G
;
lua_lock
(L
);
G
= getGtable
(L
);
return auxgetstr
(L
, G
, name
);
}
LUA_API
int lua_gettable
(lua_State
*L
, int idx
) {
const TValue
*slot
;
TValue
*t
;
lua_lock
(L
);
t
= index2value
(L
, idx
);
if (luaV_fastget
(L
, t
, s2v
(L
->top
- 1), slot
, luaH_get
)) {
setobj2s
(L
, L
->top
- 1, slot
);
}
else
luaV_finishget
(L
, t
, s2v
(L
->top
- 1), L
->top
- 1, slot
);
lua_unlock
(L
);
return ttype
(s2v
(L
->top
- 1));
}
LUA_API
int lua_getfield
(lua_State
*L
, int idx
, const char *k
) {
lua_lock
(L
);
return auxgetstr
(L
, index2value
(L
, idx
), k
);
}
LUA_API
int lua_geti
(lua_State
*L
, int idx
, lua_Integer n
) {
TValue
*t
;
const TValue
*slot
;
lua_lock
(L
);
t
= index2value
(L
, idx
);
if (luaV_fastgeti
(L
, t
, n
, slot
)) {
setobj2s
(L
, L
->top
, slot
);
}
else {
TValue aux
;
setivalue
(&aux
, n
);
luaV_finishget
(L
, t
, &aux
, L
->top
, slot
);
}
api_incr_top
(L
);
lua_unlock
(L
);
return ttype
(s2v
(L
->top
- 1));
}
l_sinline
int finishrawget
(lua_State
*L
, const TValue
*val
) {
if (isempty
(val
)) /* avoid copying empty items to the stack */
setnilvalue
(s2v
(L
->top
));
else
setobj2s
(L
, L
->top
, val
);
api_incr_top
(L
);
lua_unlock
(L
);
return ttype
(s2v
(L
->top
- 1));
}
static Table
*gettable
(lua_State
*L
, int idx
) {
TValue
*t
= index2value
(L
, idx
);
api_check
(L
, ttistable
(t
), "table expected");
return hvalue
(t
);
}
LUA_API
int lua_rawget
(lua_State
*L
, int idx
) {
Table
*t
;
const TValue
*val
;
lua_lock
(L
);
api_checknelems
(L
, 1);
t
= gettable
(L
, idx
);
val
= luaH_get
(t
, s2v
(L
->top
- 1));
L
->top
--; /* remove key */
return finishrawget
(L
, val
);
}
LUA_API
int lua_rawgeti
(lua_State
*L
, int idx
, lua_Integer n
) {
Table
*t
;
lua_lock
(L
);
t
= gettable
(L
, idx
);
return finishrawget
(L
, luaH_getint
(t
, n
));
}
LUA_API
int lua_rawgetp
(lua_State
*L
, int idx
, const void *p
) {
Table
*t
;
TValue k
;
lua_lock
(L
);
t
= gettable
(L
, idx
);
setpvalue
(&k
, cast_voidp
(p
));
return finishrawget
(L
, luaH_get
(t
, &k
));
}
LUA_API
void lua_createtable
(lua_State
*L
, int narray
, int nrec
) {
Table
*t
;
lua_lock
(L
);
t
= luaH_new
(L
);
sethvalue2s
(L
, L
->top
, t
);
api_incr_top
(L
);
if (narray
> 0 || nrec
> 0)
luaH_resize
(L
, t
, narray
, nrec
);
luaC_checkGC
(L
);
lua_unlock
(L
);
}
LUA_API
int lua_getmetatable
(lua_State
*L
, int objindex
) {
const TValue
*obj
;
Table
*mt
;
int res
= 0;
lua_lock
(L
);
obj
= index2value
(L
, objindex
);
switch (ttype
(obj
)) {
case LUA_TTABLE
:
mt
= hvalue
(obj
)->metatable
;
break;
case LUA_TUSERDATA
:
mt
= uvalue
(obj
)->metatable
;
break;
default:
mt
= G
(L
)->mt
[ttype
(obj
)];
break;
}
if (mt
!= NULL
) {
sethvalue2s
(L
, L
->top
, mt
);
api_incr_top
(L
);
res
= 1;
}
lua_unlock
(L
);
return res
;
}
LUA_API
int lua_getiuservalue
(lua_State
*L
, int idx
, int n
) {
TValue
*o
;
int t
;
lua_lock
(L
);
o
= index2value
(L
, idx
);
api_check
(L
, ttisfulluserdata
(o
), "full userdata expected");
if (n
<= 0 || n
> uvalue
(o
)->nuvalue
) {
setnilvalue
(s2v
(L
->top
));
t
= LUA_TNONE
;
}
else {
setobj2s
(L
, L
->top
, &uvalue
(o
)->uv
[n
- 1].
uv);
t
= ttype
(s2v
(L
->top
));
}
api_incr_top
(L
);
lua_unlock
(L
);
return t
;
}
/*
** set functions (stack -> Lua)
*/
/*
** t[k] = value at the top of the stack (where 'k' is a string)
*/
static void auxsetstr
(lua_State
*L
, const TValue
*t
, const char *k
) {
const TValue
*slot
;
TString
*str
= luaS_new
(L
, k
);
api_checknelems
(L
, 1);
if (luaV_fastget
(L
, t
, str
, slot
, luaH_getstr
)) {
luaV_finishfastset
(L
, t
, slot
, s2v
(L
->top
- 1));
L
->top
--; /* pop value */
}
else {
setsvalue2s
(L
, L
->top
, str
); /* push 'str' (to make it a TValue) */
api_incr_top
(L
);
luaV_finishset
(L
, t
, s2v
(L
->top
- 1), s2v
(L
->top
- 2), slot
);
L
->top
-= 2; /* pop value and key */
}
lua_unlock
(L
); /* lock done by caller */
}
LUA_API
void lua_setglobal
(lua_State
*L
, const char *name
) {
const TValue
*G
;
lua_lock
(L
); /* unlock done in 'auxsetstr' */
G
= getGtable
(L
);
auxsetstr
(L
, G
, name
);
}
LUA_API
void lua_settable
(lua_State
*L
, int idx
) {
TValue
*t
;
const TValue
*slot
;
lua_lock
(L
);
api_checknelems
(L
, 2);
t
= index2value
(L
, idx
);
if (luaV_fastget
(L
, t
, s2v
(L
->top
- 2), slot
, luaH_get
)) {
luaV_finishfastset
(L
, t
, slot
, s2v
(L
->top
- 1));
}
else
luaV_finishset
(L
, t
, s2v
(L
->top
- 2), s2v
(L
->top
- 1), slot
);
L
->top
-= 2; /* pop index and value */
lua_unlock
(L
);
}
LUA_API
void lua_setfield
(lua_State
*L
, int idx
, const char *k
) {
lua_lock
(L
); /* unlock done in 'auxsetstr' */
auxsetstr
(L
, index2value
(L
, idx
), k
);
}
LUA_API
void lua_seti
(lua_State
*L
, int idx
, lua_Integer n
) {
TValue
*t
;
const TValue
*slot
;
lua_lock
(L
);
api_checknelems
(L
, 1);
t
= index2value
(L
, idx
);
if (luaV_fastgeti
(L
, t
, n
, slot
)) {
luaV_finishfastset
(L
, t
, slot
, s2v
(L
->top
- 1));
}
else {
TValue aux
;
setivalue
(&aux
, n
);
luaV_finishset
(L
, t
, &aux
, s2v
(L
->top
- 1), slot
);
}
L
->top
--; /* pop value */
lua_unlock
(L
);
}
static void aux_rawset
(lua_State
*L
, int idx
, TValue
*key
, int n
) {
Table
*t
;
lua_lock
(L
);
api_checknelems
(L
, n
);
t
= gettable
(L
, idx
);
luaH_set
(L
, t
, key
, s2v
(L
->top
- 1));
invalidateTMcache
(t
);
luaC_barrierback
(L
, obj2gco
(t
), s2v
(L
->top
- 1));
L
->top
-= n
;
lua_unlock
(L
);
}
LUA_API
void lua_rawset
(lua_State
*L
, int idx
) {
aux_rawset
(L
, idx
, s2v
(L
->top
- 2), 2);
}
LUA_API
void lua_rawsetp
(lua_State
*L
, int idx
, const void *p
) {
TValue k
;
setpvalue
(&k
, cast_voidp
(p
));
aux_rawset
(L
, idx
, &k
, 1);
}
LUA_API
void lua_rawseti
(lua_State
*L
, int idx
, lua_Integer n
) {
Table
*t
;
lua_lock
(L
);
api_checknelems
(L
, 1);
t
= gettable
(L
, idx
);
luaH_setint
(L
, t
, n
, s2v
(L
->top
- 1));
luaC_barrierback
(L
, obj2gco
(t
), s2v
(L
->top
- 1));
L
->top
--;
lua_unlock
(L
);
}
LUA_API
int lua_setmetatable
(lua_State
*L
, int objindex
) {
TValue
*obj
;
Table
*mt
;
lua_lock
(L
);
api_checknelems
(L
, 1);
obj
= index2value
(L
, objindex
);
if (ttisnil
(s2v
(L
->top
- 1)))
mt
= NULL
;
else {
api_check
(L
, ttistable
(s2v
(L
->top
- 1)), "table expected");
mt
= hvalue
(s2v
(L
->top
- 1));
}
switch (ttype
(obj
)) {
case LUA_TTABLE
: {
hvalue
(obj
)->metatable
= mt
;
if (mt
) {
luaC_objbarrier
(L
, gcvalue
(obj
), mt
);
luaC_checkfinalizer
(L
, gcvalue
(obj
), mt
);
}
break;
}
case LUA_TUSERDATA
: {
uvalue
(obj
)->metatable
= mt
;
if (mt
) {
luaC_objbarrier
(L
, uvalue
(obj
), mt
);
luaC_checkfinalizer
(L
, gcvalue
(obj
), mt
);
}
break;
}
default: {
G
(L
)->mt
[ttype
(obj
)] = mt
;
break;
}
}
L
->top
--;
lua_unlock
(L
);
return 1;
}
LUA_API
int lua_setiuservalue
(lua_State
*L
, int idx
, int n
) {
TValue
*o
;
int res
;
lua_lock
(L
);
api_checknelems
(L
, 1);
o
= index2value
(L
, idx
);
api_check
(L
, ttisfulluserdata
(o
), "full userdata expected");
if (!(cast_uint
(n
) - 1u
< cast_uint
(uvalue
(o
)->nuvalue
)))
res
= 0; /* 'n' not in [1, uvalue(o)->nuvalue] */
else {
setobj
(L
, &uvalue
(o
)->uv
[n
- 1].
uv, s2v
(L
->top
- 1));
luaC_barrierback
(L
, gcvalue
(o
), s2v
(L
->top
- 1));
res
= 1;
}
L
->top
--;
lua_unlock
(L
);
return res
;
}
/*
** 'load' and 'call' functions (run Lua code)
*/
#define checkresults(L,na,nr) \
api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \
"results from function overflow current stack size")
LUA_API
void lua_callk
(lua_State
*L
, int nargs
, int nresults
,
lua_KContext ctx
, lua_KFunction k
) {
StkId func
;
lua_lock
(L
);
api_check
(L
, k
== NULL
|| !isLua
(L
->ci
),
"cannot use continuations inside hooks");
api_checknelems
(L
, nargs
+1);
api_check
(L
, L
->status
== LUA_OK
, "cannot do calls on non-normal thread");
checkresults
(L
, nargs
, nresults
);
func
= L
->top
- (nargs
+1);
if (k
!= NULL
&& yieldable
(L
)) { /* need to prepare continuation? */
L
->ci
->u.
c.
k = k
; /* save continuation */
L
->ci
->u.
c.
ctx = ctx
; /* save context */
luaD_call
(L
, func
, nresults
); /* do the call */
}
else /* no continuation or no yieldable */
luaD_callnoyield
(L
, func
, nresults
); /* just do the call */
adjustresults
(L
, nresults
);
lua_unlock
(L
);
}
/*
** Execute a protected call.
*/
struct CallS
{ /* data to 'f_call' */
StkId func
;
int nresults
;
};
static void f_call
(lua_State
*L
, void *ud
) {
struct CallS
*c
= cast
(struct CallS
*, ud
);
luaD_callnoyield
(L
, c
->func
, c
->nresults
);
}
LUA_API
int lua_pcallk
(lua_State
*L
, int nargs
, int nresults
, int errfunc
,
lua_KContext ctx
, lua_KFunction k
) {
struct CallS c
;
int status
;
ptrdiff_t func
;
lua_lock
(L
);
api_check
(L
, k
== NULL
|| !isLua
(L
->ci
),
"cannot use continuations inside hooks");
api_checknelems
(L
, nargs
+1);
api_check
(L
, L
->status
== LUA_OK
, "cannot do calls on non-normal thread");
checkresults
(L
, nargs
, nresults
);
if (errfunc
== 0)
func
= 0;
else {
StkId o
= index2stack
(L
, errfunc
);
api_check
(L
, ttisfunction
(s2v
(o
)), "error handler must be a function");
func
= savestack
(L
, o
);
}
c.
func = L
->top
- (nargs
+1); /* function to be called */
if (k
== NULL
|| !yieldable
(L
)) { /* no continuation or no yieldable? */
c.
nresults = nresults
; /* do a 'conventional' protected call */
status
= luaD_pcall
(L
, f_call
, &c
, savestack
(L
, c.
func), func
);
}
else { /* prepare continuation (call is already protected by 'resume') */
CallInfo
*ci
= L
->ci
;
ci
->u.
c.
k = k
; /* save continuation */
ci
->u.
c.
ctx = ctx
; /* save context */
/* save information for error recovery */
ci
->u2.
funcidx = cast_int
(savestack
(L
, c.
func));
ci
->u.
c.
old_errfunc = L
->errfunc
;
L
->errfunc
= func
;
setoah
(ci
->callstatus
, L
->allowhook
); /* save value of 'allowhook' */
ci
->callstatus
|= CIST_YPCALL
; /* function can do error recovery */
luaD_call
(L
, c.
func, nresults
); /* do the call */
ci
->callstatus
&= ~CIST_YPCALL
;
L
->errfunc
= ci
->u.
c.
old_errfunc;
status
= LUA_OK
; /* if it is here, there were no errors */
}
adjustresults
(L
, nresults
);
lua_unlock
(L
);
return status
;
}
LUA_API
int lua_load
(lua_State
*L
, lua_Reader reader
, void *data
,
const char *chunkname
, const char *mode
) {
ZIO z
;
int status
;
lua_lock
(L
);
if (!chunkname
) chunkname
= "?";
luaZ_init
(L
, &z
, reader
, data
);
status
= luaD_protectedparser
(L
, &z
, chunkname
, mode
);
if (status
== LUA_OK
) { /* no errors? */
LClosure
*f
= clLvalue
(s2v
(L
->top
- 1)); /* get newly created function */
if (f
->nupvalues
>= 1) { /* does it have an upvalue? */
/* get global table from registry */
const TValue
*gt
= getGtable
(L
);
/* set global table as 1st upvalue of 'f' (may be LUA_ENV) */
setobj
(L
, f
->upvals
[0]->v
, gt
);
luaC_barrier
(L
, f
->upvals
[0], gt
);
}
}
lua_unlock
(L
);
return status
;
}
LUA_API
int lua_dump
(lua_State
*L
, lua_Writer writer
, void *data
, int strip
) {
int status
;
TValue
*o
;
lua_lock
(L
);
api_checknelems
(L
, 1);
o
= s2v
(L
->top
- 1);
if (isLfunction
(o
))
status
= luaU_dump
(L
, getproto
(o
), writer
, data
, strip
);
else
status
= 1;
lua_unlock
(L
);
return status
;
}
LUA_API
int lua_status
(lua_State
*L
) {
return L
->status
;
}
/*
** Garbage-collection function
*/
LUA_API
int lua_gc
(lua_State
*L
, int what
, ...
) {
va_list argp
;
int res
= 0;
global_State
*g
= G
(L
);
if (g
->gcstp
& GCSTPGC
) /* internal stop? */
return -1; /* all options are invalid when stopped */
lua_lock
(L
);
va_start(argp
, what
);
switch (what
) {
case LUA_GCSTOP
: {
g
->gcstp
= GCSTPUSR
; /* stopped by the user */
break;
}
case LUA_GCRESTART
: {
luaE_setdebt
(g
, 0);
g
->gcstp
= 0; /* (GCSTPGC must be already zero here) */
break;
}
case LUA_GCCOLLECT
: {
luaC_fullgc
(L
, 0);
break;
}
case LUA_GCCOUNT
: {
/* GC values are expressed in Kbytes: #bytes/2^10 */
res
= cast_int
(gettotalbytes
(g
) >> 10);
break;
}
case LUA_GCCOUNTB
: {
res
= cast_int
(gettotalbytes
(g
) & 0x3ff);
break;
}
case LUA_GCSTEP
: {
int data
= va_arg(argp
, int);
l_mem debt
= 1; /* =1 to signal that it did an actual step */
lu_byte oldstp
= g
->gcstp
;
g
->gcstp
= 0; /* allow GC to run (GCSTPGC must be zero here) */
if (data
== 0) {
luaE_setdebt
(g
, 0); /* do a basic step */
luaC_step
(L
);
}
else { /* add 'data' to total debt */
debt
= cast
(l_mem
, data
) * 1024 + g
->GCdebt
;
luaE_setdebt
(g
, debt
);
luaC_checkGC
(L
);
}
g
->gcstp
= oldstp
; /* restore previous state */
if (debt
> 0 && g
->gcstate
== GCSpause
) /* end of cycle? */
res
= 1; /* signal it */
break;
}
case LUA_GCSETPAUSE
: {
int data
= va_arg(argp
, int);
res
= getgcparam
(g
->gcpause
);
setgcparam
(g
->gcpause
, data
);
break;
}
case LUA_GCSETSTEPMUL
: {
int data
= va_arg(argp
, int);
res
= getgcparam
(g
->gcstepmul
);
setgcparam
(g
->gcstepmul
, data
);
break;
}
case LUA_GCISRUNNING
: {
res
= gcrunning
(g
);
break;
}
case LUA_GCGEN
: {
int minormul
= va_arg(argp
, int);
int majormul
= va_arg(argp
, int);
res
= isdecGCmodegen
(g
) ? LUA_GCGEN
: LUA_GCINC
;
if (minormul
!= 0)
g
->genminormul
= minormul
;
if (majormul
!= 0)
setgcparam
(g
->genmajormul
, majormul
);
luaC_changemode
(L
, KGC_GEN
);
break;
}
case LUA_GCINC
: {
int pause
= va_arg(argp
, int);
int stepmul
= va_arg(argp
, int);
int stepsize
= va_arg(argp
, int);
res
= isdecGCmodegen
(g
) ? LUA_GCGEN
: LUA_GCINC
;
if (pause
!= 0)
setgcparam
(g
->gcpause
, pause
);
if (stepmul
!= 0)
setgcparam
(g
->gcstepmul
, stepmul
);
if (stepsize
!= 0)
g
->gcstepsize
= stepsize
;
luaC_changemode
(L
, KGC_INC
);
break;
}
default: res
= -1; /* invalid option */
}
va_end(argp
);
lua_unlock
(L
);
return res
;
}
/*
** miscellaneous functions
*/
LUA_API
int lua_error
(lua_State
*L
) {
TValue
*errobj
;
lua_lock
(L
);
errobj
= s2v
(L
->top
- 1);
api_checknelems
(L
, 1);
/* error object is the memory error message? */
if (ttisshrstring
(errobj
) && eqshrstr
(tsvalue
(errobj
), G
(L
)->memerrmsg
))
luaM_error
(L
); /* raise a memory error */
else
luaG_errormsg
(L
); /* raise a regular error */
/* code unreachable; will unlock when control actually leaves the kernel */
return 0; /* to avoid warnings */
}
LUA_API
int lua_next
(lua_State
*L
, int idx
) {
Table
*t
;
int more
;
lua_lock
(L
);
api_checknelems
(L
, 1);
t
= gettable
(L
, idx
);
more
= luaH_next
(L
, t
, L
->top
- 1);
if (more
) {
api_incr_top
(L
);
}
else /* no more elements */
L
->top
-= 1; /* remove key */
lua_unlock
(L
);
return more
;
}
LUA_API
void lua_toclose
(lua_State
*L
, int idx
) {
int nresults
;
StkId o
;
lua_lock
(L
);
o
= index2stack
(L
, idx
);
nresults
= L
->ci
->nresults
;
api_check
(L
, L
->tbclist
< o
, "given index below or equal a marked one");
luaF_newtbcupval
(L
, o
); /* create new to-be-closed upvalue */
if (!hastocloseCfunc
(nresults
)) /* function not marked yet? */
L
->ci
->nresults
= codeNresults
(nresults
); /* mark it */
lua_assert
(hastocloseCfunc
(L
->ci
->nresults
));
lua_unlock
(L
);
}
LUA_API
void lua_concat
(lua_State
*L
, int n
) {
lua_lock
(L
);
api_checknelems
(L
, n
);
if (n
> 0)
luaV_concat
(L
, n
);
else { /* nothing to concatenate */
setsvalue2s
(L
, L
->top
, luaS_newlstr
(L
, "", 0)); /* push empty string */
api_incr_top
(L
);
}
luaC_checkGC
(L
);
lua_unlock
(L
);
}
LUA_API
void lua_len
(lua_State
*L
, int idx
) {
TValue
*t
;
lua_lock
(L
);
t
= index2value
(L
, idx
);
luaV_objlen
(L
, L
->top
, t
);
api_incr_top
(L
);
lua_unlock
(L
);
}
LUA_API lua_Alloc lua_getallocf
(lua_State
*L
, void **ud
) {
lua_Alloc f
;
lua_lock
(L
);
if (ud
) *ud
= G
(L
)->ud
;
f
= G
(L
)->frealloc
;
lua_unlock
(L
);
return f
;
}
LUA_API
void lua_setallocf
(lua_State
*L
, lua_Alloc f
, void *ud
) {
lua_lock
(L
);
G
(L
)->ud
= ud
;
G
(L
)->frealloc
= f
;
lua_unlock
(L
);
}
void lua_setwarnf
(lua_State
*L
, lua_WarnFunction f
, void *ud
) {
lua_lock
(L
);
G
(L
)->ud_warn
= ud
;
G
(L
)->warnf
= f
;
lua_unlock
(L
);
}
void lua_warning
(lua_State
*L
, const char *msg
, int tocont
) {
lua_lock
(L
);
luaE_warning
(L
, msg
, tocont
);
lua_unlock
(L
);
}
LUA_API
void *lua_newuserdatauv
(lua_State
*L
, size_t size
, int nuvalue
) {
Udata
*u
;
lua_lock
(L
);
api_check
(L
, 0 <= nuvalue
&& nuvalue
< USHRT_MAX
, "invalid value");
u
= luaS_newudata
(L
, size
, nuvalue
);
setuvalue
(L
, s2v
(L
->top
), u
);
api_incr_top
(L
);
luaC_checkGC
(L
);
lua_unlock
(L
);
return getudatamem
(u
);
}
static const char *aux_upvalue
(TValue
*fi
, int n
, TValue
**val
,
GCObject
**owner
) {
switch (ttypetag
(fi
)) {
case LUA_VCCL
: { /* C closure */
CClosure
*f
= clCvalue
(fi
);
if (!(cast_uint
(n
) - 1u
< cast_uint
(f
->nupvalues
)))
return NULL
; /* 'n' not in [1, f->nupvalues] */
*val
= &f
->upvalue
[n
-1];
if (owner
) *owner
= obj2gco
(f
);
return "";
}
case LUA_VLCL
: { /* Lua closure */
LClosure
*f
= clLvalue
(fi
);
TString
*name
;
Proto
*p
= f
->p
;
if (!(cast_uint
(n
) - 1u
< cast_uint
(p
->sizeupvalues
)))
return NULL
; /* 'n' not in [1, p->sizeupvalues] */
*val
= f
->upvals
[n
-1]->v
;
if (owner
) *owner
= obj2gco
(f
->upvals
[n
- 1]);
name
= p
->upvalues
[n
-1].
name;
return (name
== NULL
) ? "(no name)" : getstr
(name
);
}
default: return NULL
; /* not a closure */
}
}
LUA_API
const char *lua_getupvalue
(lua_State
*L
, int funcindex
, int n
) {
const char *name
;
TValue
*val
= NULL
; /* to avoid warnings */
lua_lock
(L
);
name
= aux_upvalue
(index2value
(L
, funcindex
), n
, &val
, NULL
);
if (name
) {
setobj2s
(L
, L
->top
, val
);
api_incr_top
(L
);
}
lua_unlock
(L
);
return name
;
}
LUA_API
const char *lua_setupvalue
(lua_State
*L
, int funcindex
, int n
) {
const char *name
;
TValue
*val
= NULL
; /* to avoid warnings */
GCObject
*owner
= NULL
; /* to avoid warnings */
TValue
*fi
;
lua_lock
(L
);
fi
= index2value
(L
, funcindex
);
api_checknelems
(L
, 1);
name
= aux_upvalue
(fi
, n
, &val
, &owner
);
if (name
) {
L
->top
--;
setobj
(L
, val
, s2v
(L
->top
));
luaC_barrier
(L
, owner
, val
);
}
lua_unlock
(L
);
return name
;
}
static UpVal
**getupvalref
(lua_State
*L
, int fidx
, int n
, LClosure
**pf
) {
static const UpVal
*const nullup
= NULL
;
LClosure
*f
;
TValue
*fi
= index2value
(L
, fidx
);
api_check
(L
, ttisLclosure
(fi
), "Lua function expected");
f
= clLvalue
(fi
);
if (pf
) *pf
= f
;
if (1 <= n
&& n
<= f
->p
->sizeupvalues
)
return &f
->upvals
[n
- 1]; /* get its upvalue pointer */
else
return (UpVal
**)&nullup
;
}
LUA_API
void *lua_upvalueid
(lua_State
*L
, int fidx
, int n
) {
TValue
*fi
= index2value
(L
, fidx
);
switch (ttypetag
(fi
)) {
case LUA_VLCL
: { /* lua closure */
return *getupvalref
(L
, fidx
, n
, NULL
);
}
case LUA_VCCL
: { /* C closure */
CClosure
*f
= clCvalue
(fi
);
if (1 <= n
&& n
<= f
->nupvalues
)
return &f
->upvalue
[n
- 1];
/* else */
} /* FALLTHROUGH */
case LUA_VLCF
:
return NULL
; /* light C functions have no upvalues */
default: {
api_check
(L
, 0, "function expected");
return NULL
;
}
}
}
LUA_API
void lua_upvaluejoin
(lua_State
*L
, int fidx1
, int n1
,
int fidx2
, int n2
) {
LClosure
*f1
;
UpVal
**up1
= getupvalref
(L
, fidx1
, n1
, &f1
);
UpVal
**up2
= getupvalref
(L
, fidx2
, n2
, NULL
);
api_check
(L
, *up1
!= NULL
&& *up2
!= NULL
, "invalid upvalue index");
*up1
= *up2
;
luaC_objbarrier
(L
, f1
, *up1
);
}