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
	25	#include "EXTERN.h"
	26	#define PERL_IN_DUMP_C
	27	#include "perl.h"
	28	#include "regcomp.h"
	29
	30	static const char* const svtypenames[SVt_LAST] = {
	31	"NULL",
	32	"IV",
	33	"NV",
	34	"PV",
	35	"INVLIST",
	36	"PVIV",
	37	"PVNV",
	38	"PVMG",
	39	"REGEXP",
	40	"PVGV",
	41	"PVLV",
	42	"PVAV",
	43	"PVHV",
	44	"PVCV",
	45	"PVFM",
	46	"PVIO"
	47	};
	48
	49
	50	static const char* const svshorttypenames[SVt_LAST] = {
	51	"UNDEF",
	52	"IV",
	53	"NV",
	54	"PV",
	55	"INVLST",
	56	"PVIV",
	57	"PVNV",
	58	"PVMG",
	59	"REGEXP",
	60	"GV",
	61	"PVLV",
	62	"AV",
	63	"HV",
	64	"CV",
	65	"FM",
	66	"IO"
	67	};
	68
	69	struct flag_to_name {
	70	U32 flag;
	71	const char *name;
	72	};
	73
	74	static void
	75	S_append_flags(pTHX_ SV sv, U32 flags, const struct flag_to_name start,
	76	const struct flag_to_name *const end)
	77	{
	78	do {
	79	if (flags & start->flag)
	80	sv_catpv(sv, start->name);
	81	} while (++start < end);
	82	}
	83
	84	#define append_flags(sv, f, flags) \
	85	S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
	86
	87
	88
	89	void
	90	Perl_dump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	91	{
	92	va_list args;
	93	PERL_ARGS_ASSERT_DUMP_INDENT;
	94	va_start(args, pat);
	95	dump_vindent(level, file, pat, &args);
	96	va_end(args);
	97	}
	98
	99	void
	100	Perl_dump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	101	{
	102	dVAR;
	103	PERL_ARGS_ASSERT_DUMP_VINDENT;
	104	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	105	PerlIO_vprintf(file, pat, *args);
	106	}
	107
	108	void
	109	Perl_dump_all(pTHX)
	110	{
	111	dump_all_perl(FALSE);
	112	}
	113
	114	void
	115	Perl_dump_all_perl(pTHX_ bool justperl)
	116	{
	117
	118	dVAR;
	119	PerlIO_setlinebuf(Perl_debug_log);
	120	if (PL_main_root)
	121	op_dump(PL_main_root);
	122	dump_packsubs_perl(PL_defstash, justperl);
	123	}
	124
	125	void
	126	Perl_dump_packsubs(pTHX_ const HV *stash)
	127	{
	128	PERL_ARGS_ASSERT_DUMP_PACKSUBS;
	129	dump_packsubs_perl(stash, FALSE);
	130	}
	131
	132	void
	133	Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	134	{
	135	dVAR;
	136	I32 i;
	137
	138	PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
	139
	140	if (!HvARRAY(stash))
	141	return;
	142	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	143	const HE *entry;
	144	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	145	const GV * const gv = (const GV *)HeVAL(entry);
	146	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	147	continue;
	148	if (GvCVu(gv))
	149	dump_sub_perl(gv, justperl);
	150	if (GvFORM(gv))
	151	dump_form(gv);
	152	if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
	153	const HV * const hv = GvHV(gv);
	154	if (hv && (hv != PL_defstash))
	155	dump_packsubs_perl(hv, justperl); /* nested package */
	156	}
	157	}
	158	}
	159	}
	160
	161	void
	162	Perl_dump_sub(pTHX_ const GV *gv)
	163	{
	164	PERL_ARGS_ASSERT_DUMP_SUB;
	165	dump_sub_perl(gv, FALSE);
	166	}
	167
	168	void
	169	Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
	170	{
	171	SV * sv;
	172
	173	PERL_ARGS_ASSERT_DUMP_SUB_PERL;
	174
	175	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	176	return;
	177
	178	sv = sv_newmortal();
	179	gv_fullname3(sv, gv, NULL);
	180	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
	181	if (CvISXSUB(GvCV(gv)))
	182	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
	183	PTR2UV(CvXSUB(GvCV(gv))),
	184	(int)CvXSUBANY(GvCV(gv)).any_i32);
	185	else if (CvROOT(GvCV(gv)))
	186	op_dump(CvROOT(GvCV(gv)));
	187	else
	188	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	189	}
	190
	191	void
	192	Perl_dump_form(pTHX_ const GV *gv)
	193	{
	194	SV * const sv = sv_newmortal();
	195
	196	PERL_ARGS_ASSERT_DUMP_FORM;
	197
	198	gv_fullname3(sv, gv, NULL);
	199	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
	200	if (CvROOT(GvFORM(gv)))
	201	op_dump(CvROOT(GvFORM(gv)));
	202	else
	203	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	204	}
	205
	206	void
	207	Perl_dump_eval(pTHX)
	208	{
	209	dVAR;
	210	op_dump(PL_eval_root);
	211	}
	212
	213
	214	/*
	215	=for apidoc pv_escape
	216
	217	Escapes at most the first "count" chars of pv and puts the results into
	218	dsv such that the size of the escaped string will not exceed "max" chars
	219	and will not contain any incomplete escape sequences.
	220
	221	If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
	222	will also be escaped.
	223
	224	Normally the SV will be cleared before the escaped string is prepared,
	225	but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
	226
	227	If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
	228	if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
	229	using C<is_utf8_string()> to determine if it is Unicode.
	230
	231	If PERL_PV_ESCAPE_ALL is set then all input chars will be output
	232	using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
	233	chars above 127 will be escaped using this style; otherwise, only chars above
	234	255 will be so escaped; other non printable chars will use octal or
	235	common escaped patterns like C<\n>. Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
	236	then all chars below 255 will be treated as printable and
	237	will be output as literals.
	238
	239	If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
	240	string will be escaped, regardless of max. If the output is to be in hex,
	241	then it will be returned as a plain hex
	242	sequence. Thus the output will either be a single char,
	243	an octal escape sequence, a special escape like C<\n> or a hex value.
	244
	245	If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
	246	not a '\\'. This is because regexes very often contain backslashed
	247	sequences, whereas '%' is not a particularly common character in patterns.
	248
	249	Returns a pointer to the escaped text as held by dsv.
	250
	251	=cut
	252	*/
	253	#define PV_ESCAPE_OCTBUFSIZE 32
	254
	255	char *
	256	Perl_pv_escape( pTHX_ SV dsv, char const const str,
	257	const STRLEN count, const STRLEN max,
	258	STRLEN * const escaped, const U32 flags )
	259	{
	260	const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
	261	const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
	262	char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
	263	STRLEN wrote = 0; /* chars written so far */
	264	STRLEN chsize = 0; /* size of data to be written */
	265	STRLEN readsize = 1; /* size of data just read */
	266	bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
	267	const char *pv = str;
	268	const char * const end = pv + count; /* end of string */
	269	octbuf[0] = esc;
	270
	271	PERL_ARGS_ASSERT_PV_ESCAPE;
	272
	273	if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
	274	/* This won't alter the UTF-8 flag */
	275	sv_setpvs(dsv, "");
	276	}
	277
	278	if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
	279	isuni = 1;
	280
	281	for ( ; (pv < end && (!max \|\| (wrote < max))) ; pv += readsize ) {
	282	const UV u= (isuni) ? utf8_to_uvchr_buf((U8)pv, (U8) end, &readsize) : (U8)*pv;
	283	const U8 c = (U8)u & 0xFF;
	284
	285	if ( ( u > 255 )
	286	\|\| (flags & PERL_PV_ESCAPE_ALL)
	287	\|\| (( u > 127 ) && (flags & PERL_PV_ESCAPE_NONASCII)))
	288	{
	289	if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
	290	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	291	"%"UVxf, u);
	292	else
	293	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	294	"%cx{%"UVxf"}", esc, u);
	295	} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
	296	chsize = 1;
	297	} else {
	298	if ( (c == dq) \|\| (c == esc) \|\| !isPRINT(c) ) {
	299	chsize = 2;
	300	switch (c) {
	301
	302	case '\\' : /* fallthrough */
	303	case '%' : if ( c == esc ) {
	304	octbuf[1] = esc;
	305	} else {
	306	chsize = 1;
	307	}
	308	break;
	309	case '\v' : octbuf[1] = 'v'; break;
	310	case '\t' : octbuf[1] = 't'; break;
	311	case '\r' : octbuf[1] = 'r'; break;
	312	case '\n' : octbuf[1] = 'n'; break;
	313	case '\f' : octbuf[1] = 'f'; break;
	314	case '"' :
	315	if ( dq == '"' )
	316	octbuf[1] = '"';
	317	else
	318	chsize = 1;
	319	break;
	320	default:
	321	if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
	322	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	323	"%c%03o", esc, c);
	324	else
	325	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	326	"%c%o", esc, c);
	327	}
	328	} else {
	329	chsize = 1;
	330	}
	331	}
	332	if ( max && (wrote + chsize > max) ) {
	333	break;
	334	} else if (chsize > 1) {
	335	sv_catpvn(dsv, octbuf, chsize);
	336	wrote += chsize;
	337	} else {
	338	/* If PERL_PV_ESCAPE_NOBACKSLASH is set then bytes in the range
	339	128-255 can be appended raw to the dsv. If dsv happens to be
	340	UTF-8 then we need catpvf to upgrade them for us.
	341	Or add a new API call sv_catpvc(). Think about that name, and
	342	how to keep it clear that it's unlike the s of catpvs, which is
	343	really an array octets, not a string. */
	344	Perl_sv_catpvf( aTHX_ dsv, "%c", c);
	345	wrote++;
	346	}
	347	if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
	348	break;
	349	}
	350	if (escaped != NULL)
	351	*escaped= pv - str;
	352	return SvPVX(dsv);
	353	}
	354	/*
	355	=for apidoc pv_pretty
	356
	357	Converts a string into something presentable, handling escaping via
	358	pv_escape() and supporting quoting and ellipses.
	359
	360	If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
	361	double quoted with any double quotes in the string escaped. Otherwise
	362	if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
	363	angle brackets.
	364
	365	If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
	366	string were output then an ellipsis C<...> will be appended to the
	367	string. Note that this happens AFTER it has been quoted.
	368
	369	If start_color is non-null then it will be inserted after the opening
	370	quote (if there is one) but before the escaped text. If end_color
	371	is non-null then it will be inserted after the escaped text but before
	372	any quotes or ellipses.
	373
	374	Returns a pointer to the prettified text as held by dsv.
	375
	376	=cut
	377	*/
	378
	379	char *
	380	Perl_pv_pretty( pTHX_ SV dsv, char const const str, const STRLEN count,
	381	const STRLEN max, char const * const start_color, char const * const end_color,
	382	const U32 flags )
	383	{
	384	const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
	385	STRLEN escaped;
	386
	387	PERL_ARGS_ASSERT_PV_PRETTY;
	388
	389	if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
	390	/* This won't alter the UTF-8 flag */
	391	sv_setpvs(dsv, "");
	392	}
	393
	394	if ( dq == '"' )
	395	sv_catpvs(dsv, "\"");
	396	else if ( flags & PERL_PV_PRETTY_LTGT )
	397	sv_catpvs(dsv, "<");
	398
	399	if ( start_color != NULL )
	400	sv_catpv(dsv, start_color);
	401
	402	pv_escape( dsv, str, count, max, &escaped, flags \| PERL_PV_ESCAPE_NOCLEAR );
	403
	404	if ( end_color != NULL )
	405	sv_catpv(dsv, end_color);
	406
	407	if ( dq == '"' )
	408	sv_catpvs( dsv, "\"");
	409	else if ( flags & PERL_PV_PRETTY_LTGT )
	410	sv_catpvs(dsv, ">");
	411
	412	if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
	413	sv_catpvs(dsv, "...");
	414
	415	return SvPVX(dsv);
	416	}
	417
	418	/*
	419	=for apidoc pv_display
	420
	421	Similar to
	422
	423	pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
	424
	425	except that an additional "\0" will be appended to the string when
	426	len > cur and pv[cur] is "\0".
	427
	428	Note that the final string may be up to 7 chars longer than pvlim.
	429
	430	=cut
	431	*/
	432
	433	char *
	434	Perl_pv_display(pTHX_ SV dsv, const char pv, STRLEN cur, STRLEN len, STRLEN pvlim)
	435	{
	436	PERL_ARGS_ASSERT_PV_DISPLAY;
	437
	438	pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
	439	if (len > cur && pv[cur] == '\0')
	440	sv_catpvs( dsv, "\\0");
	441	return SvPVX(dsv);
	442	}
	443
	444	char *
	445	Perl_sv_peek(pTHX_ SV *sv)
	446	{
	447	dVAR;
	448	SV * const t = sv_newmortal();
	449	int unref = 0;
	450	U32 type;
	451
	452	sv_setpvs(t, "");
	453	retry:
	454	if (!sv) {
	455	sv_catpv(t, "VOID");
	456	goto finish;
	457	}
	458	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	459	/* detect data corruption under memory poisoning */
	460	sv_catpv(t, "WILD");
	461	goto finish;
	462	}
	463	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	464	if (sv == &PL_sv_undef) {
	465	sv_catpv(t, "SV_UNDEF");
	466	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	467	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	468	SvREADONLY(sv))
	469	goto finish;
	470	}
	471	else if (sv == &PL_sv_no) {
	472	sv_catpv(t, "SV_NO");
	473	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	474	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	475	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	476	SVp_POK\|SVp_NOK)) &&
	477	SvCUR(sv) == 0 &&
	478	SvNVX(sv) == 0.0)
	479	goto finish;
	480	}
	481	else if (sv == &PL_sv_yes) {
	482	sv_catpv(t, "SV_YES");
	483	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	484	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	485	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	486	SVp_POK\|SVp_NOK)) &&
	487	SvCUR(sv) == 1 &&
	488	SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
	489	SvNVX(sv) == 1.0)
	490	goto finish;
	491	}
	492	else {
	493	sv_catpv(t, "SV_PLACEHOLDER");
	494	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	495	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	496	SvREADONLY(sv))
	497	goto finish;
	498	}
	499	sv_catpv(t, ":");
	500	}
	501	else if (SvREFCNT(sv) == 0) {
	502	sv_catpv(t, "(");
	503	unref++;
	504	}
	505	else if (DEBUG_R_TEST_) {
	506	int is_tmp = 0;
	507	I32 ix;
	508	/* is this SV on the tmps stack? */
	509	for (ix=PL_tmps_ix; ix>=0; ix--) {
	510	if (PL_tmps_stack[ix] == sv) {
	511	is_tmp = 1;
	512	break;
	513	}
	514	}
	515	if (SvREFCNT(sv) > 1)
	516	Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
	517	is_tmp ? "T" : "");
	518	else if (is_tmp)
	519	sv_catpv(t, "<T>");
	520	}
	521
	522	if (SvROK(sv)) {
	523	sv_catpv(t, "\\");
	524	if (SvCUR(t) + unref > 10) {
	525	SvCUR_set(t, unref + 3);
	526	*SvEND(t) = '\0';
	527	sv_catpv(t, "...");
	528	goto finish;
	529	}
	530	sv = SvRV(sv);
	531	goto retry;
	532	}
	533	type = SvTYPE(sv);
	534	if (type == SVt_PVCV) {
	535	Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
	536	goto finish;
	537	} else if (type < SVt_LAST) {
	538	sv_catpv(t, svshorttypenames[type]);
	539
	540	if (type == SVt_NULL)
	541	goto finish;
	542	} else {
	543	sv_catpv(t, "FREED");
	544	goto finish;
	545	}
	546
	547	if (SvPOKp(sv)) {
	548	if (!SvPVX_const(sv))
	549	sv_catpv(t, "(null)");
	550	else {
	551	SV * const tmp = newSVpvs("");
	552	sv_catpv(t, "(");
	553	if (SvOOK(sv)) {
	554	STRLEN delta;
	555	SvOOK_offset(sv, delta);
	556	Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
	557	}
	558	Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
	559	if (SvUTF8(sv))
	560	Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
	561	sv_uni_display(tmp, sv, 6 * SvCUR(sv),
	562	UNI_DISPLAY_QQ));
	563	SvREFCNT_dec_NN(tmp);
	564	}
	565	}
	566	else if (SvNOKp(sv)) {
	567	STORE_NUMERIC_LOCAL_SET_STANDARD();
	568	Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
	569	RESTORE_NUMERIC_LOCAL();
	570	}
	571	else if (SvIOKp(sv)) {
	572	if (SvIsUV(sv))
	573	Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
	574	else
	575	Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
	576	}
	577	else
	578	sv_catpv(t, "()");
	579
	580	finish:
	581	while (unref--)
	582	sv_catpv(t, ")");
	583	if (TAINTING_get && SvTAINTED(sv))
	584	sv_catpv(t, " [tainted]");
	585	return SvPV_nolen(t);
	586	}
	587
	588	void
	589	Perl_do_pmop_dump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	590	{
	591	char ch;
	592
	593	PERL_ARGS_ASSERT_DO_PMOP_DUMP;
	594
	595	if (!pm) {
	596	Perl_dump_indent(aTHX_ level, file, "{}\n");
	597	return;
	598	}
	599	Perl_dump_indent(aTHX_ level, file, "{\n");
	600	level++;
	601	if (pm->op_pmflags & PMf_ONCE)
	602	ch = '?';
	603	else
	604	ch = '/';
	605	if (PM_GETRE(pm))
	606	Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
	607	ch, RX_PRECOMP(PM_GETRE(pm)), ch,
	608	(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
	609	else
	610	Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
	611	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	612	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
	613	op_dump(pm->op_pmreplrootu.op_pmreplroot);
	614	}
	615	if (pm->op_code_list) {
	616	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
	617	Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
	618	do_op_dump(level, file, pm->op_code_list);
	619	}
	620	else
	621	Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
	622	PTR2UV(pm->op_code_list));
	623	}
	624	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	625	SV * const tmpsv = pm_description(pm);
	626	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	627	SvREFCNT_dec_NN(tmpsv);
	628	}
	629
	630	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	631	}
	632
	633	const struct flag_to_name pmflags_flags_names[] = {
	634	{PMf_CONST, ",CONST"},
	635	{PMf_KEEP, ",KEEP"},
	636	{PMf_GLOBAL, ",GLOBAL"},
	637	{PMf_CONTINUE, ",CONTINUE"},
	638	{PMf_RETAINT, ",RETAINT"},
	639	{PMf_EVAL, ",EVAL"},
	640	{PMf_NONDESTRUCT, ",NONDESTRUCT"},
	641	{PMf_HAS_CV, ",HAS_CV"},
	642	{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
	643	{PMf_IS_QR, ",IS_QR"}
	644	};
	645
	646	static SV *
	647	S_pm_description(pTHX_ const PMOP *pm)
	648	{
	649	SV * const desc = newSVpvs("");
	650	const REGEXP * const regex = PM_GETRE(pm);
	651	const U32 pmflags = pm->op_pmflags;
	652
	653	PERL_ARGS_ASSERT_PM_DESCRIPTION;
	654
	655	if (pmflags & PMf_ONCE)
	656	sv_catpv(desc, ",ONCE");
	657	#ifdef USE_ITHREADS
	658	if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
	659	sv_catpv(desc, ":USED");
	660	#else
	661	if (pmflags & PMf_USED)
	662	sv_catpv(desc, ":USED");
	663	#endif
	664
	665	if (regex) {
	666	if (RX_ISTAINTED(regex))
	667	sv_catpv(desc, ",TAINTED");
	668	if (RX_CHECK_SUBSTR(regex)) {
	669	if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
	670	sv_catpv(desc, ",SCANFIRST");
	671	if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
	672	sv_catpv(desc, ",ALL");
	673	}
	674	if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
	675	sv_catpv(desc, ",SKIPWHITE");
	676	}
	677
	678	append_flags(desc, pmflags, pmflags_flags_names);
	679	return desc;
	680	}
	681
	682	void
	683	Perl_pmop_dump(pTHX_ PMOP *pm)
	684	{
	685	do_pmop_dump(0, Perl_debug_log, pm);
	686	}
	687
	688	/* Return a unique integer to represent the address of op o.
	689	* If it already exists in PL_op_sequence, just return it;
	690	* otherwise add it.
	691	* *** Note that this isn't thread-safe */
	692
	693	STATIC UV
	694	S_sequence_num(pTHX_ const OP *o)
	695	{
	696	dVAR;
	697	SV *op,
	698	**seq;
	699	const char *key;
	700	STRLEN len;
	701	if (!o)
	702	return 0;
	703	op = newSVuv(PTR2UV(o));
	704	sv_2mortal(op);
	705	key = SvPV_const(op, len);
	706	if (!PL_op_sequence)
	707	PL_op_sequence = newHV();
	708	seq = hv_fetch(PL_op_sequence, key, len, 0);
	709	if (seq)
	710	return SvUV(*seq);
	711	(void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
	712	return PL_op_seq;
	713	}
	714
	715	const struct flag_to_name op_flags_names[] = {
	716	{OPf_KIDS, ",KIDS"},
	717	{OPf_PARENS, ",PARENS"},
	718	{OPf_REF, ",REF"},
	719	{OPf_MOD, ",MOD"},
	720	{OPf_STACKED, ",STACKED"},
	721	{OPf_SPECIAL, ",SPECIAL"}
	722	};
	723
	724	const struct flag_to_name op_trans_names[] = {
	725	{OPpTRANS_FROM_UTF, ",FROM_UTF"},
	726	{OPpTRANS_TO_UTF, ",TO_UTF"},
	727	{OPpTRANS_IDENTICAL, ",IDENTICAL"},
	728	{OPpTRANS_SQUASH, ",SQUASH"},
	729	{OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
	730	{OPpTRANS_GROWS, ",GROWS"},
	731	{OPpTRANS_DELETE, ",DELETE"}
	732	};
	733
	734	const struct flag_to_name op_entersub_names[] = {
	735	{OPpENTERSUB_DB, ",DB"},
	736	{OPpENTERSUB_HASTARG, ",HASTARG"},
	737	{OPpENTERSUB_AMPER, ",AMPER"},
	738	{OPpENTERSUB_NOPAREN, ",NOPAREN"},
	739	{OPpENTERSUB_INARGS, ",INARGS"}
	740	};
	741
	742	const struct flag_to_name op_const_names[] = {
	743	{OPpCONST_NOVER, ",NOVER"},
	744	{OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
	745	{OPpCONST_STRICT, ",STRICT"},
	746	{OPpCONST_ENTERED, ",ENTERED"},
	747	{OPpCONST_FOLDED, ",FOLDED"},
	748	{OPpCONST_BARE, ",BARE"}
	749	};
	750
	751	const struct flag_to_name op_sort_names[] = {
	752	{OPpSORT_NUMERIC, ",NUMERIC"},
	753	{OPpSORT_INTEGER, ",INTEGER"},
	754	{OPpSORT_REVERSE, ",REVERSE"},
	755	{OPpSORT_INPLACE, ",INPLACE"},
	756	{OPpSORT_DESCEND, ",DESCEND"},
	757	{OPpSORT_QSORT, ",QSORT"},
	758	{OPpSORT_STABLE, ",STABLE"}
	759	};
	760
	761	const struct flag_to_name op_open_names[] = {
	762	{OPpOPEN_IN_RAW, ",IN_RAW"},
	763	{OPpOPEN_IN_CRLF, ",IN_CRLF"},
	764	{OPpOPEN_OUT_RAW, ",OUT_RAW"},
	765	{OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
	766	};
	767
	768	const struct flag_to_name op_exit_names[] = {
	769	{OPpEXIT_VMSISH, ",EXIT_VMSISH"},
	770	{OPpHUSH_VMSISH, ",HUSH_VMSISH"}
	771	};
	772
	773	const struct flag_to_name op_sassign_names[] = {
	774	{OPpASSIGN_BACKWARDS, ",BACKWARDS"},
	775	{OPpASSIGN_CV_TO_GV, ",CV2GV"}
	776	};
	777
	778	#define OP_PRIVATE_ONCE(op, flag, name) \
	779	const struct flag_to_name CAT2(op, _names)[] = { \
	780	{(flag), (name)} \
	781	}
	782
	783	OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
	784	OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
	785	OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
	786	OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
	787	OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
	788	OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
	789	OP_PRIVATE_ONCE(op_list, OPpLIST_GUESSED, ",GUESSED");
	790	OP_PRIVATE_ONCE(op_delete, OPpSLICE, ",SLICE");
	791	OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
	792	OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
	793	OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
	794
	795	struct op_private_by_op {
	796	U16 op_type;
	797	U16 len;
	798	const struct flag_to_name *start;
	799	};
	800
	801	const struct op_private_by_op op_private_names[] = {
	802	{OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
	803	{OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
	804	{OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
	805	{OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
	806	{OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
	807	{OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
	808	{OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
	809	{OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
	810	{OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
	811	{OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
	812	{OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
	813	{OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
	814	{OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
	815	{OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
	816	{OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
	817	{OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
	818	{OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
	819	{OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
	820	{OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
	821	{OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
	822	{OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
	823	};
	824
	825	static bool
	826	S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
	827	const struct op_private_by_op *start = op_private_names;
	828	const struct op_private_by_op *const end
	829	= op_private_names + C_ARRAY_LENGTH(op_private_names);
	830
	831	/* This is a linear search, but no worse than the code that it replaced.
	832	It's debugging code - size is more important than speed. */
	833	do {
	834	if (optype == start->op_type) {
	835	S_append_flags(aTHX_ tmpsv, op_private, start->start,
	836	start->start + start->len);
	837	return TRUE;
	838	}
	839	} while (++start < end);
	840	return FALSE;
	841	}
	842
	843	#define DUMP_OP_FLAGS(o,xml,level,file) \
	844	if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) { \
	845	SV * const tmpsv = newSVpvs(""); \
	846	switch (o->op_flags & OPf_WANT) { \
	847	case OPf_WANT_VOID: \
	848	sv_catpv(tmpsv, ",VOID"); \
	849	break; \
	850	case OPf_WANT_SCALAR: \
	851	sv_catpv(tmpsv, ",SCALAR"); \
	852	break; \
	853	case OPf_WANT_LIST: \
	854	sv_catpv(tmpsv, ",LIST"); \
	855	break; \
	856	default: \
	857	sv_catpv(tmpsv, ",UNKNOWN"); \
	858	break; \
	859	} \
	860	append_flags(tmpsv, o->op_flags, op_flags_names); \
	861	if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
	862	if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
	863	if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
	864	if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED"); \
	865	if (!xml) \
	866	Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
	867	SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
	868	else \
	869	PerlIO_printf(file, " flags=\"%s\"", \
	870	SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
	871	SvREFCNT_dec_NN(tmpsv); \
	872	}
	873
	874	#if !defined(PERL_MAD)
	875	# define xmldump_attr1(level, file, pat, arg)
	876	#else
	877	# define xmldump_attr1(level, file, pat, arg) \
	878	S_xmldump_attr(aTHX_ level, file, pat, arg)
	879	#endif
	880
	881	#define DUMP_OP_PRIVATE(o,xml,level,file) \
	882	if (o->op_private) { \
	883	U32 optype = o->op_type; \
	884	U32 oppriv = o->op_private; \
	885	SV * const tmpsv = newSVpvs(""); \
	886	if (PL_opargs[optype] & OA_TARGLEX) { \
	887	if (oppriv & OPpTARGET_MY) \
	888	sv_catpv(tmpsv, ",TARGET_MY"); \
	889	} \
	890	else if (optype == OP_ENTERSUB \|\| \
	891	optype == OP_RV2SV \|\| \
	892	optype == OP_GVSV \|\| \
	893	optype == OP_RV2AV \|\| \
	894	optype == OP_RV2HV \|\| \
	895	optype == OP_RV2GV \|\| \
	896	optype == OP_AELEM \|\| \
	897	optype == OP_HELEM ) \
	898	{ \
	899	if (optype == OP_ENTERSUB) { \
	900	append_flags(tmpsv, oppriv, op_entersub_names); \
	901	} \
	902	else { \
	903	switch (oppriv & OPpDEREF) { \
	904	case OPpDEREF_SV: \
	905	sv_catpv(tmpsv, ",SV"); \
	906	break; \
	907	case OPpDEREF_AV: \
	908	sv_catpv(tmpsv, ",AV"); \
	909	break; \
	910	case OPpDEREF_HV: \
	911	sv_catpv(tmpsv, ",HV"); \
	912	break; \
	913	} \
	914	if (oppriv & OPpMAYBE_LVSUB) \
	915	sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
	916	} \
	917	if (optype == OP_AELEM \|\| optype == OP_HELEM) { \
	918	if (oppriv & OPpLVAL_DEFER) \
	919	sv_catpv(tmpsv, ",LVAL_DEFER"); \
	920	} \
	921	else if (optype == OP_RV2HV \|\| optype == OP_PADHV) { \
	922	if (oppriv & OPpMAYBE_TRUEBOOL) \
	923	sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
	924	if (oppriv & OPpTRUEBOOL) \
	925	sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
	926	} \
	927	else { \
	928	if (oppriv & HINT_STRICT_REFS) \
	929	sv_catpv(tmpsv, ",STRICT_REFS"); \
	930	if (oppriv & OPpOUR_INTRO) \
	931	sv_catpv(tmpsv, ",OUR_INTRO"); \
	932	} \
	933	} \
	934	else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
	935	} \
	936	else if (OP_IS_FILETEST(o->op_type)) { \
	937	if (oppriv & OPpFT_ACCESS) \
	938	sv_catpv(tmpsv, ",FT_ACCESS"); \
	939	if (oppriv & OPpFT_STACKED) \
	940	sv_catpv(tmpsv, ",FT_STACKED"); \
	941	if (oppriv & OPpFT_STACKING) \
	942	sv_catpv(tmpsv, ",FT_STACKING"); \
	943	if (oppriv & OPpFT_AFTER_t) \
	944	sv_catpv(tmpsv, ",AFTER_t"); \
	945	} \
	946	else if (o->op_type == OP_AASSIGN) { \
	947	if (oppriv & OPpASSIGN_COMMON) \
	948	sv_catpvs(tmpsv, ",COMMON"); \
	949	if (oppriv & OPpMAYBE_LVSUB) \
	950	sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
	951	} \
	952	if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
	953	sv_catpv(tmpsv, ",INTRO"); \
	954	if (o->op_type == OP_PADRANGE) \
	955	Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
	956	(UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
	957	if (SvCUR(tmpsv)) { \
	958	if (xml) \
	959	xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
	960	else \
	961	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
	962	} else if (!xml) \
	963	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
	964	(UV)oppriv); \
	965	SvREFCNT_dec_NN(tmpsv); \
	966	}
	967
	968
	969	void
	970	Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
	971	{
	972	dVAR;
	973	UV seq;
	974	const OPCODE optype = o->op_type;
	975
	976	PERL_ARGS_ASSERT_DO_OP_DUMP;
	977
	978	Perl_dump_indent(aTHX_ level, file, "{\n");
	979	level++;
	980	seq = sequence_num(o);
	981	if (seq)
	982	PerlIO_printf(file, "%-4"UVuf, seq);
	983	else
	984	PerlIO_printf(file, "????");
	985	PerlIO_printf(file,
	986	"%*sTYPE = %s ===> ",
	987	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
	988	if (o->op_next)
	989	PerlIO_printf(file,
	990	o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
	991	sequence_num(o->op_next));
	992	else
	993	PerlIO_printf(file, "NULL\n");
	994	if (o->op_targ) {
	995	if (optype == OP_NULL) {
	996	Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
	997	if (o->op_targ == OP_NEXTSTATE) {
	998	if (CopLINE(cCOPo))
	999	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	1000	(UV)CopLINE(cCOPo));
	1001	if (CopSTASHPV(cCOPo))
	1002	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	1003	CopSTASHPV(cCOPo));
	1004	if (CopLABEL(cCOPo))
	1005	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	1006	CopLABEL(cCOPo));
	1007	}
	1008	}
	1009	else
	1010	Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
	1011	}
	1012	#ifdef DUMPADDR
	1013	Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
	1014	#endif
	1015
	1016	DUMP_OP_FLAGS(o,0,level,file);
	1017	DUMP_OP_PRIVATE(o,0,level,file);
	1018
	1019	#ifdef PERL_MAD
	1020	if (PL_madskills && o->op_madprop) {
	1021	SV * const tmpsv = newSVpvs("");
	1022	MADPROP* mp = o->op_madprop;
	1023	Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
	1024	level++;
	1025	while (mp) {
	1026	const char tmp = mp->mad_key;
	1027	sv_setpvs(tmpsv,"'");
	1028	if (tmp)
	1029	sv_catpvn(tmpsv, &tmp, 1);
	1030	sv_catpv(tmpsv, "'=");
	1031	switch (mp->mad_type) {
	1032	case MAD_NULL:
	1033	sv_catpv(tmpsv, "NULL");
	1034	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1035	break;
	1036	case MAD_PV:
	1037	sv_catpv(tmpsv, "<");
	1038	sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
	1039	sv_catpv(tmpsv, ">");
	1040	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1041	break;
	1042	case MAD_OP:
	1043	if ((OP*)mp->mad_val) {
	1044	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1045	do_op_dump(level, file, (OP*)mp->mad_val);
	1046	}
	1047	break;
	1048	default:
	1049	sv_catpv(tmpsv, "(UNK)");
	1050	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1051	break;
	1052	}
	1053	mp = mp->mad_next;
	1054	}
	1055	level--;
	1056	Perl_dump_indent(aTHX_ level, file, "}\n");
	1057
	1058	SvREFCNT_dec_NN(tmpsv);
	1059	}
	1060	#endif
	1061
	1062	switch (optype) {
	1063	case OP_AELEMFAST:
	1064	case OP_GVSV:
	1065	case OP_GV:
	1066	#ifdef USE_ITHREADS
	1067	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
	1068	#else
	1069	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
	1070	if (cSVOPo->op_sv) {
	1071	SV * const tmpsv = newSV(0);
	1072	ENTER;
	1073	SAVEFREESV(tmpsv);
	1074	#ifdef PERL_MAD
	1075	/* FIXME - is this making unwarranted assumptions about the
	1076	UTF-8 cleanliness of the dump file handle? */
	1077	SvUTF8_on(tmpsv);
	1078	#endif
	1079	gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
	1080	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
	1081	SvPV_nolen_const(tmpsv));
	1082	LEAVE;
	1083	}
	1084	else
	1085	Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
	1086	}
	1087	#endif
	1088	break;
	1089	case OP_CONST:
	1090	case OP_HINTSEVAL:
	1091	case OP_METHOD_NAMED:
	1092	#ifndef USE_ITHREADS
	1093	/* with ITHREADS, consts are stored in the pad, and the right pad
	1094	* may not be active here, so skip */
	1095	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
	1096	#endif
	1097	break;
	1098	case OP_NEXTSTATE:
	1099	case OP_DBSTATE:
	1100	if (CopLINE(cCOPo))
	1101	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	1102	(UV)CopLINE(cCOPo));
	1103	if (CopSTASHPV(cCOPo))
	1104	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	1105	CopSTASHPV(cCOPo));
	1106	if (CopLABEL(cCOPo))
	1107	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	1108	CopLABEL(cCOPo));
	1109	break;
	1110	case OP_ENTERLOOP:
	1111	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
	1112	if (cLOOPo->op_redoop)
	1113	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
	1114	else
	1115	PerlIO_printf(file, "DONE\n");
	1116	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
	1117	if (cLOOPo->op_nextop)
	1118	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
	1119	else
	1120	PerlIO_printf(file, "DONE\n");
	1121	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
	1122	if (cLOOPo->op_lastop)
	1123	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
	1124	else
	1125	PerlIO_printf(file, "DONE\n");
	1126	break;
	1127	case OP_COND_EXPR:
	1128	case OP_RANGE:
	1129	case OP_MAPWHILE:
	1130	case OP_GREPWHILE:
	1131	case OP_OR:
	1132	case OP_AND:
	1133	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
	1134	if (cLOGOPo->op_other)
	1135	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
	1136	else
	1137	PerlIO_printf(file, "DONE\n");
	1138	break;
	1139	case OP_PUSHRE:
	1140	case OP_MATCH:
	1141	case OP_QR:
	1142	case OP_SUBST:
	1143	do_pmop_dump(level, file, cPMOPo);
	1144	break;
	1145	case OP_LEAVE:
	1146	case OP_LEAVEEVAL:
	1147	case OP_LEAVESUB:
	1148	case OP_LEAVESUBLV:
	1149	case OP_LEAVEWRITE:
	1150	case OP_SCOPE:
	1151	if (o->op_private & OPpREFCOUNTED)
	1152	Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
	1153	break;
	1154	default:
	1155	break;
	1156	}
	1157	if (o->op_flags & OPf_KIDS) {
	1158	OP *kid;
	1159	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	1160	do_op_dump(level, file, kid);
	1161	}
	1162	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	1163	}
	1164
	1165	void
	1166	Perl_op_dump(pTHX_ const OP *o)
	1167	{
	1168	PERL_ARGS_ASSERT_OP_DUMP;
	1169	do_op_dump(0, Perl_debug_log, o);
	1170	}
	1171
	1172	void
	1173	Perl_gv_dump(pTHX_ GV *gv)
	1174	{
	1175	SV *sv;
	1176
	1177	PERL_ARGS_ASSERT_GV_DUMP;
	1178
	1179	if (!gv) {
	1180	PerlIO_printf(Perl_debug_log, "{}\n");
	1181	return;
	1182	}
	1183	sv = sv_newmortal();
	1184	PerlIO_printf(Perl_debug_log, "{\n");
	1185	gv_fullname3(sv, gv, NULL);
	1186	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
	1187	if (gv != GvEGV(gv)) {
	1188	gv_efullname3(sv, GvEGV(gv), NULL);
	1189	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
	1190	}
	1191	PerlIO_putc(Perl_debug_log, '\n');
	1192	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
	1193	}
	1194
	1195
	1196	/* map magic types to the symbolic names
	1197	* (with the PERL_MAGIC_ prefixed stripped)
	1198	*/
	1199
	1200	static const struct { const char type; const char *name; } magic_names[] = {
	1201	#include "mg_names.c"
	1202	/* this null string terminates the list */
	1203	{ 0, NULL },
	1204	};
	1205
	1206	void
	1207	Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1208	{
	1209	PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
	1210
	1211	for (; mg; mg = mg->mg_moremagic) {
	1212	Perl_dump_indent(aTHX_ level, file,
	1213	" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
	1214	if (mg->mg_virtual) {
	1215	const MGVTBL * const v = mg->mg_virtual;
	1216	if (v >= PL_magic_vtables
	1217	&& v < PL_magic_vtables + magic_vtable_max) {
	1218	const U32 i = v - PL_magic_vtables;
	1219	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
	1220	}
	1221	else
	1222	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
	1223	}
	1224	else
	1225	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
	1226
	1227	if (mg->mg_private)
	1228	Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
	1229
	1230	{
	1231	int n;
	1232	const char *name = NULL;
	1233	for (n = 0; magic_names[n].name; n++) {
	1234	if (mg->mg_type == magic_names[n].type) {
	1235	name = magic_names[n].name;
	1236	break;
	1237	}
	1238	}
	1239	if (name)
	1240	Perl_dump_indent(aTHX_ level, file,
	1241	" MG_TYPE = PERL_MAGIC_%s\n", name);
	1242	else
	1243	Perl_dump_indent(aTHX_ level, file,
	1244	" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
	1245	}
	1246
	1247	if (mg->mg_flags) {
	1248	Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
	1249	if (mg->mg_type == PERL_MAGIC_envelem &&
	1250	mg->mg_flags & MGf_TAINTEDDIR)
	1251	Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
	1252	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1253	mg->mg_flags & MGf_MINMATCH)
	1254	Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
	1255	if (mg->mg_flags & MGf_REFCOUNTED)
	1256	Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
	1257	if (mg->mg_flags & MGf_GSKIP)
	1258	Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
	1259	if (mg->mg_flags & MGf_COPY)
	1260	Perl_dump_indent(aTHX_ level, file, " COPY\n");
	1261	if (mg->mg_flags & MGf_DUP)
	1262	Perl_dump_indent(aTHX_ level, file, " DUP\n");
	1263	if (mg->mg_flags & MGf_LOCAL)
	1264	Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
	1265	}
	1266	if (mg->mg_obj) {
	1267	Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
	1268	PTR2UV(mg->mg_obj));
	1269	if (mg->mg_type == PERL_MAGIC_qr) {
	1270	REGEXP* const re = (REGEXP *)mg->mg_obj;
	1271	SV * const dsv = sv_newmortal();
	1272	const char * const s
	1273	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
	1274	60, NULL, NULL,
	1275	( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
	1276	(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
	1277	);
	1278	Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
	1279	Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
	1280	(IV)RX_REFCNT(re));
	1281	}
	1282	if (mg->mg_flags & MGf_REFCOUNTED)
	1283	do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
	1284	}
	1285	if (mg->mg_len)
	1286	Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
	1287	if (mg->mg_ptr) {
	1288	Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
	1289	if (mg->mg_len >= 0) {
	1290	if (mg->mg_type != PERL_MAGIC_utf8) {
	1291	SV * const sv = newSVpvs("");
	1292	PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
	1293	SvREFCNT_dec_NN(sv);
	1294	}
	1295	}
	1296	else if (mg->mg_len == HEf_SVKEY) {
	1297	PerlIO_puts(file, " => HEf_SVKEY\n");
	1298	do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
	1299	maxnest, dumpops, pvlim); /* MG is already +1 */
	1300	continue;
	1301	}
	1302	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1303	else
	1304	PerlIO_puts(
	1305	file,
	1306	" ???? - " __FILE__
	1307	" does not know how to handle this MG_LEN"
	1308	);
	1309	PerlIO_putc(file, '\n');
	1310	}
	1311	if (mg->mg_type == PERL_MAGIC_utf8) {
	1312	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1313	if (cache) {
	1314	IV i;
	1315	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1316	Perl_dump_indent(aTHX_ level, file,
	1317	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1318	i,
	1319	(UV)cache[i * 2],
	1320	(UV)cache[i * 2 + 1]);
	1321	}
	1322	}
	1323	}
	1324	}
	1325
	1326	void
	1327	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1328	{
	1329	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1330	}
	1331
	1332	void
	1333	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1334	{
	1335	const char *hvname;
	1336
	1337	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1338
	1339	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1340	if (sv && (hvname = HvNAME_get(sv)))
	1341	{
	1342	/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
	1343	name which quite legally could contain insane things like tabs, newlines, nulls or
	1344	other scary crap - this should produce sane results - except maybe for unicode package
	1345	names - but we will wait for someone to file a bug on that - demerphq */
	1346	SV * const tmpsv = newSVpvs("");
	1347	PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
	1348	}
	1349	else
	1350	PerlIO_putc(file, '\n');
	1351	}
	1352
	1353	void
	1354	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1355	{
	1356	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1357
	1358	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1359	if (sv && GvNAME(sv))
	1360	PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
	1361	else
	1362	PerlIO_putc(file, '\n');
	1363	}
	1364
	1365	void
	1366	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1367	{
	1368	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1369
	1370	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1371	if (sv && GvNAME(sv)) {
	1372	const char *hvname;
	1373	PerlIO_printf(file, "\t\"");
	1374	if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
	1375	PerlIO_printf(file, "%s\" :: \"", hvname);
	1376	PerlIO_printf(file, "%s\"\n", GvNAME(sv));
	1377	}
	1378	else
	1379	PerlIO_putc(file, '\n');
	1380	}
	1381
	1382	const struct flag_to_name first_sv_flags_names[] = {
	1383	{SVs_TEMP, "TEMP,"},
	1384	{SVs_OBJECT, "OBJECT,"},
	1385	{SVs_GMG, "GMG,"},
	1386	{SVs_SMG, "SMG,"},
	1387	{SVs_RMG, "RMG,"},
	1388	{SVf_IOK, "IOK,"},
	1389	{SVf_NOK, "NOK,"},
	1390	{SVf_POK, "POK,"}
	1391	};
	1392
	1393	const struct flag_to_name second_sv_flags_names[] = {
	1394	{SVf_OOK, "OOK,"},
	1395	{SVf_FAKE, "FAKE,"},
	1396	{SVf_READONLY, "READONLY,"},
	1397	{SVf_IsCOW, "IsCOW,"},
	1398	{SVf_BREAK, "BREAK,"},
	1399	{SVf_AMAGIC, "OVERLOAD,"},
	1400	{SVp_IOK, "pIOK,"},
	1401	{SVp_NOK, "pNOK,"},
	1402	{SVp_POK, "pPOK,"}
	1403	};
	1404
	1405	const struct flag_to_name cv_flags_names[] = {
	1406	{CVf_ANON, "ANON,"},
	1407	{CVf_UNIQUE, "UNIQUE,"},
	1408	{CVf_CLONE, "CLONE,"},
	1409	{CVf_CLONED, "CLONED,"},
	1410	{CVf_CONST, "CONST,"},
	1411	{CVf_NODEBUG, "NODEBUG,"},
	1412	{CVf_LVALUE, "LVALUE,"},
	1413	{CVf_METHOD, "METHOD,"},
	1414	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1415	{CVf_CVGV_RC, "CVGV_RC,"},
	1416	{CVf_DYNFILE, "DYNFILE,"},
	1417	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1418	{CVf_HASEVAL, "HASEVAL"},
	1419	{CVf_SLABBED, "SLABBED,"},
	1420	{CVf_ISXSUB, "ISXSUB,"}
	1421	};
	1422
	1423	const struct flag_to_name hv_flags_names[] = {
	1424	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1425	{SVphv_LAZYDEL, "LAZYDEL,"},
	1426	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	1427	{SVphv_CLONEABLE, "CLONEABLE,"}
	1428	};
	1429
	1430	const struct flag_to_name gp_flags_names[] = {
	1431	{GVf_INTRO, "INTRO,"},
	1432	{GVf_MULTI, "MULTI,"},
	1433	{GVf_ASSUMECV, "ASSUMECV,"},
	1434	{GVf_IN_PAD, "IN_PAD,"}
	1435	};
	1436
	1437	const struct flag_to_name gp_flags_imported_names[] = {
	1438	{GVf_IMPORTED_SV, " SV"},
	1439	{GVf_IMPORTED_AV, " AV"},
	1440	{GVf_IMPORTED_HV, " HV"},
	1441	{GVf_IMPORTED_CV, " CV"},
	1442	};
	1443
	1444	const struct flag_to_name regexp_flags_names[] = {
	1445	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1446	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1447	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1448	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1449	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1450	{RXf_ANCH_BOL, "ANCH_BOL,"},
	1451	{RXf_ANCH_MBOL, "ANCH_MBOL,"},
	1452	{RXf_ANCH_SBOL, "ANCH_SBOL,"},
	1453	{RXf_ANCH_GPOS, "ANCH_GPOS,"},
	1454	{RXf_GPOS_SEEN, "GPOS_SEEN,"},
	1455	{RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1456	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1457	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1458	{RXf_CANY_SEEN, "CANY_SEEN,"},
	1459	{RXf_NOSCAN, "NOSCAN,"},
	1460	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1461	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1462	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1463	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1464	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1465	{RXf_SPLIT, "SPLIT,"},
	1466	{RXf_COPY_DONE, "COPY_DONE,"},
	1467	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1468	{RXf_TAINTED, "TAINTED,"},
	1469	{RXf_START_ONLY, "START_ONLY,"},
	1470	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1471	{RXf_WHITE, "WHITE,"},
	1472	{RXf_NULL, "NULL,"},
	1473	};
	1474
	1475	void
	1476	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1477	{
	1478	dVAR;
	1479	SV *d;
	1480	const char *s;
	1481	U32 flags;
	1482	U32 type;
	1483
	1484	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1485
	1486	if (!sv) {
	1487	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1488	return;
	1489	}
	1490
	1491	flags = SvFLAGS(sv);
	1492	type = SvTYPE(sv);
	1493
	1494	/* process general SV flags */
	1495
	1496	d = Perl_newSVpvf(aTHX_
	1497	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1498	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1499	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1500	(int)(PL_dumpindent*level), "");
	1501
	1502	if (!((flags & SVpad_NAME) == SVpad_NAME
	1503	&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1504	if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
	1505	sv_catpv(d, "PADSTALE,");
	1506	}
	1507	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
	1508	if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
	1509	sv_catpv(d, "PADTMP,");
	1510	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
	1511	}
	1512	append_flags(d, flags, first_sv_flags_names);
	1513	if (flags & SVf_ROK) {
	1514	sv_catpv(d, "ROK,");
	1515	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1516	}
	1517	append_flags(d, flags, second_sv_flags_names);
	1518	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
	1519	if (SvPCS_IMPORTED(sv))
	1520	sv_catpv(d, "PCS_IMPORTED,");
	1521	else
	1522	sv_catpv(d, "SCREAM,");
	1523	}
	1524
	1525	/* process type-specific SV flags */
	1526
	1527	switch (type) {
	1528	case SVt_PVCV:
	1529	case SVt_PVFM:
	1530	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1531	break;
	1532	case SVt_PVHV:
	1533	append_flags(d, flags, hv_flags_names);
	1534	break;
	1535	case SVt_PVGV:
	1536	case SVt_PVLV:
	1537	if (isGV_with_GP(sv)) {
	1538	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1539	}
	1540	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1541	sv_catpv(d, "IMPORT");
	1542	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1543	sv_catpv(d, "ALL,");
	1544	else {
	1545	sv_catpv(d, "(");
	1546	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1547	sv_catpv(d, " ),");
	1548	}
	1549	}
	1550	/* FALL THROUGH */
	1551	default:
	1552	evaled_or_uv:
	1553	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1554	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1555	break;
	1556	case SVt_PVMG:
	1557	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1558	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1559	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1560	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1561	/* FALL THROUGH */
	1562	case SVt_PVNV:
	1563	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1564	goto evaled_or_uv;
	1565	case SVt_PVAV:
	1566	break;
	1567	}
	1568	/* SVphv_SHAREKEYS is also 0x20000000 */
	1569	if ((type != SVt_PVHV) && SvUTF8(sv))
	1570	sv_catpv(d, "UTF8");
	1571
	1572	if (*(SvEND(d) - 1) == ',') {
	1573	SvCUR_set(d, SvCUR(d) - 1);
	1574	SvPVX(d)[SvCUR(d)] = '\0';
	1575	}
	1576	sv_catpv(d, ")");
	1577	s = SvPVX_const(d);
	1578
	1579	/* dump initial SV details */
	1580
	1581	#ifdef DEBUG_LEAKING_SCALARS
	1582	Perl_dump_indent(aTHX_ level, file,
	1583	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1584	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1585	sv->sv_debug_line,
	1586	sv->sv_debug_inpad ? "for" : "by",
	1587	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1588	PTR2UV(sv->sv_debug_parent),
	1589	sv->sv_debug_serial
	1590	);
	1591	#endif
	1592	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1593
	1594	/* Dump SV type */
	1595
	1596	if (type < SVt_LAST) {
	1597	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1598
	1599	if (type == SVt_NULL) {
	1600	SvREFCNT_dec_NN(d);
	1601	return;
	1602	}
	1603	} else {
	1604	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1605	SvREFCNT_dec_NN(d);
	1606	return;
	1607	}
	1608
	1609	/* Dump general SV fields */
	1610
	1611	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1612	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1613	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1614	\|\| (type == SVt_IV && !SvROK(sv))) {
	1615	if (SvIsUV(sv)
	1616	#ifdef PERL_OLD_COPY_ON_WRITE
	1617	\|\| SvIsCOW(sv)
	1618	#endif
	1619	)
	1620	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1621	else
	1622	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1623	#ifdef PERL_OLD_COPY_ON_WRITE
	1624	if (SvIsCOW_shared_hash(sv))
	1625	PerlIO_printf(file, " (HASH)");
	1626	else if (SvIsCOW_normal(sv))
	1627	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1628	#endif
	1629	PerlIO_putc(file, '\n');
	1630	}
	1631
	1632	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1633	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1634	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1635	(UV) COP_SEQ_RANGE_LOW(sv));
	1636	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1637	(UV) COP_SEQ_RANGE_HIGH(sv));
	1638	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1639	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1640	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1641	\|\| type == SVt_NV) {
	1642	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1643	/* %Vg doesn't work? --jhi */
	1644	#ifdef USE_LONG_DOUBLE
	1645	Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
	1646	#else
	1647	Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
	1648	#endif
	1649	RESTORE_NUMERIC_LOCAL();
	1650	}
	1651
	1652	if (SvROK(sv)) {
	1653	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1654	if (nest < maxnest)
	1655	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1656	}
	1657
	1658	if (type < SVt_PV) {
	1659	SvREFCNT_dec_NN(d);
	1660	return;
	1661	}
	1662
	1663	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1664	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1665	const bool re = isREGEXP(sv);
	1666	const char * const ptr =
	1667	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1668	if (ptr) {
	1669	STRLEN delta;
	1670	if (SvOOK(sv)) {
	1671	SvOOK_offset(sv, delta);
	1672	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1673	(UV) delta);
	1674	} else {
	1675	delta = 0;
	1676	}
	1677	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1678	if (SvOOK(sv)) {
	1679	PerlIO_printf(file, "( %s . ) ",
	1680	pv_display(d, ptr - delta, delta, 0,
	1681	pvlim));
	1682	}
	1683	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1684	re ? 0 : SvLEN(sv),
	1685	pvlim));
	1686	if (SvUTF8(sv)) /* the 6? \x{....} */
	1687	PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
	1688	PerlIO_printf(file, "\n");
	1689	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1690	if (!re)
	1691	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1692	(IV)SvLEN(sv));
	1693	#ifdef PERL_NEW_COPY_ON_WRITE
	1694	if (SvIsCOW(sv) && SvLEN(sv))
	1695	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1696	CowREFCNT(sv));
	1697	#endif
	1698	}
	1699	else
	1700	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1701	}
	1702
	1703	if (type >= SVt_PVMG) {
	1704	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1705	HV * const ost = SvOURSTASH(sv);
	1706	if (ost)
	1707	do_hv_dump(level, file, " OURSTASH", ost);
	1708	} else {
	1709	if (SvMAGIC(sv))
	1710	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1711	}
	1712	if (SvSTASH(sv))
	1713	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1714
	1715	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1716	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1717	}
	1718	}
	1719
	1720	/* Dump type-specific SV fields */
	1721
	1722	switch (type) {
	1723	case SVt_PVAV:
	1724	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1725	if (AvARRAY(sv) != AvALLOC(sv)) {
	1726	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1727	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1728	}
	1729	else
	1730	PerlIO_putc(file, '\n');
	1731	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1732	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1733	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1734	sv_setpvs(d, "");
	1735	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1736	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1737	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1738	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1739	if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
	1740	int count;
	1741	for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1742	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1743
	1744	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1745	if (elt)
	1746	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1747	}
	1748	}
	1749	break;
	1750	case SVt_PVHV:
	1751	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1752	if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
	1753	/* Show distribution of HEs in the ARRAY */
	1754	int freq[200];
	1755	#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
	1756	int i;
	1757	int max = 0;
	1758	U32 pow2 = 2, keys = HvUSEDKEYS(sv);
	1759	NV theoret, sum = 0;
	1760
	1761	PerlIO_printf(file, " (");
	1762	Zero(freq, FREQ_MAX + 1, int);
	1763	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1764	HE* h;
	1765	int count = 0;
	1766	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1767	count++;
	1768	if (count > FREQ_MAX)
	1769	count = FREQ_MAX;
	1770	freq[count]++;
	1771	if (max < count)
	1772	max = count;
	1773	}
	1774	for (i = 0; i <= max; i++) {
	1775	if (freq[i]) {
	1776	PerlIO_printf(file, "%d%s:%d", i,
	1777	(i == FREQ_MAX) ? "+" : "",
	1778	freq[i]);
	1779	if (i != max)
	1780	PerlIO_printf(file, ", ");
	1781	}
	1782	}
	1783	PerlIO_putc(file, ')');
	1784	/* The "quality" of a hash is defined as the total number of
	1785	comparisons needed to access every element once, relative
	1786	to the expected number needed for a random hash.
	1787
	1788	The total number of comparisons is equal to the sum of
	1789	the squares of the number of entries in each bucket.
	1790	For a random hash of n keys into k buckets, the expected
	1791	value is
	1792	n + n(n-1)/2k
	1793	*/
	1794
	1795	for (i = max; i > 0; i--) { /* Precision: count down. */
	1796	sum += freq[i] * i * i;
	1797	}
	1798	while ((keys = keys >> 1))
	1799	pow2 = pow2 << 1;
	1800	theoret = HvUSEDKEYS(sv);
	1801	theoret += theoret * (theoret-1)/pow2;
	1802	PerlIO_putc(file, '\n');
	1803	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1804	}
	1805	PerlIO_putc(file, '\n');
	1806	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
	1807	{
	1808	STRLEN count = 0;
	1809	HE **ents = HvARRAY(sv);
	1810
	1811	if (ents) {
	1812	HE const const last = ents + HvMAX(sv);
	1813	count = last + 1 - ents;
	1814
	1815	do {
	1816	if (!*ents)
	1817	--count;
	1818	} while (++ents <= last);
	1819	}
	1820
	1821	if (SvOOK(sv)) {
	1822	struct xpvhv_aux *const aux = HvAUX(sv);
	1823	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1824	" (cached = %"UVuf")\n",
	1825	(UV)count, (UV)aux->xhv_fill_lazy);
	1826	} else {
	1827	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1828	(UV)count);
	1829	}
	1830	}
	1831	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1832	if (SvOOK(sv)) {
	1833	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1834	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1835	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1836	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1837	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1838	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1839	}
	1840	#endif
	1841	PerlIO_putc(file, '\n');
	1842	}
	1843	{
	1844	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1845	if (mg && mg->mg_obj) {
	1846	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1847	}
	1848	}
	1849	{
	1850	const char * const hvname = HvNAME_get(sv);
	1851	if (hvname)
	1852	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
	1853	}
	1854	if (SvOOK(sv)) {
	1855	AV * const backrefs
	1856	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1857	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1858	if (HvAUX(sv)->xhv_name_count)
	1859	Perl_dump_indent(aTHX_
	1860	level, file, " NAMECOUNT = %"IVdf"\n",
	1861	(IV)HvAUX(sv)->xhv_name_count
	1862	);
	1863	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1864	const I32 count = HvAUX(sv)->xhv_name_count;
	1865	if (count) {
	1866	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1867	/* The starting point is the first element if count is
	1868	positive and the second element if count is negative. */
	1869	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1870	+ (count < 0 ? 1 : 0);
	1871	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1872	+ (count < 0 ? -count : count);
	1873	while (hekp < endp) {
	1874	if (*hekp) {
	1875	sv_catpvs(names, ", \"");
	1876	sv_catpvn(names, HEK_KEY(hekp), HEK_LEN(hekp));
	1877	sv_catpvs(names, "\"");
	1878	} else {
	1879	/* This should never happen. */
	1880	sv_catpvs(names, ", (null)");
	1881	}
	1882	++hekp;
	1883	}
	1884	Perl_dump_indent(aTHX_
	1885	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	1886	);
	1887	}
	1888	else
	1889	Perl_dump_indent(aTHX_
	1890	level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
	1891	);
	1892	}
	1893	if (backrefs) {
	1894	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1895	PTR2UV(backrefs));
	1896	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1897	dumpops, pvlim);
	1898	}
	1899	if (meta) {
	1900	/* FIXME - mro_algs kflags can signal a UTF-8 name. */
	1901	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
	1902	(int)meta->mro_which->length,
	1903	meta->mro_which->name,
	1904	PTR2UV(meta->mro_which));
	1905	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1906	(UV)meta->cache_gen);
	1907	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1908	(UV)meta->pkg_gen);
	1909	if (meta->mro_linear_all) {
	1910	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1911	PTR2UV(meta->mro_linear_all));
	1912	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1913	dumpops, pvlim);
	1914	}
	1915	if (meta->mro_linear_current) {
	1916	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1917	PTR2UV(meta->mro_linear_current));
	1918	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1919	dumpops, pvlim);
	1920	}
	1921	if (meta->mro_nextmethod) {
	1922	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1923	PTR2UV(meta->mro_nextmethod));
	1924	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1925	dumpops, pvlim);
	1926	}
	1927	if (meta->isa) {
	1928	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1929	PTR2UV(meta->isa));
	1930	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1931	dumpops, pvlim);
	1932	}
	1933	}
	1934	}
	1935	if (nest < maxnest) {
	1936	HV * const hv = MUTABLE_HV(sv);
	1937	STRLEN i;
	1938	HE *he;
	1939
	1940	if (HvARRAY(hv)) {
	1941	int count = maxnest - nest;
	1942	for (i=0; i <= HvMAX(hv); i++) {
	1943	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	1944	U32 hash;
	1945	SV * keysv;
	1946	const char * keypv;
	1947	SV * elt;
	1948	STRLEN len;
	1949
	1950	if (count-- <= 0) goto DONEHV;
	1951
	1952	hash = HeHASH(he);
	1953	keysv = hv_iterkeysv(he);
	1954	keypv = SvPV_const(keysv, len);
	1955	elt = HeVAL(he);
	1956
	1957	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1958	if (SvUTF8(keysv))
	1959	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1960	if (HvEITER_get(hv) == he)
	1961	PerlIO_printf(file, "[CURRENT] ");
	1962	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	1963	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1964	}
	1965	}
	1966	DONEHV:;
	1967	}
	1968	}
	1969	break;
	1970
	1971	case SVt_PVCV:
	1972	if (CvAUTOLOAD(sv)) {
	1973	STRLEN len;
	1974	const char *const name = SvPV_const(sv, len);
	1975	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%.*s\"\n",
	1976	(int) len, name);
	1977	}
	1978	if (SvPOK(sv)) {
	1979	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
	1980	(int) CvPROTOLEN(sv), CvPROTO(sv));
	1981	}
	1982	/* FALL THROUGH */
	1983	case SVt_PVFM:
	1984	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1985	if (!CvISXSUB(sv)) {
	1986	if (CvSTART(sv)) {
	1987	Perl_dump_indent(aTHX_ level, file,
	1988	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1989	PTR2UV(CvSTART(sv)),
	1990	(IV)sequence_num(CvSTART(sv)));
	1991	}
	1992	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1993	PTR2UV(CvROOT(sv)));
	1994	if (CvROOT(sv) && dumpops) {
	1995	do_op_dump(level+1, file, CvROOT(sv));
	1996	}
	1997	} else {
	1998	SV * const constant = cv_const_sv((const CV *)sv);
	1999
	2000	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	2001
	2002	if (constant) {
	2003	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	2004	" (CONST SV)\n",
	2005	PTR2UV(CvXSUBANY(sv).any_ptr));
	2006	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	2007	pvlim);
	2008	} else {
	2009	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	2010	(IV)CvXSUBANY(sv).any_i32);
	2011	}
	2012	}
	2013	if (CvNAMED(sv))
	2014	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2015	HEK_KEY(CvNAME_HEK((CV *)sv)));
	2016	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	2017	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	2018	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	2019	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	2020	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	2021	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	2022	if (nest < maxnest) {
	2023	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	2024	}
	2025	{
	2026	const CV * const outside = CvOUTSIDE(sv);
	2027	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	2028	PTR2UV(outside),
	2029	(!outside ? "null"
	2030	: CvANON(outside) ? "ANON"
	2031	: (outside == PL_main_cv) ? "MAIN"
	2032	: CvUNIQUE(outside) ? "UNIQUE"
	2033	: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
	2034	}
	2035	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2036	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2037	break;
	2038
	2039	case SVt_PVGV:
	2040	case SVt_PVLV:
	2041	if (type == SVt_PVLV) {
	2042	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2043	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2044	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2045	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2046	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2047	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
	2048	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2049	dumpops, pvlim);
	2050	}
	2051	if (isREGEXP(sv)) goto dumpregexp;
	2052	if (!isGV_with_GP(sv))
	2053	break;
	2054	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
	2055	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2056	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2057	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2058	if (!GvGP(sv))
	2059	break;
	2060	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2061	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2062	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2063	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2064	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2065	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2066	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2067	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2068	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2069	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2070	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2071	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2072	break;
	2073	case SVt_PVIO:
	2074	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2075	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2076	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2077	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2078	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2079	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2080	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2081	if (IoTOP_NAME(sv))
	2082	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2083	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2084	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2085	else {
	2086	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2087	PTR2UV(IoTOP_GV(sv)));
	2088	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2089	maxnest, dumpops, pvlim);
	2090	}
	2091	/* Source filters hide things that are not GVs in these three, so let's
	2092	be careful out there. */
	2093	if (IoFMT_NAME(sv))
	2094	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2095	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2096	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2097	else {
	2098	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2099	PTR2UV(IoFMT_GV(sv)));
	2100	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2101	maxnest, dumpops, pvlim);
	2102	}
	2103	if (IoBOTTOM_NAME(sv))
	2104	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2105	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2106	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2107	else {
	2108	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2109	PTR2UV(IoBOTTOM_GV(sv)));
	2110	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2111	maxnest, dumpops, pvlim);
	2112	}
	2113	if (isPRINT(IoTYPE(sv)))
	2114	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2115	else
	2116	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2117	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2118	break;
	2119	case SVt_REGEXP:
	2120	dumpregexp:
	2121	{
	2122	struct regexp * const r = ReANY((REGEXP*)sv);
	2123	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
	2124	sv_setpv(d,""); \
	2125	append_flags(d, flags, regexp_flags_names); \
	2126	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2127	SvCUR_set(d, SvCUR(d) - 1); \
	2128	SvPVX(d)[SvCUR(d)] = '\0'; \
	2129	} \
	2130	} STMT_END
	2131	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
	2132	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2133	(UV)(r->compflags), SvPVX_const(d));
	2134
	2135	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
	2136	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2137	(UV)(r->extflags), SvPVX_const(d));
	2138	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2139
	2140	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2141	(UV)(r->intflags));
	2142	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2143	(UV)(r->nparens));
	2144	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2145	(UV)(r->lastparen));
	2146	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2147	(UV)(r->lastcloseparen));
	2148	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2149	(IV)(r->minlen));
	2150	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2151	(IV)(r->minlenret));
	2152	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2153	(UV)(r->gofs));
	2154	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2155	(UV)(r->pre_prefix));
	2156	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2157	(IV)(r->sublen));
	2158	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2159	(IV)(r->suboffset));
	2160	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2161	(IV)(r->subcoffset));
	2162	if (r->subbeg)
	2163	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2164	PTR2UV(r->subbeg),
	2165	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2166	else
	2167	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2168	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
	2169	PTR2UV(r->engine));
	2170	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2171	PTR2UV(r->mother_re));
	2172	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2173	PTR2UV(r->paren_names));
	2174	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2175	PTR2UV(r->substrs));
	2176	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2177	PTR2UV(r->pprivate));
	2178	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2179	PTR2UV(r->offs));
	2180	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2181	PTR2UV(r->qr_anoncv));
	2182	#ifdef PERL_ANY_COW
	2183	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2184	PTR2UV(r->saved_copy));
	2185	#endif
	2186	}
	2187	break;
	2188	}
	2189	SvREFCNT_dec_NN(d);
	2190	}
	2191
	2192	void
	2193	Perl_sv_dump(pTHX_ SV *sv)
	2194	{
	2195	dVAR;
	2196
	2197	PERL_ARGS_ASSERT_SV_DUMP;
	2198
	2199	if (SvROK(sv))
	2200	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2201	else
	2202	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2203	}
	2204
	2205	int
	2206	Perl_runops_debug(pTHX)
	2207	{
	2208	dVAR;
	2209	if (!PL_op) {
	2210	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2211	return 0;
	2212	}
	2213
	2214	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2215	do {
	2216	#ifdef PERL_TRACE_OPS
	2217	++PL_op_exec_cnt[PL_op->op_type];
	2218	#endif
	2219	if (PL_debug) {
	2220	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2221	PerlIO_printf(Perl_debug_log,
	2222	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2223	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2224	PTR2UV(*PL_watchaddr));
	2225	if (DEBUG_s_TEST_) {
	2226	if (DEBUG_v_TEST_) {
	2227	PerlIO_printf(Perl_debug_log, "\n");
	2228	deb_stack_all();
	2229	}
	2230	else
	2231	debstack();
	2232	}
	2233
	2234
	2235	if (DEBUG_t_TEST_) debop(PL_op);
	2236	if (DEBUG_P_TEST_) debprof(PL_op);
	2237	}
	2238
	2239	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2240	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2241	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2242	PERL_ASYNC_CHECK();
	2243
	2244	TAINT_NOT;
	2245	return 0;
	2246	}
	2247
	2248	I32
	2249	Perl_debop(pTHX_ const OP *o)
	2250	{
	2251	dVAR;
	2252
	2253	PERL_ARGS_ASSERT_DEBOP;
	2254
	2255	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2256	return 0;
	2257
	2258	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2259	switch (o->op_type) {
	2260	case OP_CONST:
	2261	case OP_HINTSEVAL:
	2262	/* With ITHREADS, consts are stored in the pad, and the right pad
	2263	* may not be active here, so check.
	2264	* Looks like only during compiling the pads are illegal.
	2265	*/
	2266	#ifdef USE_ITHREADS
	2267	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2268	#endif
	2269	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2270	break;
	2271	case OP_GVSV:
	2272	case OP_GV:
	2273	if (cGVOPo_gv) {
	2274	SV * const sv = newSV(0);
	2275	#ifdef PERL_MAD
	2276	/* FIXME - is this making unwarranted assumptions about the
	2277	UTF-8 cleanliness of the dump file handle? */
	2278	SvUTF8_on(sv);
	2279	#endif
	2280	gv_fullname3(sv, cGVOPo_gv, NULL);
	2281	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2282	SvREFCNT_dec_NN(sv);
	2283	}
	2284	else
	2285	PerlIO_printf(Perl_debug_log, "(NULL)");
	2286	break;
	2287
	2288	{
	2289	int count;
	2290
	2291	case OP_PADSV:
	2292	case OP_PADAV:
	2293	case OP_PADHV:
	2294	count = 1;
	2295	goto dump_padop;
	2296	case OP_PADRANGE:
	2297	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2298	dump_padop:
	2299	/* print the lexical's name */
	2300	{
	2301	CV * const cv = deb_curcv(cxstack_ix);
	2302	SV *sv;
	2303	PAD * comppad = NULL;
	2304	int i;
	2305
	2306	if (cv) {
	2307	PADLIST * const padlist = CvPADLIST(cv);
	2308	comppad = *PadlistARRAY(padlist);
	2309	}
	2310	PerlIO_printf(Perl_debug_log, "(");
	2311	for (i = 0; i < count; i++) {
	2312	if (comppad &&
	2313	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2314	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2315	else
	2316	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2317	(UV)o->op_targ+i);
	2318	if (i < count-1)
	2319	PerlIO_printf(Perl_debug_log, ",");
	2320	}
	2321	PerlIO_printf(Perl_debug_log, ")");
	2322	}
	2323	break;
	2324	}
	2325
	2326	default:
	2327	break;
	2328	}
	2329	PerlIO_printf(Perl_debug_log, "\n");
	2330	return 0;
	2331	}
	2332
	2333	STATIC CV*
	2334	S_deb_curcv(pTHX_ const I32 ix)
	2335	{
	2336	dVAR;
	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	dVAR;
	2354
	2355	PERL_ARGS_ASSERT_WATCH;
	2356
	2357	PL_watchaddr = addr;
	2358	PL_watchok = *addr;
	2359	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2360	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2361	}
	2362
	2363	STATIC void
	2364	S_debprof(pTHX_ const OP *o)
	2365	{
	2366	dVAR;
	2367
	2368	PERL_ARGS_ASSERT_DEBPROF;
	2369
	2370	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2371	return;
	2372	if (!PL_profiledata)
	2373	Newxz(PL_profiledata, MAXO, U32);
	2374	++PL_profiledata[o->op_type];
	2375	}
	2376
	2377	void
	2378	Perl_debprofdump(pTHX)
	2379	{
	2380	dVAR;
	2381	unsigned i;
	2382	if (!PL_profiledata)
	2383	return;
	2384	for (i = 0; i < MAXO; i++) {
	2385	if (PL_profiledata[i])
	2386	PerlIO_printf(Perl_debug_log,
	2387	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2388	PL_op_name[i]);
	2389	}
	2390	}
	2391
	2392	#ifdef PERL_MAD
	2393	/*
	2394	* XML variants of most of the above routines
	2395	*/
	2396
	2397	STATIC void
	2398	S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2399	{
	2400	va_list args;
	2401
	2402	PERL_ARGS_ASSERT_XMLDUMP_ATTR;
	2403
	2404	PerlIO_printf(file, "\n ");
	2405	va_start(args, pat);
	2406	xmldump_vindent(level, file, pat, &args);
	2407	va_end(args);
	2408	}
	2409
	2410
	2411	void
	2412	Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2413	{
	2414	va_list args;
	2415	PERL_ARGS_ASSERT_XMLDUMP_INDENT;
	2416	va_start(args, pat);
	2417	xmldump_vindent(level, file, pat, &args);
	2418	va_end(args);
	2419	}
	2420
	2421	void
	2422	Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	2423	{
	2424	PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
	2425
	2426	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	2427	PerlIO_vprintf(file, pat, *args);
	2428	}
	2429
	2430	void
	2431	Perl_xmldump_all(pTHX)
	2432	{
	2433	xmldump_all_perl(FALSE);
	2434	}
	2435
	2436	void
	2437	Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
	2438	{
	2439	PerlIO_setlinebuf(PL_xmlfp);
	2440	if (PL_main_root)
	2441	op_xmldump(PL_main_root);
	2442	/* someday we might call this, when it outputs XML: */
	2443	/* xmldump_packsubs_perl(PL_defstash, justperl); */
	2444	if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
	2445	PerlIO_close(PL_xmlfp);
	2446	PL_xmlfp = 0;
	2447	}
	2448
	2449	void
	2450	Perl_xmldump_packsubs(pTHX_ const HV *stash)
	2451	{
	2452	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
	2453	xmldump_packsubs_perl(stash, FALSE);
	2454	}
	2455
	2456	void
	2457	Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	2458	{
	2459	I32 i;
	2460	HE *entry;
	2461
	2462	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
	2463
	2464	if (!HvARRAY(stash))
	2465	return;
	2466	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	2467	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	2468	GV *gv = MUTABLE_GV(HeVAL(entry));
	2469	HV *hv;
	2470	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	2471	continue;
	2472	if (GvCVu(gv))
	2473	xmldump_sub_perl(gv, justperl);
	2474	if (GvFORM(gv))
	2475	xmldump_form(gv);
	2476	if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
	2477	&& (hv = GvHV(gv)) && hv != PL_defstash)
	2478	xmldump_packsubs_perl(hv, justperl); /* nested package */
	2479	}
	2480	}
	2481	}
	2482
	2483	void
	2484	Perl_xmldump_sub(pTHX_ const GV *gv)
	2485	{
	2486	PERL_ARGS_ASSERT_XMLDUMP_SUB;
	2487	xmldump_sub_perl(gv, FALSE);
	2488	}
	2489
	2490	void
	2491	Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
	2492	{
	2493	SV * sv;
	2494
	2495	PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
	2496
	2497	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	2498	return;
	2499
	2500	sv = sv_newmortal();
	2501	gv_fullname3(sv, gv, NULL);
	2502	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
	2503	if (CvXSUB(GvCV(gv)))
	2504	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
	2505	PTR2UV(CvXSUB(GvCV(gv))),
	2506	(int)CvXSUBANY(GvCV(gv)).any_i32);
	2507	else if (CvROOT(GvCV(gv)))
	2508	op_xmldump(CvROOT(GvCV(gv)));
	2509	else
	2510	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2511	}
	2512
	2513	void
	2514	Perl_xmldump_form(pTHX_ const GV *gv)
	2515	{
	2516	SV * const sv = sv_newmortal();
	2517
	2518	PERL_ARGS_ASSERT_XMLDUMP_FORM;
	2519
	2520	gv_fullname3(sv, gv, NULL);
	2521	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
	2522	if (CvROOT(GvFORM(gv)))
	2523	op_xmldump(CvROOT(GvFORM(gv)));
	2524	else
	2525	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2526	}
	2527
	2528	void
	2529	Perl_xmldump_eval(pTHX)
	2530	{
	2531	op_xmldump(PL_eval_root);
	2532	}
	2533
	2534	char *
	2535	Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
	2536	{
	2537	PERL_ARGS_ASSERT_SV_CATXMLSV;
	2538	return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
	2539	}
	2540
	2541	char *
	2542	Perl_sv_catxmlpv(pTHX_ SV dsv, const char pv, int utf8)
	2543	{
	2544	PERL_ARGS_ASSERT_SV_CATXMLPV;
	2545	return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
	2546	}
	2547
	2548	char *
	2549	Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
	2550	{
	2551	unsigned int c;
	2552	const char * const e = pv + len;
	2553	const char * const start = pv;
	2554	STRLEN dsvcur;
	2555	STRLEN cl;
	2556
	2557	PERL_ARGS_ASSERT_SV_CATXMLPVN;
	2558
	2559	sv_catpvs(dsv,"");
	2560	dsvcur = SvCUR(dsv); /* in case we have to restart */
	2561
	2562	retry:
	2563	while (pv < e) {
	2564	if (utf8) {
	2565	c = utf8_to_uvchr_buf((U8)pv, (U8)e, &cl);
	2566	if (cl == 0) {
	2567	SvCUR(dsv) = dsvcur;
	2568	pv = start;
	2569	utf8 = 0;
	2570	goto retry;
	2571	}
	2572	}
	2573	else
	2574	c = (*pv & 255);
	2575
	2576	switch (c) {
	2577	case 0x00:
	2578	case 0x01:
	2579	case 0x02:
	2580	case 0x03:
	2581	case 0x04:
	2582	case 0x05:
	2583	case 0x06:
	2584	case 0x07:
	2585	case 0x08:
	2586	case 0x0b:
	2587	case 0x0c:
	2588	case 0x0e:
	2589	case 0x0f:
	2590	case 0x10:
	2591	case 0x11:
	2592	case 0x12:
	2593	case 0x13:
	2594	case 0x14:
	2595	case 0x15:
	2596	case 0x16:
	2597	case 0x17:
	2598	case 0x18:
	2599	case 0x19:
	2600	case 0x1a:
	2601	case 0x1b:
	2602	case 0x1c:
	2603	case 0x1d:
	2604	case 0x1e:
	2605	case 0x1f:
	2606	case 0x7f:
	2607	case 0x80:
	2608	case 0x81:
	2609	case 0x82:
	2610	case 0x83:
	2611	case 0x84:
	2612	case 0x86:
	2613	case 0x87:
	2614	case 0x88:
	2615	case 0x89:
	2616	case 0x90:
	2617	case 0x91:
	2618	case 0x92:
	2619	case 0x93:
	2620	case 0x94:
	2621	case 0x95:
	2622	case 0x96:
	2623	case 0x97:
	2624	case 0x98:
	2625	case 0x99:
	2626	case 0x9a:
	2627	case 0x9b:
	2628	case 0x9c:
	2629	case 0x9d:
	2630	case 0x9e:
	2631	case 0x9f:
	2632	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2633	break;
	2634	case '<':
	2635	sv_catpvs(dsv, "<");
	2636	break;
	2637	case '>':
	2638	sv_catpvs(dsv, ">");
	2639	break;
	2640	case '&':
	2641	sv_catpvs(dsv, "&");
	2642	break;
	2643	case '"':
	2644	sv_catpvs(dsv, """);
	2645	break;
	2646	default:
	2647	if (c < 0xD800) {
	2648	if (c < 32 \|\| c > 127) {
	2649	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2650	}
	2651	else {
	2652	const char string = (char) c;
	2653	sv_catpvn(dsv, &string, 1);
	2654	}
	2655	break;
	2656	}
	2657	if ((c >= 0xD800 && c <= 0xDB7F) \|\|
	2658	(c >= 0xDC00 && c <= 0xDFFF) \|\|
	2659	(c >= 0xFFF0 && c <= 0xFFFF) \|\|
	2660	c > 0x10ffff)
	2661	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2662	else
	2663	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2664	}
	2665
	2666	if (utf8)
	2667	pv += UTF8SKIP(pv);
	2668	else
	2669	pv++;
	2670	}
	2671
	2672	return SvPVX(dsv);
	2673	}
	2674
	2675	char *
	2676	Perl_sv_xmlpeek(pTHX_ SV *sv)
	2677	{
	2678	SV * const t = sv_newmortal();
	2679	STRLEN n_a;
	2680	int unref = 0;
	2681
	2682	PERL_ARGS_ASSERT_SV_XMLPEEK;
	2683
	2684	sv_utf8_upgrade(t);
	2685	sv_setpvs(t, "");
	2686	/* retry: */
	2687	if (!sv) {
	2688	sv_catpv(t, "VOID=\"\"");
	2689	goto finish;
	2690	}
	2691	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	2692	sv_catpv(t, "WILD=\"\"");
	2693	goto finish;
	2694	}
	2695	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	2696	if (sv == &PL_sv_undef) {
	2697	sv_catpv(t, "SV_UNDEF=\"1\"");
	2698	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2699	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2700	SvREADONLY(sv))
	2701	goto finish;
	2702	}
	2703	else if (sv == &PL_sv_no) {
	2704	sv_catpv(t, "SV_NO=\"1\"");
	2705	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2706	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2707	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2708	SVp_POK\|SVp_NOK)) &&
	2709	SvCUR(sv) == 0 &&
	2710	SvNVX(sv) == 0.0)
	2711	goto finish;
	2712	}
	2713	else if (sv == &PL_sv_yes) {
	2714	sv_catpv(t, "SV_YES=\"1\"");
	2715	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2716	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2717	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2718	SVp_POK\|SVp_NOK)) &&
	2719	SvCUR(sv) == 1 &&
	2720	SvPVX(sv) && *SvPVX(sv) == '1' &&
	2721	SvNVX(sv) == 1.0)
	2722	goto finish;
	2723	}
	2724	else {
	2725	sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
	2726	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2727	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2728	SvREADONLY(sv))
	2729	goto finish;
	2730	}
	2731	sv_catpv(t, " XXX=\"\" ");
	2732	}
	2733	else if (SvREFCNT(sv) == 0) {
	2734	sv_catpv(t, " refcnt=\"0\"");
	2735	unref++;
	2736	}
	2737	else if (DEBUG_R_TEST_) {
	2738	int is_tmp = 0;
	2739	I32 ix;
	2740	/* is this SV on the tmps stack? */
	2741	for (ix=PL_tmps_ix; ix>=0; ix--) {
	2742	if (PL_tmps_stack[ix] == sv) {
	2743	is_tmp = 1;
	2744	break;
	2745	}
	2746	}
	2747	if (SvREFCNT(sv) > 1)
	2748	Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
	2749	is_tmp ? "T" : "");
	2750	else if (is_tmp)
	2751	sv_catpv(t, " DRT=\"<T>\"");
	2752	}
	2753
	2754	if (SvROK(sv)) {
	2755	sv_catpv(t, " ROK=\"\"");
	2756	}
	2757	switch (SvTYPE(sv)) {
	2758	default:
	2759	sv_catpv(t, " FREED=\"1\"");
	2760	goto finish;
	2761
	2762	case SVt_NULL:
	2763	sv_catpv(t, " UNDEF=\"1\"");
	2764	goto finish;
	2765	case SVt_IV:
	2766	sv_catpv(t, " IV=\"");
	2767	break;
	2768	case SVt_NV:
	2769	sv_catpv(t, " NV=\"");
	2770	break;
	2771	case SVt_PV:
	2772	sv_catpv(t, " PV=\"");
	2773	break;
	2774	case SVt_PVIV:
	2775	sv_catpv(t, " PVIV=\"");
	2776	break;
	2777	case SVt_PVNV:
	2778	sv_catpv(t, " PVNV=\"");
	2779	break;
	2780	case SVt_PVMG:
	2781	sv_catpv(t, " PVMG=\"");
	2782	break;
	2783	case SVt_PVLV:
	2784	sv_catpv(t, " PVLV=\"");
	2785	break;
	2786	case SVt_PVAV:
	2787	sv_catpv(t, " AV=\"");
	2788	break;
	2789	case SVt_PVHV:
	2790	sv_catpv(t, " HV=\"");
	2791	break;
	2792	case SVt_PVCV:
	2793	if (CvGV(sv))
	2794	Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
	2795	else
	2796	sv_catpv(t, " CV=\"()\"");
	2797	goto finish;
	2798	case SVt_PVGV:
	2799	sv_catpv(t, " GV=\"");
	2800	break;
	2801	case SVt_INVLIST:
	2802	sv_catpv(t, " DUMMY=\"");
	2803	break;
	2804	case SVt_REGEXP:
	2805	sv_catpv(t, " REGEXP=\"");
	2806	break;
	2807	case SVt_PVFM:
	2808	sv_catpv(t, " FM=\"");
	2809	break;
	2810	case SVt_PVIO:
	2811	sv_catpv(t, " IO=\"");
	2812	break;
	2813	}
	2814
	2815	if (SvPOKp(sv)) {
	2816	if (SvPVX(sv)) {
	2817	sv_catxmlsv(t, sv);
	2818	}
	2819	}
	2820	else if (SvNOKp(sv)) {
	2821	STORE_NUMERIC_LOCAL_SET_STANDARD();
	2822	Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
	2823	RESTORE_NUMERIC_LOCAL();
	2824	}
	2825	else if (SvIOKp(sv)) {
	2826	if (SvIsUV(sv))
	2827	Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
	2828	else
	2829	Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
	2830	}
	2831	else
	2832	sv_catpv(t, "");
	2833	sv_catpv(t, "\"");
	2834
	2835	finish:
	2836	while (unref--)
	2837	sv_catpv(t, ")");
	2838	return SvPV(t, n_a);
	2839	}
	2840
	2841	void
	2842	Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	2843	{
	2844	PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
	2845
	2846	if (!pm) {
	2847	Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
	2848	return;
	2849	}
	2850	Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
	2851	level++;
	2852	if (PM_GETRE(pm)) {
	2853	REGEXP *const r = PM_GETRE(pm);
	2854	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2855	sv_catxmlsv(tmpsv, MUTABLE_SV(r));
	2856	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
	2857	SvPVX(tmpsv));
	2858	SvREFCNT_dec_NN(tmpsv);
	2859	Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
	2860	(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
	2861	}
	2862	else
	2863	Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
	2864	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	2865	SV * const tmpsv = pm_description(pm);
	2866	Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2867	SvREFCNT_dec_NN(tmpsv);
	2868	}
	2869
	2870	level--;
	2871	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	2872	Perl_xmldump_indent(aTHX_ level, file, ">\n");
	2873	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
	2874	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
	2875	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
	2876	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
	2877	}
	2878	else
	2879	Perl_xmldump_indent(aTHX_ level, file, "/>\n");
	2880	}
	2881
	2882	void
	2883	Perl_pmop_xmldump(pTHX_ const PMOP *pm)
	2884	{
	2885	do_pmop_xmldump(0, PL_xmlfp, pm);
	2886	}
	2887
	2888	void
	2889	Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
	2890	{
	2891	UV seq;
	2892	int contents = 0;
	2893	const OPCODE optype = o->op_type;
	2894
	2895	PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
	2896
	2897	if (!o)
	2898	return;
	2899	seq = sequence_num(o);
	2900	Perl_xmldump_indent(aTHX_ level, file,
	2901	"<op_%s seq=\"%"UVuf" -> ",
	2902	OP_NAME(o),
	2903	seq);
	2904	level++;
	2905	if (o->op_next)
	2906	PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
	2907	sequence_num(o->op_next));
	2908	else
	2909	PerlIO_printf(file, "DONE\"");
	2910
	2911	if (o->op_targ) {
	2912	if (optype == OP_NULL)
	2913	{
	2914	PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
	2915	if (o->op_targ == OP_NEXTSTATE)
	2916	{
	2917	if (CopLINE(cCOPo))
	2918	PerlIO_printf(file, " line=\"%"UVuf"\"",
	2919	(UV)CopLINE(cCOPo));
	2920	if (CopSTASHPV(cCOPo))
	2921	PerlIO_printf(file, " package=\"%s\"",
	2922	CopSTASHPV(cCOPo));
	2923	if (CopLABEL(cCOPo))
	2924	PerlIO_printf(file, " label=\"%s\"",
	2925	CopLABEL(cCOPo));
	2926	}
	2927	}
	2928	else
	2929	PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
	2930	}
	2931	#ifdef DUMPADDR
	2932	PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
	2933	#endif
	2934
	2935	DUMP_OP_FLAGS(o,1,0,file);
	2936	DUMP_OP_PRIVATE(o,1,0,file);
	2937
	2938	switch (optype) {
	2939	case OP_AELEMFAST:
	2940	if (o->op_flags & OPf_SPECIAL) {
	2941	break;
	2942	}
	2943	case OP_GVSV:
	2944	case OP_GV:
	2945	#ifdef USE_ITHREADS
	2946	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
	2947	#else
	2948	if (cSVOPo->op_sv) {
	2949	SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
	2950	SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
	2951	char *s;
	2952	STRLEN len;
	2953	ENTER;
	2954	SAVEFREESV(tmpsv1);
	2955	SAVEFREESV(tmpsv2);
	2956	gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
	2957	s = SvPV(tmpsv1,len);
	2958	sv_catxmlpvn(tmpsv2, s, len, 1);
	2959	S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
	2960	LEAVE;
	2961	}
	2962	else
	2963	S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
	2964	#endif
	2965	break;
	2966	case OP_CONST:
	2967	case OP_HINTSEVAL:
	2968	case OP_METHOD_NAMED:
	2969	#ifndef USE_ITHREADS
	2970	/* with ITHREADS, consts are stored in the pad, and the right pad
	2971	* may not be active here, so skip */
	2972	S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
	2973	#endif
	2974	break;
	2975	case OP_ANONCODE:
	2976	if (!contents) {
	2977	contents = 1;
	2978	PerlIO_printf(file, ">\n");
	2979	}
	2980	do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
	2981	break;
	2982	case OP_NEXTSTATE:
	2983	case OP_DBSTATE:
	2984	if (CopLINE(cCOPo))
	2985	S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
	2986	(UV)CopLINE(cCOPo));
	2987	if (CopSTASHPV(cCOPo))
	2988	S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
	2989	CopSTASHPV(cCOPo));
	2990	if (CopLABEL(cCOPo))
	2991	S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
	2992	CopLABEL(cCOPo));
	2993	break;
	2994	case OP_ENTERLOOP:
	2995	S_xmldump_attr(aTHX_ level, file, "redo=\"");
	2996	if (cLOOPo->op_redoop)
	2997	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
	2998	else
	2999	PerlIO_printf(file, "DONE\"");
	3000	S_xmldump_attr(aTHX_ level, file, "next=\"");
	3001	if (cLOOPo->op_nextop)
	3002	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
	3003	else
	3004	PerlIO_printf(file, "DONE\"");
	3005	S_xmldump_attr(aTHX_ level, file, "last=\"");
	3006	if (cLOOPo->op_lastop)
	3007	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
	3008	else
	3009	PerlIO_printf(file, "DONE\"");
	3010	break;
	3011	case OP_COND_EXPR:
	3012	case OP_RANGE:
	3013	case OP_MAPWHILE:
	3014	case OP_GREPWHILE:
	3015	case OP_OR:
	3016	case OP_AND:
	3017	S_xmldump_attr(aTHX_ level, file, "other=\"");
	3018	if (cLOGOPo->op_other)
	3019	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
	3020	else
	3021	PerlIO_printf(file, "DONE\"");
	3022	break;
	3023	case OP_LEAVE:
	3024	case OP_LEAVEEVAL:
	3025	case OP_LEAVESUB:
	3026	case OP_LEAVESUBLV:
	3027	case OP_LEAVEWRITE:
	3028	case OP_SCOPE:
	3029	if (o->op_private & OPpREFCOUNTED)
	3030	S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
	3031	break;
	3032	default:
	3033	break;
	3034	}
	3035
	3036	if (PL_madskills && o->op_madprop) {
	3037	char prevkey = '\0';
	3038	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	3039	const MADPROP* mp = o->op_madprop;
	3040
	3041	if (!contents) {
	3042	contents = 1;
	3043	PerlIO_printf(file, ">\n");
	3044	}
	3045	Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
	3046	level++;
	3047	while (mp) {
	3048	char tmp = mp->mad_key;
	3049	sv_setpvs(tmpsv,"\"");
	3050	if (tmp)
	3051	sv_catxmlpvn(tmpsv, &tmp, 1, 0);
	3052	if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
	3053	sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
	3054	else
	3055	prevkey = tmp;
	3056	sv_catpv(tmpsv, "\"");
	3057	switch (mp->mad_type) {
	3058	case MAD_NULL:
	3059	sv_catpv(tmpsv, "NULL");
	3060	Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
	3061	break;
	3062	case MAD_PV:
	3063	sv_catpv(tmpsv, " val=\"");
	3064	sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
	3065	sv_catpv(tmpsv, "\"");
	3066	Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
	3067	break;
	3068	case MAD_SV:
	3069	sv_catpv(tmpsv, " val=\"");
	3070	sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
	3071	sv_catpv(tmpsv, "\"");
	3072	Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
	3073	break;
	3074	case MAD_OP:
	3075	if ((OP*)mp->mad_val) {
	3076	Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
	3077	do_op_xmldump(level+1, file, (OP*)mp->mad_val);
	3078	Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
	3079	}
	3080	break;
	3081	default:
	3082	Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
	3083	break;
	3084	}
	3085	mp = mp->mad_next;
	3086	}
	3087	level--;
	3088	Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
	3089
	3090	SvREFCNT_dec_NN(tmpsv);
	3091	}
	3092
	3093	switch (optype) {
	3094	case OP_PUSHRE:
	3095	case OP_MATCH:
	3096	case OP_QR:
	3097	case OP_SUBST:
	3098	if (!contents) {
	3099	contents = 1;
	3100	PerlIO_printf(file, ">\n");
	3101	}
	3102	do_pmop_xmldump(level, file, cPMOPo);
	3103	break;
	3104	default:
	3105	break;
	3106	}
	3107
	3108	if (o->op_flags & OPf_KIDS) {
	3109	OP *kid;
	3110	if (!contents) {
	3111	contents = 1;
	3112	PerlIO_printf(file, ">\n");
	3113	}
	3114	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	3115	do_op_xmldump(level, file, kid);
	3116	}
	3117
	3118	if (contents)
	3119	Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
	3120	else
	3121	PerlIO_printf(file, " />\n");
	3122	}
	3123
	3124	void
	3125	Perl_op_xmldump(pTHX_ const OP *o)
	3126	{
	3127	PERL_ARGS_ASSERT_OP_XMLDUMP;
	3128
	3129	do_op_xmldump(0, PL_xmlfp, o);
	3130	}
	3131	#endif
	3132
	3133	/*
	3134	* Local variables:
	3135	* c-indentation-style: bsd
	3136	* c-basic-offset: 4
	3137	* indent-tabs-mode: nil
	3138	* End:
	3139	*
	3140	* ex: set ts=8 sts=4 sw=4 et:
	3141	*/