perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	/* dump.c
	2	*
	3	* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
	4	* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
	5	*
	6	* You may distribute under the terms of either the GNU General Public
	7	* License or the Artistic License, as specified in the README file.
	8	*
	9	*/
	10
	11	/*
	12	* 'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
	13	* it has not been hard for me to read your mind and memory.'
	14	*
	15	* [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
	16	*/
	17
	18	/* This file contains utility routines to dump the contents of SV and OP
	19	* structures, as used by command-line options like -Dt and -Dx, and
	20	* by Devel::Peek.
	21	*
	22	* It also holds the debugging version of the runops function.
	23
	24	=head1 Display and Dump functions
	25	*/
	26
	27	#include "EXTERN.h"
	28	#define PERL_IN_DUMP_C
	29	#include "perl.h"
	30	#include "regcomp.h"
	31
	32	static const char* const svtypenames[SVt_LAST] = {
	33	"NULL",
	34	"IV",
	35	"NV",
	36	"PV",
	37	"INVLIST",
	38	"PVIV",
	39	"PVNV",
	40	"PVMG",
	41	"REGEXP",
	42	"PVGV",
	43	"PVLV",
	44	"PVAV",
	45	"PVHV",
	46	"PVCV",
	47	"PVFM",
	48	"PVIO"
	49	};
	50
	51
	52	static const char* const svshorttypenames[SVt_LAST] = {
	53	"UNDEF",
	54	"IV",
	55	"NV",
	56	"PV",
	57	"INVLST",
	58	"PVIV",
	59	"PVNV",
	60	"PVMG",
	61	"REGEXP",
	62	"GV",
	63	"PVLV",
	64	"AV",
	65	"HV",
	66	"CV",
	67	"FM",
	68	"IO"
	69	};
	70
	71	struct flag_to_name {
	72	U32 flag;
	73	const char *name;
	74	};
	75
	76	static void
	77	S_append_flags(pTHX_ SV sv, U32 flags, const struct flag_to_name start,
	78	const struct flag_to_name *const end)
	79	{
	80	do {
	81	if (flags & start->flag)
	82	sv_catpv(sv, start->name);
	83	} while (++start < end);
	84	}
	85
	86	#define append_flags(sv, f, flags) \
	87	S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
	88
	89	#define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
	90	(len) * (4+UTF8_MAXBYTES) + 1, NULL, \
	91	PERL_PV_ESCAPE_NONASCII \| PERL_PV_ESCAPE_DWIM \
	92	\| ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
	93
	94	/*
	95	=for apidoc pv_escape
	96
	97	Escapes at most the first C<count> chars of C<pv> and puts the results into
	98	C<dsv> such that the size of the escaped string will not exceed C<max> chars
	99	and will not contain any incomplete escape sequences. The number of bytes
	100	escaped will be returned in the C<STRLEN *escaped> parameter if it is not null.
	101	When the C<dsv> parameter is null no escaping actually occurs, but the number
	102	of bytes that would be escaped were it not null will be calculated.
	103
	104	If flags contains C<PERL_PV_ESCAPE_QUOTE> then any double quotes in the string
	105	will also be escaped.
	106
	107	Normally the SV will be cleared before the escaped string is prepared,
	108	but when C<PERL_PV_ESCAPE_NOCLEAR> is set this will not occur.
	109
	110	If C<PERL_PV_ESCAPE_UNI> is set then the input string is treated as UTF-8
	111	if C<PERL_PV_ESCAPE_UNI_DETECT> is set then the input string is scanned
	112	using C<is_utf8_string()> to determine if it is UTF-8.
	113
	114	If C<PERL_PV_ESCAPE_ALL> is set then all input chars will be output
	115	using C<\x01F1> style escapes, otherwise if C<PERL_PV_ESCAPE_NONASCII> is set, only
	116	non-ASCII chars will be escaped using this style; otherwise, only chars above
	117	255 will be so escaped; other non printable chars will use octal or
	118	common escaped patterns like C<\n>.
	119	Otherwise, if C<PERL_PV_ESCAPE_NOBACKSLASH>
	120	then all chars below 255 will be treated as printable and
	121	will be output as literals.
	122
	123	If C<PERL_PV_ESCAPE_FIRSTCHAR> is set then only the first char of the
	124	string will be escaped, regardless of max. If the output is to be in hex,
	125	then it will be returned as a plain hex
	126	sequence. Thus the output will either be a single char,
	127	an octal escape sequence, a special escape like C<\n> or a hex value.
	128
	129	If C<PERL_PV_ESCAPE_RE> is set then the escape char used will be a C<"%"> and
	130	not a C<"\\">. This is because regexes very often contain backslashed
	131	sequences, whereas C<"%"> is not a particularly common character in patterns.
	132
	133	Returns a pointer to the escaped text as held by C<dsv>.
	134
	135	=cut
	136	*/
	137	#define PV_ESCAPE_OCTBUFSIZE 32
	138
	139	char *
	140	Perl_pv_escape( pTHX_ SV dsv, char const const str,
	141	const STRLEN count, const STRLEN max,
	142	STRLEN * const escaped, const U32 flags )
	143	{
	144	const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
	145	const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
	146	char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
	147	STRLEN wrote = 0; /* chars written so far */
	148	STRLEN chsize = 0; /* size of data to be written */
	149	STRLEN readsize = 1; /* size of data just read */
	150	bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this UTF-8 */
	151	const char *pv = str;
	152	const char * const end = pv + count; /* end of string */
	153	octbuf[0] = esc;
	154
	155	PERL_ARGS_ASSERT_PV_ESCAPE;
	156
	157	if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) {
	158	/* This won't alter the UTF-8 flag */
	159	sv_setpvs(dsv, "");
	160	}
	161
	162	if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
	163	isuni = 1;
	164
	165	for ( ; (pv < end && (!max \|\| (wrote < max))) ; pv += readsize ) {
	166	const UV u= (isuni) ? utf8_to_uvchr_buf((U8)pv, (U8) end, &readsize) : (U8)*pv;
	167	const U8 c = (U8)u & 0xFF;
	168
	169	if ( ( u > 255 )
	170	\|\| (flags & PERL_PV_ESCAPE_ALL)
	171	\|\| (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII\|PERL_PV_ESCAPE_DWIM))))
	172	{
	173	if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
	174	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	175	"%"UVxf, u);
	176	else
	177	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	178	((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
	179	? "%cx%02"UVxf
	180	: "%cx{%02"UVxf"}", esc, u);
	181
	182	} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
	183	chsize = 1;
	184	} else {
	185	if ( (c == dq) \|\| (c == esc) \|\| !isPRINT(c) ) {
	186	chsize = 2;
	187	switch (c) {
	188
	189	case '\\' : /* FALLTHROUGH */
	190	case '%' : if ( c == esc ) {
	191	octbuf[1] = esc;
	192	} else {
	193	chsize = 1;
	194	}
	195	break;
	196	case '\v' : octbuf[1] = 'v'; break;
	197	case '\t' : octbuf[1] = 't'; break;
	198	case '\r' : octbuf[1] = 'r'; break;
	199	case '\n' : octbuf[1] = 'n'; break;
	200	case '\f' : octbuf[1] = 'f'; break;
	201	case '"' :
	202	if ( dq == '"' )
	203	octbuf[1] = '"';
	204	else
	205	chsize = 1;
	206	break;
	207	default:
	208	if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
	209	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	210	isuni ? "%cx{%02"UVxf"}" : "%cx%02"UVxf,
	211	esc, u);
	212	}
	213	else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
	214	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	215	"%c%03o", esc, c);
	216	else
	217	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	218	"%c%o", esc, c);
	219	}
	220	} else {
	221	chsize = 1;
	222	}
	223	}
	224	if ( max && (wrote + chsize > max) ) {
	225	break;
	226	} else if (chsize > 1) {
	227	if (dsv)
	228	sv_catpvn(dsv, octbuf, chsize);
	229	wrote += chsize;
	230	} else {
	231	/* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
	232	can be appended raw to the dsv. If dsv happens to be
	233	UTF-8 then we need catpvf to upgrade them for us.
	234	Or add a new API call sv_catpvc(). Think about that name, and
	235	how to keep it clear that it's unlike the s of catpvs, which is
	236	really an array of octets, not a string. */
	237	if (dsv)
	238	Perl_sv_catpvf( aTHX_ dsv, "%c", c);
	239	wrote++;
	240	}
	241	if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
	242	break;
	243	}
	244	if (escaped != NULL)
	245	*escaped= pv - str;
	246	return dsv ? SvPVX(dsv) : NULL;
	247	}
	248	/*
	249	=for apidoc pv_pretty
	250
	251	Converts a string into something presentable, handling escaping via
	252	C<pv_escape()> and supporting quoting and ellipses.
	253
	254	If the C<PERL_PV_PRETTY_QUOTE> flag is set then the result will be
	255	double quoted with any double quotes in the string escaped. Otherwise
	256	if the C<PERL_PV_PRETTY_LTGT> flag is set then the result be wrapped in
	257	angle brackets.
	258
	259	If the C<PERL_PV_PRETTY_ELLIPSES> flag is set and not all characters in
	260	string were output then an ellipsis C<...> will be appended to the
	261	string. Note that this happens AFTER it has been quoted.
	262
	263	If C<start_color> is non-null then it will be inserted after the opening
	264	quote (if there is one) but before the escaped text. If C<end_color>
	265	is non-null then it will be inserted after the escaped text but before
	266	any quotes or ellipses.
	267
	268	Returns a pointer to the prettified text as held by C<dsv>.
	269
	270	=cut
	271	*/
	272
	273	char *
	274	Perl_pv_pretty( pTHX_ SV dsv, char const const str, const STRLEN count,
	275	const STRLEN max, char const * const start_color, char const * const end_color,
	276	const U32 flags )
	277	{
	278	const U8 quotes = (U8)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
	279	(flags & PERL_PV_PRETTY_LTGT) ? "<>" : NULL);
	280	STRLEN escaped;
	281	STRLEN max_adjust= 0;
	282	STRLEN orig_cur;
	283
	284	PERL_ARGS_ASSERT_PV_PRETTY;
	285
	286	if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
	287	/* This won't alter the UTF-8 flag */
	288	sv_setpvs(dsv, "");
	289	}
	290	orig_cur= SvCUR(dsv);
	291
	292	if ( quotes )
	293	Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[0]);
	294
	295	if ( start_color != NULL )
	296	sv_catpv(dsv, start_color);
	297
	298	if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
	299	if (quotes)
	300	max_adjust += 2;
	301	assert(max > max_adjust);
	302	pv_escape( NULL, str, count, max - max_adjust, &escaped, flags );
	303	if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
	304	max_adjust += 3;
	305	assert(max > max_adjust);
	306	}
	307
	308	pv_escape( dsv, str, count, max - max_adjust, &escaped, flags \| PERL_PV_ESCAPE_NOCLEAR );
	309
	310	if ( end_color != NULL )
	311	sv_catpv(dsv, end_color);
	312
	313	if ( quotes )
	314	Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]);
	315
	316	if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
	317	sv_catpvs(dsv, "...");
	318
	319	if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
	320	while( SvCUR(dsv) - orig_cur < max )
	321	sv_catpvs(dsv," ");
	322	}
	323
	324	return SvPVX(dsv);
	325	}
	326
	327	/*
	328	=for apidoc pv_display
	329
	330	Similar to
	331
	332	pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
	333
	334	except that an additional "\0" will be appended to the string when
	335	len > cur and pv[cur] is "\0".
	336
	337	Note that the final string may be up to 7 chars longer than pvlim.
	338
	339	=cut
	340	*/
	341
	342	char *
	343	Perl_pv_display(pTHX_ SV dsv, const char pv, STRLEN cur, STRLEN len, STRLEN pvlim)
	344	{
	345	PERL_ARGS_ASSERT_PV_DISPLAY;
	346
	347	pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
	348	if (len > cur && pv[cur] == '\0')
	349	sv_catpvs( dsv, "\\0");
	350	return SvPVX(dsv);
	351	}
	352
	353	char *
	354	Perl_sv_peek(pTHX_ SV *sv)
	355	{
	356	dVAR;
	357	SV * const t = sv_newmortal();
	358	int unref = 0;
	359	U32 type;
	360
	361	sv_setpvs(t, "");
	362	retry:
	363	if (!sv) {
	364	sv_catpv(t, "VOID");
	365	goto finish;
	366	}
	367	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	368	/* detect data corruption under memory poisoning */
	369	sv_catpv(t, "WILD");
	370	goto finish;
	371	}
	372	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	373	if (sv == &PL_sv_undef) {
	374	sv_catpv(t, "SV_UNDEF");
	375	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	376	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	377	SvREADONLY(sv))
	378	goto finish;
	379	}
	380	else if (sv == &PL_sv_no) {
	381	sv_catpv(t, "SV_NO");
	382	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	383	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	384	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	385	SVp_POK\|SVp_NOK)) &&
	386	SvCUR(sv) == 0 &&
	387	SvNVX(sv) == 0.0)
	388	goto finish;
	389	}
	390	else if (sv == &PL_sv_yes) {
	391	sv_catpv(t, "SV_YES");
	392	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	393	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	394	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	395	SVp_POK\|SVp_NOK)) &&
	396	SvCUR(sv) == 1 &&
	397	SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
	398	SvNVX(sv) == 1.0)
	399	goto finish;
	400	}
	401	else {
	402	sv_catpv(t, "SV_PLACEHOLDER");
	403	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	404	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	405	SvREADONLY(sv))
	406	goto finish;
	407	}
	408	sv_catpv(t, ":");
	409	}
	410	else if (SvREFCNT(sv) == 0) {
	411	sv_catpv(t, "(");
	412	unref++;
	413	}
	414	else if (DEBUG_R_TEST_) {
	415	int is_tmp = 0;
	416	SSize_t ix;
	417	/* is this SV on the tmps stack? */
	418	for (ix=PL_tmps_ix; ix>=0; ix--) {
	419	if (PL_tmps_stack[ix] == sv) {
	420	is_tmp = 1;
	421	break;
	422	}
	423	}
	424	if (SvREFCNT(sv) > 1)
	425	Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
	426	is_tmp ? "T" : "");
	427	else if (is_tmp)
	428	sv_catpv(t, "<T>");
	429	}
	430
	431	if (SvROK(sv)) {
	432	sv_catpv(t, "\\");
	433	if (SvCUR(t) + unref > 10) {
	434	SvCUR_set(t, unref + 3);
	435	*SvEND(t) = '\0';
	436	sv_catpv(t, "...");
	437	goto finish;
	438	}
	439	sv = SvRV(sv);
	440	goto retry;
	441	}
	442	type = SvTYPE(sv);
	443	if (type == SVt_PVCV) {
	444	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	445	GV* gvcv = CvGV(sv);
	446	Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
	447	? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
	448	: "");
	449	goto finish;
	450	} else if (type < SVt_LAST) {
	451	sv_catpv(t, svshorttypenames[type]);
	452
	453	if (type == SVt_NULL)
	454	goto finish;
	455	} else {
	456	sv_catpv(t, "FREED");
	457	goto finish;
	458	}
	459
	460	if (SvPOKp(sv)) {
	461	if (!SvPVX_const(sv))
	462	sv_catpv(t, "(null)");
	463	else {
	464	SV * const tmp = newSVpvs("");
	465	sv_catpv(t, "(");
	466	if (SvOOK(sv)) {
	467	STRLEN delta;
	468	SvOOK_offset(sv, delta);
	469	Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
	470	}
	471	Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
	472	if (SvUTF8(sv))
	473	Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
	474	sv_uni_display(tmp, sv, 6 * SvCUR(sv),
	475	UNI_DISPLAY_QQ));
	476	SvREFCNT_dec_NN(tmp);
	477	}
	478	}
	479	else if (SvNOKp(sv)) {
	480	STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
	481	Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
	482	RESTORE_LC_NUMERIC_UNDERLYING();
	483	}
	484	else if (SvIOKp(sv)) {
	485	if (SvIsUV(sv))
	486	Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
	487	else
	488	Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
	489	}
	490	else
	491	sv_catpv(t, "()");
	492
	493	finish:
	494	while (unref--)
	495	sv_catpv(t, ")");
	496	if (TAINTING_get && sv && SvTAINTED(sv))
	497	sv_catpv(t, " [tainted]");
	498	return SvPV_nolen(t);
	499	}
	500
	501	/*
	502	=head1 Debugging Utilities
	503	*/
	504
	505	void
	506	Perl_dump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	507	{
	508	va_list args;
	509	PERL_ARGS_ASSERT_DUMP_INDENT;
	510	va_start(args, pat);
	511	dump_vindent(level, file, pat, &args);
	512	va_end(args);
	513	}
	514
	515	void
	516	Perl_dump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	517	{
	518	PERL_ARGS_ASSERT_DUMP_VINDENT;
	519	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	520	PerlIO_vprintf(file, pat, *args);
	521	}
	522
	523	/*
	524	=for apidoc dump_all
	525
	526	Dumps the entire optree of the current program starting at C<PL_main_root> to
	527	C<STDERR>. Also dumps the optrees for all visible subroutines in
	528	C<PL_defstash>.
	529
	530	=cut
	531	*/
	532
	533	void
	534	Perl_dump_all(pTHX)
	535	{
	536	dump_all_perl(FALSE);
	537	}
	538
	539	void
	540	Perl_dump_all_perl(pTHX_ bool justperl)
	541	{
	542	PerlIO_setlinebuf(Perl_debug_log);
	543	if (PL_main_root)
	544	op_dump(PL_main_root);
	545	dump_packsubs_perl(PL_defstash, justperl);
	546	}
	547
	548	/*
	549	=for apidoc dump_packsubs
	550
	551	Dumps the optrees for all visible subroutines in C<stash>.
	552
	553	=cut
	554	*/
	555
	556	void
	557	Perl_dump_packsubs(pTHX_ const HV *stash)
	558	{
	559	PERL_ARGS_ASSERT_DUMP_PACKSUBS;
	560	dump_packsubs_perl(stash, FALSE);
	561	}
	562
	563	void
	564	Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	565	{
	566	I32 i;
	567
	568	PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
	569
	570	if (!HvARRAY(stash))
	571	return;
	572	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	573	const HE *entry;
	574	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	575	GV * gv = (GV *)HeVAL(entry);
	576	if (SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV)
	577	/* unfake a fake GV */
	578	(void)CvGV(SvRV(gv));
	579	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	580	continue;
	581	if (GvCVu(gv))
	582	dump_sub_perl(gv, justperl);
	583	if (GvFORM(gv))
	584	dump_form(gv);
	585	if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
	586	const HV * const hv = GvHV(gv);
	587	if (hv && (hv != PL_defstash))
	588	dump_packsubs_perl(hv, justperl); /* nested package */
	589	}
	590	}
	591	}
	592	}
	593
	594	void
	595	Perl_dump_sub(pTHX_ const GV *gv)
	596	{
	597	PERL_ARGS_ASSERT_DUMP_SUB;
	598	dump_sub_perl(gv, FALSE);
	599	}
	600
	601	void
	602	Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
	603	{
	604	STRLEN len;
	605	SV * const sv = newSVpvs_flags("", SVs_TEMP);
	606	SV *tmpsv;
	607	const char * name;
	608
	609	PERL_ARGS_ASSERT_DUMP_SUB_PERL;
	610
	611	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	612	return;
	613
	614	tmpsv = newSVpvs_flags("", SVs_TEMP);
	615	gv_fullname3(sv, gv, NULL);
	616	name = SvPV_const(sv, len);
	617	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
	618	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	619	if (CvISXSUB(GvCV(gv)))
	620	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
	621	PTR2UV(CvXSUB(GvCV(gv))),
	622	(int)CvXSUBANY(GvCV(gv)).any_i32);
	623	else if (CvROOT(GvCV(gv)))
	624	op_dump(CvROOT(GvCV(gv)));
	625	else
	626	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	627	}
	628
	629	void
	630	Perl_dump_form(pTHX_ const GV *gv)
	631	{
	632	SV * const sv = sv_newmortal();
	633
	634	PERL_ARGS_ASSERT_DUMP_FORM;
	635
	636	gv_fullname3(sv, gv, NULL);
	637	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
	638	if (CvROOT(GvFORM(gv)))
	639	op_dump(CvROOT(GvFORM(gv)));
	640	else
	641	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	642	}
	643
	644	void
	645	Perl_dump_eval(pTHX)
	646	{
	647	op_dump(PL_eval_root);
	648	}
	649
	650	void
	651	Perl_do_pmop_dump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	652	{
	653	char ch;
	654
	655	PERL_ARGS_ASSERT_DO_PMOP_DUMP;
	656
	657	if (!pm) {
	658	Perl_dump_indent(aTHX_ level, file, "{}\n");
	659	return;
	660	}
	661	Perl_dump_indent(aTHX_ level, file, "{\n");
	662	level++;
	663	if (pm->op_pmflags & PMf_ONCE)
	664	ch = '?';
	665	else
	666	ch = '/';
	667	if (PM_GETRE(pm))
	668	Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c%s\n",
	669	ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch,
	670	(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
	671	else
	672	Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
	673	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	674	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
	675	op_dump(pm->op_pmreplrootu.op_pmreplroot);
	676	}
	677	if (pm->op_code_list) {
	678	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
	679	Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
	680	do_op_dump(level, file, pm->op_code_list);
	681	}
	682	else
	683	Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
	684	PTR2UV(pm->op_code_list));
	685	}
	686	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	687	SV * const tmpsv = pm_description(pm);
	688	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	689	SvREFCNT_dec_NN(tmpsv);
	690	}
	691
	692	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	693	}
	694
	695	const struct flag_to_name pmflags_flags_names[] = {
	696	{PMf_CONST, ",CONST"},
	697	{PMf_KEEP, ",KEEP"},
	698	{PMf_GLOBAL, ",GLOBAL"},
	699	{PMf_CONTINUE, ",CONTINUE"},
	700	{PMf_RETAINT, ",RETAINT"},
	701	{PMf_EVAL, ",EVAL"},
	702	{PMf_NONDESTRUCT, ",NONDESTRUCT"},
	703	{PMf_HAS_CV, ",HAS_CV"},
	704	{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
	705	{PMf_IS_QR, ",IS_QR"}
	706	};
	707
	708	static SV *
	709	S_pm_description(pTHX_ const PMOP *pm)
	710	{
	711	SV * const desc = newSVpvs("");
	712	const REGEXP * const regex = PM_GETRE(pm);
	713	const U32 pmflags = pm->op_pmflags;
	714
	715	PERL_ARGS_ASSERT_PM_DESCRIPTION;
	716
	717	if (pmflags & PMf_ONCE)
	718	sv_catpv(desc, ",ONCE");
	719	#ifdef USE_ITHREADS
	720	if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
	721	sv_catpv(desc, ":USED");
	722	#else
	723	if (pmflags & PMf_USED)
	724	sv_catpv(desc, ":USED");
	725	#endif
	726
	727	if (regex) {
	728	if (RX_ISTAINTED(regex))
	729	sv_catpv(desc, ",TAINTED");
	730	if (RX_CHECK_SUBSTR(regex)) {
	731	if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
	732	sv_catpv(desc, ",SCANFIRST");
	733	if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
	734	sv_catpv(desc, ",ALL");
	735	}
	736	if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
	737	sv_catpv(desc, ",SKIPWHITE");
	738	}
	739
	740	append_flags(desc, pmflags, pmflags_flags_names);
	741	return desc;
	742	}
	743
	744	void
	745	Perl_pmop_dump(pTHX_ PMOP *pm)
	746	{
	747	do_pmop_dump(0, Perl_debug_log, pm);
	748	}
	749
	750	/* Return a unique integer to represent the address of op o.
	751	* If it already exists in PL_op_sequence, just return it;
	752	* otherwise add it.
	753	* *** Note that this isn't thread-safe */
	754
	755	STATIC UV
	756	S_sequence_num(pTHX_ const OP *o)
	757	{
	758	dVAR;
	759	SV *op,
	760	**seq;
	761	const char *key;
	762	STRLEN len;
	763	if (!o)
	764	return 0;
	765	op = newSVuv(PTR2UV(o));
	766	sv_2mortal(op);
	767	key = SvPV_const(op, len);
	768	if (!PL_op_sequence)
	769	PL_op_sequence = newHV();
	770	seq = hv_fetch(PL_op_sequence, key, len, 0);
	771	if (seq)
	772	return SvUV(*seq);
	773	(void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
	774	return PL_op_seq;
	775	}
	776
	777
	778
	779
	780
	781	const struct flag_to_name op_flags_names[] = {
	782	{OPf_KIDS, ",KIDS"},
	783	{OPf_PARENS, ",PARENS"},
	784	{OPf_REF, ",REF"},
	785	{OPf_MOD, ",MOD"},
	786	{OPf_STACKED, ",STACKED"},
	787	{OPf_SPECIAL, ",SPECIAL"}
	788	};
	789
	790
	791	void
	792	Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
	793	{
	794	UV seq;
	795	const OPCODE optype = o->op_type;
	796
	797	PERL_ARGS_ASSERT_DO_OP_DUMP;
	798
	799	Perl_dump_indent(aTHX_ level, file, "{\n");
	800	level++;
	801	seq = sequence_num(o);
	802	if (seq)
	803	PerlIO_printf(file, "%-4"UVuf, seq);
	804	else
	805	PerlIO_printf(file, "????");
	806	PerlIO_printf(file,
	807	"%*sTYPE = %s ===> ",
	808	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
	809	if (o->op_next)
	810	PerlIO_printf(file,
	811	o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
	812	sequence_num(o->op_next));
	813	else
	814	PerlIO_printf(file, "NULL\n");
	815	if (o->op_targ) {
	816	if (optype == OP_NULL) {
	817	Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
	818	}
	819	else
	820	Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
	821	}
	822	#ifdef DUMPADDR
	823	Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
	824	#endif
	825
	826	if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) {
	827	SV * const tmpsv = newSVpvs("");
	828	switch (o->op_flags & OPf_WANT) {
	829	case OPf_WANT_VOID:
	830	sv_catpv(tmpsv, ",VOID");
	831	break;
	832	case OPf_WANT_SCALAR:
	833	sv_catpv(tmpsv, ",SCALAR");
	834	break;
	835	case OPf_WANT_LIST:
	836	sv_catpv(tmpsv, ",LIST");
	837	break;
	838	default:
	839	sv_catpv(tmpsv, ",UNKNOWN");
	840	break;
	841	}
	842	append_flags(tmpsv, o->op_flags, op_flags_names);
	843	if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED");
	844	if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
	845	if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
	846	if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
	847	if (o->op_moresib) sv_catpvs(tmpsv, ",MORESIB");
	848	Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
	849	SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	850	}
	851
	852	if (o->op_private) {
	853	U16 oppriv = o->op_private;
	854	I16 op_ix = PL_op_private_bitdef_ix[o->op_type];
	855	SV * tmpsv = NULL;
	856
	857	if (op_ix != -1) {
	858	U16 stop = 0;
	859	tmpsv = newSVpvs("");
	860	for (; !stop; op_ix++) {
	861	U16 entry = PL_op_private_bitdefs[op_ix];
	862	U16 bit = (entry >> 2) & 7;
	863	U16 ix = entry >> 5;
	864
	865	stop = (entry & 1);
	866
	867	if (entry & 2) {
	868	/* bitfield */
	869	I16 const *p = &PL_op_private_bitfields[ix];
	870	U16 bitmin = (U16) *p++;
	871	I16 label = *p++;
	872	I16 enum_label;
	873	U16 mask = 0;
	874	U16 i;
	875	U16 val;
	876
	877	for (i = bitmin; i<= bit; i++)
	878	mask \|= (1<<i);
	879	bit = bitmin;
	880	val = (oppriv & mask);
	881
	882	if ( label != -1
	883	&& PL_op_private_labels[label] == '-'
	884	&& PL_op_private_labels[label+1] == '\0'
	885	)
	886	/* display as raw number */
	887	continue;
	888
	889	oppriv -= val;
	890	val >>= bit;
	891	enum_label = -1;
	892	while (*p != -1) {
	893	if (val == *p++) {
	894	enum_label = *p;
	895	break;
	896	}
	897	p++;
	898	}
	899	if (val == 0 && enum_label == -1)
	900	/* don't display anonymous zero values */
	901	continue;
	902
	903	sv_catpv(tmpsv, ",");
	904	if (label != -1) {
	905	sv_catpv(tmpsv, &PL_op_private_labels[label]);
	906	sv_catpv(tmpsv, "=");
	907	}
	908	if (enum_label == -1)
	909	Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)val);
	910	else
	911	sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
	912
	913	}
	914	else {
	915	/* bit flag */
	916	if ( oppriv & (1<<bit)
	917	&& !(PL_op_private_labels[ix] == '-'
	918	&& PL_op_private_labels[ix+1] == '\0'))
	919	{
	920	oppriv -= (1<<bit);
	921	sv_catpv(tmpsv, ",");
	922	sv_catpv(tmpsv, &PL_op_private_labels[ix]);
	923	}
	924	}
	925	}
	926	if (oppriv) {
	927	sv_catpv(tmpsv, ",");
	928	Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)oppriv);
	929	}
	930	}
	931	if (tmpsv && SvCUR(tmpsv)) {
	932	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
	933	} else
	934	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
	935	(UV)oppriv);
	936	}
	937
	938	switch (optype) {
	939	case OP_AELEMFAST:
	940	case OP_GVSV:
	941	case OP_GV:
	942	#ifdef USE_ITHREADS
	943	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
	944	#else
	945	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
	946	if (cSVOPo->op_sv) {
	947	STRLEN len;
	948	const char * name;
	949	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	950	SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
	951	gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
	952	name = SvPV_const(tmpsv, len);
	953	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
	954	generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
	955	}
	956	else
	957	Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
	958	}
	959	#endif
	960	break;
	961
	962	case OP_MULTIDEREF:
	963	{
	964	UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
	965	UV i, count = items[-1].uv;
	966
	967	Perl_dump_indent(aTHX_ level, file, "ARGS = \n");
	968	for (i=0; i < count; i++)
	969	Perl_dump_indent(aTHX_ level+1, file, "%"UVuf" => 0x%"UVxf"\n",
	970	i, items[i].uv);
	971	break;
	972	}
	973
	974	case OP_CONST:
	975	case OP_HINTSEVAL:
	976	case OP_METHOD_NAMED:
	977	case OP_METHOD_SUPER:
	978	case OP_METHOD_REDIR:
	979	case OP_METHOD_REDIR_SUPER:
	980	#ifndef USE_ITHREADS
	981	/* with ITHREADS, consts are stored in the pad, and the right pad
	982	* may not be active here, so skip */
	983	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));
	984	#endif
	985	break;
	986	case OP_NULL:
	987	if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
	988	break;
	989	/* FALLTHROUGH */
	990	case OP_NEXTSTATE:
	991	case OP_DBSTATE:
	992	if (CopLINE(cCOPo))
	993	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	994	(UV)CopLINE(cCOPo));
	995	if (CopSTASHPV(cCOPo)) {
	996	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	997	HV *stash = CopSTASH(cCOPo);
	998	const char * const hvname = HvNAME_get(stash);
	999
	1000	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	1001	generic_pv_escape(tmpsv, hvname,
	1002	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1003	}
	1004	if (CopLABEL(cCOPo)) {
	1005	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1006	STRLEN label_len;
	1007	U32 label_flags;
	1008	const char *label = CopLABEL_len_flags(cCOPo,
	1009	&label_len, &label_flags);
	1010	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	1011	generic_pv_escape( tmpsv, label, label_len,
	1012	(label_flags & SVf_UTF8)));
	1013	}
	1014	Perl_dump_indent(aTHX_ level, file, "SEQ = %u\n",
	1015	(unsigned int)cCOPo->cop_seq);
	1016	break;
	1017	case OP_ENTERLOOP:
	1018	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
	1019	if (cLOOPo->op_redoop)
	1020	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
	1021	else
	1022	PerlIO_printf(file, "DONE\n");
	1023	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
	1024	if (cLOOPo->op_nextop)
	1025	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
	1026	else
	1027	PerlIO_printf(file, "DONE\n");
	1028	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
	1029	if (cLOOPo->op_lastop)
	1030	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
	1031	else
	1032	PerlIO_printf(file, "DONE\n");
	1033	break;
	1034	case OP_COND_EXPR:
	1035	case OP_RANGE:
	1036	case OP_MAPWHILE:
	1037	case OP_GREPWHILE:
	1038	case OP_OR:
	1039	case OP_AND:
	1040	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
	1041	if (cLOGOPo->op_other)
	1042	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
	1043	else
	1044	PerlIO_printf(file, "DONE\n");
	1045	break;
	1046	case OP_PUSHRE:
	1047	case OP_MATCH:
	1048	case OP_QR:
	1049	case OP_SUBST:
	1050	do_pmop_dump(level, file, cPMOPo);
	1051	break;
	1052	case OP_LEAVE:
	1053	case OP_LEAVEEVAL:
	1054	case OP_LEAVESUB:
	1055	case OP_LEAVESUBLV:
	1056	case OP_LEAVEWRITE:
	1057	case OP_SCOPE:
	1058	if (o->op_private & OPpREFCOUNTED)
	1059	Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
	1060	break;
	1061	default:
	1062	break;
	1063	}
	1064	if (o->op_flags & OPf_KIDS) {
	1065	OP *kid;
	1066	for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
	1067	do_op_dump(level, file, kid);
	1068	}
	1069	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	1070	}
	1071
	1072	/*
	1073	=for apidoc op_dump
	1074
	1075	Dumps the optree starting at OP C<o> to C<STDERR>.
	1076
	1077	=cut
	1078	*/
	1079
	1080	void
	1081	Perl_op_dump(pTHX_ const OP *o)
	1082	{
	1083	PERL_ARGS_ASSERT_OP_DUMP;
	1084	do_op_dump(0, Perl_debug_log, o);
	1085	}
	1086
	1087	void
	1088	Perl_gv_dump(pTHX_ GV *gv)
	1089	{
	1090	STRLEN len;
	1091	const char* name;
	1092	SV sv, tmp = newSVpvs_flags("", SVs_TEMP);
	1093
	1094	if (!gv) {
	1095	PerlIO_printf(Perl_debug_log, "{}\n");
	1096	return;
	1097	}
	1098	sv = sv_newmortal();
	1099	PerlIO_printf(Perl_debug_log, "{\n");
	1100	gv_fullname3(sv, gv, NULL);
	1101	name = SvPV_const(sv, len);
	1102	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
	1103	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1104	if (gv != GvEGV(gv)) {
	1105	gv_efullname3(sv, GvEGV(gv), NULL);
	1106	name = SvPV_const(sv, len);
	1107	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
	1108	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1109	}
	1110	(void)PerlIO_putc(Perl_debug_log, '\n');
	1111	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
	1112	}
	1113
	1114
	1115	/* map magic types to the symbolic names
	1116	* (with the PERL_MAGIC_ prefixed stripped)
	1117	*/
	1118
	1119	static const struct { const char type; const char *name; } magic_names[] = {
	1120	#include "mg_names.inc"
	1121	/* this null string terminates the list */
	1122	{ 0, NULL },
	1123	};
	1124
	1125	void
	1126	Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1127	{
	1128	PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
	1129
	1130	for (; mg; mg = mg->mg_moremagic) {
	1131	Perl_dump_indent(aTHX_ level, file,
	1132	" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
	1133	if (mg->mg_virtual) {
	1134	const MGVTBL * const v = mg->mg_virtual;
	1135	if (v >= PL_magic_vtables
	1136	&& v < PL_magic_vtables + magic_vtable_max) {
	1137	const U32 i = v - PL_magic_vtables;
	1138	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
	1139	}
	1140	else
	1141	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
	1142	}
	1143	else
	1144	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
	1145
	1146	if (mg->mg_private)
	1147	Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
	1148
	1149	{
	1150	int n;
	1151	const char *name = NULL;
	1152	for (n = 0; magic_names[n].name; n++) {
	1153	if (mg->mg_type == magic_names[n].type) {
	1154	name = magic_names[n].name;
	1155	break;
	1156	}
	1157	}
	1158	if (name)
	1159	Perl_dump_indent(aTHX_ level, file,
	1160	" MG_TYPE = PERL_MAGIC_%s\n", name);
	1161	else
	1162	Perl_dump_indent(aTHX_ level, file,
	1163	" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
	1164	}
	1165
	1166	if (mg->mg_flags) {
	1167	Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
	1168	if (mg->mg_type == PERL_MAGIC_envelem &&
	1169	mg->mg_flags & MGf_TAINTEDDIR)
	1170	Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
	1171	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1172	mg->mg_flags & MGf_MINMATCH)
	1173	Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
	1174	if (mg->mg_flags & MGf_REFCOUNTED)
	1175	Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
	1176	if (mg->mg_flags & MGf_GSKIP)
	1177	Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
	1178	if (mg->mg_flags & MGf_COPY)
	1179	Perl_dump_indent(aTHX_ level, file, " COPY\n");
	1180	if (mg->mg_flags & MGf_DUP)
	1181	Perl_dump_indent(aTHX_ level, file, " DUP\n");
	1182	if (mg->mg_flags & MGf_LOCAL)
	1183	Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
	1184	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1185	mg->mg_flags & MGf_BYTES)
	1186	Perl_dump_indent(aTHX_ level, file, " BYTES\n");
	1187	}
	1188	if (mg->mg_obj) {
	1189	Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
	1190	PTR2UV(mg->mg_obj));
	1191	if (mg->mg_type == PERL_MAGIC_qr) {
	1192	REGEXP* const re = (REGEXP *)mg->mg_obj;
	1193	SV * const dsv = sv_newmortal();
	1194	const char * const s
	1195	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
	1196	60, NULL, NULL,
	1197	( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
	1198	(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
	1199	);
	1200	Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
	1201	Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
	1202	(IV)RX_REFCNT(re));
	1203	}
	1204	if (mg->mg_flags & MGf_REFCOUNTED)
	1205	do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
	1206	}
	1207	if (mg->mg_len)
	1208	Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
	1209	if (mg->mg_ptr) {
	1210	Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
	1211	if (mg->mg_len >= 0) {
	1212	if (mg->mg_type != PERL_MAGIC_utf8) {
	1213	SV * const sv = newSVpvs("");
	1214	PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
	1215	SvREFCNT_dec_NN(sv);
	1216	}
	1217	}
	1218	else if (mg->mg_len == HEf_SVKEY) {
	1219	PerlIO_puts(file, " => HEf_SVKEY\n");
	1220	do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
	1221	maxnest, dumpops, pvlim); /* MG is already +1 */
	1222	continue;
	1223	}
	1224	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1225	else
	1226	PerlIO_puts(
	1227	file,
	1228	" ???? - " __FILE__
	1229	" does not know how to handle this MG_LEN"
	1230	);
	1231	(void)PerlIO_putc(file, '\n');
	1232	}
	1233	if (mg->mg_type == PERL_MAGIC_utf8) {
	1234	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1235	if (cache) {
	1236	IV i;
	1237	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1238	Perl_dump_indent(aTHX_ level, file,
	1239	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1240	i,
	1241	(UV)cache[i * 2],
	1242	(UV)cache[i * 2 + 1]);
	1243	}
	1244	}
	1245	}
	1246	}
	1247
	1248	void
	1249	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1250	{
	1251	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1252	}
	1253
	1254	void
	1255	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1256	{
	1257	const char *hvname;
	1258
	1259	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1260
	1261	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1262	if (sv && (hvname = HvNAME_get(sv)))
	1263	{
	1264	/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
	1265	name which quite legally could contain insane things like tabs, newlines, nulls or
	1266	other scary crap - this should produce sane results - except maybe for unicode package
	1267	names - but we will wait for someone to file a bug on that - demerphq */
	1268	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	1269	PerlIO_printf(file, "\t\"%s\"\n",
	1270	generic_pv_escape( tmpsv, hvname,
	1271	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1272	}
	1273	else
	1274	(void)PerlIO_putc(file, '\n');
	1275	}
	1276
	1277	void
	1278	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1279	{
	1280	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1281
	1282	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1283	if (sv && GvNAME(sv)) {
	1284	SV * const tmpsv = newSVpvs("");
	1285	PerlIO_printf(file, "\t\"%s\"\n",
	1286	generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
	1287	}
	1288	else
	1289	(void)PerlIO_putc(file, '\n');
	1290	}
	1291
	1292	void
	1293	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1294	{
	1295	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1296
	1297	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1298	if (sv && GvNAME(sv)) {
	1299	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1300	const char *hvname;
	1301	HV * const stash = GvSTASH(sv);
	1302	PerlIO_printf(file, "\t");
	1303	/* TODO might have an extra \" here */
	1304	if (stash && (hvname = HvNAME_get(stash))) {
	1305	PerlIO_printf(file, "\"%s\" :: \"",
	1306	generic_pv_escape(tmp, hvname,
	1307	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1308	}
	1309	PerlIO_printf(file, "%s\"\n",
	1310	generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
	1311	}
	1312	else
	1313	(void)PerlIO_putc(file, '\n');
	1314	}
	1315
	1316	const struct flag_to_name first_sv_flags_names[] = {
	1317	{SVs_TEMP, "TEMP,"},
	1318	{SVs_OBJECT, "OBJECT,"},
	1319	{SVs_GMG, "GMG,"},
	1320	{SVs_SMG, "SMG,"},
	1321	{SVs_RMG, "RMG,"},
	1322	{SVf_IOK, "IOK,"},
	1323	{SVf_NOK, "NOK,"},
	1324	{SVf_POK, "POK,"}
	1325	};
	1326
	1327	const struct flag_to_name second_sv_flags_names[] = {
	1328	{SVf_OOK, "OOK,"},
	1329	{SVf_FAKE, "FAKE,"},
	1330	{SVf_READONLY, "READONLY,"},
	1331	{SVf_PROTECT, "PROTECT,"},
	1332	{SVf_BREAK, "BREAK,"},
	1333	{SVp_IOK, "pIOK,"},
	1334	{SVp_NOK, "pNOK,"},
	1335	{SVp_POK, "pPOK,"}
	1336	};
	1337
	1338	const struct flag_to_name cv_flags_names[] = {
	1339	{CVf_ANON, "ANON,"},
	1340	{CVf_UNIQUE, "UNIQUE,"},
	1341	{CVf_CLONE, "CLONE,"},
	1342	{CVf_CLONED, "CLONED,"},
	1343	{CVf_CONST, "CONST,"},
	1344	{CVf_NODEBUG, "NODEBUG,"},
	1345	{CVf_LVALUE, "LVALUE,"},
	1346	{CVf_METHOD, "METHOD,"},
	1347	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1348	{CVf_CVGV_RC, "CVGV_RC,"},
	1349	{CVf_DYNFILE, "DYNFILE,"},
	1350	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1351	{CVf_HASEVAL, "HASEVAL,"},
	1352	{CVf_SLABBED, "SLABBED,"},
	1353	{CVf_NAMED, "NAMED,"},
	1354	{CVf_LEXICAL, "LEXICAL,"},
	1355	{CVf_ISXSUB, "ISXSUB,"}
	1356	};
	1357
	1358	const struct flag_to_name hv_flags_names[] = {
	1359	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1360	{SVphv_LAZYDEL, "LAZYDEL,"},
	1361	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	1362	{SVf_AMAGIC, "OVERLOAD,"},
	1363	{SVphv_CLONEABLE, "CLONEABLE,"}
	1364	};
	1365
	1366	const struct flag_to_name gp_flags_names[] = {
	1367	{GVf_INTRO, "INTRO,"},
	1368	{GVf_MULTI, "MULTI,"},
	1369	{GVf_ASSUMECV, "ASSUMECV,"},
	1370	};
	1371
	1372	const struct flag_to_name gp_flags_imported_names[] = {
	1373	{GVf_IMPORTED_SV, " SV"},
	1374	{GVf_IMPORTED_AV, " AV"},
	1375	{GVf_IMPORTED_HV, " HV"},
	1376	{GVf_IMPORTED_CV, " CV"},
	1377	};
	1378
	1379	/* NOTE: this structure is mostly duplicative of one generated by
	1380	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1381	* the two. - Yves */
	1382	const struct flag_to_name regexp_extflags_names[] = {
	1383	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1384	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1385	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1386	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1387	{RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
	1388	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1389	{RXf_PMf_NOCAPTURE, "PMf_NOCAPURE,"},
	1390	{RXf_IS_ANCHORED, "IS_ANCHORED,"},
	1391	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1392	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1393	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1394	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1395	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1396	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1397	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1398	{RXf_SPLIT, "SPLIT,"},
	1399	{RXf_COPY_DONE, "COPY_DONE,"},
	1400	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1401	{RXf_TAINTED, "TAINTED,"},
	1402	{RXf_START_ONLY, "START_ONLY,"},
	1403	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1404	{RXf_WHITE, "WHITE,"},
	1405	{RXf_NULL, "NULL,"},
	1406	};
	1407
	1408	/* NOTE: this structure is mostly duplicative of one generated by
	1409	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1410	* the two. - Yves */
	1411	const struct flag_to_name regexp_core_intflags_names[] = {
	1412	{PREGf_SKIP, "SKIP,"},
	1413	{PREGf_IMPLICIT, "IMPLICIT,"},
	1414	{PREGf_NAUGHTY, "NAUGHTY,"},
	1415	{PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
	1416	{PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
	1417	{PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
	1418	{PREGf_NOSCAN, "NOSCAN,"},
	1419	{PREGf_GPOS_SEEN, "GPOS_SEEN,"},
	1420	{PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1421	{PREGf_ANCH_MBOL, "ANCH_MBOL,"},
	1422	{PREGf_ANCH_SBOL, "ANCH_SBOL,"},
	1423	{PREGf_ANCH_GPOS, "ANCH_GPOS,"},
	1424	};
	1425
	1426	/* Perl_do_sv_dump():
	1427	*
	1428	* level: amount to indent the output
	1429	* sv: the object to dump
	1430	* nest: the current level of recursion
	1431	* maxnest: the maximum allowed level of recursion
	1432	* dumpops: if true, also dump the ops associated with a CV
	1433	* pvlim: limit on the length of any strings that are output
	1434	* */
	1435
	1436	void
	1437	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1438	{
	1439	SV *d;
	1440	const char *s;
	1441	U32 flags;
	1442	U32 type;
	1443
	1444	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1445
	1446	if (!sv) {
	1447	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1448	return;
	1449	}
	1450
	1451	flags = SvFLAGS(sv);
	1452	type = SvTYPE(sv);
	1453
	1454	/* process general SV flags */
	1455
	1456	d = Perl_newSVpvf(aTHX_
	1457	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1458	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1459	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1460	(int)(PL_dumpindent*level), "");
	1461
	1462	if ((flags & SVs_PADSTALE))
	1463	sv_catpv(d, "PADSTALE,");
	1464	if ((flags & SVs_PADTMP))
	1465	sv_catpv(d, "PADTMP,");
	1466	append_flags(d, flags, first_sv_flags_names);
	1467	if (flags & SVf_ROK) {
	1468	sv_catpv(d, "ROK,");
	1469	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1470	}
	1471	if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
	1472	append_flags(d, flags, second_sv_flags_names);
	1473	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1474	&& type != SVt_PVAV) {
	1475	if (SvPCS_IMPORTED(sv))
	1476	sv_catpv(d, "PCS_IMPORTED,");
	1477	else
	1478	sv_catpv(d, "SCREAM,");
	1479	}
	1480
	1481	/* process type-specific SV flags */
	1482
	1483	switch (type) {
	1484	case SVt_PVCV:
	1485	case SVt_PVFM:
	1486	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1487	break;
	1488	case SVt_PVHV:
	1489	append_flags(d, flags, hv_flags_names);
	1490	break;
	1491	case SVt_PVGV:
	1492	case SVt_PVLV:
	1493	if (isGV_with_GP(sv)) {
	1494	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1495	}
	1496	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1497	sv_catpv(d, "IMPORT");
	1498	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1499	sv_catpv(d, "ALL,");
	1500	else {
	1501	sv_catpv(d, "(");
	1502	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1503	sv_catpv(d, " ),");
	1504	}
	1505	}
	1506	/* FALLTHROUGH */
	1507	default:
	1508	evaled_or_uv:
	1509	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1510	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1511	break;
	1512	case SVt_PVMG:
	1513	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1514	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1515	/* FALLTHROUGH */
	1516	goto evaled_or_uv;
	1517	case SVt_PVAV:
	1518	break;
	1519	}
	1520	/* SVphv_SHAREKEYS is also 0x20000000 */
	1521	if ((type != SVt_PVHV) && SvUTF8(sv))
	1522	sv_catpv(d, "UTF8");
	1523
	1524	if (*(SvEND(d) - 1) == ',') {
	1525	SvCUR_set(d, SvCUR(d) - 1);
	1526	SvPVX(d)[SvCUR(d)] = '\0';
	1527	}
	1528	sv_catpv(d, ")");
	1529	s = SvPVX_const(d);
	1530
	1531	/* dump initial SV details */
	1532
	1533	#ifdef DEBUG_LEAKING_SCALARS
	1534	Perl_dump_indent(aTHX_ level, file,
	1535	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1536	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1537	sv->sv_debug_line,
	1538	sv->sv_debug_inpad ? "for" : "by",
	1539	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1540	PTR2UV(sv->sv_debug_parent),
	1541	sv->sv_debug_serial
	1542	);
	1543	#endif
	1544	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1545
	1546	/* Dump SV type */
	1547
	1548	if (type < SVt_LAST) {
	1549	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1550
	1551	if (type == SVt_NULL) {
	1552	SvREFCNT_dec_NN(d);
	1553	return;
	1554	}
	1555	} else {
	1556	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1557	SvREFCNT_dec_NN(d);
	1558	return;
	1559	}
	1560
	1561	/* Dump general SV fields */
	1562
	1563	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1564	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1565	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1566	\|\| (type == SVt_IV && !SvROK(sv))) {
	1567	if (SvIsUV(sv)
	1568	)
	1569	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1570	else
	1571	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1572	(void)PerlIO_putc(file, '\n');
	1573	}
	1574
	1575	if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1576	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1577	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1578	\|\| type == SVt_NV) {
	1579	STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
	1580	Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
	1581	RESTORE_LC_NUMERIC_UNDERLYING();
	1582	}
	1583
	1584	if (SvROK(sv)) {
	1585	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1586	if (nest < maxnest)
	1587	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1588	}
	1589
	1590	if (type < SVt_PV) {
	1591	SvREFCNT_dec_NN(d);
	1592	return;
	1593	}
	1594
	1595	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1596	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1597	const bool re = isREGEXP(sv);
	1598	const char * const ptr =
	1599	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1600	if (ptr) {
	1601	STRLEN delta;
	1602	if (SvOOK(sv)) {
	1603	SvOOK_offset(sv, delta);
	1604	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1605	(UV) delta);
	1606	} else {
	1607	delta = 0;
	1608	}
	1609	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1610	if (SvOOK(sv)) {
	1611	PerlIO_printf(file, "( %s . ) ",
	1612	pv_display(d, ptr - delta, delta, 0,
	1613	pvlim));
	1614	}
	1615	if (type == SVt_INVLIST) {
	1616	PerlIO_printf(file, "\n");
	1617	/* 4 blanks indents 2 beyond the PV, etc */
	1618	_invlist_dump(file, level, " ", sv);
	1619	}
	1620	else {
	1621	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1622	re ? 0 : SvLEN(sv),
	1623	pvlim));
	1624	if (SvUTF8(sv)) /* the 6? \x{....} */
	1625	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1626	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1627	UNI_DISPLAY_QQ));
	1628	PerlIO_printf(file, "\n");
	1629	}
	1630	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1631	if (!re)
	1632	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1633	(IV)SvLEN(sv));
	1634	#ifdef PERL_COPY_ON_WRITE
	1635	if (SvIsCOW(sv) && SvLEN(sv))
	1636	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1637	CowREFCNT(sv));
	1638	#endif
	1639	}
	1640	else
	1641	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1642	}
	1643
	1644	if (type >= SVt_PVMG) {
	1645	if (SvMAGIC(sv))
	1646	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1647	if (SvSTASH(sv))
	1648	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1649
	1650	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1651	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1652	}
	1653	}
	1654
	1655	/* Dump type-specific SV fields */
	1656
	1657	switch (type) {
	1658	case SVt_PVAV:
	1659	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1660	if (AvARRAY(sv) != AvALLOC(sv)) {
	1661	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1662	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1663	}
	1664	else
	1665	(void)PerlIO_putc(file, '\n');
	1666	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1667	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1668	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1669	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1670	sv_setpvs(d, "");
	1671	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1672	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1673	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1674	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1675	if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
	1676	SSize_t count;
	1677	for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1678	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1679
	1680	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1681	if (elt)
	1682	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1683	}
	1684	}
	1685	break;
	1686	case SVt_PVHV: {
	1687	U32 usedkeys;
	1688	if (SvOOK(sv)) {
	1689	struct xpvhv_aux *const aux = HvAUX(sv);
	1690	Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
	1691	(UV)aux->xhv_aux_flags);
	1692	}
	1693	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1694	usedkeys = HvUSEDKEYS(sv);
	1695	if (HvARRAY(sv) && usedkeys) {
	1696	/* Show distribution of HEs in the ARRAY */
	1697	int freq[200];
	1698	#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
	1699	int i;
	1700	int max = 0;
	1701	U32 pow2 = 2, keys = usedkeys;
	1702	NV theoret, sum = 0;
	1703
	1704	PerlIO_printf(file, " (");
	1705	Zero(freq, FREQ_MAX + 1, int);
	1706	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1707	HE* h;
	1708	int count = 0;
	1709	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1710	count++;
	1711	if (count > FREQ_MAX)
	1712	count = FREQ_MAX;
	1713	freq[count]++;
	1714	if (max < count)
	1715	max = count;
	1716	}
	1717	for (i = 0; i <= max; i++) {
	1718	if (freq[i]) {
	1719	PerlIO_printf(file, "%d%s:%d", i,
	1720	(i == FREQ_MAX) ? "+" : "",
	1721	freq[i]);
	1722	if (i != max)
	1723	PerlIO_printf(file, ", ");
	1724	}
	1725	}
	1726	(void)PerlIO_putc(file, ')');
	1727	/* The "quality" of a hash is defined as the total number of
	1728	comparisons needed to access every element once, relative
	1729	to the expected number needed for a random hash.
	1730
	1731	The total number of comparisons is equal to the sum of
	1732	the squares of the number of entries in each bucket.
	1733	For a random hash of n keys into k buckets, the expected
	1734	value is
	1735	n + n(n-1)/2k
	1736	*/
	1737
	1738	for (i = max; i > 0; i--) { /* Precision: count down. */
	1739	sum += freq[i] * i * i;
	1740	}
	1741	while ((keys = keys >> 1))
	1742	pow2 = pow2 << 1;
	1743	theoret = usedkeys;
	1744	theoret += theoret * (theoret-1)/pow2;
	1745	(void)PerlIO_putc(file, '\n');
	1746	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1747	}
	1748	(void)PerlIO_putc(file, '\n');
	1749	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
	1750	{
	1751	STRLEN count = 0;
	1752	HE **ents = HvARRAY(sv);
	1753
	1754	if (ents) {
	1755	HE const const last = ents + HvMAX(sv);
	1756	count = last + 1 - ents;
	1757
	1758	do {
	1759	if (!*ents)
	1760	--count;
	1761	} while (++ents <= last);
	1762	}
	1763
	1764	if (SvOOK(sv)) {
	1765	struct xpvhv_aux *const aux = HvAUX(sv);
	1766	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1767	" (cached = %"UVuf")\n",
	1768	(UV)count, (UV)aux->xhv_fill_lazy);
	1769	} else {
	1770	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1771	(UV)count);
	1772	}
	1773	}
	1774	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1775	if (SvOOK(sv)) {
	1776	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1777	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1778	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1779	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1780	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1781	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1782	}
	1783	#endif
	1784	(void)PerlIO_putc(file, '\n');
	1785	}
	1786	{
	1787	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1788	if (mg && mg->mg_obj) {
	1789	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1790	}
	1791	}
	1792	{
	1793	const char * const hvname = HvNAME_get(sv);
	1794	if (hvname) {
	1795	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1796	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1797	generic_pv_escape( tmpsv, hvname,
	1798	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1799	}
	1800	}
	1801	if (SvOOK(sv)) {
	1802	AV * const backrefs
	1803	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1804	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1805	if (HvAUX(sv)->xhv_name_count)
	1806	Perl_dump_indent(aTHX_
	1807	level, file, " NAMECOUNT = %"IVdf"\n",
	1808	(IV)HvAUX(sv)->xhv_name_count
	1809	);
	1810	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1811	const I32 count = HvAUX(sv)->xhv_name_count;
	1812	if (count) {
	1813	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1814	/* The starting point is the first element if count is
	1815	positive and the second element if count is negative. */
	1816	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1817	+ (count < 0 ? 1 : 0);
	1818	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1819	+ (count < 0 ? -count : count);
	1820	while (hekp < endp) {
	1821	if (HEK_LEN(*hekp)) {
	1822	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1823	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	1824	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	1825	} else {
	1826	/* This should never happen. */
	1827	sv_catpvs(names, ", (null)");
	1828	}
	1829	++hekp;
	1830	}
	1831	Perl_dump_indent(aTHX_
	1832	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	1833	);
	1834	}
	1835	else {
	1836	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	1837	const char *const hvename = HvENAME_get(sv);
	1838	Perl_dump_indent(aTHX_
	1839	level, file, " ENAME = \"%s\"\n",
	1840	generic_pv_escape(tmp, hvename,
	1841	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	1842	}
	1843	}
	1844	if (backrefs) {
	1845	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1846	PTR2UV(backrefs));
	1847	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1848	dumpops, pvlim);
	1849	}
	1850	if (meta) {
	1851	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1852	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	1853	generic_pv_escape( tmpsv, meta->mro_which->name,
	1854	meta->mro_which->length,
	1855	(meta->mro_which->kflags & HVhek_UTF8)),
	1856	PTR2UV(meta->mro_which));
	1857	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1858	(UV)meta->cache_gen);
	1859	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1860	(UV)meta->pkg_gen);
	1861	if (meta->mro_linear_all) {
	1862	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1863	PTR2UV(meta->mro_linear_all));
	1864	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1865	dumpops, pvlim);
	1866	}
	1867	if (meta->mro_linear_current) {
	1868	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1869	PTR2UV(meta->mro_linear_current));
	1870	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1871	dumpops, pvlim);
	1872	}
	1873	if (meta->mro_nextmethod) {
	1874	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1875	PTR2UV(meta->mro_nextmethod));
	1876	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1877	dumpops, pvlim);
	1878	}
	1879	if (meta->isa) {
	1880	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1881	PTR2UV(meta->isa));
	1882	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1883	dumpops, pvlim);
	1884	}
	1885	}
	1886	}
	1887	if (nest < maxnest) {
	1888	HV * const hv = MUTABLE_HV(sv);
	1889	STRLEN i;
	1890	HE *he;
	1891
	1892	if (HvARRAY(hv)) {
	1893	int count = maxnest - nest;
	1894	for (i=0; i <= HvMAX(hv); i++) {
	1895	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	1896	U32 hash;
	1897	SV * keysv;
	1898	const char * keypv;
	1899	SV * elt;
	1900	STRLEN len;
	1901
	1902	if (count-- <= 0) goto DONEHV;
	1903
	1904	hash = HeHASH(he);
	1905	keysv = hv_iterkeysv(he);
	1906	keypv = SvPV_const(keysv, len);
	1907	elt = HeVAL(he);
	1908
	1909	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1910	if (SvUTF8(keysv))
	1911	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1912	if (HvEITER_get(hv) == he)
	1913	PerlIO_printf(file, "[CURRENT] ");
	1914	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	1915	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1916	}
	1917	}
	1918	DONEHV:;
	1919	}
	1920	}
	1921	break;
	1922	} /* case SVt_PVHV */
	1923
	1924	case SVt_PVCV:
	1925	if (CvAUTOLOAD(sv)) {
	1926	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1927	STRLEN len;
	1928	const char *const name = SvPV_const(sv, len);
	1929	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	1930	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	1931	}
	1932	if (SvPOK(sv)) {
	1933	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1934	const char *const proto = CvPROTO(sv);
	1935	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	1936	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	1937	SvUTF8(sv)));
	1938	}
	1939	/* FALLTHROUGH */
	1940	case SVt_PVFM:
	1941	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1942	if (!CvISXSUB(sv)) {
	1943	if (CvSTART(sv)) {
	1944	Perl_dump_indent(aTHX_ level, file,
	1945	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1946	PTR2UV(CvSTART(sv)),
	1947	(IV)sequence_num(CvSTART(sv)));
	1948	}
	1949	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1950	PTR2UV(CvROOT(sv)));
	1951	if (CvROOT(sv) && dumpops) {
	1952	do_op_dump(level+1, file, CvROOT(sv));
	1953	}
	1954	} else {
	1955	SV * const constant = cv_const_sv((const CV *)sv);
	1956
	1957	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	1958
	1959	if (constant) {
	1960	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	1961	" (CONST SV)\n",
	1962	PTR2UV(CvXSUBANY(sv).any_ptr));
	1963	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	1964	pvlim);
	1965	} else {
	1966	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	1967	(IV)CvXSUBANY(sv).any_i32);
	1968	}
	1969	}
	1970	if (CvNAMED(sv))
	1971	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1972	HEK_KEY(CvNAME_HEK((CV *)sv)));
	1973	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	1974	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	1975	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1976	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1977	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1978	if (!CvISXSUB(sv)) {
	1979	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1980	if (nest < maxnest) {
	1981	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1982	}
	1983	}
	1984	else
	1985	Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv));
	1986	{
	1987	const CV * const outside = CvOUTSIDE(sv);
	1988	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1989	PTR2UV(outside),
	1990	(!outside ? "null"
	1991	: CvANON(outside) ? "ANON"
	1992	: (outside == PL_main_cv) ? "MAIN"
	1993	: CvUNIQUE(outside) ? "UNIQUE"
	1994	: CvGV(outside) ?
	1995	generic_pv_escape(
	1996	newSVpvs_flags("", SVs_TEMP),
	1997	GvNAME(CvGV(outside)),
	1998	GvNAMELEN(CvGV(outside)),
	1999	GvNAMEUTF8(CvGV(outside)))
	2000	: "UNDEFINED"));
	2001	}
	2002	if (CvOUTSIDE(sv)
	2003	&& (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv))))
	2004	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2005	break;
	2006
	2007	case SVt_PVGV:
	2008	case SVt_PVLV:
	2009	if (type == SVt_PVLV) {
	2010	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2011	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2012	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2013	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2014	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2015	if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
	2016	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2017	dumpops, pvlim);
	2018	}
	2019	if (isREGEXP(sv)) goto dumpregexp;
	2020	if (!isGV_with_GP(sv))
	2021	break;
	2022	{
	2023	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2024	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2025	generic_pv_escape(tmpsv, GvNAME(sv),
	2026	GvNAMELEN(sv),
	2027	GvNAMEUTF8(sv)));
	2028	}
	2029	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2030	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2031	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2032	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2033	if (!GvGP(sv))
	2034	break;
	2035	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2036	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2037	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2038	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2039	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2040	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2041	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2042	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2043	Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf
	2044	" (%s)\n",
	2045	(UV)GvGPFLAGS(sv),
	2046	"");
	2047	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2048	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2049	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2050	break;
	2051	case SVt_PVIO:
	2052	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2053	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2054	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2055	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2056	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2057	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2058	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2059	if (IoTOP_NAME(sv))
	2060	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2061	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2062	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2063	else {
	2064	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2065	PTR2UV(IoTOP_GV(sv)));
	2066	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2067	maxnest, dumpops, pvlim);
	2068	}
	2069	/* Source filters hide things that are not GVs in these three, so let's
	2070	be careful out there. */
	2071	if (IoFMT_NAME(sv))
	2072	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2073	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2074	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2075	else {
	2076	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2077	PTR2UV(IoFMT_GV(sv)));
	2078	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2079	maxnest, dumpops, pvlim);
	2080	}
	2081	if (IoBOTTOM_NAME(sv))
	2082	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2083	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2084	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2085	else {
	2086	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2087	PTR2UV(IoBOTTOM_GV(sv)));
	2088	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2089	maxnest, dumpops, pvlim);
	2090	}
	2091	if (isPRINT(IoTYPE(sv)))
	2092	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2093	else
	2094	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2095	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2096	break;
	2097	case SVt_REGEXP:
	2098	dumpregexp:
	2099	{
	2100	struct regexp * const r = ReANY((REGEXP*)sv);
	2101
	2102	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
	2103	sv_setpv(d,""); \
	2104	append_flags(d, flags, names); \
	2105	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2106	SvCUR_set(d, SvCUR(d) - 1); \
	2107	SvPVX(d)[SvCUR(d)] = '\0'; \
	2108	} \
	2109	} STMT_END
	2110	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
	2111	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2112	(UV)(r->compflags), SvPVX_const(d));
	2113
	2114	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
	2115	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2116	(UV)(r->extflags), SvPVX_const(d));
	2117
	2118	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
	2119	PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
	2120	if (r->engine == &PL_core_reg_engine) {
	2121	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
	2122	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
	2123	(UV)(r->intflags), SvPVX_const(d));
	2124	} else {
	2125	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2126	(UV)(r->intflags));
	2127	}
	2128	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2129	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2130	(UV)(r->nparens));
	2131	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2132	(UV)(r->lastparen));
	2133	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2134	(UV)(r->lastcloseparen));
	2135	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2136	(IV)(r->minlen));
	2137	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2138	(IV)(r->minlenret));
	2139	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2140	(UV)(r->gofs));
	2141	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2142	(UV)(r->pre_prefix));
	2143	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2144	(IV)(r->sublen));
	2145	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2146	(IV)(r->suboffset));
	2147	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2148	(IV)(r->subcoffset));
	2149	if (r->subbeg)
	2150	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2151	PTR2UV(r->subbeg),
	2152	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2153	else
	2154	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2155	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2156	PTR2UV(r->mother_re));
	2157	if (nest < maxnest && r->mother_re)
	2158	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2159	maxnest, dumpops, pvlim);
	2160	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2161	PTR2UV(r->paren_names));
	2162	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2163	PTR2UV(r->substrs));
	2164	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2165	PTR2UV(r->pprivate));
	2166	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2167	PTR2UV(r->offs));
	2168	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2169	PTR2UV(r->qr_anoncv));
	2170	#ifdef PERL_ANY_COW
	2171	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2172	PTR2UV(r->saved_copy));
	2173	#endif
	2174	}
	2175	break;
	2176	}
	2177	SvREFCNT_dec_NN(d);
	2178	}
	2179
	2180	/*
	2181	=for apidoc sv_dump
	2182
	2183	Dumps the contents of an SV to the C<STDERR> filehandle.
	2184
	2185	For an example of its output, see L<Devel::Peek>.
	2186
	2187	=cut
	2188	*/
	2189
	2190	void
	2191	Perl_sv_dump(pTHX_ SV *sv)
	2192	{
	2193	PERL_ARGS_ASSERT_SV_DUMP;
	2194
	2195	if (SvROK(sv))
	2196	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2197	else
	2198	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2199	}
	2200
	2201	int
	2202	Perl_runops_debug(pTHX)
	2203	{
	2204	if (!PL_op) {
	2205	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2206	return 0;
	2207	}
	2208
	2209	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2210	do {
	2211	#ifdef PERL_TRACE_OPS
	2212	++PL_op_exec_cnt[PL_op->op_type];
	2213	#endif
	2214	if (PL_debug) {
	2215	ENTER;
	2216	SAVETMPS;
	2217	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2218	PerlIO_printf(Perl_debug_log,
	2219	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2220	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2221	PTR2UV(*PL_watchaddr));
	2222	if (DEBUG_s_TEST_) {
	2223	if (DEBUG_v_TEST_) {
	2224	PerlIO_printf(Perl_debug_log, "\n");
	2225	deb_stack_all();
	2226	}
	2227	else
	2228	debstack();
	2229	}
	2230
	2231
	2232	if (DEBUG_t_TEST_) debop(PL_op);
	2233	if (DEBUG_P_TEST_) debprof(PL_op);
	2234	FREETMPS;
	2235	LEAVE;
	2236	}
	2237
	2238	PERL_DTRACE_PROBE_OP(PL_op);
	2239	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2240	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2241	PERL_ASYNC_CHECK();
	2242
	2243	TAINT_NOT;
	2244	return 0;
	2245	}
	2246
	2247
	2248	/* print the names of the n lexical vars starting at pad offset off */
	2249
	2250	STATIC void
	2251	S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
	2252	{
	2253	PADNAME *sv;
	2254	CV * const cv = deb_curcv(cxstack_ix);
	2255	PADNAMELIST *comppad = NULL;
	2256	int i;
	2257
	2258	if (cv) {
	2259	PADLIST * const padlist = CvPADLIST(cv);
	2260	comppad = PadlistNAMES(padlist);
	2261	}
	2262	if (paren)
	2263	PerlIO_printf(Perl_debug_log, "(");
	2264	for (i = 0; i < n; i++) {
	2265	if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
	2266	PerlIO_printf(Perl_debug_log, "%"PNf, PNfARG(sv));
	2267	else
	2268	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2269	(UV)(off+i));
	2270	if (i < n - 1)
	2271	PerlIO_printf(Perl_debug_log, ",");
	2272	}
	2273	if (paren)
	2274	PerlIO_printf(Perl_debug_log, ")");
	2275	}
	2276
	2277
	2278	/* append to the out SV, the name of the lexical at offset off in the CV
	2279	* cv */
	2280
	2281	static void
	2282	S_append_padvar(pTHX_ PADOFFSET off, CV cv, SV out, int n,
	2283	bool paren, bool is_scalar)
	2284	{
	2285	PADNAME *sv;
	2286	PADNAMELIST *namepad = NULL;
	2287	int i;
	2288
	2289	if (cv) {
	2290	PADLIST * const padlist = CvPADLIST(cv);
	2291	namepad = PadlistNAMES(padlist);
	2292	}
	2293
	2294	if (paren)
	2295	sv_catpvs_nomg(out, "(");
	2296	for (i = 0; i < n; i++) {
	2297	if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
	2298	{
	2299	STRLEN cur = SvCUR(out);
	2300	Perl_sv_catpvf(aTHX_ out, "[%"UTF8f,
	2301	UTF8fARG(1, PadnameLEN(sv) - 1,
	2302	PadnamePV(sv) + 1));
	2303	if (is_scalar)
	2304	SvPVX(out)[cur] = '$';
	2305	}
	2306	else
	2307	Perl_sv_catpvf(aTHX_ out, "[%"UVuf"]", (UV)(off+i));
	2308	if (i < n - 1)
	2309	sv_catpvs_nomg(out, ",");
	2310	}
	2311	if (paren)
	2312	sv_catpvs_nomg(out, "(");
	2313	}
	2314
	2315
	2316	static void
	2317	S_append_gv_name(pTHX_ GV gv, SV out)
	2318	{
	2319	SV *sv;
	2320	if (!gv) {
	2321	sv_catpvs_nomg(out, "<NULLGV>");
	2322	return;
	2323	}
	2324	sv = newSV(0);
	2325	gv_fullname4(sv, gv, NULL, FALSE);
	2326	Perl_sv_catpvf(aTHX_ out, "$%"SVf, SVfARG(sv));
	2327	SvREFCNT_dec_NN(sv);
	2328	}
	2329
	2330	#ifdef USE_ITHREADS
	2331	# define ITEM_SV(item) (comppad ? \
	2332	*av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
	2333	#else
	2334	# define ITEM_SV(item) UNOP_AUX_item_sv(item)
	2335	#endif
	2336
	2337
	2338	/* return a temporary SV containing a stringified representation of
	2339	* the op_aux field of a MULTIDEREF op, associated with CV cv
	2340	*/
	2341
	2342	SV*
	2343	Perl_multideref_stringify(pTHX_ const OP o, CV cv)
	2344	{
	2345	UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
	2346	UV actions = items->uv;
	2347	SV *sv;
	2348	bool last = 0;
	2349	bool is_hash = FALSE;
	2350	int derefs = 0;
	2351	SV *out = newSVpvn_flags("",0,SVs_TEMP);
	2352	#ifdef USE_ITHREADS
	2353	PAD *comppad;
	2354
	2355	if (cv) {
	2356	PADLIST *padlist = CvPADLIST(cv);
	2357	comppad = PadlistARRAY(padlist)[1];
	2358	}
	2359	else
	2360	comppad = NULL;
	2361	#endif
	2362
	2363	PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
	2364
	2365	while (!last) {
	2366	switch (actions & MDEREF_ACTION_MASK) {
	2367
	2368	case MDEREF_reload:
	2369	actions = (++items)->uv;
	2370	continue;
	2371	NOT_REACHED; /* NOTREACHED */
	2372
	2373	case MDEREF_HV_padhv_helem:
	2374	is_hash = TRUE;
	2375	/* FALLTHROUGH */
	2376	case MDEREF_AV_padav_aelem:
	2377	derefs = 1;
	2378	S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
	2379	goto do_elem;
	2380	NOT_REACHED; /* NOTREACHED */
	2381
	2382	case MDEREF_HV_gvhv_helem:
	2383	is_hash = TRUE;
	2384	/* FALLTHROUGH */
	2385	case MDEREF_AV_gvav_aelem:
	2386	derefs = 1;
	2387	items++;
	2388	sv = ITEM_SV(items);
	2389	S_append_gv_name(aTHX_ (GV*)sv, out);
	2390	goto do_elem;
	2391	NOT_REACHED; /* NOTREACHED */
	2392
	2393	case MDEREF_HV_gvsv_vivify_rv2hv_helem:
	2394	is_hash = TRUE;
	2395	/* FALLTHROUGH */
	2396	case MDEREF_AV_gvsv_vivify_rv2av_aelem:
	2397	items++;
	2398	sv = ITEM_SV(items);
	2399	S_append_gv_name(aTHX_ (GV*)sv, out);
	2400	goto do_vivify_rv2xv_elem;
	2401	NOT_REACHED; /* NOTREACHED */
	2402
	2403	case MDEREF_HV_padsv_vivify_rv2hv_helem:
	2404	is_hash = TRUE;
	2405	/* FALLTHROUGH */
	2406	case MDEREF_AV_padsv_vivify_rv2av_aelem:
	2407	S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
	2408	goto do_vivify_rv2xv_elem;
	2409	NOT_REACHED; /* NOTREACHED */
	2410
	2411	case MDEREF_HV_pop_rv2hv_helem:
	2412	case MDEREF_HV_vivify_rv2hv_helem:
	2413	is_hash = TRUE;
	2414	/* FALLTHROUGH */
	2415	do_vivify_rv2xv_elem:
	2416	case MDEREF_AV_pop_rv2av_aelem:
	2417	case MDEREF_AV_vivify_rv2av_aelem:
	2418	if (!derefs++)
	2419	sv_catpvs_nomg(out, "->");
	2420	do_elem:
	2421	if ((actions & MDEREF_INDEX_MASK)== MDEREF_INDEX_none) {
	2422	sv_catpvs_nomg(out, "->");
	2423	last = 1;
	2424	break;
	2425	}
	2426
	2427	sv_catpvn_nomg(out, (is_hash ? "{" : "["), 1);
	2428	switch (actions & MDEREF_INDEX_MASK) {
	2429	case MDEREF_INDEX_const:
	2430	if (is_hash) {
	2431	items++;
	2432	sv = ITEM_SV(items);
	2433	if (!sv)
	2434	sv_catpvs_nomg(out, "???");
	2435	else {
	2436	STRLEN cur;
	2437	char *s;
	2438	s = SvPV(sv, cur);
	2439	pv_pretty(out, s, cur, 30,
	2440	NULL, NULL,
	2441	(PERL_PV_PRETTY_NOCLEAR
	2442	\|PERL_PV_PRETTY_QUOTE
	2443	\|PERL_PV_PRETTY_ELLIPSES));
	2444	}
	2445	}
	2446	else
	2447	Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
	2448	break;
	2449	case MDEREF_INDEX_padsv:
	2450	S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
	2451	break;
	2452	case MDEREF_INDEX_gvsv:
	2453	items++;
	2454	sv = ITEM_SV(items);
	2455	S_append_gv_name(aTHX_ (GV*)sv, out);
	2456	break;
	2457	}
	2458	sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
	2459
	2460	if (actions & MDEREF_FLAG_last)
	2461	last = 1;
	2462	is_hash = FALSE;
	2463
	2464	break;
	2465
	2466	default:
	2467	PerlIO_printf(Perl_debug_log, "UNKNOWN(%d)",
	2468	(int)(actions & MDEREF_ACTION_MASK));
	2469	last = 1;
	2470	break;
	2471
	2472	} /* switch */
	2473
	2474	actions >>= MDEREF_SHIFT;
	2475	} /* while */
	2476	return out;
	2477	}
	2478
	2479
	2480	I32
	2481	Perl_debop(pTHX_ const OP *o)
	2482	{
	2483	PERL_ARGS_ASSERT_DEBOP;
	2484
	2485	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2486	return 0;
	2487
	2488	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2489	switch (o->op_type) {
	2490	case OP_CONST:
	2491	case OP_HINTSEVAL:
	2492	/* With ITHREADS, consts are stored in the pad, and the right pad
	2493	* may not be active here, so check.
	2494	* Looks like only during compiling the pads are illegal.
	2495	*/
	2496	#ifdef USE_ITHREADS
	2497	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2498	#endif
	2499	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2500	break;
	2501	case OP_GVSV:
	2502	case OP_GV:
	2503	if (cGVOPo_gv && isGV(cGVOPo_gv)) {
	2504	SV * const sv = newSV(0);
	2505	gv_fullname3(sv, cGVOPo_gv, NULL);
	2506	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2507	SvREFCNT_dec_NN(sv);
	2508	}
	2509	else if (cGVOPo_gv) {
	2510	SV * const sv = newSV(0);
	2511	assert(SvROK(cGVOPo_gv));
	2512	assert(SvTYPE(SvRV(cGVOPo_gv)) == SVt_PVCV);
	2513	PerlIO_printf(Perl_debug_log, "(cv ref: %s)",
	2514	SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv,0)));
	2515	SvREFCNT_dec_NN(sv);
	2516	}
	2517	else
	2518	PerlIO_printf(Perl_debug_log, "(NULL)");
	2519	break;
	2520
	2521	case OP_PADSV:
	2522	case OP_PADAV:
	2523	case OP_PADHV:
	2524	S_deb_padvar(aTHX_ o->op_targ, 1, 1);
	2525	break;
	2526
	2527	case OP_PADRANGE:
	2528	S_deb_padvar(aTHX_ o->op_targ,
	2529	o->op_private & OPpPADRANGE_COUNTMASK, 1);
	2530	break;
	2531
	2532	case OP_MULTIDEREF:
	2533	PerlIO_printf(Perl_debug_log, "(%"SVf")",
	2534	SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
	2535	break;
	2536
	2537	default:
	2538	break;
	2539	}
	2540	PerlIO_printf(Perl_debug_log, "\n");
	2541	return 0;
	2542	}
	2543
	2544	STATIC CV*
	2545	S_deb_curcv(pTHX_ I32 ix)
	2546	{
	2547	PERL_SI *si = PL_curstackinfo;
	2548	for (; ix >=0; ix--) {
	2549	const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
	2550
	2551	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2552	return cx->blk_sub.cv;
	2553	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2554	return cx->blk_eval.cv;
	2555	else if (ix == 0 && si->si_type == PERLSI_MAIN)
	2556	return PL_main_cv;
	2557	else if (ix == 0 && CxTYPE(cx) == CXt_NULL
	2558	&& si->si_type == PERLSI_SORT)
	2559	{
	2560	/* fake sort sub; use CV of caller */
	2561	si = si->si_prev;
	2562	ix = si->si_cxix + 1;
	2563	}
	2564	}
	2565	return NULL;
	2566	}
	2567
	2568	void
	2569	Perl_watch(pTHX_ char **addr)
	2570	{
	2571	PERL_ARGS_ASSERT_WATCH;
	2572
	2573	PL_watchaddr = addr;
	2574	PL_watchok = *addr;
	2575	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2576	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2577	}
	2578
	2579	STATIC void
	2580	S_debprof(pTHX_ const OP *o)
	2581	{
	2582	PERL_ARGS_ASSERT_DEBPROF;
	2583
	2584	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2585	return;
	2586	if (!PL_profiledata)
	2587	Newxz(PL_profiledata, MAXO, U32);
	2588	++PL_profiledata[o->op_type];
	2589	}
	2590
	2591	void
	2592	Perl_debprofdump(pTHX)
	2593	{
	2594	unsigned i;
	2595	if (!PL_profiledata)
	2596	return;
	2597	for (i = 0; i < MAXO; i++) {
	2598	if (PL_profiledata[i])
	2599	PerlIO_printf(Perl_debug_log,
	2600	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2601	PL_op_name[i]);
	2602	}
	2603	}
	2604
	2605
	2606	/*
	2607	* ex: set ts=8 sts=4 sw=4 et:
	2608	*/