perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

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