1 /* $NetBSD: lbaselib.c,v 1.1.1.1 2010/10/31 11:16:55 mbalmer Exp $ */ 2 3 /* 4 ** Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto 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 static int luaB_loadfile (lua_State *L) { 288 const char *fname = luaL_optstring(L, 1, NULL); 289 return load_aux(L, luaL_loadfile(L, fname)); 290 } 291 292 293 /* 294 ** Reader for generic `load' function: `lua_load' uses the 295 ** stack for internal stuff, so the reader cannot change the 296 ** stack top. Instead, it keeps its resulting string in a 297 ** reserved slot inside the stack. 298 */ 299 static const char *generic_reader (lua_State *L, void *ud, size_t *size) { 300 (void)ud; /* to avoid warnings */ 301 luaL_checkstack(L, 2, "too many nested functions"); 302 lua_pushvalue(L, 1); /* get function */ 303 lua_call(L, 0, 1); /* call it */ 304 if (lua_isnil(L, -1)) { 305 *size = 0; 306 return NULL; 307 } 308 else if (lua_isstring(L, -1)) { 309 lua_replace(L, 3); /* save string in a reserved stack slot */ 310 return lua_tolstring(L, 3, size); 311 } 312 else luaL_error(L, "reader function must return a string"); 313 return NULL; /* to avoid warnings */ 314 } 315 316 317 static int luaB_load (lua_State *L) { 318 int status; 319 const char *cname = luaL_optstring(L, 2, "=(load)"); 320 luaL_checktype(L, 1, LUA_TFUNCTION); 321 lua_settop(L, 3); /* function, eventual name, plus one reserved slot */ 322 status = lua_load(L, generic_reader, NULL, cname); 323 return load_aux(L, status); 324 } 325 326 327 static int luaB_dofile (lua_State *L) { 328 const char *fname = luaL_optstring(L, 1, NULL); 329 int n = lua_gettop(L); 330 if (luaL_loadfile(L, fname) != 0) lua_error(L); 331 lua_call(L, 0, LUA_MULTRET); 332 return lua_gettop(L) - n; 333 } 334 335 336 static int luaB_assert (lua_State *L) { 337 luaL_checkany(L, 1); 338 if (!lua_toboolean(L, 1)) 339 return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); 340 return lua_gettop(L); 341 } 342 343 344 static int luaB_unpack (lua_State *L) { 345 int i, e, n; 346 luaL_checktype(L, 1, LUA_TTABLE); 347 i = luaL_optint(L, 2, 1); 348 e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1)); 349 if (i > e) return 0; /* empty range */ 350 n = e - i + 1; /* number of elements */ 351 if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */ 352 return luaL_error(L, "too many results to unpack"); 353 lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */ 354 while (i++ < e) /* push arg[i + 1...e] */ 355 lua_rawgeti(L, 1, i); 356 return n; 357 } 358 359 360 static int luaB_select (lua_State *L) { 361 int n = lua_gettop(L); 362 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') { 363 lua_pushinteger(L, n-1); 364 return 1; 365 } 366 else { 367 int i = luaL_checkint(L, 1); 368 if (i < 0) i = n + i; 369 else if (i > n) i = n; 370 luaL_argcheck(L, 1 <= i, 1, "index out of range"); 371 return n - i; 372 } 373 } 374 375 376 static int luaB_pcall (lua_State *L) { 377 int status; 378 luaL_checkany(L, 1); 379 status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); 380 lua_pushboolean(L, (status == 0)); 381 lua_insert(L, 1); 382 return lua_gettop(L); /* return status + all results */ 383 } 384 385 386 static int luaB_xpcall (lua_State *L) { 387 int status; 388 luaL_checkany(L, 2); 389 lua_settop(L, 2); 390 lua_insert(L, 1); /* put error function under function to be called */ 391 status = lua_pcall(L, 0, LUA_MULTRET, 1); 392 lua_pushboolean(L, (status == 0)); 393 lua_replace(L, 1); 394 return lua_gettop(L); /* return status + all results */ 395 } 396 397 398 static int luaB_tostring (lua_State *L) { 399 luaL_checkany(L, 1); 400 if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ 401 return 1; /* use its value */ 402 switch (lua_type(L, 1)) { 403 case LUA_TNUMBER: 404 lua_pushstring(L, lua_tostring(L, 1)); 405 break; 406 case LUA_TSTRING: 407 lua_pushvalue(L, 1); 408 break; 409 case LUA_TBOOLEAN: 410 lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); 411 break; 412 case LUA_TNIL: 413 lua_pushliteral(L, "nil"); 414 break; 415 default: 416 lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1)); 417 break; 418 } 419 return 1; 420 } 421 422 423 static int luaB_newproxy (lua_State *L) { 424 lua_settop(L, 1); 425 lua_newuserdata(L, 0); /* create proxy */ 426 if (lua_toboolean(L, 1) == 0) 427 return 1; /* no metatable */ 428 else if (lua_isboolean(L, 1)) { 429 lua_newtable(L); /* create a new metatable `m' ... */ 430 lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ 431 lua_pushboolean(L, 1); 432 lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ 433 } 434 else { 435 int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ 436 if (lua_getmetatable(L, 1)) { 437 lua_rawget(L, lua_upvalueindex(1)); 438 validproxy = lua_toboolean(L, -1); 439 lua_pop(L, 1); /* remove value */ 440 } 441 luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); 442 lua_getmetatable(L, 1); /* metatable is valid; get it */ 443 } 444 lua_setmetatable(L, 2); 445 return 1; 446 } 447 448 449 static const luaL_Reg base_funcs[] = { 450 {"assert", luaB_assert}, 451 {"collectgarbage", luaB_collectgarbage}, 452 {"dofile", luaB_dofile}, 453 {"error", luaB_error}, 454 {"gcinfo", luaB_gcinfo}, 455 {"getfenv", luaB_getfenv}, 456 {"getmetatable", luaB_getmetatable}, 457 {"loadfile", luaB_loadfile}, 458 {"load", luaB_load}, 459 {"loadstring", luaB_loadstring}, 460 {"next", luaB_next}, 461 {"pcall", luaB_pcall}, 462 {"print", luaB_print}, 463 {"rawequal", luaB_rawequal}, 464 {"rawget", luaB_rawget}, 465 {"rawset", luaB_rawset}, 466 {"select", luaB_select}, 467 {"setfenv", luaB_setfenv}, 468 {"setmetatable", luaB_setmetatable}, 469 {"tonumber", luaB_tonumber}, 470 {"tostring", luaB_tostring}, 471 {"type", luaB_type}, 472 {"unpack", luaB_unpack}, 473 {"xpcall", luaB_xpcall}, 474 {NULL, NULL} 475 }; 476 477 478 /* 479 ** {====================================================== 480 ** Coroutine library 481 ** ======================================================= 482 */ 483 484 #define CO_RUN 0 /* running */ 485 #define CO_SUS 1 /* suspended */ 486 #define CO_NOR 2 /* 'normal' (it resumed another coroutine) */ 487 #define CO_DEAD 3 488 489 static const char *const statnames[] = 490 {"running", "suspended", "normal", "dead"}; 491 492 static int costatus (lua_State *L, lua_State *co) { 493 if (L == co) return CO_RUN; 494 switch (lua_status(co)) { 495 case LUA_YIELD: 496 return CO_SUS; 497 case 0: { 498 lua_Debug ar; 499 if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */ 500 return CO_NOR; /* it is running */ 501 else if (lua_gettop(co) == 0) 502 return CO_DEAD; 503 else 504 return CO_SUS; /* initial state */ 505 } 506 default: /* some error occured */ 507 return CO_DEAD; 508 } 509 } 510 511 512 static int luaB_costatus (lua_State *L) { 513 lua_State *co = lua_tothread(L, 1); 514 luaL_argcheck(L, co, 1, "coroutine expected"); 515 lua_pushstring(L, statnames[costatus(L, co)]); 516 return 1; 517 } 518 519 520 static int auxresume (lua_State *L, lua_State *co, int narg) { 521 int status = costatus(L, co); 522 if (!lua_checkstack(co, narg)) 523 luaL_error(L, "too many arguments to resume"); 524 if (status != CO_SUS) { 525 lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]); 526 return -1; /* error flag */ 527 } 528 lua_xmove(L, co, narg); 529 lua_setlevel(L, co); 530 status = lua_resume(co, narg); 531 if (status == 0 || status == LUA_YIELD) { 532 int nres = lua_gettop(co); 533 if (!lua_checkstack(L, nres + 1)) 534 luaL_error(L, "too many results to resume"); 535 lua_xmove(co, L, nres); /* move yielded values */ 536 return nres; 537 } 538 else { 539 lua_xmove(co, L, 1); /* move error message */ 540 return -1; /* error flag */ 541 } 542 } 543 544 545 static int luaB_coresume (lua_State *L) { 546 lua_State *co = lua_tothread(L, 1); 547 int r; 548 luaL_argcheck(L, co, 1, "coroutine expected"); 549 r = auxresume(L, co, lua_gettop(L) - 1); 550 if (r < 0) { 551 lua_pushboolean(L, 0); 552 lua_insert(L, -2); 553 return 2; /* return false + error message */ 554 } 555 else { 556 lua_pushboolean(L, 1); 557 lua_insert(L, -(r + 1)); 558 return r + 1; /* return true + `resume' returns */ 559 } 560 } 561 562 563 static int luaB_auxwrap (lua_State *L) { 564 lua_State *co = lua_tothread(L, lua_upvalueindex(1)); 565 int r = auxresume(L, co, lua_gettop(L)); 566 if (r < 0) { 567 if (lua_isstring(L, -1)) { /* error object is a string? */ 568 luaL_where(L, 1); /* add extra info */ 569 lua_insert(L, -2); 570 lua_concat(L, 2); 571 } 572 lua_error(L); /* propagate error */ 573 } 574 return r; 575 } 576 577 578 static int luaB_cocreate (lua_State *L) { 579 lua_State *NL = lua_newthread(L); 580 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, 581 "Lua function expected"); 582 lua_pushvalue(L, 1); /* move function to top */ 583 lua_xmove(L, NL, 1); /* move function from L to NL */ 584 return 1; 585 } 586 587 588 static int luaB_cowrap (lua_State *L) { 589 luaB_cocreate(L); 590 lua_pushcclosure(L, luaB_auxwrap, 1); 591 return 1; 592 } 593 594 595 static int luaB_yield (lua_State *L) { 596 return lua_yield(L, lua_gettop(L)); 597 } 598 599 600 static int luaB_corunning (lua_State *L) { 601 if (lua_pushthread(L)) 602 lua_pushnil(L); /* main thread is not a coroutine */ 603 return 1; 604 } 605 606 607 static const luaL_Reg co_funcs[] = { 608 {"create", luaB_cocreate}, 609 {"resume", luaB_coresume}, 610 {"running", luaB_corunning}, 611 {"status", luaB_costatus}, 612 {"wrap", luaB_cowrap}, 613 {"yield", luaB_yield}, 614 {NULL, NULL} 615 }; 616 617 /* }====================================================== */ 618 619 620 static void auxopen (lua_State *L, const char *name, 621 lua_CFunction f, lua_CFunction u) { 622 lua_pushcfunction(L, u); 623 lua_pushcclosure(L, f, 1); 624 lua_setfield(L, -2, name); 625 } 626 627 628 static void base_open (lua_State *L) { 629 /* set global _G */ 630 lua_pushvalue(L, LUA_GLOBALSINDEX); 631 lua_setglobal(L, "_G"); 632 /* open lib into global table */ 633 luaL_register(L, "_G", base_funcs); 634 lua_pushliteral(L, LUA_VERSION); 635 lua_setglobal(L, "_VERSION"); /* set global _VERSION */ 636 /* `ipairs' and `pairs' need auxliliary functions as upvalues */ 637 auxopen(L, "ipairs", luaB_ipairs, ipairsaux); 638 auxopen(L, "pairs", luaB_pairs, luaB_next); 639 /* `newproxy' needs a weaktable as upvalue */ 640 lua_createtable(L, 0, 1); /* new table `w' */ 641 lua_pushvalue(L, -1); /* `w' will be its own metatable */ 642 lua_setmetatable(L, -2); 643 lua_pushliteral(L, "kv"); 644 lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */ 645 lua_pushcclosure(L, luaB_newproxy, 1); 646 lua_setglobal(L, "newproxy"); /* set global `newproxy' */ 647 } 648 649 650 LUALIB_API int luaopen_base (lua_State *L) { 651 base_open(L); 652 luaL_register(L, LUA_COLIBNAME, co_funcs); 653 return 2; 654 } 655 656