Merge pull request #2672 from kitsunehunter/laundry-keys
[RRG-proxmark3.git] / client / deps / liblua / ldebug.c
blob43420c6293b485ad0a38ff781ae658923243b58d
1 /*
2 ** $Id: ldebug.c $
3 ** Debug Interface
4 ** See Copyright Notice in lua.h
5 */
7 #define ldebug_c
8 #define LUA_CORE
10 #include "lprefix.h"
13 #include <stdarg.h>
14 #include <stddef.h>
15 #include <string.h>
17 #include "lua.h"
19 #include "lapi.h"
20 #include "lcode.h"
21 #include "ldebug.h"
22 #include "ldo.h"
23 #include "lfunc.h"
24 #include "lobject.h"
25 #include "lopcodes.h"
26 #include "lstate.h"
27 #include "lstring.h"
28 #include "ltable.h"
29 #include "ltm.h"
30 #include "lvm.h"
34 #define LuaClosure(f) ((f) != NULL && (f)->c.tt == LUA_VLCL)
37 static const char *funcnamefromcall(lua_State *L, CallInfo *ci,
38 const char **name);
41 static int currentpc(CallInfo *ci) {
42 lua_assert(isLua(ci));
43 return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
48 ** Get a "base line" to find the line corresponding to an instruction.
49 ** Base lines are regularly placed at MAXIWTHABS intervals, so usually
50 ** an integer division gets the right place. When the source file has
51 ** large sequences of empty/comment lines, it may need extra entries,
52 ** so the original estimate needs a correction.
53 ** If the original estimate is -1, the initial 'if' ensures that the
54 ** 'while' will run at least once.
55 ** The assertion that the estimate is a lower bound for the correct base
56 ** is valid as long as the debug info has been generated with the same
57 ** value for MAXIWTHABS or smaller. (Previous releases use a little
58 ** smaller value.)
60 static int getbaseline(const Proto *f, int pc, int *basepc) {
61 if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
62 *basepc = -1; /* start from the beginning */
63 return f->linedefined;
64 } else {
65 int i = cast_uint(pc) / MAXIWTHABS - 1; /* get an estimate */
66 /* estimate must be a lower bound of the correct base */
67 lua_assert(i < 0 ||
68 (i < f->sizeabslineinfo && f->abslineinfo[i].pc <= pc));
69 while (i + 1 < f->sizeabslineinfo && pc >= f->abslineinfo[i + 1].pc)
70 i++; /* low estimate; adjust it */
71 *basepc = f->abslineinfo[i].pc;
72 return f->abslineinfo[i].line;
78 ** Get the line corresponding to instruction 'pc' in function 'f';
79 ** first gets a base line and from there does the increments until
80 ** the desired instruction.
82 int luaG_getfuncline(const Proto *f, int pc) {
83 if (f->lineinfo == NULL) /* no debug information? */
84 return -1;
85 else {
86 int basepc;
87 int baseline = getbaseline(f, pc, &basepc);
88 while (basepc++ < pc) { /* walk until given instruction */
89 lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
90 baseline += f->lineinfo[basepc]; /* correct line */
92 return baseline;
97 static int getcurrentline(CallInfo *ci) {
98 return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
103 ** Set 'trap' for all active Lua frames.
104 ** This function can be called during a signal, under "reasonable"
105 ** assumptions. A new 'ci' is completely linked in the list before it
106 ** becomes part of the "active" list, and we assume that pointers are
107 ** atomic; see comment in next function.
108 ** (A compiler doing interprocedural optimizations could, theoretically,
109 ** reorder memory writes in such a way that the list could be
110 ** temporarily broken while inserting a new element. We simply assume it
111 ** has no good reasons to do that.)
113 static void settraps(CallInfo *ci) {
114 for (; ci != NULL; ci = ci->previous)
115 if (isLua(ci))
116 ci->u.l.trap = 1;
121 ** This function can be called during a signal, under "reasonable"
122 ** assumptions.
123 ** Fields 'basehookcount' and 'hookcount' (set by 'resethookcount')
124 ** are for debug only, and it is no problem if they get arbitrary
125 ** values (causes at most one wrong hook call). 'hookmask' is an atomic
126 ** value. We assume that pointers are atomic too (e.g., gcc ensures that
127 ** for all platforms where it runs). Moreover, 'hook' is always checked
128 ** before being called (see 'luaD_hook').
130 LUA_API void lua_sethook(lua_State *L, lua_Hook func, int mask, int count) {
131 if (func == NULL || mask == 0) { /* turn off hooks? */
132 mask = 0;
133 func = NULL;
135 L->hook = func;
136 L->basehookcount = count;
137 resethookcount(L);
138 L->hookmask = cast_byte(mask);
139 if (mask)
140 settraps(L->ci); /* to trace inside 'luaV_execute' */
144 LUA_API lua_Hook lua_gethook(lua_State *L) {
145 return L->hook;
149 LUA_API int lua_gethookmask(lua_State *L) {
150 return L->hookmask;
154 LUA_API int lua_gethookcount(lua_State *L) {
155 return L->basehookcount;
159 LUA_API int lua_getstack(lua_State *L, int level, lua_Debug *ar) {
160 int status;
161 CallInfo *ci;
162 if (level < 0) return 0; /* invalid (negative) level */
163 lua_lock(L);
164 for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
165 level--;
166 if (level == 0 && ci != &L->base_ci) { /* level found? */
167 status = 1;
168 ar->i_ci = ci;
169 } else status = 0; /* no such level */
170 lua_unlock(L);
171 return status;
175 static const char *upvalname(const Proto *p, int uv) {
176 TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
177 if (s == NULL) return "?";
178 else return getstr(s);
182 static const char *findvararg(CallInfo *ci, int n, StkId *pos) {
183 if (clLvalue(s2v(ci->func.p))->p->is_vararg) {
184 int nextra = ci->u.l.nextraargs;
185 if (n >= -nextra) { /* 'n' is negative */
186 *pos = ci->func.p - nextra - (n + 1);
187 return "(vararg)"; /* generic name for any vararg */
190 return NULL; /* no such vararg */
194 const char *luaG_findlocal(lua_State *L, CallInfo *ci, int n, StkId *pos) {
195 StkId base = ci->func.p + 1;
196 const char *name = NULL;
197 if (isLua(ci)) {
198 if (n < 0) /* access to vararg values? */
199 return findvararg(ci, n, pos);
200 else
201 name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
203 if (name == NULL) { /* no 'standard' name? */
204 StkId limit = (ci == L->ci) ? L->top.p : ci->next->func.p;
205 if (limit - base >= n && n > 0) { /* is 'n' inside 'ci' stack? */
206 /* generic name for any valid slot */
207 name = isLua(ci) ? "(temporary)" : "(C temporary)";
208 } else
209 return NULL; /* no name */
211 if (pos)
212 *pos = base + (n - 1);
213 return name;
217 LUA_API const char *lua_getlocal(lua_State *L, const lua_Debug *ar, int n) {
218 const char *name;
219 lua_lock(L);
220 if (ar == NULL) { /* information about non-active function? */
221 if (!isLfunction(s2v(L->top.p - 1))) /* not a Lua function? */
222 name = NULL;
223 else /* consider live variables at function start (parameters) */
224 name = luaF_getlocalname(clLvalue(s2v(L->top.p - 1))->p, n, 0);
225 } else { /* active function; get information through 'ar' */
226 StkId pos = NULL; /* to avoid warnings */
227 name = luaG_findlocal(L, ar->i_ci, n, &pos);
228 if (name) {
229 setobjs2s(L, L->top.p, pos);
230 api_incr_top(L);
233 lua_unlock(L);
234 return name;
238 LUA_API const char *lua_setlocal(lua_State *L, const lua_Debug *ar, int n) {
239 StkId pos = NULL; /* to avoid warnings */
240 const char *name;
241 lua_lock(L);
242 name = luaG_findlocal(L, ar->i_ci, n, &pos);
243 if (name) {
244 setobjs2s(L, pos, L->top.p - 1);
245 L->top.p--; /* pop value */
247 lua_unlock(L);
248 return name;
252 static void funcinfo(lua_Debug *ar, Closure *cl) {
253 if (!LuaClosure(cl)) {
254 ar->source = "=[C]";
255 ar->srclen = LL("=[C]");
256 ar->linedefined = -1;
257 ar->lastlinedefined = -1;
258 ar->what = "C";
259 } else {
260 const Proto *p = cl->l.p;
261 if (p->source) {
262 ar->source = getstr(p->source);
263 ar->srclen = tsslen(p->source);
264 } else {
265 ar->source = "=?";
266 ar->srclen = LL("=?");
268 ar->linedefined = p->linedefined;
269 ar->lastlinedefined = p->lastlinedefined;
270 ar->what = (ar->linedefined == 0) ? "main" : "Lua";
272 luaO_chunkid(ar->short_src, ar->source, ar->srclen);
276 static int nextline(const Proto *p, int currentline, int pc) {
277 if (p->lineinfo[pc] != ABSLINEINFO)
278 return currentline + p->lineinfo[pc];
279 else
280 return luaG_getfuncline(p, pc);
284 static void collectvalidlines(lua_State *L, Closure *f) {
285 if (!LuaClosure(f)) {
286 setnilvalue(s2v(L->top.p));
287 api_incr_top(L);
288 } else {
289 const Proto *p = f->l.p;
290 int currentline = p->linedefined;
291 Table *t = luaH_new(L); /* new table to store active lines */
292 sethvalue2s(L, L->top.p, t); /* push it on stack */
293 api_incr_top(L);
294 if (p->lineinfo != NULL) { /* proto with debug information? */
295 int i;
296 TValue v;
297 setbtvalue(&v); /* boolean 'true' to be the value of all indices */
298 if (!p->is_vararg) /* regular function? */
299 i = 0; /* consider all instructions */
300 else { /* vararg function */
301 lua_assert(GET_OPCODE(p->code[0]) == OP_VARARGPREP);
302 currentline = nextline(p, currentline, 0);
303 i = 1; /* skip first instruction (OP_VARARGPREP) */
305 for (; i < p->sizelineinfo; i++) { /* for each instruction */
306 currentline = nextline(p, currentline, i); /* get its line */
307 luaH_setint(L, t, currentline, &v); /* table[line] = true */
314 static const char *getfuncname(lua_State *L, CallInfo *ci, const char **name) {
315 /* calling function is a known function? */
316 if (ci != NULL && !(ci->callstatus & CIST_TAIL))
317 return funcnamefromcall(L, ci->previous, name);
318 else return NULL; /* no way to find a name */
322 static int auxgetinfo(lua_State *L, const char *what, lua_Debug *ar,
323 Closure *f, CallInfo *ci) {
324 int status = 1;
325 for (; *what; what++) {
326 switch (*what) {
327 case 'S': {
328 funcinfo(ar, f);
329 break;
331 case 'l': {
332 ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
333 break;
335 case 'u': {
336 ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
337 if (!LuaClosure(f)) {
338 ar->isvararg = 1;
339 ar->nparams = 0;
340 } else {
341 ar->isvararg = f->l.p->is_vararg;
342 ar->nparams = f->l.p->numparams;
344 break;
346 case 't': {
347 ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
348 break;
350 case 'n': {
351 ar->namewhat = getfuncname(L, ci, &ar->name);
352 if (ar->namewhat == NULL) {
353 ar->namewhat = ""; /* not found */
354 ar->name = NULL;
356 break;
358 case 'r': {
359 if (ci == NULL || !(ci->callstatus & CIST_TRAN))
360 ar->ftransfer = ar->ntransfer = 0;
361 else {
362 ar->ftransfer = ci->u2.transferinfo.ftransfer;
363 ar->ntransfer = ci->u2.transferinfo.ntransfer;
365 break;
367 case 'L':
368 case 'f': /* handled by lua_getinfo */
369 break;
370 default:
371 status = 0; /* invalid option */
374 return status;
378 LUA_API int lua_getinfo(lua_State *L, const char *what, lua_Debug *ar) {
379 int status;
380 Closure *cl;
381 CallInfo *ci;
382 TValue *func;
383 lua_lock(L);
384 if (*what == '>') {
385 ci = NULL;
386 func = s2v(L->top.p - 1);
387 api_check(L, ttisfunction(func), "function expected");
388 what++; /* skip the '>' */
389 L->top.p--; /* pop function */
390 } else {
391 ci = ar->i_ci;
392 func = s2v(ci->func.p);
393 lua_assert(ttisfunction(func));
395 cl = ttisclosure(func) ? clvalue(func) : NULL;
396 status = auxgetinfo(L, what, ar, cl, ci);
397 if (strchr(what, 'f')) {
398 setobj2s(L, L->top.p, func);
399 api_incr_top(L);
401 if (strchr(what, 'L'))
402 collectvalidlines(L, cl);
403 lua_unlock(L);
404 return status;
409 ** {======================================================
410 ** Symbolic Execution
411 ** =======================================================
415 static int filterpc(int pc, int jmptarget) {
416 if (pc < jmptarget) /* is code conditional (inside a jump)? */
417 return -1; /* cannot know who sets that register */
418 else return pc; /* current position sets that register */
423 ** Try to find last instruction before 'lastpc' that modified register 'reg'.
425 static int findsetreg(const Proto *p, int lastpc, int reg) {
426 int pc;
427 int setreg = -1; /* keep last instruction that changed 'reg' */
428 int jmptarget = 0; /* any code before this address is conditional */
429 if (testMMMode(GET_OPCODE(p->code[lastpc])))
430 lastpc--; /* previous instruction was not actually executed */
431 for (pc = 0; pc < lastpc; pc++) {
432 Instruction i = p->code[pc];
433 OpCode op = GET_OPCODE(i);
434 int a = GETARG_A(i);
435 int change; /* true if current instruction changed 'reg' */
436 switch (op) {
437 case OP_LOADNIL: { /* set registers from 'a' to 'a+b' */
438 int b = GETARG_B(i);
439 change = (a <= reg && reg <= a + b);
440 break;
442 case OP_TFORCALL: { /* affect all regs above its base */
443 change = (reg >= a + 2);
444 break;
446 case OP_CALL:
447 case OP_TAILCALL: { /* affect all registers above base */
448 change = (reg >= a);
449 break;
451 case OP_JMP: { /* doesn't change registers, but changes 'jmptarget' */
452 int b = GETARG_sJ(i);
453 int dest = pc + 1 + b;
454 /* jump does not skip 'lastpc' and is larger than current one? */
455 if (dest <= lastpc && dest > jmptarget)
456 jmptarget = dest; /* update 'jmptarget' */
457 change = 0;
458 break;
460 default: /* any instruction that sets A */
461 change = (testAMode(op) && reg == a);
462 break;
464 if (change)
465 setreg = filterpc(pc, jmptarget);
467 return setreg;
472 ** Find a "name" for the constant 'c'.
474 static const char *kname(const Proto *p, int index, const char **name) {
475 TValue *kvalue = &p->k[index];
476 if (ttisstring(kvalue)) {
477 *name = getstr(tsvalue(kvalue));
478 return "constant";
479 } else {
480 *name = "?";
481 return NULL;
486 static const char *basicgetobjname(const Proto *p, int *ppc, int reg,
487 const char **name) {
488 int pc = *ppc;
489 *name = luaF_getlocalname(p, reg + 1, pc);
490 if (*name) /* is a local? */
491 return "local";
492 /* else try symbolic execution */
493 *ppc = pc = findsetreg(p, pc, reg);
494 if (pc != -1) { /* could find instruction? */
495 Instruction i = p->code[pc];
496 OpCode op = GET_OPCODE(i);
497 switch (op) {
498 case OP_MOVE: {
499 int b = GETARG_B(i); /* move from 'b' to 'a' */
500 if (b < GETARG_A(i))
501 return basicgetobjname(p, ppc, b, name); /* get name for 'b' */
502 break;
504 case OP_GETUPVAL: {
505 *name = upvalname(p, GETARG_B(i));
506 return "upvalue";
508 case OP_LOADK:
509 return kname(p, GETARG_Bx(i), name);
510 case OP_LOADKX:
511 return kname(p, GETARG_Ax(p->code[pc + 1]), name);
512 default:
513 break;
516 return NULL; /* could not find reasonable name */
521 ** Find a "name" for the register 'c'.
523 static void rname(const Proto *p, int pc, int c, const char **name) {
524 const char *what = basicgetobjname(p, &pc, c, name); /* search for 'c' */
525 if (!(what && *what == 'c')) /* did not find a constant name? */
526 *name = "?";
531 ** Find a "name" for a 'C' value in an RK instruction.
533 static void rkname(const Proto *p, int pc, Instruction i, const char **name) {
534 int c = GETARG_C(i); /* key index */
535 if (GETARG_k(i)) /* is 'c' a constant? */
536 kname(p, c, name);
537 else /* 'c' is a register */
538 rname(p, pc, c, name);
543 ** Check whether table being indexed by instruction 'i' is the
544 ** environment '_ENV'
546 static const char *isEnv(const Proto *p, int pc, Instruction i, int isup) {
547 int t = GETARG_B(i); /* table index */
548 const char *name; /* name of indexed variable */
549 if (isup) /* is 't' an upvalue? */
550 name = upvalname(p, t);
551 else /* 't' is a register */
552 basicgetobjname(p, &pc, t, &name);
553 return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
558 ** Extend 'basicgetobjname' to handle table accesses
560 static const char *getobjname(const Proto *p, int lastpc, int reg,
561 const char **name) {
562 const char *kind = basicgetobjname(p, &lastpc, reg, name);
563 if (kind != NULL)
564 return kind;
565 else if (lastpc != -1) { /* could find instruction? */
566 Instruction i = p->code[lastpc];
567 OpCode op = GET_OPCODE(i);
568 switch (op) {
569 case OP_GETTABUP: {
570 int k = GETARG_C(i); /* key index */
571 kname(p, k, name);
572 return isEnv(p, lastpc, i, 1);
574 case OP_GETTABLE: {
575 int k = GETARG_C(i); /* key index */
576 rname(p, lastpc, k, name);
577 return isEnv(p, lastpc, i, 0);
579 case OP_GETI: {
580 *name = "integer index";
581 return "field";
583 case OP_GETFIELD: {
584 int k = GETARG_C(i); /* key index */
585 kname(p, k, name);
586 return isEnv(p, lastpc, i, 0);
588 case OP_SELF: {
589 rkname(p, lastpc, i, name);
590 return "method";
592 default:
593 break; /* go through to return NULL */
596 return NULL; /* could not find reasonable name */
601 ** Try to find a name for a function based on the code that called it.
602 ** (Only works when function was called by a Lua function.)
603 ** Returns what the name is (e.g., "for iterator", "method",
604 ** "metamethod") and sets '*name' to point to the name.
606 static const char *funcnamefromcode(lua_State *L, const Proto *p,
607 int pc, const char **name) {
608 TMS tm = (TMS)0; /* (initial value avoids warnings) */
609 Instruction i = p->code[pc]; /* calling instruction */
610 switch (GET_OPCODE(i)) {
611 case OP_CALL:
612 case OP_TAILCALL:
613 return getobjname(p, pc, GETARG_A(i), name); /* get function name */
614 case OP_TFORCALL: { /* for iterator */
615 *name = "for iterator";
616 return "for iterator";
618 /* other instructions can do calls through metamethods */
619 case OP_SELF:
620 case OP_GETTABUP:
621 case OP_GETTABLE:
622 case OP_GETI:
623 case OP_GETFIELD:
624 tm = TM_INDEX;
625 break;
626 case OP_SETTABUP:
627 case OP_SETTABLE:
628 case OP_SETI:
629 case OP_SETFIELD:
630 tm = TM_NEWINDEX;
631 break;
632 case OP_MMBIN:
633 case OP_MMBINI:
634 case OP_MMBINK: {
635 tm = cast(TMS, GETARG_C(i));
636 break;
638 case OP_UNM:
639 tm = TM_UNM;
640 break;
641 case OP_BNOT:
642 tm = TM_BNOT;
643 break;
644 case OP_LEN:
645 tm = TM_LEN;
646 break;
647 case OP_CONCAT:
648 tm = TM_CONCAT;
649 break;
650 case OP_EQ:
651 tm = TM_EQ;
652 break;
653 /* no cases for OP_EQI and OP_EQK, as they don't call metamethods */
654 case OP_LT:
655 case OP_LTI:
656 case OP_GTI:
657 tm = TM_LT;
658 break;
659 case OP_LE:
660 case OP_LEI:
661 case OP_GEI:
662 tm = TM_LE;
663 break;
664 case OP_CLOSE:
665 case OP_RETURN:
666 tm = TM_CLOSE;
667 break;
668 default:
669 return NULL; /* cannot find a reasonable name */
671 *name = getshrstr(G(L)->tmname[tm]) + 2;
672 return "metamethod";
677 ** Try to find a name for a function based on how it was called.
679 static const char *funcnamefromcall(lua_State *L, CallInfo *ci,
680 const char **name) {
681 if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */
682 *name = "?";
683 return "hook";
684 } else if (ci->callstatus & CIST_FIN) { /* was it called as a finalizer? */
685 *name = "__gc";
686 return "metamethod"; /* report it as such */
687 } else if (isLua(ci))
688 return funcnamefromcode(L, ci_func(ci)->p, currentpc(ci), name);
689 else
690 return NULL;
693 /* }====================================================== */
698 ** Check whether pointer 'o' points to some value in the stack frame of
699 ** the current function and, if so, returns its index. Because 'o' may
700 ** not point to a value in this stack, we cannot compare it with the
701 ** region boundaries (undefined behavior in ISO C).
703 static int instack(CallInfo *ci, const TValue *o) {
704 int pos;
705 StkId base = ci->func.p + 1;
706 for (pos = 0; base + pos < ci->top.p; pos++) {
707 if (o == s2v(base + pos))
708 return pos;
710 return -1; /* not found */
715 ** Checks whether value 'o' came from an upvalue. (That can only happen
716 ** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
717 ** upvalues.)
719 static const char *getupvalname(CallInfo *ci, const TValue *o,
720 const char **name) {
721 LClosure *c = ci_func(ci);
722 int i;
723 for (i = 0; i < c->nupvalues; i++) {
724 if (c->upvals[i]->v.p == o) {
725 *name = upvalname(c->p, i);
726 return "upvalue";
729 return NULL;
733 static const char *formatvarinfo(lua_State *L, const char *kind,
734 const char *name) {
735 if (kind == NULL)
736 return ""; /* no information */
737 else
738 return luaO_pushfstring(L, " (%s '%s')", kind, name);
742 ** Build a string with a "description" for the value 'o', such as
743 ** "variable 'x'" or "upvalue 'y'".
745 static const char *varinfo(lua_State *L, const TValue *o) {
746 CallInfo *ci = L->ci;
747 const char *name = NULL; /* to avoid warnings */
748 const char *kind = NULL;
749 if (isLua(ci)) {
750 kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */
751 if (!kind) { /* not an upvalue? */
752 int reg = instack(ci, o); /* try a register */
753 if (reg >= 0) /* is 'o' a register? */
754 kind = getobjname(ci_func(ci)->p, currentpc(ci), reg, &name);
757 return formatvarinfo(L, kind, name);
762 ** Raise a type error
764 static l_noret typeerror(lua_State *L, const TValue *o, const char *op,
765 const char *extra) {
766 const char *t = luaT_objtypename(L, o);
767 luaG_runerror(L, "attempt to %s a %s value%s", op, t, extra);
772 ** Raise a type error with "standard" information about the faulty
773 ** object 'o' (using 'varinfo').
775 l_noret luaG_typeerror(lua_State *L, const TValue *o, const char *op) {
776 typeerror(L, o, op, varinfo(L, o));
781 ** Raise an error for calling a non-callable object. Try to find a name
782 ** for the object based on how it was called ('funcnamefromcall'); if it
783 ** cannot get a name there, try 'varinfo'.
785 l_noret luaG_callerror(lua_State *L, const TValue *o) {
786 CallInfo *ci = L->ci;
787 const char *name = NULL; /* to avoid warnings */
788 const char *kind = funcnamefromcall(L, ci, &name);
789 const char *extra = kind ? formatvarinfo(L, kind, name) : varinfo(L, o);
790 typeerror(L, o, "call", extra);
794 l_noret luaG_forerror(lua_State *L, const TValue *o, const char *what) {
795 luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
796 what, luaT_objtypename(L, o));
800 l_noret luaG_concaterror(lua_State *L, const TValue *p1, const TValue *p2) {
801 if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
802 luaG_typeerror(L, p1, "concatenate");
806 l_noret luaG_opinterror(lua_State *L, const TValue *p1,
807 const TValue *p2, const char *msg) {
808 if (!ttisnumber(p1)) /* first operand is wrong? */
809 p2 = p1; /* now second is wrong */
810 luaG_typeerror(L, p2, msg);
815 ** Error when both values are convertible to numbers, but not to integers
817 l_noret luaG_tointerror(lua_State *L, const TValue *p1, const TValue *p2) {
818 lua_Integer temp;
819 if (!luaV_tointegerns(p1, &temp, LUA_FLOORN2I))
820 p2 = p1;
821 luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
825 l_noret luaG_ordererror(lua_State *L, const TValue *p1, const TValue *p2) {
826 const char *t1 = luaT_objtypename(L, p1);
827 const char *t2 = luaT_objtypename(L, p2);
828 if (strcmp(t1, t2) == 0)
829 luaG_runerror(L, "attempt to compare two %s values", t1);
830 else
831 luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
835 /* add src:line information to 'msg' */
836 const char *luaG_addinfo(lua_State *L, const char *msg, TString *src,
837 int line) {
838 char buff[LUA_IDSIZE];
839 if (src)
840 luaO_chunkid(buff, getstr(src), tsslen(src));
841 else { /* no source available; use "?" instead */
842 buff[0] = '?';
843 buff[1] = '\0';
845 return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
849 l_noret luaG_errormsg(lua_State *L) {
850 if (L->errfunc != 0) { /* is there an error handling function? */
851 StkId errfunc = restorestack(L, L->errfunc);
852 lua_assert(ttisfunction(s2v(errfunc)));
853 setobjs2s(L, L->top.p, L->top.p - 1); /* move argument */
854 setobjs2s(L, L->top.p - 1, errfunc); /* push function */
855 L->top.p++; /* assume EXTRA_STACK */
856 luaD_callnoyield(L, L->top.p - 2, 1); /* call it */
858 luaD_throw(L, LUA_ERRRUN);
862 l_noret luaG_runerror(lua_State *L, const char *fmt, ...) {
863 CallInfo *ci = L->ci;
864 const char *msg;
865 va_list argp;
866 luaC_checkGC(L); /* error message uses memory */
867 va_start(argp, fmt);
868 msg = luaO_pushvfstring(L, fmt, argp); /* format message */
869 va_end(argp);
870 if (isLua(ci)) { /* if Lua function, add source:line information */
871 luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
872 setobjs2s(L, L->top.p - 2, L->top.p - 1); /* remove 'msg' */
873 L->top.p--;
875 luaG_errormsg(L);
880 ** Check whether new instruction 'newpc' is in a different line from
881 ** previous instruction 'oldpc'. More often than not, 'newpc' is only
882 ** one or a few instructions after 'oldpc' (it must be after, see
883 ** caller), so try to avoid calling 'luaG_getfuncline'. If they are
884 ** too far apart, there is a good chance of a ABSLINEINFO in the way,
885 ** so it goes directly to 'luaG_getfuncline'.
887 static int changedline(const Proto *p, int oldpc, int newpc) {
888 if (p->lineinfo == NULL) /* no debug information? */
889 return 0;
890 if (newpc - oldpc < MAXIWTHABS / 2) { /* not too far apart? */
891 int delta = 0; /* line difference */
892 int pc = oldpc;
893 for (;;) {
894 int lineinfo = p->lineinfo[++pc];
895 if (lineinfo == ABSLINEINFO)
896 break; /* cannot compute delta; fall through */
897 delta += lineinfo;
898 if (pc == newpc)
899 return (delta != 0); /* delta computed successfully */
902 /* either instructions are too far apart or there is an absolute line
903 info in the way; compute line difference explicitly */
904 return (luaG_getfuncline(p, oldpc) != luaG_getfuncline(p, newpc));
909 ** Traces Lua calls. If code is running the first instruction of a function,
910 ** and function is not vararg, and it is not coming from an yield,
911 ** calls 'luaD_hookcall'. (Vararg functions will call 'luaD_hookcall'
912 ** after adjusting its variable arguments; otherwise, they could call
913 ** a line/count hook before the call hook. Functions coming from
914 ** an yield already called 'luaD_hookcall' before yielding.)
916 int luaG_tracecall(lua_State *L) {
917 CallInfo *ci = L->ci;
918 Proto *p = ci_func(ci)->p;
919 ci->u.l.trap = 1; /* ensure hooks will be checked */
920 if (ci->u.l.savedpc == p->code) { /* first instruction (not resuming)? */
921 if (p->is_vararg)
922 return 0; /* hooks will start at VARARGPREP instruction */
923 else if (!(ci->callstatus & CIST_HOOKYIELD)) /* not yieded? */
924 luaD_hookcall(L, ci); /* check 'call' hook */
926 return 1; /* keep 'trap' on */
931 ** Traces the execution of a Lua function. Called before the execution
932 ** of each opcode, when debug is on. 'L->oldpc' stores the last
933 ** instruction traced, to detect line changes. When entering a new
934 ** function, 'npci' will be zero and will test as a new line whatever
935 ** the value of 'oldpc'. Some exceptional conditions may return to
936 ** a function without setting 'oldpc'. In that case, 'oldpc' may be
937 ** invalid; if so, use zero as a valid value. (A wrong but valid 'oldpc'
938 ** at most causes an extra call to a line hook.)
939 ** This function is not "Protected" when called, so it should correct
940 ** 'L->top.p' before calling anything that can run the GC.
942 int luaG_traceexec(lua_State *L, const Instruction *pc) {
943 CallInfo *ci = L->ci;
944 lu_byte mask = L->hookmask;
945 const Proto *p = ci_func(ci)->p;
946 int counthook;
947 if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */
948 ci->u.l.trap = 0; /* don't need to stop again */
949 return 0; /* turn off 'trap' */
951 pc++; /* reference is always next instruction */
952 ci->u.l.savedpc = pc; /* save 'pc' */
953 counthook = (mask & LUA_MASKCOUNT) && (--L->hookcount == 0);
954 if (counthook)
955 resethookcount(L); /* reset count */
956 else if (!(mask & LUA_MASKLINE))
957 return 1; /* no line hook and count != 0; nothing to be done now */
958 if (ci->callstatus & CIST_HOOKYIELD) { /* hook yielded last time? */
959 ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */
960 return 1; /* do not call hook again (VM yielded, so it did not move) */
962 if (!isIT(*(ci->u.l.savedpc - 1))) /* top not being used? */
963 L->top.p = ci->top.p; /* correct top */
964 if (counthook)
965 luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */
966 if (mask & LUA_MASKLINE) {
967 /* 'L->oldpc' may be invalid; use zero in this case */
968 int oldpc = (L->oldpc < p->sizecode) ? L->oldpc : 0;
969 int npci = pcRel(pc, p);
970 if (npci <= oldpc || /* call hook when jump back (loop), */
971 changedline(p, oldpc, npci)) { /* or when enter new line */
972 int newline = luaG_getfuncline(p, npci);
973 luaD_hook(L, LUA_HOOKLINE, newline, 0, 0); /* call line hook */
975 L->oldpc = npci; /* 'pc' of last call to line hook */
977 if (L->status == LUA_YIELD) { /* did hook yield? */
978 if (counthook)
979 L->hookcount = 1; /* undo decrement to zero */
980 ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */
981 luaD_throw(L, LUA_YIELD);
983 return 1; /* keep 'trap' on */