line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
2
|
|
|
|
|
|
|
#include "EXTERN.h" |
3
|
|
|
|
|
|
|
#include "perl.h" |
4
|
|
|
|
|
|
|
#include "XSUB.h" |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
#ifndef isGV_with_GP |
7
|
|
|
|
|
|
|
#define isGV_with_GP(x) isGV(x) |
8
|
|
|
|
|
|
|
#endif |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#ifndef CxOLD_OP_TYPE |
11
|
|
|
|
|
|
|
# define CxOLD_OP_TYPE(cx) (0 + (cx)->blk_eval.old_op_type) |
12
|
|
|
|
|
|
|
#endif |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
#ifndef CvISXSUB |
15
|
|
|
|
|
|
|
#define CvISXSUB(sv) CvXSUB(sv) |
16
|
|
|
|
|
|
|
#endif |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
/* For development testing */ |
19
|
|
|
|
|
|
|
#ifdef PADWALKER_DEBUGGING |
20
|
|
|
|
|
|
|
# define debug_print(x) printf x |
21
|
|
|
|
|
|
|
#else |
22
|
|
|
|
|
|
|
# define debug_print(x) |
23
|
|
|
|
|
|
|
#endif |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
/* For debugging */ |
26
|
|
|
|
|
|
|
#ifdef PADWALKER_DEBUGGING |
27
|
|
|
|
|
|
|
char * |
28
|
|
|
|
|
|
|
cxtype_name(U32 cx_type) |
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
switch(cx_type & CXTYPEMASK) |
31
|
|
|
|
|
|
|
{ |
32
|
|
|
|
|
|
|
case CXt_NULL: return "null"; |
33
|
|
|
|
|
|
|
case CXt_SUB: return "sub"; |
34
|
|
|
|
|
|
|
case CXt_EVAL: return "eval"; |
35
|
|
|
|
|
|
|
case CXt_LOOP: return "loop"; |
36
|
|
|
|
|
|
|
case CXt_SUBST: return "subst"; |
37
|
|
|
|
|
|
|
case CXt_BLOCK: return "block"; |
38
|
|
|
|
|
|
|
case CXt_FORMAT: return "format"; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
default: debug_print(("Unknown context type 0x%lx\n", cx_type)); |
41
|
|
|
|
|
|
|
return "(unknown)"; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
void |
46
|
|
|
|
|
|
|
show_cxstack(void) |
47
|
|
|
|
|
|
|
{ |
48
|
|
|
|
|
|
|
I32 i; |
49
|
|
|
|
|
|
|
for (i = cxstack_ix; i>=0; --i) |
50
|
|
|
|
|
|
|
{ |
51
|
|
|
|
|
|
|
printf(" =%ld= %s (%lx)", (long)i, |
52
|
|
|
|
|
|
|
cxtype_name(CxTYPE(&cxstack[i])), cxstack[i].blk_oldcop->cop_seq); |
53
|
|
|
|
|
|
|
if (CxTYPE(&cxstack[i]) == CXt_SUB) { |
54
|
|
|
|
|
|
|
CV *cv = cxstack[i].blk_sub.cv; |
55
|
|
|
|
|
|
|
printf("\t%s", (cv && CvGV(cv)) ? GvNAME(CvGV(cv)) :"(null)"); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
printf("\n"); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
#else |
61
|
|
|
|
|
|
|
# define show_cxstack() |
62
|
|
|
|
|
|
|
#endif |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
#ifndef SvOURSTASH |
65
|
|
|
|
|
|
|
# ifdef OURSTASH |
66
|
|
|
|
|
|
|
# define SvOURSTASH OURSTASH |
67
|
|
|
|
|
|
|
# else |
68
|
|
|
|
|
|
|
# define SvOURSTASH GvSTASH |
69
|
|
|
|
|
|
|
# endif |
70
|
|
|
|
|
|
|
#endif |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#ifndef COP_SEQ_RANGE_LOW |
73
|
|
|
|
|
|
|
# define COP_SEQ_RANGE_LOW(sv) U_32(SvNVX(sv)) |
74
|
|
|
|
|
|
|
#endif |
75
|
|
|
|
|
|
|
#ifndef COP_SEQ_RANGE_HIGH |
76
|
|
|
|
|
|
|
# define COP_SEQ_RANGE_HIGH(sv) U_32(SvUVX(sv)) |
77
|
|
|
|
|
|
|
#endif |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
#ifndef PadARRAY |
80
|
|
|
|
|
|
|
typedef AV PADNAMELIST; |
81
|
|
|
|
|
|
|
typedef SV PADNAME; |
82
|
|
|
|
|
|
|
# if PERL_VERSION < 8 || (PERL_VERSION == 8 && !PERL_SUBVERSION) |
83
|
|
|
|
|
|
|
typedef AV PADLIST; |
84
|
|
|
|
|
|
|
typedef AV PAD; |
85
|
|
|
|
|
|
|
# endif |
86
|
|
|
|
|
|
|
# define PadlistARRAY(pl) ((PAD **)AvARRAY(pl)) |
87
|
|
|
|
|
|
|
# define PadlistMAX(pl) AvFILLp(pl) |
88
|
|
|
|
|
|
|
# define PadlistNAMES(pl) (*PadlistARRAY(pl)) |
89
|
|
|
|
|
|
|
# define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl)) |
90
|
|
|
|
|
|
|
# define PadnamelistMAX(pnl) AvFILLp(pnl) |
91
|
|
|
|
|
|
|
# define PadARRAY AvARRAY |
92
|
|
|
|
|
|
|
# define PadnameIsOUR(pn) !!(SvFLAGS(pn) & SVpad_OUR) |
93
|
|
|
|
|
|
|
# define PadnameOURSTASH(pn) SvOURSTASH(pn) |
94
|
|
|
|
|
|
|
# define PadnameOUTER(pn) !!SvFAKE(pn) |
95
|
|
|
|
|
|
|
# define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL) |
96
|
|
|
|
|
|
|
#endif |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
/* Originally stolen from pp_ctl.c; now significantly different */ |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
I32 |
102
|
56
|
|
|
|
|
|
dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
dTHR; |
105
|
|
|
|
|
|
|
I32 i; |
106
|
|
|
|
|
|
|
PERL_CONTEXT *cx; |
107
|
105
|
100
|
|
|
|
|
for (i = startingblock; i >= 0; i--) { |
108
|
83
|
|
|
|
|
|
cx = &cxstk[i]; |
109
|
83
|
100
|
|
|
|
|
switch (CxTYPE(cx)) { |
110
|
|
|
|
|
|
|
default: |
111
|
49
|
|
|
|
|
|
continue; |
112
|
|
|
|
|
|
|
case CXt_SUB: |
113
|
|
|
|
|
|
|
/* In Perl 5.005, formats just used CXt_SUB */ |
114
|
|
|
|
|
|
|
#ifdef CXt_FORMAT |
115
|
|
|
|
|
|
|
case CXt_FORMAT: |
116
|
|
|
|
|
|
|
#endif |
117
|
|
|
|
|
|
|
debug_print(("**dopoptosub_at: found sub #%ld\n", (long)i)); |
118
|
34
|
|
|
|
|
|
return i; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
debug_print(("**dopoptosub_at: not found #%ld\n", (long)i)); |
122
|
22
|
|
|
|
|
|
return i; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
I32 |
126
|
34
|
|
|
|
|
|
dopoptosub(pTHX_ I32 startingblock) |
127
|
|
|
|
|
|
|
{ |
128
|
|
|
|
|
|
|
dTHR; |
129
|
34
|
|
|
|
|
|
return dopoptosub_at(aTHX_ cxstack, startingblock); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
/* This function is based on the code of pp_caller */ |
133
|
|
|
|
|
|
|
PERL_CONTEXT* |
134
|
34
|
|
|
|
|
|
upcontext(pTHX_ I32 count, COP **cop_p, PERL_CONTEXT **ccstack_p, |
135
|
|
|
|
|
|
|
I32 *cxix_from_p, I32 *cxix_to_p) |
136
|
|
|
|
|
|
|
{ |
137
|
34
|
|
|
|
|
|
PERL_SI *top_si = PL_curstackinfo; |
138
|
34
|
|
|
|
|
|
I32 cxix = dopoptosub(aTHX_ cxstack_ix); |
139
|
34
|
|
|
|
|
|
PERL_CONTEXT *ccstack = cxstack; |
140
|
|
|
|
|
|
|
|
141
|
34
|
50
|
|
|
|
|
if (cxix_from_p) *cxix_from_p = cxstack_ix+1; |
142
|
34
|
50
|
|
|
|
|
if (cxix_to_p) *cxix_to_p = cxix; |
143
|
|
|
|
|
|
|
for (;;) { |
144
|
|
|
|
|
|
|
/* we may be in a higher stacklevel, so dig down deeper */ |
145
|
56
|
100
|
|
|
|
|
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { |
|
|
100
|
|
|
|
|
|
146
|
2
|
|
|
|
|
|
top_si = top_si->si_prev; |
147
|
2
|
|
|
|
|
|
ccstack = top_si->si_cxstack; |
148
|
2
|
|
|
|
|
|
cxix = dopoptosub_at(aTHX_ ccstack, top_si->si_cxix); |
149
|
2
|
50
|
|
|
|
|
if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p; |
|
|
50
|
|
|
|
|
|
150
|
2
|
50
|
|
|
|
|
if (cxix_to_p) *cxix_to_p = cxix; |
151
|
|
|
|
|
|
|
} |
152
|
54
|
100
|
|
|
|
|
if (cxix < 0 && count == 0) { |
|
|
100
|
|
|
|
|
|
153
|
19
|
50
|
|
|
|
|
if (ccstack_p) *ccstack_p = ccstack; |
154
|
19
|
|
|
|
|
|
return (PERL_CONTEXT *)0; |
155
|
|
|
|
|
|
|
} |
156
|
35
|
100
|
|
|
|
|
else if (cxix < 0) |
157
|
1
|
|
|
|
|
|
return (PERL_CONTEXT *)-1; |
158
|
34
|
50
|
|
|
|
|
if (PL_DBsub && cxix >= 0 && |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
159
|
34
|
|
|
|
|
|
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) |
160
|
0
|
|
|
|
|
|
count++; |
161
|
34
|
100
|
|
|
|
|
if (!count--) |
162
|
14
|
|
|
|
|
|
break; |
163
|
|
|
|
|
|
|
|
164
|
20
|
100
|
|
|
|
|
if (cop_p) *cop_p = ccstack[cxix].blk_oldcop; |
165
|
20
|
|
|
|
|
|
cxix = dopoptosub_at(aTHX_ ccstack, cxix - 1); |
166
|
20
|
50
|
|
|
|
|
if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p; |
|
|
50
|
|
|
|
|
|
167
|
20
|
50
|
|
|
|
|
if (cxix_to_p) *cxix_to_p = cxix; |
168
|
20
|
|
|
|
|
|
} |
169
|
14
|
50
|
|
|
|
|
if (ccstack_p) *ccstack_p = ccstack; |
170
|
14
|
|
|
|
|
|
return &ccstack[cxix]; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
/* end thievery */ |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
SV* |
176
|
17
|
|
|
|
|
|
fetch_from_stash(pTHX_ HV *stash, char *name_str, U32 name_len) |
177
|
|
|
|
|
|
|
{ |
178
|
|
|
|
|
|
|
/* This isn't the most efficient approach, but it has |
179
|
|
|
|
|
|
|
* the advantage that it uses documented API functions. */ |
180
|
17
|
50
|
|
|
|
|
char *package_name = HvNAME(stash); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
181
|
|
|
|
|
|
|
char *qualified_name; |
182
|
17
|
|
|
|
|
|
SV *ret = 0; /* Initialise to silence spurious compiler warning */ |
183
|
|
|
|
|
|
|
|
184
|
17
|
|
|
|
|
|
New(0, qualified_name, strlen(package_name) + 2 + name_len, char); |
185
|
17
|
|
|
|
|
|
strcpy(qualified_name, package_name); |
186
|
17
|
|
|
|
|
|
strcat(qualified_name, "::"); |
187
|
17
|
|
|
|
|
|
strcat(qualified_name, name_str+1); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
debug_print(("fetch_from_stash: Looking for %c%s\n", |
190
|
|
|
|
|
|
|
name_str[0], qualified_name)); |
191
|
17
|
|
|
|
|
|
switch (name_str[0]) { |
192
|
15
|
|
|
|
|
|
case '$': ret = get_sv(qualified_name, FALSE); break; |
193
|
0
|
|
|
|
|
|
case '@': ret = (SV*) get_av(qualified_name, FALSE); break; |
194
|
2
|
|
|
|
|
|
case '%': ret = (SV*) get_hv(qualified_name, FALSE); break; |
195
|
17
|
|
|
|
|
|
default: die("PadWalker: variable '%s' of unknown type", name_str); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
if (ret) |
198
|
|
|
|
|
|
|
debug_print(("%s\n", sv_peek(ret))); |
199
|
|
|
|
|
|
|
else |
200
|
|
|
|
|
|
|
/* I don't _think_ this should ever happen */ |
201
|
|
|
|
|
|
|
debug_print(("XXXX - Variable %c%s not found\n", |
202
|
|
|
|
|
|
|
name_str[0], qualified_name)); |
203
|
17
|
|
|
|
|
|
Safefree(qualified_name); |
204
|
17
|
|
|
|
|
|
return ret; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
void |
208
|
68
|
|
|
|
|
|
pads_into_hash(pTHX_ PADNAMELIST* pad_namelist, PAD* pad_vallist, HV* my_hash, |
209
|
|
|
|
|
|
|
HV* our_hash, U32 valid_at_seq) |
210
|
|
|
|
|
|
|
{ |
211
|
|
|
|
|
|
|
I32 i; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
debug_print(("pads_into_hash(%p, %p, ..)\n", |
214
|
|
|
|
|
|
|
(void*)pad_namelist, (void*) pad_vallist)); |
215
|
|
|
|
|
|
|
|
216
|
764
|
100
|
|
|
|
|
for (i=PadnamelistMAX(pad_namelist); i>=0; --i) { |
217
|
696
|
|
|
|
|
|
PADNAME* name_sv = PadnamelistARRAY(pad_namelist)[i]; |
218
|
|
|
|
|
|
|
|
219
|
696
|
100
|
|
|
|
|
if (name_sv) { |
220
|
530
|
|
|
|
|
|
char *name_str = PadnamePV(name_sv); |
221
|
530
|
100
|
|
|
|
|
if (name_str) { |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
debug_print(("** %s (%lx,%lx) [%lx]%s\n", name_str, |
224
|
|
|
|
|
|
|
COP_SEQ_RANGE_LOW(name_sv), COP_SEQ_RANGE_HIGH(name_sv), valid_at_seq, |
225
|
|
|
|
|
|
|
PadnameOUTER(name_sv) ? " " : "")); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
/* Check that this variable is valid at the cop_seq |
228
|
|
|
|
|
|
|
* specified, by peeking into the NV and IV slots |
229
|
|
|
|
|
|
|
* of the name sv. (This must be one of those "breathtaking |
230
|
|
|
|
|
|
|
* optimisations" mentioned in the Panther book). |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
* Anonymous subs are stored here with a name of "&", |
233
|
|
|
|
|
|
|
* so also check that the name is longer than one char. |
234
|
|
|
|
|
|
|
* (Note that the prefix letter is here as well, so a |
235
|
|
|
|
|
|
|
* valid variable will _always_ be >1 char) |
236
|
|
|
|
|
|
|
*/ |
237
|
|
|
|
|
|
|
|
238
|
346
|
100
|
|
|
|
|
if ((PadnameOUTER(name_sv) || 0 == valid_at_seq || |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
239
|
211
|
100
|
|
|
|
|
(valid_at_seq <= COP_SEQ_RANGE_HIGH(name_sv) && |
240
|
123
|
50
|
|
|
|
|
valid_at_seq > COP_SEQ_RANGE_LOW(name_sv))) && |
241
|
123
|
|
|
|
|
|
strlen(name_str) > 1 ) |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
{ |
244
|
|
|
|
|
|
|
SV *val_sv; |
245
|
123
|
|
|
|
|
|
U32 name_len = strlen(name_str); |
246
|
123
|
|
|
|
|
|
bool is_our = PadnameIsOUR(name_sv); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
debug_print(((is_our ? "** FOUND OUR %s\n" |
249
|
|
|
|
|
|
|
: "** FOUND MY %s\n"), name_str)); |
250
|
|
|
|
|
|
|
|
251
|
123
|
100
|
|
|
|
|
if ( hv_exists(my_hash, name_str, name_len) |
252
|
116
|
100
|
|
|
|
|
|| hv_exists(our_hash, name_str, name_len)) |
253
|
|
|
|
|
|
|
{ |
254
|
|
|
|
|
|
|
debug_print(("** key already exists - ignoring!\n")); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
else { |
257
|
109
|
100
|
|
|
|
|
if (is_our) { |
258
|
17
|
|
|
|
|
|
val_sv = fetch_from_stash(aTHX_ PadnameOURSTASH(name_sv), |
259
|
|
|
|
|
|
|
name_str, name_len); |
260
|
17
|
50
|
|
|
|
|
if (!val_sv) { |
261
|
|
|
|
|
|
|
debug_print(("Value of our variable is undefined\n")); |
262
|
17
|
|
|
|
|
|
val_sv = &PL_sv_undef; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
else |
266
|
|
|
|
|
|
|
{ |
267
|
92
|
|
|
|
|
|
val_sv = |
268
|
92
|
50
|
|
|
|
|
pad_vallist ? PadARRAY(pad_vallist)[i] : &PL_sv_undef; |
269
|
92
|
50
|
|
|
|
|
if (!val_sv) val_sv = &PL_sv_undef; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
109
|
50
|
|
|
|
|
hv_store((is_our ? our_hash : my_hash), name_str, PadnameUTF8(name_sv) ? -name_len : name_len, |
|
|
100
|
|
|
|
|
|
273
|
|
|
|
|
|
|
(val_sv ? newRV_inc(val_sv) : &PL_sv_undef), 0); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
68
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
void |
282
|
68
|
|
|
|
|
|
padlist_into_hash(pTHX_ PADLIST* padlist, HV* my_hash, HV* our_hash, |
283
|
|
|
|
|
|
|
U32 valid_at_seq, long depth) |
284
|
|
|
|
|
|
|
{ |
285
|
|
|
|
|
|
|
PADNAMELIST *pad_namelist; |
286
|
|
|
|
|
|
|
PAD *pad_vallist; |
287
|
|
|
|
|
|
|
|
288
|
68
|
100
|
|
|
|
|
if (depth == 0) depth = 1; |
289
|
|
|
|
|
|
|
|
290
|
68
|
50
|
|
|
|
|
if (!padlist) { |
291
|
|
|
|
|
|
|
/* Probably an XSUB */ |
292
|
0
|
|
|
|
|
|
die("PadWalker: cv has no padlist"); |
293
|
|
|
|
|
|
|
} |
294
|
68
|
|
|
|
|
|
pad_namelist = PadlistNAMES(padlist); |
295
|
68
|
|
|
|
|
|
pad_vallist = PadlistARRAY(padlist)[depth]; |
296
|
|
|
|
|
|
|
|
297
|
68
|
|
|
|
|
|
pads_into_hash(aTHX_ pad_namelist, pad_vallist, my_hash, our_hash, valid_at_seq); |
298
|
68
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
void |
301
|
37
|
|
|
|
|
|
context_vars(pTHX_ PERL_CONTEXT *cx, HV* my_ret, HV* our_ret, U32 seq, CV *cv) |
302
|
|
|
|
|
|
|
{ |
303
|
|
|
|
|
|
|
/* If cx is null, we take that to mean that we should look |
304
|
|
|
|
|
|
|
* at the cv instead |
305
|
|
|
|
|
|
|
*/ |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
debug_print(("**context_vars(%p, %p, %p, 0x%lx)\n", |
308
|
|
|
|
|
|
|
(void*)cx, (void*)my_ret, (void*)our_ret, (long)seq)); |
309
|
37
|
100
|
|
|
|
|
if (cx == (PERL_CONTEXT*)-1) |
310
|
1
|
|
|
|
|
|
croak("Not nested deeply enough"); |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
else { |
313
|
36
|
100
|
|
|
|
|
CV* cur_cv = cx ? cx->blk_sub.cv : cv; |
314
|
36
|
100
|
|
|
|
|
long depth = cx ? cx->blk_sub.olddepth + 1 : 1; |
315
|
|
|
|
|
|
|
|
316
|
36
|
50
|
|
|
|
|
if (!cur_cv) |
317
|
0
|
|
|
|
|
|
die("panic: Context has no CV!\n"); |
318
|
|
|
|
|
|
|
|
319
|
101
|
100
|
|
|
|
|
while (cur_cv) { |
320
|
|
|
|
|
|
|
debug_print(("\tcv name = %s; depth=%ld\n", |
321
|
|
|
|
|
|
|
CvGV(cur_cv) ? GvNAME(CvGV(cur_cv)) :"(null)", depth)); |
322
|
65
|
100
|
|
|
|
|
if (CvPADLIST(cur_cv)) |
323
|
64
|
|
|
|
|
|
padlist_into_hash(aTHX_ CvPADLIST(cur_cv), my_ret, our_ret, seq, depth); |
324
|
65
|
|
|
|
|
|
cur_cv = CvOUTSIDE(cur_cv); |
325
|
65
|
100
|
|
|
|
|
if (cur_cv) depth = CvDEPTH(cur_cv); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
36
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
void |
331
|
27
|
|
|
|
|
|
do_peek(pTHX_ I32 uplevel, HV* my_hash, HV* our_hash) |
332
|
|
|
|
|
|
|
{ |
333
|
|
|
|
|
|
|
PERL_CONTEXT *cx, *ccstack; |
334
|
27
|
|
|
|
|
|
COP *cop = 0; |
335
|
|
|
|
|
|
|
I32 cxix_from, cxix_to, i; |
336
|
27
|
|
|
|
|
|
bool first_eval = TRUE; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
show_cxstack(); |
339
|
27
|
|
|
|
|
|
if (PL_curstackinfo->si_type != PERLSI_MAIN) |
340
|
|
|
|
|
|
|
debug_print(("!! We're in a higher stack level\n")); |
341
|
|
|
|
|
|
|
|
342
|
27
|
|
|
|
|
|
cx = upcontext(aTHX_ uplevel, &cop, &ccstack, &cxix_from, &cxix_to); |
343
|
|
|
|
|
|
|
debug_print(("** cxix = (%ld,%ld)\n", cxix_from, cxix_to)); |
344
|
27
|
100
|
|
|
|
|
if (cop == 0) { |
345
|
|
|
|
|
|
|
debug_print(("**Setting cop to PL_curcop\n")); |
346
|
14
|
|
|
|
|
|
cop = PL_curcop; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
debug_print(("**Cop file = %s\n", CopFILE(cop))); |
349
|
|
|
|
|
|
|
|
350
|
27
|
|
|
|
|
|
context_vars(aTHX_ cx, my_hash, our_hash, cop->cop_seq, PL_main_cv); |
351
|
|
|
|
|
|
|
|
352
|
49
|
100
|
|
|
|
|
for (i = cxix_from-1; i > cxix_to; --i) { |
353
|
|
|
|
|
|
|
debug_print(("** CxTYPE = %s (cxix = %ld)\n", |
354
|
|
|
|
|
|
|
cxtype_name(CxTYPE(&ccstack[i])), i)); |
355
|
25
|
|
|
|
|
|
switch (CxTYPE(&ccstack[i])) { |
356
|
|
|
|
|
|
|
case CXt_EVAL: |
357
|
|
|
|
|
|
|
debug_print(("\told_op_type = %ld\n", CxOLD_OP_TYPE(&ccstack[i]))); |
358
|
7
|
|
|
|
|
|
switch(CxOLD_OP_TYPE(&ccstack[i])) { |
359
|
|
|
|
|
|
|
case OP_ENTEREVAL: |
360
|
5
|
100
|
|
|
|
|
if (first_eval) { |
361
|
3
|
|
|
|
|
|
context_vars(aTHX_ 0, my_hash, our_hash, cop->cop_seq, ccstack[i].blk_eval.cv); |
362
|
3
|
|
|
|
|
|
first_eval = FALSE; |
363
|
|
|
|
|
|
|
} |
364
|
5
|
|
|
|
|
|
context_vars(aTHX_ 0, my_hash, our_hash, ccstack[i].blk_oldcop->cop_seq, |
365
|
5
|
|
|
|
|
|
ccstack[i].blk_eval.cv); |
366
|
5
|
|
|
|
|
|
break; |
367
|
|
|
|
|
|
|
case OP_REQUIRE: |
368
|
|
|
|
|
|
|
case OP_DOFILE: |
369
|
|
|
|
|
|
|
debug_print(("blk_eval.cv = %p\n", (void*) ccstack[i].blk_eval.cv)); |
370
|
2
|
50
|
|
|
|
|
if (first_eval) |
371
|
2
|
|
|
|
|
|
context_vars(aTHX_ 0, my_hash, our_hash, |
372
|
4
|
|
|
|
|
|
cop->cop_seq, ccstack[i].blk_eval.cv); |
373
|
2
|
|
|
|
|
|
return; |
374
|
|
|
|
|
|
|
/* If it's OP_ENTERTRY, we skip this altogether. */ |
375
|
|
|
|
|
|
|
} |
376
|
5
|
|
|
|
|
|
break; |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
case CXt_SUB: |
379
|
|
|
|
|
|
|
#ifdef CXt_FORMAT |
380
|
|
|
|
|
|
|
case CXt_FORMAT: |
381
|
|
|
|
|
|
|
#endif |
382
|
0
|
|
|
|
|
|
Perl_die(aTHX_ "PadWalker: internal error"); |
383
|
|
|
|
|
|
|
exit(EXIT_FAILURE); |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
void |
389
|
7
|
|
|
|
|
|
get_closed_over(pTHX_ CV *cv, HV *hash, HV *indices) |
390
|
|
|
|
|
|
|
{ |
391
|
|
|
|
|
|
|
I32 i; |
392
|
|
|
|
|
|
|
U32 val_depth; |
393
|
|
|
|
|
|
|
PADNAMELIST *pad_namelist; |
394
|
|
|
|
|
|
|
PAD *pad_vallist; |
395
|
|
|
|
|
|
|
|
396
|
7
|
100
|
|
|
|
|
if (CvISXSUB(cv) || !CvPADLIST(cv)) { |
|
|
50
|
|
|
|
|
|
397
|
1
|
|
|
|
|
|
return; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
6
|
100
|
|
|
|
|
val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; |
401
|
6
|
|
|
|
|
|
pad_namelist = PadlistNAMES(CvPADLIST(cv)); |
402
|
6
|
|
|
|
|
|
pad_vallist = PadlistARRAY(CvPADLIST(cv))[val_depth]; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
debug_print(("PadlistMAX(CvPADLIST(cv)) = %ld\n", |
405
|
|
|
|
|
|
|
PadlistMAX(CvPADLIST(cv)) )); |
406
|
|
|
|
|
|
|
|
407
|
72
|
100
|
|
|
|
|
for (i=PadnamelistMAX(pad_namelist); i>=0; --i) { |
408
|
66
|
|
|
|
|
|
PADNAME* name_sv = PadnamelistARRAY(pad_namelist)[i]; |
409
|
|
|
|
|
|
|
|
410
|
66
|
50
|
|
|
|
|
if (name_sv && PadnamePV(name_sv)) { |
|
|
100
|
|
|
|
|
|
411
|
15
|
|
|
|
|
|
char* name_str = PadnamePV(name_sv); |
412
|
15
|
|
|
|
|
|
STRLEN name_len = strlen(name_str); |
413
|
|
|
|
|
|
|
|
414
|
15
|
100
|
|
|
|
|
if (PadnameOUTER(name_sv) && !PadnameIsOUR(name_sv)) { |
|
|
100
|
|
|
|
|
|
415
|
8
|
|
|
|
|
|
SV *val_sv = PadARRAY(pad_vallist)[i]; |
416
|
8
|
50
|
|
|
|
|
if (!val_sv) val_sv = &PL_sv_undef; |
417
|
|
|
|
|
|
|
#ifdef PADWALKER_DEBUGGING |
418
|
|
|
|
|
|
|
debug_print(("Found a fake slot: %s\n", name_str)); |
419
|
|
|
|
|
|
|
if (val == 0) |
420
|
|
|
|
|
|
|
debug_print(("value is null\n")); |
421
|
|
|
|
|
|
|
else |
422
|
|
|
|
|
|
|
sv_dump(*val); |
423
|
|
|
|
|
|
|
#endif |
424
|
8
|
|
|
|
|
|
hv_store(hash, name_str, name_len, newRV_inc(val_sv), 0); |
425
|
8
|
50
|
|
|
|
|
if (indices) { |
426
|
|
|
|
|
|
|
/* Create a temporary SV as a way of getting perl to |
427
|
|
|
|
|
|
|
* stringify 'i' for us. */ |
428
|
0
|
|
|
|
|
|
SV *i_sv = newSViv(i); |
429
|
0
|
|
|
|
|
|
hv_store_ent(indices, i_sv, newRV_inc(val_sv), 0); |
430
|
0
|
|
|
|
|
|
SvREFCNT_dec(i_sv); |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
char * |
438
|
8
|
|
|
|
|
|
get_var_name(CV *cv, SV *var) |
439
|
|
|
|
|
|
|
{ |
440
|
|
|
|
|
|
|
I32 i; |
441
|
8
|
100
|
|
|
|
|
U32 val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; |
442
|
8
|
|
|
|
|
|
PADNAMELIST *pad_namelist = PadlistNAMES(CvPADLIST(cv)); |
443
|
8
|
|
|
|
|
|
PAD *pad_vallist = PadlistARRAY(CvPADLIST(cv))[val_depth]; |
444
|
|
|
|
|
|
|
|
445
|
40
|
50
|
|
|
|
|
for (i=PadnamelistMAX(pad_namelist); i>=0; --i) { |
446
|
40
|
|
|
|
|
|
PADNAME* name = PadnamelistARRAY(pad_namelist)[i]; |
447
|
|
|
|
|
|
|
char* name_str; |
448
|
|
|
|
|
|
|
|
449
|
40
|
100
|
|
|
|
|
if ( name && (name_str = PadnamePV(name)) |
|
|
50
|
|
|
|
|
|
450
|
19
|
100
|
|
|
|
|
&& PadARRAY(pad_vallist)[i] == var) { |
451
|
8
|
|
|
|
|
|
return name_str; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
0
|
|
|
|
|
|
return 0; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
CV * |
458
|
7
|
|
|
|
|
|
up_cv(pTHX_ I32 uplevel, const char * caller_name) |
459
|
|
|
|
|
|
|
{ |
460
|
|
|
|
|
|
|
PERL_CONTEXT *cx, *ccstack; |
461
|
|
|
|
|
|
|
I32 cxix_from, cxix_to, i; |
462
|
|
|
|
|
|
|
|
463
|
7
|
50
|
|
|
|
|
if (uplevel < 0) |
464
|
0
|
|
|
|
|
|
croak("%s: sub is < 0", caller_name); |
465
|
|
|
|
|
|
|
|
466
|
7
|
|
|
|
|
|
cx = upcontext(aTHX_ uplevel, 0, &ccstack, &cxix_from, &cxix_to); |
467
|
7
|
50
|
|
|
|
|
if (cx == (PERL_CONTEXT *)-1) { |
468
|
0
|
|
|
|
|
|
croak("%s: Not nested deeply enough", caller_name); |
469
|
|
|
|
|
|
|
return 0; /* NOT REACHED, but stop picky compilers from whining */ |
470
|
|
|
|
|
|
|
} |
471
|
7
|
50
|
|
|
|
|
else if (cx) |
472
|
0
|
|
|
|
|
|
return cx->blk_sub.cv; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
else { |
475
|
|
|
|
|
|
|
|
476
|
12
|
100
|
|
|
|
|
for (i = cxix_from-1; i > cxix_to; --i) |
477
|
9
|
100
|
|
|
|
|
if (CxTYPE(&ccstack[i]) == CXt_EVAL) { |
478
|
6
|
|
|
|
|
|
I32 old_op_type = CxOLD_OP_TYPE(&ccstack[i]); |
479
|
6
|
100
|
|
|
|
|
if (old_op_type == OP_REQUIRE || old_op_type == OP_DOFILE) |
|
|
100
|
|
|
|
|
|
480
|
4
|
|
|
|
|
|
return ccstack[i].blk_eval.cv; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
7
|
|
|
|
|
|
return PL_main_cv; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
STATIC bool |
488
|
3
|
|
|
|
|
|
is_scalar_type(SV *sv) { |
489
|
5
|
100
|
|
|
|
|
return !( |
|
|
50
|
|
|
|
|
|
490
|
3
|
|
|
|
|
|
SvTYPE(sv) == SVt_PVAV |
491
|
2
|
50
|
|
|
|
|
|| SvTYPE(sv) == SVt_PVHV |
492
|
2
|
50
|
|
|
|
|
|| SvTYPE(sv) == SVt_PVCV |
493
|
2
|
50
|
|
|
|
|
|| isGV_with_GP(sv) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
494
|
2
|
|
|
|
|
|
|| SvTYPE(sv) == SVt_PVIO |
495
|
|
|
|
|
|
|
); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
STATIC bool |
499
|
4
|
|
|
|
|
|
is_correct_type(SV *orig, SV *restore) { |
500
|
4
|
|
|
|
|
|
return ( |
501
|
4
|
|
|
|
|
|
( SvTYPE(orig) == SvTYPE(restore) ) |
502
|
7
|
|
|
|
|
|
|| |
503
|
3
|
50
|
|
|
|
|
( is_scalar_type(orig) && is_scalar_type(restore) ) |
504
|
|
|
|
|
|
|
); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
MODULE = PadWalker PACKAGE = PadWalker |
509
|
|
|
|
|
|
|
PROTOTYPES: DISABLE |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
void |
512
|
|
|
|
|
|
|
peek_my(uplevel) |
513
|
|
|
|
|
|
|
I32 uplevel; |
514
|
|
|
|
|
|
|
PREINIT: |
515
|
26
|
|
|
|
|
|
HV* ret = newHV(); |
516
|
26
|
|
|
|
|
|
HV* ignore = newHV(); |
517
|
|
|
|
|
|
|
PPCODE: |
518
|
26
|
|
|
|
|
|
do_peek(aTHX_ uplevel, ret, ignore); |
519
|
25
|
|
|
|
|
|
SvREFCNT_dec((SV*) ignore); |
520
|
25
|
50
|
|
|
|
|
EXTEND(SP, 1); |
521
|
25
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)ret))); |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
void |
524
|
|
|
|
|
|
|
peek_our(uplevel) |
525
|
|
|
|
|
|
|
I32 uplevel; |
526
|
|
|
|
|
|
|
PREINIT: |
527
|
1
|
|
|
|
|
|
HV* ret = newHV(); |
528
|
1
|
|
|
|
|
|
HV* ignore = newHV(); |
529
|
|
|
|
|
|
|
PPCODE: |
530
|
1
|
|
|
|
|
|
do_peek(aTHX_ uplevel, ignore, ret); |
531
|
1
|
|
|
|
|
|
SvREFCNT_dec((SV*) ignore); |
532
|
1
|
50
|
|
|
|
|
EXTEND(SP, 1); |
533
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)ret))); |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
void |
537
|
|
|
|
|
|
|
peek_sub(cv) |
538
|
|
|
|
|
|
|
CV* cv; |
539
|
|
|
|
|
|
|
PREINIT: |
540
|
6
|
|
|
|
|
|
HV* ret = newHV(); |
541
|
6
|
|
|
|
|
|
HV* ignore = newHV(); |
542
|
|
|
|
|
|
|
PPCODE: |
543
|
5
|
100
|
|
|
|
|
if (CvISXSUB(cv)) |
544
|
1
|
|
|
|
|
|
die("PadWalker: cv has no padlist"); |
545
|
4
|
|
|
|
|
|
padlist_into_hash(aTHX_ CvPADLIST(cv), ret, ignore, 0, CvDEPTH(cv)); |
546
|
4
|
|
|
|
|
|
SvREFCNT_dec((SV*) ignore); |
547
|
4
|
50
|
|
|
|
|
EXTEND(SP, 1); |
548
|
4
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)ret))); |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
void |
551
|
|
|
|
|
|
|
set_closed_over(sv, pad) |
552
|
|
|
|
|
|
|
SV* sv; |
553
|
|
|
|
|
|
|
HV* pad; |
554
|
|
|
|
|
|
|
PREINIT: |
555
|
|
|
|
|
|
|
I32 i; |
556
|
4
|
|
|
|
|
|
CV *cv = (CV *)SvRV(sv); |
557
|
4
|
50
|
|
|
|
|
U32 val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; |
558
|
4
|
|
|
|
|
|
PADNAMELIST *pad_namelist = PadlistNAMES(CvPADLIST(cv)); |
559
|
4
|
|
|
|
|
|
PAD *pad_vallist = PadlistARRAY(CvPADLIST(cv))[val_depth]; |
560
|
|
|
|
|
|
|
CODE: |
561
|
23
|
100
|
|
|
|
|
for (i=PadnamelistMAX(pad_namelist); i>=0; --i) { |
562
|
20
|
|
|
|
|
|
PADNAME* name = PadnamelistARRAY(pad_namelist)[i]; |
563
|
|
|
|
|
|
|
char* name_str; |
564
|
|
|
|
|
|
|
|
565
|
20
|
50
|
|
|
|
|
if (name && (name_str = PadnamePV(name))) { |
|
|
100
|
|
|
|
|
|
566
|
10
|
|
|
|
|
|
STRLEN name_len = strlen(name_str); |
567
|
|
|
|
|
|
|
|
568
|
10
|
100
|
|
|
|
|
if (PadnameOUTER(name) && !PadnameIsOUR(name)) { |
|
|
50
|
|
|
|
|
|
569
|
7
|
|
|
|
|
|
SV **restore_ref = hv_fetch(pad, name_str, name_len, FALSE); |
570
|
7
|
100
|
|
|
|
|
if ( restore_ref ) { |
571
|
4
|
50
|
|
|
|
|
if ( SvROK(*restore_ref) ) { |
572
|
4
|
|
|
|
|
|
SV *restore = SvRV(*restore_ref); |
573
|
4
|
|
|
|
|
|
SV *orig = PadARRAY(pad_vallist)[i]; |
574
|
4
|
|
|
|
|
|
int restore_type = SvTYPE(restore); |
575
|
|
|
|
|
|
|
|
576
|
4
|
50
|
|
|
|
|
if ( !orig || is_correct_type(orig, restore) ) { |
|
|
100
|
|
|
|
|
|
577
|
3
|
|
|
|
|
|
SvREFCNT_inc(restore); |
578
|
|
|
|
|
|
|
|
579
|
3
|
|
|
|
|
|
PadARRAY(pad_vallist)[i] = restore; |
580
|
|
|
|
|
|
|
} else { |
581
|
1
|
|
|
|
|
|
croak("Incorrect reftype for variable %s (got %s expected %s)", name_str, sv_reftype(restore, 0), sv_reftype(orig, 0)); |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
} else { |
584
|
0
|
|
|
|
|
|
croak("The variable for %s is not a reference", name_str); |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
void |
594
|
|
|
|
|
|
|
closed_over(cv) |
595
|
|
|
|
|
|
|
CV* cv; |
596
|
|
|
|
|
|
|
PREINIT: |
597
|
7
|
|
|
|
|
|
HV* ret = newHV(); |
598
|
|
|
|
|
|
|
HV* targs; |
599
|
|
|
|
|
|
|
PPCODE: |
600
|
7
|
50
|
|
|
|
|
if (GIMME_V == G_ARRAY) { |
|
|
100
|
|
|
|
|
|
601
|
1
|
|
|
|
|
|
targs = newHV(); |
602
|
1
|
|
|
|
|
|
get_closed_over(aTHX_ cv, ret, targs); |
603
|
|
|
|
|
|
|
|
604
|
1
|
50
|
|
|
|
|
EXTEND(SP, 2); |
605
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)ret))); |
606
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)targs))); |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
else { |
609
|
6
|
|
|
|
|
|
get_closed_over(aTHX_ cv, ret, 0); |
610
|
|
|
|
|
|
|
|
611
|
6
|
50
|
|
|
|
|
EXTEND(SP, 1); |
612
|
6
|
|
|
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV*)ret))); |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
char* |
616
|
|
|
|
|
|
|
var_name(sub, var_ref) |
617
|
|
|
|
|
|
|
SV* sub; |
618
|
|
|
|
|
|
|
SV* var_ref; |
619
|
|
|
|
|
|
|
PREINIT: |
620
|
|
|
|
|
|
|
SV *cv; |
621
|
|
|
|
|
|
|
CODE: |
622
|
8
|
50
|
|
|
|
|
if (!SvROK(var_ref)) |
623
|
0
|
|
|
|
|
|
croak("Usage: PadWalker::var_name(sub, var_ref)"); |
624
|
|
|
|
|
|
|
|
625
|
8
|
100
|
|
|
|
|
if (SvROK(sub)) { |
626
|
1
|
|
|
|
|
|
cv = SvRV(sub); |
627
|
1
|
50
|
|
|
|
|
if (SvTYPE(cv) != SVt_PVCV) |
628
|
0
|
|
|
|
|
|
croak("PadWalker::var_name: sub is neither a CODE reference nor a number"); |
629
|
|
|
|
|
|
|
} else |
630
|
7
|
50
|
|
|
|
|
cv = (SV *) up_cv(aTHX_ SvIV(sub), "PadWalker::upcontext"); |
631
|
|
|
|
|
|
|
|
632
|
8
|
|
|
|
|
|
RETVAL = get_var_name((CV *) cv, SvRV(var_ref)); |
633
|
|
|
|
|
|
|
OUTPUT: |
634
|
|
|
|
|
|
|
RETVAL |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
void |
637
|
|
|
|
|
|
|
_upcontext(uplevel) |
638
|
|
|
|
|
|
|
I32 uplevel |
639
|
|
|
|
|
|
|
PPCODE: |
640
|
|
|
|
|
|
|
/* This is used by Devel::Caller. */ |
641
|
0
|
0
|
|
|
|
|
XPUSHs(sv_2mortal(newSViv((IV)upcontext(aTHX_ uplevel, 0, 0, 0, 0)))); |