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