ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.xs
(Generate patch)

Comparing Devel-FindRef/FindRef.xs (file contents):
Revision 1.12 by root, Sat Jul 19 01:17:12 2008 UTC vs.
Revision 1.16 by root, Fri Jun 26 14:47:03 2009 UTC

… …
41 41
42MODULE = Devel::FindRef PACKAGE = Devel::FindRef 42MODULE = Devel::FindRef PACKAGE = Devel::FindRef
43 43
44PROTOTYPES: ENABLE 44PROTOTYPES: ENABLE
45 45
46SV *
47ptr2ref (UV ptr)
48 CODE:
49 RETVAL = newRV_inc (INT2PTR (SV *, ptr));
50 OUTPUT:
51 RETVAL
52
53UV
54ref2ptr (SV *rv)
55 CODE:
56 RETVAL = PTR2UV (SvRV (rv));
57 OUTPUT:
58 RETVAL
59
60void 46void
61find_ (SV *target) 47find_ (SV *target_ref)
62 PPCODE: 48 PPCODE:
63{ 49{
64 SV *arena, *targ; 50 SV *arena, *targ;
65 U32 rmagical; 51 U32 rmagical;
66 int i; 52 int i;
67 AV *about = newAV (); 53 AV *about = newAV ();
68 AV *excl = newAV (); 54 AV *excl = newAV ();
69 55
70 if (!SvROK (target)) 56 if (!SvROK (target_ref))
71 croak ("find expects a reference to a perl value"); 57 croak ("find expects a reference to a perl value");
72 58
73 targ = SvRV (target); 59 targ = SvRV (target_ref);
74 60
75 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena)) 61 if (SvIMMORTAL (targ))
76 { 62 {
77 UV idx = SvREFCNT (arena); 63 if (targ == &PL_sv_undef)
78 64 res_text ("the immortal 'undef' value");
79 /* Remember that the zeroth slot is used as the pointer onwards, so don't 65 else if (targ == &PL_sv_yes)
80 include it. */ 66 res_text ("the immortal 'yes' value");
81 while (--idx > 0) 67 else if (targ == &PL_sv_no)
68 res_text ("the immortal 'no' value");
69 else if (targ == &PL_sv_placeholder)
70 res_text ("the immortal placeholder value");
71 else
72 res_text ("some unknown immortal");
73 }
74 else
75 {
76 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
82 { 77 {
83 SV *sv = &arena [idx]; 78 UV idx = SvREFCNT (arena);
84 79
85 if (SvTYPE (sv) >= SVt_LAST) 80 /* Remember that the zeroth slot is used as the pointer onwards, so don't
86 continue; 81 include it. */
87 82 while (--idx > 0)
88 /* temporarily disable RMAGICAL, it can easily interfere with us */
89 if ((rmagical = SvRMAGICAL (sv)))
90 SvRMAGICAL_off (sv);
91
92 if (SvTYPE (sv) >= SVt_PVMG)
93 { 83 {
84 SV *sv = &arena [idx];
85
86 if (SvTYPE (sv) >= SVt_LAST)
87 continue;
88
89 /* temporarily disable RMAGICAL, it can easily interfere with us */
90 if ((rmagical = SvRMAGICAL (sv)))
91 SvRMAGICAL_off (sv);
92
94 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv)) 93 if (SvTYPE (sv) >= SVt_PVMG)
95 { 94 {
95 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
96 {
96 /* I have no clue what this is */ 97 /* I have no clue what this is */
97 /* maybe some placeholder for our variables for eval? */ 98 /* maybe some placeholder for our variables for eval? */
98 /* it doesn't seem to reference anything, so we should be able to ignore it */ 99 /* it doesn't seem to reference anything, so we should be able to ignore it */
100 }
101 else
102 {
103 MAGIC *mg = SvMAGIC (sv);
104
105 while (mg)
106 {
107 if (mg->mg_obj == targ && mg->mg_flags & MGf_REFCOUNTED)
108 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
109
110 if ((SV *)mg->mg_ptr == targ)
111 res_pair (form ("%sreferenced (in mg_ptr) by '%c' type magic attached to",
112 mg->mg_len == HEf_SVKEY ? "" : "possibly ",
113 mg->mg_type));
114
115 mg = mg->mg_moremagic;
116 }
117 }
118 }
119
120 if (SvROK (sv))
121 {
122 if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref)
123 res_pair ("referenced by");
99 } 124 }
100 else 125 else
126 switch (SvTYPE (sv))
101 { 127 {
102 MAGIC *mg = SvMAGIC (sv); 128 case SVt_PVAV:
129 if (AvREAL (sv))
130 for (i = AvFILLp (sv) + 1; i--; )
131 if (AvARRAY (sv)[i] == targ)
132 res_pair (form ("in array element %d of", i));
103 133
104 while (mg) 134 break;
135
136 case SVt_PVHV:
137 if (hv_iterinit ((HV *)sv))
138 {
139 HE *he;
140
141 while ((he = hv_iternext ((HV *)sv)))
142 if (HeVAL (he) == targ)
143 res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
144 }
145
146 break;
147
148 case SVt_PVCV:
105 { 149 {
106 if (mg->mg_obj == targ) 150 int depth = CvDEPTH (sv);
107 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
108 151
109 if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED) 152 /* Anonymous subs have a padlist but zero depth */
110 res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type)); 153 if (CvANON (sv) && !depth && CvPADLIST (sv))
154 depth = 1;
111 155
112 mg = mg->mg_moremagic; 156 if (depth)
157 {
158 AV *padlist = CvPADLIST (sv);
159
160 while (depth)
161 {
162 AV *pad = (AV *)AvARRAY (padlist)[depth];
163
164 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
165
166 /* The 0th pad slot is @_ */
167 if (AvARRAY (pad)[0] == targ)
168 res_pair ("the argument array for");
169
170 for (i = AvFILLp (pad) + 1; --i; )
171 if (AvARRAY (pad)[i] == targ)
172 {
173 /* Values from constant functions are stored in the pad without any name */
174 SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
175
176 if (name_sv && SvPOK (name_sv))
177 res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
178 else
179 res_pair ("in an unnamed lexical in");
180 }
181
182 --depth;
183 }
184 }
185
186 if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
187 res_pair ("the constant value of");
188
189 if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
190 res_pair ("the containing scope for");
191
192 if (sv == targ && CvANON (sv))
193 if (CvSTART (sv)
194 && CvSTART (sv)->op_type == OP_NEXTSTATE
195 && CopLINE ((COP *)CvSTART (sv)))
196 res_text (form ("the closure created at %s:%d",
197 CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
198 CopLINE ((COP *)CvSTART (sv))));
199 else
200 res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
201 CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
113 } 202 }
203
204 break;
205
206 case SVt_PVGV:
207 if (GvGP (sv))
208 {
209 if (GvSV (sv) == (SV *)targ) res_gv ('$');
210 if (GvAV (sv) == (AV *)targ) res_gv ('@');
211 if (GvHV (sv) == (HV *)targ) res_gv ('%');
212 if (GvCV (sv) == (CV *)targ) res_gv ('&');
213 }
214
215 break;
216
217 case SVt_PVLV:
218 if (LvTARG (sv) == targ)
219 {
220 if (LvTYPE (sv) == 'y')
221 {
222 MAGIC *mg = mg_find (sv, PERL_MAGIC_defelem);
223
224 if (mg && mg->mg_obj)
225 res_pair (form ("the target for the lvalue hash element '%.*s',",
226 SvCUR (mg->mg_obj), SvPV_nolen (mg->mg_obj)));
227 else
228 res_pair (form ("the target for the lvalue array element #%d,", LvTARGOFF (sv)));
229 }
230 else
231 res_pair (form ("an lvalue reference target (type '%c', ofs %d, len %d),",
232 LvTYPE (sv), LvTARGOFF (sv), LvTARGLEN (sv)));
233 }
234
235 break;
114 } 236 }
237
238 if (rmagical)
239 SvRMAGICAL_on (sv);
115 } 240 }
116
117 if (SvROK (sv))
118 {
119 if (sv != target && SvRV (sv) == targ && !SvWEAKREF (sv))
120 res_pair ("referenced by");
121 }
122 else
123 switch (SvTYPE (sv))
124 {
125 case SVt_PVAV:
126 if (AvREAL (sv))
127 for (i = AvFILLp (sv) + 1; i--; )
128 if (AvARRAY (sv)[i] == targ)
129 res_pair (form ("in array element %d of", i));
130
131 break;
132
133 case SVt_PVHV:
134 if (hv_iterinit ((HV *)sv))
135 {
136 HE *he;
137
138 while ((he = hv_iternext ((HV *)sv)))
139 if (HeVAL (he) == targ)
140 res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
141 }
142
143 break;
144
145 case SVt_PVCV:
146 {
147 int depth = CvDEPTH (sv);
148
149 /* Anonymous subs have a padlist but zero depth */
150 if (CvANON (sv) && !depth && CvPADLIST (sv))
151 depth = 1;
152
153 if (depth)
154 {
155 AV *padlist = CvPADLIST (sv);
156
157 while (depth)
158 {
159 AV *pad = (AV *)AvARRAY (padlist)[depth];
160
161 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
162
163 for (i = AvFILLp (pad) + 1; i--; )
164 if (AvARRAY (pad)[i] == targ)
165 {
166 /* Values from constant functions are stored in the pad without any name */
167 SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
168
169 if (name_sv && SvPOK (name_sv))
170 res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
171 else
172 res_pair ("in an unnamed lexical in");
173 }
174
175 --depth;
176 }
177 }
178
179 if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
180 res_pair ("the constant value of");
181
182 if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
183 res_pair ("the containing scope for");
184
185 if (sv == targ && CvANON (sv))
186 if (CvSTART (sv)
187 && CvSTART (sv)->op_type == OP_NEXTSTATE
188 && CopLINE ((COP *)CvSTART (sv)))
189 res_text (form ("the closure created at %s:%d",
190 CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
191 CopLINE ((COP *)CvSTART (sv))));
192 else
193 res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
194 CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
195 }
196
197 break;
198
199 case SVt_PVGV:
200 if (GvGP (sv))
201 {
202 if (GvSV (sv) == (SV *)targ) res_gv ('$');
203 if (GvAV (sv) == (AV *)targ) res_gv ('@');
204 if (GvHV (sv) == (HV *)targ) res_gv ('%');
205 if (GvCV (sv) == (CV *)targ) res_gv ('&');
206 }
207
208 break;
209 }
210
211 if (rmagical)
212 SvRMAGICAL_on (sv);
213 } 241 }
242
243 /* look at the mortalise stack of the current coroutine */
244 for (i = 0; i <= PL_tmps_ix; ++i)
245 if (PL_tmps_stack [i] == targ)
246 res_text ("a temporary on the stack");
247
248 if (targ == (SV*)PL_main_cv)
249 res_text ("the main body of the program");
214 } 250 }
215 251
216 EXTEND (SP, 2); 252 EXTEND (SP, 2);
217 PUSHs (sv_2mortal (newRV_noinc ((SV *)about))); 253 PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));
218 PUSHs (sv_2mortal (newRV_noinc ((SV *)excl))); 254 PUSHs (sv_2mortal (newRV_noinc ((SV *)excl)));
219} 255}
220 256
257SV *
258ptr2ref (UV ptr)
259 CODE:
260 RETVAL = newRV_inc (INT2PTR (SV *, ptr));
261 OUTPUT:
262 RETVAL
263
264UV
265ref2ptr (SV *rv)
266 CODE:
267 if (!SvROK (rv))
268 croak ("argument to Devel::FindRef::ref2ptr must be a reference");
269 RETVAL = PTR2UV (SvRV (rv));
270 OUTPUT:
271 RETVAL
272
273U32
274_refcnt (SV *rv)
275 CODE:
276 if (!SvROK (rv))
277 croak ("argument to Devel::FindRef::_refcnt must be a reference");
278 RETVAL = SvREFCNT (SvRV (rv));
279 OUTPUT:
280 RETVAL

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines