1 /* $NetBSD: lbaselib.c,v 1.2 2013/12/02 04:57:41 lneto Exp $ */ 2 3 /* 4 ** $Id: lbaselib.c,v 1.2 2013/12/02 04:57:41 lneto Exp $ 5 ** Basic library 6 ** See Copyright Notice in lua.h 7 */ 8 9 10 11 #include <ctype.h> 12 #include <stdio.h> 13 #include <stdlib.h> 14 #include <string.h> 15 16 #define lbaselib_c 17 #define LUA_LIB 18 19 #include "lua.h" 20 21 #include "lauxlib.h" 22 #include "lualib.h" 23 24 25 26 27 /* 28 ** If your system does not support `stdout', you can just remove this function. 29 ** If you need, you can define your own `print' function, following this 30 ** model but changing `fputs' to put the strings at a proper place 31 ** (a console window or a log file, for instance). 32 */ 33 static int luaB_print (lua_State *L) { 34 int n = lua_gettop(L); /* number of arguments */ 35 int i; 36 lua_getglobal(L, "tostring"); 37 for (i=1; i<=n; i++) { 38 const char *s; 39 lua_pushvalue(L, -1); /* function to be called */ 40 lua_pushvalue(L, i); /* value to print */ 41 lua_call(L, 1, 1); 42 s = lua_tostring(L, -1); /* get result */ 43 if (s == NULL) 44 return luaL_error(L, LUA_QL("tostring") " must return a string to " 45 LUA_QL("print")); 46 if (i>1) fputs("\t", stdout); 47 fputs(s, stdout); 48 lua_pop(L, 1); /* pop result */ 49 } 50 fputs("\n", stdout); 51 return 0; 52 } 53 54 55 static int luaB_tonumber (lua_State *L) { 56 int base = luaL_optint(L, 2, 10); 57 if (base == 10) { /* standard conversion */ 58 luaL_checkany(L, 1); 59 if (lua_isnumber(L, 1)) { 60 lua_pushnumber(L, lua_tonumber(L, 1)); 61 return 1; 62 } 63 } 64 else { 65 const char *s1 = luaL_checkstring(L, 1); 66 char *s2; 67 unsigned long n; 68 luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); 69 n = strtoul(s1, &s2, base); 70 if (s1 != s2) { /* at least one valid digit? */ 71 while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */ 72 if (*s2 == '\0') { /* no invalid trailing characters? */ 73 lua_pushnumber(L, (lua_Number)n); 74 return 1; 75 } 76 } 77 } 78 lua_pushnil(L); /* else not a number */ 79 return 1; 80 } 81 82 83 static int luaB_error (lua_State *L) { 84 int level = luaL_optint(L, 2, 1); 85 lua_settop(L, 1); 86 if (lua_isstring(L, 1) && level > 0) { /* add extra information? */ 87 luaL_where(L, level); 88 lua_pushvalue(L, 1); 89 lua_concat(L, 2); 90 } 91 return lua_error(L); 92 } 93 94 95 static int luaB_getmetatable (lua_State *L) { 96 luaL_checkany(L, 1); 97 if (!lua_getmetatable(L, 1)) { 98 lua_pushnil(L); 99 return 1; /* no metatable */ 100 } 101 luaL_getmetafield(L, 1, "__metatable"); 102 return 1; /* returns either __metatable field (if present) or metatable */ 103 } 104 105 106 static int luaB_setmetatable (lua_State *L) { 107 int t = lua_type(L, 2); 108 luaL_checktype(L, 1, LUA_TTABLE); 109 luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, 110 "nil or table expected"); 111 if (luaL_getmetafield(L, 1, "__metatable")) 112 luaL_error(L, "cannot change a protected metatable"); 113 lua_settop(L, 2); 114 lua_setmetatable(L, 1); 115 return 1; 116 } 117 118 119 static void getfunc (lua_State *L, int opt) { 120 if (lua_isfunction(L, 1)) lua_pushvalue(L, 1); 121 else { 122 lua_Debug ar; 123 int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1); 124 luaL_argcheck(L, level >= 0, 1, "level must be non-negative"); 125 if (lua_getstack(L, level, &ar) == 0) 126 luaL_argerror(L, 1, "invalid level"); 127 lua_getinfo(L, "f", &ar); 128 if (lua_isnil(L, -1)) 129 luaL_error(L, "no function environment for tail call at level %d", 130 level); 131 } 132 } 133 134 135 static int luaB_getfenv (lua_State *L) { 136 getfunc(L, 1); 137 if (lua_iscfunction(L, -1)) /* is a C function? */ 138 lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */ 139 else 140 lua_getfenv(L, -1); 141 return 1; 142 } 143 144 145 static int luaB_setfenv (lua_State *L) { 146 luaL_checktype(L, 2, LUA_TTABLE); 147 getfunc(L, 0); 148 lua_pushvalue(L, 2); 149 if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) { 150 /* change environment of current thread */ 151 lua_pushthread(L); 152 lua_insert(L, -2); 153 lua_setfenv(L, -2); 154 return 0; 155 } 156 else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0) 157 luaL_error(L, 158 LUA_QL("setfenv") " cannot change environment of given object"); 159 return 1; 160 } 161 162 163 static int luaB_rawequal (lua_State *L) { 164 luaL_checkany(L, 1); 165 luaL_checkany(L, 2); 166 lua_pushboolean(L, lua_rawequal(L, 1, 2)); 167 return 1; 168 } 169 170 171 static int luaB_rawget (lua_State *L) { 172 luaL_checktype(L, 1, LUA_TTABLE); 173 luaL_checkany(L, 2); 174 lua_settop(L, 2); 175 lua_rawget(L, 1); 176 return 1; 177 } 178 179 static int luaB_rawset (lua_State *L) { 180 luaL_checktype(L, 1, LUA_TTABLE); 181 luaL_checkany(L, 2); 182 luaL_checkany(L, 3); 183 lua_settop(L, 3); 184 lua_rawset(L, 1); 185 return 1; 186 } 187 188 189 static int luaB_gcinfo (lua_State *L) { 190 lua_pushinteger(L, lua_getgccount(L)); 191 return 1; 192 } 193 194 195 static int luaB_collectgarbage (lua_State *L) { 196 static const char *const opts[] = {"stop", "restart", "collect", 197 "count", "step", "setpause", "setstepmul", NULL}; 198 static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT, 199 LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL}; 200 int o = luaL_checkoption(L, 1, "collect", opts); 201 int ex = luaL_optint(L, 2, 0); 202 int res = lua_gc(L, optsnum[o], ex); 203 switch (optsnum[o]) { 204 case LUA_GCCOUNT: { 205 int b = lua_gc(L, LUA_GCCOUNTB, 0); 206 lua_pushnumber(L, res + ((lua_Number)b/1024)); 207 return 1; 208 } 209 case LUA_GCSTEP: { 210 lua_pushboolean(L, res); 211 return 1; 212 } 213 default: { 214 lua_pushnumber(L, res); 215 return 1; 216 } 217 } 218 } 219 220 221 static int luaB_type (lua_State *L) { 222 luaL_checkany(L, 1); 223 lua_pushstring(L, luaL_typename(L, 1)); 224 return 1; 225 } 226 227 228 static int luaB_next (lua_State *L) { 229 luaL_checktype(L, 1, LUA_TTABLE); 230 lua_settop(L, 2); /* create a 2nd argument if there isn't one */ 231 if (lua_next(L, 1)) 232 return 2; 233 else { 234 lua_pushnil(L); 235 return 1; 236 } 237 } 238 239 240 static int luaB_pairs (lua_State *L) { 241 luaL_checktype(L, 1, LUA_TTABLE); 242 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */ 243 lua_pushvalue(L, 1); /* state, */ 244 lua_pushnil(L); /* and initial value */ 245 return 3; 246 } 247 248 249 static int ipairsaux (lua_State *L) { 250 int i = luaL_checkint(L, 2); 251 luaL_checktype(L, 1, LUA_TTABLE); 252 i++; /* next value */ 253 lua_pushinteger(L, i); 254 lua_rawgeti(L, 1, i); 255 return (lua_isnil(L, -1)) ? 0 : 2; 256 } 257 258 259 static int luaB_ipairs (lua_State *L) { 260 luaL_checktype(L, 1, LUA_TTABLE); 261 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */ 262 lua_pushvalue(L, 1); /* state, */ 263 lua_pushinteger(L, 0); /* and initial value */ 264 return 3; 265 } 266 267 268 static int load_aux (lua_State *L, int status) { 269 if (status == 0) /* OK? */ 270 return 1; 271 else { 272 lua_pushnil(L); 273 lua_insert(L, -2); /* put before error message */ 274 return 2; /* return nil plus error message */ 275 } 276 } 277 278 279 static int luaB_loadstring (lua_State *L) { 280 size_t l; 281 const char *s = luaL_checklstring(L, 1, &l); 282 const char *chunkname = luaL_optstring(L, 2, s); 283 return load_aux(L, luaL_loadbuffer(L, s, l, chunkname)); 284 } 285 286 287 #ifndef _KERNEL 288 static int luaB_loadfile (lua_State *L) { 289 const char *fname = luaL_optstring(L, 1, NULL); 290 return load_aux(L, luaL_loadfile(L, fname)); 291 } 292 #endif 293 294 295 /* 296 ** Reader for generic `load' function: `lua_load' uses the 297 ** stack for internal stuff, so the reader cannot change the 298 ** stack top. Instead, it keeps its resulting string in a 299 ** reserved slot inside the stack. 300 */ 301 static const char *generic_reader (lua_State *L, void *ud, size_t *size) { 302 (void)ud; /* to avoid warnings */ 303 luaL_checkstack(L, 2, "too many nested functions"); 304 lua_pushvalue(L, 1); /* get function */ 305 lua_call(L, 0, 1); /* call it */ 306 if (lua_isnil(L, -1)) { 307 *size = 0; 308 return NULL; 309 } 310 else if (lua_isstring(L, -1)) { 311 lua_replace(L, 3); /* save string in a reserved stack slot */ 312 return lua_tolstring(L, 3, size); 313 } 314 else luaL_error(L, "reader function must return a string"); 315 return NULL; /* to avoid warnings */ 316 } 317 318 319 static int luaB_load (lua_State *L) { 320 int status; 321 const char *cname = luaL_optstring(L, 2, "=(load)"); 322 luaL_checktype(L, 1, LUA_TFUNCTION); 323 lua_settop(L, 3); /* function, eventual name, plus one reserved slot */ 324 status = lua_load(L, generic_reader, NULL, cname); 325 return load_aux(L, status); 326 } 327 328 329 #ifndef _KERNEL 330 static int luaB_dofile (lua_State *L) { 331 const char *fname = luaL_optstring(L, 1, NULL); 332 int n = lua_gettop(L); 333 if (luaL_loadfile(L, fname) != 0) lua_error(L); 334 lua_call(L, 0, LUA_MULTRET); 335 return lua_gettop(L) - n; 336 } 337 #endif 338 339 340 static int luaB_assert (lua_State *L) { 341 luaL_checkany(L, 1); 342 if (!lua_toboolean(L, 1)) 343 return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); 344 return lua_gettop(L); 345 } 346 347 348 static int luaB_unpack (lua_State *L) { 349 int i, e, n; 350 luaL_checktype(L, 1, LUA_TTABLE); 351 i = luaL_optint(L, 2, 1); 352 e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1)); 353 if (i > e) return 0; /* empty range */ 354 n = e - i + 1; /* number of elements */ 355 if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */ 356 return luaL_error(L, "too many results to unpack"); 357 lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */ 358 while (i++ < e) /* push arg[i + 1...e] */ 359 lua_rawgeti(L, 1, i); 360 return n; 361 } 362 363 364 static int luaB_select (lua_State *L) { 365 int n = lua_gettop(L); 366 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') { 367 lua_pushinteger(L, n-1); 368 return 1; 369 } 370 else { 371 int i = luaL_checkint(L, 1); 372 if (i < 0) i = n + i; 373 else if (i > n) i = n; 374 luaL_argcheck(L, 1 <= i, 1, "index out of range"); 375 return n - i; 376 } 377 } 378 379 380 static int luaB_pcall (lua_State *L) { 381 int status; 382 luaL_checkany(L, 1); 383 status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); 384 lua_pushboolean(L, (status == 0)); 385 lua_insert(L, 1); 386 return lua_gettop(L); /* return status + all results */ 387 } 388 389 390 static int luaB_xpcall (lua_State *L) { 391 int status; 392 luaL_checkany(L, 2); 393 lua_settop(L, 2); 394 lua_insert(L, 1); /* put error function under function to be called */ 395 status = lua_pcall(L, 0, LUA_MULTRET, 1); 396 lua_pushboolean(L, (status == 0)); 397 lua_replace(L, 1); 398 return lua_gettop(L); /* return status + all results */ 399 } 400 401 402 static int luaB_tostring (lua_State *L) { 403 luaL_checkany(L, 1); 404 if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ 405 return 1; /* use its value */ 406 switch (lua_type(L, 1)) { 407 case LUA_TNUMBER: 408 lua_pushstring(L, lua_tostring(L, 1)); 409 break; 410 case LUA_TSTRING: 411 lua_pushvalue(L, 1); 412 break; 413 case LUA_TBOOLEAN: 414 lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); 415 break; 416 case LUA_TNIL: 417 lua_pushliteral(L, "nil"); 418 break; 419 default: 420 lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1)); 421 break; 422 } 423 return 1; 424 } 425 426 427 static int luaB_newproxy (lua_State *L) { 428 lua_settop(L, 1); 429 lua_newuserdata(L, 0); /* create proxy */ 430 if (lua_toboolean(L, 1) == 0) 431 return 1; /* no metatable */ 432 else if (lua_isboolean(L, 1)) { 433 lua_newtable(L); /* create a new metatable `m' ... */ 434 lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ 435 lua_pushboolean(L, 1); 436 lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ 437 } 438 else { 439 int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ 440 if (lua_getmetatable(L, 1)) { 441 lua_rawget(L, lua_upvalueindex(1)); 442 validproxy = lua_toboolean(L, -1); 443 lua_pop(L, 1); /* remove value */ 444 } 445 luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); 446 lua_getmetatable(L, 1); /* metatable is valid; get it */ 447 } 448 lua_setmetatable(L, 2); 449 return 1; 450 } 451 452 453 static const luaL_Reg base_funcs[] = { 454 {"assert", luaB_assert}, 455 {"collectgarbage", luaB_collectgarbage}, 456 #ifndef _KERNEL 457 {"dofile", luaB_dofile}, 458 #endif 459 {"error", luaB_error}, 460 {"gcinfo", luaB_gcinfo}, 461 {"getfenv", luaB_getfenv}, 462 {"getmetatable", luaB_getmetatable}, 463 #ifndef _KERNEL 464 {"loadfile", luaB_loadfile}, 465 #endif 466 {"load", luaB_load}, 467 {"loadstring", luaB_loadstring}, 468 {"next", luaB_next}, 469 {"pcall", luaB_pcall}, 470 {"print", luaB_print}, 471 {"rawequal", luaB_rawequal}, 472 {"rawget", luaB_rawget}, 473 {"rawset", luaB_rawset}, 474 {"select", luaB_select}, 475 {"setfenv", luaB_setfenv}, 476 {"setmetatable", luaB_setmetatable}, 477 {"tonumber", luaB_tonumber}, 478 {"tostring", luaB_tostring}, 479 {"type", luaB_type}, 480 {"unpack", luaB_unpack}, 481 {"xpcall", luaB_xpcall}, 482 {NULL, NULL} 483 }; 484 485 486 /* 487 ** {====================================================== 488 ** Coroutine library 489 ** ======================================================= 490 */ 491 492 #define CO_RUN 0 /* running */ 493 #define CO_SUS 1 /* suspended */ 494 #define CO_NOR 2 /* 'normal' (it resumed another coroutine) */ 495 #define CO_DEAD 3 496 497 static const char *const statnames[] = 498 {"running", "suspended", "normal", "dead"}; 499 500 static int costatus (lua_State *L, lua_State *co) { 501 if (L == co) return CO_RUN; 502 switch (lua_status(co)) { 503 case LUA_YIELD: 504 return CO_SUS; 505 case 0: { 506 lua_Debug ar; 507 if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */ 508 return CO_NOR; /* it is running */ 509 else if (lua_gettop(co) == 0) 510 return CO_DEAD; 511 else 512 return CO_SUS; /* initial state */ 513 } 514 default: /* some error occured */ 515 return CO_DEAD; 516 } 517 } 518 519 520 static int luaB_costatus (lua_State *L) { 521 lua_State *co = lua_tothread(L, 1); 522 luaL_argcheck(L, co, 1, "coroutine expected"); 523 lua_pushstring(L, statnames[costatus(L, co)]); 524 return 1; 525 } 526 527 528 static int auxresume (lua_State *L, lua_State *co, int narg) { 529 int status = costatus(L, co); 530 if (!lua_checkstack(co, narg)) 531 luaL_error(L, "too many arguments to resume"); 532 if (status != CO_SUS) { 533 lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]); 534 return -1; /* error flag */ 535 } 536 lua_xmove(L, co, narg); 537 lua_setlevel(L, co); 538 status = lua_resume(co, narg); 539 if (status == 0 || status == LUA_YIELD) { 540 int nres = lua_gettop(co); 541 if (!lua_checkstack(L, nres + 1)) 542 luaL_error(L, "too many results to resume"); 543 lua_xmove(co, L, nres); /* move yielded values */ 544 return nres; 545 } 546 else { 547 lua_xmove(co, L, 1); /* move error message */ 548 return -1; /* error flag */ 549 } 550 } 551 552 553 static int luaB_coresume (lua_State *L) { 554 lua_State *co = lua_tothread(L, 1); 555 int r; 556 luaL_argcheck(L, co, 1, "coroutine expected"); 557 r = auxresume(L, co, lua_gettop(L) - 1); 558 if (r < 0) { 559 lua_pushboolean(L, 0); 560 lua_insert(L, -2); 561 return 2; /* return false + error message */ 562 } 563 else { 564 lua_pushboolean(L, 1); 565 lua_insert(L, -(r + 1)); 566 return r + 1; /* return true + `resume' returns */ 567 } 568 } 569 570 571 static int luaB_auxwrap (lua_State *L) { 572 lua_State *co = lua_tothread(L, lua_upvalueindex(1)); 573 int r = auxresume(L, co, lua_gettop(L)); 574 if (r < 0) { 575 if (lua_isstring(L, -1)) { /* error object is a string? */ 576 luaL_where(L, 1); /* add extra info */ 577 lua_insert(L, -2); 578 lua_concat(L, 2); 579 } 580 lua_error(L); /* propagate error */ 581 } 582 return r; 583 } 584 585 586 static int luaB_cocreate (lua_State *L) { 587 lua_State *NL = lua_newthread(L); 588 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, 589 "Lua function expected"); 590 lua_pushvalue(L, 1); /* move function to top */ 591 lua_xmove(L, NL, 1); /* move function from L to NL */ 592 return 1; 593 } 594 595 596 static int luaB_cowrap (lua_State *L) { 597 luaB_cocreate(L); 598 lua_pushcclosure(L, luaB_auxwrap, 1); 599 return 1; 600 } 601 602 603 static int luaB_yield (lua_State *L) { 604 return lua_yield(L, lua_gettop(L)); 605 } 606 607 608 static int luaB_corunning (lua_State *L) { 609 if (lua_pushthread(L)) 610 lua_pushnil(L); /* main thread is not a coroutine */ 611 return 1; 612 } 613 614 615 static const luaL_Reg co_funcs[] = { 616 {"create", luaB_cocreate}, 617 {"resume", luaB_coresume}, 618 {"running", luaB_corunning}, 619 {"status", luaB_costatus}, 620 {"wrap", luaB_cowrap}, 621 {"yield", luaB_yield}, 622 {NULL, NULL} 623 }; 624 625 /* }====================================================== */ 626 627 628 static void auxopen (lua_State *L, const char *name, 629 lua_CFunction f, lua_CFunction u) { 630 lua_pushcfunction(L, u); 631 lua_pushcclosure(L, f, 1); 632 lua_setfield(L, -2, name); 633 } 634 635 636 static void base_open (lua_State *L) { 637 /* set global _G */ 638 lua_pushvalue(L, LUA_GLOBALSINDEX); 639 lua_setglobal(L, "_G"); 640 /* open lib into global table */ 641 luaL_register(L, "_G", base_funcs); 642 lua_pushliteral(L, LUA_VERSION); 643 lua_setglobal(L, "_VERSION"); /* set global _VERSION */ 644 /* `ipairs' and `pairs' need auxiliary functions as upvalues */ 645 auxopen(L, "ipairs", luaB_ipairs, ipairsaux); 646 auxopen(L, "pairs", luaB_pairs, luaB_next); 647 /* `newproxy' needs a weaktable as upvalue */ 648 lua_createtable(L, 0, 1); /* new table `w' */ 649 lua_pushvalue(L, -1); /* `w' will be its own metatable */ 650 lua_setmetatable(L, -2); 651 lua_pushliteral(L, "kv"); 652 lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */ 653 lua_pushcclosure(L, luaB_newproxy, 1); 654 lua_setglobal(L, "newproxy"); /* set global `newproxy' */ 655 } 656 657 658 LUALIB_API int luaopen_base (lua_State *L) { 659 base_open(L); 660 luaL_register(L, LUA_COLIBNAME, co_funcs); 661 return 2; 662 } 663 664