~ubuntu-branches/debian/sid/freeciv/sid

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Clint Adams, Karl Goetz, Clint Adams
  • Date: 2010-02-23 22:09:02 UTC
  • mfrom: (7.1.5 sid)
  • Revision ID: james.westby@ubuntu.com-20100223220902-s3spqi1x4e190y0t
[ Karl Goetz ]
* Remove civserver files in /etc/ggzd/ (Closes: 523772, 517787)
* Adding ${misc:Depends} to all binary packages (lintian warnings)

[ Clint Adams ]
* New upstream version.
  - Drop data_dsc_use_bindir.diff (binary pathnames have changed).

Show diffs side-by-side

added added

removed removed

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