Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/ceguilua/src/lua/ldebug.c @ 2157

Last change on this file since 2157 was 1806, checked in by rgrieder, 16 years ago

added single 5.1.3 directory for lua since CEGUILua 0.5 can also build against lua 5.1

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