1 /*
2 ** $Id: lbaselib.c,v 1.314.1.1 2017/04/19 17:39:34 roberto Exp $
3 ** Basic library
4 ** See Copyright Notice in lua.h
5 */
6 
7 #define lbaselib_c
8 #define LUA_LIB
9 
10 #include "lprefix.h"
11 
12 
13 #include <ctype.h>
14 #include <stdio.h>
15 #include <stdlib.h>
16 #include <string.h>
17 
18 #include "lua.h"
19 
20 #include "lauxlib.h"
21 #include "lualib.h"
22 
23 
luaB_print(lua_State * L)24 static int luaB_print (lua_State *L) {
25   int n = lua_gettop(L);  /* number of arguments */
26   int i;
27   lua_getglobal(L, "tostring");
28   for (i=1; i<=n; i++) {
29     const char *s;
30     size_t l;
31     lua_pushvalue(L, -1);  /* function to be called */
32     lua_pushvalue(L, i);   /* value to print */
33     lua_call(L, 1, 1);
34     s = lua_tolstring(L, -1, &l);  /* get result */
35     if (s == NULL)
36       return luaL_error(L, "'tostring' must return a string to 'print'");
37     if (i>1) lua_writestring("\t", 1);
38     lua_writestring(s, l);
39     lua_pop(L, 1);  /* pop result */
40   }
41   lua_writeline();
42   return 0;
43 }
44 
45 
46 #define SPACECHARS	" \f\n\r\t\v"
47 
b_str2int(const char * s,int base,lua_Integer * pn)48 static const char *b_str2int (const char *s, int base, lua_Integer *pn) {
49   lua_Unsigned n = 0;
50   int neg = 0;
51   s += strspn(s, SPACECHARS);  /* skip initial spaces */
52   if (*s == '-') { s++; neg = 1; }  /* handle signal */
53   else if (*s == '+') s++;
54   if (!isalnum((unsigned char)*s))  /* no digit? */
55     return NULL;
56   do {
57     int digit = (isdigit((unsigned char)*s)) ? *s - '0'
58                    : (toupper((unsigned char)*s) - 'A') + 10;
59     if (digit >= base) return NULL;  /* invalid numeral */
60     n = n * base + digit;
61     s++;
62   } while (isalnum((unsigned char)*s));
63   s += strspn(s, SPACECHARS);  /* skip trailing spaces */
64   *pn = (lua_Integer)((neg) ? (0u - n) : n);
65   return s;
66 }
67 
68 
luaB_tonumber(lua_State * L)69 static int luaB_tonumber (lua_State *L) {
70   if (lua_isnoneornil(L, 2)) {  /* standard conversion? */
71     luaL_checkany(L, 1);
72     if (lua_type(L, 1) == LUA_TNUMBER) {  /* already a number? */
73       lua_settop(L, 1);  /* yes; return it */
74       return 1;
75     }
76     else {
77       size_t l;
78       const char *s = lua_tolstring(L, 1, &l);
79       if (s != NULL && lua_stringtonumber(L, s) == l + 1)
80         return 1;  /* successful conversion to number */
81       /* else not a number */
82     }
83   }
84   else {
85     size_t l;
86     const char *s;
87     lua_Integer n = 0;  /* to avoid warnings */
88     lua_Integer base = luaL_checkinteger(L, 2);
89     luaL_checktype(L, 1, LUA_TSTRING);  /* no numbers as strings */
90     s = lua_tolstring(L, 1, &l);
91     luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
92     if (b_str2int(s, (int)base, &n) == s + l) {
93       lua_pushinteger(L, n);
94       return 1;
95     }  /* else not a number */
96   }  /* else not a number */
97   lua_pushnil(L);  /* not a number */
98   return 1;
99 }
100 
101 
luaB_error(lua_State * L)102 static int luaB_error (lua_State *L) {
103   int level = (int)luaL_optinteger(L, 2, 1);
104   lua_settop(L, 1);
105   if (lua_type(L, 1) == LUA_TSTRING && level > 0) {
106     luaL_where(L, level);   /* add extra information */
107     lua_pushvalue(L, 1);
108     lua_concat(L, 2);
109   }
110   return lua_error(L);
111 }
112 
113 
luaB_getmetatable(lua_State * L)114 static int luaB_getmetatable (lua_State *L) {
115   luaL_checkany(L, 1);
116   if (!lua_getmetatable(L, 1)) {
117     lua_pushnil(L);
118     return 1;  /* no metatable */
119   }
120   luaL_getmetafield(L, 1, "__metatable");
121   return 1;  /* returns either __metatable field (if present) or metatable */
122 }
123 
124 
luaB_setmetatable(lua_State * L)125 static int luaB_setmetatable (lua_State *L) {
126   int t = lua_type(L, 2);
127   luaL_checktype(L, 1, LUA_TTABLE);
128   luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
129                     "nil or table expected");
130   if (luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL)
131     return luaL_error(L, "cannot change a protected metatable");
132   lua_settop(L, 2);
133   lua_setmetatable(L, 1);
134   return 1;
135 }
136 
137 
luaB_rawequal(lua_State * L)138 static int luaB_rawequal (lua_State *L) {
139   luaL_checkany(L, 1);
140   luaL_checkany(L, 2);
141   lua_pushboolean(L, lua_rawequal(L, 1, 2));
142   return 1;
143 }
144 
145 
luaB_rawlen(lua_State * L)146 static int luaB_rawlen (lua_State *L) {
147   int t = lua_type(L, 1);
148   luaL_argcheck(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
149                    "table or string expected");
150   lua_pushinteger(L, lua_rawlen(L, 1));
151   return 1;
152 }
153 
154 
luaB_rawget(lua_State * L)155 static int luaB_rawget (lua_State *L) {
156   luaL_checktype(L, 1, LUA_TTABLE);
157   luaL_checkany(L, 2);
158   lua_settop(L, 2);
159   lua_rawget(L, 1);
160   return 1;
161 }
162 
luaB_rawset(lua_State * L)163 static int luaB_rawset (lua_State *L) {
164   luaL_checktype(L, 1, LUA_TTABLE);
165   luaL_checkany(L, 2);
166   luaL_checkany(L, 3);
167   lua_settop(L, 3);
168   lua_rawset(L, 1);
169   return 1;
170 }
171 
172 
luaB_collectgarbage(lua_State * L)173 static int luaB_collectgarbage (lua_State *L) {
174   static const char *const opts[] = {"stop", "restart", "collect",
175     "count", "step", "setpause", "setstepmul",
176     "isrunning", NULL};
177   static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
178     LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
179     LUA_GCISRUNNING};
180   int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
181   int ex = (int)luaL_optinteger(L, 2, 0);
182   int res = lua_gc(L, o, ex);
183   switch (o) {
184     case LUA_GCCOUNT: {
185       int b = lua_gc(L, LUA_GCCOUNTB, 0);
186       lua_pushnumber(L, (lua_Number)res + ((lua_Number)b/1024));
187       return 1;
188     }
189     case LUA_GCSTEP: case LUA_GCISRUNNING: {
190       lua_pushboolean(L, res);
191       return 1;
192     }
193     default: {
194       lua_pushinteger(L, res);
195       return 1;
196     }
197   }
198 }
199 
200 
luaB_type(lua_State * L)201 static int luaB_type (lua_State *L) {
202   int t = lua_type(L, 1);
203   luaL_argcheck(L, t != LUA_TNONE, 1, "value expected");
204   lua_pushstring(L, lua_typename(L, t));
205   return 1;
206 }
207 
208 
pairsmeta(lua_State * L,const char * method,int iszero,lua_CFunction iter)209 static int pairsmeta (lua_State *L, const char *method, int iszero,
210                       lua_CFunction iter) {
211   luaL_checkany(L, 1);
212   if (luaL_getmetafield(L, 1, method) == LUA_TNIL) {  /* no metamethod? */
213     lua_pushcfunction(L, iter);  /* will return generator, */
214     lua_pushvalue(L, 1);  /* state, */
215     if (iszero) lua_pushinteger(L, 0);  /* and initial value */
216     else lua_pushnil(L);
217   }
218   else {
219     lua_pushvalue(L, 1);  /* argument 'self' to metamethod */
220     lua_call(L, 1, 3);  /* get 3 values from metamethod */
221   }
222   return 3;
223 }
224 
225 
luaB_next(lua_State * L)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 
luaB_pairs(lua_State * L)238 static int luaB_pairs (lua_State *L) {
239   return pairsmeta(L, "__pairs", 0, luaB_next);
240 }
241 
242 
243 /*
244 ** Traversal function for 'ipairs'
245 */
ipairsaux(lua_State * L)246 static int ipairsaux (lua_State *L) {
247   lua_Integer i = luaL_checkinteger(L, 2) + 1;
248   lua_pushinteger(L, i);
249   return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2;
250 }
251 
252 
253 /*
254 ** 'ipairs' function. Returns 'ipairsaux', given "table", 0.
255 ** (The given "table" may not be a table.)
256 */
luaB_ipairs(lua_State * L)257 static int luaB_ipairs (lua_State *L) {
258 #if defined(LUA_COMPAT_IPAIRS)
259   return pairsmeta(L, "__ipairs", 1, ipairsaux);
260 #else
261   luaL_checkany(L, 1);
262   lua_pushcfunction(L, ipairsaux);  /* iteration function */
263   lua_pushvalue(L, 1);  /* state */
264   lua_pushinteger(L, 0);  /* initial value */
265   return 3;
266 #endif
267 }
268 
269 
load_aux(lua_State * L,int status,int envidx)270 static int load_aux (lua_State *L, int status, int envidx) {
271   if (status == LUA_OK) {
272     if (envidx != 0) {  /* 'env' parameter? */
273       lua_pushvalue(L, envidx);  /* environment for loaded function */
274       if (!lua_setupvalue(L, -2, 1))  /* set it as 1st upvalue */
275         lua_pop(L, 1);  /* remove 'env' if not used by previous call */
276     }
277     return 1;
278   }
279   else {  /* error (message is on top of the stack) */
280     lua_pushnil(L);
281     lua_insert(L, -2);  /* put before error message */
282     return 2;  /* return nil plus error message */
283   }
284 }
285 
286 
luaB_loadfile(lua_State * L)287 static int luaB_loadfile (lua_State *L) {
288   const char *fname = luaL_optstring(L, 1, NULL);
289   const char *mode = luaL_optstring(L, 2, NULL);
290   int env = (!lua_isnone(L, 3) ? 3 : 0);  /* 'env' index or 0 if no 'env' */
291   int status = luaL_loadfilex(L, fname, mode);
292   return load_aux(L, status, env);
293 }
294 
295 
296 /*
297 ** {======================================================
298 ** Generic Read function
299 ** =======================================================
300 */
301 
302 
303 /*
304 ** reserved slot, above all arguments, to hold a copy of the returned
305 ** string to avoid it being collected while parsed. 'load' has four
306 ** optional arguments (chunk, source name, mode, and environment).
307 */
308 #define RESERVEDSLOT	5
309 
310 
311 /*
312 ** Reader for generic 'load' function: 'lua_load' uses the
313 ** stack for internal stuff, so the reader cannot change the
314 ** stack top. Instead, it keeps its resulting string in a
315 ** reserved slot inside the stack.
316 */
generic_reader(lua_State * L,void * ud,size_t * size)317 static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
318   (void)(ud);  /* not used */
319   luaL_checkstack(L, 2, "too many nested functions");
320   lua_pushvalue(L, 1);  /* get function */
321   lua_call(L, 0, 1);  /* call it */
322   if (lua_isnil(L, -1)) {
323     lua_pop(L, 1);  /* pop result */
324     *size = 0;
325     return NULL;
326   }
327   else if (!lua_isstring(L, -1))
328     luaL_error(L, "reader function must return a string");
329   lua_replace(L, RESERVEDSLOT);  /* save string in reserved slot */
330   return lua_tolstring(L, RESERVEDSLOT, size);
331 }
332 
333 
luaB_load(lua_State * L)334 static int luaB_load (lua_State *L) {
335   int status;
336   size_t l;
337   const char *s = lua_tolstring(L, 1, &l);
338   const char *mode = luaL_optstring(L, 3, "bt");
339   int env = (!lua_isnone(L, 4) ? 4 : 0);  /* 'env' index or 0 if no 'env' */
340   if (s != NULL) {  /* loading a string? */
341     const char *chunkname = luaL_optstring(L, 2, s);
342     status = luaL_loadbufferx(L, s, l, chunkname, mode);
343   }
344   else {  /* loading from a reader function */
345     const char *chunkname = luaL_optstring(L, 2, "=(load)");
346     luaL_checktype(L, 1, LUA_TFUNCTION);
347     lua_settop(L, RESERVEDSLOT);  /* create reserved slot */
348     status = lua_load(L, generic_reader, NULL, chunkname, mode);
349   }
350   return load_aux(L, status, env);
351 }
352 
353 /* }====================================================== */
354 
355 
dofilecont(lua_State * L,int d1,lua_KContext d2)356 static int dofilecont (lua_State *L, int d1, lua_KContext d2) {
357   (void)d1;  (void)d2;  /* only to match 'lua_Kfunction' prototype */
358   return lua_gettop(L) - 1;
359 }
360 
361 
luaB_dofile(lua_State * L)362 static int luaB_dofile (lua_State *L) {
363   const char *fname = luaL_optstring(L, 1, NULL);
364   lua_settop(L, 1);
365   if (luaL_loadfile(L, fname) != LUA_OK)
366     return lua_error(L);
367   lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);
368   return dofilecont(L, 0, 0);
369 }
370 
371 
luaB_assert(lua_State * L)372 static int luaB_assert (lua_State *L) {
373   if (lua_toboolean(L, 1))  /* condition is true? */
374     return lua_gettop(L);  /* return all arguments */
375   else {  /* error */
376     luaL_checkany(L, 1);  /* there must be a condition */
377     lua_remove(L, 1);  /* remove it */
378     lua_pushliteral(L, "assertion failed!");  /* default message */
379     lua_settop(L, 1);  /* leave only message (default if no other one) */
380     return luaB_error(L);  /* call 'error' */
381   }
382 }
383 
384 
luaB_select(lua_State * L)385 static int luaB_select (lua_State *L) {
386   int n = lua_gettop(L);
387   if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
388     lua_pushinteger(L, n-1);
389     return 1;
390   }
391   else {
392     lua_Integer i = luaL_checkinteger(L, 1);
393     if (i < 0) i = n + i;
394     else if (i > n) i = n;
395     luaL_argcheck(L, 1 <= i, 1, "index out of range");
396     return n - (int)i;
397   }
398 }
399 
400 
401 /*
402 ** Continuation function for 'pcall' and 'xpcall'. Both functions
403 ** already pushed a 'true' before doing the call, so in case of success
404 ** 'finishpcall' only has to return everything in the stack minus
405 ** 'extra' values (where 'extra' is exactly the number of items to be
406 ** ignored).
407 */
finishpcall(lua_State * L,int status,lua_KContext extra)408 static int finishpcall (lua_State *L, int status, lua_KContext extra) {
409   if (status != LUA_OK && status != LUA_YIELD) {  /* error? */
410     lua_pushboolean(L, 0);  /* first result (false) */
411     lua_pushvalue(L, -2);  /* error message */
412     return 2;  /* return false, msg */
413   }
414   else
415     return lua_gettop(L) - (int)extra;  /* return all results */
416 }
417 
418 
luaB_pcall(lua_State * L)419 static int luaB_pcall (lua_State *L) {
420   int status;
421   luaL_checkany(L, 1);
422   lua_pushboolean(L, 1);  /* first result if no errors */
423   lua_insert(L, 1);  /* put it in place */
424   status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall);
425   return finishpcall(L, status, 0);
426 }
427 
428 
429 /*
430 ** Do a protected call with error handling. After 'lua_rotate', the
431 ** stack will have <f, err, true, f, [args...]>; so, the function passes
432 ** 2 to 'finishpcall' to skip the 2 first values when returning results.
433 */
luaB_xpcall(lua_State * L)434 static int luaB_xpcall (lua_State *L) {
435   int status;
436   int n = lua_gettop(L);
437   luaL_checktype(L, 2, LUA_TFUNCTION);  /* check error function */
438   lua_pushboolean(L, 1);  /* first result */
439   lua_pushvalue(L, 1);  /* function */
440   lua_rotate(L, 3, 2);  /* move them below function's arguments */
441   status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall);
442   return finishpcall(L, status, 2);
443 }
444 
445 
luaB_tostring(lua_State * L)446 static int luaB_tostring (lua_State *L) {
447   luaL_checkany(L, 1);
448   luaL_tolstring(L, 1, NULL);
449   return 1;
450 }
451 
452 
453 static const luaL_Reg base_funcs[] = {
454   {"assert", luaB_assert},
455   {"collectgarbage", luaB_collectgarbage},
456   {"dofile", luaB_dofile},
457   {"error", luaB_error},
458   {"getmetatable", luaB_getmetatable},
459   {"ipairs", luaB_ipairs},
460   {"loadfile", luaB_loadfile},
461   {"load", luaB_load},
462 #if defined(LUA_COMPAT_LOADSTRING)
463   {"loadstring", luaB_load},
464 #endif
465   {"next", luaB_next},
466   {"pairs", luaB_pairs},
467   {"pcall", luaB_pcall},
468   {"print", luaB_print},
469   {"rawequal", luaB_rawequal},
470   {"rawlen", luaB_rawlen},
471   {"rawget", luaB_rawget},
472   {"rawset", luaB_rawset},
473   {"select", luaB_select},
474   {"setmetatable", luaB_setmetatable},
475   {"tonumber", luaB_tonumber},
476   {"tostring", luaB_tostring},
477   {"type", luaB_type},
478   {"xpcall", luaB_xpcall},
479   /* placeholders */
480   {"_G", NULL},
481   {"_VERSION", NULL},
482   {NULL, NULL}
483 };
484 
485 
luaopen_base(lua_State * L)486 LUAMOD_API int luaopen_base (lua_State *L) {
487   /* open lib into global table */
488   lua_pushglobaltable(L);
489   luaL_setfuncs(L, base_funcs, 0);
490   /* set global _G */
491   lua_pushvalue(L, -1);
492   lua_setfield(L, -2, "_G");
493   /* set global _VERSION */
494   lua_pushliteral(L, LUA_VERSION);
495   lua_setfield(L, -2, "_VERSION");
496   return 1;
497 }
498 
499