From 9a5eedd11cc043fd09c96d57eb901fb85fc1655d Mon Sep 17 00:00:00 2001 From: pixel Date: Thu, 11 Dec 2003 16:53:27 +0000 Subject: Linux ports --- lib/lua/src/LuaLib/lbaselib.c | 1348 ++++++++++++++++++++--------------------- 1 file changed, 674 insertions(+), 674 deletions(-) (limited to 'lib/lua/src/LuaLib/lbaselib.c') diff --git a/lib/lua/src/LuaLib/lbaselib.c b/lib/lua/src/LuaLib/lbaselib.c index 9e7c18b..5a3245a 100644 --- a/lib/lua/src/LuaLib/lbaselib.c +++ b/lib/lua/src/LuaLib/lbaselib.c @@ -1,674 +1,674 @@ -/* -** $Id: lbaselib.c,v 1.1 2003-11-06 11:56:07 pixel Exp $ -** Basic library -** See Copyright Notice in lua.h -*/ - - - -#include -#include -#include -#include - -#define lbaselib_c - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - - - -/* -** If your system does not support `stdout', you can 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). -*/ -static int luaB_print (lua_State *L) { - int n = lua_gettop(L); /* number of arguments */ - int i; - lua_getglobal(L, "tostring"); - for (i=1; i<=n; i++) { - const char *s; - lua_pushvalue(L, -1); /* function to be called */ - lua_pushvalue(L, i); /* value to print */ - lua_call(L, 1, 1); - s = lua_tostring(L, -1); /* get result */ - if (s == NULL) - return luaL_error(L, "`tostring' must return a string to `print'"); - if (i>1) fputs("\t", stdout); - fputs(s, stdout); - lua_pop(L, 1); /* pop result */ - } - fputs("\n", stdout); - return 0; -} - - -static int luaB_tonumber (lua_State *L) { - int base = luaL_optint(L, 2, 10); - if (base == 10) { /* standard conversion */ - luaL_checkany(L, 1); - if (lua_isnumber(L, 1)) { - lua_pushnumber(L, lua_tonumber(L, 1)); - return 1; - } - } - else { - const char *s1 = luaL_checkstring(L, 1); - char *s2; - unsigned long n; - luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); - n = strtoul(s1, &s2, base); - if (s1 != s2) { /* at least one valid digit? */ - while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */ - if (*s2 == '\0') { /* no invalid trailing characters? */ - lua_pushnumber(L, (lua_Number)n); - return 1; - } - } - } - lua_pushnil(L); /* else not a number */ - return 1; -} - - -static int luaB_error (lua_State *L) { - int level = luaL_optint(L, 2, 1); - luaL_checkany(L, 1); - if (!lua_isstring(L, 1) || level == 0) - lua_pushvalue(L, 1); /* propagate error message without changes */ - else { /* add extra information */ - luaL_where(L, level); - lua_pushvalue(L, 1); - lua_concat(L, 2); - } - return lua_error(L); -} - - -static int luaB_getmetatable (lua_State *L) { - luaL_checkany(L, 1); - if (!lua_getmetatable(L, 1)) { - lua_pushnil(L); - return 1; /* no metatable */ - } - luaL_getmetafield(L, 1, "__metatable"); - return 1; /* returns either __metatable field (if present) or metatable */ -} - - -static int luaB_setmetatable (lua_State *L) { - int t = lua_type(L, 2); - luaL_checktype(L, 1, LUA_TTABLE); - luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, - "nil or table expected"); - if (luaL_getmetafield(L, 1, "__metatable")) - luaL_error(L, "cannot change a protected metatable"); - lua_settop(L, 2); - lua_setmetatable(L, 1); - return 1; -} - - -static void getfunc (lua_State *L) { - if (lua_isfunction(L, 1)) lua_pushvalue(L, 1); - else { - lua_Debug ar; - int level = luaL_optint(L, 1, 1); - luaL_argcheck(L, level >= 0, 1, "level must be non-negative"); - if (lua_getstack(L, level, &ar) == 0) - luaL_argerror(L, 1, "invalid level"); - lua_getinfo(L, "f", &ar); - if (lua_isnil(L, -1)) - luaL_error(L, "no function environment for tail call at level %d", - level); - } -} - - -static int aux_getfenv (lua_State *L) { - lua_getfenv(L, -1); - lua_pushliteral(L, "__fenv"); - lua_rawget(L, -2); - return !lua_isnil(L, -1); -} - - -static int luaB_getfenv (lua_State *L) { - getfunc(L); - if (!aux_getfenv(L)) /* __fenv not defined? */ - lua_pop(L, 1); /* remove it, to return real environment */ - return 1; -} - - -static int luaB_setfenv (lua_State *L) { - luaL_checktype(L, 2, LUA_TTABLE); - getfunc(L); - if (aux_getfenv(L)) /* __fenv defined? */ - luaL_error(L, "`setfenv' cannot change a protected environment"); - else - lua_pop(L, 2); /* remove __fenv and real environment table */ - lua_pushvalue(L, 2); - if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) - lua_replace(L, LUA_GLOBALSINDEX); - else if (lua_setfenv(L, -2) == 0) - luaL_error(L, "`setfenv' cannot change environment of given function"); - return 0; -} - - -static int luaB_rawequal (lua_State *L) { - luaL_checkany(L, 1); - luaL_checkany(L, 2); - lua_pushboolean(L, lua_rawequal(L, 1, 2)); - return 1; -} - - -static int luaB_rawget (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checkany(L, 2); - lua_rawget(L, 1); - return 1; -} - -static int luaB_rawset (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checkany(L, 2); - luaL_checkany(L, 3); - lua_rawset(L, 1); - return 1; -} - - -static int luaB_gcinfo (lua_State *L) { - lua_pushnumber(L, (lua_Number)lua_getgccount(L)); - lua_pushnumber(L, (lua_Number)lua_getgcthreshold(L)); - return 2; -} - - -static int luaB_collectgarbage (lua_State *L) { - lua_setgcthreshold(L, luaL_optint(L, 1, 0)); - return 0; -} - - -static int luaB_type (lua_State *L) { - luaL_checkany(L, 1); - lua_pushstring(L, lua_typename(L, lua_type(L, 1))); - return 1; -} - - -static int luaB_next (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_settop(L, 2); /* create a 2nd argument if there isn't one */ - if (lua_next(L, 1)) - return 2; - else { - lua_pushnil(L); - return 1; - } -} - - -static int luaB_pairs (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_pushliteral(L, "next"); - lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ - lua_pushvalue(L, 1); /* state, */ - lua_pushnil(L); /* and initial value */ - return 3; -} - - -static int luaB_ipairs (lua_State *L) { - lua_Number i = lua_tonumber(L, 2); - luaL_checktype(L, 1, LUA_TTABLE); - if (i == 0 && lua_isnone(L, 2)) { /* `for' start? */ - lua_pushliteral(L, "ipairs"); - lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ - lua_pushvalue(L, 1); /* state, */ - lua_pushnumber(L, 0); /* and initial value */ - return 3; - } - else { /* `for' step */ - i++; /* next value */ - lua_pushnumber(L, i); - lua_rawgeti(L, 1, (int)i); - return (lua_isnil(L, -1)) ? 0 : 2; - } -} - - -static int load_aux (lua_State *L, int status) { - if (status == 0) /* OK? */ - return 1; - else { - lua_pushnil(L); - lua_insert(L, -2); /* put before error message */ - return 2; /* return nil plus error message */ - } -} - - -static int luaB_loadstring (lua_State *L) { - size_t l; - const char *s = luaL_checklstring(L, 1, &l); - const char *chunkname = luaL_optstring(L, 2, s); - return load_aux(L, luaL_loadbuffer(L, s, l, chunkname)); -} - - -static int luaB_loadfile (lua_State *L) { - const char *fname = luaL_optstring(L, 1, NULL); - return load_aux(L, luaL_loadfile(L, fname)); -} - - -static int luaB_dofile (lua_State *L) { - const char *fname = luaL_optstring(L, 1, NULL); - int status = luaL_loadfile(L, fname); - if (status != 0) lua_error(L); - lua_call(L, 0, LUA_MULTRET); - return lua_gettop(L) - 1; -} - - -static int luaB_assert (lua_State *L) { - luaL_checkany(L, 1); - if (!lua_toboolean(L, 1)) - return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); - lua_settop(L, 1); - return 1; -} - - -static int luaB_unpack (lua_State *L) { - int n, i; - luaL_checktype(L, 1, LUA_TTABLE); - n = luaL_getn(L, 1); - luaL_checkstack(L, n, "table too big to unpack"); - for (i=1; i<=n; i++) /* push arg[1...n] */ - lua_rawgeti(L, 1, i); - return n; -} - - -static int luaB_pcall (lua_State *L) { - int status; - luaL_checkany(L, 1); - status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); - lua_pushboolean(L, (status == 0)); - lua_insert(L, 1); - return lua_gettop(L); /* return status + all results */ -} - - -static int luaB_xpcall (lua_State *L) { - int status; - luaL_checkany(L, 2); - lua_settop(L, 2); - lua_insert(L, 1); /* put error function under function to be called */ - status = lua_pcall(L, 0, LUA_MULTRET, 1); - lua_pushboolean(L, (status == 0)); - lua_replace(L, 1); - return lua_gettop(L); /* return status + all results */ -} - - -static int luaB_tostring (lua_State *L) { - char buff[64]; - luaL_checkany(L, 1); - if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ - return 1; /* use its value */ - switch (lua_type(L, 1)) { - case LUA_TNUMBER: - lua_pushstring(L, lua_tostring(L, 1)); - return 1; - case LUA_TSTRING: - lua_pushvalue(L, 1); - return 1; - case LUA_TBOOLEAN: - lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); - return 1; - case LUA_TTABLE: - sprintf(buff, "table: %p", lua_topointer(L, 1)); - break; - case LUA_TFUNCTION: - sprintf(buff, "function: %p", lua_topointer(L, 1)); - break; - case LUA_TUSERDATA: - case LUA_TLIGHTUSERDATA: - sprintf(buff, "userdata: %p", lua_touserdata(L, 1)); - break; - case LUA_TTHREAD: - sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1)); - break; - case LUA_TNIL: - lua_pushliteral(L, "nil"); - return 1; - } - lua_pushstring(L, buff); - return 1; -} - - -static int luaB_newproxy (lua_State *L) { - lua_settop(L, 1); - lua_newuserdata(L, 0); /* create proxy */ - if (lua_toboolean(L, 1) == 0) - return 1; /* no metatable */ - else if (lua_isboolean(L, 1)) { - lua_newtable(L); /* create a new metatable `m' ... */ - lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ - lua_pushboolean(L, 1); - lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ - } - else { - int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ - if (lua_getmetatable(L, 1)) { - lua_rawget(L, lua_upvalueindex(1)); - validproxy = lua_toboolean(L, -1); - lua_pop(L, 1); /* remove value */ - } - luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); - lua_getmetatable(L, 1); /* metatable is valid; get it */ - } - lua_setmetatable(L, 2); - return 1; -} - - -/* -** {====================================================== -** `require' function -** ======================================================= -*/ - - -/* name of global that holds table with loaded packages */ -#define REQTAB "_LOADED" - -/* name of global that holds the search path for packages */ -#define LUA_PATH "LUA_PATH" - -#ifndef LUA_PATH_SEP -#define LUA_PATH_SEP ';' -#endif - -#ifndef LUA_PATH_MARK -#define LUA_PATH_MARK '?' -#endif - -#ifndef LUA_PATH_DEFAULT -#define LUA_PATH_DEFAULT "?;?.lua" -#endif - - -static const char *getpath (lua_State *L) { - const char *path; - lua_getglobal(L, LUA_PATH); /* try global variable */ - path = lua_tostring(L, -1); - lua_pop(L, 1); - if (path) return path; - path = getenv(LUA_PATH); /* else try environment variable */ - if (path) return path; - return LUA_PATH_DEFAULT; /* else use default */ -} - - -static const char *pushnextpath (lua_State *L, const char *path) { - const char *l; - if (*path == '\0') return NULL; /* no more paths */ - if (*path == LUA_PATH_SEP) path++; /* skip separator */ - l = strchr(path, LUA_PATH_SEP); /* find next separator */ - if (l == NULL) l = path+strlen(path); - lua_pushlstring(L, path, l - path); /* directory name */ - return l; -} - - -static void pushcomposename (lua_State *L) { - const char *path = lua_tostring(L, -1); - const char *wild; - int n = 1; - while ((wild = strchr(path, LUA_PATH_MARK)) != NULL) { - /* is there stack space for prefix, name, and eventual last sufix? */ - luaL_checkstack(L, 3, "too many marks in a path component"); - lua_pushlstring(L, path, wild - path); /* push prefix */ - lua_pushvalue(L, 1); /* push package name (in place of MARK) */ - path = wild + 1; /* continue after MARK */ - n += 2; - } - lua_pushstring(L, path); /* push last sufix (`n' already includes this) */ - lua_concat(L, n); -} - - -static int luaB_require (lua_State *L) { - const char *path; - int status = LUA_ERRFILE; /* not found (yet) */ - luaL_checkstring(L, 1); - lua_settop(L, 1); - lua_getglobal(L, REQTAB); - if (!lua_istable(L, 2)) return luaL_error(L, "`" REQTAB "' is not a table"); - path = getpath(L); - lua_pushvalue(L, 1); /* check package's name in book-keeping table */ - lua_rawget(L, 2); - if (lua_toboolean(L, -1)) /* is it there? */ - return 1; /* package is already loaded; return its result */ - else { /* must load it */ - while (status == LUA_ERRFILE) { - lua_settop(L, 3); /* reset stack position */ - if ((path = pushnextpath(L, path)) == NULL) break; - pushcomposename(L); - status = luaL_loadfile(L, lua_tostring(L, -1)); /* try to load it */ - } - } - switch (status) { - case 0: { - lua_getglobal(L, "_REQUIREDNAME"); /* save previous name */ - lua_insert(L, -2); /* put it below function */ - lua_pushvalue(L, 1); - lua_setglobal(L, "_REQUIREDNAME"); /* set new name */ - lua_call(L, 0, 1); /* run loaded module */ - lua_insert(L, -2); /* put result below previous name */ - lua_setglobal(L, "_REQUIREDNAME"); /* reset to previous name */ - if (lua_isnil(L, -1)) { /* no/nil return? */ - lua_pushboolean(L, 1); - lua_replace(L, -2); /* replace to true */ - } - lua_pushvalue(L, 1); - lua_pushvalue(L, -2); - lua_rawset(L, 2); /* mark it as loaded */ - return 1; /* return value */ - } - case LUA_ERRFILE: { /* file not found */ - return luaL_error(L, "could not load package `%s' from path `%s'", - lua_tostring(L, 1), getpath(L)); - } - default: { - return luaL_error(L, "error loading package `%s' (%s)", - lua_tostring(L, 1), lua_tostring(L, -1)); - } - } -} - -/* }====================================================== */ - - -static const luaL_reg base_funcs[] = { - {"error", luaB_error}, - {"getmetatable", luaB_getmetatable}, - {"setmetatable", luaB_setmetatable}, - {"getfenv", luaB_getfenv}, - {"setfenv", luaB_setfenv}, - {"next", luaB_next}, - {"ipairs", luaB_ipairs}, - {"pairs", luaB_pairs}, - {"print", luaB_print}, - {"tonumber", luaB_tonumber}, - {"tostring", luaB_tostring}, - {"type", luaB_type}, - {"assert", luaB_assert}, - {"unpack", luaB_unpack}, - {"rawequal", luaB_rawequal}, - {"rawget", luaB_rawget}, - {"rawset", luaB_rawset}, - {"pcall", luaB_pcall}, - {"xpcall", luaB_xpcall}, - {"collectgarbage", luaB_collectgarbage}, - {"gcinfo", luaB_gcinfo}, - {"loadfile", luaB_loadfile}, - {"dofile", luaB_dofile}, - {"loadstring", luaB_loadstring}, - {"require", luaB_require}, - {NULL, NULL} -}; - - -/* -** {====================================================== -** Coroutine library -** ======================================================= -*/ - -static int auxresume (lua_State *L, lua_State *co, int narg) { - int status; - if (!lua_checkstack(co, narg)) - luaL_error(L, "too many arguments to resume"); - lua_xmove(L, co, narg); - status = lua_resume(co, narg); - if (status == 0) { - int nres = lua_gettop(co); - if (!lua_checkstack(L, nres)) - luaL_error(L, "too many results to resume"); - lua_xmove(co, L, nres); /* move yielded values */ - return nres; - } - else { - lua_xmove(co, L, 1); /* move error message */ - return -1; /* error flag */ - } -} - - -static int luaB_coresume (lua_State *L) { - lua_State *co = lua_tothread(L, 1); - int r; - luaL_argcheck(L, co, 1, "coroutine expected"); - r = auxresume(L, co, lua_gettop(L) - 1); - if (r < 0) { - lua_pushboolean(L, 0); - lua_insert(L, -2); - return 2; /* return false + error message */ - } - else { - lua_pushboolean(L, 1); - lua_insert(L, -(r + 1)); - return r + 1; /* return true + `resume' returns */ - } -} - - -static int luaB_auxwrap (lua_State *L) { - lua_State *co = lua_tothread(L, lua_upvalueindex(1)); - int r = auxresume(L, co, lua_gettop(L)); - if (r < 0) { - if (lua_isstring(L, -1)) { /* error object is a string? */ - luaL_where(L, 1); /* add extra info */ - lua_insert(L, -2); - lua_concat(L, 2); - } - lua_error(L); /* propagate error */ - } - return r; -} - - -static int luaB_cocreate (lua_State *L) { - lua_State *NL = lua_newthread(L); - luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, - "Lua function expected"); - lua_pushvalue(L, 1); /* move function to top */ - lua_xmove(L, NL, 1); /* move function from L to NL */ - return 1; -} - - -static int luaB_cowrap (lua_State *L) { - luaB_cocreate(L); - lua_pushcclosure(L, luaB_auxwrap, 1); - return 1; -} - - -static int luaB_yield (lua_State *L) { - return lua_yield(L, lua_gettop(L)); -} - - -static int luaB_costatus (lua_State *L) { - lua_State *co = lua_tothread(L, 1); - luaL_argcheck(L, co, 1, "coroutine expected"); - if (L == co) lua_pushliteral(L, "running"); - else { - lua_Debug ar; - if (lua_getstack(co, 0, &ar) == 0 && lua_gettop(co) == 0) - lua_pushliteral(L, "dead"); - else - lua_pushliteral(L, "suspended"); - } - return 1; -} - - -static const luaL_reg co_funcs[] = { - {"create", luaB_cocreate}, - {"wrap", luaB_cowrap}, - {"resume", luaB_coresume}, - {"yield", luaB_yield}, - {"status", luaB_costatus}, - {NULL, NULL} -}; - -/* }====================================================== */ - - - -static void base_open (lua_State *L) { - lua_pushliteral(L, "_G"); - lua_pushvalue(L, LUA_GLOBALSINDEX); - luaL_openlib(L, NULL, base_funcs, 0); /* open lib into global table */ - lua_pushliteral(L, "_VERSION"); - lua_pushliteral(L, LUA_VERSION); - lua_rawset(L, -3); /* set global _VERSION */ - /* `newproxy' needs a weaktable as upvalue */ - lua_pushliteral(L, "newproxy"); - lua_newtable(L); /* new table `w' */ - lua_pushvalue(L, -1); /* `w' will be its own metatable */ - lua_setmetatable(L, -2); - lua_pushliteral(L, "__mode"); - lua_pushliteral(L, "k"); - lua_rawset(L, -3); /* metatable(w).__mode = "k" */ - lua_pushcclosure(L, luaB_newproxy, 1); - lua_rawset(L, -3); /* set global `newproxy' */ - lua_rawset(L, -1); /* set global _G */ -} - - -LUALIB_API int luaopen_base (lua_State *L) { - base_open(L); - luaL_openlib(L, LUA_COLIBNAME, co_funcs, 0); - lua_newtable(L); - lua_setglobal(L, REQTAB); - return 0; -} - +/* +** $Id: lbaselib.c,v 1.2 2003-12-11 16:53:32 pixel Exp $ +** Basic library +** See Copyright Notice in lua.h +*/ + + + +#include +#include +#include +#include + +#define lbaselib_c + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + + + +/* +** If your system does not support `stdout', you can 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). +*/ +static int luaB_print (lua_State *L) { + int n = lua_gettop(L); /* number of arguments */ + int i; + lua_getglobal(L, "tostring"); + for (i=1; i<=n; i++) { + const char *s; + lua_pushvalue(L, -1); /* function to be called */ + lua_pushvalue(L, i); /* value to print */ + lua_call(L, 1, 1); + s = lua_tostring(L, -1); /* get result */ + if (s == NULL) + return luaL_error(L, "`tostring' must return a string to `print'"); + if (i>1) fputs("\t", stdout); + fputs(s, stdout); + lua_pop(L, 1); /* pop result */ + } + fputs("\n", stdout); + return 0; +} + + +static int luaB_tonumber (lua_State *L) { + int base = luaL_optint(L, 2, 10); + if (base == 10) { /* standard conversion */ + luaL_checkany(L, 1); + if (lua_isnumber(L, 1)) { + lua_pushnumber(L, lua_tonumber(L, 1)); + return 1; + } + } + else { + const char *s1 = luaL_checkstring(L, 1); + char *s2; + unsigned long n; + luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); + n = strtoul(s1, &s2, base); + if (s1 != s2) { /* at least one valid digit? */ + while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */ + if (*s2 == '\0') { /* no invalid trailing characters? */ + lua_pushnumber(L, (lua_Number)n); + return 1; + } + } + } + lua_pushnil(L); /* else not a number */ + return 1; +} + + +static int luaB_error (lua_State *L) { + int level = luaL_optint(L, 2, 1); + luaL_checkany(L, 1); + if (!lua_isstring(L, 1) || level == 0) + lua_pushvalue(L, 1); /* propagate error message without changes */ + else { /* add extra information */ + luaL_where(L, level); + lua_pushvalue(L, 1); + lua_concat(L, 2); + } + return lua_error(L); +} + + +static int luaB_getmetatable (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_getmetatable(L, 1)) { + lua_pushnil(L); + return 1; /* no metatable */ + } + luaL_getmetafield(L, 1, "__metatable"); + return 1; /* returns either __metatable field (if present) or metatable */ +} + + +static int luaB_setmetatable (lua_State *L) { + int t = lua_type(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, + "nil or table expected"); + if (luaL_getmetafield(L, 1, "__metatable")) + luaL_error(L, "cannot change a protected metatable"); + lua_settop(L, 2); + lua_setmetatable(L, 1); + return 1; +} + + +static void getfunc (lua_State *L) { + if (lua_isfunction(L, 1)) lua_pushvalue(L, 1); + else { + lua_Debug ar; + int level = luaL_optint(L, 1, 1); + luaL_argcheck(L, level >= 0, 1, "level must be non-negative"); + if (lua_getstack(L, level, &ar) == 0) + luaL_argerror(L, 1, "invalid level"); + lua_getinfo(L, "f", &ar); + if (lua_isnil(L, -1)) + luaL_error(L, "no function environment for tail call at level %d", + level); + } +} + + +static int aux_getfenv (lua_State *L) { + lua_getfenv(L, -1); + lua_pushliteral(L, "__fenv"); + lua_rawget(L, -2); + return !lua_isnil(L, -1); +} + + +static int luaB_getfenv (lua_State *L) { + getfunc(L); + if (!aux_getfenv(L)) /* __fenv not defined? */ + lua_pop(L, 1); /* remove it, to return real environment */ + return 1; +} + + +static int luaB_setfenv (lua_State *L) { + luaL_checktype(L, 2, LUA_TTABLE); + getfunc(L); + if (aux_getfenv(L)) /* __fenv defined? */ + luaL_error(L, "`setfenv' cannot change a protected environment"); + else + lua_pop(L, 2); /* remove __fenv and real environment table */ + lua_pushvalue(L, 2); + if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) + lua_replace(L, LUA_GLOBALSINDEX); + else if (lua_setfenv(L, -2) == 0) + luaL_error(L, "`setfenv' cannot change environment of given function"); + return 0; +} + + +static int luaB_rawequal (lua_State *L) { + luaL_checkany(L, 1); + luaL_checkany(L, 2); + lua_pushboolean(L, lua_rawequal(L, 1, 2)); + return 1; +} + + +static int luaB_rawget (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checkany(L, 2); + lua_rawget(L, 1); + return 1; +} + +static int luaB_rawset (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checkany(L, 2); + luaL_checkany(L, 3); + lua_rawset(L, 1); + return 1; +} + + +static int luaB_gcinfo (lua_State *L) { + lua_pushnumber(L, (lua_Number)lua_getgccount(L)); + lua_pushnumber(L, (lua_Number)lua_getgcthreshold(L)); + return 2; +} + + +static int luaB_collectgarbage (lua_State *L) { + lua_setgcthreshold(L, luaL_optint(L, 1, 0)); + return 0; +} + + +static int luaB_type (lua_State *L) { + luaL_checkany(L, 1); + lua_pushstring(L, lua_typename(L, lua_type(L, 1))); + return 1; +} + + +static int luaB_next (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_settop(L, 2); /* create a 2nd argument if there isn't one */ + if (lua_next(L, 1)) + return 2; + else { + lua_pushnil(L); + return 1; + } +} + + +static int luaB_pairs (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_pushliteral(L, "next"); + lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushnil(L); /* and initial value */ + return 3; +} + + +static int luaB_ipairs (lua_State *L) { + lua_Number i = lua_tonumber(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + if (i == 0 && lua_isnone(L, 2)) { /* `for' start? */ + lua_pushliteral(L, "ipairs"); + lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushnumber(L, 0); /* and initial value */ + return 3; + } + else { /* `for' step */ + i++; /* next value */ + lua_pushnumber(L, i); + lua_rawgeti(L, 1, (int)i); + return (lua_isnil(L, -1)) ? 0 : 2; + } +} + + +static int load_aux (lua_State *L, int status) { + if (status == 0) /* OK? */ + return 1; + else { + lua_pushnil(L); + lua_insert(L, -2); /* put before error message */ + return 2; /* return nil plus error message */ + } +} + + +static int luaB_loadstring (lua_State *L) { + size_t l; + const char *s = luaL_checklstring(L, 1, &l); + const char *chunkname = luaL_optstring(L, 2, s); + return load_aux(L, luaL_loadbuffer(L, s, l, chunkname)); +} + + +static int luaB_loadfile (lua_State *L) { + const char *fname = luaL_optstring(L, 1, NULL); + return load_aux(L, luaL_loadfile(L, fname)); +} + + +static int luaB_dofile (lua_State *L) { + const char *fname = luaL_optstring(L, 1, NULL); + int status = luaL_loadfile(L, fname); + if (status != 0) lua_error(L); + lua_call(L, 0, LUA_MULTRET); + return lua_gettop(L) - 1; +} + + +static int luaB_assert (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_toboolean(L, 1)) + return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); + lua_settop(L, 1); + return 1; +} + + +static int luaB_unpack (lua_State *L) { + int n, i; + luaL_checktype(L, 1, LUA_TTABLE); + n = luaL_getn(L, 1); + luaL_checkstack(L, n, "table too big to unpack"); + for (i=1; i<=n; i++) /* push arg[1...n] */ + lua_rawgeti(L, 1, i); + return n; +} + + +static int luaB_pcall (lua_State *L) { + int status; + luaL_checkany(L, 1); + status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); + lua_pushboolean(L, (status == 0)); + lua_insert(L, 1); + return lua_gettop(L); /* return status + all results */ +} + + +static int luaB_xpcall (lua_State *L) { + int status; + luaL_checkany(L, 2); + lua_settop(L, 2); + lua_insert(L, 1); /* put error function under function to be called */ + status = lua_pcall(L, 0, LUA_MULTRET, 1); + lua_pushboolean(L, (status == 0)); + lua_replace(L, 1); + return lua_gettop(L); /* return status + all results */ +} + + +static int luaB_tostring (lua_State *L) { + char buff[64]; + luaL_checkany(L, 1); + if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ + return 1; /* use its value */ + switch (lua_type(L, 1)) { + case LUA_TNUMBER: + lua_pushstring(L, lua_tostring(L, 1)); + return 1; + case LUA_TSTRING: + lua_pushvalue(L, 1); + return 1; + case LUA_TBOOLEAN: + lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); + return 1; + case LUA_TTABLE: + sprintf(buff, "table: %p", lua_topointer(L, 1)); + break; + case LUA_TFUNCTION: + sprintf(buff, "function: %p", lua_topointer(L, 1)); + break; + case LUA_TUSERDATA: + case LUA_TLIGHTUSERDATA: + sprintf(buff, "userdata: %p", lua_touserdata(L, 1)); + break; + case LUA_TTHREAD: + sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1)); + break; + case LUA_TNIL: + lua_pushliteral(L, "nil"); + return 1; + } + lua_pushstring(L, buff); + return 1; +} + + +static int luaB_newproxy (lua_State *L) { + lua_settop(L, 1); + lua_newuserdata(L, 0); /* create proxy */ + if (lua_toboolean(L, 1) == 0) + return 1; /* no metatable */ + else if (lua_isboolean(L, 1)) { + lua_newtable(L); /* create a new metatable `m' ... */ + lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ + lua_pushboolean(L, 1); + lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ + } + else { + int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ + if (lua_getmetatable(L, 1)) { + lua_rawget(L, lua_upvalueindex(1)); + validproxy = lua_toboolean(L, -1); + lua_pop(L, 1); /* remove value */ + } + luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); + lua_getmetatable(L, 1); /* metatable is valid; get it */ + } + lua_setmetatable(L, 2); + return 1; +} + + +/* +** {====================================================== +** `require' function +** ======================================================= +*/ + + +/* name of global that holds table with loaded packages */ +#define REQTAB "_LOADED" + +/* name of global that holds the search path for packages */ +#define LUA_PATH "LUA_PATH" + +#ifndef LUA_PATH_SEP +#define LUA_PATH_SEP ';' +#endif + +#ifndef LUA_PATH_MARK +#define LUA_PATH_MARK '?' +#endif + +#ifndef LUA_PATH_DEFAULT +#define LUA_PATH_DEFAULT "?;?.lua" +#endif + + +static const char *getpath (lua_State *L) { + const char *path; + lua_getglobal(L, LUA_PATH); /* try global variable */ + path = lua_tostring(L, -1); + lua_pop(L, 1); + if (path) return path; + path = getenv(LUA_PATH); /* else try environment variable */ + if (path) return path; + return LUA_PATH_DEFAULT; /* else use default */ +} + + +static const char *pushnextpath (lua_State *L, const char *path) { + const char *l; + if (*path == '\0') return NULL; /* no more paths */ + if (*path == LUA_PATH_SEP) path++; /* skip separator */ + l = strchr(path, LUA_PATH_SEP); /* find next separator */ + if (l == NULL) l = path+strlen(path); + lua_pushlstring(L, path, l - path); /* directory name */ + return l; +} + + +static void pushcomposename (lua_State *L) { + const char *path = lua_tostring(L, -1); + const char *wild; + int n = 1; + while ((wild = strchr(path, LUA_PATH_MARK)) != NULL) { + /* is there stack space for prefix, name, and eventual last sufix? */ + luaL_checkstack(L, 3, "too many marks in a path component"); + lua_pushlstring(L, path, wild - path); /* push prefix */ + lua_pushvalue(L, 1); /* push package name (in place of MARK) */ + path = wild + 1; /* continue after MARK */ + n += 2; + } + lua_pushstring(L, path); /* push last sufix (`n' already includes this) */ + lua_concat(L, n); +} + + +static int luaB_require (lua_State *L) { + const char *path; + int status = LUA_ERRFILE; /* not found (yet) */ + luaL_checkstring(L, 1); + lua_settop(L, 1); + lua_getglobal(L, REQTAB); + if (!lua_istable(L, 2)) return luaL_error(L, "`" REQTAB "' is not a table"); + path = getpath(L); + lua_pushvalue(L, 1); /* check package's name in book-keeping table */ + lua_rawget(L, 2); + if (lua_toboolean(L, -1)) /* is it there? */ + return 1; /* package is already loaded; return its result */ + else { /* must load it */ + while (status == LUA_ERRFILE) { + lua_settop(L, 3); /* reset stack position */ + if ((path = pushnextpath(L, path)) == NULL) break; + pushcomposename(L); + status = luaL_loadfile(L, lua_tostring(L, -1)); /* try to load it */ + } + } + switch (status) { + case 0: { + lua_getglobal(L, "_REQUIREDNAME"); /* save previous name */ + lua_insert(L, -2); /* put it below function */ + lua_pushvalue(L, 1); + lua_setglobal(L, "_REQUIREDNAME"); /* set new name */ + lua_call(L, 0, 1); /* run loaded module */ + lua_insert(L, -2); /* put result below previous name */ + lua_setglobal(L, "_REQUIREDNAME"); /* reset to previous name */ + if (lua_isnil(L, -1)) { /* no/nil return? */ + lua_pushboolean(L, 1); + lua_replace(L, -2); /* replace to true */ + } + lua_pushvalue(L, 1); + lua_pushvalue(L, -2); + lua_rawset(L, 2); /* mark it as loaded */ + return 1; /* return value */ + } + case LUA_ERRFILE: { /* file not found */ + return luaL_error(L, "could not load package `%s' from path `%s'", + lua_tostring(L, 1), getpath(L)); + } + default: { + return luaL_error(L, "error loading package `%s' (%s)", + lua_tostring(L, 1), lua_tostring(L, -1)); + } + } +} + +/* }====================================================== */ + + +static const luaL_reg base_funcs[] = { + {"error", luaB_error}, + {"getmetatable", luaB_getmetatable}, + {"setmetatable", luaB_setmetatable}, + {"getfenv", luaB_getfenv}, + {"setfenv", luaB_setfenv}, + {"next", luaB_next}, + {"ipairs", luaB_ipairs}, + {"pairs", luaB_pairs}, + {"print", luaB_print}, + {"tonumber", luaB_tonumber}, + {"tostring", luaB_tostring}, + {"type", luaB_type}, + {"assert", luaB_assert}, + {"unpack", luaB_unpack}, + {"rawequal", luaB_rawequal}, + {"rawget", luaB_rawget}, + {"rawset", luaB_rawset}, + {"pcall", luaB_pcall}, + {"xpcall", luaB_xpcall}, + {"collectgarbage", luaB_collectgarbage}, + {"gcinfo", luaB_gcinfo}, + {"loadfile", luaB_loadfile}, + {"dofile", luaB_dofile}, + {"loadstring", luaB_loadstring}, + {"require", luaB_require}, + {NULL, NULL} +}; + + +/* +** {====================================================== +** Coroutine library +** ======================================================= +*/ + +static int auxresume (lua_State *L, lua_State *co, int narg) { + int status; + if (!lua_checkstack(co, narg)) + luaL_error(L, "too many arguments to resume"); + lua_xmove(L, co, narg); + status = lua_resume(co, narg); + if (status == 0) { + int nres = lua_gettop(co); + if (!lua_checkstack(L, nres)) + luaL_error(L, "too many results to resume"); + lua_xmove(co, L, nres); /* move yielded values */ + return nres; + } + else { + lua_xmove(co, L, 1); /* move error message */ + return -1; /* error flag */ + } +} + + +static int luaB_coresume (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + int r; + luaL_argcheck(L, co, 1, "coroutine expected"); + r = auxresume(L, co, lua_gettop(L) - 1); + if (r < 0) { + lua_pushboolean(L, 0); + lua_insert(L, -2); + return 2; /* return false + error message */ + } + else { + lua_pushboolean(L, 1); + lua_insert(L, -(r + 1)); + return r + 1; /* return true + `resume' returns */ + } +} + + +static int luaB_auxwrap (lua_State *L) { + lua_State *co = lua_tothread(L, lua_upvalueindex(1)); + int r = auxresume(L, co, lua_gettop(L)); + if (r < 0) { + if (lua_isstring(L, -1)) { /* error object is a string? */ + luaL_where(L, 1); /* add extra info */ + lua_insert(L, -2); + lua_concat(L, 2); + } + lua_error(L); /* propagate error */ + } + return r; +} + + +static int luaB_cocreate (lua_State *L) { + lua_State *NL = lua_newthread(L); + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, + "Lua function expected"); + lua_pushvalue(L, 1); /* move function to top */ + lua_xmove(L, NL, 1); /* move function from L to NL */ + return 1; +} + + +static int luaB_cowrap (lua_State *L) { + luaB_cocreate(L); + lua_pushcclosure(L, luaB_auxwrap, 1); + return 1; +} + + +static int luaB_yield (lua_State *L) { + return lua_yield(L, lua_gettop(L)); +} + + +static int luaB_costatus (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + luaL_argcheck(L, co, 1, "coroutine expected"); + if (L == co) lua_pushliteral(L, "running"); + else { + lua_Debug ar; + if (lua_getstack(co, 0, &ar) == 0 && lua_gettop(co) == 0) + lua_pushliteral(L, "dead"); + else + lua_pushliteral(L, "suspended"); + } + return 1; +} + + +static const luaL_reg co_funcs[] = { + {"create", luaB_cocreate}, + {"wrap", luaB_cowrap}, + {"resume", luaB_coresume}, + {"yield", luaB_yield}, + {"status", luaB_costatus}, + {NULL, NULL} +}; + +/* }====================================================== */ + + + +static void base_open (lua_State *L) { + lua_pushliteral(L, "_G"); + lua_pushvalue(L, LUA_GLOBALSINDEX); + luaL_openlib(L, NULL, base_funcs, 0); /* open lib into global table */ + lua_pushliteral(L, "_VERSION"); + lua_pushliteral(L, LUA_VERSION); + lua_rawset(L, -3); /* set global _VERSION */ + /* `newproxy' needs a weaktable as upvalue */ + lua_pushliteral(L, "newproxy"); + lua_newtable(L); /* new table `w' */ + lua_pushvalue(L, -1); /* `w' will be its own metatable */ + lua_setmetatable(L, -2); + lua_pushliteral(L, "__mode"); + lua_pushliteral(L, "k"); + lua_rawset(L, -3); /* metatable(w).__mode = "k" */ + lua_pushcclosure(L, luaB_newproxy, 1); + lua_rawset(L, -3); /* set global `newproxy' */ + lua_rawset(L, -1); /* set global _G */ +} + + +LUALIB_API int luaopen_base (lua_State *L) { + base_open(L); + luaL_openlib(L, LUA_COLIBNAME, co_funcs, 0); + lua_newtable(L); + lua_setglobal(L, REQTAB); + return 0; +} + -- cgit v1.2.3