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