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