]>
git.proxmox.com Git - mirror_edk2.git/blob - AppPkg/Applications/Lua/src/ldebug.c
2 ** $Id: ldebug.c,v 2.90.1.3 2013/05/16 16:04:15 roberto Exp $
4 ** See Copyright Notice in lua.h
33 #define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL)
36 static const char *getfuncname (lua_State
*L
, CallInfo
*ci
, const char **name
);
39 static int currentpc (CallInfo
*ci
) {
40 lua_assert(isLua(ci
));
41 return pcRel(ci
->u
.l
.savedpc
, ci_func(ci
)->p
);
45 static int currentline (CallInfo
*ci
) {
46 return getfuncline(ci_func(ci
)->p
, currentpc(ci
));
51 ** this function can be called asynchronous (e.g. during a signal)
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? */
59 L
->oldpc
= L
->ci
->u
.l
.savedpc
;
61 L
->basehookcount
= count
;
63 L
->hookmask
= cast_byte(mask
);
68 LUA_API lua_Hook
lua_gethook (lua_State
*L
) {
73 LUA_API
int lua_gethookmask (lua_State
*L
) {
78 LUA_API
int lua_gethookcount (lua_State
*L
) {
79 return L
->basehookcount
;
83 LUA_API
int lua_getstack (lua_State
*L
, int level
, lua_Debug
*ar
) {
86 if (level
< 0) return 0; /* invalid (negative) level */
88 for (ci
= L
->ci
; level
> 0 && ci
!= &L
->base_ci
; ci
= ci
->previous
)
90 if (level
== 0 && ci
!= &L
->base_ci
) { /* level found? */
94 else status
= 0; /* no such level */
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
);
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 */
112 *pos
= ci
->func
+ nparams
+ n
;
113 return "(*vararg)"; /* generic name for any vararg */
118 static const char *findlocal (lua_State
*L
, CallInfo
*ci
, int n
,
120 const char *name
= NULL
;
123 if (n
< 0) /* access to vararg values? */
124 return findvararg(ci
, -n
, pos
);
127 name
= luaF_getlocalname(ci_func(ci
)->p
, n
, currentpc(ci
));
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 */
137 return NULL
; /* no name */
139 *pos
= base
+ (n
- 1);
144 LUA_API
const char *lua_getlocal (lua_State
*L
, const lua_Debug
*ar
, int n
) {
147 if (ar
== NULL
) { /* information about non-active function? */
148 if (!isLfunction(L
->top
- 1)) /* not a Lua function? */
150 else /* consider live variables at function start (parameters) */
151 name
= luaF_getlocalname(clLvalue(L
->top
- 1)->p
, n
, 0);
153 else { /* active function; get information through 'ar' */
154 StkId pos
= 0; /* to avoid warnings */
155 name
= findlocal(L
, ar
->i_ci
, n
, &pos
);
157 setobj2s(L
, L
->top
, pos
);
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
);
171 setobjs2s(L
, pos
, L
->top
- 1);
172 L
->top
--; /* pop value */
178 static void funcinfo (lua_Debug
*ar
, Closure
*cl
) {
179 if (noLuaClosure(cl
)) {
181 ar
->linedefined
= -1;
182 ar
->lastlinedefined
= -1;
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";
192 luaO_chunkid(ar
->short_src
, ar
->source
, LUA_IDSIZE
);
196 static void collectvalidlines (lua_State
*L
, Closure
*f
) {
197 if (noLuaClosure(f
)) {
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 */
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 */
215 static int auxgetinfo (lua_State
*L
, const char *what
, lua_Debug
*ar
,
216 Closure
*f
, CallInfo
*ci
) {
218 for (; *what
; what
++) {
225 ar
->currentline
= (ci
&& isLua(ci
)) ? currentline(ci
) : -1;
229 ar
->nups
= (f
== NULL
) ? 0 : f
->c
.nupvalues
;
230 if (noLuaClosure(f
)) {
235 ar
->isvararg
= f
->l
.p
->is_vararg
;
236 ar
->nparams
= f
->l
.p
->numparams
;
241 ar
->istailcall
= (ci
) ? ci
->callstatus
& CIST_TAIL
: 0;
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
);
250 if (ar
->namewhat
== NULL
) {
251 ar
->namewhat
= ""; /* not found */
257 case 'f': /* handled by lua_getinfo */
259 default: status
= 0; /* invalid option */
266 LUA_API
int lua_getinfo (lua_State
*L
, const char *what
, lua_Debug
*ar
) {
275 api_check(L
, ttisfunction(func
), "function expected");
276 what
++; /* skip the '>' */
277 L
->top
--; /* pop function */
282 lua_assert(ttisfunction(ci
->func
));
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
);
290 if (strchr(what
, 'L'))
291 collectvalidlines(L
, cl
);
298 ** {======================================================
299 ** Symbolic Execution
300 ** =======================================================
303 static const char *getobjname (Proto
*p
, int lastpc
, int reg
,
308 ** find a "name" for the RK value 'c'
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 */
317 /* else no reasonable name found */
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 */
324 /* else no reasonable name found */
326 *name
= "?"; /* no reasonable name found */
330 static int filterpc (int pc
, int jmptarget
) {
331 if (pc
< jmptarget
) /* is code conditional (inside a jump)? */
332 return -1; /* cannot know who sets that register */
333 else return pc
; /* current position sets that register */
338 ** try to find last instruction before 'lastpc' that modified register 'reg'
340 static int findsetreg (Proto
*p
, int lastpc
, int reg
) {
342 int setreg
= -1; /* keep last instruction that changed 'reg' */
343 int jmptarget
= 0; /* any code before this address is conditional */
344 for (pc
= 0; pc
< lastpc
; pc
++) {
345 Instruction i
= p
->code
[pc
];
346 OpCode op
= GET_OPCODE(i
);
351 if (a
<= reg
&& reg
<= a
+ b
) /* set registers from 'a' to 'a+b' */
352 setreg
= filterpc(pc
, jmptarget
);
356 if (reg
>= a
+ 2) /* affect all regs above its base */
357 setreg
= filterpc(pc
, jmptarget
);
362 if (reg
>= a
) /* affect all registers above base */
363 setreg
= filterpc(pc
, jmptarget
);
367 int b
= GETARG_sBx(i
);
368 int dest
= pc
+ 1 + b
;
369 /* jump is forward and do not skip `lastpc'? */
370 if (pc
< dest
&& dest
<= lastpc
) {
371 if (dest
> jmptarget
)
372 jmptarget
= dest
; /* update 'jmptarget' */
377 if (reg
== a
) /* jumped code can change 'a' */
378 setreg
= filterpc(pc
, jmptarget
);
382 if (testAMode(op
) && reg
== a
) /* any instruction that set A */
383 setreg
= filterpc(pc
, jmptarget
);
391 static const char *getobjname (Proto
*p
, int lastpc
, int reg
,
394 *name
= luaF_getlocalname(p
, reg
+ 1, lastpc
);
395 if (*name
) /* is a local? */
397 /* else try symbolic execution */
398 pc
= findsetreg(p
, lastpc
, reg
);
399 if (pc
!= -1) { /* could find instruction? */
400 Instruction i
= p
->code
[pc
];
401 OpCode op
= GET_OPCODE(i
);
404 int b
= GETARG_B(i
); /* move from 'b' to 'a' */
406 return getobjname(p
, pc
, b
, name
); /* get name for 'b' */
411 int k
= GETARG_C(i
); /* key index */
412 int t
= GETARG_B(i
); /* table index */
413 const char *vn
= (op
== OP_GETTABLE
) /* name of indexed variable */
414 ? luaF_getlocalname(p
, t
+ 1, pc
)
416 kname(p
, pc
, k
, name
);
417 return (vn
&& strcmp(vn
, LUA_ENV
) == 0) ? "global" : "field";
420 *name
= upvalname(p
, GETARG_B(i
));
425 int b
= (op
== OP_LOADK
) ? GETARG_Bx(i
)
426 : GETARG_Ax(p
->code
[pc
+ 1]);
427 if (ttisstring(&p
->k
[b
])) {
428 *name
= svalue(&p
->k
[b
]);
434 int k
= GETARG_C(i
); /* key index */
435 kname(p
, pc
, k
, name
);
438 default: break; /* go through to return NULL */
441 return NULL
; /* could not find reasonable name */
445 static const char *getfuncname (lua_State
*L
, CallInfo
*ci
, const char **name
) {
447 Proto
*p
= ci_func(ci
)->p
; /* calling function */
448 int pc
= currentpc(ci
); /* calling instruction index */
449 Instruction i
= p
->code
[pc
]; /* calling instruction */
450 switch (GET_OPCODE(i
)) {
452 case OP_TAILCALL
: /* get function name */
453 return getobjname(p
, pc
, GETARG_A(i
), name
);
454 case OP_TFORCALL
: { /* for iterator */
455 *name
= "for iterator";
456 return "for iterator";
458 /* all other instructions can call only through metamethods */
461 case OP_GETTABLE
: tm
= TM_INDEX
; break;
463 case OP_SETTABLE
: tm
= TM_NEWINDEX
; break;
464 case OP_EQ
: tm
= TM_EQ
; break;
465 case OP_ADD
: tm
= TM_ADD
; break;
466 case OP_SUB
: tm
= TM_SUB
; break;
467 case OP_MUL
: tm
= TM_MUL
; break;
468 case OP_DIV
: tm
= TM_DIV
; break;
469 case OP_MOD
: tm
= TM_MOD
; break;
470 case OP_POW
: tm
= TM_POW
; break;
471 case OP_UNM
: tm
= TM_UNM
; break;
472 case OP_LEN
: tm
= TM_LEN
; break;
473 case OP_LT
: tm
= TM_LT
; break;
474 case OP_LE
: tm
= TM_LE
; break;
475 case OP_CONCAT
: tm
= TM_CONCAT
; break;
477 return NULL
; /* else no useful name can be found */
479 *name
= getstr(G(L
)->tmname
[tm
]);
483 /* }====================================================== */
488 ** only ANSI way to check whether a pointer points to an array
489 ** (used only for error messages, so efficiency is not a big concern)
491 static int isinstack (CallInfo
*ci
, const TValue
*o
) {
493 for (p
= ci
->u
.l
.base
; p
< ci
->top
; p
++)
494 if (o
== p
) return 1;
499 static const char *getupvalname (CallInfo
*ci
, const TValue
*o
,
501 LClosure
*c
= ci_func(ci
);
503 for (i
= 0; i
< c
->nupvalues
; i
++) {
504 if (c
->upvals
[i
]->v
== o
) {
505 *name
= upvalname(c
->p
, i
);
513 l_noret
luaG_typeerror (lua_State
*L
, const TValue
*o
, const char *op
) {
514 CallInfo
*ci
= L
->ci
;
515 const char *name
= NULL
;
516 const char *t
= objtypename(o
);
517 const char *kind
= NULL
;
519 kind
= getupvalname(ci
, o
, &name
); /* check whether 'o' is an upvalue */
520 if (!kind
&& isinstack(ci
, o
)) /* no? try a register */
521 kind
= getobjname(ci_func(ci
)->p
, currentpc(ci
),
522 cast_int(o
- ci
->u
.l
.base
), &name
);
525 luaG_runerror(L
, "attempt to %s %s " LUA_QS
" (a %s value)",
528 luaG_runerror(L
, "attempt to %s a %s value", op
, t
);
532 l_noret
luaG_concaterror (lua_State
*L
, StkId p1
, StkId p2
) {
533 if (ttisstring(p1
) || ttisnumber(p1
)) p1
= p2
;
534 lua_assert(!ttisstring(p1
) && !ttisnumber(p1
));
535 luaG_typeerror(L
, p1
, "concatenate");
539 l_noret
luaG_aritherror (lua_State
*L
, const TValue
*p1
, const TValue
*p2
) {
541 if (luaV_tonumber(p1
, &temp
) == NULL
)
542 p2
= p1
; /* first operand is wrong */
543 luaG_typeerror(L
, p2
, "perform arithmetic on");
547 l_noret
luaG_ordererror (lua_State
*L
, const TValue
*p1
, const TValue
*p2
) {
548 const char *t1
= objtypename(p1
);
549 const char *t2
= objtypename(p2
);
551 luaG_runerror(L
, "attempt to compare two %s values", t1
);
553 luaG_runerror(L
, "attempt to compare %s with %s", t1
, t2
);
557 static void addinfo (lua_State
*L
, const char *msg
) {
558 CallInfo
*ci
= L
->ci
;
559 if (isLua(ci
)) { /* is Lua code? */
560 char buff
[LUA_IDSIZE
]; /* add file:line information */
561 int line
= currentline(ci
);
562 TString
*src
= ci_func(ci
)->p
->source
;
564 luaO_chunkid(buff
, getstr(src
), LUA_IDSIZE
);
565 else { /* no source available; use "?" instead */
566 buff
[0] = '?'; buff
[1] = '\0';
568 luaO_pushfstring(L
, "%s:%d: %s", buff
, line
, msg
);
573 l_noret
luaG_errormsg (lua_State
*L
) {
574 if (L
->errfunc
!= 0) { /* is there an error handling function? */
575 StkId errfunc
= restorestack(L
, L
->errfunc
);
576 if (!ttisfunction(errfunc
)) luaD_throw(L
, LUA_ERRERR
);
577 setobjs2s(L
, L
->top
, L
->top
- 1); /* move argument */
578 setobjs2s(L
, L
->top
- 1, errfunc
); /* push function */
580 luaD_call(L
, L
->top
- 2, 1, 0); /* call it */
582 luaD_throw(L
, LUA_ERRRUN
);
586 l_noret
luaG_runerror (lua_State
*L
, const char *fmt
, ...) {
589 addinfo(L
, luaO_pushvfstring(L
, fmt
, argp
));