/*** $Id: lbaselib.c,v 1.189 2006/01/18 11:49:12 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) {  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 luaB_getfenv (lua_State *L) {  getfunc(L);  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);  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);}