MackieControl: in sends subview, if there are no sends for a vpot, drop the controlla...
[ardour.git] / libs / lua / lua-5.3.2 / ldebug.c
1 /*
2 ** $Id: ldebug.c,v 2.117 2015/11/02 18:48:07 roberto Exp $
3 ** Debug Interface
4 ** See Copyright Notice in lua.h
5 */
6
7 #define ldebug_c
8 #define LUA_CORE
9
10 #include "lprefix.h"
11
12
13 #include <stdarg.h>
14 #include <stddef.h>
15 #include <string.h>
16
17 #include "lua.h"
18
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"
31
32
33
34 #define noLuaClosure(f)         ((f) == NULL || (f)->c.tt == LUA_TCCL)
35
36
37 /* Active Lua function (given call info) */
38 #define ci_func(ci)             (clLvalue((ci)->func))
39
40
41 static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
42
43
44 static int currentpc (CallInfo *ci) {
45   lua_assert(isLua(ci));
46   return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
47 }
48
49
50 static int currentline (CallInfo *ci) {
51   return getfuncline(ci_func(ci)->p, currentpc(ci));
52 }
53
54
55 /*
56 ** If function yielded, its 'func' can be in the 'extra' field. The
57 ** next function restores 'func' to its correct value for debugging
58 ** purposes. (It exchanges 'func' and 'extra'; so, when called again,
59 ** after debugging, it also "re-restores" ** 'func' to its altered value.
60 */
61 static void swapextra (lua_State *L) {
62   if (L->status == LUA_YIELD) {
63     CallInfo *ci = L->ci;  /* get function that yielded */
64     StkId temp = ci->func;  /* exchange its 'func' and 'extra' values */
65     ci->func = restorestack(L, ci->extra);
66     ci->extra = savestack(L, temp);
67   }
68 }
69
70
71 /*
72 ** this function can be called asynchronous (e.g. during a signal)
73 */
74 LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
75   if (func == NULL || mask == 0) {  /* turn off hooks? */
76     mask = 0;
77     func = NULL;
78   }
79   if (isLua(L->ci))
80     L->oldpc = L->ci->u.l.savedpc;
81   L->hook = func;
82   L->basehookcount = count;
83   resethookcount(L);
84   L->hookmask = cast_byte(mask);
85 }
86
87
88 LUA_API lua_Hook lua_gethook (lua_State *L) {
89   return L->hook;
90 }
91
92
93 LUA_API int lua_gethookmask (lua_State *L) {
94   return L->hookmask;
95 }
96
97
98 LUA_API int lua_gethookcount (lua_State *L) {
99   return L->basehookcount;
100 }
101
102
103 LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
104   int status;
105   CallInfo *ci;
106   if (level < 0) return 0;  /* invalid (negative) level */
107   lua_lock(L);
108   for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
109     level--;
110   if (level == 0 && ci != &L->base_ci) {  /* level found? */
111     status = 1;
112     ar->i_ci = ci;
113   }
114   else status = 0;  /* no such level */
115   lua_unlock(L);
116   return status;
117 }
118
119
120 static const char *upvalname (Proto *p, int uv) {
121   TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
122   if (s == NULL) return "?";
123   else return getstr(s);
124 }
125
126
127 static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
128   int nparams = clLvalue(ci->func)->p->numparams;
129   if (n >= cast_int(ci->u.l.base - ci->func) - nparams)
130     return NULL;  /* no such vararg */
131   else {
132     *pos = ci->func + nparams + n;
133     return "(*vararg)";  /* generic name for any vararg */
134   }
135 }
136
137
138 static const char *findlocal (lua_State *L, CallInfo *ci, int n,
139                               StkId *pos) {
140   const char *name = NULL;
141   StkId base;
142   if (isLua(ci)) {
143     if (n < 0)  /* access to vararg values? */
144       return findvararg(ci, -n, pos);
145     else {
146       base = ci->u.l.base;
147       name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
148     }
149   }
150   else
151     base = ci->func + 1;
152   if (name == NULL) {  /* no 'standard' name? */
153     StkId limit = (ci == L->ci) ? L->top : ci->next->func;
154     if (limit - base >= n && n > 0)  /* is 'n' inside 'ci' stack? */
155       name = "(*temporary)";  /* generic name for any valid slot */
156     else
157       return NULL;  /* no name */
158   }
159   *pos = base + (n - 1);
160   return name;
161 }
162
163
164 LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
165   const char *name;
166   lua_lock(L);
167   swapextra(L);
168   if (ar == NULL) {  /* information about non-active function? */
169     if (!isLfunction(L->top - 1))  /* not a Lua function? */
170       name = NULL;
171     else  /* consider live variables at function start (parameters) */
172       name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);
173   }
174   else {  /* active function; get information through 'ar' */
175     StkId pos = NULL;  /* to avoid warnings */
176     name = findlocal(L, ar->i_ci, n, &pos);
177     if (name) {
178       setobj2s(L, L->top, pos);
179       api_incr_top(L);
180     }
181   }
182   swapextra(L);
183   lua_unlock(L);
184   return name;
185 }
186
187
188 LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
189   StkId pos = NULL;  /* to avoid warnings */
190   const char *name;
191   lua_lock(L);
192   swapextra(L);
193   name = findlocal(L, ar->i_ci, n, &pos);
194   if (name) {
195     setobjs2s(L, pos, L->top - 1);
196     L->top--;  /* pop value */
197   }
198   swapextra(L);
199   lua_unlock(L);
200   return name;
201 }
202
203
204 static void funcinfo (lua_Debug *ar, Closure *cl) {
205   if (noLuaClosure(cl)) {
206     ar->source = "=[C]";
207     ar->linedefined = -1;
208     ar->lastlinedefined = -1;
209     ar->what = "C";
210   }
211   else {
212     Proto *p = cl->l.p;
213     ar->source = p->source ? getstr(p->source) : "=?";
214     ar->linedefined = p->linedefined;
215     ar->lastlinedefined = p->lastlinedefined;
216     ar->what = (ar->linedefined == 0) ? "main" : "Lua";
217   }
218   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
219 }
220
221
222 static void collectvalidlines (lua_State *L, Closure *f) {
223   if (noLuaClosure(f)) {
224     setnilvalue(L->top);
225     api_incr_top(L);
226   }
227   else {
228     int i;
229     TValue v;
230     int *lineinfo = f->l.p->lineinfo;
231     Table *t = luaH_new(L);  /* new table to store active lines */
232     sethvalue(L, L->top, t);  /* push it on stack */
233     api_incr_top(L);
234     setbvalue(&v, 1);  /* boolean 'true' to be the value of all indices */
235     for (i = 0; i < f->l.p->sizelineinfo; i++)  /* for all lines with code */
236       luaH_setint(L, t, lineinfo[i], &v);  /* table[line] = true */
237   }
238 }
239
240
241 static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
242                        Closure *f, CallInfo *ci) {
243   int status = 1;
244   for (; *what; what++) {
245     switch (*what) {
246       case 'S': {
247         funcinfo(ar, f);
248         break;
249       }
250       case 'l': {
251         ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;
252         break;
253       }
254       case 'u': {
255         ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
256         if (noLuaClosure(f)) {
257           ar->isvararg = 1;
258           ar->nparams = 0;
259         }
260         else {
261           ar->isvararg = f->l.p->is_vararg;
262           ar->nparams = f->l.p->numparams;
263         }
264         break;
265       }
266       case 't': {
267         ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
268         break;
269       }
270       case 'n': {
271         /* calling function is a known Lua function? */
272         if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
273           ar->namewhat = getfuncname(L, ci->previous, &ar->name);
274         else
275           ar->namewhat = NULL;
276         if (ar->namewhat == NULL) {
277           ar->namewhat = "";  /* not found */
278           ar->name = NULL;
279         }
280         break;
281       }
282       case 'L':
283       case 'f':  /* handled by lua_getinfo */
284         break;
285       default: status = 0;  /* invalid option */
286     }
287   }
288   return status;
289 }
290
291
292 LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
293   int status;
294   Closure *cl;
295   CallInfo *ci;
296   StkId func;
297   lua_lock(L);
298   swapextra(L);
299   if (*what == '>') {
300     ci = NULL;
301     func = L->top - 1;
302     api_check(L, ttisfunction(func), "function expected");
303     what++;  /* skip the '>' */
304     L->top--;  /* pop function */
305   }
306   else {
307     ci = ar->i_ci;
308     func = ci->func;
309     lua_assert(ttisfunction(ci->func));
310   }
311   cl = ttisclosure(func) ? clvalue(func) : NULL;
312   status = auxgetinfo(L, what, ar, cl, ci);
313   if (strchr(what, 'f')) {
314     setobjs2s(L, L->top, func);
315     api_incr_top(L);
316   }
317   swapextra(L);  /* correct before option 'L', which can raise a mem. error */
318   if (strchr(what, 'L'))
319     collectvalidlines(L, cl);
320   lua_unlock(L);
321   return status;
322 }
323
324
325 /*
326 ** {======================================================
327 ** Symbolic Execution
328 ** =======================================================
329 */
330
331 static const char *getobjname (Proto *p, int lastpc, int reg,
332                                const char **name);
333
334
335 /*
336 ** find a "name" for the RK value 'c'
337 */
338 static void kname (Proto *p, int pc, int c, const char **name) {
339   if (ISK(c)) {  /* is 'c' a constant? */
340     TValue *kvalue = &p->k[INDEXK(c)];
341     if (ttisstring(kvalue)) {  /* literal constant? */
342       *name = svalue(kvalue);  /* it is its own name */
343       return;
344     }
345     /* else no reasonable name found */
346   }
347   else {  /* 'c' is a register */
348     const char *what = getobjname(p, pc, c, name); /* search for 'c' */
349     if (what && *what == 'c') {  /* found a constant name? */
350       return;  /* 'name' already filled */
351     }
352     /* else no reasonable name found */
353   }
354   *name = "?";  /* no reasonable name found */
355 }
356
357
358 static int filterpc (int pc, int jmptarget) {
359   if (pc < jmptarget)  /* is code conditional (inside a jump)? */
360     return -1;  /* cannot know who sets that register */
361   else return pc;  /* current position sets that register */
362 }
363
364
365 /*
366 ** try to find last instruction before 'lastpc' that modified register 'reg'
367 */
368 static int findsetreg (Proto *p, int lastpc, int reg) {
369   int pc;
370   int setreg = -1;  /* keep last instruction that changed 'reg' */
371   int jmptarget = 0;  /* any code before this address is conditional */
372   for (pc = 0; pc < lastpc; pc++) {
373     Instruction i = p->code[pc];
374     OpCode op = GET_OPCODE(i);
375     int a = GETARG_A(i);
376     switch (op) {
377       case OP_LOADNIL: {
378         int b = GETARG_B(i);
379         if (a <= reg && reg <= a + b)  /* set registers from 'a' to 'a+b' */
380           setreg = filterpc(pc, jmptarget);
381         break;
382       }
383       case OP_TFORCALL: {
384         if (reg >= a + 2)  /* affect all regs above its base */
385           setreg = filterpc(pc, jmptarget);
386         break;
387       }
388       case OP_CALL:
389       case OP_TAILCALL: {
390         if (reg >= a)  /* affect all registers above base */
391           setreg = filterpc(pc, jmptarget);
392         break;
393       }
394       case OP_JMP: {
395         int b = GETARG_sBx(i);
396         int dest = pc + 1 + b;
397         /* jump is forward and do not skip 'lastpc'? */
398         if (pc < dest && dest <= lastpc) {
399           if (dest > jmptarget)
400             jmptarget = dest;  /* update 'jmptarget' */
401         }
402         break;
403       }
404       default:
405         if (testAMode(op) && reg == a)  /* any instruction that set A */
406           setreg = filterpc(pc, jmptarget);
407         break;
408     }
409   }
410   return setreg;
411 }
412
413
414 static const char *getobjname (Proto *p, int lastpc, int reg,
415                                const char **name) {
416   int pc;
417   *name = luaF_getlocalname(p, reg + 1, lastpc);
418   if (*name)  /* is a local? */
419     return "local";
420   /* else try symbolic execution */
421   pc = findsetreg(p, lastpc, reg);
422   if (pc != -1) {  /* could find instruction? */
423     Instruction i = p->code[pc];
424     OpCode op = GET_OPCODE(i);
425     switch (op) {
426       case OP_MOVE: {
427         int b = GETARG_B(i);  /* move from 'b' to 'a' */
428         if (b < GETARG_A(i))
429           return getobjname(p, pc, b, name);  /* get name for 'b' */
430         break;
431       }
432       case OP_GETTABUP:
433       case OP_GETTABLE: {
434         int k = GETARG_C(i);  /* key index */
435         int t = GETARG_B(i);  /* table index */
436         const char *vn = (op == OP_GETTABLE)  /* name of indexed variable */
437                          ? luaF_getlocalname(p, t + 1, pc)
438                          : upvalname(p, t);
439         kname(p, pc, k, name);
440         return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";
441       }
442       case OP_GETUPVAL: {
443         *name = upvalname(p, GETARG_B(i));
444         return "upvalue";
445       }
446       case OP_LOADK:
447       case OP_LOADKX: {
448         int b = (op == OP_LOADK) ? GETARG_Bx(i)
449                                  : GETARG_Ax(p->code[pc + 1]);
450         if (ttisstring(&p->k[b])) {
451           *name = svalue(&p->k[b]);
452           return "constant";
453         }
454         break;
455       }
456       case OP_SELF: {
457         int k = GETARG_C(i);  /* key index */
458         kname(p, pc, k, name);
459         return "method";
460       }
461       default: break;  /* go through to return NULL */
462     }
463   }
464   return NULL;  /* could not find reasonable name */
465 }
466
467
468 static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
469   TMS tm = (TMS)0;  /* to avoid warnings */
470   Proto *p = ci_func(ci)->p;  /* calling function */
471   int pc = currentpc(ci);  /* calling instruction index */
472   Instruction i = p->code[pc];  /* calling instruction */
473   if (ci->callstatus & CIST_HOOKED) {  /* was it called inside a hook? */
474     *name = "?";
475     return "hook";
476   }
477   switch (GET_OPCODE(i)) {
478     case OP_CALL:
479     case OP_TAILCALL:  /* get function name */
480       return getobjname(p, pc, GETARG_A(i), name);
481     case OP_TFORCALL: {  /* for iterator */
482       *name = "for iterator";
483        return "for iterator";
484     }
485     /* all other instructions can call only through metamethods */
486     case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
487       tm = TM_INDEX;
488       break;
489     case OP_SETTABUP: case OP_SETTABLE:
490       tm = TM_NEWINDEX;
491       break;
492     case OP_ADD: case OP_SUB: case OP_MUL: case OP_MOD:
493     case OP_POW: case OP_DIV: case OP_IDIV: case OP_BAND:
494     case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: {
495       int offset = cast_int(GET_OPCODE(i)) - cast_int(OP_ADD);  /* ORDER OP */
496       tm = cast(TMS, offset + cast_int(TM_ADD));  /* ORDER TM */
497       break;
498     }
499     case OP_UNM: tm = TM_UNM; break;
500     case OP_BNOT: tm = TM_BNOT; break;
501     case OP_LEN: tm = TM_LEN; break;
502     case OP_CONCAT: tm = TM_CONCAT; break;
503     case OP_EQ: tm = TM_EQ; break;
504     case OP_LT: tm = TM_LT; break;
505     case OP_LE: tm = TM_LE; break;
506     default: lua_assert(0);  /* other instructions cannot call a function */
507   }
508   *name = getstr(G(L)->tmname[tm]);
509   return "metamethod";
510 }
511
512 /* }====================================================== */
513
514
515
516 /*
517 ** The subtraction of two potentially unrelated pointers is
518 ** not ISO C, but it should not crash a program; the subsequent
519 ** checks are ISO C and ensure a correct result.
520 */
521 static int isinstack (CallInfo *ci, const TValue *o) {
522   ptrdiff_t i = o - ci->u.l.base;
523   return (0 <= i && i < (ci->top - ci->u.l.base) && ci->u.l.base + i == o);
524 }
525
526
527 /*
528 ** Checks whether value 'o' came from an upvalue. (That can only happen
529 ** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
530 ** upvalues.)
531 */
532 static const char *getupvalname (CallInfo *ci, const TValue *o,
533                                  const char **name) {
534   LClosure *c = ci_func(ci);
535   int i;
536   for (i = 0; i < c->nupvalues; i++) {
537     if (c->upvals[i]->v == o) {
538       *name = upvalname(c->p, i);
539       return "upvalue";
540     }
541   }
542   return NULL;
543 }
544
545
546 static const char *varinfo (lua_State *L, const TValue *o) {
547   const char *name = NULL;  /* to avoid warnings */
548   CallInfo *ci = L->ci;
549   const char *kind = NULL;
550   if (isLua(ci)) {
551     kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
552     if (!kind && isinstack(ci, o))  /* no? try a register */
553       kind = getobjname(ci_func(ci)->p, currentpc(ci),
554                         cast_int(o - ci->u.l.base), &name);
555   }
556   return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : "";
557 }
558
559
560 l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
561   const char *t = objtypename(o);
562   luaG_runerror(L, "attempt to %s a %s value%s", op, t, varinfo(L, o));
563 }
564
565
566 l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
567   if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
568   luaG_typeerror(L, p1, "concatenate");
569 }
570
571
572 l_noret luaG_opinterror (lua_State *L, const TValue *p1,
573                          const TValue *p2, const char *msg) {
574   lua_Number temp;
575   if (!tonumber(p1, &temp))  /* first operand is wrong? */
576     p2 = p1;  /* now second is wrong */
577   luaG_typeerror(L, p2, msg);
578 }
579
580
581 /*
582 ** Error when both values are convertible to numbers, but not to integers
583 */
584 l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
585   lua_Integer temp;
586   if (!tointeger(p1, &temp))
587     p2 = p1;
588   luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
589 }
590
591
592 l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
593   const char *t1 = objtypename(p1);
594   const char *t2 = objtypename(p2);
595   if (t1 == t2)
596     luaG_runerror(L, "attempt to compare two %s values", t1);
597   else
598     luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
599 }
600
601
602 /* add src:line information to 'msg' */
603 const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,
604                                         int line) {
605   char buff[LUA_IDSIZE];
606   if (src)
607     luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
608   else {  /* no source available; use "?" instead */
609     buff[0] = '?'; buff[1] = '\0';
610   }
611   return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
612 }
613
614
615 l_noret luaG_errormsg (lua_State *L) {
616   if (L->errfunc != 0) {  /* is there an error handling function? */
617     StkId errfunc = restorestack(L, L->errfunc);
618     setobjs2s(L, L->top, L->top - 1);  /* move argument */
619     setobjs2s(L, L->top - 1, errfunc);  /* push function */
620     L->top++;  /* assume EXTRA_STACK */
621     luaD_callnoyield(L, L->top - 2, 1);  /* call it */
622   }
623   luaD_throw(L, LUA_ERRRUN);
624 }
625
626
627 l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
628   CallInfo *ci = L->ci;
629   const char *msg;
630   va_list argp;
631   va_start(argp, fmt);
632   msg = luaO_pushvfstring(L, fmt, argp);  /* format message */
633   va_end(argp);
634   if (isLua(ci))  /* if Lua function, add source:line information */
635     luaG_addinfo(L, msg, ci_func(ci)->p->source, currentline(ci));
636   luaG_errormsg(L);
637 }
638
639
640 void luaG_traceexec (lua_State *L) {
641   CallInfo *ci = L->ci;
642   lu_byte mask = L->hookmask;
643   int counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
644   if (counthook)
645     resethookcount(L);  /* reset count */
646   else if (!(mask & LUA_MASKLINE))
647     return;  /* no line hook and count != 0; nothing to be done */
648   if (ci->callstatus & CIST_HOOKYIELD) {  /* called hook last time? */
649     ci->callstatus &= ~CIST_HOOKYIELD;  /* erase mark */
650     return;  /* do not call hook again (VM yielded, so it did not move) */
651   }
652   if (counthook)
653     luaD_hook(L, LUA_HOOKCOUNT, -1);  /* call count hook */
654   if (mask & LUA_MASKLINE) {
655     Proto *p = ci_func(ci)->p;
656     int npc = pcRel(ci->u.l.savedpc, p);
657     int newline = getfuncline(p, npc);
658     if (npc == 0 ||  /* call linehook when enter a new function, */
659         ci->u.l.savedpc <= L->oldpc ||  /* when jump back (loop), or when */
660         newline != getfuncline(p, pcRel(L->oldpc, p)))  /* enter a new line */
661       luaD_hook(L, LUA_HOOKLINE, newline);  /* call line hook */
662   }
663   L->oldpc = ci->u.l.savedpc;
664   if (L->status == LUA_YIELD) {  /* did hook yield? */
665     if (counthook)
666       L->hookcount = 1;  /* undo decrement to zero */
667     ci->u.l.savedpc--;  /* undo increment (resume will increment it again) */
668     ci->callstatus |= CIST_HOOKYIELD;  /* mark that it yielded */
669     ci->func = L->top - 1;  /* protect stack below results */
670     luaD_throw(L, LUA_YIELD);
671   }
672 }
673