mirrors
/
lua
mirror of https://github.com/lua/lua
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
lua/lbuiltin.c

739 lines
19 KiB
C
Raw Blame History

/*
** $Id: lbuiltin.c,v 1.50 1999/02/08 16:29:35 roberto Exp roberto $
** Built-in functions
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lapi.h"
#include "lauxlib.h"
#include "lbuiltin.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
#include "lundump.h"
#include "lvm.h"
/*
** {======================================================
** Auxiliary functions
** =======================================================
*/
static void pushtagstring (TaggedString *s) {
TObject o;
o.ttype = LUA_T_STRING;
o.value.ts = s;
luaA_pushobject(&o);
}
static real getsize (Hash *h) {
real max = 0;
int i;
for (i = 0; i<nhash(h); i++) {
Node *n = h->node+i;
if (ttype(ref(n)) == LUA_T_NUMBER &&
ttype(val(n)) != LUA_T_NIL &&
nvalue(ref(n)) > max)
max = nvalue(ref(n));
}
return max;
}
static real getnarg (Hash *a) {
TObject index;
TObject *value;
/* value = table.n */
ttype(&index) = LUA_T_STRING;
tsvalue(&index) = luaS_new("n");
value = luaH_get(a, &index);
return (ttype(value) == LUA_T_NUMBER) ? nvalue(value) : getsize(a);
}
static Hash *gethash (int arg) {
return avalue(luaA_Address(luaL_tablearg(arg)));
}
/* }====================================================== */
/*
** {======================================================
** Functions that use only the official API
** =======================================================
*/
/*
** If your system does not support "stderr", remove this function and
** define your own "_ALERT" function. You *must* have an _ALERT function
** defined for Lua to work properly.
*/
static void luaB_alert (void) {
fputs(luaL_check_string(1), stderr);
}
/*
** Standard implementation of _ERRORMESSAGE.
** The library "iolib" redefines _ERRORMESSAGE for better error information.
*/
static void error_message (void) {
char buff[600];
sprintf(buff, "lua error: %.500s\n", luaL_check_string(1));
lua_pushstring(buff);
lua_call("_ALERT");
}
/*
** If your system does not support "stdout", just remove this function.
** If you need, you can define your own "print" function, following this
** model but changing "fputs" to put the strings at a proper place
** (a console window or a log file, for instance).
*/
#define MAXPRINT 40
static void luaB_print (void) {
lua_Object args[MAXPRINT];
lua_Object obj;
int n = 0;
int i;
while ((obj = lua_getparam(n+1)) != LUA_NOOBJECT) {
luaL_arg_check(n < MAXPRINT, n+1, "too many arguments");
args[n++] = obj;
}
for (i=0; i<n; i++) {
lua_pushobject(args[i]);
if (lua_call("tostring"))
lua_error("error in `tostring' called by `print'");
obj = lua_getresult(1);
if (!lua_isstring(obj))
lua_error("`tostring' must return a string to `print'");
if (i>0) fputs("\t", stdout);
fputs(lua_getstring(obj), stdout);
}
fputs("\n", stdout);
}
static void luaB_tonumber (void) {
int base = luaL_opt_int(2, 10);
if (base == 10) { /* standard conversion */
lua_Object o = lua_getparam(1);
if (lua_isnumber(o)) lua_pushnumber(lua_getnumber(o));
else lua_pushnil(); /* not a number */
}
else {
char *s = luaL_check_string(1);
long n;
luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
n = strtol(s, &s, base);
while (isspace(*s)) s++; /* skip trailing spaces */
if (*s) lua_pushnil(); /* invalid format: return nil */
else lua_pushnumber(n);
}
}
static void luaB_error (void) {
lua_error(lua_getstring(lua_getparam(1)));
}
static void luaB_setglobal (void) {
char *n = luaL_check_string(1);
lua_Object value = luaL_nonnullarg(2);
lua_pushobject(value);
lua_setglobal(n);
lua_pushobject(value); /* return given value */
}
static void luaB_rawsetglobal (void) {
char *n = luaL_check_string(1);
lua_Object value = luaL_nonnullarg(2);
lua_pushobject(value);
lua_rawsetglobal(n);
lua_pushobject(value); /* return given value */
}
static void luaB_getglobal (void) {
lua_pushobject(lua_getglobal(luaL_check_string(1)));
}
static void luaB_rawgetglobal (void) {
lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
}
static void luaB_luatag (void) {
lua_pushnumber(lua_tag(lua_getparam(1)));
}
static void luaB_settag (void) {
lua_Object o = luaL_tablearg(1);
lua_pushobject(o);
lua_settag(luaL_check_int(2));
lua_pushobject(o); /* returns first argument */
}
static void luaB_newtag (void) {
lua_pushnumber(lua_newtag());
}
static void luaB_copytagmethods (void) {
lua_pushnumber(lua_copytagmethods(luaL_check_int(1),
luaL_check_int(2)));
}
static void luaB_rawgettable (void) {
lua_pushobject(luaL_nonnullarg(1));
lua_pushobject(luaL_nonnullarg(2));
lua_pushobject(lua_rawgettable());
}
static void luaB_rawsettable (void) {
lua_pushobject(luaL_nonnullarg(1));
lua_pushobject(luaL_nonnullarg(2));
lua_pushobject(luaL_nonnullarg(3));
lua_rawsettable();
}
static void luaB_settagmethod (void) {
lua_Object nf = luaL_nonnullarg(3);
lua_pushobject(nf);
lua_pushobject(lua_settagmethod(luaL_check_int(1), luaL_check_string(2)));
}
static void luaB_gettagmethod (void) {
lua_pushobject(lua_gettagmethod(luaL_check_int(1), luaL_check_string(2)));
}
static void luaB_seterrormethod (void) {
lua_Object nf = luaL_functionarg(1);
lua_pushobject(nf);
lua_pushobject(lua_seterrormethod());
}
static void luaB_collectgarbage (void) {
lua_pushnumber(lua_collectgarbage(luaL_opt_int(1, 0)));
}
/* }====================================================== */
/*
** {======================================================
** Functions that could use only the official API but
** do not, for efficiency.
** =======================================================
*/
static void luaB_dostring (void) {
long l;
char *s = luaL_check_lstr(1, &l);
if (*s == ID_CHUNK)
lua_error("`dostring' cannot run pre-compiled code");
if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0)
if (luaA_passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
}
static void luaB_dofile (void) {
char *fname = luaL_opt_string(1, NULL);
if (lua_dofile(fname) == 0)
if (luaA_passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
}
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();
}
}
/* }====================================================== */
#ifdef EXTRALIB
/*
** {======================================================
** "Extra" functions
** These functions can be written in Lua, so you can
** delete them if you need a tiny Lua implementation.
** If you delete them, remove their entries in array
** "builtin_funcs".
** =======================================================
*/
static void luaB_assert (void) {
lua_Object p = lua_getparam(1);
if (p == LUA_NOOBJECT || lua_isnil(p))
luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
}
static void luaB_foreachi (void) {
Hash *t = gethash(1);
TObject *f = luaA_Address(luaL_functionarg(2));
int i;
int n = (int)getnarg(t);
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 luaB_foreach (void) {
Hash *a = gethash(1);
TObject *f = luaA_Address(luaL_functionarg(2));
int i;
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--;
}
}
}
static void luaB_foreachvar (void) {
TObject *f = luaA_Address(luaL_functionarg(1));
GCnode *g;
StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */
luaD_checkstack(4); /* for var name, f, s, and globalvar */
ttype(L->stack.stack+name) = LUA_T_NIL;
L->stack.top++; /* top == base */
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 */
*(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)
return;
L->stack.top--;
}
}
}
static void luaB_getn (void) {
lua_pushnumber(getnarg(gethash(1)));
}
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); /* increment field "n" */
for ( ;n>=pos; n--)
luaH_move(a, n, n+1);
luaH_setint(a, pos, luaA_Address(v));
}
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)); /* push result */
luaV_setn(a, n-1); /* decrement field "n" */
for ( ;pos<n; pos++)
luaH_move(a, pos+1, pos);
}
/* {
** Quicksort
*/
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);
}
static int sort_comp (TObject *f, TObject *a, TObject *b) {
/* notice: the caller (auxsort) must check stack space */
if (f) {
*(L->stack.top) = *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 auxsort (Hash *a, int l, int u, TObject *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_sort (void) {
lua_Object t = lua_getparam(1);
Hash *a = gethash(1);
int n = (int)getnarg(a);
lua_Object func = lua_getparam(2);
TObject *f = luaA_Address(func);
luaL_arg_check(!f || lua_isfunction(func), 2, "function expected");
luaD_checkstack(4); /* for Pivot, f, a, b (sort_comp) */
auxsort(a, 1, n, f);
lua_pushobject(t);
}
/* }}===================================================== */
#endif
/*
** {======================================================
** Internal Functions.
** These functions need access to internal structures
** to be implemented.
** =======================================================
*/
static void luaB_nextvar (void) {
TObject *o = luaA_Address(luaL_nonnullarg(1));
TaggedString *g;
if (ttype(o) == LUA_T_NIL)
g = (TaggedString *)L->rootglobal.next; /* first variable */
else {
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
g = tsvalue(o); /* find given variable name */
/* 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; /* get next */
}
while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */
g = (TaggedString *)g->head.next;
if (g) {
pushtagstring(g);
luaA_pushobject(&g->u.s.globalval);
}
else lua_pushnil(); /* no more globals */
}
static void luaB_next (void) {
Node *n = luaH_next(gethash(1), luaA_Address(luaL_nonnullarg(2)));
if (n) {
luaA_pushobject(&n->ref);
luaA_pushobject(&n->val);
}
else 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 luaB_type (void) {
lua_Object o = luaL_nonnullarg(1);
lua_pushstring(luaO_typename(luaA_Address(o)));
lua_pushnumber(lua_tag(o));
}
/* }====================================================== */
#ifdef DEBUG
/*
** {======================================================
** some DEBUG functions
** =======================================================
*/
static void mem_query (void) {
lua_pushnumber(totalmem);
lua_pushnumber(numblocks);
}
static void query_strings (void) {
lua_pushnumber(L->string_root[luaL_check_int(1)].nuse);
}
static void countlist (void) {
char *s = luaL_check_string(1);
GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
(s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
int i=0;
while (l) {
i++;
l = l->next;
}
lua_pushnumber(i);
}
static void testC (void) {
#define getnum(s) ((*s++) - '0')
#define getname(s) (nome[0] = *s++, nome)
static int locks[10];
lua_Object reg[10];
char nome[2];
char *s = luaL_check_string(1);
nome[1] = 0;
for (;;) {
switch (*s++) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
lua_pushnumber(*(s-1) - '0');
break;
case 'c': reg[getnum(s)] = lua_createtable(); break;
case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
lua_pushcclosure(f, getnum(s));
break;
}
case 'P': reg[getnum(s)] = lua_pop(); break;
case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
case 'G': { int n = getnum(s);
reg[n] = lua_rawgetglobal(getname(s));
break;
}
case 'l': locks[getnum(s)] = lua_ref(1); break;
case 'L': locks[getnum(s)] = lua_ref(0); break;
case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
case 'u': lua_unref(locks[getnum(s)]); break;
case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
case '=': lua_setglobal(getname(s)); break;
case 's': lua_pushstring(getname(s)); break;
case 'o': lua_pushobject(reg[getnum(s)]); break;
case 'f': lua_call(getname(s)); break;
case 'i': reg[getnum(s)] = lua_gettable(); break;
case 'I': reg[getnum(s)] = lua_rawgettable(); break;
case 't': lua_settable(); break;
case 'T': lua_rawsettable(); break;
default: luaL_verror("unknown command in `testC': %c", *(s-1));
}
if (*s == 0) return;
if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
}
}
/* }====================================================== */
#endif
static struct luaL_reg builtin_funcs[] = {
#ifdef LUA_COMPAT2_5
{"setfallback", luaT_setfallback},
#endif
#ifdef DEBUG
{"testC", testC},
{"totalmem", mem_query},
{"count", countlist},
{"querystr", query_strings},
#endif
{"_ALERT", luaB_alert},
{"_ERRORMESSAGE", error_message},
{"call", luaB_call},
{"collectgarbage", luaB_collectgarbage},
{"copytagmethods", luaB_copytagmethods},
{"dofile", luaB_dofile},
{"dostring", luaB_dostring},
{"error", luaB_error},
{"getglobal", luaB_getglobal},
{"gettagmethod", luaB_gettagmethod},
{"newtag", luaB_newtag},
{"next", luaB_next},
{"nextvar", luaB_nextvar},
{"print", luaB_print},
{"rawgetglobal", luaB_rawgetglobal},
{"rawgettable", luaB_rawgettable},
{"rawsetglobal", luaB_rawsetglobal},
{"rawsettable", luaB_rawsettable},
{"seterrormethod", luaB_seterrormethod},
{"setglobal", luaB_setglobal},
{"settag", luaB_settag},
{"settagmethod", luaB_settagmethod},
{"tag", luaB_luatag},
{"tonumber", luaB_tonumber},
{"tostring", luaB_tostring},
{"type", luaB_type}
#ifdef EXTRALIB
/* "Extra" functions */
,{"assert", luaB_assert},
{"foreach", luaB_foreach},
{"foreachi", luaB_foreachi},
{"foreachvar", luaB_foreachvar},
{"getn", luaB_getn},
{"sort", luaB_sort},
{"tinsert", luaB_tinsert},
{"tremove", luaB_tremove}
#endif
};
#define INTFUNCSIZE (sizeof(builtin_funcs)/sizeof(builtin_funcs[0]))
void luaB_predefine (void) {
/* pre-register mem error messages, to avoid loop when error arises */
luaS_newfixedstring(tableEM);
luaS_newfixedstring(memEM);
luaL_openlib(builtin_funcs, (sizeof(builtin_funcs)/sizeof(builtin_funcs[0])));
lua_pushstring(LUA_VERSION);
lua_setglobal("_VERSION");
}
Reference in New Issue View Git Blame Copy Permalink