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