[ViewVC] Diff of: cvs/Devel-FindRef/FindRef.xs

Comparing Devel-FindRef/FindRef.xs (file contents):
Revision 1.10 by root, Fri Jul 11 15:33:48 2008 UTC vs.
Revision 1.16 by root, Fri Jun 26 14:47:03 2009 UTC

…		…
24	av_push (av, sv_rvweaken (newRV_inc (sv))); \	24	av_push (av, sv_rvweaken (newRV_inc (sv))); \
25	if (rmagical) SvRMAGICAL_off (sv); \	25	if (rmagical) SvRMAGICAL_off (sv); \
26	av_push (about, newRV_noinc ((SV *)av)); \	26	av_push (about, newRV_noinc ((SV *)av)); \
27	} while (0)	27	} while (0)
28		28
29	#define res_gv(sigil) \	29	#define res_text(text) \
30	do { \	30	do { \
31	AV *av = newAV (); \	31	AV *av = newAV (); \
32	av_push (av, newSVpv (form ("in the global %c%s::%.*s", sigil, \	32	av_push (av, newSVpv (text, 0)); \
33	HvNAME (GvSTASH (sv)), \
34	GvNAMELEN (sv), GvNAME (sv) ? GvNAME (sv) : "<anonymous>"), \
35	0)); \
36	av_push (about, newRV_noinc ((SV *)av)); \	33	av_push (about, newRV_noinc ((SV *)av)); \
37	} while (0)	34	} while (0)
38		35
		36	#define res_gv(sigil) \
		37	res_text (form ("in the global %c%s::%.*s", sigil, \
		38	HvNAME (GvSTASH (sv)), \
		39	GvNAMELEN (sv), \
		40	GvNAME (sv) ? GvNAME (sv) : "<anonymous>"))
		41
39	MODULE = Devel::FindRef PACKAGE = Devel::FindRef	42	MODULE = Devel::FindRef PACKAGE = Devel::FindRef
40		43
41	PROTOTYPES: ENABLE	44	PROTOTYPES: ENABLE
42		45
43	SV *
44	ptr2ref (IV ptr)
45	CODE:
46	RETVAL = newRV_inc (INT2PTR (SV *, ptr));
47	OUTPUT:
48	RETVAL
49
50	void	46	void
51	find_ (SV *target)	47	find_ (SV *target_ref)
52	PPCODE:	48	PPCODE:
53	{	49	{
54	SV arena, targ;	50	SV arena, targ;
55	U32 rmagical;	51	U32 rmagical;
56	int i;	52	int i;
57	AV *about = newAV ();	53	AV *about = newAV ();
58	AV *excl = newAV ();	54	AV *excl = newAV ();
59		55
60	if (!SvROK (target))	56	if (!SvROK (target_ref))
61	croak ("find expects a reference to a perl value");	57	croak ("find expects a reference to a perl value");
62		58
63	targ = SvRV (target);	59	targ = SvRV (target_ref);
64		60
65	for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))	61	if (SvIMMORTAL (targ))
66	{	62	{
67	UV idx = SvREFCNT (arena);	63	if (targ == &PL_sv_undef)
68		64	res_text ("the immortal 'undef' value");
69	/* Remember that the zeroth slot is used as the pointer onwards, so don't	65	else if (targ == &PL_sv_yes)
70	include it. */	66	res_text ("the immortal 'yes' value");
71	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))
72	{	77	{
73	SV *sv = &arena [idx];	78	UV idx = SvREFCNT (arena);
74		79
75	if (SvTYPE (sv) >= SVt_LAST)	80	/* Remember that the zeroth slot is used as the pointer onwards, so don't
76	continue;	81	include it. */
77		82	while (--idx > 0)
78	/* temporarily disable RMAGICAL, it can easily interfere with us */
79	if ((rmagical = SvRMAGICAL (sv)))
80	SvRMAGICAL_off (sv);
81
82	if (SvTYPE (sv) >= SVt_PVMG)
83	{	83	{
		84	SV *sv = &arena [idx];
84		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
85	if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))	93	if (SvTYPE (sv) >= SVt_PVMG)
86	{	94	{
		95	if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
		96	{
87	/* I have no clue what this is */	97	/* I have no clue what this is */
88	/* maybe some placeholder for our variables for eval? */	98	/* maybe some placeholder for our variables for eval? */
89	/* 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");
90	}	124	}
91	else	125	else
		126	switch (SvTYPE (sv))
92	{	127	{
93	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));
94		133
95	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:
96	{	149	{
97	if (mg->mg_obj == targ)	150	int depth = CvDEPTH (sv);
98	res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
99		151
100	if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED)	152	/* Anonymous subs have a padlist but zero depth */
101	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;
102		155
103	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>"));
104	}	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;
105	}	236	}
		237
		238	if (rmagical)
		239	SvRMAGICAL_on (sv);
106	}	240	}
107
108	if (SvROK (sv))
109	{
110	if (sv != target && SvRV (sv) == targ && !SvWEAKREF (sv))
111	res_pair ("referenced by");
112	}
113	else
114	switch (SvTYPE (sv))
115	{
116	case SVt_PVAV:
117	if (AvREAL (sv))
118	for (i = AvFILLp (sv) + 1; i--; )
119	if (AvARRAY (sv)[i] == targ)
120	res_pair (form ("in array element %d of", i));
121
122	break;
123
124	case SVt_PVHV:
125	if (hv_iterinit ((HV *)sv))
126	{
127	HE *he;
128
129	while ((he = hv_iternext ((HV *)sv)))
130	if (HeVAL (he) == targ)
131	res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
132	}
133
134	break;
135
136	case SVt_PVCV:
137	{
138	int depth = CvDEPTH (sv);
139
140	/* Anonymous subs have a padlist but zero depth */
141	if (!depth && CvPADLIST (sv))
142	depth = 1;
143
144	if (depth)
145	{
146	AV *padlist = CvPADLIST (sv);
147
148	while (depth)
149	{
150	AV pad = (AV )AvARRAY (padlist)[depth];
151
152	av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
153
154	for (i = AvFILLp (pad) + 1; i--; )
155	if (AvARRAY (pad)[i] == targ)
156	{
157	/* Values from constant functions are stored in the pad without any name */
158	SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
159
160	if (name_sv && SvPOK (name_sv))
161	res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
162	else
163	res_pair ("in an unnamed lexical in");
164	}
165
166	--depth;
167	}
168	}
169
170	if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
171	res_pair ("the constant value of");
172
173	if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
174	res_pair ("the containing scope for");
175	}
176
177	break;
178
179	case SVt_PVGV:
180	if (GvGP (sv))
181	{
182	if (GvSV (sv) == (SV *)targ) res_gv ('$');
183	if (GvAV (sv) == (AV *)targ) res_gv ('@');
184	if (GvHV (sv) == (HV *)targ) res_gv ('%');
185	if (GvCV (sv) == (CV *)targ) res_gv ('&');
186	}
187
188	break;
189	}
190
191	if (rmagical)
192	SvRMAGICAL_on (sv);
193	}	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");
194	}	250	}
195		251
196	EXTEND (SP, 2);	252	EXTEND (SP, 2);
197	PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));	253	PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));
198	PUSHs (sv_2mortal (newRV_noinc ((SV *)excl)));	254	PUSHs (sv_2mortal (newRV_noinc ((SV *)excl)));
199	}	255	}
200		256
		257	SV *
		258	ptr2ref (UV ptr)
		259	CODE:
		260	RETVAL = newRV_inc (INT2PTR (SV *, ptr));
		261	OUTPUT:
		262	RETVAL
		263
		264	UV
		265	ref2ptr (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
		273	U32
		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

Comparing Devel-FindRef/FindRef.xs (file contents): Revision 1.10 by root, Fri Jul 11 15:33:48 2008 UTC vs. Revision 1.16 by root, Fri Jun 26 14:47:03 2009 UTC

Diff Legend

Comparing Devel-FindRef/FindRef.xs (file contents):
Revision 1.10 by root, Fri Jul 11 15:33:48 2008 UTC vs.
Revision 1.16 by root, Fri Jun 26 14:47:03 2009 UTC