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

... / ...

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