ad498d2e28e986f2af6f8f23f2ba77904b3ba0ce
[olsrd.git] / lib / tas / src / lua / ldebug.c
1
2 /*
3 ** $Id: ldebug.c,v 1.150 2003/03/19 21:24:04 roberto Exp $
4 ** Debug Interface
5 ** See Copyright Notice in lua.h
6 */
7
8
9 #include <stdlib.h>
10 #include <string.h>
11
12 #define ldebug_c
13
14 #include "lua.h"
15
16 #include "lapi.h"
17 #include "lcode.h"
18 #include "ldebug.h"
19 #include "ldo.h"
20 #include "lfunc.h"
21 #include "lobject.h"
22 #include "lopcodes.h"
23 #include "lstate.h"
24 #include "lstring.h"
25 #include "ltable.h"
26 #include "ltm.h"
27 #include "lvm.h"
28
29
30
31 static const char *getfuncname(CallInfo * ci, const char **name);
32
33
34 #define isLua(ci)       (!((ci)->state & CI_C))
35
36
37 static int
38 currentpc(CallInfo * ci)
39 {
40   if (!isLua(ci))
41     return -1;                  /* function is not a Lua function? */
42   if (ci->state & CI_HASFRAME)  /* function has a frame? */
43     ci->u.l.savedpc = *ci->u.l.pc;      /* use `pc' from there */
44   /* function's pc is saved */
45   return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p);
46 }
47
48
49 static int
50 currentline(CallInfo * ci)
51 {
52   int pc = currentpc(ci);
53   if (pc < 0)
54     return -1;                  /* only active lua functions have current-line information */
55   else
56     return getline(ci_func(ci)->l.p, pc);
57 }
58
59
60 void
61 luaG_inithooks(lua_State * L)
62 {
63   CallInfo *ci;
64   for (ci = L->ci; ci != L->base_ci; ci--)      /* update all `savedpc's */
65     currentpc(ci);
66   L->hookinit = 1;
67 }
68
69
70 /*
71 ** this function can be called asynchronous (e.g. during a signal)
72 */
73 LUA_API int
74 lua_sethook(lua_State * L, lua_Hook func, int mask, int count)
75 {
76   if (func == NULL || mask == 0) {      /* turn off hooks? */
77     mask = 0;
78     func = NULL;
79   }
80   L->hook = func;
81   L->basehookcount = count;
82   resethookcount(L);
83   L->hookmask = cast(lu_byte, mask);
84   L->hookinit = 0;
85   return 1;
86 }
87
88
89 LUA_API lua_Hook
90 lua_gethook(lua_State * L)
91 {
92   return L->hook;
93 }
94
95
96 LUA_API int
97 lua_gethookmask(lua_State * L)
98 {
99   return L->hookmask;
100 }
101
102
103 LUA_API int
104 lua_gethookcount(lua_State * L)
105 {
106   return L->basehookcount;
107 }
108
109
110 LUA_API int
111 lua_getstack(lua_State * L, int level, lua_Debug * ar)
112 {
113   int status;
114   CallInfo *ci;
115   lua_lock(L);
116   for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
117     level--;
118     if (!(ci->state & CI_C))    /* Lua function? */
119       level -= ci->u.l.tailcalls;       /* skip lost tail calls */
120   }
121   if (level > 0 || ci == L->base_ci)
122     status = 0;                 /* there is no such level */
123   else if (level < 0) {         /* level is of a lost tail call */
124     status = 1;
125     ar->i_ci = 0;
126   } else {
127     status = 1;
128     ar->i_ci = ci - L->base_ci;
129   }
130   lua_unlock(L);
131   return status;
132 }
133
134
135 static Proto *
136 getluaproto(CallInfo * ci)
137 {
138   return (isLua(ci) ? ci_func(ci)->l.p : NULL);
139 }
140
141
142 LUA_API const char *
143 lua_getlocal(lua_State * L, const lua_Debug * ar, int n)
144 {
145   const char *name;
146   CallInfo *ci;
147   Proto *fp;
148   lua_lock(L);
149   name = NULL;
150   ci = L->base_ci + ar->i_ci;
151   fp = getluaproto(ci);
152   if (fp) {                     /* is a Lua function? */
153     name = luaF_getlocalname(fp, n, currentpc(ci));
154     if (name)
155       luaA_pushobject(L, ci->base + (n - 1));   /* push value */
156   }
157   lua_unlock(L);
158   return name;
159 }
160
161
162 LUA_API const char *
163 lua_setlocal(lua_State * L, const lua_Debug * ar, int n)
164 {
165   const char *name;
166   CallInfo *ci;
167   Proto *fp;
168   lua_lock(L);
169   name = NULL;
170   ci = L->base_ci + ar->i_ci;
171   fp = getluaproto(ci);
172   L->top--;                     /* pop new value */
173   if (fp) {                     /* is a Lua function? */
174     name = luaF_getlocalname(fp, n, currentpc(ci));
175     if (!name || name[0] == '(')        /* `(' starts private locals */
176       name = NULL;
177     else
178       setobjs2s(ci->base + (n - 1), L->top);
179   }
180   lua_unlock(L);
181   return name;
182 }
183
184
185 static void
186 funcinfo(lua_Debug * ar, StkId func)
187 {
188   Closure *cl = clvalue(func);
189   if (cl->c.isC) {
190     ar->source = "=[C]";
191     ar->linedefined = -1;
192     ar->what = "C";
193   } else {
194     ar->source = getstr(cl->l.p->source);
195     ar->linedefined = cl->l.p->lineDefined;
196     ar->what = (ar->linedefined == 0) ? "main" : "Lua";
197   }
198   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
199 }
200
201
202 static const char *
203 travglobals(lua_State * L, const TObject * o)
204 {
205   Table *g = hvalue(gt(L));
206   int i = sizenode(g);
207   while (i--) {
208     Node *n = gnode(g, i);
209     if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n)))
210       return getstr(tsvalue(gkey(n)));
211   }
212   return NULL;
213 }
214
215
216 static void
217 info_tailcall(lua_State * L, lua_Debug * ar)
218 {
219   ar->name = ar->namewhat = "";
220   ar->what = "tail";
221   ar->linedefined = ar->currentline = -1;
222   ar->source = "=(tail call)";
223   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
224   ar->nups = 0;
225   setnilvalue(L->top);
226 }
227
228
229 static int
230 auxgetinfo(lua_State * L, const char *what, lua_Debug * ar, StkId f, CallInfo * ci)
231 {
232   int status = 1;
233   for (; *what; what++) {
234     switch (*what) {
235     case 'S':{
236         funcinfo(ar, f);
237         break;
238       }
239     case 'l':{
240         ar->currentline = (ci) ? currentline(ci) : -1;
241         break;
242       }
243     case 'u':{
244         ar->nups = clvalue(f)->c.nupvalues;
245         break;
246       }
247     case 'n':{
248         ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL;
249         if (ar->namewhat == NULL) {
250           /* try to find a global name */
251           if ((ar->name = travglobals(L, f)) != NULL)
252             ar->namewhat = "global";
253           else
254             ar->namewhat = "";  /* not found */
255         }
256         break;
257       }
258     case 'f':{
259         setobj2s(L->top, f);
260         break;
261       }
262     default:
263       status = 0;               /* invalid option */
264     }
265   }
266   return status;
267 }
268
269
270 LUA_API int
271 lua_getinfo(lua_State * L, const char *what, lua_Debug * ar)
272 {
273   int status = 1;
274   lua_lock(L);
275   if (*what == '>') {
276     StkId f = L->top - 1;
277     if (!ttisfunction(f))
278       luaG_runerror(L, "value for `lua_getinfo' is not a function");
279     status = auxgetinfo(L, what + 1, ar, f, NULL);
280     L->top--;                   /* pop function */
281   } else if (ar->i_ci != 0) {   /* no tail call? */
282     CallInfo *ci = L->base_ci + ar->i_ci;
283     lua_assert(ttisfunction(ci->base - 1));
284     status = auxgetinfo(L, what, ar, ci->base - 1, ci);
285   } else
286     info_tailcall(L, ar);
287   if (strchr(what, 'f'))
288     incr_top(L);
289   lua_unlock(L);
290   return status;
291 }
292
293
294 /*
295 ** {======================================================
296 ** Symbolic Execution and code checker
297 ** =======================================================
298 */
299
300 #define check(x)                if (!(x)) return 0;
301
302 #define checkjump(pt,pc)        check(0 <= pc && pc < pt->sizecode)
303
304 #define checkreg(pt,reg)        check((reg) < (pt)->maxstacksize)
305
306
307
308 static int
309 precheck(const Proto * pt)
310 {
311   check(pt->maxstacksize <= MAXSTACK);
312   check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0);
313   lua_assert(pt->numparams + pt->is_vararg <= pt->maxstacksize);
314   check(GET_OPCODE(pt->code[pt->sizecode - 1]) == OP_RETURN);
315   return 1;
316 }
317
318
319 static int
320 checkopenop(const Proto * pt, int pc)
321 {
322   Instruction i = pt->code[pc + 1];
323   switch (GET_OPCODE(i)) {
324   case OP_CALL:
325   case OP_TAILCALL:
326   case OP_RETURN:{
327       check(GETARG_B(i) == 0);
328       return 1;
329     }
330   case OP_SETLISTO:
331     return 1;
332   default:
333     return 0;                   /* invalid instruction after an open call */
334   }
335 }
336
337
338 static int
339 checkRK(const Proto * pt, int r)
340 {
341   return (r < pt->maxstacksize || (r >= MAXSTACK && r - MAXSTACK < pt->sizek));
342 }
343
344
345 static Instruction
346 luaG_symbexec(const Proto * pt, int lastpc, int reg)
347 {
348   int pc;
349   int last;                            /* stores position of last instruction that changed `reg' */
350   last = pt->sizecode - 1;      /* points to final return (a `neutral' instruction) */
351   check(precheck(pt));
352   for (pc = 0; pc < lastpc; pc++) {
353     const Instruction i = pt->code[pc];
354     OpCode op = GET_OPCODE(i);
355     int a = GETARG_A(i);
356     int b = 0;
357     int c = 0;
358     checkreg(pt, a);
359     switch (getOpMode(op)) {
360     case iABC:{
361         b = GETARG_B(i);
362         c = GETARG_C(i);
363         if (testOpMode(op, OpModeBreg)) {
364           checkreg(pt, b);
365         } else if (testOpMode(op, OpModeBrk))
366           check(checkRK(pt, b));
367         if (testOpMode(op, OpModeCrk))
368           check(checkRK(pt, c));
369         break;
370       }
371     case iABx:{
372         b = GETARG_Bx(i);
373         if (testOpMode(op, OpModeK))
374           check(b < pt->sizek);
375         break;
376       }
377     case iAsBx:{
378         b = GETARG_sBx(i);
379         break;
380       }
381     }
382     if (testOpMode(op, OpModesetA)) {
383       if (a == reg)
384         last = pc;              /* change register `a' */
385     }
386     if (testOpMode(op, OpModeT)) {
387       check(pc + 2 < pt->sizecode);     /* check skip */
388       check(GET_OPCODE(pt->code[pc + 1]) == OP_JMP);
389     }
390     switch (op) {
391     case OP_LOADBOOL:{
392         check(c == 0 || pc + 2 < pt->sizecode); /* check its jump */
393         break;
394       }
395     case OP_LOADNIL:{
396         if (a <= reg && reg <= b)
397           last = pc;            /* set registers from `a' to `b' */
398         break;
399       }
400     case OP_GETUPVAL:
401     case OP_SETUPVAL:{
402         check(b < pt->nups);
403         break;
404       }
405     case OP_GETGLOBAL:
406     case OP_SETGLOBAL:{
407         check(ttisstring(&pt->k[b]));
408         break;
409       }
410     case OP_SELF:{
411         checkreg(pt, a + 1);
412         if (reg == a + 1)
413           last = pc;
414         break;
415       }
416     case OP_CONCAT:{
417         /* `c' is a register, and at least two operands */
418         check(c < MAXSTACK && b < c);
419         break;
420       }
421     case OP_TFORLOOP:
422       checkreg(pt, a + c + 5);
423       if (reg >= a)
424         last = pc;              /* affect all registers above base */
425       /* go through */
426     case OP_FORLOOP:
427       checkreg(pt, a + 2);
428       /* go through */
429     case OP_JMP:{
430         int dest = pc + 1 + b;
431         check(0 <= dest && dest < pt->sizecode);
432         /* not full check and jump is forward and do not skip `lastpc'? */
433         if (reg != NO_REG && pc < dest && dest <= lastpc)
434           pc += b;              /* do the jump */
435         break;
436       }
437     case OP_CALL:
438     case OP_TAILCALL:{
439         if (b != 0) {
440           checkreg(pt, a + b - 1);
441         }
442         c--;                    /* c = num. returns */
443         if (c == LUA_MULTRET) {
444           check(checkopenop(pt, pc));
445         } else if (c != 0)
446           checkreg(pt, a + c - 1);
447         if (reg >= a)
448           last = pc;            /* affect all registers above base */
449         break;
450       }
451     case OP_RETURN:{
452         b--;                    /* b = num. returns */
453         if (b > 0)
454           checkreg(pt, a + b - 1);
455         break;
456       }
457     case OP_SETLIST:{
458         checkreg(pt, a + (b & (LFIELDS_PER_FLUSH - 1)) + 1);
459         break;
460       }
461     case OP_CLOSURE:{
462         int nup;
463         check(b < pt->sizep);
464         nup = pt->p[b]->nups;
465         check(pc + nup < pt->sizecode);
466         for (; nup > 0; nup--) {
467           OpCode op1 = GET_OPCODE(pt->code[pc + nup]);
468           check(op1 == OP_GETUPVAL || op1 == OP_MOVE);
469         }
470         break;
471       }
472     default:
473       break;
474     }
475   }
476   return pt->code[last];
477 }
478
479 #undef check
480 #undef checkjump
481 #undef checkreg
482
483 /* }====================================================== */
484
485
486 int
487 luaG_checkcode(const Proto * pt)
488 {
489   return luaG_symbexec(pt, pt->sizecode, NO_REG);
490 }
491
492
493 static const char *
494 kname(Proto * p, int c)
495 {
496   c = c - MAXSTACK;
497   if (c >= 0 && ttisstring(&p->k[c]))
498     return svalue(&p->k[c]);
499   else
500     return "?";
501 }
502
503
504 static const char *
505 getobjname(CallInfo * ci, int stackpos, const char **name)
506 {
507   if (isLua(ci)) {              /* a Lua function? */
508     Proto *p = ci_func(ci)->l.p;
509     int pc = currentpc(ci);
510     Instruction i;
511     *name = luaF_getlocalname(p, stackpos + 1, pc);
512     if (*name)                  /* is a local? */
513       return "local";
514     i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */
515     lua_assert(pc != -1);
516     switch (GET_OPCODE(i)) {
517     case OP_GETGLOBAL:{
518         int g = GETARG_Bx(i);          /* global index */
519         lua_assert(ttisstring(&p->k[g]));
520         *name = svalue(&p->k[g]);
521         return "global";
522       }
523     case OP_MOVE:{
524         int a = GETARG_A(i);
525         int b = GETARG_B(i);           /* move from `b' to `a' */
526         if (b < a)
527           return getobjname(ci, b, name);       /* get name for `b' */
528         break;
529       }
530     case OP_GETTABLE:{
531         int k = GETARG_C(i);           /* key index */
532         *name = kname(p, k);
533         return "field";
534       }
535     case OP_SELF:{
536         int k = GETARG_C(i);           /* key index */
537         *name = kname(p, k);
538         return "method";
539       }
540     default:
541       break;
542     }
543   }
544   return NULL;                  /* no useful name found */
545 }
546
547
548 static const char *
549 getfuncname(CallInfo * ci, const char **name)
550 {
551   Instruction i;
552   if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1))
553     return NULL;                /* calling function is not Lua (or is unknown) */
554   ci--;                         /* calling function */
555   i = ci_func(ci)->l.p->code[currentpc(ci)];
556   if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL)
557     return getobjname(ci, GETARG_A(i), name);
558   else
559     return NULL;                /* no useful name can be found */
560 }
561
562
563 /* only ANSI way to check whether a pointer points to an array */
564 static int
565 isinstack(CallInfo * ci, const TObject * o)
566 {
567   StkId p;
568   for (p = ci->base; p < ci->top; p++)
569     if (o == p)
570       return 1;
571   return 0;
572 }
573
574
575 void
576 luaG_typeerror(lua_State * L, const TObject * o, const char *op)
577 {
578   const char *name = NULL;
579   const char *t = luaT_typenames[ttype(o)];
580   const char *kind = (isinstack(L->ci, o)) ? getobjname(L->ci, o - L->base, &name) : NULL;
581   if (kind)
582     luaG_runerror(L, "attempt to %s %s `%s' (a %s value)", op, kind, name, t);
583   else
584     luaG_runerror(L, "attempt to %s a %s value", op, t);
585 }
586
587
588 void
589 luaG_concaterror(lua_State * L, StkId p1, StkId p2)
590 {
591   if (ttisstring(p1))
592     p1 = p2;
593   lua_assert(!ttisstring(p1));
594   luaG_typeerror(L, p1, "concatenate");
595 }
596
597
598 void
599 luaG_aritherror(lua_State * L, const TObject * p1, const TObject * p2)
600 {
601   TObject temp;
602   if (luaV_tonumber(p1, &temp) == NULL)
603     p2 = p1;                    /* first operand is wrong */
604   luaG_typeerror(L, p2, "perform arithmetic on");
605 }
606
607
608 int
609 luaG_ordererror(lua_State * L, const TObject * p1, const TObject * p2)
610 {
611   const char *t1 = luaT_typenames[ttype(p1)];
612   const char *t2 = luaT_typenames[ttype(p2)];
613   if (t1[2] == t2[2])
614     luaG_runerror(L, "attempt to compare two %s values", t1);
615   else
616     luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
617 }
618
619
620 static void
621 addinfo(lua_State * L, const char *msg)
622 {
623   CallInfo *ci = L->ci;
624   if (isLua(ci)) {              /* is Lua code? */
625     char buff[LUA_IDSIZE];             /* add file:line information */
626     int line = currentline(ci);
627     luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE);
628     luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
629   }
630 }
631
632
633 void
634 luaG_errormsg(lua_State * L)
635 {
636   if (L->errfunc != 0) {        /* is there an error handling function? */
637     StkId errfunc = restorestack(L, L->errfunc);
638     if (!ttisfunction(errfunc))
639       luaD_throw(L, LUA_ERRERR);
640     setobjs2s(L->top, L->top - 1);      /* move argument */
641     setobjs2s(L->top - 1, errfunc);     /* push function */
642     incr_top(L);
643     luaD_call(L, L->top - 2, 1);        /* call it */
644   }
645   luaD_throw(L, LUA_ERRRUN);
646 }
647
648
649 void
650 luaG_runerror(lua_State * L, const char *fmt, ...)
651 {
652   va_list argp;
653   va_start(argp, fmt);
654   addinfo(L, luaO_pushvfstring(L, fmt, argp));
655   va_end(argp);
656   luaG_errormsg(L);
657 }