deps/lua/src/lbaselib.c

/*
** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $
** Basic library
** See Copyright Notice in lua.h
*/


#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define lbaselib_c
#define LUA_LIB

#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, LUA_QL("tostring") " must return a string to "
                           LUA_QL("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);
  lua_settop(L, 1);
  if (lua_isstring(L, 1) && level > 0) {  /* 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, int opt) {
  if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
  else {
    lua_Debug ar;
    int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 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 luaB_getfenv (lua_State *L) {
  getfunc(L, 1);
  if (lua_iscfunction(L, -1))  /* is a C function? */
    lua_pushvalue(L, LUA_GLOBALSINDEX);  /* return the thread's global env. */
  else
    lua_getfenv(L, -1);
  return 1;
}


static int luaB_setfenv (lua_State *L) {
  luaL_checktype(L, 2, LUA_TTABLE);
  getfunc(L, 0);
  lua_pushvalue(L, 2);
  if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {
    /* change environment of current thread */
    lua_pushthread(L);
    lua_insert(L, -2);
    lua_setfenv(L, -2);
    return 0;
  }
  else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)
    luaL_error(L,
          LUA_QL("setfenv") " cannot change environment of given object");
  return 1;
}


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_settop(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_settop(L, 3);
  lua_rawset(L, 1);
  return 1;
}


static int luaB_gcinfo (lua_State *L) {
  lua_pushinteger(L, lua_getgccount(L));
  return 1;
}


static int luaB_collectgarbage (lua_State *L) {
  static const char *const opts[] = {"stop", "restart", "collect",
    "count", "step", "setpause", "setstepmul", NULL};
  static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
    LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
  int o = luaL_checkoption(L, 1, "collect", opts);
  int ex = luaL_optint(L, 2, 0);
  int res = lua_gc(L, optsnum[o], ex);
  switch (optsnum[o]) {
    case LUA_GCCOUNT: {
      int b = lua_gc(L, LUA_GCCOUNTB, 0);
      lua_pushnumber(L, res + ((lua_Number)b/1024));
      return 1;
    }
    case LUA_GCSTEP: {
      lua_pushboolean(L, res);
      return 1;
    }
    default: {
      lua_pushnumber(L, res);
      return 1;
    }
  }
}


static int luaB_type (lua_State *L) {
  luaL_checkany(L, 1);
  lua_pushstring(L, luaL_typename(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_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
  lua_pushvalue(L, 1);  /* state, */
  lua_pushnil(L);  /* and initial value */
  return 3;
}


static int ipairsaux (lua_State *L) {
  int i = luaL_checkint(L, 2);
  luaL_checktype(L, 1, LUA_TTABLE);
  i++;  /* next value */
  lua_pushinteger(L, i);
  lua_rawgeti(L, 1, i);
  return (lua_isnil(L, -1)) ? 0 : 2;
}


static int luaB_ipairs (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  lua_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
  lua_pushvalue(L, 1);  /* state, */
  lua_pushinteger(L, 0);  /* and initial value */
  return 3;
}


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));
}


/*
** Reader for generic `load' function: `lua_load' uses the
** stack for internal stuff, so the reader cannot change the
** stack top. Instead, it keeps its resulting string in a
** reserved slot inside the stack.
*/
static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
  (void)ud;  /* to avoid warnings */
  luaL_checkstack(L, 2, "too many nested functions");
  lua_pushvalue(L, 1);  /* get function */
  lua_call(L, 0, 1);  /* call it */
  if (lua_isnil(L, -1)) {
    *size = 0;
    return NULL;
  }
  else if (lua_isstring(L, -1)) {
    lua_replace(L, 3);  /* save string in a reserved stack slot */
    return lua_tolstring(L, 3, size);
  }
  else luaL_error(L, "reader function must return a string");
  return NULL;  /* to avoid warnings */
}


static int luaB_load (lua_State *L) {
  int status;
  const char *cname = luaL_optstring(L, 2, "=(load)");
  luaL_checktype(L, 1, LUA_TFUNCTION);
  lua_settop(L, 3);  /* function, eventual name, plus one reserved slot */
  status = lua_load(L, generic_reader, NULL, cname);
  return load_aux(L, status);
}


static int luaB_dofile (lua_State *L) {
  const char *fname = luaL_optstring(L, 1, NULL);
  int n = lua_gettop(L);
  if (luaL_loadfile(L, fname) != 0) lua_error(L);
  lua_call(L, 0, LUA_MULTRET);
  return lua_gettop(L) - n;
}


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!"));
  return lua_gettop(L);
}


static int luaB_unpack (lua_State *L) {
  int i, e, n;
  luaL_checktype(L, 1, LUA_TTABLE);
  i = luaL_optint(L, 2, 1);
  e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
  if (i > e) return 0;  /* empty range */
  n = e - i + 1;  /* number of elements */
  if (n <= 0 || !lua_checkstack(L, n))  /* n <= 0 means arith. overflow */
    return luaL_error(L, "too many results to unpack");
  lua_rawgeti(L, 1, i);  /* push arg[i] (avoiding overflow problems) */
  while (i++ < e)  /* push arg[i + 1...e] */
    lua_rawgeti(L, 1, i);
  return n;
}


static int luaB_select (lua_State *L) {
  int n = lua_gettop(L);
  if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
    lua_pushinteger(L, n-1);
    return 1;
  }
  else {
    int i = luaL_checkint(L, 1);
    if (i < 0) i = n + i;
    else if (i > n) i = n;
    luaL_argcheck(L, 1 <= i, 1, "index out of range");
    return n - i;
  }
}


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) {
  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));
      break;
    case LUA_TSTRING:
      lua_pushvalue(L, 1);
      break;
    case LUA_TBOOLEAN:
      lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
      break;
    case LUA_TNIL:
      lua_pushliteral(L, "nil");
      break;
    default:
      lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
      break;
  }
  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;
}


static const luaL_Reg base_funcs[] = {
  {"assert", luaB_assert},
  {"collectgarbage", luaB_collectgarbage},
  {"dofile", luaB_dofile},
  {"error", luaB_error},
  {"gcinfo", luaB_gcinfo},
  {"getfenv", luaB_getfenv},
  {"getmetatable", luaB_getmetatable},
  {"loadfile", luaB_loadfile},
  {"load", luaB_load},
  {"loadstring", luaB_loadstring},
  {"next", luaB_next},
  {"pcall", luaB_pcall},
  {"print", luaB_print},
  {"rawequal", luaB_rawequal},
  {"rawget", luaB_rawget},
  {"rawset", luaB_rawset},
  {"select", luaB_select},
  {"setfenv", luaB_setfenv},
  {"setmetatable", luaB_setmetatable},
  {"tonumber", luaB_tonumber},
  {"tostring", luaB_tostring},
  {"type", luaB_type},
  {"unpack", luaB_unpack},
  {"xpcall", luaB_xpcall},
  {NULL, NULL}
};


/*
** {======================================================
** Coroutine library
** =======================================================
*/

#define CO_RUN	0	/* running */
#define CO_SUS	1	/* suspended */
#define CO_NOR	2	/* 'normal' (it resumed another coroutine) */
#define CO_DEAD	3

static const char *const statnames[] =
    {"running", "suspended", "normal", "dead"};

static int costatus (lua_State *L, lua_State *co) {
  if (L == co) return CO_RUN;
  switch (lua_status(co)) {
    case LUA_YIELD:
      return CO_SUS;
    case 0: {
      lua_Debug ar;
      if (lua_getstack(co, 0, &ar) > 0)  /* does it have frames? */
        return CO_NOR;  /* it is running */
      else if (lua_gettop(co) == 0)
          return CO_DEAD;
      else
        return CO_SUS;  /* initial state */
    }
    default:  /* some error occured */
      return CO_DEAD;
  }
}


static int luaB_costatus (lua_State *L) {
  lua_State *co = lua_tothread(L, 1);
  luaL_argcheck(L, co, 1, "coroutine expected");
  lua_pushstring(L, statnames[costatus(L, co)]);
  return 1;
}


static int auxresume (lua_State *L, lua_State *co, int narg) {
  int status = costatus(L, co);
  if (!lua_checkstack(co, narg))
    luaL_error(L, "too many arguments to resume");
  if (status != CO_SUS) {
    lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
    return -1;  /* error flag */
  }
  lua_xmove(L, co, narg);
  lua_setlevel(L, co);
  status = lua_resume(co, narg);
  if (status == 0 || status == LUA_YIELD) {
    int nres = lua_gettop(co);
    if (!lua_checkstack(L, nres + 1))
      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_corunning (lua_State *L) {
  if (lua_pushthread(L))
    lua_pushnil(L);  /* main thread is not a coroutine */
  return 1;
}


static const luaL_Reg co_funcs[] = {
  {"create", luaB_cocreate},
  {"resume", luaB_coresume},
  {"running", luaB_corunning},
  {"status", luaB_costatus},
  {"wrap", luaB_cowrap},
  {"yield", luaB_yield},
  {NULL, NULL}
};

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


static void auxopen (lua_State *L, const char *name,
                     lua_CFunction f, lua_CFunction u) {
  lua_pushcfunction(L, u);
  lua_pushcclosure(L, f, 1);
  lua_setfield(L, -2, name);
}


static void base_open (lua_State *L) {
  /* set global _G */
  lua_pushvalue(L, LUA_GLOBALSINDEX);
  lua_setglobal(L, "_G");
  /* open lib into global table */
  luaL_register(L, "_G", base_funcs);
  lua_pushliteral(L, LUA_VERSION);
  lua_setglobal(L, "_VERSION");  /* set global _VERSION */
  /* `ipairs' and `pairs' need auxliliary functions as upvalues */
  auxopen(L, "ipairs", luaB_ipairs, ipairsaux);
  auxopen(L, "pairs", luaB_pairs, luaB_next);
  /* `newproxy' needs a weaktable as upvalue */
  lua_createtable(L, 0, 1);  /* new table `w' */
  lua_pushvalue(L, -1);  /* `w' will be its own metatable */
  lua_setmetatable(L, -2);
  lua_pushliteral(L, "kv");
  lua_setfield(L, -2, "__mode");  /* metatable(w).__mode = "kv" */
  lua_pushcclosure(L, luaB_newproxy, 1);
  lua_setglobal(L, "newproxy");  /* set global `newproxy' */
}


LUALIB_API int luaopen_base (lua_State *L) {
  base_open(L);
  luaL_register(L, LUA_COLIBNAME, co_funcs);
  return 2;
}
Commit	Line	Data
	1	/*
	2	** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $
	3	** Basic library
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8
	9	#include <ctype.h>
	10	#include <stdio.h>
	11	#include <stdlib.h>
	12	#include <string.h>
	13
	14	#define lbaselib_c
	15	#define LUA_LIB
	16
	17	#include "lua.h"
	18
	19	#include "lauxlib.h"
	20	#include "lualib.h"
	21
	22
	23
	24
	25	/*
	26	** If your system does not support `stdout', you can just remove this function.
	27	** If you need, you can define your own `print' function, following this
	28	** model but changing `fputs' to put the strings at a proper place
	29	** (a console window or a log file, for instance).
	30	*/
	31	static int luaB_print (lua_State *L) {
	32	int n = lua_gettop(L); /* number of arguments */
	33	int i;
	34	lua_getglobal(L, "tostring");
	35	for (i=1; i<=n; i++) {
	36	const char *s;
	37	lua_pushvalue(L, -1); /* function to be called */
	38	lua_pushvalue(L, i); /* value to print */
	39	lua_call(L, 1, 1);
	40	s = lua_tostring(L, -1); /* get result */
	41	if (s == NULL)
	42	return luaL_error(L, LUA_QL("tostring") " must return a string to "
	43	LUA_QL("print"));
	44	if (i>1) fputs("\t", stdout);
	45	fputs(s, stdout);
	46	lua_pop(L, 1); /* pop result */
	47	}
	48	fputs("\n", stdout);
	49	return 0;
	50	}
	51
	52
	53	static int luaB_tonumber (lua_State *L) {
	54	int base = luaL_optint(L, 2, 10);
	55	if (base == 10) { /* standard conversion */
	56	luaL_checkany(L, 1);
	57	if (lua_isnumber(L, 1)) {
	58	lua_pushnumber(L, lua_tonumber(L, 1));
	59	return 1;
	60	}
	61	}
	62	else {
	63	const char *s1 = luaL_checkstring(L, 1);
	64	char *s2;
	65	unsigned long n;
	66	luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
	67	n = strtoul(s1, &s2, base);
	68	if (s1 != s2) { /* at least one valid digit? */
	69	while (isspace((unsigned char)(s2))) s2++; / skip trailing spaces */
	70	if (s2 == '\0') { / no invalid trailing characters? */
	71	lua_pushnumber(L, (lua_Number)n);
	72	return 1;
	73	}
	74	}
	75	}
	76	lua_pushnil(L); /* else not a number */
	77	return 1;
	78	}
	79
	80
	81	static int luaB_error (lua_State *L) {
	82	int level = luaL_optint(L, 2, 1);
	83	lua_settop(L, 1);
	84	if (lua_isstring(L, 1) && level > 0) { /* add extra information? */
	85	luaL_where(L, level);
	86	lua_pushvalue(L, 1);
	87	lua_concat(L, 2);
	88	}
	89	return lua_error(L);
	90	}
	91
	92
	93	static int luaB_getmetatable (lua_State *L) {
	94	luaL_checkany(L, 1);
	95	if (!lua_getmetatable(L, 1)) {
	96	lua_pushnil(L);
	97	return 1; /* no metatable */
	98	}
	99	luaL_getmetafield(L, 1, "__metatable");
	100	return 1; /* returns either __metatable field (if present) or metatable */
	101	}
	102
	103
	104	static int luaB_setmetatable (lua_State *L) {
	105	int t = lua_type(L, 2);
	106	luaL_checktype(L, 1, LUA_TTABLE);
	107	luaL_argcheck(L, t == LUA_TNIL \|\| t == LUA_TTABLE, 2,
	108	"nil or table expected");
	109	if (luaL_getmetafield(L, 1, "__metatable"))
	110	luaL_error(L, "cannot change a protected metatable");
	111	lua_settop(L, 2);
	112	lua_setmetatable(L, 1);
	113	return 1;
	114	}
	115
	116
	117	static void getfunc (lua_State *L, int opt) {
	118	if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
	119	else {
	120	lua_Debug ar;
	121	int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);
	122	luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
	123	if (lua_getstack(L, level, &ar) == 0)
	124	luaL_argerror(L, 1, "invalid level");
	125	lua_getinfo(L, "f", &ar);
	126	if (lua_isnil(L, -1))
	127	luaL_error(L, "no function environment for tail call at level %d",
	128	level);
	129	}
	130	}
	131
	132
	133	static int luaB_getfenv (lua_State *L) {
	134	getfunc(L, 1);
	135	if (lua_iscfunction(L, -1)) /* is a C function? */
	136	lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */
	137	else
	138	lua_getfenv(L, -1);
	139	return 1;
	140	}
	141
	142
	143	static int luaB_setfenv (lua_State *L) {
	144	luaL_checktype(L, 2, LUA_TTABLE);
	145	getfunc(L, 0);
	146	lua_pushvalue(L, 2);
	147	if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {
	148	/* change environment of current thread */
	149	lua_pushthread(L);
	150	lua_insert(L, -2);
	151	lua_setfenv(L, -2);
	152	return 0;
	153	}
	154	else if (lua_iscfunction(L, -2) \|\| lua_setfenv(L, -2) == 0)
	155	luaL_error(L,
	156	LUA_QL("setfenv") " cannot change environment of given object");
	157	return 1;
	158	}
	159
	160
	161	static int luaB_rawequal (lua_State *L) {
	162	luaL_checkany(L, 1);
	163	luaL_checkany(L, 2);
	164	lua_pushboolean(L, lua_rawequal(L, 1, 2));
	165	return 1;
	166	}
	167
	168
	169	static int luaB_rawget (lua_State *L) {
	170	luaL_checktype(L, 1, LUA_TTABLE);
	171	luaL_checkany(L, 2);
	172	lua_settop(L, 2);
	173	lua_rawget(L, 1);
	174	return 1;
	175	}
	176
	177	static int luaB_rawset (lua_State *L) {
	178	luaL_checktype(L, 1, LUA_TTABLE);
	179	luaL_checkany(L, 2);
	180	luaL_checkany(L, 3);
	181	lua_settop(L, 3);
	182	lua_rawset(L, 1);
	183	return 1;
	184	}
	185
	186
	187	static int luaB_gcinfo (lua_State *L) {
	188	lua_pushinteger(L, lua_getgccount(L));
	189	return 1;
	190	}
	191
	192
	193	static int luaB_collectgarbage (lua_State *L) {
	194	static const char *const opts[] = {"stop", "restart", "collect",
	195	"count", "step", "setpause", "setstepmul", NULL};
	196	static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
	197	LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
	198	int o = luaL_checkoption(L, 1, "collect", opts);
	199	int ex = luaL_optint(L, 2, 0);
	200	int res = lua_gc(L, optsnum[o], ex);
	201	switch (optsnum[o]) {
	202	case LUA_GCCOUNT: {
	203	int b = lua_gc(L, LUA_GCCOUNTB, 0);
	204	lua_pushnumber(L, res + ((lua_Number)b/1024));
	205	return 1;
	206	}
	207	case LUA_GCSTEP: {
	208	lua_pushboolean(L, res);
	209	return 1;
	210	}
	211	default: {
	212	lua_pushnumber(L, res);
	213	return 1;
	214	}
	215	}
	216	}
	217
	218
	219	static int luaB_type (lua_State *L) {
	220	luaL_checkany(L, 1);
	221	lua_pushstring(L, luaL_typename(L, 1));
	222	return 1;
	223	}
	224
	225
	226	static int luaB_next (lua_State *L) {
	227	luaL_checktype(L, 1, LUA_TTABLE);
	228	lua_settop(L, 2); /* create a 2nd argument if there isn't one */
	229	if (lua_next(L, 1))
	230	return 2;
	231	else {
	232	lua_pushnil(L);
	233	return 1;
	234	}
	235	}
	236
	237
	238	static int luaB_pairs (lua_State *L) {
	239	luaL_checktype(L, 1, LUA_TTABLE);
	240	lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
	241	lua_pushvalue(L, 1); /* state, */
	242	lua_pushnil(L); /* and initial value */
	243	return 3;
	244	}
	245
	246
	247	static int ipairsaux (lua_State *L) {
	248	int i = luaL_checkint(L, 2);
	249	luaL_checktype(L, 1, LUA_TTABLE);
	250	i++; /* next value */
	251	lua_pushinteger(L, i);
	252	lua_rawgeti(L, 1, i);
	253	return (lua_isnil(L, -1)) ? 0 : 2;
	254	}
	255
	256
	257	static int luaB_ipairs (lua_State *L) {
	258	luaL_checktype(L, 1, LUA_TTABLE);
	259	lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
	260	lua_pushvalue(L, 1); /* state, */
	261	lua_pushinteger(L, 0); /* and initial value */
	262	return 3;
	263	}
	264
	265
	266	static int load_aux (lua_State *L, int status) {
	267	if (status == 0) /* OK? */
	268	return 1;
	269	else {
	270	lua_pushnil(L);
	271	lua_insert(L, -2); /* put before error message */
	272	return 2; /* return nil plus error message */
	273	}
	274	}
	275
	276
	277	static int luaB_loadstring (lua_State *L) {
	278	size_t l;
	279	const char *s = luaL_checklstring(L, 1, &l);
	280	const char *chunkname = luaL_optstring(L, 2, s);
	281	return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
	282	}
	283
	284
	285	static int luaB_loadfile (lua_State *L) {
	286	const char *fname = luaL_optstring(L, 1, NULL);
	287	return load_aux(L, luaL_loadfile(L, fname));
	288	}
	289
	290
	291	/*
	292	** Reader for generic `load' function: `lua_load' uses the
	293	** stack for internal stuff, so the reader cannot change the
	294	** stack top. Instead, it keeps its resulting string in a
	295	** reserved slot inside the stack.
	296	*/
	297	static const char generic_reader (lua_State L, void ud, size_t size) {
	298	(void)ud; /* to avoid warnings */
	299	luaL_checkstack(L, 2, "too many nested functions");
	300	lua_pushvalue(L, 1); /* get function */
	301	lua_call(L, 0, 1); /* call it */
	302	if (lua_isnil(L, -1)) {
	303	*size = 0;
	304	return NULL;
	305	}
	306	else if (lua_isstring(L, -1)) {
	307	lua_replace(L, 3); /* save string in a reserved stack slot */
	308	return lua_tolstring(L, 3, size);
	309	}
	310	else luaL_error(L, "reader function must return a string");
	311	return NULL; /* to avoid warnings */
	312	}
	313
	314
	315	static int luaB_load (lua_State *L) {
	316	int status;
	317	const char *cname = luaL_optstring(L, 2, "=(load)");
	318	luaL_checktype(L, 1, LUA_TFUNCTION);
	319	lua_settop(L, 3); /* function, eventual name, plus one reserved slot */
	320	status = lua_load(L, generic_reader, NULL, cname);
	321	return load_aux(L, status);
	322	}
	323
	324
	325	static int luaB_dofile (lua_State *L) {
	326	const char *fname = luaL_optstring(L, 1, NULL);
	327	int n = lua_gettop(L);
	328	if (luaL_loadfile(L, fname) != 0) lua_error(L);
	329	lua_call(L, 0, LUA_MULTRET);
	330	return lua_gettop(L) - n;
	331	}
	332
	333
	334	static int luaB_assert (lua_State *L) {
	335	luaL_checkany(L, 1);
	336	if (!lua_toboolean(L, 1))
	337	return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
	338	return lua_gettop(L);
	339	}
	340
	341
	342	static int luaB_unpack (lua_State *L) {
	343	int i, e, n;
	344	luaL_checktype(L, 1, LUA_TTABLE);
	345	i = luaL_optint(L, 2, 1);
	346	e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
	347	if (i > e) return 0; /* empty range */
	348	n = e - i + 1; /* number of elements */
	349	if (n <= 0 \|\| !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */
	350	return luaL_error(L, "too many results to unpack");
	351	lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */
	352	while (i++ < e) /* push arg[i + 1...e] */
	353	lua_rawgeti(L, 1, i);
	354	return n;
	355	}
	356
	357
	358	static int luaB_select (lua_State *L) {
	359	int n = lua_gettop(L);
	360	if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
	361	lua_pushinteger(L, n-1);
	362	return 1;
	363	}
	364	else {
	365	int i = luaL_checkint(L, 1);
	366	if (i < 0) i = n + i;
	367	else if (i > n) i = n;
	368	luaL_argcheck(L, 1 <= i, 1, "index out of range");
	369	return n - i;
	370	}
	371	}
	372
	373
	374	static int luaB_pcall (lua_State *L) {
	375	int status;
	376	luaL_checkany(L, 1);
	377	status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
	378	lua_pushboolean(L, (status == 0));
	379	lua_insert(L, 1);
	380	return lua_gettop(L); /* return status + all results */
	381	}
	382
	383
	384	static int luaB_xpcall (lua_State *L) {
	385	int status;
	386	luaL_checkany(L, 2);
	387	lua_settop(L, 2);
	388	lua_insert(L, 1); /* put error function under function to be called */
	389	status = lua_pcall(L, 0, LUA_MULTRET, 1);
	390	lua_pushboolean(L, (status == 0));
	391	lua_replace(L, 1);
	392	return lua_gettop(L); /* return status + all results */
	393	}
	394
	395
	396	static int luaB_tostring (lua_State *L) {
	397	luaL_checkany(L, 1);
	398	if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */
	399	return 1; /* use its value */
	400	switch (lua_type(L, 1)) {
	401	case LUA_TNUMBER:
	402	lua_pushstring(L, lua_tostring(L, 1));
	403	break;
	404	case LUA_TSTRING:
	405	lua_pushvalue(L, 1);
	406	break;
	407	case LUA_TBOOLEAN:
	408	lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
	409	break;
	410	case LUA_TNIL:
	411	lua_pushliteral(L, "nil");
	412	break;
	413	default:
	414	lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
	415	break;
	416	}
	417	return 1;
	418	}
	419
	420
	421	static int luaB_newproxy (lua_State *L) {
	422	lua_settop(L, 1);
	423	lua_newuserdata(L, 0); /* create proxy */
	424	if (lua_toboolean(L, 1) == 0)
	425	return 1; /* no metatable */
	426	else if (lua_isboolean(L, 1)) {
	427	lua_newtable(L); /* create a new metatable `m' ... */
	428	lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */
	429	lua_pushboolean(L, 1);
	430	lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */
	431	}
	432	else {
	433	int validproxy = 0; /* to check if weaktable[metatable(u)] == true */
	434	if (lua_getmetatable(L, 1)) {
	435	lua_rawget(L, lua_upvalueindex(1));
	436	validproxy = lua_toboolean(L, -1);
	437	lua_pop(L, 1); /* remove value */
	438	}
	439	luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
	440	lua_getmetatable(L, 1); /* metatable is valid; get it */
	441	}
	442	lua_setmetatable(L, 2);
	443	return 1;
	444	}
	445
	446
	447	static const luaL_Reg base_funcs[] = {
	448	{"assert", luaB_assert},
	449	{"collectgarbage", luaB_collectgarbage},
	450	{"dofile", luaB_dofile},
	451	{"error", luaB_error},
	452	{"gcinfo", luaB_gcinfo},
	453	{"getfenv", luaB_getfenv},
	454	{"getmetatable", luaB_getmetatable},
	455	{"loadfile", luaB_loadfile},
	456	{"load", luaB_load},
	457	{"loadstring", luaB_loadstring},
	458	{"next", luaB_next},
	459	{"pcall", luaB_pcall},
	460	{"print", luaB_print},
	461	{"rawequal", luaB_rawequal},
	462	{"rawget", luaB_rawget},
	463	{"rawset", luaB_rawset},
	464	{"select", luaB_select},
	465	{"setfenv", luaB_setfenv},
	466	{"setmetatable", luaB_setmetatable},
	467	{"tonumber", luaB_tonumber},
	468	{"tostring", luaB_tostring},
	469	{"type", luaB_type},
	470	{"unpack", luaB_unpack},
	471	{"xpcall", luaB_xpcall},
	472	{NULL, NULL}
	473	};
	474
	475
	476	/*
	477	** {======================================================
	478	** Coroutine library
	479	** =======================================================
	480	*/
	481
	482	#define CO_RUN 0 /* running */
	483	#define CO_SUS 1 /* suspended */
	484	#define CO_NOR 2 /* 'normal' (it resumed another coroutine) */
	485	#define CO_DEAD 3
	486
	487	static const char *const statnames[] =
	488	{"running", "suspended", "normal", "dead"};
	489
	490	static int costatus (lua_State L, lua_State co) {
	491	if (L == co) return CO_RUN;
	492	switch (lua_status(co)) {
	493	case LUA_YIELD:
	494	return CO_SUS;
	495	case 0: {
	496	lua_Debug ar;
	497	if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */
	498	return CO_NOR; /* it is running */
	499	else if (lua_gettop(co) == 0)
	500	return CO_DEAD;
	501	else
	502	return CO_SUS; /* initial state */
	503	}
	504	default: /* some error occured */
	505	return CO_DEAD;
	506	}
	507	}
	508
	509
	510	static int luaB_costatus (lua_State *L) {
	511	lua_State *co = lua_tothread(L, 1);
	512	luaL_argcheck(L, co, 1, "coroutine expected");
	513	lua_pushstring(L, statnames[costatus(L, co)]);
	514	return 1;
	515	}
	516
	517
	518	static int auxresume (lua_State L, lua_State co, int narg) {
	519	int status = costatus(L, co);
	520	if (!lua_checkstack(co, narg))
	521	luaL_error(L, "too many arguments to resume");
	522	if (status != CO_SUS) {
	523	lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
	524	return -1; /* error flag */
	525	}
	526	lua_xmove(L, co, narg);
	527	lua_setlevel(L, co);
	528	status = lua_resume(co, narg);
	529	if (status == 0 \|\| status == LUA_YIELD) {
	530	int nres = lua_gettop(co);
	531	if (!lua_checkstack(L, nres + 1))
	532	luaL_error(L, "too many results to resume");
	533	lua_xmove(co, L, nres); /* move yielded values */
	534	return nres;
	535	}
	536	else {
	537	lua_xmove(co, L, 1); /* move error message */
	538	return -1; /* error flag */
	539	}
	540	}
	541
	542
	543	static int luaB_coresume (lua_State *L) {
	544	lua_State *co = lua_tothread(L, 1);
	545	int r;
	546	luaL_argcheck(L, co, 1, "coroutine expected");
	547	r = auxresume(L, co, lua_gettop(L) - 1);
	548	if (r < 0) {
	549	lua_pushboolean(L, 0);
	550	lua_insert(L, -2);
	551	return 2; /* return false + error message */
	552	}
	553	else {
	554	lua_pushboolean(L, 1);
	555	lua_insert(L, -(r + 1));
	556	return r + 1; /* return true + `resume' returns */
	557	}
	558	}
	559
	560
	561	static int luaB_auxwrap (lua_State *L) {
	562	lua_State *co = lua_tothread(L, lua_upvalueindex(1));
	563	int r = auxresume(L, co, lua_gettop(L));
	564	if (r < 0) {
	565	if (lua_isstring(L, -1)) { /* error object is a string? */
	566	luaL_where(L, 1); /* add extra info */
	567	lua_insert(L, -2);
	568	lua_concat(L, 2);
	569	}
	570	lua_error(L); /* propagate error */
	571	}
	572	return r;
	573	}
	574
	575
	576	static int luaB_cocreate (lua_State *L) {
	577	lua_State *NL = lua_newthread(L);
	578	luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
	579	"Lua function expected");
	580	lua_pushvalue(L, 1); /* move function to top */
	581	lua_xmove(L, NL, 1); /* move function from L to NL */
	582	return 1;
	583	}
	584
	585
	586	static int luaB_cowrap (lua_State *L) {
	587	luaB_cocreate(L);
	588	lua_pushcclosure(L, luaB_auxwrap, 1);
	589	return 1;
	590	}
	591
	592
	593	static int luaB_yield (lua_State *L) {
	594	return lua_yield(L, lua_gettop(L));
	595	}
	596
	597
	598	static int luaB_corunning (lua_State *L) {
	599	if (lua_pushthread(L))
	600	lua_pushnil(L); /* main thread is not a coroutine */
	601	return 1;
	602	}
	603
	604
	605	static const luaL_Reg co_funcs[] = {
	606	{"create", luaB_cocreate},
	607	{"resume", luaB_coresume},
	608	{"running", luaB_corunning},
	609	{"status", luaB_costatus},
	610	{"wrap", luaB_cowrap},
	611	{"yield", luaB_yield},
	612	{NULL, NULL}
	613	};
	614
	615	/* }====================================================== */
	616
	617
	618	static void auxopen (lua_State L, const char name,
	619	lua_CFunction f, lua_CFunction u) {
	620	lua_pushcfunction(L, u);
	621	lua_pushcclosure(L, f, 1);
	622	lua_setfield(L, -2, name);
	623	}
	624
	625
	626	static void base_open (lua_State *L) {
	627	/* set global _G */
	628	lua_pushvalue(L, LUA_GLOBALSINDEX);
	629	lua_setglobal(L, "_G");
	630	/* open lib into global table */
	631	luaL_register(L, "_G", base_funcs);
	632	lua_pushliteral(L, LUA_VERSION);
	633	lua_setglobal(L, "_VERSION"); /* set global _VERSION */
	634	/* `ipairs' and `pairs' need auxliliary functions as upvalues */
	635	auxopen(L, "ipairs", luaB_ipairs, ipairsaux);
	636	auxopen(L, "pairs", luaB_pairs, luaB_next);
	637	/* `newproxy' needs a weaktable as upvalue */
	638	lua_createtable(L, 0, 1); /* new table `w' */
	639	lua_pushvalue(L, -1); /* `w' will be its own metatable */
	640	lua_setmetatable(L, -2);
	641	lua_pushliteral(L, "kv");
	642	lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */
	643	lua_pushcclosure(L, luaB_newproxy, 1);
	644	lua_setglobal(L, "newproxy"); /* set global `newproxy' */
	645	}
	646
	647
	648	LUALIB_API int luaopen_base (lua_State *L) {
	649	base_open(L);
	650	luaL_register(L, LUA_COLIBNAME, co_funcs);
	651	return 2;
	652	}
	653