diff options
author | Maurus Cuelenaere <mcuelenaere@gmail.com> | 2009-05-21 19:01:41 +0000 |
---|---|---|
committer | Maurus Cuelenaere <mcuelenaere@gmail.com> | 2009-05-21 19:01:41 +0000 |
commit | cf87597226f5d6b269f1f2c4d6f402aa1eccb852 (patch) | |
tree | 4ba1f3ae53b3bd9cae0e2c6c4dd57836b43a5ece /apps/plugins/lua/ldebug.c | |
parent | c483efadc63eaed35b5fb5e4e02c2282daf32470 (diff) | |
download | rockbox-cf87597226f5d6b269f1f2c4d6f402aa1eccb852.tar.gz rockbox-cf87597226f5d6b269f1f2c4d6f402aa1eccb852.zip |
Commit FS#9174: Lua scripting language by Dan Everton
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@21020 a1c6a512-1295-4272-9138-f99709370657
Diffstat (limited to 'apps/plugins/lua/ldebug.c')
-rw-r--r-- | apps/plugins/lua/ldebug.c | 638 |
1 files changed, 638 insertions, 0 deletions
diff --git a/apps/plugins/lua/ldebug.c b/apps/plugins/lua/ldebug.c new file mode 100644 index 0000000000..50ad3d3803 --- /dev/null +++ b/apps/plugins/lua/ldebug.c | |||
@@ -0,0 +1,638 @@ | |||
1 | /* | ||
2 | ** $Id: ldebug.c,v 2.29.1.6 2008/05/08 16:56:26 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 | static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name); | ||
34 | |||
35 | |||
36 | static 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 | |||
44 | static 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 | */ | ||
56 | LUA_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 | |||
69 | LUA_API lua_Hook lua_gethook (lua_State *L) { | ||
70 | return L->hook; | ||
71 | } | ||
72 | |||
73 | |||
74 | LUA_API int lua_gethookmask (lua_State *L) { | ||
75 | return L->hookmask; | ||
76 | } | ||
77 | |||
78 | |||
79 | LUA_API int lua_gethookcount (lua_State *L) { | ||
80 | return L->basehookcount; | ||
81 | } | ||
82 | |||
83 | |||
84 | LUA_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 | |||
107 | static Proto *getluaproto (CallInfo *ci) { | ||
108 | return (isLua(ci) ? ci_func(ci)->l.p : NULL); | ||
109 | } | ||
110 | |||
111 | |||
112 | static 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 | |||
127 | LUA_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 | |||
138 | LUA_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 | |||
150 | static 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 | |||
167 | static 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 | |||
177 | static 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 | |||
193 | static 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 | |||
232 | LUA_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 | |||
276 | static int precheck (const Proto *pt) { | ||
277 | check(pt->maxstacksize <= MAXSTACK); | ||
278 | check(pt->numparams+(pt->is_vararg & VARARG_HASARG) <= pt->maxstacksize); | ||
279 | check(!(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(pt->sizecode > 0 && 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 | |||
290 | int 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 | |||
304 | static 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 | |||
317 | static 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 | int j; | ||
350 | /* check that it does not jump to a setlist count; this | ||
351 | is tricky, because the count from a previous setlist may | ||
352 | have the same value of an invalid setlist; so, we must | ||
353 | go all the way back to the first of them (if any) */ | ||
354 | for (j = 0; j < dest; j++) { | ||
355 | Instruction d = pt->code[dest-1-j]; | ||
356 | if (!(GET_OPCODE(d) == OP_SETLIST && GETARG_C(d) == 0)) break; | ||
357 | } | ||
358 | /* if 'j' is even, previous value is not a setlist (even if | ||
359 | it looks like one) */ | ||
360 | check((j&1) == 0); | ||
361 | } | ||
362 | } | ||
363 | break; | ||
364 | } | ||
365 | } | ||
366 | if (testAMode(op)) { | ||
367 | if (a == reg) last = pc; /* change register `a' */ | ||
368 | } | ||
369 | if (testTMode(op)) { | ||
370 | check(pc+2 < pt->sizecode); /* check skip */ | ||
371 | check(GET_OPCODE(pt->code[pc+1]) == OP_JMP); | ||
372 | } | ||
373 | switch (op) { | ||
374 | case OP_LOADBOOL: { | ||
375 | if (c == 1) { /* does it jump? */ | ||
376 | check(pc+2 < pt->sizecode); /* check its jump */ | ||
377 | check(GET_OPCODE(pt->code[pc+1]) != OP_SETLIST || | ||
378 | GETARG_C(pt->code[pc+1]) != 0); | ||
379 | } | ||
380 | break; | ||
381 | } | ||
382 | case OP_LOADNIL: { | ||
383 | if (a <= reg && reg <= b) | ||
384 | last = pc; /* set registers from `a' to `b' */ | ||
385 | break; | ||
386 | } | ||
387 | case OP_GETUPVAL: | ||
388 | case OP_SETUPVAL: { | ||
389 | check(b < pt->nups); | ||
390 | break; | ||
391 | } | ||
392 | case OP_GETGLOBAL: | ||
393 | case OP_SETGLOBAL: { | ||
394 | check(ttisstring(&pt->k[b])); | ||
395 | break; | ||
396 | } | ||
397 | case OP_SELF: { | ||
398 | checkreg(pt, a+1); | ||
399 | if (reg == a+1) last = pc; | ||
400 | break; | ||
401 | } | ||
402 | case OP_CONCAT: { | ||
403 | check(b < c); /* at least two operands */ | ||
404 | break; | ||
405 | } | ||
406 | case OP_TFORLOOP: { | ||
407 | check(c >= 1); /* at least one result (control variable) */ | ||
408 | checkreg(pt, a+2+c); /* space for results */ | ||
409 | if (reg >= a+2) last = pc; /* affect all regs above its base */ | ||
410 | break; | ||
411 | } | ||
412 | case OP_FORLOOP: | ||
413 | case OP_FORPREP: | ||
414 | checkreg(pt, a+3); | ||
415 | /* go through */ | ||
416 | case OP_JMP: { | ||
417 | int dest = pc+1+b; | ||
418 | /* not full check and jump is forward and do not skip `lastpc'? */ | ||
419 | if (reg != NO_REG && pc < dest && dest <= lastpc) | ||
420 | pc += b; /* do the jump */ | ||
421 | break; | ||
422 | } | ||
423 | case OP_CALL: | ||
424 | case OP_TAILCALL: { | ||
425 | if (b != 0) { | ||
426 | checkreg(pt, a+b-1); | ||
427 | } | ||
428 | c--; /* c = num. returns */ | ||
429 | if (c == LUA_MULTRET) { | ||
430 | check(checkopenop(pt, pc)); | ||
431 | } | ||
432 | else if (c != 0) | ||
433 | checkreg(pt, a+c-1); | ||
434 | if (reg >= a) last = pc; /* affect all registers above base */ | ||
435 | break; | ||
436 | } | ||
437 | case OP_RETURN: { | ||
438 | b--; /* b = num. returns */ | ||
439 | if (b > 0) checkreg(pt, a+b-1); | ||
440 | break; | ||
441 | } | ||
442 | case OP_SETLIST: { | ||
443 | if (b > 0) checkreg(pt, a + b); | ||
444 | if (c == 0) { | ||
445 | pc++; | ||
446 | check(pc < pt->sizecode - 1); | ||
447 | } | ||
448 | break; | ||
449 | } | ||
450 | case OP_CLOSURE: { | ||
451 | int nup, j; | ||
452 | check(b < pt->sizep); | ||
453 | nup = pt->p[b]->nups; | ||
454 | check(pc + nup < pt->sizecode); | ||
455 | for (j = 1; j <= nup; j++) { | ||
456 | OpCode op1 = GET_OPCODE(pt->code[pc + j]); | ||
457 | check(op1 == OP_GETUPVAL || op1 == OP_MOVE); | ||
458 | } | ||
459 | if (reg != NO_REG) /* tracing? */ | ||
460 | pc += nup; /* do not 'execute' these pseudo-instructions */ | ||
461 | break; | ||
462 | } | ||
463 | case OP_VARARG: { | ||
464 | check((pt->is_vararg & VARARG_ISVARARG) && | ||
465 | !(pt->is_vararg & VARARG_NEEDSARG)); | ||
466 | b--; | ||
467 | if (b == LUA_MULTRET) check(checkopenop(pt, pc)); | ||
468 | checkreg(pt, a+b-1); | ||
469 | break; | ||
470 | } | ||
471 | default: break; | ||
472 | } | ||
473 | } | ||
474 | return pt->code[last]; | ||
475 | } | ||
476 | |||
477 | #undef check | ||
478 | #undef checkjump | ||
479 | #undef checkreg | ||
480 | |||
481 | /* }====================================================== */ | ||
482 | |||
483 | |||
484 | int luaG_checkcode (const Proto *pt) { | ||
485 | return (symbexec(pt, pt->sizecode, NO_REG) != 0); | ||
486 | } | ||
487 | |||
488 | |||
489 | static const char *kname (Proto *p, int c) { | ||
490 | if (ISK(c) && ttisstring(&p->k[INDEXK(c)])) | ||
491 | return svalue(&p->k[INDEXK(c)]); | ||
492 | else | ||
493 | return "?"; | ||
494 | } | ||
495 | |||
496 | |||
497 | static const char *getobjname (lua_State *L, CallInfo *ci, int stackpos, | ||
498 | const char **name) { | ||
499 | if (isLua(ci)) { /* a Lua function? */ | ||
500 | Proto *p = ci_func(ci)->l.p; | ||
501 | int pc = currentpc(L, ci); | ||
502 | Instruction i; | ||
503 | *name = luaF_getlocalname(p, stackpos+1, pc); | ||
504 | if (*name) /* is a local? */ | ||
505 | return "local"; | ||
506 | i = symbexec(p, pc, stackpos); /* try symbolic execution */ | ||
507 | lua_assert(pc != -1); | ||
508 | switch (GET_OPCODE(i)) { | ||
509 | case OP_GETGLOBAL: { | ||
510 | int g = GETARG_Bx(i); /* global index */ | ||
511 | lua_assert(ttisstring(&p->k[g])); | ||
512 | *name = svalue(&p->k[g]); | ||
513 | return "global"; | ||
514 | } | ||
515 | case OP_MOVE: { | ||
516 | int a = GETARG_A(i); | ||
517 | int b = GETARG_B(i); /* move from `b' to `a' */ | ||
518 | if (b < a) | ||
519 | return getobjname(L, ci, b, name); /* get name for `b' */ | ||
520 | break; | ||
521 | } | ||
522 | case OP_GETTABLE: { | ||
523 | int k = GETARG_C(i); /* key index */ | ||
524 | *name = kname(p, k); | ||
525 | return "field"; | ||
526 | } | ||
527 | case OP_GETUPVAL: { | ||
528 | int u = GETARG_B(i); /* upvalue index */ | ||
529 | *name = p->upvalues ? getstr(p->upvalues[u]) : "?"; | ||
530 | return "upvalue"; | ||
531 | } | ||
532 | case OP_SELF: { | ||
533 | int k = GETARG_C(i); /* key index */ | ||
534 | *name = kname(p, k); | ||
535 | return "method"; | ||
536 | } | ||
537 | default: break; | ||
538 | } | ||
539 | } | ||
540 | return NULL; /* no useful name found */ | ||
541 | } | ||
542 | |||
543 | |||
544 | static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) { | ||
545 | Instruction i; | ||
546 | if ((isLua(ci) && ci->tailcalls > 0) || !isLua(ci - 1)) | ||
547 | return NULL; /* calling function is not Lua (or is unknown) */ | ||
548 | ci--; /* calling function */ | ||
549 | i = ci_func(ci)->l.p->code[currentpc(L, ci)]; | ||
550 | if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL || | ||
551 | GET_OPCODE(i) == OP_TFORLOOP) | ||
552 | return getobjname(L, ci, GETARG_A(i), name); | ||
553 | else | ||
554 | return NULL; /* no useful name can be found */ | ||
555 | } | ||
556 | |||
557 | |||
558 | /* only ANSI way to check whether a pointer points to an array */ | ||
559 | static int isinstack (CallInfo *ci, const TValue *o) { | ||
560 | StkId p; | ||
561 | for (p = ci->base; p < ci->top; p++) | ||
562 | if (o == p) return 1; | ||
563 | return 0; | ||
564 | } | ||
565 | |||
566 | |||
567 | void luaG_typeerror (lua_State *L, const TValue *o, const char *op) { | ||
568 | const char *name = NULL; | ||
569 | const char *t = luaT_typenames[ttype(o)]; | ||
570 | const char *kind = (isinstack(L->ci, o)) ? | ||
571 | getobjname(L, L->ci, cast_int(o - L->base), &name) : | ||
572 | NULL; | ||
573 | if (kind) | ||
574 | luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)", | ||
575 | op, kind, name, t); | ||
576 | else | ||
577 | luaG_runerror(L, "attempt to %s a %s value", op, t); | ||
578 | } | ||
579 | |||
580 | |||
581 | void luaG_concaterror (lua_State *L, StkId p1, StkId p2) { | ||
582 | if (ttisstring(p1) || ttisnumber(p1)) p1 = p2; | ||
583 | lua_assert(!ttisstring(p1) && !ttisnumber(p1)); | ||
584 | luaG_typeerror(L, p1, "concatenate"); | ||
585 | } | ||
586 | |||
587 | |||
588 | void luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) { | ||
589 | TValue temp; | ||
590 | if (luaV_tonumber(p1, &temp) == NULL) | ||
591 | p2 = p1; /* first operand is wrong */ | ||
592 | luaG_typeerror(L, p2, "perform arithmetic on"); | ||
593 | } | ||
594 | |||
595 | |||
596 | int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) { | ||
597 | const char *t1 = luaT_typenames[ttype(p1)]; | ||
598 | const char *t2 = luaT_typenames[ttype(p2)]; | ||
599 | if (t1[2] == t2[2]) | ||
600 | luaG_runerror(L, "attempt to compare two %s values", t1); | ||
601 | else | ||
602 | luaG_runerror(L, "attempt to compare %s with %s", t1, t2); | ||
603 | return 0; | ||
604 | } | ||
605 | |||
606 | |||
607 | static void addinfo (lua_State *L, const char *msg) { | ||
608 | CallInfo *ci = L->ci; | ||
609 | if (isLua(ci)) { /* is Lua code? */ | ||
610 | char buff[LUA_IDSIZE]; /* add file:line information */ | ||
611 | int line = currentline(L, ci); | ||
612 | luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE); | ||
613 | luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); | ||
614 | } | ||
615 | } | ||
616 | |||
617 | |||
618 | void luaG_errormsg (lua_State *L) { | ||
619 | if (L->errfunc != 0) { /* is there an error handling function? */ | ||
620 | StkId errfunc = restorestack(L, L->errfunc); | ||
621 | if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); | ||
622 | setobjs2s(L, L->top, L->top - 1); /* move argument */ | ||
623 | setobjs2s(L, L->top - 1, errfunc); /* push function */ | ||
624 | incr_top(L); | ||
625 | luaD_call(L, L->top - 2, 1); /* call it */ | ||
626 | } | ||
627 | luaD_throw(L, LUA_ERRRUN); | ||
628 | } | ||
629 | |||
630 | |||
631 | void luaG_runerror (lua_State *L, const char *fmt, ...) { | ||
632 | va_list argp; | ||
633 | va_start(argp, fmt); | ||
634 | addinfo(L, luaO_pushvfstring(L, fmt, argp)); | ||
635 | va_end(argp); | ||
636 | luaG_errormsg(L); | ||
637 | } | ||
638 | |||