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