]>
Commit | Line | Data |
---|---|---|
7c673cae | 1 | /* |
11fdf7f2 | 2 | ** $Id: lbaselib.c,v 1.313 2016/04/11 19:18:40 roberto Exp $ |
7c673cae FG |
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 | ||
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 | ||
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 | ||
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); | |
11fdf7f2 TL |
89 | luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */ |
90 | s = lua_tolstring(L, 1, &l); | |
7c673cae FG |
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 | ||
102 | static int luaB_error (lua_State *L) { | |
103 | int level = (int)luaL_optinteger(L, 2, 1); | |
104 | lua_settop(L, 1); | |
11fdf7f2 TL |
105 | if (lua_type(L, 1) == LUA_TSTRING && level > 0) { |
106 | luaL_where(L, level); /* add extra information */ | |
7c673cae FG |
107 | lua_pushvalue(L, 1); |
108 | lua_concat(L, 2); | |
109 | } | |
110 | return lua_error(L); | |
111 | } | |
112 | ||
113 | ||
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 | ||
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 | ||
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 | ||
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 | ||
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 | ||
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 | ||
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 | ||
7c673cae | 201 | static int luaB_type (lua_State *L) { |
11fdf7f2 TL |
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)); | |
7c673cae FG |
205 | return 1; |
206 | } | |
207 | ||
208 | ||
209 | static int pairsmeta (lua_State *L, const char *method, int iszero, | |
210 | lua_CFunction iter) { | |
211 | if (luaL_getmetafield(L, 1, method) == LUA_TNIL) { /* no metamethod? */ | |
212 | luaL_checktype(L, 1, LUA_TTABLE); /* argument must be a table */ | |
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 | ||
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 | return pairsmeta(L, "__pairs", 0, luaB_next); | |
240 | } | |
241 | ||
242 | ||
243 | /* | |
11fdf7f2 | 244 | ** Traversal function for 'ipairs' |
7c673cae FG |
245 | */ |
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 | /* | |
11fdf7f2 TL |
254 | ** 'ipairs' function. Returns 'ipairsaux', given "table", 0. |
255 | ** (The given "table" may not be a table.) | |
7c673cae FG |
256 | */ |
257 | static int luaB_ipairs (lua_State *L) { | |
7c673cae | 258 | #if defined(LUA_COMPAT_IPAIRS) |
11fdf7f2 | 259 | return pairsmeta(L, "__ipairs", 1, ipairsaux); |
7c673cae FG |
260 | #else |
261 | luaL_checkany(L, 1); | |
11fdf7f2 | 262 | lua_pushcfunction(L, ipairsaux); /* iteration function */ |
7c673cae FG |
263 | lua_pushvalue(L, 1); /* state */ |
264 | lua_pushinteger(L, 0); /* initial value */ | |
265 | return 3; | |
266 | #endif | |
267 | } | |
268 | ||
269 | ||
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 | ||
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 | */ | |
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 | ||
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 | ||
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 | ||
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 | ||
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 | ||
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 | */ | |
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 | ||
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 | */ | |
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 | ||
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}, | |
11fdf7f2 | 477 | {"type", luaB_type}, |
7c673cae FG |
478 | {"xpcall", luaB_xpcall}, |
479 | /* placeholders */ | |
7c673cae FG |
480 | {"_G", NULL}, |
481 | {"_VERSION", NULL}, | |
482 | {NULL, NULL} | |
483 | }; | |
484 | ||
485 | ||
486 | LUAMOD_API int luaopen_base (lua_State *L) { | |
7c673cae FG |
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"); | |
7c673cae FG |
496 | return 1; |
497 | } | |
498 |