blob: 0f8d2ead7065d17c8b9d5de3dc59fe512c9d0880 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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 */
|
