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