ltests.c (57498B)
1 /* 2 ** $Id: ltests.c $ 3 ** Internal Module for Debugging of the Lua Implementation 4 ** See Copyright Notice in lua.h 5 */ 6 7 #define ltests_c 8 #define LUA_CORE 9 10 #include "lprefix.h" 11 12 13 #include <limits.h> 14 #include <setjmp.h> 15 #include <stdio.h> 16 #include <stdlib.h> 17 #include <string.h> 18 19 #include "lua.h" 20 21 #include "lapi.h" 22 #include "lauxlib.h" 23 #include "lcode.h" 24 #include "lctype.h" 25 #include "ldebug.h" 26 #include "ldo.h" 27 #include "lfunc.h" 28 #include "lmem.h" 29 #include "lopcodes.h" 30 #include "lopnames.h" 31 #include "lstate.h" 32 #include "lstring.h" 33 #include "ltable.h" 34 #include "lualib.h" 35 36 37 38 /* 39 ** The whole module only makes sense with LUA_DEBUG on 40 */ 41 #if defined(LUA_DEBUG) 42 43 44 void *l_Trick = 0; 45 46 47 #define obj_at(L,k) s2v(L->ci->func.p + (k)) 48 49 50 static int runC (lua_State *L, lua_State *L1, const char *pc); 51 52 53 static void setnameval (lua_State *L, const char *name, int val) { 54 lua_pushinteger(L, val); 55 lua_setfield(L, -2, name); 56 } 57 58 59 static void pushobject (lua_State *L, const TValue *o) { 60 setobj2s(L, L->top.p, o); 61 api_incr_top(L); 62 } 63 64 65 static void badexit (const char *fmt, const char *s1, const char *s2) { 66 fprintf(stderr, fmt, s1); 67 if (s2) 68 fprintf(stderr, "extra info: %s\n", s2); 69 /* avoid assertion failures when exiting */ 70 l_memcontrol.numblocks = l_memcontrol.total = 0; 71 exit(EXIT_FAILURE); 72 } 73 74 75 static int tpanic (lua_State *L) { 76 const char *msg = (lua_type(L, -1) == LUA_TSTRING) 77 ? lua_tostring(L, -1) 78 : "error object is not a string"; 79 return (badexit("PANIC: unprotected error in call to Lua API (%s)\n", 80 msg, NULL), 81 0); /* do not return to Lua */ 82 } 83 84 85 /* 86 ** Warning function for tests. First, it concatenates all parts of 87 ** a warning in buffer 'buff'. Then, it has three modes: 88 ** - 0.normal: messages starting with '#' are shown on standard output; 89 ** - other messages abort the tests (they represent real warning 90 ** conditions; the standard tests should not generate these conditions 91 ** unexpectedly); 92 ** - 1.allow: all messages are shown; 93 ** - 2.store: all warnings go to the global '_WARN'; 94 */ 95 static void warnf (void *ud, const char *msg, int tocont) { 96 lua_State *L = cast(lua_State *, ud); 97 static char buff[200] = ""; /* should be enough for tests... */ 98 static int onoff = 0; 99 static int mode = 0; /* start in normal mode */ 100 static int lasttocont = 0; 101 if (!lasttocont && !tocont && *msg == '@') { /* control message? */ 102 if (buff[0] != '\0') 103 badexit("Control warning during warning: %s\naborting...\n", msg, buff); 104 if (strcmp(msg, "@off") == 0) 105 onoff = 0; 106 else if (strcmp(msg, "@on") == 0) 107 onoff = 1; 108 else if (strcmp(msg, "@normal") == 0) 109 mode = 0; 110 else if (strcmp(msg, "@allow") == 0) 111 mode = 1; 112 else if (strcmp(msg, "@store") == 0) 113 mode = 2; 114 else 115 badexit("Invalid control warning in test mode: %s\naborting...\n", 116 msg, NULL); 117 return; 118 } 119 lasttocont = tocont; 120 if (strlen(msg) >= sizeof(buff) - strlen(buff)) 121 badexit("warnf-buffer overflow (%s)\n", msg, buff); 122 strcat(buff, msg); /* add new message to current warning */ 123 if (!tocont) { /* message finished? */ 124 lua_unlock(L); 125 luaL_checkstack(L, 1, "warn stack space"); 126 lua_getglobal(L, "_WARN"); 127 if (!lua_toboolean(L, -1)) 128 lua_pop(L, 1); /* ok, no previous unexpected warning */ 129 else { 130 badexit("Unhandled warning in store mode: %s\naborting...\n", 131 lua_tostring(L, -1), buff); 132 } 133 lua_lock(L); 134 switch (mode) { 135 case 0: { /* normal */ 136 if (buff[0] != '#' && onoff) /* unexpected warning? */ 137 badexit("Unexpected warning in test mode: %s\naborting...\n", 138 buff, NULL); 139 } /* FALLTHROUGH */ 140 case 1: { /* allow */ 141 if (onoff) 142 fprintf(stderr, "Lua warning: %s\n", buff); /* print warning */ 143 break; 144 } 145 case 2: { /* store */ 146 lua_unlock(L); 147 luaL_checkstack(L, 1, "warn stack space"); 148 lua_pushstring(L, buff); 149 lua_setglobal(L, "_WARN"); /* assign message to global '_WARN' */ 150 lua_lock(L); 151 break; 152 } 153 } 154 buff[0] = '\0'; /* prepare buffer for next warning */ 155 } 156 } 157 158 159 /* 160 ** {====================================================================== 161 ** Controlled version for realloc. 162 ** ======================================================================= 163 */ 164 165 #define MARK 0x55 /* 01010101 (a nice pattern) */ 166 167 typedef union Header { 168 LUAI_MAXALIGN; 169 struct { 170 size_t size; 171 int type; 172 } d; 173 } Header; 174 175 176 #if !defined(EXTERNMEMCHECK) 177 178 /* full memory check */ 179 #define MARKSIZE 16 /* size of marks after each block */ 180 #define fillmem(mem,size) memset(mem, -MARK, size) 181 182 #else 183 184 /* external memory check: don't do it twice */ 185 #define MARKSIZE 0 186 #define fillmem(mem,size) /* empty */ 187 188 #endif 189 190 191 Memcontrol l_memcontrol = 192 {0, 0UL, 0UL, 0UL, 0UL, (~0UL), 193 {0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL, 0UL}}; 194 195 196 static void freeblock (Memcontrol *mc, Header *block) { 197 if (block) { 198 size_t size = block->d.size; 199 int i; 200 for (i = 0; i < MARKSIZE; i++) /* check marks after block */ 201 lua_assert(*(cast_charp(block + 1) + size + i) == MARK); 202 mc->objcount[block->d.type]--; 203 fillmem(block, sizeof(Header) + size + MARKSIZE); /* erase block */ 204 free(block); /* actually free block */ 205 mc->numblocks--; /* update counts */ 206 mc->total -= size; 207 } 208 } 209 210 211 void *debug_realloc (void *ud, void *b, size_t oldsize, size_t size) { 212 Memcontrol *mc = cast(Memcontrol *, ud); 213 Header *block = cast(Header *, b); 214 int type; 215 if (mc->memlimit == 0) { /* first time? */ 216 char *limit = getenv("MEMLIMIT"); /* initialize memory limit */ 217 mc->memlimit = limit ? strtoul(limit, NULL, 10) : ULONG_MAX; 218 } 219 if (block == NULL) { 220 type = (oldsize < LUA_NUMTYPES) ? cast_int(oldsize) : 0; 221 oldsize = 0; 222 } 223 else { 224 block--; /* go to real header */ 225 type = block->d.type; 226 lua_assert(oldsize == block->d.size); 227 } 228 if (size == 0) { 229 freeblock(mc, block); 230 return NULL; 231 } 232 if (mc->failnext) { 233 mc->failnext = 0; 234 return NULL; /* fake a single memory allocation error */ 235 } 236 if (mc->countlimit != ~0UL && size != oldsize) { /* count limit in use? */ 237 if (mc->countlimit == 0) 238 return NULL; /* fake a memory allocation error */ 239 mc->countlimit--; 240 } 241 if (size > oldsize && mc->total+size-oldsize > mc->memlimit) 242 return NULL; /* fake a memory allocation error */ 243 else { 244 Header *newblock; 245 int i; 246 size_t commonsize = (oldsize < size) ? oldsize : size; 247 size_t realsize = sizeof(Header) + size + MARKSIZE; 248 if (realsize < size) return NULL; /* arithmetic overflow! */ 249 newblock = cast(Header *, malloc(realsize)); /* alloc a new block */ 250 if (newblock == NULL) 251 return NULL; /* really out of memory? */ 252 if (block) { 253 memcpy(newblock + 1, block + 1, commonsize); /* copy old contents */ 254 freeblock(mc, block); /* erase (and check) old copy */ 255 } 256 /* initialize new part of the block with something weird */ 257 fillmem(cast_charp(newblock + 1) + commonsize, size - commonsize); 258 /* initialize marks after block */ 259 for (i = 0; i < MARKSIZE; i++) 260 *(cast_charp(newblock + 1) + size + i) = MARK; 261 newblock->d.size = size; 262 newblock->d.type = type; 263 mc->total += size; 264 if (mc->total > mc->maxmem) 265 mc->maxmem = mc->total; 266 mc->numblocks++; 267 mc->objcount[type]++; 268 return newblock + 1; 269 } 270 } 271 272 273 /* }====================================================================== */ 274 275 276 277 /* 278 ** {===================================================================== 279 ** Functions to check memory consistency. 280 ** Most of these checks are done through asserts, so this code does 281 ** not make sense with asserts off. For this reason, it uses 'assert' 282 ** directly, instead of 'lua_assert'. 283 ** ====================================================================== 284 */ 285 286 #include <assert.h> 287 288 /* 289 ** Check GC invariants. For incremental mode, a black object cannot 290 ** point to a white one. For generational mode, really old objects 291 ** cannot point to young objects. Both old1 and touched2 objects 292 ** cannot point to new objects (but can point to survivals). 293 ** (Threads and open upvalues, despite being marked "really old", 294 ** continue to be visited in all collections, and therefore can point to 295 ** new objects. They, and only they, are old but gray.) 296 */ 297 static int testobjref1 (global_State *g, GCObject *f, GCObject *t) { 298 if (isdead(g,t)) return 0; 299 if (issweepphase(g)) 300 return 1; /* no invariants */ 301 else if (g->gckind != KGC_GENMINOR) 302 return !(isblack(f) && iswhite(t)); /* basic incremental invariant */ 303 else { /* generational mode */ 304 if ((getage(f) == G_OLD && isblack(f)) && !isold(t)) 305 return 0; 306 if ((getage(f) == G_OLD1 || getage(f) == G_TOUCHED2) && 307 getage(t) == G_NEW) 308 return 0; 309 return 1; 310 } 311 } 312 313 314 static void printobj (global_State *g, GCObject *o) { 315 printf("||%s(%p)-%c%c(%02X)||", 316 ttypename(novariant(o->tt)), (void *)o, 317 isdead(g,o) ? 'd' : isblack(o) ? 'b' : iswhite(o) ? 'w' : 'g', 318 "ns01oTt"[getage(o)], o->marked); 319 if (o->tt == LUA_VSHRSTR || o->tt == LUA_VLNGSTR) 320 printf(" '%s'", getstr(gco2ts(o))); 321 } 322 323 324 void lua_printobj (lua_State *L, struct GCObject *o) { 325 printobj(G(L), o); 326 } 327 328 329 void lua_printvalue (TValue *v) { 330 switch (ttype(v)) { 331 case LUA_TNUMBER: { 332 char buff[LUA_N2SBUFFSZ]; 333 unsigned len = luaO_tostringbuff(v, buff); 334 buff[len] = '\0'; 335 printf("%s", buff); 336 break; 337 } 338 case LUA_TSTRING: { 339 printf("'%s'", getstr(tsvalue(v))); 340 break; 341 } 342 case LUA_TBOOLEAN: { 343 printf("%s", (!l_isfalse(v) ? "true" : "false")); 344 break; 345 } 346 case LUA_TLIGHTUSERDATA: { 347 printf("light udata: %p", pvalue(v)); 348 break; 349 } 350 case LUA_TNIL: { 351 printf("nil"); 352 break; 353 } 354 default: { 355 if (ttislcf(v)) 356 printf("light C function: %p", fvalue(v)); 357 else /* must be collectable */ 358 printf("%s: %p", ttypename(ttype(v)), gcvalue(v)); 359 break; 360 } 361 } 362 } 363 364 365 static int testobjref (global_State *g, GCObject *f, GCObject *t) { 366 int r1 = testobjref1(g, f, t); 367 if (!r1) { 368 printf("%d(%02X) - ", g->gcstate, g->currentwhite); 369 printobj(g, f); 370 printf(" -> "); 371 printobj(g, t); 372 printf("\n"); 373 } 374 return r1; 375 } 376 377 378 static void checkobjref (global_State *g, GCObject *f, GCObject *t) { 379 assert(testobjref(g, f, t)); 380 } 381 382 383 /* 384 ** Version where 't' can be NULL. In that case, it should not apply the 385 ** macro 'obj2gco' over the object. ('t' may have several types, so this 386 ** definition must be a macro.) Most checks need this version, because 387 ** the check may run while an object is still being created. 388 */ 389 #define checkobjrefN(g,f,t) { if (t) checkobjref(g,f,obj2gco(t)); } 390 391 392 static void checkvalref (global_State *g, GCObject *f, const TValue *t) { 393 assert(!iscollectable(t) || (righttt(t) && testobjref(g, f, gcvalue(t)))); 394 } 395 396 397 static void checktable (global_State *g, Table *h) { 398 unsigned int i; 399 unsigned int asize = h->asize; 400 Node *n, *limit = gnode(h, sizenode(h)); 401 GCObject *hgc = obj2gco(h); 402 checkobjrefN(g, hgc, h->metatable); 403 for (i = 0; i < asize; i++) { 404 TValue aux; 405 arr2obj(h, i, &aux); 406 checkvalref(g, hgc, &aux); 407 } 408 for (n = gnode(h, 0); n < limit; n++) { 409 if (!isempty(gval(n))) { 410 TValue k; 411 getnodekey(mainthread(g), &k, n); 412 assert(!keyisnil(n)); 413 checkvalref(g, hgc, &k); 414 checkvalref(g, hgc, gval(n)); 415 } 416 } 417 } 418 419 420 static void checkudata (global_State *g, Udata *u) { 421 int i; 422 GCObject *hgc = obj2gco(u); 423 checkobjrefN(g, hgc, u->metatable); 424 for (i = 0; i < u->nuvalue; i++) 425 checkvalref(g, hgc, &u->uv[i].uv); 426 } 427 428 429 static void checkproto (global_State *g, Proto *f) { 430 int i; 431 GCObject *fgc = obj2gco(f); 432 checkobjrefN(g, fgc, f->source); 433 for (i=0; i<f->sizek; i++) { 434 if (iscollectable(f->k + i)) 435 checkobjref(g, fgc, gcvalue(f->k + i)); 436 } 437 for (i=0; i<f->sizeupvalues; i++) 438 checkobjrefN(g, fgc, f->upvalues[i].name); 439 for (i=0; i<f->sizep; i++) 440 checkobjrefN(g, fgc, f->p[i]); 441 for (i=0; i<f->sizelocvars; i++) 442 checkobjrefN(g, fgc, f->locvars[i].varname); 443 } 444 445 446 static void checkCclosure (global_State *g, CClosure *cl) { 447 GCObject *clgc = obj2gco(cl); 448 int i; 449 for (i = 0; i < cl->nupvalues; i++) 450 checkvalref(g, clgc, &cl->upvalue[i]); 451 } 452 453 454 static void checkLclosure (global_State *g, LClosure *cl) { 455 GCObject *clgc = obj2gco(cl); 456 int i; 457 checkobjrefN(g, clgc, cl->p); 458 for (i=0; i<cl->nupvalues; i++) { 459 UpVal *uv = cl->upvals[i]; 460 if (uv) { 461 checkobjrefN(g, clgc, uv); 462 if (!upisopen(uv)) 463 checkvalref(g, obj2gco(uv), uv->v.p); 464 } 465 } 466 } 467 468 469 static int lua_checkpc (CallInfo *ci) { 470 if (!isLua(ci)) return 1; 471 else { 472 StkId f = ci->func.p; 473 Proto *p = clLvalue(s2v(f))->p; 474 return p->code <= ci->u.l.savedpc && 475 ci->u.l.savedpc <= p->code + p->sizecode; 476 } 477 } 478 479 480 static void checkstack (global_State *g, lua_State *L1) { 481 StkId o; 482 CallInfo *ci; 483 UpVal *uv; 484 assert(!isdead(g, L1)); 485 if (L1->stack.p == NULL) { /* incomplete thread? */ 486 assert(L1->openupval == NULL && L1->ci == NULL); 487 return; 488 } 489 for (uv = L1->openupval; uv != NULL; uv = uv->u.open.next) 490 assert(upisopen(uv)); /* must be open */ 491 assert(L1->top.p <= L1->stack_last.p); 492 assert(L1->tbclist.p <= L1->top.p); 493 for (ci = L1->ci; ci != NULL; ci = ci->previous) { 494 assert(ci->top.p <= L1->stack_last.p); 495 assert(lua_checkpc(ci)); 496 } 497 for (o = L1->stack.p; o < L1->stack_last.p; o++) 498 checkliveness(L1, s2v(o)); /* entire stack must have valid values */ 499 } 500 501 502 static void checkrefs (global_State *g, GCObject *o) { 503 switch (o->tt) { 504 case LUA_VUSERDATA: { 505 checkudata(g, gco2u(o)); 506 break; 507 } 508 case LUA_VUPVAL: { 509 checkvalref(g, o, gco2upv(o)->v.p); 510 break; 511 } 512 case LUA_VTABLE: { 513 checktable(g, gco2t(o)); 514 break; 515 } 516 case LUA_VTHREAD: { 517 checkstack(g, gco2th(o)); 518 break; 519 } 520 case LUA_VLCL: { 521 checkLclosure(g, gco2lcl(o)); 522 break; 523 } 524 case LUA_VCCL: { 525 checkCclosure(g, gco2ccl(o)); 526 break; 527 } 528 case LUA_VPROTO: { 529 checkproto(g, gco2p(o)); 530 break; 531 } 532 case LUA_VSHRSTR: 533 case LUA_VLNGSTR: { 534 assert(!isgray(o)); /* strings are never gray */ 535 break; 536 } 537 default: assert(0); 538 } 539 } 540 541 542 /* 543 ** Check consistency of an object: 544 ** - Dead objects can only happen in the 'allgc' list during a sweep 545 ** phase (controlled by the caller through 'maybedead'). 546 ** - During pause, all objects must be white. 547 ** - In generational mode: 548 ** * objects must be old enough for their lists ('listage'). 549 ** * old objects cannot be white. 550 ** * old objects must be black, except for 'touched1', 'old0', 551 ** threads, and open upvalues. 552 ** * 'touched1' objects must be gray. 553 */ 554 static void checkobject (global_State *g, GCObject *o, int maybedead, 555 int listage) { 556 if (isdead(g, o)) 557 assert(maybedead); 558 else { 559 assert(g->gcstate != GCSpause || iswhite(o)); 560 if (g->gckind == KGC_GENMINOR) { /* generational mode? */ 561 assert(getage(o) >= listage); 562 if (isold(o)) { 563 assert(!iswhite(o)); 564 assert(isblack(o) || 565 getage(o) == G_TOUCHED1 || 566 getage(o) == G_OLD0 || 567 o->tt == LUA_VTHREAD || 568 (o->tt == LUA_VUPVAL && upisopen(gco2upv(o)))); 569 } 570 assert(getage(o) != G_TOUCHED1 || isgray(o)); 571 } 572 checkrefs(g, o); 573 } 574 } 575 576 577 static l_mem checkgraylist (global_State *g, GCObject *o) { 578 int total = 0; /* count number of elements in the list */ 579 cast_void(g); /* better to keep it if we need to print an object */ 580 while (o) { 581 assert(!!isgray(o) ^ (getage(o) == G_TOUCHED2)); 582 assert(!testbit(o->marked, TESTBIT)); 583 if (keepinvariant(g)) 584 l_setbit(o->marked, TESTBIT); /* mark that object is in a gray list */ 585 total++; 586 switch (o->tt) { 587 case LUA_VTABLE: o = gco2t(o)->gclist; break; 588 case LUA_VLCL: o = gco2lcl(o)->gclist; break; 589 case LUA_VCCL: o = gco2ccl(o)->gclist; break; 590 case LUA_VTHREAD: o = gco2th(o)->gclist; break; 591 case LUA_VPROTO: o = gco2p(o)->gclist; break; 592 case LUA_VUSERDATA: 593 assert(gco2u(o)->nuvalue > 0); 594 o = gco2u(o)->gclist; 595 break; 596 default: assert(0); /* other objects cannot be in a gray list */ 597 } 598 } 599 return total; 600 } 601 602 603 /* 604 ** Check objects in gray lists. 605 */ 606 static l_mem checkgrays (global_State *g) { 607 l_mem total = 0; /* count number of elements in all lists */ 608 if (!keepinvariant(g)) return total; 609 total += checkgraylist(g, g->gray); 610 total += checkgraylist(g, g->grayagain); 611 total += checkgraylist(g, g->weak); 612 total += checkgraylist(g, g->allweak); 613 total += checkgraylist(g, g->ephemeron); 614 return total; 615 } 616 617 618 /* 619 ** Check whether 'o' should be in a gray list. If so, increment 620 ** 'count' and check its TESTBIT. (It must have been previously set by 621 ** 'checkgraylist'.) 622 */ 623 static void incifingray (global_State *g, GCObject *o, l_mem *count) { 624 if (!keepinvariant(g)) 625 return; /* gray lists not being kept in these phases */ 626 if (o->tt == LUA_VUPVAL) { 627 /* only open upvalues can be gray */ 628 assert(!isgray(o) || upisopen(gco2upv(o))); 629 return; /* upvalues are never in gray lists */ 630 } 631 /* these are the ones that must be in gray lists */ 632 if (isgray(o) || getage(o) == G_TOUCHED2) { 633 (*count)++; 634 assert(testbit(o->marked, TESTBIT)); 635 resetbit(o->marked, TESTBIT); /* prepare for next cycle */ 636 } 637 } 638 639 640 static l_mem checklist (global_State *g, int maybedead, int tof, 641 GCObject *newl, GCObject *survival, GCObject *old, GCObject *reallyold) { 642 GCObject *o; 643 l_mem total = 0; /* number of object that should be in gray lists */ 644 for (o = newl; o != survival; o = o->next) { 645 checkobject(g, o, maybedead, G_NEW); 646 incifingray(g, o, &total); 647 assert(!tof == !tofinalize(o)); 648 } 649 for (o = survival; o != old; o = o->next) { 650 checkobject(g, o, 0, G_SURVIVAL); 651 incifingray(g, o, &total); 652 assert(!tof == !tofinalize(o)); 653 } 654 for (o = old; o != reallyold; o = o->next) { 655 checkobject(g, o, 0, G_OLD1); 656 incifingray(g, o, &total); 657 assert(!tof == !tofinalize(o)); 658 } 659 for (o = reallyold; o != NULL; o = o->next) { 660 checkobject(g, o, 0, G_OLD); 661 incifingray(g, o, &total); 662 assert(!tof == !tofinalize(o)); 663 } 664 return total; 665 } 666 667 668 int lua_checkmemory (lua_State *L) { 669 global_State *g = G(L); 670 GCObject *o; 671 int maybedead; 672 l_mem totalin; /* total of objects that are in gray lists */ 673 l_mem totalshould; /* total of objects that should be in gray lists */ 674 if (keepinvariant(g)) { 675 assert(!iswhite(mainthread(g))); 676 assert(!iswhite(gcvalue(&g->l_registry))); 677 } 678 assert(!isdead(g, gcvalue(&g->l_registry))); 679 assert(g->sweepgc == NULL || issweepphase(g)); 680 totalin = checkgrays(g); 681 682 /* check 'fixedgc' list */ 683 for (o = g->fixedgc; o != NULL; o = o->next) { 684 assert(o->tt == LUA_VSHRSTR && isgray(o) && getage(o) == G_OLD); 685 } 686 687 /* check 'allgc' list */ 688 maybedead = (GCSatomic < g->gcstate && g->gcstate <= GCSswpallgc); 689 totalshould = checklist(g, maybedead, 0, g->allgc, 690 g->survival, g->old1, g->reallyold); 691 692 /* check 'finobj' list */ 693 totalshould += checklist(g, 0, 1, g->finobj, 694 g->finobjsur, g->finobjold1, g->finobjrold); 695 696 /* check 'tobefnz' list */ 697 for (o = g->tobefnz; o != NULL; o = o->next) { 698 checkobject(g, o, 0, G_NEW); 699 incifingray(g, o, &totalshould); 700 assert(tofinalize(o)); 701 assert(o->tt == LUA_VUSERDATA || o->tt == LUA_VTABLE); 702 } 703 if (keepinvariant(g)) 704 assert(totalin == totalshould); 705 return 0; 706 } 707 708 /* }====================================================== */ 709 710 711 712 /* 713 ** {====================================================== 714 ** Disassembler 715 ** ======================================================= 716 */ 717 718 719 static char *buildop (Proto *p, int pc, char *buff) { 720 char *obuff = buff; 721 Instruction i = p->code[pc]; 722 OpCode o = GET_OPCODE(i); 723 const char *name = opnames[o]; 724 int line = luaG_getfuncline(p, pc); 725 int lineinfo = (p->lineinfo != NULL) ? p->lineinfo[pc] : 0; 726 if (lineinfo == ABSLINEINFO) 727 buff += sprintf(buff, "(__"); 728 else 729 buff += sprintf(buff, "(%2d", lineinfo); 730 buff += sprintf(buff, " - %4d) %4d - ", line, pc); 731 switch (getOpMode(o)) { 732 case iABC: 733 sprintf(buff, "%-12s%4d %4d %4d%s", name, 734 GETARG_A(i), GETARG_B(i), GETARG_C(i), 735 GETARG_k(i) ? " (k)" : ""); 736 break; 737 case ivABC: 738 sprintf(buff, "%-12s%4d %4d %4d%s", name, 739 GETARG_A(i), GETARG_vB(i), GETARG_vC(i), 740 GETARG_k(i) ? " (k)" : ""); 741 break; 742 case iABx: 743 sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i)); 744 break; 745 case iAsBx: 746 sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(i)); 747 break; 748 case iAx: 749 sprintf(buff, "%-12s%4d", name, GETARG_Ax(i)); 750 break; 751 case isJ: 752 sprintf(buff, "%-12s%4d", name, GETARG_sJ(i)); 753 break; 754 } 755 return obuff; 756 } 757 758 759 #if 0 760 void luaI_printcode (Proto *pt, int size) { 761 int pc; 762 for (pc=0; pc<size; pc++) { 763 char buff[100]; 764 printf("%s\n", buildop(pt, pc, buff)); 765 } 766 printf("-------\n"); 767 } 768 769 770 void luaI_printinst (Proto *pt, int pc) { 771 char buff[100]; 772 printf("%s\n", buildop(pt, pc, buff)); 773 } 774 #endif 775 776 777 static int listcode (lua_State *L) { 778 int pc; 779 Proto *p; 780 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 781 1, "Lua function expected"); 782 p = getproto(obj_at(L, 1)); 783 lua_newtable(L); 784 setnameval(L, "maxstack", p->maxstacksize); 785 setnameval(L, "numparams", p->numparams); 786 for (pc=0; pc<p->sizecode; pc++) { 787 char buff[100]; 788 lua_pushinteger(L, pc+1); 789 lua_pushstring(L, buildop(p, pc, buff)); 790 lua_settable(L, -3); 791 } 792 return 1; 793 } 794 795 796 static int printcode (lua_State *L) { 797 int pc; 798 Proto *p; 799 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 800 1, "Lua function expected"); 801 p = getproto(obj_at(L, 1)); 802 printf("maxstack: %d\n", p->maxstacksize); 803 printf("numparams: %d\n", p->numparams); 804 for (pc=0; pc<p->sizecode; pc++) { 805 char buff[100]; 806 printf("%s\n", buildop(p, pc, buff)); 807 } 808 return 0; 809 } 810 811 812 static int listk (lua_State *L) { 813 Proto *p; 814 int i; 815 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 816 1, "Lua function expected"); 817 p = getproto(obj_at(L, 1)); 818 lua_createtable(L, p->sizek, 0); 819 for (i=0; i<p->sizek; i++) { 820 pushobject(L, p->k+i); 821 lua_rawseti(L, -2, i+1); 822 } 823 return 1; 824 } 825 826 827 static int listabslineinfo (lua_State *L) { 828 Proto *p; 829 int i; 830 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 831 1, "Lua function expected"); 832 p = getproto(obj_at(L, 1)); 833 luaL_argcheck(L, p->abslineinfo != NULL, 1, "function has no debug info"); 834 lua_createtable(L, 2 * p->sizeabslineinfo, 0); 835 for (i=0; i < p->sizeabslineinfo; i++) { 836 lua_pushinteger(L, p->abslineinfo[i].pc); 837 lua_rawseti(L, -2, 2 * i + 1); 838 lua_pushinteger(L, p->abslineinfo[i].line); 839 lua_rawseti(L, -2, 2 * i + 2); 840 } 841 return 1; 842 } 843 844 845 static int listlocals (lua_State *L) { 846 Proto *p; 847 int pc = cast_int(luaL_checkinteger(L, 2)) - 1; 848 int i = 0; 849 const char *name; 850 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 851 1, "Lua function expected"); 852 p = getproto(obj_at(L, 1)); 853 while ((name = luaF_getlocalname(p, ++i, pc)) != NULL) 854 lua_pushstring(L, name); 855 return i-1; 856 } 857 858 /* }====================================================== */ 859 860 861 862 void lua_printstack (lua_State *L) { 863 int i; 864 int n = lua_gettop(L); 865 printf("stack: >>\n"); 866 for (i = 1; i <= n; i++) { 867 printf("%3d: ", i); 868 lua_printvalue(s2v(L->ci->func.p + i)); 869 printf("\n"); 870 } 871 printf("<<\n"); 872 } 873 874 875 static int get_limits (lua_State *L) { 876 lua_createtable(L, 0, 5); 877 setnameval(L, "IS32INT", LUAI_IS32INT); 878 setnameval(L, "MAXARG_Ax", MAXARG_Ax); 879 setnameval(L, "MAXARG_Bx", MAXARG_Bx); 880 setnameval(L, "OFFSET_sBx", OFFSET_sBx); 881 setnameval(L, "NUM_OPCODES", NUM_OPCODES); 882 return 1; 883 } 884 885 886 static int mem_query (lua_State *L) { 887 if (lua_isnone(L, 1)) { 888 lua_pushinteger(L, cast(lua_Integer, l_memcontrol.total)); 889 lua_pushinteger(L, cast(lua_Integer, l_memcontrol.numblocks)); 890 lua_pushinteger(L, cast(lua_Integer, l_memcontrol.maxmem)); 891 return 3; 892 } 893 else if (lua_isnumber(L, 1)) { 894 unsigned long limit = cast(unsigned long, luaL_checkinteger(L, 1)); 895 if (limit == 0) limit = ULONG_MAX; 896 l_memcontrol.memlimit = limit; 897 return 0; 898 } 899 else { 900 const char *t = luaL_checkstring(L, 1); 901 int i; 902 for (i = LUA_NUMTYPES - 1; i >= 0; i--) { 903 if (strcmp(t, ttypename(i)) == 0) { 904 lua_pushinteger(L, cast(lua_Integer, l_memcontrol.objcount[i])); 905 return 1; 906 } 907 } 908 return luaL_error(L, "unknown type '%s'", t); 909 } 910 } 911 912 913 static int alloc_count (lua_State *L) { 914 if (lua_isnone(L, 1)) 915 l_memcontrol.countlimit = cast(unsigned long, ~0L); 916 else 917 l_memcontrol.countlimit = cast(unsigned long, luaL_checkinteger(L, 1)); 918 return 0; 919 } 920 921 922 static int alloc_failnext (lua_State *L) { 923 UNUSED(L); 924 l_memcontrol.failnext = 1; 925 return 0; 926 } 927 928 929 static int settrick (lua_State *L) { 930 if (ttisnil(obj_at(L, 1))) 931 l_Trick = NULL; 932 else 933 l_Trick = gcvalue(obj_at(L, 1)); 934 return 0; 935 } 936 937 938 static int gc_color (lua_State *L) { 939 TValue *o; 940 luaL_checkany(L, 1); 941 o = obj_at(L, 1); 942 if (!iscollectable(o)) 943 lua_pushstring(L, "no collectable"); 944 else { 945 GCObject *obj = gcvalue(o); 946 lua_pushstring(L, isdead(G(L), obj) ? "dead" : 947 iswhite(obj) ? "white" : 948 isblack(obj) ? "black" : "gray"); 949 } 950 return 1; 951 } 952 953 954 static int gc_age (lua_State *L) { 955 TValue *o; 956 luaL_checkany(L, 1); 957 o = obj_at(L, 1); 958 if (!iscollectable(o)) 959 lua_pushstring(L, "no collectable"); 960 else { 961 static const char *gennames[] = {"new", "survival", "old0", "old1", 962 "old", "touched1", "touched2"}; 963 GCObject *obj = gcvalue(o); 964 lua_pushstring(L, gennames[getage(obj)]); 965 } 966 return 1; 967 } 968 969 970 static int gc_printobj (lua_State *L) { 971 TValue *o; 972 luaL_checkany(L, 1); 973 o = obj_at(L, 1); 974 if (!iscollectable(o)) 975 printf("no collectable\n"); 976 else { 977 GCObject *obj = gcvalue(o); 978 printobj(G(L), obj); 979 printf("\n"); 980 } 981 return 0; 982 } 983 984 985 static const char *statenames[] = { 986 "propagate", "enteratomic", "atomic", "sweepallgc", "sweepfinobj", 987 "sweeptobefnz", "sweepend", "callfin", "pause", ""}; 988 989 static int gc_state (lua_State *L) { 990 static const int states[] = { 991 GCSpropagate, GCSenteratomic, GCSatomic, GCSswpallgc, GCSswpfinobj, 992 GCSswptobefnz, GCSswpend, GCScallfin, GCSpause, -1}; 993 int option = states[luaL_checkoption(L, 1, "", statenames)]; 994 global_State *g = G(L); 995 if (option == -1) { 996 lua_pushstring(L, statenames[g->gcstate]); 997 return 1; 998 } 999 else { 1000 if (g->gckind != KGC_INC) 1001 luaL_error(L, "cannot change states in generational mode"); 1002 lua_lock(L); 1003 if (option < g->gcstate) { /* must cross 'pause'? */ 1004 luaC_runtilstate(L, GCSpause, 1); /* run until pause */ 1005 } 1006 luaC_runtilstate(L, option, 0); /* do not skip propagation state */ 1007 lua_assert(g->gcstate == option); 1008 lua_unlock(L); 1009 return 0; 1010 } 1011 } 1012 1013 1014 static int tracinggc = 0; 1015 void luai_tracegctest (lua_State *L, int first) { 1016 if (!tracinggc) return; 1017 else { 1018 global_State *g = G(L); 1019 lua_unlock(L); 1020 g->gcstp = GCSTPGC; 1021 lua_checkstack(L, 10); 1022 lua_getfield(L, LUA_REGISTRYINDEX, "tracegc"); 1023 lua_pushboolean(L, first); 1024 lua_call(L, 1, 0); 1025 g->gcstp = 0; 1026 lua_lock(L); 1027 } 1028 } 1029 1030 1031 static int tracegc (lua_State *L) { 1032 if (lua_isnil(L, 1)) 1033 tracinggc = 0; 1034 else { 1035 tracinggc = 1; 1036 lua_setfield(L, LUA_REGISTRYINDEX, "tracegc"); 1037 } 1038 return 0; 1039 } 1040 1041 1042 static int hash_query (lua_State *L) { 1043 if (lua_isnone(L, 2)) { 1044 luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected"); 1045 lua_pushinteger(L, cast_int(tsvalue(obj_at(L, 1))->hash)); 1046 } 1047 else { 1048 TValue *o = obj_at(L, 1); 1049 Table *t; 1050 luaL_checktype(L, 2, LUA_TTABLE); 1051 t = hvalue(obj_at(L, 2)); 1052 lua_pushinteger(L, cast(lua_Integer, luaH_mainposition(t, o) - t->node)); 1053 } 1054 return 1; 1055 } 1056 1057 1058 static int stacklevel (lua_State *L) { 1059 int a = 0; 1060 lua_pushinteger(L, cast(lua_Integer, L->top.p - L->stack.p)); 1061 lua_pushinteger(L, stacksize(L)); 1062 lua_pushinteger(L, cast(lua_Integer, L->nCcalls)); 1063 lua_pushinteger(L, L->nci); 1064 lua_pushinteger(L, (lua_Integer)(size_t)&a); 1065 return 5; 1066 } 1067 1068 1069 static int table_query (lua_State *L) { 1070 const Table *t; 1071 int i = cast_int(luaL_optinteger(L, 2, -1)); 1072 unsigned int asize; 1073 luaL_checktype(L, 1, LUA_TTABLE); 1074 t = hvalue(obj_at(L, 1)); 1075 asize = t->asize; 1076 if (i == -1) { 1077 lua_pushinteger(L, cast(lua_Integer, asize)); 1078 lua_pushinteger(L, cast(lua_Integer, allocsizenode(t))); 1079 lua_pushinteger(L, cast(lua_Integer, asize > 0 ? *lenhint(t) : 0)); 1080 return 3; 1081 } 1082 else if (cast_uint(i) < asize) { 1083 lua_pushinteger(L, i); 1084 if (!tagisempty(*getArrTag(t, i))) 1085 arr2obj(t, cast_uint(i), s2v(L->top.p)); 1086 else 1087 setnilvalue(s2v(L->top.p)); 1088 api_incr_top(L); 1089 lua_pushnil(L); 1090 } 1091 else if (cast_uint(i -= cast_int(asize)) < sizenode(t)) { 1092 TValue k; 1093 getnodekey(L, &k, gnode(t, i)); 1094 if (!isempty(gval(gnode(t, i))) || 1095 ttisnil(&k) || 1096 ttisnumber(&k)) { 1097 pushobject(L, &k); 1098 } 1099 else 1100 lua_pushliteral(L, "<undef>"); 1101 if (!isempty(gval(gnode(t, i)))) 1102 pushobject(L, gval(gnode(t, i))); 1103 else 1104 lua_pushnil(L); 1105 lua_pushinteger(L, gnext(&t->node[i])); 1106 } 1107 return 3; 1108 } 1109 1110 1111 static int gc_query (lua_State *L) { 1112 global_State *g = G(L); 1113 lua_pushstring(L, g->gckind == KGC_INC ? "inc" 1114 : g->gckind == KGC_GENMAJOR ? "genmajor" 1115 : "genminor"); 1116 lua_pushstring(L, statenames[g->gcstate]); 1117 lua_pushinteger(L, cast_st2S(gettotalbytes(g))); 1118 lua_pushinteger(L, cast_st2S(g->GCdebt)); 1119 lua_pushinteger(L, cast_st2S(g->GCmarked)); 1120 lua_pushinteger(L, cast_st2S(g->GCmajorminor)); 1121 return 6; 1122 } 1123 1124 1125 static int test_codeparam (lua_State *L) { 1126 lua_Integer p = luaL_checkinteger(L, 1); 1127 lua_pushinteger(L, luaO_codeparam(cast_uint(p))); 1128 return 1; 1129 } 1130 1131 1132 static int test_applyparam (lua_State *L) { 1133 lua_Integer p = luaL_checkinteger(L, 1); 1134 lua_Integer x = luaL_checkinteger(L, 2); 1135 lua_pushinteger(L, cast(lua_Integer, luaO_applyparam(cast_byte(p), x))); 1136 return 1; 1137 } 1138 1139 1140 static int string_query (lua_State *L) { 1141 stringtable *tb = &G(L)->strt; 1142 int s = cast_int(luaL_optinteger(L, 1, 0)) - 1; 1143 if (s == -1) { 1144 lua_pushinteger(L ,tb->size); 1145 lua_pushinteger(L ,tb->nuse); 1146 return 2; 1147 } 1148 else if (s < tb->size) { 1149 TString *ts; 1150 int n = 0; 1151 for (ts = tb->hash[s]; ts != NULL; ts = ts->u.hnext) { 1152 setsvalue2s(L, L->top.p, ts); 1153 api_incr_top(L); 1154 n++; 1155 } 1156 return n; 1157 } 1158 else return 0; 1159 } 1160 1161 1162 static int getreftable (lua_State *L) { 1163 if (lua_istable(L, 2)) /* is there a table as second argument? */ 1164 return 2; /* use it as the table */ 1165 else 1166 return LUA_REGISTRYINDEX; /* default is to use the register */ 1167 } 1168 1169 1170 static int tref (lua_State *L) { 1171 int t = getreftable(L); 1172 int level = lua_gettop(L); 1173 luaL_checkany(L, 1); 1174 lua_pushvalue(L, 1); 1175 lua_pushinteger(L, luaL_ref(L, t)); 1176 cast_void(level); /* to avoid warnings */ 1177 lua_assert(lua_gettop(L) == level+1); /* +1 for result */ 1178 return 1; 1179 } 1180 1181 1182 static int getref (lua_State *L) { 1183 int t = getreftable(L); 1184 int level = lua_gettop(L); 1185 lua_rawgeti(L, t, luaL_checkinteger(L, 1)); 1186 cast_void(level); /* to avoid warnings */ 1187 lua_assert(lua_gettop(L) == level+1); 1188 return 1; 1189 } 1190 1191 static int unref (lua_State *L) { 1192 int t = getreftable(L); 1193 int level = lua_gettop(L); 1194 luaL_unref(L, t, cast_int(luaL_checkinteger(L, 1))); 1195 cast_void(level); /* to avoid warnings */ 1196 lua_assert(lua_gettop(L) == level); 1197 return 0; 1198 } 1199 1200 1201 static int upvalue (lua_State *L) { 1202 int n = cast_int(luaL_checkinteger(L, 2)); 1203 luaL_checktype(L, 1, LUA_TFUNCTION); 1204 if (lua_isnone(L, 3)) { 1205 const char *name = lua_getupvalue(L, 1, n); 1206 if (name == NULL) return 0; 1207 lua_pushstring(L, name); 1208 return 2; 1209 } 1210 else { 1211 const char *name = lua_setupvalue(L, 1, n); 1212 lua_pushstring(L, name); 1213 return 1; 1214 } 1215 } 1216 1217 1218 static int newuserdata (lua_State *L) { 1219 size_t size = cast_sizet(luaL_optinteger(L, 1, 0)); 1220 int nuv = cast_int(luaL_optinteger(L, 2, 0)); 1221 char *p = cast_charp(lua_newuserdatauv(L, size, nuv)); 1222 while (size--) *p++ = '\0'; 1223 return 1; 1224 } 1225 1226 1227 static int pushuserdata (lua_State *L) { 1228 lua_Integer u = luaL_checkinteger(L, 1); 1229 lua_pushlightuserdata(L, cast_voidp(cast_sizet(u))); 1230 return 1; 1231 } 1232 1233 1234 static int udataval (lua_State *L) { 1235 lua_pushinteger(L, cast(lua_Integer, cast(size_t, lua_touserdata(L, 1)))); 1236 return 1; 1237 } 1238 1239 1240 static int doonnewstack (lua_State *L) { 1241 lua_State *L1 = lua_newthread(L); 1242 size_t l; 1243 const char *s = luaL_checklstring(L, 1, &l); 1244 int status = luaL_loadbuffer(L1, s, l, s); 1245 if (status == LUA_OK) 1246 status = lua_pcall(L1, 0, 0, 0); 1247 lua_pushinteger(L, status); 1248 return 1; 1249 } 1250 1251 1252 static int s2d (lua_State *L) { 1253 lua_pushnumber(L, cast_num(*cast(const double *, luaL_checkstring(L, 1)))); 1254 return 1; 1255 } 1256 1257 1258 static int d2s (lua_State *L) { 1259 double d = cast(double, luaL_checknumber(L, 1)); 1260 lua_pushlstring(L, cast_charp(&d), sizeof(d)); 1261 return 1; 1262 } 1263 1264 1265 static int num2int (lua_State *L) { 1266 lua_pushinteger(L, lua_tointeger(L, 1)); 1267 return 1; 1268 } 1269 1270 1271 static int makeseed (lua_State *L) { 1272 lua_pushinteger(L, cast(lua_Integer, luaL_makeseed(L))); 1273 return 1; 1274 } 1275 1276 1277 static int newstate (lua_State *L) { 1278 void *ud; 1279 lua_Alloc f = lua_getallocf(L, &ud); 1280 lua_State *L1 = lua_newstate(f, ud, 0); 1281 if (L1) { 1282 lua_atpanic(L1, tpanic); 1283 lua_pushlightuserdata(L, L1); 1284 } 1285 else 1286 lua_pushnil(L); 1287 return 1; 1288 } 1289 1290 1291 static lua_State *getstate (lua_State *L) { 1292 lua_State *L1 = cast(lua_State *, lua_touserdata(L, 1)); 1293 luaL_argcheck(L, L1 != NULL, 1, "state expected"); 1294 return L1; 1295 } 1296 1297 1298 static int loadlib (lua_State *L) { 1299 lua_State *L1 = getstate(L); 1300 int load = cast_int(luaL_checkinteger(L, 2)); 1301 int preload = cast_int(luaL_checkinteger(L, 3)); 1302 luaL_openselectedlibs(L1, load, preload); 1303 luaL_requiref(L1, "T", luaB_opentests, 0); 1304 lua_assert(lua_type(L1, -1) == LUA_TTABLE); 1305 /* 'requiref' should not reload module already loaded... */ 1306 luaL_requiref(L1, "T", NULL, 1); /* seg. fault if it reloads */ 1307 /* ...but should return the same module */ 1308 lua_assert(lua_compare(L1, -1, -2, LUA_OPEQ)); 1309 return 0; 1310 } 1311 1312 static int closestate (lua_State *L) { 1313 lua_State *L1 = getstate(L); 1314 lua_close(L1); 1315 return 0; 1316 } 1317 1318 static int doremote (lua_State *L) { 1319 lua_State *L1 = getstate(L); 1320 size_t lcode; 1321 const char *code = luaL_checklstring(L, 2, &lcode); 1322 int status; 1323 lua_settop(L1, 0); 1324 status = luaL_loadbuffer(L1, code, lcode, code); 1325 if (status == LUA_OK) 1326 status = lua_pcall(L1, 0, LUA_MULTRET, 0); 1327 if (status != LUA_OK) { 1328 lua_pushnil(L); 1329 lua_pushstring(L, lua_tostring(L1, -1)); 1330 lua_pushinteger(L, status); 1331 return 3; 1332 } 1333 else { 1334 int i = 0; 1335 while (!lua_isnone(L1, ++i)) 1336 lua_pushstring(L, lua_tostring(L1, i)); 1337 lua_pop(L1, i-1); 1338 return i-1; 1339 } 1340 } 1341 1342 1343 static int log2_aux (lua_State *L) { 1344 unsigned int x = (unsigned int)luaL_checkinteger(L, 1); 1345 lua_pushinteger(L, luaO_ceillog2(x)); 1346 return 1; 1347 } 1348 1349 1350 struct Aux { jmp_buf jb; const char *paniccode; lua_State *L; }; 1351 1352 /* 1353 ** does a long-jump back to "main program". 1354 */ 1355 static int panicback (lua_State *L) { 1356 struct Aux *b; 1357 lua_checkstack(L, 1); /* open space for 'Aux' struct */ 1358 lua_getfield(L, LUA_REGISTRYINDEX, "_jmpbuf"); /* get 'Aux' struct */ 1359 b = (struct Aux *)lua_touserdata(L, -1); 1360 lua_pop(L, 1); /* remove 'Aux' struct */ 1361 runC(b->L, L, b->paniccode); /* run optional panic code */ 1362 longjmp(b->jb, 1); 1363 return 1; /* to avoid warnings */ 1364 } 1365 1366 static int checkpanic (lua_State *L) { 1367 struct Aux b; 1368 void *ud; 1369 lua_State *L1; 1370 const char *code = luaL_checkstring(L, 1); 1371 lua_Alloc f = lua_getallocf(L, &ud); 1372 b.paniccode = luaL_optstring(L, 2, ""); 1373 b.L = L; 1374 L1 = lua_newstate(f, ud, 0); /* create new state */ 1375 if (L1 == NULL) { /* error? */ 1376 lua_pushstring(L, MEMERRMSG); 1377 return 1; 1378 } 1379 lua_atpanic(L1, panicback); /* set its panic function */ 1380 lua_pushlightuserdata(L1, &b); 1381 lua_setfield(L1, LUA_REGISTRYINDEX, "_jmpbuf"); /* store 'Aux' struct */ 1382 if (setjmp(b.jb) == 0) { /* set jump buffer */ 1383 runC(L, L1, code); /* run code unprotected */ 1384 lua_pushliteral(L, "no errors"); 1385 } 1386 else { /* error handling */ 1387 /* move error message to original state */ 1388 lua_pushstring(L, lua_tostring(L1, -1)); 1389 } 1390 lua_close(L1); 1391 return 1; 1392 } 1393 1394 1395 static int externKstr (lua_State *L) { 1396 size_t len; 1397 const char *s = luaL_checklstring(L, 1, &len); 1398 lua_pushexternalstring(L, s, len, NULL, NULL); 1399 return 1; 1400 } 1401 1402 1403 /* 1404 ** Create a buffer with the content of a given string and then 1405 ** create an external string using that buffer. Use the allocation 1406 ** function from Lua to create and free the buffer. 1407 */ 1408 static int externstr (lua_State *L) { 1409 size_t len; 1410 const char *s = luaL_checklstring(L, 1, &len); 1411 void *ud; 1412 lua_Alloc allocf = lua_getallocf(L, &ud); /* get allocation function */ 1413 /* create the buffer */ 1414 char *buff = cast_charp((*allocf)(ud, NULL, 0, len + 1)); 1415 if (buff == NULL) { /* memory error? */ 1416 lua_pushliteral(L, "not enough memory"); 1417 lua_error(L); /* raise a memory error */ 1418 } 1419 /* copy string content to buffer, including ending 0 */ 1420 memcpy(buff, s, (len + 1) * sizeof(char)); 1421 /* create external string */ 1422 lua_pushexternalstring(L, buff, len, allocf, ud); 1423 return 1; 1424 } 1425 1426 1427 /* 1428 ** {==================================================================== 1429 ** function to test the API with C. It interprets a kind of assembler 1430 ** language with calls to the API, so the test can be driven by Lua code 1431 ** ===================================================================== 1432 */ 1433 1434 1435 static void sethookaux (lua_State *L, int mask, int count, const char *code); 1436 1437 static const char *const delimits = " \t\n,;"; 1438 1439 static void skip (const char **pc) { 1440 for (;;) { 1441 if (**pc != '\0' && strchr(delimits, **pc)) (*pc)++; 1442 else if (**pc == '#') { /* comment? */ 1443 while (**pc != '\n' && **pc != '\0') (*pc)++; /* until end-of-line */ 1444 } 1445 else break; 1446 } 1447 } 1448 1449 static int getnum_aux (lua_State *L, lua_State *L1, const char **pc) { 1450 int res = 0; 1451 int sig = 1; 1452 skip(pc); 1453 if (**pc == '.') { 1454 res = cast_int(lua_tointeger(L1, -1)); 1455 lua_pop(L1, 1); 1456 (*pc)++; 1457 return res; 1458 } 1459 else if (**pc == '*') { 1460 res = lua_gettop(L1); 1461 (*pc)++; 1462 return res; 1463 } 1464 else if (**pc == '!') { 1465 (*pc)++; 1466 if (**pc == 'G') 1467 res = LUA_RIDX_GLOBALS; 1468 else if (**pc == 'M') 1469 res = LUA_RIDX_MAINTHREAD; 1470 else lua_assert(0); 1471 (*pc)++; 1472 return res; 1473 } 1474 else if (**pc == '-') { 1475 sig = -1; 1476 (*pc)++; 1477 } 1478 if (!lisdigit(cast_uchar(**pc))) 1479 luaL_error(L, "number expected (%s)", *pc); 1480 while (lisdigit(cast_uchar(**pc))) res = res*10 + (*(*pc)++) - '0'; 1481 return sig*res; 1482 } 1483 1484 static const char *getstring_aux (lua_State *L, char *buff, const char **pc) { 1485 int i = 0; 1486 skip(pc); 1487 if (**pc == '"' || **pc == '\'') { /* quoted string? */ 1488 int quote = *(*pc)++; 1489 while (**pc != quote) { 1490 if (**pc == '\0') luaL_error(L, "unfinished string in C script"); 1491 buff[i++] = *(*pc)++; 1492 } 1493 (*pc)++; 1494 } 1495 else { 1496 while (**pc != '\0' && !strchr(delimits, **pc)) 1497 buff[i++] = *(*pc)++; 1498 } 1499 buff[i] = '\0'; 1500 return buff; 1501 } 1502 1503 1504 static int getindex_aux (lua_State *L, lua_State *L1, const char **pc) { 1505 skip(pc); 1506 switch (*(*pc)++) { 1507 case 'R': return LUA_REGISTRYINDEX; 1508 case 'U': return lua_upvalueindex(getnum_aux(L, L1, pc)); 1509 default: { 1510 int n; 1511 (*pc)--; /* to read again */ 1512 n = getnum_aux(L, L1, pc); 1513 if (n == 0) return 0; 1514 else return lua_absindex(L1, n); 1515 } 1516 } 1517 } 1518 1519 1520 static const char *const statcodes[] = {"OK", "YIELD", "ERRRUN", 1521 "ERRSYNTAX", MEMERRMSG, "ERRERR"}; 1522 1523 /* 1524 ** Avoid these stat codes from being collected, to avoid possible 1525 ** memory error when pushing them. 1526 */ 1527 static void regcodes (lua_State *L) { 1528 unsigned int i; 1529 for (i = 0; i < sizeof(statcodes) / sizeof(statcodes[0]); i++) { 1530 lua_pushboolean(L, 1); 1531 lua_setfield(L, LUA_REGISTRYINDEX, statcodes[i]); 1532 } 1533 } 1534 1535 1536 #define EQ(s1) (strcmp(s1, inst) == 0) 1537 1538 #define getnum (getnum_aux(L, L1, &pc)) 1539 #define getstring (getstring_aux(L, buff, &pc)) 1540 #define getindex (getindex_aux(L, L1, &pc)) 1541 1542 1543 static int testC (lua_State *L); 1544 static int Cfunck (lua_State *L, int status, lua_KContext ctx); 1545 1546 /* 1547 ** arithmetic operation encoding for 'arith' instruction 1548 ** LUA_OPIDIV -> \ 1549 ** LUA_OPSHL -> < 1550 ** LUA_OPSHR -> > 1551 ** LUA_OPUNM -> _ 1552 ** LUA_OPBNOT -> ! 1553 */ 1554 static const char ops[] = "+-*%^/\\&|~<>_!"; 1555 1556 static int runC (lua_State *L, lua_State *L1, const char *pc) { 1557 char buff[300]; 1558 int status = 0; 1559 if (pc == NULL) return luaL_error(L, "attempt to runC null script"); 1560 for (;;) { 1561 const char *inst = getstring; 1562 if EQ("") return 0; 1563 else if EQ("absindex") { 1564 lua_pushinteger(L1, getindex); 1565 } 1566 else if EQ("append") { 1567 int t = getindex; 1568 int i = cast_int(lua_rawlen(L1, t)); 1569 lua_rawseti(L1, t, i + 1); 1570 } 1571 else if EQ("arith") { 1572 int op; 1573 skip(&pc); 1574 op = cast_int(strchr(ops, *pc++) - ops); 1575 lua_arith(L1, op); 1576 } 1577 else if EQ("call") { 1578 int narg = getnum; 1579 int nres = getnum; 1580 lua_call(L1, narg, nres); 1581 } 1582 else if EQ("callk") { 1583 int narg = getnum; 1584 int nres = getnum; 1585 int i = getindex; 1586 lua_callk(L1, narg, nres, i, Cfunck); 1587 } 1588 else if EQ("checkstack") { 1589 int sz = getnum; 1590 const char *msg = getstring; 1591 if (*msg == '\0') 1592 msg = NULL; /* to test 'luaL_checkstack' with no message */ 1593 luaL_checkstack(L1, sz, msg); 1594 } 1595 else if EQ("rawcheckstack") { 1596 int sz = getnum; 1597 lua_pushboolean(L1, lua_checkstack(L1, sz)); 1598 } 1599 else if EQ("compare") { 1600 const char *opt = getstring; /* EQ, LT, or LE */ 1601 int op = (opt[0] == 'E') ? LUA_OPEQ 1602 : (opt[1] == 'T') ? LUA_OPLT : LUA_OPLE; 1603 int a = getindex; 1604 int b = getindex; 1605 lua_pushboolean(L1, lua_compare(L1, a, b, op)); 1606 } 1607 else if EQ("concat") { 1608 lua_concat(L1, getnum); 1609 } 1610 else if EQ("copy") { 1611 int f = getindex; 1612 lua_copy(L1, f, getindex); 1613 } 1614 else if EQ("func2num") { 1615 lua_CFunction func = lua_tocfunction(L1, getindex); 1616 lua_pushinteger(L1, cast(lua_Integer, cast(size_t, func))); 1617 } 1618 else if EQ("getfield") { 1619 int t = getindex; 1620 int tp = lua_getfield(L1, t, getstring); 1621 lua_assert(tp == lua_type(L1, -1)); 1622 } 1623 else if EQ("getglobal") { 1624 lua_getglobal(L1, getstring); 1625 } 1626 else if EQ("getmetatable") { 1627 if (lua_getmetatable(L1, getindex) == 0) 1628 lua_pushnil(L1); 1629 } 1630 else if EQ("gettable") { 1631 int tp = lua_gettable(L1, getindex); 1632 lua_assert(tp == lua_type(L1, -1)); 1633 } 1634 else if EQ("gettop") { 1635 lua_pushinteger(L1, lua_gettop(L1)); 1636 } 1637 else if EQ("gsub") { 1638 int a = getnum; int b = getnum; int c = getnum; 1639 luaL_gsub(L1, lua_tostring(L1, a), 1640 lua_tostring(L1, b), 1641 lua_tostring(L1, c)); 1642 } 1643 else if EQ("insert") { 1644 lua_insert(L1, getnum); 1645 } 1646 else if EQ("iscfunction") { 1647 lua_pushboolean(L1, lua_iscfunction(L1, getindex)); 1648 } 1649 else if EQ("isfunction") { 1650 lua_pushboolean(L1, lua_isfunction(L1, getindex)); 1651 } 1652 else if EQ("isnil") { 1653 lua_pushboolean(L1, lua_isnil(L1, getindex)); 1654 } 1655 else if EQ("isnull") { 1656 lua_pushboolean(L1, lua_isnone(L1, getindex)); 1657 } 1658 else if EQ("isnumber") { 1659 lua_pushboolean(L1, lua_isnumber(L1, getindex)); 1660 } 1661 else if EQ("isstring") { 1662 lua_pushboolean(L1, lua_isstring(L1, getindex)); 1663 } 1664 else if EQ("istable") { 1665 lua_pushboolean(L1, lua_istable(L1, getindex)); 1666 } 1667 else if EQ("isudataval") { 1668 lua_pushboolean(L1, lua_islightuserdata(L1, getindex)); 1669 } 1670 else if EQ("isuserdata") { 1671 lua_pushboolean(L1, lua_isuserdata(L1, getindex)); 1672 } 1673 else if EQ("len") { 1674 lua_len(L1, getindex); 1675 } 1676 else if EQ("Llen") { 1677 lua_pushinteger(L1, luaL_len(L1, getindex)); 1678 } 1679 else if EQ("loadfile") { 1680 luaL_loadfile(L1, luaL_checkstring(L1, getnum)); 1681 } 1682 else if EQ("loadstring") { 1683 size_t slen; 1684 const char *s = luaL_checklstring(L1, getnum, &slen); 1685 const char *name = getstring; 1686 const char *mode = getstring; 1687 luaL_loadbufferx(L1, s, slen, name, mode); 1688 } 1689 else if EQ("newmetatable") { 1690 lua_pushboolean(L1, luaL_newmetatable(L1, getstring)); 1691 } 1692 else if EQ("newtable") { 1693 lua_newtable(L1); 1694 } 1695 else if EQ("newthread") { 1696 lua_newthread(L1); 1697 } 1698 else if EQ("resetthread") { 1699 lua_pushinteger(L1, lua_resetthread(L1)); /* deprecated */ 1700 } 1701 else if EQ("newuserdata") { 1702 lua_newuserdata(L1, cast_sizet(getnum)); 1703 } 1704 else if EQ("next") { 1705 lua_next(L1, -2); 1706 } 1707 else if EQ("objsize") { 1708 lua_pushinteger(L1, l_castU2S(lua_rawlen(L1, getindex))); 1709 } 1710 else if EQ("pcall") { 1711 int narg = getnum; 1712 int nres = getnum; 1713 status = lua_pcall(L1, narg, nres, getnum); 1714 } 1715 else if EQ("pcallk") { 1716 int narg = getnum; 1717 int nres = getnum; 1718 int i = getindex; 1719 status = lua_pcallk(L1, narg, nres, 0, i, Cfunck); 1720 } 1721 else if EQ("pop") { 1722 lua_pop(L1, getnum); 1723 } 1724 else if EQ("printstack") { 1725 int n = getnum; 1726 if (n != 0) { 1727 lua_printvalue(s2v(L->ci->func.p + n)); 1728 printf("\n"); 1729 } 1730 else lua_printstack(L1); 1731 } 1732 else if EQ("print") { 1733 const char *msg = getstring; 1734 printf("%s\n", msg); 1735 } 1736 else if EQ("warningC") { 1737 const char *msg = getstring; 1738 lua_warning(L1, msg, 1); 1739 } 1740 else if EQ("warning") { 1741 const char *msg = getstring; 1742 lua_warning(L1, msg, 0); 1743 } 1744 else if EQ("pushbool") { 1745 lua_pushboolean(L1, getnum); 1746 } 1747 else if EQ("pushcclosure") { 1748 lua_pushcclosure(L1, testC, getnum); 1749 } 1750 else if EQ("pushint") { 1751 lua_pushinteger(L1, getnum); 1752 } 1753 else if EQ("pushnil") { 1754 lua_pushnil(L1); 1755 } 1756 else if EQ("pushnum") { 1757 lua_pushnumber(L1, (lua_Number)getnum); 1758 } 1759 else if EQ("pushstatus") { 1760 lua_pushstring(L1, statcodes[status]); 1761 } 1762 else if EQ("pushstring") { 1763 lua_pushstring(L1, getstring); 1764 } 1765 else if EQ("pushupvalueindex") { 1766 lua_pushinteger(L1, lua_upvalueindex(getnum)); 1767 } 1768 else if EQ("pushvalue") { 1769 lua_pushvalue(L1, getindex); 1770 } 1771 else if EQ("pushfstringI") { 1772 lua_pushfstring(L1, lua_tostring(L, -2), (int)lua_tointeger(L, -1)); 1773 } 1774 else if EQ("pushfstringS") { 1775 lua_pushfstring(L1, lua_tostring(L, -2), lua_tostring(L, -1)); 1776 } 1777 else if EQ("pushfstringP") { 1778 lua_pushfstring(L1, lua_tostring(L, -2), lua_topointer(L, -1)); 1779 } 1780 else if EQ("rawget") { 1781 int t = getindex; 1782 lua_rawget(L1, t); 1783 } 1784 else if EQ("rawgeti") { 1785 int t = getindex; 1786 lua_rawgeti(L1, t, getnum); 1787 } 1788 else if EQ("rawgetp") { 1789 int t = getindex; 1790 lua_rawgetp(L1, t, cast_voidp(cast_sizet(getnum))); 1791 } 1792 else if EQ("rawset") { 1793 int t = getindex; 1794 lua_rawset(L1, t); 1795 } 1796 else if EQ("rawseti") { 1797 int t = getindex; 1798 lua_rawseti(L1, t, getnum); 1799 } 1800 else if EQ("rawsetp") { 1801 int t = getindex; 1802 lua_rawsetp(L1, t, cast_voidp(cast_sizet(getnum))); 1803 } 1804 else if EQ("remove") { 1805 lua_remove(L1, getnum); 1806 } 1807 else if EQ("replace") { 1808 lua_replace(L1, getindex); 1809 } 1810 else if EQ("resume") { 1811 int i = getindex; 1812 int nres; 1813 status = lua_resume(lua_tothread(L1, i), L, getnum, &nres); 1814 } 1815 else if EQ("traceback") { 1816 const char *msg = getstring; 1817 int level = getnum; 1818 luaL_traceback(L1, L1, msg, level); 1819 } 1820 else if EQ("threadstatus") { 1821 lua_pushstring(L1, statcodes[lua_status(L1)]); 1822 } 1823 else if EQ("alloccount") { 1824 l_memcontrol.countlimit = cast_uint(getnum); 1825 } 1826 else if EQ("return") { 1827 int n = getnum; 1828 if (L1 != L) { 1829 int i; 1830 for (i = 0; i < n; i++) { 1831 int idx = -(n - i); 1832 switch (lua_type(L1, idx)) { 1833 case LUA_TBOOLEAN: 1834 lua_pushboolean(L, lua_toboolean(L1, idx)); 1835 break; 1836 default: 1837 lua_pushstring(L, lua_tostring(L1, idx)); 1838 break; 1839 } 1840 } 1841 } 1842 return n; 1843 } 1844 else if EQ("rotate") { 1845 int i = getindex; 1846 lua_rotate(L1, i, getnum); 1847 } 1848 else if EQ("setfield") { 1849 int t = getindex; 1850 const char *s = getstring; 1851 lua_setfield(L1, t, s); 1852 } 1853 else if EQ("seti") { 1854 int t = getindex; 1855 lua_seti(L1, t, getnum); 1856 } 1857 else if EQ("setglobal") { 1858 const char *s = getstring; 1859 lua_setglobal(L1, s); 1860 } 1861 else if EQ("sethook") { 1862 int mask = getnum; 1863 int count = getnum; 1864 const char *s = getstring; 1865 sethookaux(L1, mask, count, s); 1866 } 1867 else if EQ("setmetatable") { 1868 int idx = getindex; 1869 lua_setmetatable(L1, idx); 1870 } 1871 else if EQ("settable") { 1872 lua_settable(L1, getindex); 1873 } 1874 else if EQ("settop") { 1875 lua_settop(L1, getnum); 1876 } 1877 else if EQ("testudata") { 1878 int i = getindex; 1879 lua_pushboolean(L1, luaL_testudata(L1, i, getstring) != NULL); 1880 } 1881 else if EQ("error") { 1882 lua_error(L1); 1883 } 1884 else if EQ("abort") { 1885 abort(); 1886 } 1887 else if EQ("throw") { 1888 #if defined(__cplusplus) 1889 static struct X { int x; } x; 1890 throw x; 1891 #else 1892 luaL_error(L1, "C++"); 1893 #endif 1894 break; 1895 } 1896 else if EQ("tobool") { 1897 lua_pushboolean(L1, lua_toboolean(L1, getindex)); 1898 } 1899 else if EQ("tocfunction") { 1900 lua_pushcfunction(L1, lua_tocfunction(L1, getindex)); 1901 } 1902 else if EQ("tointeger") { 1903 lua_pushinteger(L1, lua_tointeger(L1, getindex)); 1904 } 1905 else if EQ("tonumber") { 1906 lua_pushnumber(L1, lua_tonumber(L1, getindex)); 1907 } 1908 else if EQ("topointer") { 1909 lua_pushlightuserdata(L1, cast_voidp(lua_topointer(L1, getindex))); 1910 } 1911 else if EQ("touserdata") { 1912 lua_pushlightuserdata(L1, lua_touserdata(L1, getindex)); 1913 } 1914 else if EQ("tostring") { 1915 const char *s = lua_tostring(L1, getindex); 1916 const char *s1 = lua_pushstring(L1, s); 1917 cast_void(s1); /* to avoid warnings */ 1918 lua_longassert((s == NULL && s1 == NULL) || strcmp(s, s1) == 0); 1919 } 1920 else if EQ("Ltolstring") { 1921 luaL_tolstring(L1, getindex, NULL); 1922 } 1923 else if EQ("type") { 1924 lua_pushstring(L1, luaL_typename(L1, getnum)); 1925 } 1926 else if EQ("xmove") { 1927 int f = getindex; 1928 int t = getindex; 1929 lua_State *fs = (f == 0) ? L1 : lua_tothread(L1, f); 1930 lua_State *ts = (t == 0) ? L1 : lua_tothread(L1, t); 1931 int n = getnum; 1932 if (n == 0) n = lua_gettop(fs); 1933 lua_xmove(fs, ts, n); 1934 } 1935 else if EQ("isyieldable") { 1936 lua_pushboolean(L1, lua_isyieldable(lua_tothread(L1, getindex))); 1937 } 1938 else if EQ("yield") { 1939 return lua_yield(L1, getnum); 1940 } 1941 else if EQ("yieldk") { 1942 int nres = getnum; 1943 int i = getindex; 1944 return lua_yieldk(L1, nres, i, Cfunck); 1945 } 1946 else if EQ("toclose") { 1947 lua_toclose(L1, getnum); 1948 } 1949 else if EQ("closeslot") { 1950 lua_closeslot(L1, getnum); 1951 } 1952 else if EQ("argerror") { 1953 int arg = getnum; 1954 luaL_argerror(L1, arg, getstring); 1955 } 1956 else luaL_error(L, "unknown instruction %s", buff); 1957 } 1958 return 0; 1959 } 1960 1961 1962 static int testC (lua_State *L) { 1963 lua_State *L1; 1964 const char *pc; 1965 if (lua_isuserdata(L, 1)) { 1966 L1 = getstate(L); 1967 pc = luaL_checkstring(L, 2); 1968 } 1969 else if (lua_isthread(L, 1)) { 1970 L1 = lua_tothread(L, 1); 1971 pc = luaL_checkstring(L, 2); 1972 } 1973 else { 1974 L1 = L; 1975 pc = luaL_checkstring(L, 1); 1976 } 1977 return runC(L, L1, pc); 1978 } 1979 1980 1981 static int Cfunc (lua_State *L) { 1982 return runC(L, L, lua_tostring(L, lua_upvalueindex(1))); 1983 } 1984 1985 1986 static int Cfunck (lua_State *L, int status, lua_KContext ctx) { 1987 lua_pushstring(L, statcodes[status]); 1988 lua_setglobal(L, "status"); 1989 lua_pushinteger(L, cast(lua_Integer, ctx)); 1990 lua_setglobal(L, "ctx"); 1991 return runC(L, L, lua_tostring(L, cast_int(ctx))); 1992 } 1993 1994 1995 static int makeCfunc (lua_State *L) { 1996 luaL_checkstring(L, 1); 1997 lua_pushcclosure(L, Cfunc, lua_gettop(L)); 1998 return 1; 1999 } 2000 2001 2002 /* }====================================================== */ 2003 2004 2005 /* 2006 ** {====================================================== 2007 ** tests for C hooks 2008 ** ======================================================= 2009 */ 2010 2011 /* 2012 ** C hook that runs the C script stored in registry.C_HOOK[L] 2013 */ 2014 static void Chook (lua_State *L, lua_Debug *ar) { 2015 const char *scpt; 2016 const char *const events [] = {"call", "ret", "line", "count", "tailcall"}; 2017 lua_getfield(L, LUA_REGISTRYINDEX, "C_HOOK"); 2018 lua_pushlightuserdata(L, L); 2019 lua_gettable(L, -2); /* get C_HOOK[L] (script saved by sethookaux) */ 2020 scpt = lua_tostring(L, -1); /* not very religious (string will be popped) */ 2021 lua_pop(L, 2); /* remove C_HOOK and script */ 2022 lua_pushstring(L, events[ar->event]); /* may be used by script */ 2023 lua_pushinteger(L, ar->currentline); /* may be used by script */ 2024 runC(L, L, scpt); /* run script from C_HOOK[L] */ 2025 } 2026 2027 2028 /* 2029 ** sets 'registry.C_HOOK[L] = scpt' and sets 'Chook' as a hook 2030 */ 2031 static void sethookaux (lua_State *L, int mask, int count, const char *scpt) { 2032 if (*scpt == '\0') { /* no script? */ 2033 lua_sethook(L, NULL, 0, 0); /* turn off hooks */ 2034 return; 2035 } 2036 lua_getfield(L, LUA_REGISTRYINDEX, "C_HOOK"); /* get C_HOOK table */ 2037 if (!lua_istable(L, -1)) { /* no hook table? */ 2038 lua_pop(L, 1); /* remove previous value */ 2039 lua_newtable(L); /* create new C_HOOK table */ 2040 lua_pushvalue(L, -1); 2041 lua_setfield(L, LUA_REGISTRYINDEX, "C_HOOK"); /* register it */ 2042 } 2043 lua_pushlightuserdata(L, L); 2044 lua_pushstring(L, scpt); 2045 lua_settable(L, -3); /* C_HOOK[L] = script */ 2046 lua_sethook(L, Chook, mask, count); 2047 } 2048 2049 2050 static int sethook (lua_State *L) { 2051 if (lua_isnoneornil(L, 1)) 2052 lua_sethook(L, NULL, 0, 0); /* turn off hooks */ 2053 else { 2054 const char *scpt = luaL_checkstring(L, 1); 2055 const char *smask = luaL_checkstring(L, 2); 2056 int count = cast_int(luaL_optinteger(L, 3, 0)); 2057 int mask = 0; 2058 if (strchr(smask, 'c')) mask |= LUA_MASKCALL; 2059 if (strchr(smask, 'r')) mask |= LUA_MASKRET; 2060 if (strchr(smask, 'l')) mask |= LUA_MASKLINE; 2061 if (count > 0) mask |= LUA_MASKCOUNT; 2062 sethookaux(L, mask, count, scpt); 2063 } 2064 return 0; 2065 } 2066 2067 2068 static int coresume (lua_State *L) { 2069 int status, nres; 2070 lua_State *co = lua_tothread(L, 1); 2071 luaL_argcheck(L, co, 1, "coroutine expected"); 2072 status = lua_resume(co, L, 0, &nres); 2073 if (status != LUA_OK && status != LUA_YIELD) { 2074 lua_pushboolean(L, 0); 2075 lua_insert(L, -2); 2076 return 2; /* return false + error message */ 2077 } 2078 else { 2079 lua_pushboolean(L, 1); 2080 return 1; 2081 } 2082 } 2083 2084 /* }====================================================== */ 2085 2086 2087 2088 static const struct luaL_Reg tests_funcs[] = { 2089 {"checkmemory", lua_checkmemory}, 2090 {"closestate", closestate}, 2091 {"d2s", d2s}, 2092 {"doonnewstack", doonnewstack}, 2093 {"doremote", doremote}, 2094 {"gccolor", gc_color}, 2095 {"gcage", gc_age}, 2096 {"gcstate", gc_state}, 2097 {"tracegc", tracegc}, 2098 {"pobj", gc_printobj}, 2099 {"getref", getref}, 2100 {"hash", hash_query}, 2101 {"log2", log2_aux}, 2102 {"limits", get_limits}, 2103 {"listcode", listcode}, 2104 {"printcode", printcode}, 2105 {"listk", listk}, 2106 {"listabslineinfo", listabslineinfo}, 2107 {"listlocals", listlocals}, 2108 {"loadlib", loadlib}, 2109 {"checkpanic", checkpanic}, 2110 {"newstate", newstate}, 2111 {"newuserdata", newuserdata}, 2112 {"num2int", num2int}, 2113 {"makeseed", makeseed}, 2114 {"pushuserdata", pushuserdata}, 2115 {"gcquery", gc_query}, 2116 {"querystr", string_query}, 2117 {"querytab", table_query}, 2118 {"codeparam", test_codeparam}, 2119 {"applyparam", test_applyparam}, 2120 {"ref", tref}, 2121 {"resume", coresume}, 2122 {"s2d", s2d}, 2123 {"sethook", sethook}, 2124 {"stacklevel", stacklevel}, 2125 {"testC", testC}, 2126 {"makeCfunc", makeCfunc}, 2127 {"totalmem", mem_query}, 2128 {"alloccount", alloc_count}, 2129 {"allocfailnext", alloc_failnext}, 2130 {"trick", settrick}, 2131 {"udataval", udataval}, 2132 {"unref", unref}, 2133 {"upvalue", upvalue}, 2134 {"externKstr", externKstr}, 2135 {"externstr", externstr}, 2136 {NULL, NULL} 2137 }; 2138 2139 2140 static void checkfinalmem (void) { 2141 lua_assert(l_memcontrol.numblocks == 0); 2142 lua_assert(l_memcontrol.total == 0); 2143 } 2144 2145 2146 int luaB_opentests (lua_State *L) { 2147 void *ud; 2148 lua_Alloc f = lua_getallocf(L, &ud); 2149 lua_atpanic(L, &tpanic); 2150 lua_setwarnf(L, &warnf, L); 2151 lua_pushboolean(L, 0); 2152 lua_setglobal(L, "_WARN"); /* _WARN = false */ 2153 regcodes(L); 2154 atexit(checkfinalmem); 2155 lua_assert(f == debug_realloc && ud == cast_voidp(&l_memcontrol)); 2156 lua_setallocf(L, f, ud); /* exercise this function */ 2157 luaL_newlib(L, tests_funcs); 2158 return 1; 2159 } 2160 2161 #endif 2162