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 if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1369	else
	1370	PerlIO_puts(
	1371	file,
	1372	" ???? - " __FILE__
	1373	" does not know how to handle this MG_LEN"
	1374	);
	1375	PerlIO_putc(file, '\n');
	1376	}
	1377	if (mg->mg_type == PERL_MAGIC_utf8) {
	1378	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1379	if (cache) {
	1380	IV i;
	1381	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1382	Perl_dump_indent(aTHX_ level, file,
	1383	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1384	i,
	1385	(UV)cache[i * 2],
	1386	(UV)cache[i * 2 + 1]);
	1387	}
	1388	}
	1389	}
	1390	}
	1391
	1392	void
	1393	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1394	{
	1395	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1396	}
	1397
	1398	void
	1399	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1400	{
	1401	const char *hvname;
	1402
	1403	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1404
	1405	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1406	if (sv && (hvname = HvNAME_get(sv)))
	1407	PerlIO_printf(file, "\t\"%s\"\n", hvname);
	1408	else
	1409	PerlIO_putc(file, '\n');
	1410	}
	1411
	1412	void
	1413	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1414	{
	1415	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1416
	1417	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1418	if (sv && GvNAME(sv))
	1419	PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
	1420	else
	1421	PerlIO_putc(file, '\n');
	1422	}
	1423
	1424	void
	1425	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1426	{
	1427	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1428
	1429	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1430	if (sv && GvNAME(sv)) {
	1431	const char *hvname;
	1432	PerlIO_printf(file, "\t\"");
	1433	if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
	1434	PerlIO_printf(file, "%s\" :: \"", hvname);
	1435	PerlIO_printf(file, "%s\"\n", GvNAME(sv));
	1436	}
	1437	else
	1438	PerlIO_putc(file, '\n');
	1439	}
	1440
	1441	void
	1442	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1443	{
	1444	dVAR;
	1445	SV *d;
	1446	const char *s;
	1447	U32 flags;
	1448	U32 type;
	1449
	1450	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1451
	1452	if (!sv) {
	1453	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1454	return;
	1455	}
	1456
	1457	flags = SvFLAGS(sv);
	1458	type = SvTYPE(sv);
	1459
	1460	d = Perl_newSVpvf(aTHX_
	1461	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1462	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1463	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1464	(int)(PL_dumpindent*level), "");
	1465
	1466	if (!(flags & SVpad_NAME && (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1467	if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
	1468	}
	1469	if (!(flags & SVpad_NAME && type == SVt_PVMG)) {
	1470	if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
	1471	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
	1472	}
	1473	if (flags & SVs_TEMP) sv_catpv(d, "TEMP,");
	1474	if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,");
	1475	if (flags & SVs_GMG) sv_catpv(d, "GMG,");
	1476	if (flags & SVs_SMG) sv_catpv(d, "SMG,");
	1477	if (flags & SVs_RMG) sv_catpv(d, "RMG,");
	1478
	1479	if (flags & SVf_IOK) sv_catpv(d, "IOK,");
	1480	if (flags & SVf_NOK) sv_catpv(d, "NOK,");
	1481	if (flags & SVf_POK) sv_catpv(d, "POK,");
	1482	if (flags & SVf_ROK) {
	1483	sv_catpv(d, "ROK,");
	1484	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1485	}
	1486	if (flags & SVf_OOK) sv_catpv(d, "OOK,");
	1487	if (flags & SVf_FAKE) sv_catpv(d, "FAKE,");
	1488	if (flags & SVf_READONLY) sv_catpv(d, "READONLY,");
	1489	if (flags & SVf_BREAK) sv_catpv(d, "BREAK,");
	1490
	1491	if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,");
	1492	if (flags & SVp_IOK) sv_catpv(d, "pIOK,");
	1493	if (flags & SVp_NOK) sv_catpv(d, "pNOK,");
	1494	if (flags & SVp_POK) sv_catpv(d, "pPOK,");
	1495	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
	1496	if (SvPCS_IMPORTED(sv))
	1497	sv_catpv(d, "PCS_IMPORTED,");
	1498	else
	1499	sv_catpv(d, "SCREAM,");
	1500	}
	1501
	1502	switch (type) {
	1503	case SVt_PVCV:
	1504	case SVt_PVFM:
	1505	if (CvANON(sv)) sv_catpv(d, "ANON,");
	1506	if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
	1507	if (CvCLONE(sv)) sv_catpv(d, "CLONE,");
	1508	if (CvCLONED(sv)) sv_catpv(d, "CLONED,");
	1509	if (CvCONST(sv)) sv_catpv(d, "CONST,");
	1510	if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,");
	1511	if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,");
	1512	if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,");
	1513	if (CvMETHOD(sv)) sv_catpv(d, "METHOD,");
	1514	if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,");
	1515	break;
	1516	case SVt_PVHV:
	1517	if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,");
	1518	if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,");
	1519	if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,");
	1520	if (HvREHASH(sv)) sv_catpv(d, "REHASH,");
	1521	if (flags & SVphv_CLONEABLE) sv_catpv(d, "CLONEABLE,");
	1522	break;
	1523	case SVt_PVGV:
	1524	case SVt_PVLV:
	1525	if (isGV_with_GP(sv)) {
	1526	if (GvINTRO(sv)) sv_catpv(d, "INTRO,");
	1527	if (GvMULTI(sv)) sv_catpv(d, "MULTI,");
	1528	if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
	1529	if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
	1530	}
	1531	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1532	sv_catpv(d, "IMPORT");
	1533	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1534	sv_catpv(d, "ALL,");
	1535	else {
	1536	sv_catpv(d, "(");
	1537	if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV");
	1538	if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV");
	1539	if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV");
	1540	if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV");
	1541	sv_catpv(d, " ),");
	1542	}
	1543	}
	1544	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1545	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1546	/* FALL THROUGH */
	1547	default:
	1548	evaled_or_uv:
	1549	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1550	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1551	break;
	1552	case SVt_PVMG:
	1553	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1554	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1555	/* FALL THROUGH */
	1556	case SVt_PVNV:
	1557	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1558	goto evaled_or_uv;
	1559	case SVt_PVAV:
	1560	break;
	1561	}
	1562	/* SVphv_SHAREKEYS is also 0x20000000 */
	1563	if ((type != SVt_PVHV) && SvUTF8(sv))
	1564	sv_catpv(d, "UTF8");
	1565
	1566	if (*(SvEND(d) - 1) == ',') {
	1567	SvCUR_set(d, SvCUR(d) - 1);
	1568	SvPVX(d)[SvCUR(d)] = '\0';
	1569	}
	1570	sv_catpv(d, ")");
	1571	s = SvPVX_const(d);
	1572
	1573	#ifdef DEBUG_LEAKING_SCALARS
	1574	Perl_dump_indent(aTHX_ level, file,
	1575	"ALLOCATED at %s:%d %s %s%s; serial %"UVuf"\n",
	1576	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1577	sv->sv_debug_line,
	1578	sv->sv_debug_inpad ? "for" : "by",
	1579	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1580	sv->sv_debug_cloned ? " (cloned)" : "",
	1581	sv->sv_debug_serial
	1582	);
	1583	#endif
	1584	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1585	if (type < SVt_LAST) {
	1586	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1587
	1588	if (type == SVt_NULL) {
	1589	SvREFCNT_dec(d);
	1590	return;
	1591	}
	1592	} else {
	1593	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1594	SvREFCNT_dec(d);
	1595	return;
	1596	}
	1597	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1598	&& type != SVt_PVCV && !isGV_with_GP(sv) && type != SVt_PVFM
	1599	&& type != SVt_PVIO)
	1600	\|\| (type == SVt_IV && !SvROK(sv))) {
	1601	if (SvIsUV(sv)
	1602	#ifdef PERL_OLD_COPY_ON_WRITE
	1603	\|\| SvIsCOW(sv)
	1604	#endif
	1605	)
	1606	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1607	else
	1608	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1609	#ifdef PERL_OLD_COPY_ON_WRITE
	1610	if (SvIsCOW_shared_hash(sv))
	1611	PerlIO_printf(file, " (HASH)");
	1612	else if (SvIsCOW_normal(sv))
	1613	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1614	#endif
	1615	PerlIO_putc(file, '\n');
	1616	}
	1617	if ((type == SVt_PVNV \|\| type == SVt_PVMG) && SvFLAGS(sv) & SVpad_NAME) {
	1618	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1619	(UV) COP_SEQ_RANGE_LOW(sv));
	1620	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1621	(UV) COP_SEQ_RANGE_HIGH(sv));
	1622	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1623	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1624	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1625	\|\| type == SVt_NV) {
	1626	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1627	/* %Vg doesn't work? --jhi */
	1628	#ifdef USE_LONG_DOUBLE
	1629	Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
	1630	#else
	1631	Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
	1632	#endif
	1633	RESTORE_NUMERIC_LOCAL();
	1634	}
	1635	if (SvROK(sv)) {
	1636	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1637	if (nest < maxnest)
	1638	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1639	}
	1640	if (type < SVt_PV) {
	1641	SvREFCNT_dec(d);
	1642	return;
	1643	}
	1644	if ((type <= SVt_PVLV && !isGV_with_GP(sv)) \|\| type == SVt_PVFM) {
	1645	if (SvPVX_const(sv)) {
	1646	STRLEN delta;
	1647	if (SvOOK(sv)) {
	1648	SvOOK_offset(sv, delta);
	1649	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1650	(UV) delta);
	1651	} else {
	1652	delta = 0;
	1653	}
	1654	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
	1655	if (SvOOK(sv)) {
	1656	PerlIO_printf(file, "( %s . ) ",
	1657	pv_display(d, SvPVX_const(sv) - delta, delta, 0,
	1658	pvlim));
	1659	}
	1660	PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
	1661	if (SvUTF8(sv)) /* the 6? \x{....} */
	1662	PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
	1663	PerlIO_printf(file, "\n");
	1664	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1665	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
	1666	}
	1667	else
	1668	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1669	}
	1670	if (type == SVt_REGEXP) {
	1671	/* FIXME dumping
	1672	Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%"UVxf"\n",
	1673	PTR2UV(((struct regexp *)SvANY(sv))->xrx_regexp));
	1674	*/
	1675	}
	1676	if (type >= SVt_PVMG) {
	1677	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1678	HV * const ost = SvOURSTASH(sv);
	1679	if (ost)
	1680	do_hv_dump(level, file, " OURSTASH", ost);
	1681	} else {
	1682	if (SvMAGIC(sv))
	1683	do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
	1684	}
	1685	if (SvSTASH(sv))
	1686	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1687	}
	1688	switch (type) {
	1689	case SVt_PVAV:
	1690	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1691	if (AvARRAY(sv) != AvALLOC(sv)) {
	1692	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1693	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1694	}
	1695	else
	1696	PerlIO_putc(file, '\n');
	1697	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1698	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1699	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1700	sv_setpvs(d, "");
	1701	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1702	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1703	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1704	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1705	if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
	1706	int count;
	1707	for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1708	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1709
	1710	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1711	if (elt)
	1712	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1713	}
	1714	}
	1715	break;
	1716	case SVt_PVHV:
	1717	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1718	if (HvARRAY(sv) && HvKEYS(sv)) {
	1719	/* Show distribution of HEs in the ARRAY */
	1720	int freq[200];
	1721	#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
	1722	int i;
	1723	int max = 0;
	1724	U32 pow2 = 2, keys = HvKEYS(sv);
	1725	NV theoret, sum = 0;
	1726
	1727	PerlIO_printf(file, " (");
	1728	Zero(freq, FREQ_MAX + 1, int);
	1729	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1730	HE* h;
	1731	int count = 0;
	1732	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1733	count++;
	1734	if (count > FREQ_MAX)
	1735	count = FREQ_MAX;
	1736	freq[count]++;
	1737	if (max < count)
	1738	max = count;
	1739	}
	1740	for (i = 0; i <= max; i++) {
	1741	if (freq[i]) {
	1742	PerlIO_printf(file, "%d%s:%d", i,
	1743	(i == FREQ_MAX) ? "+" : "",
	1744	freq[i]);
	1745	if (i != max)
	1746	PerlIO_printf(file, ", ");
	1747	}
	1748	}
	1749	PerlIO_putc(file, ')');
	1750	/* The "quality" of a hash is defined as the total number of
	1751	comparisons needed to access every element once, relative
	1752	to the expected number needed for a random hash.
	1753
	1754	The total number of comparisons is equal to the sum of
	1755	the squares of the number of entries in each bucket.
	1756	For a random hash of n keys into k buckets, the expected
	1757	value is
	1758	n + n(n-1)/2k
	1759	*/
	1760
	1761	for (i = max; i > 0; i--) { /* Precision: count down. */
	1762	sum += freq[i] * i * i;
	1763	}
	1764	while ((keys = keys >> 1))
	1765	pow2 = pow2 << 1;
	1766	theoret = HvKEYS(sv);
	1767	theoret += theoret * (theoret-1)/pow2;
	1768	PerlIO_putc(file, '\n');
	1769	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1770	}
	1771	PerlIO_putc(file, '\n');
	1772	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
	1773	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
	1774	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1775	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1776	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1777	{
	1778	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1779	if (mg && mg->mg_obj) {
	1780	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1781	}
	1782	}
	1783	{
	1784	const char * const hvname = HvNAME_get(sv);
	1785	if (hvname)
	1786	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
	1787	}
	1788	if (SvOOK(sv)) {
	1789	AV * const backrefs
	1790	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1791	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1792	if (backrefs) {
	1793	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1794	PTR2UV(backrefs));
	1795	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1796	dumpops, pvlim);
	1797	}
	1798	if (meta) {
	1799	/* FIXME - mro_algs kflags can signal a UTF-8 name. */
	1800	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
	1801	(int)meta->mro_which->length,
	1802	meta->mro_which->name,
	1803	PTR2UV(meta->mro_which));
	1804	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1805	(UV)meta->cache_gen);
	1806	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1807	(UV)meta->pkg_gen);
	1808	if (meta->mro_linear_all) {
	1809	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1810	PTR2UV(meta->mro_linear_all));
	1811	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1812	dumpops, pvlim);
	1813	}
	1814	if (meta->mro_linear_current) {
	1815	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1816	PTR2UV(meta->mro_linear_current));
	1817	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1818	dumpops, pvlim);
	1819	}
	1820	if (meta->mro_nextmethod) {
	1821	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1822	PTR2UV(meta->mro_nextmethod));
	1823	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1824	dumpops, pvlim);
	1825	}
	1826	if (meta->isa) {
	1827	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1828	PTR2UV(meta->isa));
	1829	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1830	dumpops, pvlim);
	1831	}
	1832	}
	1833	}
	1834	if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
	1835	HE *he;
	1836	HV * const hv = MUTABLE_HV(sv);
	1837	int count = maxnest - nest;
	1838
	1839	hv_iterinit(hv);
	1840	while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
	1841	&& count--) {
	1842	STRLEN len;
	1843	const U32 hash = HeHASH(he);
	1844	SV * const keysv = hv_iterkeysv(he);
	1845	const char * const keypv = SvPV_const(keysv, len);
	1846	SV * const elt = hv_iterval(hv, he);
	1847
	1848	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1849	if (SvUTF8(keysv))
	1850	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1851	if (HeKREHASH(he))
	1852	PerlIO_printf(file, "[REHASH] ");
	1853	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
	1854	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1855	}
	1856	hv_iterinit(hv); /* Return to status quo */
	1857	}
	1858	break;
	1859	case SVt_PVCV:
	1860	if (SvPOK(sv)) {
	1861	STRLEN len;
	1862	const char *const proto = SvPV_const(sv, len);
	1863	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
	1864	(int) len, proto);
	1865	}
	1866	/* FALL THROUGH */
	1867	case SVt_PVFM:
	1868	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1869	if (!CvISXSUB(sv)) {
	1870	if (CvSTART(sv)) {
	1871	Perl_dump_indent(aTHX_ level, file,
	1872	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1873	PTR2UV(CvSTART(sv)),
	1874	(IV)sequence_num(CvSTART(sv)));
	1875	}
	1876	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1877	PTR2UV(CvROOT(sv)));
	1878	if (CvROOT(sv) && dumpops) {
	1879	do_op_dump(level+1, file, CvROOT(sv));
	1880	}
	1881	} else {
	1882	SV * const constant = cv_const_sv((const CV *)sv);
	1883
	1884	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	1885
	1886	if (constant) {
	1887	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	1888	" (CONST SV)\n",
	1889	PTR2UV(CvXSUBANY(sv).any_ptr));
	1890	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	1891	pvlim);
	1892	} else {
	1893	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	1894	(IV)CvXSUBANY(sv).any_i32);
	1895	}
	1896	}
	1897	do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	1898	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	1899	if (type == SVt_PVCV)
	1900	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1901	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1902	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1903	if (type == SVt_PVFM)
	1904	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
	1905	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1906	if (nest < maxnest) {
	1907	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1908	}
	1909	{
	1910	const CV * const outside = CvOUTSIDE(sv);
	1911	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1912	PTR2UV(outside),
	1913	(!outside ? "null"
	1914	: CvANON(outside) ? "ANON"
	1915	: (outside == PL_main_cv) ? "MAIN"
	1916	: CvUNIQUE(outside) ? "UNIQUE"
	1917	: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
	1918	}
	1919	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	1920	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	1921	break;
	1922	case SVt_PVGV:
	1923	case SVt_PVLV:
	1924	if (type == SVt_PVLV) {
	1925	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	1926	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	1927	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	1928	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	1929	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
	1930	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	1931	dumpops, pvlim);
	1932	}
	1933	if (SvVALID(sv)) {
	1934	Perl_dump_indent(aTHX_ level, file, " FLAGS = %u\n", (U8)BmFLAGS(sv));
	1935	Perl_dump_indent(aTHX_ level, file, " RARE = %u\n", (U8)BmRARE(sv));
	1936	Perl_dump_indent(aTHX_ level, file, " PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
	1937	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1938	}
	1939	if (!isGV_with_GP(sv))
	1940	break;
	1941	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
	1942	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	1943	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	1944	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	1945	if (!GvGP(sv))
	1946	break;
	1947	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	1948	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	1949	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	1950	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	1951	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	1952	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	1953	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	1954	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	1955	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	1956	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	1957	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	1958	do_gv_dump (level, file, " EGV", GvEGV(sv));
	1959	break;
	1960	case SVt_PVIO:
	1961	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	1962	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	1963	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	1964	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	1965	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	1966	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	1967	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	1968	if (IoTOP_NAME(sv))
	1969	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	1970	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	1971	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	1972	else {
	1973	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	1974	PTR2UV(IoTOP_GV(sv)));
	1975	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	1976	maxnest, dumpops, pvlim);
	1977	}
	1978	/* Source filters hide things that are not GVs in these three, so let's
	1979	be careful out there. */
	1980	if (IoFMT_NAME(sv))
	1981	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	1982	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	1983	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	1984	else {
	1985	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	1986	PTR2UV(IoFMT_GV(sv)));
	1987	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	1988	maxnest, dumpops, pvlim);
	1989	}
	1990	if (IoBOTTOM_NAME(sv))
	1991	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	1992	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	1993	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	1994	else {
	1995	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	1996	PTR2UV(IoBOTTOM_GV(sv)));
	1997	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	1998	maxnest, dumpops, pvlim);
	1999	}
	2000	if (isPRINT(IoTYPE(sv)))
	2001	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2002	else
	2003	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2004	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2005	break;
	2006	}
	2007	SvREFCNT_dec(d);
	2008	}
	2009
	2010	void
	2011	Perl_sv_dump(pTHX_ SV *sv)
	2012	{
	2013	dVAR;
	2014
	2015	PERL_ARGS_ASSERT_SV_DUMP;
	2016
	2017	if (SvROK(sv))
	2018	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2019	else
	2020	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2021	}
	2022
	2023	int
	2024	Perl_runops_debug(pTHX)
	2025	{
	2026	dVAR;
	2027	if (!PL_op) {
	2028	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2029	return 0;
	2030	}
	2031
	2032	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2033	do {
	2034	if (PL_debug) {
	2035	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2036	PerlIO_printf(Perl_debug_log,
	2037	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2038	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2039	PTR2UV(*PL_watchaddr));
	2040	if (DEBUG_s_TEST_) {
	2041	if (DEBUG_v_TEST_) {
	2042	PerlIO_printf(Perl_debug_log, "\n");
	2043	deb_stack_all();
	2044	}
	2045	else
	2046	debstack();
	2047	}
	2048
	2049
	2050	if (DEBUG_t_TEST_) debop(PL_op);
	2051	if (DEBUG_P_TEST_) debprof(PL_op);
	2052	}
	2053	} while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
	2054	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2055
	2056	TAINT_NOT;
	2057	return 0;
	2058	}
	2059
	2060	I32
	2061	Perl_debop(pTHX_ const OP *o)
	2062	{
	2063	dVAR;
	2064
	2065	PERL_ARGS_ASSERT_DEBOP;
	2066
	2067	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2068	return 0;
	2069
	2070	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2071	switch (o->op_type) {
	2072	case OP_CONST:
	2073	case OP_HINTSEVAL:
	2074	/* With ITHREADS, consts are stored in the pad, and the right pad
	2075	* may not be active here, so check.
	2076	* Looks like only during compiling the pads are illegal.
	2077	*/
	2078	#ifdef USE_ITHREADS
	2079	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2080	#endif
	2081	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2082	break;
	2083	case OP_GVSV:
	2084	case OP_GV:
	2085	if (cGVOPo_gv) {
	2086	SV * const sv = newSV(0);
	2087	#ifdef PERL_MAD
	2088	/* FIXME - is this making unwarranted assumptions about the
	2089	UTF-8 cleanliness of the dump file handle? */
	2090	SvUTF8_on(sv);
	2091	#endif
	2092	gv_fullname3(sv, cGVOPo_gv, NULL);
	2093	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2094	SvREFCNT_dec(sv);
	2095	}
	2096	else
	2097	PerlIO_printf(Perl_debug_log, "(NULL)");
	2098	break;
	2099	case OP_PADSV:
	2100	case OP_PADAV:
	2101	case OP_PADHV:
	2102	{
	2103	/* print the lexical's name */
	2104	CV * const cv = deb_curcv(cxstack_ix);
	2105	SV *sv;
	2106	if (cv) {
	2107	AV * const padlist = CvPADLIST(cv);
	2108	AV * const comppad = MUTABLE_AV(*av_fetch(padlist, 0, FALSE));
	2109	sv = *av_fetch(comppad, o->op_targ, FALSE);
	2110	} else
	2111	sv = NULL;
	2112	if (sv)
	2113	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2114	else
	2115	PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
	2116	}
	2117	break;
	2118	default:
	2119	break;
	2120	}
	2121	PerlIO_printf(Perl_debug_log, "\n");
	2122	return 0;
	2123	}
	2124
	2125	STATIC CV*
	2126	S_deb_curcv(pTHX_ const I32 ix)
	2127	{
	2128	dVAR;
	2129	const PERL_CONTEXT * const cx = &cxstack[ix];
	2130	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2131	return cx->blk_sub.cv;
	2132	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2133	return PL_compcv;
	2134	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2135	return PL_main_cv;
	2136	else if (ix <= 0)
	2137	return NULL;
	2138	else
	2139	return deb_curcv(ix - 1);
	2140	}
	2141
	2142	void
	2143	Perl_watch(pTHX_ char **addr)
	2144	{
	2145	dVAR;
	2146
	2147	PERL_ARGS_ASSERT_WATCH;
	2148
	2149	PL_watchaddr = addr;
	2150	PL_watchok = *addr;
	2151	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2152	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2153	}
	2154
	2155	STATIC void
	2156	S_debprof(pTHX_ const OP *o)
	2157	{
	2158	dVAR;
	2159
	2160	PERL_ARGS_ASSERT_DEBPROF;
	2161
	2162	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2163	return;
	2164	if (!PL_profiledata)
	2165	Newxz(PL_profiledata, MAXO, U32);
	2166	++PL_profiledata[o->op_type];
	2167	}
	2168
	2169	void
	2170	Perl_debprofdump(pTHX)
	2171	{
	2172	dVAR;
	2173	unsigned i;
	2174	if (!PL_profiledata)
	2175	return;
	2176	for (i = 0; i < MAXO; i++) {
	2177	if (PL_profiledata[i])
	2178	PerlIO_printf(Perl_debug_log,
	2179	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2180	PL_op_name[i]);
	2181	}
	2182	}
	2183
	2184	#ifdef PERL_MAD
	2185	/*
	2186	* XML variants of most of the above routines
	2187	*/
	2188
	2189	STATIC void
	2190	S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2191	{
	2192	va_list args;
	2193
	2194	PERL_ARGS_ASSERT_XMLDUMP_ATTR;
	2195
	2196	PerlIO_printf(file, "\n ");
	2197	va_start(args, pat);
	2198	xmldump_vindent(level, file, pat, &args);
	2199	va_end(args);
	2200	}
	2201
	2202
	2203	void
	2204	Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2205	{
	2206	va_list args;
	2207	PERL_ARGS_ASSERT_XMLDUMP_INDENT;
	2208	va_start(args, pat);
	2209	xmldump_vindent(level, file, pat, &args);
	2210	va_end(args);
	2211	}
	2212
	2213	void
	2214	Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	2215	{
	2216	PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
	2217
	2218	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	2219	PerlIO_vprintf(file, pat, *args);
	2220	}
	2221
	2222	void
	2223	Perl_xmldump_all(pTHX)
	2224	{
	2225	xmldump_all_perl(FALSE);
	2226	}
	2227
	2228	void
	2229	Perl_xmldump_all_perl(pTHX_ bool justperl)
	2230	{
	2231	PerlIO_setlinebuf(PL_xmlfp);
	2232	if (PL_main_root)
	2233	op_xmldump(PL_main_root);
	2234	xmldump_packsubs_perl(PL_defstash, justperl);
	2235	if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
	2236	PerlIO_close(PL_xmlfp);
	2237	PL_xmlfp = 0;
	2238	}
	2239
	2240	void
	2241	Perl_xmldump_packsubs(pTHX_ const HV *stash)
	2242	{
	2243	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
	2244	xmldump_packsubs_perl(stash, FALSE);
	2245	}
	2246
	2247	void
	2248	Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	2249	{
	2250	I32 i;
	2251	HE *entry;
	2252
	2253	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
	2254
	2255	if (!HvARRAY(stash))
	2256	return;
	2257	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	2258	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	2259	GV *gv = MUTABLE_GV(HeVAL(entry));
	2260	HV *hv;
	2261	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	2262	continue;
	2263	if (GvCVu(gv))
	2264	xmldump_sub_perl(gv, justperl);
	2265	if (GvFORM(gv))
	2266	xmldump_form(gv);
	2267	if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
	2268	&& (hv = GvHV(gv)) && hv != PL_defstash)
	2269	xmldump_packsubs_perl(hv, justperl); /* nested package */
	2270	}
	2271	}
	2272	}
	2273
	2274	void
	2275	Perl_xmldump_sub(pTHX_ const GV *gv)
	2276	{
	2277	PERL_ARGS_ASSERT_XMLDUMP_SUB;
	2278	xmldump_sub_perl(gv, FALSE);
	2279	}
	2280
	2281	void
	2282	Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
	2283	{
	2284	SV * sv;
	2285
	2286	PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
	2287
	2288	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	2289	return;
	2290
	2291	sv = sv_newmortal();
	2292	gv_fullname3(sv, gv, NULL);
	2293	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
	2294	if (CvXSUB(GvCV(gv)))
	2295	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
	2296	PTR2UV(CvXSUB(GvCV(gv))),
	2297	(int)CvXSUBANY(GvCV(gv)).any_i32);
	2298	else if (CvROOT(GvCV(gv)))
	2299	op_xmldump(CvROOT(GvCV(gv)));
	2300	else
	2301	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2302	}
	2303
	2304	void
	2305	Perl_xmldump_form(pTHX_ const GV *gv)
	2306	{
	2307	SV * const sv = sv_newmortal();
	2308
	2309	PERL_ARGS_ASSERT_XMLDUMP_FORM;
	2310
	2311	gv_fullname3(sv, gv, NULL);
	2312	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
	2313	if (CvROOT(GvFORM(gv)))
	2314	op_xmldump(CvROOT(GvFORM(gv)));
	2315	else
	2316	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2317	}
	2318
	2319	void
	2320	Perl_xmldump_eval(pTHX)
	2321	{
	2322	op_xmldump(PL_eval_root);
	2323	}
	2324
	2325	char *
	2326	Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
	2327	{
	2328	PERL_ARGS_ASSERT_SV_CATXMLSV;
	2329	return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
	2330	}
	2331
	2332	char *
	2333	Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
	2334	{
	2335	unsigned int c;
	2336	const char * const e = pv + len;
	2337	const char * const start = pv;
	2338	STRLEN dsvcur;
	2339	STRLEN cl;
	2340
	2341	PERL_ARGS_ASSERT_SV_CATXMLPVN;
	2342
	2343	sv_catpvs(dsv,"");
	2344	dsvcur = SvCUR(dsv); /* in case we have to restart */
	2345
	2346	retry:
	2347	while (pv < e) {
	2348	if (utf8) {
	2349	c = utf8_to_uvchr((U8*)pv, &cl);
	2350	if (cl == 0) {
	2351	SvCUR(dsv) = dsvcur;
	2352	pv = start;
	2353	utf8 = 0;
	2354	goto retry;
	2355	}
	2356	}
	2357	else
	2358	c = (*pv & 255);
	2359
	2360	switch (c) {
	2361	case 0x00:
	2362	case 0x01:
	2363	case 0x02:
	2364	case 0x03:
	2365	case 0x04:
	2366	case 0x05:
	2367	case 0x06:
	2368	case 0x07:
	2369	case 0x08:
	2370	case 0x0b:
	2371	case 0x0c:
	2372	case 0x0e:
	2373	case 0x0f:
	2374	case 0x10:
	2375	case 0x11:
	2376	case 0x12:
	2377	case 0x13:
	2378	case 0x14:
	2379	case 0x15:
	2380	case 0x16:
	2381	case 0x17:
	2382	case 0x18:
	2383	case 0x19:
	2384	case 0x1a:
	2385	case 0x1b:
	2386	case 0x1c:
	2387	case 0x1d:
	2388	case 0x1e:
	2389	case 0x1f:
	2390	case 0x7f:
	2391	case 0x80:
	2392	case 0x81:
	2393	case 0x82:
	2394	case 0x83:
	2395	case 0x84:
	2396	case 0x86:
	2397	case 0x87:
	2398	case 0x88:
	2399	case 0x89:
	2400	case 0x90:
	2401	case 0x91:
	2402	case 0x92:
	2403	case 0x93:
	2404	case 0x94:
	2405	case 0x95:
	2406	case 0x96:
	2407	case 0x97:
	2408	case 0x98:
	2409	case 0x99:
	2410	case 0x9a:
	2411	case 0x9b:
	2412	case 0x9c:
	2413	case 0x9d:
	2414	case 0x9e:
	2415	case 0x9f:
	2416	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2417	break;
	2418	case '<':
	2419	sv_catpvs(dsv, "<");
	2420	break;
	2421	case '>':
	2422	sv_catpvs(dsv, ">");
	2423	break;
	2424	case '&':
	2425	sv_catpvs(dsv, "&");
	2426	break;
	2427	case '"':
	2428	sv_catpvs(dsv, """);
	2429	break;
	2430	default:
	2431	if (c < 0xD800) {
	2432	if (c < 32 \|\| c > 127) {
	2433	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2434	}
	2435	else {
	2436	const char string = (char) c;
	2437	sv_catpvn(dsv, &string, 1);
	2438	}
	2439	break;
	2440	}
	2441	if ((c >= 0xD800 && c <= 0xDB7F) \|\|
	2442	(c >= 0xDC00 && c <= 0xDFFF) \|\|
	2443	(c >= 0xFFF0 && c <= 0xFFFF) \|\|
	2444	c > 0x10ffff)
	2445	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2446	else
	2447	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2448	}
	2449
	2450	if (utf8)
	2451	pv += UTF8SKIP(pv);
	2452	else
	2453	pv++;
	2454	}
	2455
	2456	return SvPVX(dsv);
	2457	}
	2458
	2459	char *
	2460	Perl_sv_xmlpeek(pTHX_ SV *sv)
	2461	{
	2462	SV * const t = sv_newmortal();
	2463	STRLEN n_a;
	2464	int unref = 0;
	2465
	2466	PERL_ARGS_ASSERT_SV_XMLPEEK;
	2467
	2468	sv_utf8_upgrade(t);
	2469	sv_setpvs(t, "");
	2470	/* retry: */
	2471	if (!sv) {
	2472	sv_catpv(t, "VOID=\"\"");
	2473	goto finish;
	2474	}
	2475	else if (sv == (const SV *)0x55555555 \|\| SvTYPE(sv) == 'U') {
	2476	sv_catpv(t, "WILD=\"\"");
	2477	goto finish;
	2478	}
	2479	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	2480	if (sv == &PL_sv_undef) {
	2481	sv_catpv(t, "SV_UNDEF=\"1\"");
	2482	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2483	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2484	SvREADONLY(sv))
	2485	goto finish;
	2486	}
	2487	else if (sv == &PL_sv_no) {
	2488	sv_catpv(t, "SV_NO=\"1\"");
	2489	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2490	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2491	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2492	SVp_POK\|SVp_NOK)) &&
	2493	SvCUR(sv) == 0 &&
	2494	SvNVX(sv) == 0.0)
	2495	goto finish;
	2496	}
	2497	else if (sv == &PL_sv_yes) {
	2498	sv_catpv(t, "SV_YES=\"1\"");
	2499	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2500	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2501	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2502	SVp_POK\|SVp_NOK)) &&
	2503	SvCUR(sv) == 1 &&
	2504	SvPVX(sv) && *SvPVX(sv) == '1' &&
	2505	SvNVX(sv) == 1.0)
	2506	goto finish;
	2507	}
	2508	else {
	2509	sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
	2510	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2511	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2512	SvREADONLY(sv))
	2513	goto finish;
	2514	}
	2515	sv_catpv(t, " XXX=\"\" ");
	2516	}
	2517	else if (SvREFCNT(sv) == 0) {
	2518	sv_catpv(t, " refcnt=\"0\"");
	2519	unref++;
	2520	}
	2521	else if (DEBUG_R_TEST_) {
	2522	int is_tmp = 0;
	2523	I32 ix;
	2524	/* is this SV on the tmps stack? */
	2525	for (ix=PL_tmps_ix; ix>=0; ix--) {
	2526	if (PL_tmps_stack[ix] == sv) {
	2527	is_tmp = 1;
	2528	break;
	2529	}
	2530	}
	2531	if (SvREFCNT(sv) > 1)
	2532	Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
	2533	is_tmp ? "T" : "");
	2534	else if (is_tmp)
	2535	sv_catpv(t, " DRT=\"<T>\"");
	2536	}
	2537
	2538	if (SvROK(sv)) {
	2539	sv_catpv(t, " ROK=\"\"");
	2540	}
	2541	switch (SvTYPE(sv)) {
	2542	default:
	2543	sv_catpv(t, " FREED=\"1\"");
	2544	goto finish;
	2545
	2546	case SVt_NULL:
	2547	sv_catpv(t, " UNDEF=\"1\"");
	2548	goto finish;
	2549	case SVt_IV:
	2550	sv_catpv(t, " IV=\"");
	2551	break;
	2552	case SVt_NV:
	2553	sv_catpv(t, " NV=\"");
	2554	break;
	2555	case SVt_PV:
	2556	sv_catpv(t, " PV=\"");
	2557	break;
	2558	case SVt_PVIV:
	2559	sv_catpv(t, " PVIV=\"");
	2560	break;
	2561	case SVt_PVNV:
	2562	sv_catpv(t, " PVNV=\"");
	2563	break;
	2564	case SVt_PVMG:
	2565	sv_catpv(t, " PVMG=\"");
	2566	break;
	2567	case SVt_PVLV:
	2568	sv_catpv(t, " PVLV=\"");
	2569	break;
	2570	case SVt_PVAV:
	2571	sv_catpv(t, " AV=\"");
	2572	break;
	2573	case SVt_PVHV:
	2574	sv_catpv(t, " HV=\"");
	2575	break;
	2576	case SVt_PVCV:
	2577	if (CvGV(sv))
	2578	Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
	2579	else
	2580	sv_catpv(t, " CV=\"()\"");
	2581	goto finish;
	2582	case SVt_PVGV:
	2583	sv_catpv(t, " GV=\"");
	2584	break;
	2585	case SVt_BIND:
	2586	sv_catpv(t, " BIND=\"");
	2587	break;
	2588	case SVt_REGEXP:
	2589	sv_catpv(t, " ORANGE=\"");
	2590	break;
	2591	case SVt_PVFM:
	2592	sv_catpv(t, " FM=\"");
	2593	break;
	2594	case SVt_PVIO:
	2595	sv_catpv(t, " IO=\"");
	2596	break;
	2597	}
	2598
	2599	if (SvPOKp(sv)) {
	2600	if (SvPVX(sv)) {
	2601	sv_catxmlsv(t, sv);
	2602	}
	2603	}
	2604	else if (SvNOKp(sv)) {
	2605	STORE_NUMERIC_LOCAL_SET_STANDARD();
	2606	Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
	2607	RESTORE_NUMERIC_LOCAL();
	2608	}
	2609	else if (SvIOKp(sv)) {
	2610	if (SvIsUV(sv))
	2611	Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
	2612	else
	2613	Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
	2614	}
	2615	else
	2616	sv_catpv(t, "");
	2617	sv_catpv(t, "\"");
	2618
	2619	finish:
	2620	while (unref--)
	2621	sv_catpv(t, ")");
	2622	return SvPV(t, n_a);
	2623	}
	2624
	2625	void
	2626	Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	2627	{
	2628	PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
	2629
	2630	if (!pm) {
	2631	Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
	2632	return;
	2633	}
	2634	Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
	2635	level++;
	2636	if (PM_GETRE(pm)) {
	2637	REGEXP *const r = PM_GETRE(pm);
	2638	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2639	sv_catxmlsv(tmpsv, MUTABLE_SV(r));
	2640	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
	2641	SvPVX(tmpsv));
	2642	SvREFCNT_dec(tmpsv);
	2643	Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
	2644	(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
	2645	}
	2646	else
	2647	Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
	2648	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	2649	SV * const tmpsv = pm_description(pm);
	2650	Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2651	SvREFCNT_dec(tmpsv);
	2652	}
	2653
	2654	level--;
	2655	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	2656	Perl_xmldump_indent(aTHX_ level, file, ">\n");
	2657	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
	2658	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
	2659	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
	2660	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
	2661	}
	2662	else
	2663	Perl_xmldump_indent(aTHX_ level, file, "/>\n");
	2664	}
	2665
	2666	void
	2667	Perl_pmop_xmldump(pTHX_ const PMOP *pm)
	2668	{
	2669	do_pmop_xmldump(0, PL_xmlfp, pm);
	2670	}
	2671
	2672	void
	2673	Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
	2674	{
	2675	UV seq;
	2676	int contents = 0;
	2677
	2678	PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
	2679
	2680	if (!o)
	2681	return;
	2682	sequence(o);
	2683	seq = sequence_num(o);
	2684	Perl_xmldump_indent(aTHX_ level, file,
	2685	"<op_%s seq=\"%"UVuf" -> ",
	2686	OP_NAME(o),
	2687	seq);
	2688	level++;
	2689	if (o->op_next)
	2690	PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
	2691	sequence_num(o->op_next));
	2692	else
	2693	PerlIO_printf(file, "DONE\"");
	2694
	2695	if (o->op_targ) {
	2696	if (o->op_type == OP_NULL)
	2697	{
	2698	PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
	2699	if (o->op_targ == OP_NEXTSTATE)
	2700	{
	2701	if (CopLINE(cCOPo))
	2702	PerlIO_printf(file, " line=\"%"UVuf"\"",
	2703	(UV)CopLINE(cCOPo));
	2704	if (CopSTASHPV(cCOPo))
	2705	PerlIO_printf(file, " package=\"%s\"",
	2706	CopSTASHPV(cCOPo));
	2707	if (CopLABEL(cCOPo))
	2708	PerlIO_printf(file, " label=\"%s\"",
	2709	CopLABEL(cCOPo));
	2710	}
	2711	}
	2712	else
	2713	PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
	2714	}
	2715	#ifdef DUMPADDR
	2716	PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
	2717	#endif
	2718	if (o->op_flags) {
	2719	SV * const tmpsv = newSVpvs("");
	2720	switch (o->op_flags & OPf_WANT) {
	2721	case OPf_WANT_VOID:
	2722	sv_catpv(tmpsv, ",VOID");
	2723	break;
	2724	case OPf_WANT_SCALAR:
	2725	sv_catpv(tmpsv, ",SCALAR");
	2726	break;
	2727	case OPf_WANT_LIST:
	2728	sv_catpv(tmpsv, ",LIST");
	2729	break;
	2730	default:
	2731	sv_catpv(tmpsv, ",UNKNOWN");
	2732	break;
	2733	}
	2734	if (o->op_flags & OPf_KIDS)
	2735	sv_catpv(tmpsv, ",KIDS");
	2736	if (o->op_flags & OPf_PARENS)
	2737	sv_catpv(tmpsv, ",PARENS");
	2738	if (o->op_flags & OPf_STACKED)
	2739	sv_catpv(tmpsv, ",STACKED");
	2740	if (o->op_flags & OPf_REF)
	2741	sv_catpv(tmpsv, ",REF");
	2742	if (o->op_flags & OPf_MOD)
	2743	sv_catpv(tmpsv, ",MOD");
	2744	if (o->op_flags & OPf_SPECIAL)
	2745	sv_catpv(tmpsv, ",SPECIAL");
	2746	PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2747	SvREFCNT_dec(tmpsv);
	2748	}
	2749	if (o->op_private) {
	2750	SV * const tmpsv = newSVpvs("");
	2751	if (PL_opargs[o->op_type] & OA_TARGLEX) {
	2752	if (o->op_private & OPpTARGET_MY)
	2753	sv_catpv(tmpsv, ",TARGET_MY");
	2754	}
	2755	else if (o->op_type == OP_LEAVESUB \|\|
	2756	o->op_type == OP_LEAVE \|\|
	2757	o->op_type == OP_LEAVESUBLV \|\|
	2758	o->op_type == OP_LEAVEWRITE) {
	2759	if (o->op_private & OPpREFCOUNTED)
	2760	sv_catpv(tmpsv, ",REFCOUNTED");
	2761	}
	2762	else if (o->op_type == OP_AASSIGN) {
	2763	if (o->op_private & OPpASSIGN_COMMON)
	2764	sv_catpv(tmpsv, ",COMMON");
	2765	}
	2766	else if (o->op_type == OP_SASSIGN) {
	2767	if (o->op_private & OPpASSIGN_BACKWARDS)
	2768	sv_catpv(tmpsv, ",BACKWARDS");
	2769	}
	2770	else if (o->op_type == OP_TRANS) {
	2771	if (o->op_private & OPpTRANS_SQUASH)
	2772	sv_catpv(tmpsv, ",SQUASH");
	2773	if (o->op_private & OPpTRANS_DELETE)
	2774	sv_catpv(tmpsv, ",DELETE");
	2775	if (o->op_private & OPpTRANS_COMPLEMENT)
	2776	sv_catpv(tmpsv, ",COMPLEMENT");
	2777	if (o->op_private & OPpTRANS_IDENTICAL)
	2778	sv_catpv(tmpsv, ",IDENTICAL");
	2779	if (o->op_private & OPpTRANS_GROWS)
	2780	sv_catpv(tmpsv, ",GROWS");
	2781	}
	2782	else if (o->op_type == OP_REPEAT) {
	2783	if (o->op_private & OPpREPEAT_DOLIST)
	2784	sv_catpv(tmpsv, ",DOLIST");
	2785	}
	2786	else if (o->op_type == OP_ENTERSUB \|\|
	2787	o->op_type == OP_RV2SV \|\|
	2788	o->op_type == OP_GVSV \|\|
	2789	o->op_type == OP_RV2AV \|\|
	2790	o->op_type == OP_RV2HV \|\|
	2791	o->op_type == OP_RV2GV \|\|
	2792	o->op_type == OP_AELEM \|\|
	2793	o->op_type == OP_HELEM )
	2794	{
	2795	if (o->op_type == OP_ENTERSUB) {
	2796	if (o->op_private & OPpENTERSUB_AMPER)
	2797	sv_catpv(tmpsv, ",AMPER");
	2798	if (o->op_private & OPpENTERSUB_DB)
	2799	sv_catpv(tmpsv, ",DB");
	2800	if (o->op_private & OPpENTERSUB_HASTARG)
	2801	sv_catpv(tmpsv, ",HASTARG");
	2802	if (o->op_private & OPpENTERSUB_NOPAREN)
	2803	sv_catpv(tmpsv, ",NOPAREN");
	2804	if (o->op_private & OPpENTERSUB_INARGS)
	2805	sv_catpv(tmpsv, ",INARGS");
	2806	if (o->op_private & OPpENTERSUB_NOMOD)
	2807	sv_catpv(tmpsv, ",NOMOD");
	2808	}
	2809	else {
	2810	switch (o->op_private & OPpDEREF) {
	2811	case OPpDEREF_SV:
	2812	sv_catpv(tmpsv, ",SV");
	2813	break;
	2814	case OPpDEREF_AV:
	2815	sv_catpv(tmpsv, ",AV");
	2816	break;
	2817	case OPpDEREF_HV:
	2818	sv_catpv(tmpsv, ",HV");
	2819	break;
	2820	}
	2821	if (o->op_private & OPpMAYBE_LVSUB)
	2822	sv_catpv(tmpsv, ",MAYBE_LVSUB");
	2823	}
	2824	if (o->op_type == OP_AELEM \|\| o->op_type == OP_HELEM) {
	2825	if (o->op_private & OPpLVAL_DEFER)
	2826	sv_catpv(tmpsv, ",LVAL_DEFER");
	2827	}
	2828	else {
	2829	if (o->op_private & HINT_STRICT_REFS)
	2830	sv_catpv(tmpsv, ",STRICT_REFS");
	2831	if (o->op_private & OPpOUR_INTRO)
	2832	sv_catpv(tmpsv, ",OUR_INTRO");
	2833	}
	2834	}
	2835	else if (o->op_type == OP_CONST) {
	2836	if (o->op_private & OPpCONST_BARE)
	2837	sv_catpv(tmpsv, ",BARE");
	2838	if (o->op_private & OPpCONST_STRICT)
	2839	sv_catpv(tmpsv, ",STRICT");
	2840	if (o->op_private & OPpCONST_ARYBASE)
	2841	sv_catpv(tmpsv, ",ARYBASE");
	2842	if (o->op_private & OPpCONST_WARNING)
	2843	sv_catpv(tmpsv, ",WARNING");
	2844	if (o->op_private & OPpCONST_ENTERED)
	2845	sv_catpv(tmpsv, ",ENTERED");
	2846	}
	2847	else if (o->op_type == OP_FLIP) {
	2848	if (o->op_private & OPpFLIP_LINENUM)
	2849	sv_catpv(tmpsv, ",LINENUM");
	2850	}
	2851	else if (o->op_type == OP_FLOP) {
	2852	if (o->op_private & OPpFLIP_LINENUM)
	2853	sv_catpv(tmpsv, ",LINENUM");
	2854	}
	2855	else if (o->op_type == OP_RV2CV) {
	2856	if (o->op_private & OPpLVAL_INTRO)
	2857	sv_catpv(tmpsv, ",INTRO");
	2858	}
	2859	else if (o->op_type == OP_GV) {
	2860	if (o->op_private & OPpEARLY_CV)
	2861	sv_catpv(tmpsv, ",EARLY_CV");
	2862	}
	2863	else if (o->op_type == OP_LIST) {
	2864	if (o->op_private & OPpLIST_GUESSED)
	2865	sv_catpv(tmpsv, ",GUESSED");
	2866	}
	2867	else if (o->op_type == OP_DELETE) {
	2868	if (o->op_private & OPpSLICE)
	2869	sv_catpv(tmpsv, ",SLICE");
	2870	}
	2871	else if (o->op_type == OP_EXISTS) {
	2872	if (o->op_private & OPpEXISTS_SUB)
	2873	sv_catpv(tmpsv, ",EXISTS_SUB");
	2874	}
	2875	else if (o->op_type == OP_SORT) {
	2876	if (o->op_private & OPpSORT_NUMERIC)
	2877	sv_catpv(tmpsv, ",NUMERIC");
	2878	if (o->op_private & OPpSORT_INTEGER)
	2879	sv_catpv(tmpsv, ",INTEGER");
	2880	if (o->op_private & OPpSORT_REVERSE)
	2881	sv_catpv(tmpsv, ",REVERSE");
	2882	}
	2883	else if (o->op_type == OP_OPEN \|\| o->op_type == OP_BACKTICK) {
	2884	if (o->op_private & OPpOPEN_IN_RAW)
	2885	sv_catpv(tmpsv, ",IN_RAW");
	2886	if (o->op_private & OPpOPEN_IN_CRLF)
	2887	sv_catpv(tmpsv, ",IN_CRLF");
	2888	if (o->op_private & OPpOPEN_OUT_RAW)
	2889	sv_catpv(tmpsv, ",OUT_RAW");
	2890	if (o->op_private & OPpOPEN_OUT_CRLF)
	2891	sv_catpv(tmpsv, ",OUT_CRLF");
	2892	}
	2893	else if (o->op_type == OP_EXIT) {
	2894	if (o->op_private & OPpEXIT_VMSISH)
	2895	sv_catpv(tmpsv, ",EXIT_VMSISH");
	2896	if (o->op_private & OPpHUSH_VMSISH)
	2897	sv_catpv(tmpsv, ",HUSH_VMSISH");
	2898	}
	2899	else if (o->op_type == OP_DIE) {
	2900	if (o->op_private & OPpHUSH_VMSISH)
	2901	sv_catpv(tmpsv, ",HUSH_VMSISH");
	2902	}
	2903	else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
	2904	if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
	2905	sv_catpv(tmpsv, ",FT_ACCESS");
	2906	if (o->op_private & OPpFT_STACKED)
	2907	sv_catpv(tmpsv, ",FT_STACKED");
	2908	}
	2909	if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
	2910	sv_catpv(tmpsv, ",INTRO");
	2911	if (SvCUR(tmpsv))
	2912	S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
	2913	SvREFCNT_dec(tmpsv);
	2914	}
	2915
	2916	switch (o->op_type) {
	2917	case OP_AELEMFAST:
	2918	if (o->op_flags & OPf_SPECIAL) {
	2919	break;
	2920	}
	2921	case OP_GVSV:
	2922	case OP_GV:
	2923	#ifdef USE_ITHREADS
	2924	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
	2925	#else
	2926	if (cSVOPo->op_sv) {
	2927	SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
	2928	SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
	2929	char *s;
	2930	STRLEN len;
	2931	ENTER;
	2932	SAVEFREESV(tmpsv1);
	2933	SAVEFREESV(tmpsv2);
	2934	gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
	2935	s = SvPV(tmpsv1,len);
	2936	sv_catxmlpvn(tmpsv2, s, len, 1);
	2937	S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
	2938	LEAVE;
	2939	}
	2940	else
	2941	S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
	2942	#endif
	2943	break;
	2944	case OP_CONST:
	2945	case OP_HINTSEVAL:
	2946	case OP_METHOD_NAMED:
	2947	#ifndef USE_ITHREADS
	2948	/* with ITHREADS, consts are stored in the pad, and the right pad
	2949	* may not be active here, so skip */
	2950	S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
	2951	#endif
	2952	break;
	2953	case OP_ANONCODE:
	2954	if (!contents) {
	2955	contents = 1;
	2956	PerlIO_printf(file, ">\n");
	2957	}
	2958	do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
	2959	break;
	2960	case OP_NEXTSTATE:
	2961	case OP_DBSTATE:
	2962	if (CopLINE(cCOPo))
	2963	S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
	2964	(UV)CopLINE(cCOPo));
	2965	if (CopSTASHPV(cCOPo))
	2966	S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
	2967	CopSTASHPV(cCOPo));
	2968	if (CopLABEL(cCOPo))
	2969	S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
	2970	CopLABEL(cCOPo));
	2971	break;
	2972	case OP_ENTERLOOP:
	2973	S_xmldump_attr(aTHX_ level, file, "redo=\"");
	2974	if (cLOOPo->op_redoop)
	2975	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
	2976	else
	2977	PerlIO_printf(file, "DONE\"");
	2978	S_xmldump_attr(aTHX_ level, file, "next=\"");
	2979	if (cLOOPo->op_nextop)
	2980	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
	2981	else
	2982	PerlIO_printf(file, "DONE\"");
	2983	S_xmldump_attr(aTHX_ level, file, "last=\"");
	2984	if (cLOOPo->op_lastop)
	2985	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
	2986	else
	2987	PerlIO_printf(file, "DONE\"");
	2988	break;
	2989	case OP_COND_EXPR:
	2990	case OP_RANGE:
	2991	case OP_MAPWHILE:
	2992	case OP_GREPWHILE:
	2993	case OP_OR:
	2994	case OP_AND:
	2995	S_xmldump_attr(aTHX_ level, file, "other=\"");
	2996	if (cLOGOPo->op_other)
	2997	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
	2998	else
	2999	PerlIO_printf(file, "DONE\"");
	3000	break;
	3001	case OP_LEAVE:
	3002	case OP_LEAVEEVAL:
	3003	case OP_LEAVESUB:
	3004	case OP_LEAVESUBLV:
	3005	case OP_LEAVEWRITE:
	3006	case OP_SCOPE:
	3007	if (o->op_private & OPpREFCOUNTED)
	3008	S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
	3009	break;
	3010	default:
	3011	break;
	3012	}
	3013
	3014	if (PL_madskills && o->op_madprop) {
	3015	char prevkey = '\0';
	3016	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	3017	const MADPROP* mp = o->op_madprop;
	3018
	3019	if (!contents) {
	3020	contents = 1;
	3021	PerlIO_printf(file, ">\n");
	3022	}
	3023	Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
	3024	level++;
	3025	while (mp) {
	3026	char tmp = mp->mad_key;
	3027	sv_setpvs(tmpsv,"\"");
	3028	if (tmp)
	3029	sv_catxmlpvn(tmpsv, &tmp, 1, 0);
	3030	if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
	3031	sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
	3032	else
	3033	prevkey = tmp;
	3034	sv_catpv(tmpsv, "\"");
	3035	switch (mp->mad_type) {
	3036	case MAD_NULL:
	3037	sv_catpv(tmpsv, "NULL");
	3038	Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
	3039	break;
	3040	case MAD_PV:
	3041	sv_catpv(tmpsv, " val=\"");
	3042	sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
	3043	sv_catpv(tmpsv, "\"");
	3044	Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
	3045	break;
	3046	case MAD_SV:
	3047	sv_catpv(tmpsv, " val=\"");
	3048	sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
	3049	sv_catpv(tmpsv, "\"");
	3050	Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
	3051	break;
	3052	case MAD_OP:
	3053	if ((OP*)mp->mad_val) {
	3054	Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
	3055	do_op_xmldump(level+1, file, (OP*)mp->mad_val);
	3056	Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
	3057	}
	3058	break;
	3059	default:
	3060	Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
	3061	break;
	3062	}
	3063	mp = mp->mad_next;
	3064	}
	3065	level--;
	3066	Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
	3067
	3068	SvREFCNT_dec(tmpsv);
	3069	}
	3070
	3071	switch (o->op_type) {
	3072	case OP_PUSHRE:
	3073	case OP_MATCH:
	3074	case OP_QR:
	3075	case OP_SUBST:
	3076	if (!contents) {
	3077	contents = 1;
	3078	PerlIO_printf(file, ">\n");
	3079	}
	3080	do_pmop_xmldump(level, file, cPMOPo);
	3081	break;
	3082	default:
	3083	break;
	3084	}
	3085
	3086	if (o->op_flags & OPf_KIDS) {
	3087	OP *kid;
	3088	if (!contents) {
	3089	contents = 1;
	3090	PerlIO_printf(file, ">\n");
	3091	}
	3092	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	3093	do_op_xmldump(level, file, kid);
	3094	}
	3095
	3096	if (contents)
	3097	Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
	3098	else
	3099	PerlIO_printf(file, " />\n");
	3100	}
	3101
	3102	void
	3103	Perl_op_xmldump(pTHX_ const OP *o)
	3104	{
	3105	PERL_ARGS_ASSERT_OP_XMLDUMP;
	3106
	3107	do_op_xmldump(0, PL_xmlfp, o);
	3108	}
	3109	#endif
	3110
	3111	/*
	3112	* Local variables:
	3113	* c-indentation-style: bsd
	3114	* c-basic-offset: 4
	3115	* indent-tabs-mode: t
	3116	* End:
	3117	*
	3118	* ex: set ts=8 sts=4 sw=4 noet:
	3119	*/