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