lbaselib.cc (13711B)
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 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); 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 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 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 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 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 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 /* 244 ** Traversal function for 'ipairs' 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 /* 254 ** 'ipairs' function. Returns 'ipairsaux', given "table", 0. 255 ** (The given "table" may not be a table.) 256 */ 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 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}, 477 {"type", luaB_type}, 478 {"xpcall", luaB_xpcall}, 479 /* placeholders */ 480 {"_G", NULL}, 481 {"_VERSION", NULL}, 482 {NULL, NULL} 483 }; 484 485 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