diff options
Diffstat (limited to 'run.c')
-rw-r--r-- | run.c | 40 |
1 files changed, 34 insertions, 6 deletions
@@ -63,8 +63,9 @@ I32 Perl_debop(pTHX_ OP *o) { #ifdef DEBUGGING + AV *padlist, *comppad; + CV *cv; SV *sv; - SV **svp; STRLEN n_a; Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]); switch (o->op_type) { @@ -86,12 +87,18 @@ Perl_debop(pTHX_ OP *o) case OP_PADAV: case OP_PADHV: /* print the lexical's name */ - svp = av_fetch(PL_comppad_name, o->op_targ, FALSE); - if (svp) - PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a)); - else + cv = deb_curcv(cxstack_ix); + if (cv) { + padlist = CvPADLIST(cv); + comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); + sv = *av_fetch(comppad, o->op_targ, FALSE); + } else + sv = Nullsv; + if (sv) + PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv)); + else PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ); - break; + break; default: break; } @@ -100,6 +107,27 @@ Perl_debop(pTHX_ OP *o) return 0; } +STATIC CV* +S_deb_curcv(I32 ix) +{ +#ifdef DEBUGGING + PERL_CONTEXT *cx = &cxstack[ix]; + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) + return cx->blk_sub.cv; + else if (CxTYPE(cx) == CXt_EVAL && PL_compcv) + /* XXX Should be PL_compcv? */ + return Nullcv; + else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN) + return PL_main_cv; + else if (ix <= 0) + return Nullcv; + else + return deb_curcv(ix - 1); +#else + return Nullcv; +#endif /* DEBUGGING */ +} + void Perl_watch(pTHX_ char **addr) { |