diff options
Diffstat (limited to 'stolen_bits_of_padwalker.c')
-rw-r--r-- | stolen_bits_of_padwalker.c | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/stolen_bits_of_padwalker.c b/stolen_bits_of_padwalker.c new file mode 100644 index 0000000..0f8d2ea --- /dev/null +++ b/stolen_bits_of_padwalker.c @@ -0,0 +1,82 @@ +/* For development testing */ +#ifdef PACKAGE_STASH_DEBUGGING +# define debug_print(x) printf x +#else +# define debug_print(x) +#endif + +/* Originally stolen from pp_ctl.c; now significantly different */ + +I32 +dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) +{ + dTHR; + I32 i; + PERL_CONTEXT *cx; + for (i = startingblock; i >= 0; i--) { + cx = &cxstk[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_SUB: + /* In Perl 5.005, formats just used CXt_SUB */ +#ifdef CXt_FORMAT + case CXt_FORMAT: +#endif + debug_print(("**dopoptosub_at: found sub #%ld\n", (long)i)); + return i; + } + } + debug_print(("**dopoptosub_at: not found #%ld\n", (long)i)); + return i; +} + +I32 +dopoptosub(pTHX_ I32 startingblock) +{ + dTHR; + return dopoptosub_at(aTHX_ cxstack, startingblock); +} + +/* This function is based on the code of pp_caller */ +PERL_CONTEXT* +upcontext(pTHX_ I32 count, COP **cop_p, PERL_CONTEXT **ccstack_p, + I32 *cxix_from_p, I32 *cxix_to_p) +{ + PERL_SI *top_si = PL_curstackinfo; + I32 cxix = dopoptosub(aTHX_ cxstack_ix); + PERL_CONTEXT *ccstack = cxstack; + + if (cxix_from_p) *cxix_from_p = cxstack_ix+1; + if (cxix_to_p) *cxix_to_p = cxix; + for (;;) { + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = dopoptosub_at(aTHX_ ccstack, top_si->si_cxix); + if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p; + if (cxix_to_p) *cxix_to_p = cxix; + } + if (cxix < 0 && count == 0) { + if (ccstack_p) *ccstack_p = ccstack; + return (PERL_CONTEXT *)0; + } + else if (cxix < 0) + return (PERL_CONTEXT *)-1; + if (PL_DBsub && cxix >= 0 && + ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) + count++; + if (!count--) + break; + + if (cop_p) *cop_p = ccstack[cxix].blk_oldcop; + cxix = dopoptosub_at(aTHX_ ccstack, cxix - 1); + if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p; + if (cxix_to_p) *cxix_to_p = cxix; + } + if (ccstack_p) *ccstack_p = ccstack; + return &ccstack[cxix]; +} + +/* end thievery */ |