GvIOp(g) = (IO*)(v); \
} while (0)
-/* XXX: the core implementation of caller() is private, so we need a
- * a reimplementation. luckily, padwalker already has done this. rafl says
- * that there should be a public interface in 5.14, so maybe look into
- * converting to use that at some point */
-#include "stolen_bits_of_padwalker.c"
-
typedef enum {
VAR_NONE = 0,
VAR_SCALAR,
}
if (!filename || first_line_num == -1) {
- I32 cxix_from, cxix_to;
- PERL_CONTEXT *cx, *ccstack;
- COP *cop = NULL;
-
- cx = upcontext(0, &cop, &ccstack, &cxix_from, &cxix_to);
- if (!cop)
- cop = PL_curcop;
-
if (!filename)
- filename = CopFILE(cop);
+ filename = CopFILE(PL_curcop);
if (first_line_num == -1)
- first_line_num = cop->cop_line;
+ first_line_num = PL_curcop->cop_line;
}
if (last_line_num == -1)
+++ /dev/null
-/* 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 */