← Back to branch summary

~ubuntu-branches/ubuntu/vivid/emscripten/vivid

« back to all changes in this revision

Viewing changes to tests/lua/src/ldebug.c

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2013-05-02 13:11:51 UTC
  • Revision ID: package-import@ubuntu.com-20130502131151-q8dvteqr1ef2x7xz
Tags: upstream-1.4.1~20130504~adb56cb
Import upstream version 1.4.1~20130504~adb56cb

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lua/src/ldebug.c
 
1
/*
 
2
** $Id: ldebug.c,v 2.90 2012/08/16 17:34:28 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
 
 
33
#define noLuaClosure(f)         ((f) == NULL || (f)->c.tt == LUA_TCCL)
 
34
 
 
35
 
 
36
static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
 
37
 
 
38
 
 
39
static int currentpc (CallInfo *ci) {
 
40
  lua_assert(isLua(ci));
 
41
  return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
 
42
}
 
43
 
 
44
 
 
45
static int currentline (CallInfo *ci) {
 
46
  return getfuncline(ci_func(ci)->p, currentpc(ci));
 
47
}
 
48
 
 
49
 
 
50
/*
 
51
** this function can be called asynchronous (e.g. during a signal)
 
52
*/
 
53
LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
 
54
  if (func == NULL || mask == 0) {  /* turn off hooks? */
 
55
    mask = 0;
 
56
    func = NULL;
 
57
  }
 
58
  if (isLua(L->ci))
 
59
    L->oldpc = L->ci->u.l.savedpc;
 
60
  L->hook = func;
 
61
  L->basehookcount = count;
 
62
  resethookcount(L);
 
63
  L->hookmask = cast_byte(mask);
 
64
  return 1;
 
65
}
 
66
 
 
67
 
 
68
LUA_API lua_Hook lua_gethook (lua_State *L) {
 
69
  return L->hook;
 
70
}
 
71
 
 
72
 
 
73
LUA_API int lua_gethookmask (lua_State *L) {
 
74
  return L->hookmask;
 
75
}
 
76
 
 
77
 
 
78
LUA_API int lua_gethookcount (lua_State *L) {
 
79
  return L->basehookcount;
 
80
}
 
81
 
 
82
 
 
83
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
 
84
  int status;
 
85
  CallInfo *ci;
 
86
  if (level < 0) return 0;  /* invalid (negative) level */
 
87
  lua_lock(L);
 
88
  for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
 
89
    level--;
 
90
  if (level == 0 && ci != &L->base_ci) {  /* level found? */
 
91
    status = 1;
 
92
    ar->i_ci = ci;
 
93
  }
 
94
  else status = 0;  /* no such level */
 
95
  lua_unlock(L);
 
96
  return status;
 
97
}
 
98
 
 
99
 
 
100
static const char *upvalname (Proto *p, int uv) {
 
101
  TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
 
102
  if (s == NULL) return "?";
 
103
  else return getstr(s);
 
104
}
 
105
 
 
106
 
 
107
static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
 
108
  int nparams = clLvalue(ci->func)->p->numparams;
 
109
  if (n >= ci->u.l.base - ci->func - nparams)
 
110
    return NULL;  /* no such vararg */
 
111
  else {
 
112
    *pos = ci->func + nparams + n;
 
113
    return "(*vararg)";  /* generic name for any vararg */
 
114
  }
 
115
}
 
116
 
 
117
 
 
118
static const char *findlocal (lua_State *L, CallInfo *ci, int n,
 
119
                              StkId *pos) {
 
120
  const char *name = NULL;
 
121
  StkId base;
 
122
  if (isLua(ci)) {
 
123
    if (n < 0)  /* access to vararg values? */
 
124
      return findvararg(ci, -n, pos);
 
125
    else {
 
126
      base = ci->u.l.base;
 
127
      name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
 
128
    }
 
129
  }
 
130
  else
 
131
    base = ci->func + 1;
 
132
  if (name == NULL) {  /* no 'standard' name? */
 
133
    StkId limit = (ci == L->ci) ? L->top : ci->next->func;
 
134
    if (limit - base >= n && n > 0)  /* is 'n' inside 'ci' stack? */
 
135
      name = "(*temporary)";  /* generic name for any valid slot */
 
136
    else
 
137
      return NULL;  /* no name */
 
138
  }
 
139
  *pos = base + (n - 1);
 
140
  return name;
 
141
}
 
142
 
 
143
 
 
144
LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
 
145
  const char *name;
 
146
  lua_lock(L);
 
147
  if (ar == NULL) {  /* information about non-active function? */
 
148
    if (!isLfunction(L->top - 1))  /* not a Lua function? */
 
149
      name = NULL;
 
150
    else  /* consider live variables at function start (parameters) */
 
151
      name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);
 
152
  }
 
153
  else {  /* active function; get information through 'ar' */
 
154
    StkId pos = 0;  /* to avoid warnings */
 
155
    name = findlocal(L, ar->i_ci, n, &pos);
 
156
    if (name) {
 
157
      setobj2s(L, L->top, pos);
 
158
      api_incr_top(L);
 
159
    }
 
160
  }
 
161
  lua_unlock(L);
 
162
  return name;
 
163
}
 
164
 
 
165
 
 
166
LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
 
167
  StkId pos = 0;  /* to avoid warnings */
 
168
  const char *name = findlocal(L, ar->i_ci, n, &pos);
 
169
  lua_lock(L);
 
170
  if (name)
 
171
    setobjs2s(L, pos, L->top - 1);
 
172
  L->top--;  /* pop value */
 
173
  lua_unlock(L);
 
174
  return name;
 
175
}
 
176
 
 
177
 
 
178
static void funcinfo (lua_Debug *ar, Closure *cl) {
 
179
  if (noLuaClosure(cl)) {
 
180
    ar->source = "=[C]";
 
181
    ar->linedefined = -1;
 
182
    ar->lastlinedefined = -1;
 
183
    ar->what = "C";
 
184
  }
 
185
  else {
 
186
    Proto *p = cl->l.p;
 
187
    ar->source = p->source ? getstr(p->source) : "=?";
 
188
    ar->linedefined = p->linedefined;
 
189
    ar->lastlinedefined = p->lastlinedefined;
 
190
    ar->what = (ar->linedefined == 0) ? "main" : "Lua";
 
191
  }
 
192
  luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
 
193
}
 
194
 
 
195
 
 
196
static void collectvalidlines (lua_State *L, Closure *f) {
 
197
  if (noLuaClosure(f)) {
 
198
    setnilvalue(L->top);
 
199
    api_incr_top(L);
 
200
  }
 
201
  else {
 
202
    int i;
 
203
    TValue v;
 
204
    int *lineinfo = f->l.p->lineinfo;
 
205
    Table *t = luaH_new(L);  /* new table to store active lines */
 
206
    sethvalue(L, L->top, t);  /* push it on stack */
 
207
    api_incr_top(L);
 
208
    setbvalue(&v, 1);  /* boolean 'true' to be the value of all indices */
 
209
    for (i = 0; i < f->l.p->sizelineinfo; i++)  /* for all lines with code */
 
210
      luaH_setint(L, t, lineinfo[i], &v);  /* table[line] = true */
 
211
  }
 
212
}
 
213
 
 
214
 
 
215
static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
 
216
                       Closure *f, CallInfo *ci) {
 
217
  int status = 1;
 
218
  for (; *what; what++) {
 
219
    switch (*what) {
 
220
      case 'S': {
 
221
        funcinfo(ar, f);
 
222
        break;
 
223
      }
 
224
      case 'l': {
 
225
        ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;
 
226
        break;
 
227
      }
 
228
      case 'u': {
 
229
        ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
 
230
        if (noLuaClosure(f)) {
 
231
          ar->isvararg = 1;
 
232
          ar->nparams = 0;
 
233
        }
 
234
        else {
 
235
          ar->isvararg = f->l.p->is_vararg;
 
236
          ar->nparams = f->l.p->numparams;
 
237
        }
 
238
        break;
 
239
      }
 
240
      case 't': {
 
241
        ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
 
242
        break;
 
243
      }
 
244
      case 'n': {
 
245
        /* calling function is a known Lua function? */
 
246
        if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
 
247
          ar->namewhat = getfuncname(L, ci->previous, &ar->name);
 
248
        else
 
249
          ar->namewhat = NULL;
 
250
        if (ar->namewhat == NULL) {
 
251
          ar->namewhat = "";  /* not found */
 
252
          ar->name = NULL;
 
253
        }
 
254
        break;
 
255
      }
 
256
      case 'L':
 
257
      case 'f':  /* handled by lua_getinfo */
 
258
        break;
 
259
      default: status = 0;  /* invalid option */
 
260
    }
 
261
  }
 
262
  return status;
 
263
}
 
264
 
 
265
 
 
266
LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
 
267
  int status;
 
268
  Closure *cl;
 
269
  CallInfo *ci;
 
270
  StkId func;
 
271
  lua_lock(L);
 
272
  if (*what == '>') {
 
273
    ci = NULL;
 
274
    func = L->top - 1;
 
275
    api_check(L, ttisfunction(func), "function expected");
 
276
    what++;  /* skip the '>' */
 
277
    L->top--;  /* pop function */
 
278
  }
 
279
  else {
 
280
    ci = ar->i_ci;
 
281
    func = ci->func;
 
282
    lua_assert(ttisfunction(ci->func));
 
283
  }
 
284
  cl = ttisclosure(func) ? clvalue(func) : NULL;
 
285
  status = auxgetinfo(L, what, ar, cl, ci);
 
286
  if (strchr(what, 'f')) {
 
287
    setobjs2s(L, L->top, func);
 
288
    api_incr_top(L);
 
289
  }
 
290
  if (strchr(what, 'L'))
 
291
    collectvalidlines(L, cl);
 
292
  lua_unlock(L);
 
293
  return status;
 
294
}
 
295
 
 
296
 
 
297
/*
 
298
** {======================================================
 
299
** Symbolic Execution
 
300
** =======================================================
 
301
*/
 
302
 
 
303
static const char *getobjname (Proto *p, int lastpc, int reg,
 
304
                               const char **name);
 
305
 
 
306
 
 
307
/*
 
308
** find a "name" for the RK value 'c'
 
309
*/
 
310
static void kname (Proto *p, int pc, int c, const char **name) {
 
311
  if (ISK(c)) {  /* is 'c' a constant? */
 
312
    TValue *kvalue = &p->k[INDEXK(c)];
 
313
    if (ttisstring(kvalue)) {  /* literal constant? */
 
314
      *name = svalue(kvalue);  /* it is its own name */
 
315
      return;
 
316
    }
 
317
    /* else no reasonable name found */
 
318
  }
 
319
  else {  /* 'c' is a register */
 
320
    const char *what = getobjname(p, pc, c, name); /* search for 'c' */
 
321
    if (what && *what == 'c') {  /* found a constant name? */
 
322
      return;  /* 'name' already filled */
 
323
    }
 
324
    /* else no reasonable name found */
 
325
  }
 
326
  *name = "?";  /* no reasonable name found */
 
327
}
 
328
 
 
329
 
 
330
/*
 
331
** try to find last instruction before 'lastpc' that modified register 'reg'
 
332
*/
 
333
static int findsetreg (Proto *p, int lastpc, int reg) {
 
334
  int pc;
 
335
  int setreg = -1;  /* keep last instruction that changed 'reg' */
 
336
  for (pc = 0; pc < lastpc; pc++) {
 
337
    Instruction i = p->code[pc];
 
338
    OpCode op = GET_OPCODE(i);
 
339
    int a = GETARG_A(i);
 
340
    switch (op) {
 
341
      case OP_LOADNIL: {
 
342
        int b = GETARG_B(i);
 
343
        if (a <= reg && reg <= a + b)  /* set registers from 'a' to 'a+b' */
 
344
          setreg = pc;
 
345
        break;
 
346
      }
 
347
      case OP_TFORCALL: {
 
348
        if (reg >= a + 2) setreg = pc;  /* affect all regs above its base */
 
349
        break;
 
350
      }
 
351
      case OP_CALL:
 
352
      case OP_TAILCALL: {
 
353
        if (reg >= a) setreg = pc;  /* affect all registers above base */
 
354
        break;
 
355
      }
 
356
      case OP_JMP: {
 
357
        int b = GETARG_sBx(i);
 
358
        int dest = pc + 1 + b;
 
359
        /* jump is forward and do not skip `lastpc'? */
 
360
        if (pc < dest && dest <= lastpc)
 
361
          pc += b;  /* do the jump */
 
362
        break;
 
363
      }
 
364
      case OP_TEST: {
 
365
        if (reg == a) setreg = pc;  /* jumped code can change 'a' */
 
366
        break;
 
367
      }
 
368
      default:
 
369
        if (testAMode(op) && reg == a)  /* any instruction that set A */
 
370
          setreg = pc;
 
371
        break;
 
372
    }
 
373
  }
 
374
  return setreg;
 
375
}
 
376
 
 
377
 
 
378
static const char *getobjname (Proto *p, int lastpc, int reg,
 
379
                               const char **name) {
 
380
  int pc;
 
381
  *name = luaF_getlocalname(p, reg + 1, lastpc);
 
382
  if (*name)  /* is a local? */
 
383
    return "local";
 
384
  /* else try symbolic execution */
 
385
  pc = findsetreg(p, lastpc, reg);
 
386
  if (pc != -1) {  /* could find instruction? */
 
387
    Instruction i = p->code[pc];
 
388
    OpCode op = GET_OPCODE(i);
 
389
    switch (op) {
 
390
      case OP_MOVE: {
 
391
        int b = GETARG_B(i);  /* move from 'b' to 'a' */
 
392
        if (b < GETARG_A(i))
 
393
          return getobjname(p, pc, b, name);  /* get name for 'b' */
 
394
        break;
 
395
      }
 
396
      case OP_GETTABUP:
 
397
      case OP_GETTABLE: {
 
398
        int k = GETARG_C(i);  /* key index */
 
399
        int t = GETARG_B(i);  /* table index */
 
400
        const char *vn = (op == OP_GETTABLE)  /* name of indexed variable */
 
401
                         ? luaF_getlocalname(p, t + 1, pc)
 
402
                         : upvalname(p, t);
 
403
        kname(p, pc, k, name);
 
404
        return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";
 
405
      }
 
406
      case OP_GETUPVAL: {
 
407
        *name = upvalname(p, GETARG_B(i));
 
408
        return "upvalue";
 
409
      }
 
410
      case OP_LOADK:
 
411
      case OP_LOADKX: {
 
412
        int b = (op == OP_LOADK) ? GETARG_Bx(i)
 
413
                                 : GETARG_Ax(p->code[pc + 1]);
 
414
        if (ttisstring(&p->k[b])) {
 
415
          *name = svalue(&p->k[b]);
 
416
          return "constant";
 
417
        }
 
418
        break;
 
419
      }
 
420
      case OP_SELF: {
 
421
        int k = GETARG_C(i);  /* key index */
 
422
        kname(p, pc, k, name);
 
423
        return "method";
 
424
      }
 
425
      default: break;  /* go through to return NULL */
 
426
    }
 
427
  }
 
428
  return NULL;  /* could not find reasonable name */
 
429
}
 
430
 
 
431
 
 
432
static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
 
433
  TMS tm;
 
434
  Proto *p = ci_func(ci)->p;  /* calling function */
 
435
  int pc = currentpc(ci);  /* calling instruction index */
 
436
  Instruction i = p->code[pc];  /* calling instruction */
 
437
  switch (GET_OPCODE(i)) {
 
438
    case OP_CALL:
 
439
    case OP_TAILCALL:  /* get function name */
 
440
      return getobjname(p, pc, GETARG_A(i), name);
 
441
    case OP_TFORCALL: {  /* for iterator */
 
442
      *name = "for iterator";
 
443
       return "for iterator";
 
444
    }
 
445
    /* all other instructions can call only through metamethods */
 
446
    case OP_SELF:
 
447
    case OP_GETTABUP:
 
448
    case OP_GETTABLE: tm = TM_INDEX; break;
 
449
    case OP_SETTABUP:
 
450
    case OP_SETTABLE: tm = TM_NEWINDEX; break;
 
451
    case OP_EQ: tm = TM_EQ; break;
 
452
    case OP_ADD: tm = TM_ADD; break;
 
453
    case OP_SUB: tm = TM_SUB; break;
 
454
    case OP_MUL: tm = TM_MUL; break;
 
455
    case OP_DIV: tm = TM_DIV; break;
 
456
    case OP_MOD: tm = TM_MOD; break;
 
457
    case OP_POW: tm = TM_POW; break;
 
458
    case OP_UNM: tm = TM_UNM; break;
 
459
    case OP_LEN: tm = TM_LEN; break;
 
460
    case OP_LT: tm = TM_LT; break;
 
461
    case OP_LE: tm = TM_LE; break;
 
462
    case OP_CONCAT: tm = TM_CONCAT; break;
 
463
    default:
 
464
      return NULL;  /* else no useful name can be found */
 
465
  }
 
466
  *name = getstr(G(L)->tmname[tm]);
 
467
  return "metamethod";
 
468
}
 
469
 
 
470
/* }====================================================== */
 
471
 
 
472
 
 
473
 
 
474
/*
 
475
** only ANSI way to check whether a pointer points to an array
 
476
** (used only for error messages, so efficiency is not a big concern)
 
477
*/
 
478
static int isinstack (CallInfo *ci, const TValue *o) {
 
479
  StkId p;
 
480
  for (p = ci->u.l.base; p < ci->top; p++)
 
481
    if (o == p) return 1;
 
482
  return 0;
 
483
}
 
484
 
 
485
 
 
486
static const char *getupvalname (CallInfo *ci, const TValue *o,
 
487
                                 const char **name) {
 
488
  LClosure *c = ci_func(ci);
 
489
  int i;
 
490
  for (i = 0; i < c->nupvalues; i++) {
 
491
    if (c->upvals[i]->v == o) {
 
492
      *name = upvalname(c->p, i);
 
493
      return "upvalue";
 
494
    }
 
495
  }
 
496
  return NULL;
 
497
}
 
498
 
 
499
 
 
500
l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
 
501
  CallInfo *ci = L->ci;
 
502
  const char *name = NULL;
 
503
  const char *t = objtypename(o);
 
504
  const char *kind = NULL;
 
505
  if (isLua(ci)) {
 
506
    kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
 
507
    if (!kind && isinstack(ci, o))  /* no? try a register */
 
508
      kind = getobjname(ci_func(ci)->p, currentpc(ci),
 
509
                        cast_int(o - ci->u.l.base), &name);
 
510
  }
 
511
  if (kind)
 
512
    luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
 
513
                op, kind, name, t);
 
514
  else
 
515
    luaG_runerror(L, "attempt to %s a %s value", op, t);
 
516
}
 
517
 
 
518
 
 
519
l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
 
520
  if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
 
521
  lua_assert(!ttisstring(p1) && !ttisnumber(p2));
 
522
  luaG_typeerror(L, p1, "concatenate");
 
523
}
 
524
 
 
525
 
 
526
l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
 
527
  TValue temp;
 
528
  if (luaV_tonumber(p1, &temp) == NULL)
 
529
    p2 = p1;  /* first operand is wrong */
 
530
  luaG_typeerror(L, p2, "perform arithmetic on");
 
531
}
 
532
 
 
533
 
 
534
l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
 
535
  const char *t1 = objtypename(p1);
 
536
  const char *t2 = objtypename(p2);
 
537
  if (t1 == t2)
 
538
    luaG_runerror(L, "attempt to compare two %s values", t1);
 
539
  else
 
540
    luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
 
541
}
 
542
 
 
543
 
 
544
static void addinfo (lua_State *L, const char *msg) {
 
545
  CallInfo *ci = L->ci;
 
546
  if (isLua(ci)) {  /* is Lua code? */
 
547
    char buff[LUA_IDSIZE];  /* add file:line information */
 
548
    int line = currentline(ci);
 
549
    TString *src = ci_func(ci)->p->source;
 
550
    if (src)
 
551
      luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
 
552
    else {  /* no source available; use "?" instead */
 
553
      buff[0] = '?'; buff[1] = '\0';
 
554
    }
 
555
    luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
 
556
  }
 
557
}
 
558
 
 
559
 
 
560
l_noret luaG_errormsg (lua_State *L) {
 
561
  if (L->errfunc != 0) {  /* is there an error handling function? */
 
562
    StkId errfunc = restorestack(L, L->errfunc);
 
563
    if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
 
564
    setobjs2s(L, L->top, L->top - 1);  /* move argument */
 
565
    setobjs2s(L, L->top - 1, errfunc);  /* push function */
 
566
    L->top++;
 
567
    luaD_call(L, L->top - 2, 1, 0);  /* call it */
 
568
  }
 
569
  luaD_throw(L, LUA_ERRRUN);
 
570
}
 
571
 
 
572
 
 
573
l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
 
574
  va_list argp;
 
575
  va_start(argp, fmt);
 
576
  addinfo(L, luaO_pushvfstring(L, fmt, argp));
 
577
  va_end(argp);
 
578
  luaG_errormsg(L);
 
579
}
 
580