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 "count" chars of pv and puts the results into
	98	dsv such that the size of the escaped string will not exceed "max" chars
	99	and will not contain any incomplete escape sequences. The number of bytes
	100	escaped will be returned in the STRLEN *escaped parameter if it is not null.
	101	When the 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 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 PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
	109
	110	If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
	111	if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
	112	using C<is_utf8_string()> to determine if it is Unicode.
	113
	114	If PERL_PV_ESCAPE_ALL is set then all input chars will be output
	115	using C<\x01F1> style escapes, otherwise if 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 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 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 PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
	130	not a '\\'. This is because regexes very often contain backslashed
	131	sequences, whereas '%' is not a particularly common character in patterns.
	132
	133	Returns a pointer to the escaped text as held by 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 Unicode */
	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	pv_escape() and supporting quoting and ellipses.
	253
	254	If the 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 PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
	257	angle brackets.
	258
	259	If the 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 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 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 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_NUMERIC_LOCAL_SET_STANDARD();
	481	Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
	482	RESTORE_NUMERIC_LOCAL();
	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	const GV * const gv = (const GV *)HeVAL(entry);
	576	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	577	continue;
	578	if (GvCVu(gv))
	579	dump_sub_perl(gv, justperl);
	580	if (GvFORM(gv))
	581	dump_form(gv);
	582	if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
	583	const HV * const hv = GvHV(gv);
	584	if (hv && (hv != PL_defstash))
	585	dump_packsubs_perl(hv, justperl); /* nested package */
	586	}
	587	}
	588	}
	589	}
	590
	591	void
	592	Perl_dump_sub(pTHX_ const GV *gv)
	593	{
	594	PERL_ARGS_ASSERT_DUMP_SUB;
	595	dump_sub_perl(gv, FALSE);
	596	}
	597
	598	void
	599	Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
	600	{
	601	STRLEN len;
	602	SV * const sv = newSVpvs_flags("", SVs_TEMP);
	603	SV *tmpsv;
	604	const char * name;
	605
	606	PERL_ARGS_ASSERT_DUMP_SUB_PERL;
	607
	608	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	609	return;
	610
	611	tmpsv = newSVpvs_flags("", SVs_TEMP);
	612	gv_fullname3(sv, gv, NULL);
	613	name = SvPV_const(sv, len);
	614	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
	615	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	616	if (CvISXSUB(GvCV(gv)))
	617	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
	618	PTR2UV(CvXSUB(GvCV(gv))),
	619	(int)CvXSUBANY(GvCV(gv)).any_i32);
	620	else if (CvROOT(GvCV(gv)))
	621	op_dump(CvROOT(GvCV(gv)));
	622	else
	623	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	624	}
	625
	626	void
	627	Perl_dump_form(pTHX_ const GV *gv)
	628	{
	629	SV * const sv = sv_newmortal();
	630
	631	PERL_ARGS_ASSERT_DUMP_FORM;
	632
	633	gv_fullname3(sv, gv, NULL);
	634	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
	635	if (CvROOT(GvFORM(gv)))
	636	op_dump(CvROOT(GvFORM(gv)));
	637	else
	638	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	639	}
	640
	641	void
	642	Perl_dump_eval(pTHX)
	643	{
	644	op_dump(PL_eval_root);
	645	}
	646
	647	void
	648	Perl_do_pmop_dump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	649	{
	650	char ch;
	651
	652	PERL_ARGS_ASSERT_DO_PMOP_DUMP;
	653
	654	if (!pm) {
	655	Perl_dump_indent(aTHX_ level, file, "{}\n");
	656	return;
	657	}
	658	Perl_dump_indent(aTHX_ level, file, "{\n");
	659	level++;
	660	if (pm->op_pmflags & PMf_ONCE)
	661	ch = '?';
	662	else
	663	ch = '/';
	664	if (PM_GETRE(pm))
	665	Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c%s\n",
	666	ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch,
	667	(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
	668	else
	669	Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
	670	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	671	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
	672	op_dump(pm->op_pmreplrootu.op_pmreplroot);
	673	}
	674	if (pm->op_code_list) {
	675	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
	676	Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
	677	do_op_dump(level, file, pm->op_code_list);
	678	}
	679	else
	680	Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
	681	PTR2UV(pm->op_code_list));
	682	}
	683	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	684	SV * const tmpsv = pm_description(pm);
	685	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	686	SvREFCNT_dec_NN(tmpsv);
	687	}
	688
	689	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	690	}
	691
	692	const struct flag_to_name pmflags_flags_names[] = {
	693	{PMf_CONST, ",CONST"},
	694	{PMf_KEEP, ",KEEP"},
	695	{PMf_GLOBAL, ",GLOBAL"},
	696	{PMf_CONTINUE, ",CONTINUE"},
	697	{PMf_RETAINT, ",RETAINT"},
	698	{PMf_EVAL, ",EVAL"},
	699	{PMf_NONDESTRUCT, ",NONDESTRUCT"},
	700	{PMf_HAS_CV, ",HAS_CV"},
	701	{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
	702	{PMf_IS_QR, ",IS_QR"}
	703	};
	704
	705	static SV *
	706	S_pm_description(pTHX_ const PMOP *pm)
	707	{
	708	SV * const desc = newSVpvs("");
	709	const REGEXP * const regex = PM_GETRE(pm);
	710	const U32 pmflags = pm->op_pmflags;
	711
	712	PERL_ARGS_ASSERT_PM_DESCRIPTION;
	713
	714	if (pmflags & PMf_ONCE)
	715	sv_catpv(desc, ",ONCE");
	716	#ifdef USE_ITHREADS
	717	if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
	718	sv_catpv(desc, ":USED");
	719	#else
	720	if (pmflags & PMf_USED)
	721	sv_catpv(desc, ":USED");
	722	#endif
	723
	724	if (regex) {
	725	if (RX_ISTAINTED(regex))
	726	sv_catpv(desc, ",TAINTED");
	727	if (RX_CHECK_SUBSTR(regex)) {
	728	if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
	729	sv_catpv(desc, ",SCANFIRST");
	730	if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
	731	sv_catpv(desc, ",ALL");
	732	}
	733	if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
	734	sv_catpv(desc, ",SKIPWHITE");
	735	}
	736
	737	append_flags(desc, pmflags, pmflags_flags_names);
	738	return desc;
	739	}
	740
	741	void
	742	Perl_pmop_dump(pTHX_ PMOP *pm)
	743	{
	744	do_pmop_dump(0, Perl_debug_log, pm);
	745	}
	746
	747	/* Return a unique integer to represent the address of op o.
	748	* If it already exists in PL_op_sequence, just return it;
	749	* otherwise add it.
	750	* *** Note that this isn't thread-safe */
	751
	752	STATIC UV
	753	S_sequence_num(pTHX_ const OP *o)
	754	{
	755	dVAR;
	756	SV *op,
	757	**seq;
	758	const char *key;
	759	STRLEN len;
	760	if (!o)
	761	return 0;
	762	op = newSVuv(PTR2UV(o));
	763	sv_2mortal(op);
	764	key = SvPV_const(op, len);
	765	if (!PL_op_sequence)
	766	PL_op_sequence = newHV();
	767	seq = hv_fetch(PL_op_sequence, key, len, 0);
	768	if (seq)
	769	return SvUV(*seq);
	770	(void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
	771	return PL_op_seq;
	772	}
	773
	774
	775
	776
	777
	778	const struct flag_to_name op_flags_names[] = {
	779	{OPf_KIDS, ",KIDS"},
	780	{OPf_PARENS, ",PARENS"},
	781	{OPf_REF, ",REF"},
	782	{OPf_MOD, ",MOD"},
	783	{OPf_STACKED, ",STACKED"},
	784	{OPf_SPECIAL, ",SPECIAL"}
	785	};
	786
	787
	788	void
	789	Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
	790	{
	791	UV seq;
	792	const OPCODE optype = o->op_type;
	793
	794	PERL_ARGS_ASSERT_DO_OP_DUMP;
	795
	796	Perl_dump_indent(aTHX_ level, file, "{\n");
	797	level++;
	798	seq = sequence_num(o);
	799	if (seq)
	800	PerlIO_printf(file, "%-4"UVuf, seq);
	801	else
	802	PerlIO_printf(file, "????");
	803	PerlIO_printf(file,
	804	"%*sTYPE = %s ===> ",
	805	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
	806	if (o->op_next)
	807	PerlIO_printf(file,
	808	o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
	809	sequence_num(o->op_next));
	810	else
	811	PerlIO_printf(file, "NULL\n");
	812	if (o->op_targ) {
	813	if (optype == OP_NULL) {
	814	Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
	815	}
	816	else
	817	Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
	818	}
	819	#ifdef DUMPADDR
	820	Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
	821	#endif
	822
	823	if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) {
	824	SV * const tmpsv = newSVpvs("");
	825	switch (o->op_flags & OPf_WANT) {
	826	case OPf_WANT_VOID:
	827	sv_catpv(tmpsv, ",VOID");
	828	break;
	829	case OPf_WANT_SCALAR:
	830	sv_catpv(tmpsv, ",SCALAR");
	831	break;
	832	case OPf_WANT_LIST:
	833	sv_catpv(tmpsv, ",LIST");
	834	break;
	835	default:
	836	sv_catpv(tmpsv, ",UNKNOWN");
	837	break;
	838	}
	839	append_flags(tmpsv, o->op_flags, op_flags_names);
	840	if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED");
	841	if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
	842	if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
	843	if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
	844	if (o->op_lastsib) sv_catpvs(tmpsv, ",LASTSIB");
	845	Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
	846	SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	847	}
	848
	849	if (o->op_private) {
	850	U16 oppriv = o->op_private;
	851	I16 op_ix = PL_op_private_bitdef_ix[o->op_type];
	852	SV * tmpsv = NULL;
	853
	854	if (op_ix != -1) {
	855	U16 stop = 0;
	856	tmpsv = newSVpvs("");
	857	for (; !stop; op_ix++) {
	858	U16 entry = PL_op_private_bitdefs[op_ix];
	859	U16 bit = (entry >> 2) & 7;
	860	U16 ix = entry >> 5;
	861
	862	stop = (entry & 1);
	863
	864	if (entry & 2) {
	865	/* bitfield */
	866	I16 const *p = &PL_op_private_bitfields[ix];
	867	U16 bitmin = (U16) *p++;
	868	I16 label = *p++;
	869	I16 enum_label;
	870	U16 mask = 0;
	871	U16 i;
	872	U16 val;
	873
	874	for (i = bitmin; i<= bit; i++)
	875	mask \|= (1<<i);
	876	bit = bitmin;
	877	val = (oppriv & mask);
	878
	879	if ( label != -1
	880	&& PL_op_private_labels[label] == '-'
	881	&& PL_op_private_labels[label+1] == '\0'
	882	)
	883	/* display as raw number */
	884	continue;
	885
	886	oppriv -= val;
	887	val >>= bit;
	888	enum_label = -1;
	889	while (*p != -1) {
	890	if (val == *p++) {
	891	enum_label = *p;
	892	break;
	893	}
	894	p++;
	895	}
	896	if (val == 0 && enum_label == -1)
	897	/* don't display anonymous zero values */
	898	continue;
	899
	900	sv_catpv(tmpsv, ",");
	901	if (label != -1) {
	902	sv_catpv(tmpsv, &PL_op_private_labels[label]);
	903	sv_catpv(tmpsv, "=");
	904	}
	905	sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
	906
	907	}
	908	else {
	909	/* bit flag */
	910	if ( oppriv & (1<<bit)
	911	&& !(PL_op_private_labels[ix] == '-'
	912	&& PL_op_private_labels[ix+1] == '\0'))
	913	{
	914	oppriv -= (1<<bit);
	915	sv_catpv(tmpsv, ",");
	916	sv_catpv(tmpsv, &PL_op_private_labels[ix]);
	917	}
	918	}
	919	}
	920	if (oppriv) {
	921	sv_catpv(tmpsv, ",");
	922	Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)oppriv);
	923	}
	924	}
	925	if (tmpsv && SvCUR(tmpsv)) {
	926	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
	927	} else
	928	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
	929	(UV)oppriv);
	930	}
	931
	932	switch (optype) {
	933	case OP_AELEMFAST:
	934	case OP_GVSV:
	935	case OP_GV:
	936	#ifdef USE_ITHREADS
	937	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
	938	#else
	939	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
	940	if (cSVOPo->op_sv) {
	941	STRLEN len;
	942	const char * name;
	943	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	944	SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
	945	gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
	946	name = SvPV_const(tmpsv, len);
	947	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
	948	generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
	949	}
	950	else
	951	Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
	952	}
	953	#endif
	954	break;
	955	case OP_CONST:
	956	case OP_HINTSEVAL:
	957	case OP_METHOD_NAMED:
	958	#ifndef USE_ITHREADS
	959	/* with ITHREADS, consts are stored in the pad, and the right pad
	960	* may not be active here, so skip */
	961	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));
	962	#endif
	963	break;
	964	case OP_NULL:
	965	if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
	966	break;
	967	/* FALLTHROUGH */
	968	case OP_NEXTSTATE:
	969	case OP_DBSTATE:
	970	if (CopLINE(cCOPo))
	971	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	972	(UV)CopLINE(cCOPo));
	973	if (CopSTASHPV(cCOPo)) {
	974	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	975	HV *stash = CopSTASH(cCOPo);
	976	const char * const hvname = HvNAME_get(stash);
	977
	978	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	979	generic_pv_escape(tmpsv, hvname,
	980	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	981	}
	982	if (CopLABEL(cCOPo)) {
	983	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	984	STRLEN label_len;
	985	U32 label_flags;
	986	const char *label = CopLABEL_len_flags(cCOPo,
	987	&label_len, &label_flags);
	988	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	989	generic_pv_escape( tmpsv, label, label_len,
	990	(label_flags & SVf_UTF8)));
	991	}
	992	Perl_dump_indent(aTHX_ level, file, "SEQ = %d\n",
	993	cCOPo->cop_seq);
	994	break;
	995	case OP_ENTERLOOP:
	996	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
	997	if (cLOOPo->op_redoop)
	998	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
	999	else
	1000	PerlIO_printf(file, "DONE\n");
	1001	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
	1002	if (cLOOPo->op_nextop)
	1003	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
	1004	else
	1005	PerlIO_printf(file, "DONE\n");
	1006	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
	1007	if (cLOOPo->op_lastop)
	1008	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
	1009	else
	1010	PerlIO_printf(file, "DONE\n");
	1011	break;
	1012	case OP_COND_EXPR:
	1013	case OP_RANGE:
	1014	case OP_MAPWHILE:
	1015	case OP_GREPWHILE:
	1016	case OP_OR:
	1017	case OP_AND:
	1018	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
	1019	if (cLOGOPo->op_other)
	1020	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
	1021	else
	1022	PerlIO_printf(file, "DONE\n");
	1023	break;
	1024	case OP_PUSHRE:
	1025	case OP_MATCH:
	1026	case OP_QR:
	1027	case OP_SUBST:
	1028	do_pmop_dump(level, file, cPMOPo);
	1029	break;
	1030	case OP_LEAVE:
	1031	case OP_LEAVEEVAL:
	1032	case OP_LEAVESUB:
	1033	case OP_LEAVESUBLV:
	1034	case OP_LEAVEWRITE:
	1035	case OP_SCOPE:
	1036	if (o->op_private & OPpREFCOUNTED)
	1037	Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
	1038	break;
	1039	default:
	1040	break;
	1041	}
	1042	if (o->op_flags & OPf_KIDS) {
	1043	OP *kid;
	1044	for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
	1045	do_op_dump(level, file, kid);
	1046	}
	1047	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	1048	}
	1049
	1050	/*
	1051	=for apidoc op_dump
	1052
	1053	Dumps the optree starting at OP C<o> to C<STDERR>.
	1054
	1055	=cut
	1056	*/
	1057
	1058	void
	1059	Perl_op_dump(pTHX_ const OP *o)
	1060	{
	1061	PERL_ARGS_ASSERT_OP_DUMP;
	1062	do_op_dump(0, Perl_debug_log, o);
	1063	}
	1064
	1065	void
	1066	Perl_gv_dump(pTHX_ GV *gv)
	1067	{
	1068	STRLEN len;
	1069	const char* name;
	1070	SV sv, tmp = newSVpvs_flags("", SVs_TEMP);
	1071
	1072
	1073	PERL_ARGS_ASSERT_GV_DUMP;
	1074
	1075	if (!gv) {
	1076	PerlIO_printf(Perl_debug_log, "{}\n");
	1077	return;
	1078	}
	1079	sv = sv_newmortal();
	1080	PerlIO_printf(Perl_debug_log, "{\n");
	1081	gv_fullname3(sv, gv, NULL);
	1082	name = SvPV_const(sv, len);
	1083	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
	1084	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1085	if (gv != GvEGV(gv)) {
	1086	gv_efullname3(sv, GvEGV(gv), NULL);
	1087	name = SvPV_const(sv, len);
	1088	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
	1089	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1090	}
	1091	PerlIO_putc(Perl_debug_log, '\n');
	1092	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
	1093	}
	1094
	1095
	1096	/* map magic types to the symbolic names
	1097	* (with the PERL_MAGIC_ prefixed stripped)
	1098	*/
	1099
	1100	static const struct { const char type; const char *name; } magic_names[] = {
	1101	#include "mg_names.c"
	1102	/* this null string terminates the list */
	1103	{ 0, NULL },
	1104	};
	1105
	1106	void
	1107	Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1108	{
	1109	PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
	1110
	1111	for (; mg; mg = mg->mg_moremagic) {
	1112	Perl_dump_indent(aTHX_ level, file,
	1113	" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
	1114	if (mg->mg_virtual) {
	1115	const MGVTBL * const v = mg->mg_virtual;
	1116	if (v >= PL_magic_vtables
	1117	&& v < PL_magic_vtables + magic_vtable_max) {
	1118	const U32 i = v - PL_magic_vtables;
	1119	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
	1120	}
	1121	else
	1122	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
	1123	}
	1124	else
	1125	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
	1126
	1127	if (mg->mg_private)
	1128	Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
	1129
	1130	{
	1131	int n;
	1132	const char *name = NULL;
	1133	for (n = 0; magic_names[n].name; n++) {
	1134	if (mg->mg_type == magic_names[n].type) {
	1135	name = magic_names[n].name;
	1136	break;
	1137	}
	1138	}
	1139	if (name)
	1140	Perl_dump_indent(aTHX_ level, file,
	1141	" MG_TYPE = PERL_MAGIC_%s\n", name);
	1142	else
	1143	Perl_dump_indent(aTHX_ level, file,
	1144	" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
	1145	}
	1146
	1147	if (mg->mg_flags) {
	1148	Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
	1149	if (mg->mg_type == PERL_MAGIC_envelem &&
	1150	mg->mg_flags & MGf_TAINTEDDIR)
	1151	Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
	1152	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1153	mg->mg_flags & MGf_MINMATCH)
	1154	Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
	1155	if (mg->mg_flags & MGf_REFCOUNTED)
	1156	Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
	1157	if (mg->mg_flags & MGf_GSKIP)
	1158	Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
	1159	if (mg->mg_flags & MGf_COPY)
	1160	Perl_dump_indent(aTHX_ level, file, " COPY\n");
	1161	if (mg->mg_flags & MGf_DUP)
	1162	Perl_dump_indent(aTHX_ level, file, " DUP\n");
	1163	if (mg->mg_flags & MGf_LOCAL)
	1164	Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
	1165	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1166	mg->mg_flags & MGf_BYTES)
	1167	Perl_dump_indent(aTHX_ level, file, " BYTES\n");
	1168	}
	1169	if (mg->mg_obj) {
	1170	Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
	1171	PTR2UV(mg->mg_obj));
	1172	if (mg->mg_type == PERL_MAGIC_qr) {
	1173	REGEXP* const re = (REGEXP *)mg->mg_obj;
	1174	SV * const dsv = sv_newmortal();
	1175	const char * const s
	1176	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
	1177	60, NULL, NULL,
	1178	( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
	1179	(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
	1180	);
	1181	Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
	1182	Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
	1183	(IV)RX_REFCNT(re));
	1184	}
	1185	if (mg->mg_flags & MGf_REFCOUNTED)
	1186	do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
	1187	}
	1188	if (mg->mg_len)
	1189	Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
	1190	if (mg->mg_ptr) {
	1191	Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
	1192	if (mg->mg_len >= 0) {
	1193	if (mg->mg_type != PERL_MAGIC_utf8) {
	1194	SV * const sv = newSVpvs("");
	1195	PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
	1196	SvREFCNT_dec_NN(sv);
	1197	}
	1198	}
	1199	else if (mg->mg_len == HEf_SVKEY) {
	1200	PerlIO_puts(file, " => HEf_SVKEY\n");
	1201	do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
	1202	maxnest, dumpops, pvlim); /* MG is already +1 */
	1203	continue;
	1204	}
	1205	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1206	else
	1207	PerlIO_puts(
	1208	file,
	1209	" ???? - " __FILE__
	1210	" does not know how to handle this MG_LEN"
	1211	);
	1212	PerlIO_putc(file, '\n');
	1213	}
	1214	if (mg->mg_type == PERL_MAGIC_utf8) {
	1215	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1216	if (cache) {
	1217	IV i;
	1218	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1219	Perl_dump_indent(aTHX_ level, file,
	1220	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1221	i,
	1222	(UV)cache[i * 2],
	1223	(UV)cache[i * 2 + 1]);
	1224	}
	1225	}
	1226	}
	1227	}
	1228
	1229	void
	1230	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1231	{
	1232	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1233	}
	1234
	1235	void
	1236	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1237	{
	1238	const char *hvname;
	1239
	1240	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1241
	1242	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1243	if (sv && (hvname = HvNAME_get(sv)))
	1244	{
	1245	/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
	1246	name which quite legally could contain insane things like tabs, newlines, nulls or
	1247	other scary crap - this should produce sane results - except maybe for unicode package
	1248	names - but we will wait for someone to file a bug on that - demerphq */
	1249	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	1250	PerlIO_printf(file, "\t\"%s\"\n",
	1251	generic_pv_escape( tmpsv, hvname,
	1252	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1253	}
	1254	else
	1255	PerlIO_putc(file, '\n');
	1256	}
	1257
	1258	void
	1259	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1260	{
	1261	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1262
	1263	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1264	if (sv && GvNAME(sv)) {
	1265	SV * const tmpsv = newSVpvs("");
	1266	PerlIO_printf(file, "\t\"%s\"\n",
	1267	generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
	1268	}
	1269	else
	1270	PerlIO_putc(file, '\n');
	1271	}
	1272
	1273	void
	1274	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1275	{
	1276	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1277
	1278	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1279	if (sv && GvNAME(sv)) {
	1280	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1281	const char *hvname;
	1282	HV * const stash = GvSTASH(sv);
	1283	PerlIO_printf(file, "\t");
	1284	/* TODO might have an extra \" here */
	1285	if (stash && (hvname = HvNAME_get(stash))) {
	1286	PerlIO_printf(file, "\"%s\" :: \"",
	1287	generic_pv_escape(tmp, hvname,
	1288	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1289	}
	1290	PerlIO_printf(file, "%s\"\n",
	1291	generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
	1292	}
	1293	else
	1294	PerlIO_putc(file, '\n');
	1295	}
	1296
	1297	const struct flag_to_name first_sv_flags_names[] = {
	1298	{SVs_TEMP, "TEMP,"},
	1299	{SVs_OBJECT, "OBJECT,"},
	1300	{SVs_GMG, "GMG,"},
	1301	{SVs_SMG, "SMG,"},
	1302	{SVs_RMG, "RMG,"},
	1303	{SVf_IOK, "IOK,"},
	1304	{SVf_NOK, "NOK,"},
	1305	{SVf_POK, "POK,"}
	1306	};
	1307
	1308	const struct flag_to_name second_sv_flags_names[] = {
	1309	{SVf_OOK, "OOK,"},
	1310	{SVf_FAKE, "FAKE,"},
	1311	{SVf_READONLY, "READONLY,"},
	1312	{SVf_PROTECT, "PROTECT,"},
	1313	{SVf_BREAK, "BREAK,"},
	1314	{SVp_IOK, "pIOK,"},
	1315	{SVp_NOK, "pNOK,"},
	1316	{SVp_POK, "pPOK,"}
	1317	};
	1318
	1319	const struct flag_to_name cv_flags_names[] = {
	1320	{CVf_ANON, "ANON,"},
	1321	{CVf_UNIQUE, "UNIQUE,"},
	1322	{CVf_CLONE, "CLONE,"},
	1323	{CVf_CLONED, "CLONED,"},
	1324	{CVf_CONST, "CONST,"},
	1325	{CVf_NODEBUG, "NODEBUG,"},
	1326	{CVf_LVALUE, "LVALUE,"},
	1327	{CVf_METHOD, "METHOD,"},
	1328	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1329	{CVf_CVGV_RC, "CVGV_RC,"},
	1330	{CVf_DYNFILE, "DYNFILE,"},
	1331	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1332	{CVf_HASEVAL, "HASEVAL,"},
	1333	{CVf_SLABBED, "SLABBED,"},
	1334	{CVf_NAMED, "NAMED,"},
	1335	{CVf_LEXICAL, "LEXICAL,"},
	1336	{CVf_ISXSUB, "ISXSUB,"}
	1337	};
	1338
	1339	const struct flag_to_name hv_flags_names[] = {
	1340	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1341	{SVphv_LAZYDEL, "LAZYDEL,"},
	1342	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	1343	{SVf_AMAGIC, "OVERLOAD,"},
	1344	{SVphv_CLONEABLE, "CLONEABLE,"}
	1345	};
	1346
	1347	const struct flag_to_name gp_flags_names[] = {
	1348	{GVf_INTRO, "INTRO,"},
	1349	{GVf_MULTI, "MULTI,"},
	1350	{GVf_ASSUMECV, "ASSUMECV,"},
	1351	};
	1352
	1353	const struct flag_to_name gp_flags_imported_names[] = {
	1354	{GVf_IMPORTED_SV, " SV"},
	1355	{GVf_IMPORTED_AV, " AV"},
	1356	{GVf_IMPORTED_HV, " HV"},
	1357	{GVf_IMPORTED_CV, " CV"},
	1358	};
	1359
	1360	/* NOTE: this structure is mostly duplicative of one generated by
	1361	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1362	* the two. - Yves */
	1363	const struct flag_to_name regexp_extflags_names[] = {
	1364	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1365	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1366	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1367	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1368	{RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
	1369	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1370	{RXf_IS_ANCHORED, "IS_ANCHORED,"},
	1371	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1372	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1373	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1374	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1375	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1376	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1377	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1378	{RXf_SPLIT, "SPLIT,"},
	1379	{RXf_COPY_DONE, "COPY_DONE,"},
	1380	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1381	{RXf_TAINTED, "TAINTED,"},
	1382	{RXf_START_ONLY, "START_ONLY,"},
	1383	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1384	{RXf_WHITE, "WHITE,"},
	1385	{RXf_NULL, "NULL,"},
	1386	};
	1387
	1388	/* NOTE: this structure is mostly duplicative of one generated by
	1389	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1390	* the two. - Yves */
	1391	const struct flag_to_name regexp_core_intflags_names[] = {
	1392	{PREGf_SKIP, "SKIP,"},
	1393	{PREGf_IMPLICIT, "IMPLICIT,"},
	1394	{PREGf_NAUGHTY, "NAUGHTY,"},
	1395	{PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
	1396	{PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
	1397	{PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
	1398	{PREGf_NOSCAN, "NOSCAN,"},
	1399	{PREGf_CANY_SEEN, "CANY_SEEN,"},
	1400	{PREGf_GPOS_SEEN, "GPOS_SEEN,"},
	1401	{PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1402	{PREGf_ANCH_MBOL, "ANCH_MBOL,"},
	1403	{PREGf_ANCH_SBOL, "ANCH_SBOL,"},
	1404	{PREGf_ANCH_GPOS, "ANCH_GPOS,"},
	1405	};
	1406
	1407	void
	1408	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1409	{
	1410	SV *d;
	1411	const char *s;
	1412	U32 flags;
	1413	U32 type;
	1414
	1415	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1416
	1417	if (!sv) {
	1418	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1419	return;
	1420	}
	1421
	1422	flags = SvFLAGS(sv);
	1423	type = SvTYPE(sv);
	1424
	1425	/* process general SV flags */
	1426
	1427	d = Perl_newSVpvf(aTHX_
	1428	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1429	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1430	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1431	(int)(PL_dumpindent*level), "");
	1432
	1433	if (!((flags & SVpad_NAME) == SVpad_NAME
	1434	&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1435	if ((flags & SVs_PADSTALE))
	1436	sv_catpv(d, "PADSTALE,");
	1437	}
	1438	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
	1439	if ((flags & SVs_PADTMP))
	1440	sv_catpv(d, "PADTMP,");
	1441	}
	1442	append_flags(d, flags, first_sv_flags_names);
	1443	if (flags & SVf_ROK) {
	1444	sv_catpv(d, "ROK,");
	1445	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1446	}
	1447	if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
	1448	append_flags(d, flags, second_sv_flags_names);
	1449	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1450	&& type != SVt_PVAV) {
	1451	if (SvPCS_IMPORTED(sv))
	1452	sv_catpv(d, "PCS_IMPORTED,");
	1453	else
	1454	sv_catpv(d, "SCREAM,");
	1455	}
	1456
	1457	/* process type-specific SV flags */
	1458
	1459	switch (type) {
	1460	case SVt_PVCV:
	1461	case SVt_PVFM:
	1462	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1463	break;
	1464	case SVt_PVHV:
	1465	append_flags(d, flags, hv_flags_names);
	1466	break;
	1467	case SVt_PVGV:
	1468	case SVt_PVLV:
	1469	if (isGV_with_GP(sv)) {
	1470	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1471	}
	1472	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1473	sv_catpv(d, "IMPORT");
	1474	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1475	sv_catpv(d, "ALL,");
	1476	else {
	1477	sv_catpv(d, "(");
	1478	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1479	sv_catpv(d, " ),");
	1480	}
	1481	}
	1482	/* FALLTHROUGH */
	1483	default:
	1484	evaled_or_uv:
	1485	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1486	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1487	break;
	1488	case SVt_PVMG:
	1489	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1490	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1491	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1492	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1493	/* FALLTHROUGH */
	1494	case SVt_PVNV:
	1495	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1496	goto evaled_or_uv;
	1497	case SVt_PVAV:
	1498	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
	1499	break;
	1500	}
	1501	/* SVphv_SHAREKEYS is also 0x20000000 */
	1502	if ((type != SVt_PVHV) && SvUTF8(sv))
	1503	sv_catpv(d, "UTF8");
	1504
	1505	if (*(SvEND(d) - 1) == ',') {
	1506	SvCUR_set(d, SvCUR(d) - 1);
	1507	SvPVX(d)[SvCUR(d)] = '\0';
	1508	}
	1509	sv_catpv(d, ")");
	1510	s = SvPVX_const(d);
	1511
	1512	/* dump initial SV details */
	1513
	1514	#ifdef DEBUG_LEAKING_SCALARS
	1515	Perl_dump_indent(aTHX_ level, file,
	1516	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1517	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1518	sv->sv_debug_line,
	1519	sv->sv_debug_inpad ? "for" : "by",
	1520	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1521	PTR2UV(sv->sv_debug_parent),
	1522	sv->sv_debug_serial
	1523	);
	1524	#endif
	1525	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1526
	1527	/* Dump SV type */
	1528
	1529	if (type < SVt_LAST) {
	1530	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1531
	1532	if (type == SVt_NULL) {
	1533	SvREFCNT_dec_NN(d);
	1534	return;
	1535	}
	1536	} else {
	1537	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1538	SvREFCNT_dec_NN(d);
	1539	return;
	1540	}
	1541
	1542	/* Dump general SV fields */
	1543
	1544	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1545	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1546	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1547	\|\| (type == SVt_IV && !SvROK(sv))) {
	1548	if (SvIsUV(sv)
	1549	#ifdef PERL_OLD_COPY_ON_WRITE
	1550	\|\| SvIsCOW(sv)
	1551	#endif
	1552	)
	1553	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1554	else
	1555	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1556	#ifdef PERL_OLD_COPY_ON_WRITE
	1557	if (SvIsCOW_shared_hash(sv))
	1558	PerlIO_printf(file, " (HASH)");
	1559	else if (SvIsCOW_normal(sv))
	1560	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1561	#endif
	1562	PerlIO_putc(file, '\n');
	1563	}
	1564
	1565	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1566	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1567	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1568	(UV) COP_SEQ_RANGE_LOW(sv));
	1569	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1570	(UV) COP_SEQ_RANGE_HIGH(sv));
	1571	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1572	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1573	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1574	\|\| type == SVt_NV) {
	1575	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1576	Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
	1577	RESTORE_NUMERIC_LOCAL();
	1578	}
	1579
	1580	if (SvROK(sv)) {
	1581	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1582	if (nest < maxnest)
	1583	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1584	}
	1585
	1586	if (type < SVt_PV) {
	1587	SvREFCNT_dec_NN(d);
	1588	return;
	1589	}
	1590
	1591	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1592	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1593	const bool re = isREGEXP(sv);
	1594	const char * const ptr =
	1595	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1596	if (ptr) {
	1597	STRLEN delta;
	1598	if (SvOOK(sv)) {
	1599	SvOOK_offset(sv, delta);
	1600	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1601	(UV) delta);
	1602	} else {
	1603	delta = 0;
	1604	}
	1605	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1606	if (SvOOK(sv)) {
	1607	PerlIO_printf(file, "( %s . ) ",
	1608	pv_display(d, ptr - delta, delta, 0,
	1609	pvlim));
	1610	}
	1611	if (type == SVt_INVLIST) {
	1612	PerlIO_printf(file, "\n");
	1613	/* 4 blanks indents 2 beyond the PV, etc */
	1614	_invlist_dump(file, level, " ", sv);
	1615	}
	1616	else {
	1617	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1618	re ? 0 : SvLEN(sv),
	1619	pvlim));
	1620	if (SvUTF8(sv)) /* the 6? \x{....} */
	1621	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1622	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1623	UNI_DISPLAY_QQ));
	1624	PerlIO_printf(file, "\n");
	1625	}
	1626	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1627	if (!re)
	1628	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1629	(IV)SvLEN(sv));
	1630	#ifdef PERL_NEW_COPY_ON_WRITE
	1631	if (SvIsCOW(sv) && SvLEN(sv))
	1632	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1633	CowREFCNT(sv));
	1634	#endif
	1635	}
	1636	else
	1637	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1638	}
	1639
	1640	if (type >= SVt_PVMG) {
	1641	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1642	HV * const ost = SvOURSTASH(sv);
	1643	if (ost)
	1644	do_hv_dump(level, file, " OURSTASH", ost);
	1645	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
	1646	Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
	1647	(UV)PadnamelistMAXNAMED(sv));
	1648	} else {
	1649	if (SvMAGIC(sv))
	1650	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1651	}
	1652	if (SvSTASH(sv))
	1653	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1654
	1655	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1656	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1657	}
	1658	}
	1659
	1660	/* Dump type-specific SV fields */
	1661
	1662	switch (type) {
	1663	case SVt_PVAV:
	1664	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1665	if (AvARRAY(sv) != AvALLOC(sv)) {
	1666	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1667	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1668	}
	1669	else
	1670	PerlIO_putc(file, '\n');
	1671	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1672	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1673	/* arylen is stored in magic, and padnamelists use SvMAGIC for
	1674	something else. */
	1675	if (!AvPAD_NAMELIST(sv))
	1676	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1677	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1678	sv_setpvs(d, "");
	1679	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1680	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1681	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1682	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1683	if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
	1684	SSize_t count;
	1685	for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1686	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1687
	1688	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1689	if (elt)
	1690	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1691	}
	1692	}
	1693	break;
	1694	case SVt_PVHV: {
	1695	U32 usedkeys;
	1696	if (SvOOK(sv)) {
	1697	struct xpvhv_aux *const aux = HvAUX(sv);
	1698	Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
	1699	(UV)aux->xhv_aux_flags);
	1700	}
	1701	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1702	usedkeys = HvUSEDKEYS(sv);
	1703	if (HvARRAY(sv) && usedkeys) {
	1704	/* Show distribution of HEs in the ARRAY */
	1705	int freq[200];
	1706	#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
	1707	int i;
	1708	int max = 0;
	1709	U32 pow2 = 2, keys = usedkeys;
	1710	NV theoret, sum = 0;
	1711
	1712	PerlIO_printf(file, " (");
	1713	Zero(freq, FREQ_MAX + 1, int);
	1714	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1715	HE* h;
	1716	int count = 0;
	1717	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1718	count++;
	1719	if (count > FREQ_MAX)
	1720	count = FREQ_MAX;
	1721	freq[count]++;
	1722	if (max < count)
	1723	max = count;
	1724	}
	1725	for (i = 0; i <= max; i++) {
	1726	if (freq[i]) {
	1727	PerlIO_printf(file, "%d%s:%d", i,
	1728	(i == FREQ_MAX) ? "+" : "",
	1729	freq[i]);
	1730	if (i != max)
	1731	PerlIO_printf(file, ", ");
	1732	}
	1733	}
	1734	PerlIO_putc(file, ')');
	1735	/* The "quality" of a hash is defined as the total number of
	1736	comparisons needed to access every element once, relative
	1737	to the expected number needed for a random hash.
	1738
	1739	The total number of comparisons is equal to the sum of
	1740	the squares of the number of entries in each bucket.
	1741	For a random hash of n keys into k buckets, the expected
	1742	value is
	1743	n + n(n-1)/2k
	1744	*/
	1745
	1746	for (i = max; i > 0; i--) { /* Precision: count down. */
	1747	sum += freq[i] * i * i;
	1748	}
	1749	while ((keys = keys >> 1))
	1750	pow2 = pow2 << 1;
	1751	theoret = usedkeys;
	1752	theoret += theoret * (theoret-1)/pow2;
	1753	PerlIO_putc(file, '\n');
	1754	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1755	}
	1756	PerlIO_putc(file, '\n');
	1757	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
	1758	{
	1759	STRLEN count = 0;
	1760	HE **ents = HvARRAY(sv);
	1761
	1762	if (ents) {
	1763	HE const const last = ents + HvMAX(sv);
	1764	count = last + 1 - ents;
	1765
	1766	do {
	1767	if (!*ents)
	1768	--count;
	1769	} while (++ents <= last);
	1770	}
	1771
	1772	if (SvOOK(sv)) {
	1773	struct xpvhv_aux *const aux = HvAUX(sv);
	1774	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1775	" (cached = %"UVuf")\n",
	1776	(UV)count, (UV)aux->xhv_fill_lazy);
	1777	} else {
	1778	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1779	(UV)count);
	1780	}
	1781	}
	1782	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1783	if (SvOOK(sv)) {
	1784	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1785	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1786	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1787	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1788	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1789	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1790	}
	1791	#endif
	1792	PerlIO_putc(file, '\n');
	1793	}
	1794	{
	1795	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1796	if (mg && mg->mg_obj) {
	1797	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1798	}
	1799	}
	1800	{
	1801	const char * const hvname = HvNAME_get(sv);
	1802	if (hvname) {
	1803	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1804	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1805	generic_pv_escape( tmpsv, hvname,
	1806	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1807	}
	1808	}
	1809	if (SvOOK(sv)) {
	1810	AV * const backrefs
	1811	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1812	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1813	if (HvAUX(sv)->xhv_name_count)
	1814	Perl_dump_indent(aTHX_
	1815	level, file, " NAMECOUNT = %"IVdf"\n",
	1816	(IV)HvAUX(sv)->xhv_name_count
	1817	);
	1818	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1819	const I32 count = HvAUX(sv)->xhv_name_count;
	1820	if (count) {
	1821	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1822	/* The starting point is the first element if count is
	1823	positive and the second element if count is negative. */
	1824	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1825	+ (count < 0 ? 1 : 0);
	1826	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1827	+ (count < 0 ? -count : count);
	1828	while (hekp < endp) {
	1829	if (HEK_LEN(*hekp)) {
	1830	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1831	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	1832	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	1833	} else {
	1834	/* This should never happen. */
	1835	sv_catpvs(names, ", (null)");
	1836	}
	1837	++hekp;
	1838	}
	1839	Perl_dump_indent(aTHX_
	1840	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	1841	);
	1842	}
	1843	else {
	1844	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	1845	const char *const hvename = HvENAME_get(sv);
	1846	Perl_dump_indent(aTHX_
	1847	level, file, " ENAME = \"%s\"\n",
	1848	generic_pv_escape(tmp, hvename,
	1849	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	1850	}
	1851	}
	1852	if (backrefs) {
	1853	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1854	PTR2UV(backrefs));
	1855	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1856	dumpops, pvlim);
	1857	}
	1858	if (meta) {
	1859	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1860	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	1861	generic_pv_escape( tmpsv, meta->mro_which->name,
	1862	meta->mro_which->length,
	1863	(meta->mro_which->kflags & HVhek_UTF8)),
	1864	PTR2UV(meta->mro_which));
	1865	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1866	(UV)meta->cache_gen);
	1867	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1868	(UV)meta->pkg_gen);
	1869	if (meta->mro_linear_all) {
	1870	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1871	PTR2UV(meta->mro_linear_all));
	1872	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1873	dumpops, pvlim);
	1874	}
	1875	if (meta->mro_linear_current) {
	1876	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1877	PTR2UV(meta->mro_linear_current));
	1878	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1879	dumpops, pvlim);
	1880	}
	1881	if (meta->mro_nextmethod) {
	1882	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1883	PTR2UV(meta->mro_nextmethod));
	1884	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1885	dumpops, pvlim);
	1886	}
	1887	if (meta->isa) {
	1888	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1889	PTR2UV(meta->isa));
	1890	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1891	dumpops, pvlim);
	1892	}
	1893	}
	1894	}
	1895	if (nest < maxnest) {
	1896	HV * const hv = MUTABLE_HV(sv);
	1897	STRLEN i;
	1898	HE *he;
	1899
	1900	if (HvARRAY(hv)) {
	1901	int count = maxnest - nest;
	1902	for (i=0; i <= HvMAX(hv); i++) {
	1903	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	1904	U32 hash;
	1905	SV * keysv;
	1906	const char * keypv;
	1907	SV * elt;
	1908	STRLEN len;
	1909
	1910	if (count-- <= 0) goto DONEHV;
	1911
	1912	hash = HeHASH(he);
	1913	keysv = hv_iterkeysv(he);
	1914	keypv = SvPV_const(keysv, len);
	1915	elt = HeVAL(he);
	1916
	1917	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1918	if (SvUTF8(keysv))
	1919	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1920	if (HvEITER_get(hv) == he)
	1921	PerlIO_printf(file, "[CURRENT] ");
	1922	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	1923	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1924	}
	1925	}
	1926	DONEHV:;
	1927	}
	1928	}
	1929	break;
	1930	} /* case SVt_PVHV */
	1931
	1932	case SVt_PVCV:
	1933	if (CvAUTOLOAD(sv)) {
	1934	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1935	STRLEN len;
	1936	const char *const name = SvPV_const(sv, len);
	1937	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	1938	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	1939	}
	1940	if (SvPOK(sv)) {
	1941	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1942	const char *const proto = CvPROTO(sv);
	1943	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	1944	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	1945	SvUTF8(sv)));
	1946	}
	1947	/* FALLTHROUGH */
	1948	case SVt_PVFM:
	1949	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1950	if (!CvISXSUB(sv)) {
	1951	if (CvSTART(sv)) {
	1952	Perl_dump_indent(aTHX_ level, file,
	1953	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1954	PTR2UV(CvSTART(sv)),
	1955	(IV)sequence_num(CvSTART(sv)));
	1956	}
	1957	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1958	PTR2UV(CvROOT(sv)));
	1959	if (CvROOT(sv) && dumpops) {
	1960	do_op_dump(level+1, file, CvROOT(sv));
	1961	}
	1962	} else {
	1963	SV * const constant = cv_const_sv((const CV *)sv);
	1964
	1965	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	1966
	1967	if (constant) {
	1968	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	1969	" (CONST SV)\n",
	1970	PTR2UV(CvXSUBANY(sv).any_ptr));
	1971	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	1972	pvlim);
	1973	} else {
	1974	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	1975	(IV)CvXSUBANY(sv).any_i32);
	1976	}
	1977	}
	1978	if (CvNAMED(sv))
	1979	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1980	HEK_KEY(CvNAME_HEK((CV *)sv)));
	1981	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	1982	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	1983	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1984	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1985	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1986	if (!CvISXSUB(sv)) {
	1987	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1988	if (nest < maxnest) {
	1989	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1990	}
	1991	}
	1992	else
	1993	Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv));
	1994	{
	1995	const CV * const outside = CvOUTSIDE(sv);
	1996	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1997	PTR2UV(outside),
	1998	(!outside ? "null"
	1999	: CvANON(outside) ? "ANON"
	2000	: (outside == PL_main_cv) ? "MAIN"
	2001	: CvUNIQUE(outside) ? "UNIQUE"
	2002	: CvGV(outside) ?
	2003	generic_pv_escape(
	2004	newSVpvs_flags("", SVs_TEMP),
	2005	GvNAME(CvGV(outside)),
	2006	GvNAMELEN(CvGV(outside)),
	2007	GvNAMEUTF8(CvGV(outside)))
	2008	: "UNDEFINED"));
	2009	}
	2010	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2011	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2012	break;
	2013
	2014	case SVt_PVGV:
	2015	case SVt_PVLV:
	2016	if (type == SVt_PVLV) {
	2017	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2018	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2019	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2020	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2021	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2022	if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
	2023	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2024	dumpops, pvlim);
	2025	}
	2026	if (isREGEXP(sv)) goto dumpregexp;
	2027	if (!isGV_with_GP(sv))
	2028	break;
	2029	{
	2030	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2031	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2032	generic_pv_escape(tmpsv, GvNAME(sv),
	2033	GvNAMELEN(sv),
	2034	GvNAMEUTF8(sv)));
	2035	}
	2036	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2037	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2038	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2039	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2040	if (!GvGP(sv))
	2041	break;
	2042	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2043	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2044	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2045	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2046	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2047	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2048	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2049	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2050	Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf
	2051	" (%s)\n",
	2052	(UV)GvGPFLAGS(sv),
	2053	GvALIASED_SV(sv) ? "ALIASED_SV" : "");
	2054	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2055	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2056	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2057	break;
	2058	case SVt_PVIO:
	2059	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2060	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2061	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2062	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2063	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2064	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2065	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2066	if (IoTOP_NAME(sv))
	2067	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2068	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2069	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2070	else {
	2071	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2072	PTR2UV(IoTOP_GV(sv)));
	2073	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2074	maxnest, dumpops, pvlim);
	2075	}
	2076	/* Source filters hide things that are not GVs in these three, so let's
	2077	be careful out there. */
	2078	if (IoFMT_NAME(sv))
	2079	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2080	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2081	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2082	else {
	2083	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2084	PTR2UV(IoFMT_GV(sv)));
	2085	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2086	maxnest, dumpops, pvlim);
	2087	}
	2088	if (IoBOTTOM_NAME(sv))
	2089	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2090	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2091	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2092	else {
	2093	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2094	PTR2UV(IoBOTTOM_GV(sv)));
	2095	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2096	maxnest, dumpops, pvlim);
	2097	}
	2098	if (isPRINT(IoTYPE(sv)))
	2099	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2100	else
	2101	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2102	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2103	break;
	2104	case SVt_REGEXP:
	2105	dumpregexp:
	2106	{
	2107	struct regexp * const r = ReANY((REGEXP*)sv);
	2108
	2109	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
	2110	sv_setpv(d,""); \
	2111	append_flags(d, flags, names); \
	2112	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2113	SvCUR_set(d, SvCUR(d) - 1); \
	2114	SvPVX(d)[SvCUR(d)] = '\0'; \
	2115	} \
	2116	} STMT_END
	2117	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
	2118	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2119	(UV)(r->compflags), SvPVX_const(d));
	2120
	2121	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
	2122	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2123	(UV)(r->extflags), SvPVX_const(d));
	2124
	2125	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
	2126	PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
	2127	if (r->engine == &PL_core_reg_engine) {
	2128	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
	2129	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
	2130	(UV)(r->intflags), SvPVX_const(d));
	2131	} else {
	2132	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2133	(UV)(r->intflags));
	2134	}
	2135	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2136	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2137	(UV)(r->nparens));
	2138	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2139	(UV)(r->lastparen));
	2140	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2141	(UV)(r->lastcloseparen));
	2142	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2143	(IV)(r->minlen));
	2144	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2145	(IV)(r->minlenret));
	2146	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2147	(UV)(r->gofs));
	2148	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2149	(UV)(r->pre_prefix));
	2150	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2151	(IV)(r->sublen));
	2152	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2153	(IV)(r->suboffset));
	2154	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2155	(IV)(r->subcoffset));
	2156	if (r->subbeg)
	2157	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2158	PTR2UV(r->subbeg),
	2159	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2160	else
	2161	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2162	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2163	PTR2UV(r->mother_re));
	2164	if (nest < maxnest && r->mother_re)
	2165	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2166	maxnest, dumpops, pvlim);
	2167	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2168	PTR2UV(r->paren_names));
	2169	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2170	PTR2UV(r->substrs));
	2171	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2172	PTR2UV(r->pprivate));
	2173	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2174	PTR2UV(r->offs));
	2175	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2176	PTR2UV(r->qr_anoncv));
	2177	#ifdef PERL_ANY_COW
	2178	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2179	PTR2UV(r->saved_copy));
	2180	#endif
	2181	}
	2182	break;
	2183	}
	2184	SvREFCNT_dec_NN(d);
	2185	}
	2186
	2187	/*
	2188	=for apidoc sv_dump
	2189
	2190	Dumps the contents of an SV to the C<STDERR> filehandle.
	2191
	2192	For an example of its output, see L<Devel::Peek>.
	2193
	2194	=cut
	2195	*/
	2196
	2197	void
	2198	Perl_sv_dump(pTHX_ SV *sv)
	2199	{
	2200	PERL_ARGS_ASSERT_SV_DUMP;
	2201
	2202	if (SvROK(sv))
	2203	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2204	else
	2205	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2206	}
	2207
	2208	int
	2209	Perl_runops_debug(pTHX)
	2210	{
	2211	if (!PL_op) {
	2212	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2213	return 0;
	2214	}
	2215
	2216	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2217	do {
	2218	#ifdef PERL_TRACE_OPS
	2219	++PL_op_exec_cnt[PL_op->op_type];
	2220	#endif
	2221	if (PL_debug) {
	2222	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2223	PerlIO_printf(Perl_debug_log,
	2224	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2225	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2226	PTR2UV(*PL_watchaddr));
	2227	if (DEBUG_s_TEST_) {
	2228	if (DEBUG_v_TEST_) {
	2229	PerlIO_printf(Perl_debug_log, "\n");
	2230	deb_stack_all();
	2231	}
	2232	else
	2233	debstack();
	2234	}
	2235
	2236
	2237	if (DEBUG_t_TEST_) debop(PL_op);
	2238	if (DEBUG_P_TEST_) debprof(PL_op);
	2239	}
	2240
	2241	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2242	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2243	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2244	PERL_ASYNC_CHECK();
	2245
	2246	TAINT_NOT;
	2247	return 0;
	2248	}
	2249
	2250	I32
	2251	Perl_debop(pTHX_ const OP *o)
	2252	{
	2253	int count;
	2254
	2255	PERL_ARGS_ASSERT_DEBOP;
	2256
	2257	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2258	return 0;
	2259
	2260	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2261	switch (o->op_type) {
	2262	case OP_CONST:
	2263	case OP_HINTSEVAL:
	2264	/* With ITHREADS, consts are stored in the pad, and the right pad
	2265	* may not be active here, so check.
	2266	* Looks like only during compiling the pads are illegal.
	2267	*/
	2268	#ifdef USE_ITHREADS
	2269	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2270	#endif
	2271	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2272	break;
	2273	case OP_GVSV:
	2274	case OP_GV:
	2275	if (cGVOPo_gv && isGV(cGVOPo_gv)) {
	2276	SV * const sv = newSV(0);
	2277	gv_fullname3(sv, cGVOPo_gv, NULL);
	2278	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2279	SvREFCNT_dec_NN(sv);
	2280	}
	2281	else if (cGVOPo_gv) {
	2282	SV * const sv = newSV(0);
	2283	assert(SvROK(cGVOPo_gv));
	2284	assert(SvTYPE(SvRV(cGVOPo_gv)) == SVt_PVCV);
	2285	PerlIO_printf(Perl_debug_log, "(cv ref: %s)",
	2286	SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv,0)));
	2287	SvREFCNT_dec_NN(sv);
	2288	}
	2289	else
	2290	PerlIO_printf(Perl_debug_log, "(NULL)");
	2291	break;
	2292
	2293	case OP_PADSV:
	2294	case OP_PADAV:
	2295	case OP_PADHV:
	2296	count = 1;
	2297	goto dump_padop;
	2298	case OP_PADRANGE:
	2299	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2300	dump_padop:
	2301	/* print the lexical's name */
	2302	{
	2303	CV * const cv = deb_curcv(cxstack_ix);
	2304	SV *sv;
	2305	PAD * comppad = NULL;
	2306	int i;
	2307
	2308	if (cv) {
	2309	PADLIST * const padlist = CvPADLIST(cv);
	2310	comppad = *PadlistARRAY(padlist);
	2311	}
	2312	PerlIO_printf(Perl_debug_log, "(");
	2313	for (i = 0; i < count; i++) {
	2314	if (comppad &&
	2315	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2316	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2317	else
	2318	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2319	(UV)o->op_targ+i);
	2320	if (i < count-1)
	2321	PerlIO_printf(Perl_debug_log, ",");
	2322	}
	2323	PerlIO_printf(Perl_debug_log, ")");
	2324	}
	2325	break;
	2326
	2327	default:
	2328	break;
	2329	}
	2330	PerlIO_printf(Perl_debug_log, "\n");
	2331	return 0;
	2332	}
	2333
	2334	STATIC CV*
	2335	S_deb_curcv(pTHX_ const I32 ix)
	2336	{
	2337	const PERL_CONTEXT * const cx = &cxstack[ix];
	2338	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2339	return cx->blk_sub.cv;
	2340	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2341	return cx->blk_eval.cv;
	2342	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2343	return PL_main_cv;
	2344	else if (ix <= 0)
	2345	return NULL;
	2346	else
	2347	return deb_curcv(ix - 1);
	2348	}
	2349
	2350	void
	2351	Perl_watch(pTHX_ char **addr)
	2352	{
	2353	PERL_ARGS_ASSERT_WATCH;
	2354
	2355	PL_watchaddr = addr;
	2356	PL_watchok = *addr;
	2357	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2358	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2359	}
	2360
	2361	STATIC void
	2362	S_debprof(pTHX_ const OP *o)
	2363	{
	2364	PERL_ARGS_ASSERT_DEBPROF;
	2365
	2366	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2367	return;
	2368	if (!PL_profiledata)
	2369	Newxz(PL_profiledata, MAXO, U32);
	2370	++PL_profiledata[o->op_type];
	2371	}
	2372
	2373	void
	2374	Perl_debprofdump(pTHX)
	2375	{
	2376	unsigned i;
	2377	if (!PL_profiledata)
	2378	return;
	2379	for (i = 0; i < MAXO; i++) {
	2380	if (PL_profiledata[i])
	2381	PerlIO_printf(Perl_debug_log,
	2382	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2383	PL_op_name[i]);
	2384	}
	2385	}
	2386
	2387
	2388	/*
	2389	* Local variables:
	2390	* c-indentation-style: bsd
	2391	* c-basic-offset: 4
	2392	* indent-tabs-mode: nil
	2393	* End:
	2394	*
	2395	* ex: set ts=8 sts=4 sw=4 et:
	2396	*/