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.7 by root, Sat Apr 26 03:15:28 2008 UTC vs.
Revision 1.15 by root, Mon Dec 1 13:47:09 2008 UTC

… …
10 10
11#if !PERL_VERSION_ATLEAST (5,8,9) 11#if !PERL_VERSION_ATLEAST (5,8,9)
12# define SVt_LAST 16 12# define SVt_LAST 16
13#endif 13#endif
14 14
15#if !PERL_VERSION_ATLEAST (5,10,0)
16# define SvPAD_OUR(dummy) 0
17#endif
18
15#define res_pair(text) \ 19#define res_pair(text) \
16 { \ 20 do { \
17 AV *av = newAV (); \ 21 AV *av = newAV (); \
18 av_push (av, newSVpv (text, 0)); \ 22 av_push (av, newSVpv (text, 0)); \
19 if (rmagical) SvRMAGICAL_on (sv); \ 23 if (rmagical) SvRMAGICAL_on (sv); \
20 av_push (av, sv_rvweaken (newRV_inc (sv))); \ 24 av_push (av, sv_rvweaken (newRV_inc (sv))); \
21 if (rmagical) SvRMAGICAL_off (sv); \ 25 if (rmagical) SvRMAGICAL_off (sv); \
22 av_push (about, newRV_noinc ((SV *)av)); \ 26 av_push (about, newRV_noinc ((SV *)av)); \
23 } 27 } while (0)
28
29#define res_text(text) \
30 do { \
31 AV *av = newAV (); \
32 av_push (av, newSVpv (text, 0)); \
33 av_push (about, newRV_noinc ((SV *)av)); \
34 } while (0)
24 35
25#define res_gv(sigil) \ 36#define res_gv(sigil) \
26 { \
27 AV *av = newAV (); \
28 av_push (av, newSVpv (form ("in the global %c%s::%.*s", sigil, \ 37 res_text (form ("in the global %c%s::%.*s", sigil, \
29 HvNAME (GvSTASH (sv)), \ 38 HvNAME (GvSTASH (sv)), \
39 GvNAMELEN (sv), \
30 GvNAMELEN (sv), GvNAME (sv) ? GvNAME (sv) : "<anonymous>"), \ 40 GvNAME (sv) ? GvNAME (sv) : "<anonymous>"))
31 0)); \
32 av_push (about, newRV_noinc ((SV *)av)); \
33 }
34 41
35MODULE = Devel::FindRef PACKAGE = Devel::FindRef 42MODULE = Devel::FindRef PACKAGE = Devel::FindRef
36 43
37PROTOTYPES: ENABLE 44PROTOTYPES: ENABLE
38 45
39SV *
40ptr2ref (IV ptr)
41 CODE:
42 RETVAL = newRV_inc (INT2PTR (SV *, ptr));
43 OUTPUT:
44 RETVAL
45
46void 46void
47find_ (SV *target) 47find_ (SV *target_ref)
48 PPCODE: 48 PPCODE:
49{ 49{
50 SV *arena, *targ; 50 SV *arena, *targ;
51 int rmagical, i; 51 U32 rmagical;
52 int i;
52 AV *about = newAV (); 53 AV *about = newAV ();
53 AV *excl = newAV (); 54 AV *excl = newAV ();
54 55
55 if (!SvROK (target)) 56 if (!SvROK (target_ref))
56 croak ("find expects a reference to a perl value"); 57 croak ("find expects a reference to a perl value");
57 58
58 targ = SvRV (target); 59 targ = SvRV (target_ref);
59 60
60 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena)) 61 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
61 { 62 {
62 UV idx = SvREFCNT (arena); 63 UV idx = SvREFCNT (arena);
63 64
… …
74 if ((rmagical = SvRMAGICAL (sv))) 75 if ((rmagical = SvRMAGICAL (sv)))
75 SvRMAGICAL_off (sv); 76 SvRMAGICAL_off (sv);
76 77
77 if (SvTYPE (sv) >= SVt_PVMG) 78 if (SvTYPE (sv) >= SVt_PVMG)
78 { 79 {
79 MAGIC *mg = SvMAGIC (sv); 80 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
80 while (mg)
81 { 81 {
82 /* I have no clue what this is */
83 /* maybe some placeholder for our variables for eval? */
84 /* it doesn't seem to reference anything, so we should be able to ignore it */
85 }
86 else
87 {
88 MAGIC *mg = SvMAGIC (sv);
89
90 while (mg)
91 {
82 if (mg->mg_obj == targ) 92 if (mg->mg_obj == targ)
83 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type)); 93 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
84 94
85 if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED) 95 if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED)
86 res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type)); 96 res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type));
87 97
88 mg = mg->mg_moremagic; 98 mg = mg->mg_moremagic;
99 }
89 } 100 }
90 } 101 }
91 102
92 if (SvROK (sv)) 103 if (SvROK (sv))
93 { 104 {
94 if (sv != target && SvRV (sv) == targ && !SvWEAKREF (sv)) 105 if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref)
95 res_pair ("referenced by"); 106 res_pair ("referenced by");
96 } 107 }
97 else 108 else
98 switch (SvTYPE (sv)) 109 switch (SvTYPE (sv))
99 { 110 {
… …
119 130
120 case SVt_PVCV: 131 case SVt_PVCV:
121 { 132 {
122 int depth = CvDEPTH (sv); 133 int depth = CvDEPTH (sv);
123 134
135 /* Anonymous subs have a padlist but zero depth */
124 if (!depth && CvPADLIST(sv)) 136 if (CvANON (sv) && !depth && CvPADLIST (sv))
125 depth = 1; 137 depth = 1;
126 138
127 if (depth) 139 if (depth)
128 { 140 {
129 AV *padlist = CvPADLIST (sv); 141 AV *padlist = CvPADLIST (sv);
… …
132 { 144 {
133 AV *pad = (AV *)AvARRAY (padlist)[depth]; 145 AV *pad = (AV *)AvARRAY (padlist)[depth];
134 146
135 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */ 147 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
136 148
149 /* The 0th pad slot is @_ */
150 if (AvARRAY (pad)[0] == targ)
151 res_pair ("the argument array for");
152
137 for (i = AvFILLp (pad) + 1; i--; ) 153 for (i = AvFILLp (pad) + 1; --i; )
138 if (AvARRAY (pad)[i] == targ) 154 if (AvARRAY (pad)[i] == targ)
155 {
156 /* Values from constant functions are stored in the pad without any name */
157 SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
158
159 if (name_sv && SvPOK (name_sv))
139 res_pair (form ("in the lexical '%s' in", SvPVX (AvARRAY (AvARRAY (padlist)[0])[i]))); 160 res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
161 else
162 res_pair ("in an unnamed lexical in");
163 }
140 164
141 --depth; 165 --depth;
142 } 166 }
143 } 167 }
144 168
169 if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
170 res_pair ("the constant value of");
171
145 if ((SV*)CvOUTSIDE(sv) == targ) 172 if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
146 res_pair ("the containing scope for"); 173 res_pair ("the containing scope for");
174
175 if (sv == targ && CvANON (sv))
176 if (CvSTART (sv)
177 && CvSTART (sv)->op_type == OP_NEXTSTATE
178 && CopLINE ((COP *)CvSTART (sv)))
179 res_text (form ("the closure created at %s:%d",
180 CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
181 CopLINE ((COP *)CvSTART (sv))));
182 else
183 res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
184 CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
147 } 185 }
148 186
149 break; 187 break;
150 188
151 case SVt_PVGV: 189 case SVt_PVGV:
… …
163 if (rmagical) 201 if (rmagical)
164 SvRMAGICAL_on (sv); 202 SvRMAGICAL_on (sv);
165 } 203 }
166 } 204 }
167 205
206 /* look at the mortalise stack of the current coroutine */
207 for (i = 0; i <= PL_tmps_ix; ++i)
208 if (PL_tmps_stack [i] == targ)
209 res_text ("a temporary on the stack");
210
211 if (targ == (SV*)PL_main_cv)
212 res_text ("the main body of the program");
213
168 EXTEND (SP, 2); 214 EXTEND (SP, 2);
169 PUSHs (sv_2mortal (newRV_noinc ((SV *)about))); 215 PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));
170 PUSHs (sv_2mortal (newRV_noinc ((SV *)excl))); 216 PUSHs (sv_2mortal (newRV_noinc ((SV *)excl)));
171} 217}
172 218
219SV *
220ptr2ref (UV ptr)
221 CODE:
222 RETVAL = newRV_inc (INT2PTR (SV *, ptr));
223 OUTPUT:
224 RETVAL
225
226UV
227ref2ptr (SV *rv)
228 CODE:
229 RETVAL = PTR2UV (SvRV (rv));
230 OUTPUT:
231 RETVAL
232
233U32
234_refcnt (SV *rv)
235 CODE:
236 RETVAL = SvREFCNT (SvRV (rv));
237 OUTPUT:
238 RETVAL

Diff Legend

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