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 && 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
	872	= op_private_names + C_ARRAY_LENGTH(op_private_names);
	873
	874	/* This is a linear search, but no worse than the code that it replaced.
	875	It's debugging code - size is more important than speed. */
	876	do {
	877	if (optype == start->op_type) {
	878	S_append_flags(aTHX_ tmpsv, op_private, start->start,
	879	start->start + start->len);
	880	return TRUE;
	881	}
	882	} while (++start < end);
	883	return FALSE;
	884	}
	885
	886	#define DUMP_OP_FLAGS(o,xml,level,file) \
	887	if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) { \
	888	SV * const tmpsv = newSVpvs(""); \
	889	switch (o->op_flags & OPf_WANT) { \
	890	case OPf_WANT_VOID: \
	891	sv_catpv(tmpsv, ",VOID"); \
	892	break; \
	893	case OPf_WANT_SCALAR: \
	894	sv_catpv(tmpsv, ",SCALAR"); \
	895	break; \
	896	case OPf_WANT_LIST: \
	897	sv_catpv(tmpsv, ",LIST"); \
	898	break; \
	899	default: \
	900	sv_catpv(tmpsv, ",UNKNOWN"); \
	901	break; \
	902	} \
	903	append_flags(tmpsv, o->op_flags, op_flags_names); \
	904	if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
	905	if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
	906	if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
	907	if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED"); \
	908	if (!xml) \
	909	Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
	910	SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
	911	else \
	912	PerlIO_printf(file, " flags=\"%s\"", \
	913	SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
	914	}
	915
	916	#if !defined(PERL_MAD)
	917	# define xmldump_attr1(level, file, pat, arg)
	918	#else
	919	# define xmldump_attr1(level, file, pat, arg) \
	920	S_xmldump_attr(aTHX_ level, file, pat, arg)
	921	#endif
	922
	923	#define DUMP_OP_PRIVATE(o,xml,level,file) \
	924	if (o->op_private) { \
	925	U32 optype = o->op_type; \
	926	U32 oppriv = o->op_private; \
	927	SV * const tmpsv = newSVpvs(""); \
	928	if (PL_opargs[optype] & OA_TARGLEX) { \
	929	if (oppriv & OPpTARGET_MY) \
	930	sv_catpv(tmpsv, ",TARGET_MY"); \
	931	} \
	932	else if (optype == OP_ENTERSUB \|\| \
	933	optype == OP_RV2SV \|\| \
	934	optype == OP_GVSV \|\| \
	935	optype == OP_RV2AV \|\| \
	936	optype == OP_RV2HV \|\| \
	937	optype == OP_RV2GV \|\| \
	938	optype == OP_AELEM \|\| \
	939	optype == OP_HELEM ) \
	940	{ \
	941	if (optype == OP_ENTERSUB) { \
	942	append_flags(tmpsv, oppriv, op_entersub_names); \
	943	} \
	944	else { \
	945	switch (oppriv & OPpDEREF) { \
	946	case OPpDEREF_SV: \
	947	sv_catpv(tmpsv, ",SV"); \
	948	break; \
	949	case OPpDEREF_AV: \
	950	sv_catpv(tmpsv, ",AV"); \
	951	break; \
	952	case OPpDEREF_HV: \
	953	sv_catpv(tmpsv, ",HV"); \
	954	break; \
	955	} \
	956	if (oppriv & OPpMAYBE_LVSUB) \
	957	sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
	958	} \
	959	if (optype == OP_AELEM \|\| optype == OP_HELEM) { \
	960	if (oppriv & OPpLVAL_DEFER) \
	961	sv_catpv(tmpsv, ",LVAL_DEFER"); \
	962	} \
	963	else if (optype == OP_RV2HV \|\| optype == OP_PADHV) { \
	964	if (oppriv & OPpMAYBE_TRUEBOOL) \
	965	sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
	966	if (oppriv & OPpTRUEBOOL) \
	967	sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
	968	} \
	969	else { \
	970	if (oppriv & HINT_STRICT_REFS) \
	971	sv_catpv(tmpsv, ",STRICT_REFS"); \
	972	if (oppriv & OPpOUR_INTRO) \
	973	sv_catpv(tmpsv, ",OUR_INTRO"); \
	974	} \
	975	} \
	976	else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
	977	} \
	978	else if (OP_IS_FILETEST(o->op_type)) { \
	979	if (oppriv & OPpFT_ACCESS) \
	980	sv_catpv(tmpsv, ",FT_ACCESS"); \
	981	if (oppriv & OPpFT_STACKED) \
	982	sv_catpv(tmpsv, ",FT_STACKED"); \
	983	if (oppriv & OPpFT_STACKING) \
	984	sv_catpv(tmpsv, ",FT_STACKING"); \
	985	if (oppriv & OPpFT_AFTER_t) \
	986	sv_catpv(tmpsv, ",AFTER_t"); \
	987	} \
	988	else if (o->op_type == OP_AASSIGN) { \
	989	if (oppriv & OPpASSIGN_COMMON) \
	990	sv_catpvs(tmpsv, ",COMMON"); \
	991	if (oppriv & OPpMAYBE_LVSUB) \
	992	sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
	993	} \
	994	if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
	995	sv_catpv(tmpsv, ",INTRO"); \
	996	if (o->op_type == OP_PADRANGE) \
	997	Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
	998	(UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
	999	if ( (o->op_type == OP_RV2HV \|\| o->op_type == OP_RV2AV \|\| \
	1000	o->op_type == OP_PADAV \|\| o->op_type == OP_PADHV \|\| \
	1001	o->op_type == OP_ASLICE \|\| o->op_type == OP_HSLICE) \
	1002	&& oppriv & OPpSLICEWARNING ) \
	1003	sv_catpvs(tmpsv, ",SLICEWARNING"); \
	1004	if (SvCUR(tmpsv)) { \
	1005	if (xml) \
	1006	xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
	1007	else \
	1008	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
	1009	} else if (!xml) \
	1010	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
	1011	(UV)oppriv); \
	1012	}
	1013
	1014
	1015	void
	1016	Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
	1017	{
	1018	dVAR;
	1019	UV seq;
	1020	const OPCODE optype = o->op_type;
	1021
	1022	PERL_ARGS_ASSERT_DO_OP_DUMP;
	1023
	1024	Perl_dump_indent(aTHX_ level, file, "{\n");
	1025	level++;
	1026	seq = sequence_num(o);
	1027	if (seq)
	1028	PerlIO_printf(file, "%-4"UVuf, seq);
	1029	else
	1030	PerlIO_printf(file, "????");
	1031	PerlIO_printf(file,
	1032	"%*sTYPE = %s ===> ",
	1033	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
	1034	if (o->op_next)
	1035	PerlIO_printf(file,
	1036	o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
	1037	sequence_num(o->op_next));
	1038	else
	1039	PerlIO_printf(file, "NULL\n");
	1040	if (o->op_targ) {
	1041	if (optype == OP_NULL) {
	1042	Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
	1043	if (o->op_targ == OP_NEXTSTATE) {
	1044	if (CopLINE(cCOPo))
	1045	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	1046	(UV)CopLINE(cCOPo));
	1047	if (CopSTASHPV(cCOPo)) {
	1048	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1049	HV *stash = CopSTASH(cCOPo);
	1050	const char * const hvname = HvNAME_get(stash);
	1051
	1052	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	1053	generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1054	}
	1055	if (CopLABEL(cCOPo)) {
	1056	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1057	STRLEN label_len;
	1058	U32 label_flags;
	1059	const char *label = CopLABEL_len_flags(cCOPo,
	1060	&label_len,
	1061	&label_flags);
	1062	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	1063	generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
	1064	}
	1065
	1066	}
	1067	}
	1068	else
	1069	Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
	1070	}
	1071	#ifdef DUMPADDR
	1072	Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
	1073	#endif
	1074
	1075	DUMP_OP_FLAGS(o,0,level,file);
	1076	DUMP_OP_PRIVATE(o,0,level,file);
	1077
	1078	#ifdef PERL_MAD
	1079	if (PL_madskills && o->op_madprop) {
	1080	SV * const tmpsv = newSVpvs("");
	1081	MADPROP* mp = o->op_madprop;
	1082	Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
	1083	level++;
	1084	while (mp) {
	1085	const char tmp = mp->mad_key;
	1086	sv_setpvs(tmpsv,"'");
	1087	if (tmp)
	1088	sv_catpvn(tmpsv, &tmp, 1);
	1089	sv_catpv(tmpsv, "'=");
	1090	switch (mp->mad_type) {
	1091	case MAD_NULL:
	1092	sv_catpv(tmpsv, "NULL");
	1093	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1094	break;
	1095	case MAD_PV:
	1096	sv_catpv(tmpsv, "<");
	1097	sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
	1098	sv_catpv(tmpsv, ">");
	1099	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1100	break;
	1101	case MAD_OP:
	1102	if ((OP*)mp->mad_val) {
	1103	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1104	do_op_dump(level, file, (OP*)mp->mad_val);
	1105	}
	1106	break;
	1107	default:
	1108	sv_catpv(tmpsv, "(UNK)");
	1109	Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
	1110	break;
	1111	}
	1112	mp = mp->mad_next;
	1113	}
	1114	level--;
	1115	Perl_dump_indent(aTHX_ level, file, "}\n");
	1116	}
	1117	#endif
	1118
	1119	switch (optype) {
	1120	case OP_AELEMFAST:
	1121	case OP_GVSV:
	1122	case OP_GV:
	1123	#ifdef USE_ITHREADS
	1124	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
	1125	#else
	1126	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
	1127	if (cSVOPo->op_sv) {
	1128	STRLEN len;
	1129	const char * name;
	1130	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	1131	SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
	1132	#ifdef PERL_MAD
	1133	/* FIXME - is this making unwarranted assumptions about the
	1134	UTF-8 cleanliness of the dump file handle? */
	1135	SvUTF8_on(tmpsv);
	1136	#endif
	1137	gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
	1138	name = SvPV_const(tmpsv, len);
	1139	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
	1140	generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
	1141	}
	1142	else
	1143	Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
	1144	}
	1145	#endif
	1146	break;
	1147	case OP_CONST:
	1148	case OP_HINTSEVAL:
	1149	case OP_METHOD_NAMED:
	1150	#ifndef USE_ITHREADS
	1151	/* with ITHREADS, consts are stored in the pad, and the right pad
	1152	* may not be active here, so skip */
	1153	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
	1154	#endif
	1155	break;
	1156	case OP_NEXTSTATE:
	1157	case OP_DBSTATE:
	1158	if (CopLINE(cCOPo))
	1159	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	1160	(UV)CopLINE(cCOPo));
	1161	if (CopSTASHPV(cCOPo)) {
	1162	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1163	HV *stash = CopSTASH(cCOPo);
	1164	const char * const hvname = HvNAME_get(stash);
	1165
	1166	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	1167	generic_pv_escape(tmpsv, hvname,
	1168	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1169	}
	1170	if (CopLABEL(cCOPo)) {
	1171	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1172	STRLEN label_len;
	1173	U32 label_flags;
	1174	const char *label = CopLABEL_len_flags(cCOPo,
	1175	&label_len, &label_flags);
	1176	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	1177	generic_pv_escape( tmpsv, label, label_len,
	1178	(label_flags & SVf_UTF8)));
	1179	}
	1180	break;
	1181	case OP_ENTERLOOP:
	1182	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
	1183	if (cLOOPo->op_redoop)
	1184	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
	1185	else
	1186	PerlIO_printf(file, "DONE\n");
	1187	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
	1188	if (cLOOPo->op_nextop)
	1189	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
	1190	else
	1191	PerlIO_printf(file, "DONE\n");
	1192	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
	1193	if (cLOOPo->op_lastop)
	1194	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
	1195	else
	1196	PerlIO_printf(file, "DONE\n");
	1197	break;
	1198	case OP_COND_EXPR:
	1199	case OP_RANGE:
	1200	case OP_MAPWHILE:
	1201	case OP_GREPWHILE:
	1202	case OP_OR:
	1203	case OP_AND:
	1204	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
	1205	if (cLOGOPo->op_other)
	1206	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
	1207	else
	1208	PerlIO_printf(file, "DONE\n");
	1209	break;
	1210	case OP_PUSHRE:
	1211	case OP_MATCH:
	1212	case OP_QR:
	1213	case OP_SUBST:
	1214	do_pmop_dump(level, file, cPMOPo);
	1215	break;
	1216	case OP_LEAVE:
	1217	case OP_LEAVEEVAL:
	1218	case OP_LEAVESUB:
	1219	case OP_LEAVESUBLV:
	1220	case OP_LEAVEWRITE:
	1221	case OP_SCOPE:
	1222	if (o->op_private & OPpREFCOUNTED)
	1223	Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
	1224	break;
	1225	default:
	1226	break;
	1227	}
	1228	if (o->op_flags & OPf_KIDS) {
	1229	OP *kid;
	1230	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	1231	do_op_dump(level, file, kid);
	1232	}
	1233	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	1234	}
	1235
	1236	/*
	1237	=for apidoc op_dump
	1238
	1239	Dumps the optree starting at OP C<o> to C<STDERR>.
	1240
	1241	=cut
	1242	*/
	1243
	1244	void
	1245	Perl_op_dump(pTHX_ const OP *o)
	1246	{
	1247	PERL_ARGS_ASSERT_OP_DUMP;
	1248	do_op_dump(0, Perl_debug_log, o);
	1249	}
	1250
	1251	void
	1252	Perl_gv_dump(pTHX_ GV *gv)
	1253	{
	1254	STRLEN len;
	1255	const char* name;
	1256	SV sv, tmp = newSVpvs_flags("", SVs_TEMP);
	1257
	1258
	1259	PERL_ARGS_ASSERT_GV_DUMP;
	1260
	1261	if (!gv) {
	1262	PerlIO_printf(Perl_debug_log, "{}\n");
	1263	return;
	1264	}
	1265	sv = sv_newmortal();
	1266	PerlIO_printf(Perl_debug_log, "{\n");
	1267	gv_fullname3(sv, gv, NULL);
	1268	name = SvPV_const(sv, len);
	1269	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
	1270	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1271	if (gv != GvEGV(gv)) {
	1272	gv_efullname3(sv, GvEGV(gv), NULL);
	1273	name = SvPV_const(sv, len);
	1274	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
	1275	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1276	}
	1277	PerlIO_putc(Perl_debug_log, '\n');
	1278	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
	1279	}
	1280
	1281
	1282	/* map magic types to the symbolic names
	1283	* (with the PERL_MAGIC_ prefixed stripped)
	1284	*/
	1285
	1286	static const struct { const char type; const char *name; } magic_names[] = {
	1287	#include "mg_names.c"
	1288	/* this null string terminates the list */
	1289	{ 0, NULL },
	1290	};
	1291
	1292	void
	1293	Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1294	{
	1295	PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
	1296
	1297	for (; mg; mg = mg->mg_moremagic) {
	1298	Perl_dump_indent(aTHX_ level, file,
	1299	" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
	1300	if (mg->mg_virtual) {
	1301	const MGVTBL * const v = mg->mg_virtual;
	1302	if (v >= PL_magic_vtables
	1303	&& v < PL_magic_vtables + magic_vtable_max) {
	1304	const U32 i = v - PL_magic_vtables;
	1305	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
	1306	}
	1307	else
	1308	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
	1309	}
	1310	else
	1311	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
	1312
	1313	if (mg->mg_private)
	1314	Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
	1315
	1316	{
	1317	int n;
	1318	const char *name = NULL;
	1319	for (n = 0; magic_names[n].name; n++) {
	1320	if (mg->mg_type == magic_names[n].type) {
	1321	name = magic_names[n].name;
	1322	break;
	1323	}
	1324	}
	1325	if (name)
	1326	Perl_dump_indent(aTHX_ level, file,
	1327	" MG_TYPE = PERL_MAGIC_%s\n", name);
	1328	else
	1329	Perl_dump_indent(aTHX_ level, file,
	1330	" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
	1331	}
	1332
	1333	if (mg->mg_flags) {
	1334	Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
	1335	if (mg->mg_type == PERL_MAGIC_envelem &&
	1336	mg->mg_flags & MGf_TAINTEDDIR)
	1337	Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
	1338	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1339	mg->mg_flags & MGf_MINMATCH)
	1340	Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
	1341	if (mg->mg_flags & MGf_REFCOUNTED)
	1342	Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
	1343	if (mg->mg_flags & MGf_GSKIP)
	1344	Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
	1345	if (mg->mg_flags & MGf_COPY)
	1346	Perl_dump_indent(aTHX_ level, file, " COPY\n");
	1347	if (mg->mg_flags & MGf_DUP)
	1348	Perl_dump_indent(aTHX_ level, file, " DUP\n");
	1349	if (mg->mg_flags & MGf_LOCAL)
	1350	Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
	1351	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1352	mg->mg_flags & MGf_BYTES)
	1353	Perl_dump_indent(aTHX_ level, file, " BYTES\n");
	1354	}
	1355	if (mg->mg_obj) {
	1356	Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
	1357	PTR2UV(mg->mg_obj));
	1358	if (mg->mg_type == PERL_MAGIC_qr) {
	1359	REGEXP* const re = (REGEXP *)mg->mg_obj;
	1360	SV * const dsv = sv_newmortal();
	1361	const char * const s
	1362	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
	1363	60, NULL, NULL,
	1364	( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
	1365	(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
	1366	);
	1367	Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
	1368	Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
	1369	(IV)RX_REFCNT(re));
	1370	}
	1371	if (mg->mg_flags & MGf_REFCOUNTED)
	1372	do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
	1373	}
	1374	if (mg->mg_len)
	1375	Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
	1376	if (mg->mg_ptr) {
	1377	Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
	1378	if (mg->mg_len >= 0) {
	1379	if (mg->mg_type != PERL_MAGIC_utf8) {
	1380	SV * const sv = newSVpvs("");
	1381	PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
	1382	SvREFCNT_dec_NN(sv);
	1383	}
	1384	}
	1385	else if (mg->mg_len == HEf_SVKEY) {
	1386	PerlIO_puts(file, " => HEf_SVKEY\n");
	1387	do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
	1388	maxnest, dumpops, pvlim); /* MG is already +1 */
	1389	continue;
	1390	}
	1391	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1392	else
	1393	PerlIO_puts(
	1394	file,
	1395	" ???? - " __FILE__
	1396	" does not know how to handle this MG_LEN"
	1397	);
	1398	PerlIO_putc(file, '\n');
	1399	}
	1400	if (mg->mg_type == PERL_MAGIC_utf8) {
	1401	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1402	if (cache) {
	1403	IV i;
	1404	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1405	Perl_dump_indent(aTHX_ level, file,
	1406	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1407	i,
	1408	(UV)cache[i * 2],
	1409	(UV)cache[i * 2 + 1]);
	1410	}
	1411	}
	1412	}
	1413	}
	1414
	1415	void
	1416	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1417	{
	1418	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1419	}
	1420
	1421	void
	1422	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1423	{
	1424	const char *hvname;
	1425
	1426	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1427
	1428	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1429	if (sv && (hvname = HvNAME_get(sv)))
	1430	{
	1431	/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
	1432	name which quite legally could contain insane things like tabs, newlines, nulls or
	1433	other scary crap - this should produce sane results - except maybe for unicode package
	1434	names - but we will wait for someone to file a bug on that - demerphq */
	1435	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	1436	PerlIO_printf(file, "\t\"%s\"\n",
	1437	generic_pv_escape( tmpsv, hvname,
	1438	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1439	}
	1440	else
	1441	PerlIO_putc(file, '\n');
	1442	}
	1443
	1444	void
	1445	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1446	{
	1447	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1448
	1449	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1450	if (sv && GvNAME(sv)) {
	1451	SV * const tmpsv = newSVpvs("");
	1452	PerlIO_printf(file, "\t\"%s\"\n",
	1453	generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
	1454	}
	1455	else
	1456	PerlIO_putc(file, '\n');
	1457	}
	1458
	1459	void
	1460	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1461	{
	1462	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1463
	1464	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1465	if (sv && GvNAME(sv)) {
	1466	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1467	const char *hvname;
	1468	HV * const stash = GvSTASH(sv);
	1469	PerlIO_printf(file, "\t");
	1470	/* TODO might have an extra \" here */
	1471	if (stash && (hvname = HvNAME_get(stash))) {
	1472	PerlIO_printf(file, "\"%s\" :: \"",
	1473	generic_pv_escape(tmp, hvname,
	1474	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1475	}
	1476	PerlIO_printf(file, "%s\"\n",
	1477	generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
	1478	}
	1479	else
	1480	PerlIO_putc(file, '\n');
	1481	}
	1482
	1483	const struct flag_to_name first_sv_flags_names[] = {
	1484	{SVs_TEMP, "TEMP,"},
	1485	{SVs_OBJECT, "OBJECT,"},
	1486	{SVs_GMG, "GMG,"},
	1487	{SVs_SMG, "SMG,"},
	1488	{SVs_RMG, "RMG,"},
	1489	{SVf_IOK, "IOK,"},
	1490	{SVf_NOK, "NOK,"},
	1491	{SVf_POK, "POK,"}
	1492	};
	1493
	1494	const struct flag_to_name second_sv_flags_names[] = {
	1495	{SVf_OOK, "OOK,"},
	1496	{SVf_FAKE, "FAKE,"},
	1497	{SVf_READONLY, "READONLY,"},
	1498	{SVf_IsCOW, "IsCOW,"},
	1499	{SVf_BREAK, "BREAK,"},
	1500	{SVf_AMAGIC, "OVERLOAD,"},
	1501	{SVp_IOK, "pIOK,"},
	1502	{SVp_NOK, "pNOK,"},
	1503	{SVp_POK, "pPOK,"}
	1504	};
	1505
	1506	const struct flag_to_name cv_flags_names[] = {
	1507	{CVf_ANON, "ANON,"},
	1508	{CVf_UNIQUE, "UNIQUE,"},
	1509	{CVf_CLONE, "CLONE,"},
	1510	{CVf_CLONED, "CLONED,"},
	1511	{CVf_CONST, "CONST,"},
	1512	{CVf_NODEBUG, "NODEBUG,"},
	1513	{CVf_LVALUE, "LVALUE,"},
	1514	{CVf_METHOD, "METHOD,"},
	1515	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1516	{CVf_CVGV_RC, "CVGV_RC,"},
	1517	{CVf_DYNFILE, "DYNFILE,"},
	1518	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1519	{CVf_HASEVAL, "HASEVAL"},
	1520	{CVf_SLABBED, "SLABBED,"},
	1521	{CVf_ISXSUB, "ISXSUB,"}
	1522	};
	1523
	1524	const struct flag_to_name hv_flags_names[] = {
	1525	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1526	{SVphv_LAZYDEL, "LAZYDEL,"},
	1527	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	1528	{SVphv_CLONEABLE, "CLONEABLE,"}
	1529	};
	1530
	1531	const struct flag_to_name gp_flags_names[] = {
	1532	{GVf_INTRO, "INTRO,"},
	1533	{GVf_MULTI, "MULTI,"},
	1534	{GVf_ASSUMECV, "ASSUMECV,"},
	1535	{GVf_IN_PAD, "IN_PAD,"}
	1536	};
	1537
	1538	const struct flag_to_name gp_flags_imported_names[] = {
	1539	{GVf_IMPORTED_SV, " SV"},
	1540	{GVf_IMPORTED_AV, " AV"},
	1541	{GVf_IMPORTED_HV, " HV"},
	1542	{GVf_IMPORTED_CV, " CV"},
	1543	};
	1544
	1545	/* NOTE: this structure is mostly duplicative of one generated by
	1546	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1547	* the two. - Yves */
	1548	const struct flag_to_name regexp_extflags_names[] = {
	1549	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1550	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1551	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1552	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1553	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1554	{RXf_IS_ANCHORED, "IS_ANCHORED,"},
	1555	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1556	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1557	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1558	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1559	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1560	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1561	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1562	{RXf_SPLIT, "SPLIT,"},
	1563	{RXf_COPY_DONE, "COPY_DONE,"},
	1564	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1565	{RXf_TAINTED, "TAINTED,"},
	1566	{RXf_START_ONLY, "START_ONLY,"},
	1567	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1568	{RXf_WHITE, "WHITE,"},
	1569	{RXf_NULL, "NULL,"},
	1570	};
	1571
	1572	/* NOTE: this structure is mostly duplicative of one generated by
	1573	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1574	* the two. - Yves */
	1575	const struct flag_to_name regexp_core_intflags_names[] = {
	1576	{PREGf_SKIP, "SKIP,"},
	1577	{PREGf_IMPLICIT, "IMPLICIT,"},
	1578	{PREGf_NAUGHTY, "NAUGHTY,"},
	1579	{PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
	1580	{PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
	1581	{PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
	1582	{PREGf_NOSCAN, "NOSCAN,"},
	1583	{PREGf_CANY_SEEN, "CANY_SEEN,"},
	1584	{PREGf_GPOS_SEEN, "GPOS_SEEN,"},
	1585	{PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1586	{PREGf_ANCH_BOL, "ANCH_BOL,"},
	1587	{PREGf_ANCH_MBOL, "ANCH_MBOL,"},
	1588	{PREGf_ANCH_SBOL, "ANCH_SBOL,"},
	1589	{PREGf_ANCH_GPOS, "ANCH_GPOS,"},
	1590	};
	1591
	1592	void
	1593	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1594	{
	1595	dVAR;
	1596	SV *d;
	1597	const char *s;
	1598	U32 flags;
	1599	U32 type;
	1600
	1601	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1602
	1603	if (!sv) {
	1604	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1605	return;
	1606	}
	1607
	1608	flags = SvFLAGS(sv);
	1609	type = SvTYPE(sv);
	1610
	1611	/* process general SV flags */
	1612
	1613	d = Perl_newSVpvf(aTHX_
	1614	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1615	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1616	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1617	(int)(PL_dumpindent*level), "");
	1618
	1619	if (!((flags & SVpad_NAME) == SVpad_NAME
	1620	&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1621	if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
	1622	sv_catpv(d, "PADSTALE,");
	1623	}
	1624	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
	1625	if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
	1626	sv_catpv(d, "PADTMP,");
	1627	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
	1628	}
	1629	append_flags(d, flags, first_sv_flags_names);
	1630	if (flags & SVf_ROK) {
	1631	sv_catpv(d, "ROK,");
	1632	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1633	}
	1634	append_flags(d, flags, second_sv_flags_names);
	1635	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1636	&& type != SVt_PVAV) {
	1637	if (SvPCS_IMPORTED(sv))
	1638	sv_catpv(d, "PCS_IMPORTED,");
	1639	else
	1640	sv_catpv(d, "SCREAM,");
	1641	}
	1642
	1643	/* process type-specific SV flags */
	1644
	1645	switch (type) {
	1646	case SVt_PVCV:
	1647	case SVt_PVFM:
	1648	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1649	break;
	1650	case SVt_PVHV:
	1651	append_flags(d, flags, hv_flags_names);
	1652	break;
	1653	case SVt_PVGV:
	1654	case SVt_PVLV:
	1655	if (isGV_with_GP(sv)) {
	1656	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1657	}
	1658	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1659	sv_catpv(d, "IMPORT");
	1660	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1661	sv_catpv(d, "ALL,");
	1662	else {
	1663	sv_catpv(d, "(");
	1664	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1665	sv_catpv(d, " ),");
	1666	}
	1667	}
	1668	/* FALL THROUGH */
	1669	default:
	1670	evaled_or_uv:
	1671	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1672	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1673	break;
	1674	case SVt_PVMG:
	1675	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1676	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1677	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1678	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1679	/* FALL THROUGH */
	1680	case SVt_PVNV:
	1681	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1682	goto evaled_or_uv;
	1683	case SVt_PVAV:
	1684	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
	1685	break;
	1686	}
	1687	/* SVphv_SHAREKEYS is also 0x20000000 */
	1688	if ((type != SVt_PVHV) && SvUTF8(sv))
	1689	sv_catpv(d, "UTF8");
	1690
	1691	if (*(SvEND(d) - 1) == ',') {
	1692	SvCUR_set(d, SvCUR(d) - 1);
	1693	SvPVX(d)[SvCUR(d)] = '\0';
	1694	}
	1695	sv_catpv(d, ")");
	1696	s = SvPVX_const(d);
	1697
	1698	/* dump initial SV details */
	1699
	1700	#ifdef DEBUG_LEAKING_SCALARS
	1701	Perl_dump_indent(aTHX_ level, file,
	1702	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1703	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1704	sv->sv_debug_line,
	1705	sv->sv_debug_inpad ? "for" : "by",
	1706	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1707	PTR2UV(sv->sv_debug_parent),
	1708	sv->sv_debug_serial
	1709	);
	1710	#endif
	1711	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1712
	1713	/* Dump SV type */
	1714
	1715	if (type < SVt_LAST) {
	1716	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1717
	1718	if (type == SVt_NULL) {
	1719	SvREFCNT_dec_NN(d);
	1720	return;
	1721	}
	1722	} else {
	1723	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1724	SvREFCNT_dec_NN(d);
	1725	return;
	1726	}
	1727
	1728	/* Dump general SV fields */
	1729
	1730	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1731	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1732	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1733	\|\| (type == SVt_IV && !SvROK(sv))) {
	1734	if (SvIsUV(sv)
	1735	#ifdef PERL_OLD_COPY_ON_WRITE
	1736	\|\| SvIsCOW(sv)
	1737	#endif
	1738	)
	1739	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1740	else
	1741	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1742	#ifdef PERL_OLD_COPY_ON_WRITE
	1743	if (SvIsCOW_shared_hash(sv))
	1744	PerlIO_printf(file, " (HASH)");
	1745	else if (SvIsCOW_normal(sv))
	1746	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1747	#endif
	1748	PerlIO_putc(file, '\n');
	1749	}
	1750
	1751	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1752	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1753	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1754	(UV) COP_SEQ_RANGE_LOW(sv));
	1755	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1756	(UV) COP_SEQ_RANGE_HIGH(sv));
	1757	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1758	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1759	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1760	\|\| type == SVt_NV) {
	1761	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1762	/* %Vg doesn't work? --jhi */
	1763	#ifdef USE_LONG_DOUBLE
	1764	Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
	1765	#else
	1766	Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
	1767	#endif
	1768	RESTORE_NUMERIC_LOCAL();
	1769	}
	1770
	1771	if (SvROK(sv)) {
	1772	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1773	if (nest < maxnest)
	1774	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1775	}
	1776
	1777	if (type < SVt_PV) {
	1778	SvREFCNT_dec_NN(d);
	1779	return;
	1780	}
	1781
	1782	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1783	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1784	const bool re = isREGEXP(sv);
	1785	const char * const ptr =
	1786	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1787	if (ptr) {
	1788	STRLEN delta;
	1789	if (SvOOK(sv)) {
	1790	SvOOK_offset(sv, delta);
	1791	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1792	(UV) delta);
	1793	} else {
	1794	delta = 0;
	1795	}
	1796	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1797	if (SvOOK(sv)) {
	1798	PerlIO_printf(file, "( %s . ) ",
	1799	pv_display(d, ptr - delta, delta, 0,
	1800	pvlim));
	1801	}
	1802	if (type == SVt_INVLIST) {
	1803	PerlIO_printf(file, "\n");
	1804	/* 4 blanks indents 2 beyond the PV, etc */
	1805	_invlist_dump(file, level, " ", sv);
	1806	}
	1807	else {
	1808	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1809	re ? 0 : SvLEN(sv),
	1810	pvlim));
	1811	if (SvUTF8(sv)) /* the 6? \x{....} */
	1812	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1813	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1814	UNI_DISPLAY_QQ));
	1815	PerlIO_printf(file, "\n");
	1816	}
	1817	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1818	if (!re)
	1819	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1820	(IV)SvLEN(sv));
	1821	#ifdef PERL_NEW_COPY_ON_WRITE
	1822	if (SvIsCOW(sv) && SvLEN(sv))
	1823	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1824	CowREFCNT(sv));
	1825	#endif
	1826	}
	1827	else
	1828	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1829	}
	1830
	1831	if (type >= SVt_PVMG) {
	1832	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1833	HV * const ost = SvOURSTASH(sv);
	1834	if (ost)
	1835	do_hv_dump(level, file, " OURSTASH", ost);
	1836	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
	1837	Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
	1838	(UV)PadnamelistMAXNAMED(sv));
	1839	} else {
	1840	if (SvMAGIC(sv))
	1841	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1842	}
	1843	if (SvSTASH(sv))
	1844	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1845
	1846	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1847	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1848	}
	1849	}
	1850
	1851	/* Dump type-specific SV fields */
	1852
	1853	switch (type) {
	1854	case SVt_PVAV:
	1855	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1856	if (AvARRAY(sv) != AvALLOC(sv)) {
	1857	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1858	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1859	}
	1860	else
	1861	PerlIO_putc(file, '\n');
	1862	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1863	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1864	/* arylen is stored in magic, and padnamelists use SvMAGIC for
	1865	something else. */
	1866	if (!AvPAD_NAMELIST(sv))
	1867	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1868	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1869	sv_setpvs(d, "");
	1870	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1871	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1872	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1873	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1874	if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
	1875	SSize_t count;
	1876	for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1877	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1878
	1879	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1880	if (elt)
	1881	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1882	}
	1883	}
	1884	break;
	1885	case SVt_PVHV:
	1886	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1887	if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
	1888	/* Show distribution of HEs in the ARRAY */
	1889	int freq[200];
	1890	#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
	1891	int i;
	1892	int max = 0;
	1893	U32 pow2 = 2, keys = HvUSEDKEYS(sv);
	1894	NV theoret, sum = 0;
	1895
	1896	PerlIO_printf(file, " (");
	1897	Zero(freq, FREQ_MAX + 1, int);
	1898	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1899	HE* h;
	1900	int count = 0;
	1901	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1902	count++;
	1903	if (count > FREQ_MAX)
	1904	count = FREQ_MAX;
	1905	freq[count]++;
	1906	if (max < count)
	1907	max = count;
	1908	}
	1909	for (i = 0; i <= max; i++) {
	1910	if (freq[i]) {
	1911	PerlIO_printf(file, "%d%s:%d", i,
	1912	(i == FREQ_MAX) ? "+" : "",
	1913	freq[i]);
	1914	if (i != max)
	1915	PerlIO_printf(file, ", ");
	1916	}
	1917	}
	1918	PerlIO_putc(file, ')');
	1919	/* The "quality" of a hash is defined as the total number of
	1920	comparisons needed to access every element once, relative
	1921	to the expected number needed for a random hash.
	1922
	1923	The total number of comparisons is equal to the sum of
	1924	the squares of the number of entries in each bucket.
	1925	For a random hash of n keys into k buckets, the expected
	1926	value is
	1927	n + n(n-1)/2k
	1928	*/
	1929
	1930	for (i = max; i > 0; i--) { /* Precision: count down. */
	1931	sum += freq[i] * i * i;
	1932	}
	1933	while ((keys = keys >> 1))
	1934	pow2 = pow2 << 1;
	1935	theoret = HvUSEDKEYS(sv);
	1936	theoret += theoret * (theoret-1)/pow2;
	1937	PerlIO_putc(file, '\n');
	1938	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1939	}
	1940	PerlIO_putc(file, '\n');
	1941	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
	1942	{
	1943	STRLEN count = 0;
	1944	HE **ents = HvARRAY(sv);
	1945
	1946	if (ents) {
	1947	HE const const last = ents + HvMAX(sv);
	1948	count = last + 1 - ents;
	1949
	1950	do {
	1951	if (!*ents)
	1952	--count;
	1953	} while (++ents <= last);
	1954	}
	1955
	1956	if (SvOOK(sv)) {
	1957	struct xpvhv_aux *const aux = HvAUX(sv);
	1958	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1959	" (cached = %"UVuf")\n",
	1960	(UV)count, (UV)aux->xhv_fill_lazy);
	1961	} else {
	1962	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1963	(UV)count);
	1964	}
	1965	}
	1966	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1967	if (SvOOK(sv)) {
	1968	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1969	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1970	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1971	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1972	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1973	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1974	}
	1975	#endif
	1976	PerlIO_putc(file, '\n');
	1977	}
	1978	{
	1979	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1980	if (mg && mg->mg_obj) {
	1981	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1982	}
	1983	}
	1984	{
	1985	const char * const hvname = HvNAME_get(sv);
	1986	if (hvname) {
	1987	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1988	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1989	generic_pv_escape( tmpsv, hvname,
	1990	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1991	}
	1992	}
	1993	if (SvOOK(sv)) {
	1994	AV * const backrefs
	1995	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1996	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1997	if (HvAUX(sv)->xhv_name_count)
	1998	Perl_dump_indent(aTHX_
	1999	level, file, " NAMECOUNT = %"IVdf"\n",
	2000	(IV)HvAUX(sv)->xhv_name_count
	2001	);
	2002	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	2003	const I32 count = HvAUX(sv)->xhv_name_count;
	2004	if (count) {
	2005	SV * const names = newSVpvs_flags("", SVs_TEMP);
	2006	/* The starting point is the first element if count is
	2007	positive and the second element if count is negative. */
	2008	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	2009	+ (count < 0 ? 1 : 0);
	2010	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	2011	+ (count < 0 ? -count : count);
	2012	while (hekp < endp) {
	2013	if (HEK_LEN(*hekp)) {
	2014	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	2015	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	2016	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	2017	} else {
	2018	/* This should never happen. */
	2019	sv_catpvs(names, ", (null)");
	2020	}
	2021	++hekp;
	2022	}
	2023	Perl_dump_indent(aTHX_
	2024	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	2025	);
	2026	}
	2027	else {
	2028	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	2029	const char *const hvename = HvENAME_get(sv);
	2030	Perl_dump_indent(aTHX_
	2031	level, file, " ENAME = \"%s\"\n",
	2032	generic_pv_escape(tmp, hvename,
	2033	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	2034	}
	2035	}
	2036	if (backrefs) {
	2037	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	2038	PTR2UV(backrefs));
	2039	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	2040	dumpops, pvlim);
	2041	}
	2042	if (meta) {
	2043	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2044	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	2045	generic_pv_escape( tmpsv, meta->mro_which->name,
	2046	meta->mro_which->length,
	2047	(meta->mro_which->kflags & HVhek_UTF8)),
	2048	PTR2UV(meta->mro_which));
	2049	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	2050	(UV)meta->cache_gen);
	2051	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	2052	(UV)meta->pkg_gen);
	2053	if (meta->mro_linear_all) {
	2054	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	2055	PTR2UV(meta->mro_linear_all));
	2056	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	2057	dumpops, pvlim);
	2058	}
	2059	if (meta->mro_linear_current) {
	2060	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	2061	PTR2UV(meta->mro_linear_current));
	2062	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	2063	dumpops, pvlim);
	2064	}
	2065	if (meta->mro_nextmethod) {
	2066	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	2067	PTR2UV(meta->mro_nextmethod));
	2068	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	2069	dumpops, pvlim);
	2070	}
	2071	if (meta->isa) {
	2072	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	2073	PTR2UV(meta->isa));
	2074	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	2075	dumpops, pvlim);
	2076	}
	2077	}
	2078	}
	2079	if (nest < maxnest) {
	2080	HV * const hv = MUTABLE_HV(sv);
	2081	STRLEN i;
	2082	HE *he;
	2083
	2084	if (HvARRAY(hv)) {
	2085	int count = maxnest - nest;
	2086	for (i=0; i <= HvMAX(hv); i++) {
	2087	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	2088	U32 hash;
	2089	SV * keysv;
	2090	const char * keypv;
	2091	SV * elt;
	2092	STRLEN len;
	2093
	2094	if (count-- <= 0) goto DONEHV;
	2095
	2096	hash = HeHASH(he);
	2097	keysv = hv_iterkeysv(he);
	2098	keypv = SvPV_const(keysv, len);
	2099	elt = HeVAL(he);
	2100
	2101	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	2102	if (SvUTF8(keysv))
	2103	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	2104	if (HvEITER_get(hv) == he)
	2105	PerlIO_printf(file, "[CURRENT] ");
	2106	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	2107	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	2108	}
	2109	}
	2110	DONEHV:;
	2111	}
	2112	}
	2113	break;
	2114
	2115	case SVt_PVCV:
	2116	if (CvAUTOLOAD(sv)) {
	2117	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2118	STRLEN len;
	2119	const char *const name = SvPV_const(sv, len);
	2120	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	2121	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	2122	}
	2123	if (SvPOK(sv)) {
	2124	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2125	const char *const proto = CvPROTO(sv);
	2126	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	2127	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	2128	SvUTF8(sv)));
	2129	}
	2130	/* FALL THROUGH */
	2131	case SVt_PVFM:
	2132	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	2133	if (!CvISXSUB(sv)) {
	2134	if (CvSTART(sv)) {
	2135	Perl_dump_indent(aTHX_ level, file,
	2136	" START = 0x%"UVxf" ===> %"IVdf"\n",
	2137	PTR2UV(CvSTART(sv)),
	2138	(IV)sequence_num(CvSTART(sv)));
	2139	}
	2140	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	2141	PTR2UV(CvROOT(sv)));
	2142	if (CvROOT(sv) && dumpops) {
	2143	do_op_dump(level+1, file, CvROOT(sv));
	2144	}
	2145	} else {
	2146	SV * const constant = cv_const_sv((const CV *)sv);
	2147
	2148	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	2149
	2150	if (constant) {
	2151	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	2152	" (CONST SV)\n",
	2153	PTR2UV(CvXSUBANY(sv).any_ptr));
	2154	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	2155	pvlim);
	2156	} else {
	2157	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	2158	(IV)CvXSUBANY(sv).any_i32);
	2159	}
	2160	}
	2161	if (CvNAMED(sv))
	2162	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2163	HEK_KEY(CvNAME_HEK((CV *)sv)));
	2164	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	2165	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	2166	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	2167	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	2168	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	2169	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	2170	if (nest < maxnest) {
	2171	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	2172	}
	2173	{
	2174	const CV * const outside = CvOUTSIDE(sv);
	2175	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	2176	PTR2UV(outside),
	2177	(!outside ? "null"
	2178	: CvANON(outside) ? "ANON"
	2179	: (outside == PL_main_cv) ? "MAIN"
	2180	: CvUNIQUE(outside) ? "UNIQUE"
	2181	: CvGV(outside) ?
	2182	generic_pv_escape(
	2183	newSVpvs_flags("", SVs_TEMP),
	2184	GvNAME(CvGV(outside)),
	2185	GvNAMELEN(CvGV(outside)),
	2186	GvNAMEUTF8(CvGV(outside)))
	2187	: "UNDEFINED"));
	2188	}
	2189	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2190	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2191	break;
	2192
	2193	case SVt_PVGV:
	2194	case SVt_PVLV:
	2195	if (type == SVt_PVLV) {
	2196	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2197	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2198	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2199	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2200	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2201	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
	2202	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2203	dumpops, pvlim);
	2204	}
	2205	if (isREGEXP(sv)) goto dumpregexp;
	2206	if (!isGV_with_GP(sv))
	2207	break;
	2208	{
	2209	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2210	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2211	generic_pv_escape(tmpsv, GvNAME(sv),
	2212	GvNAMELEN(sv),
	2213	GvNAMEUTF8(sv)));
	2214	}
	2215	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2216	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2217	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2218	if (!GvGP(sv))
	2219	break;
	2220	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2221	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2222	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2223	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2224	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2225	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2226	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2227	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2228	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2229	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2230	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2231	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2232	break;
	2233	case SVt_PVIO:
	2234	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2235	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2236	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2237	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2238	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2239	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2240	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2241	if (IoTOP_NAME(sv))
	2242	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2243	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2244	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2245	else {
	2246	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2247	PTR2UV(IoTOP_GV(sv)));
	2248	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2249	maxnest, dumpops, pvlim);
	2250	}
	2251	/* Source filters hide things that are not GVs in these three, so let's
	2252	be careful out there. */
	2253	if (IoFMT_NAME(sv))
	2254	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2255	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2256	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2257	else {
	2258	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2259	PTR2UV(IoFMT_GV(sv)));
	2260	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2261	maxnest, dumpops, pvlim);
	2262	}
	2263	if (IoBOTTOM_NAME(sv))
	2264	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2265	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2266	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2267	else {
	2268	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2269	PTR2UV(IoBOTTOM_GV(sv)));
	2270	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2271	maxnest, dumpops, pvlim);
	2272	}
	2273	if (isPRINT(IoTYPE(sv)))
	2274	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2275	else
	2276	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2277	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2278	break;
	2279	case SVt_REGEXP:
	2280	dumpregexp:
	2281	{
	2282	struct regexp * const r = ReANY((REGEXP*)sv);
	2283
	2284	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
	2285	sv_setpv(d,""); \
	2286	append_flags(d, flags, names); \
	2287	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2288	SvCUR_set(d, SvCUR(d) - 1); \
	2289	SvPVX(d)[SvCUR(d)] = '\0'; \
	2290	} \
	2291	} STMT_END
	2292	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
	2293	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2294	(UV)(r->compflags), SvPVX_const(d));
	2295
	2296	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
	2297	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2298	(UV)(r->extflags), SvPVX_const(d));
	2299
	2300	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
	2301	PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
	2302	if (r->engine == &PL_core_reg_engine) {
	2303	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
	2304	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
	2305	(UV)(r->intflags), SvPVX_const(d));
	2306	} else {
	2307	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2308	(UV)(r->intflags));
	2309	}
	2310	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2311	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2312	(UV)(r->nparens));
	2313	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2314	(UV)(r->lastparen));
	2315	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2316	(UV)(r->lastcloseparen));
	2317	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2318	(IV)(r->minlen));
	2319	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2320	(IV)(r->minlenret));
	2321	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2322	(UV)(r->gofs));
	2323	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2324	(UV)(r->pre_prefix));
	2325	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2326	(IV)(r->sublen));
	2327	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2328	(IV)(r->suboffset));
	2329	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2330	(IV)(r->subcoffset));
	2331	if (r->subbeg)
	2332	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2333	PTR2UV(r->subbeg),
	2334	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2335	else
	2336	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2337	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2338	PTR2UV(r->mother_re));
	2339	if (nest < maxnest && r->mother_re)
	2340	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2341	maxnest, dumpops, pvlim);
	2342	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2343	PTR2UV(r->paren_names));
	2344	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2345	PTR2UV(r->substrs));
	2346	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2347	PTR2UV(r->pprivate));
	2348	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2349	PTR2UV(r->offs));
	2350	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2351	PTR2UV(r->qr_anoncv));
	2352	#ifdef PERL_ANY_COW
	2353	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2354	PTR2UV(r->saved_copy));
	2355	#endif
	2356	}
	2357	break;
	2358	}
	2359	SvREFCNT_dec_NN(d);
	2360	}
	2361
	2362	/*
	2363	=for apidoc sv_dump
	2364
	2365	Dumps the contents of an SV to the C<STDERR> filehandle.
	2366
	2367	For an example of its output, see L<Devel::Peek>.
	2368
	2369	=cut
	2370	*/
	2371
	2372	void
	2373	Perl_sv_dump(pTHX_ SV *sv)
	2374	{
	2375	dVAR;
	2376
	2377	PERL_ARGS_ASSERT_SV_DUMP;
	2378
	2379	if (SvROK(sv))
	2380	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2381	else
	2382	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2383	}
	2384
	2385	int
	2386	Perl_runops_debug(pTHX)
	2387	{
	2388	dVAR;
	2389	if (!PL_op) {
	2390	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2391	return 0;
	2392	}
	2393
	2394	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2395	do {
	2396	#ifdef PERL_TRACE_OPS
	2397	++PL_op_exec_cnt[PL_op->op_type];
	2398	#endif
	2399	if (PL_debug) {
	2400	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2401	PerlIO_printf(Perl_debug_log,
	2402	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2403	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2404	PTR2UV(*PL_watchaddr));
	2405	if (DEBUG_s_TEST_) {
	2406	if (DEBUG_v_TEST_) {
	2407	PerlIO_printf(Perl_debug_log, "\n");
	2408	deb_stack_all();
	2409	}
	2410	else
	2411	debstack();
	2412	}
	2413
	2414
	2415	if (DEBUG_t_TEST_) debop(PL_op);
	2416	if (DEBUG_P_TEST_) debprof(PL_op);
	2417	}
	2418
	2419	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2420	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2421	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2422	PERL_ASYNC_CHECK();
	2423
	2424	TAINT_NOT;
	2425	return 0;
	2426	}
	2427
	2428	I32
	2429	Perl_debop(pTHX_ const OP *o)
	2430	{
	2431	dVAR;
	2432
	2433	PERL_ARGS_ASSERT_DEBOP;
	2434
	2435	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2436	return 0;
	2437
	2438	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2439	switch (o->op_type) {
	2440	case OP_CONST:
	2441	case OP_HINTSEVAL:
	2442	/* With ITHREADS, consts are stored in the pad, and the right pad
	2443	* may not be active here, so check.
	2444	* Looks like only during compiling the pads are illegal.
	2445	*/
	2446	#ifdef USE_ITHREADS
	2447	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2448	#endif
	2449	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2450	break;
	2451	case OP_GVSV:
	2452	case OP_GV:
	2453	if (cGVOPo_gv) {
	2454	SV * const sv = newSV(0);
	2455	#ifdef PERL_MAD
	2456	/* FIXME - is this making unwarranted assumptions about the
	2457	UTF-8 cleanliness of the dump file handle? */
	2458	SvUTF8_on(sv);
	2459	#endif
	2460	gv_fullname3(sv, cGVOPo_gv, NULL);
	2461	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2462	SvREFCNT_dec_NN(sv);
	2463	}
	2464	else
	2465	PerlIO_printf(Perl_debug_log, "(NULL)");
	2466	break;
	2467
	2468	{
	2469	int count;
	2470
	2471	case OP_PADSV:
	2472	case OP_PADAV:
	2473	case OP_PADHV:
	2474	count = 1;
	2475	goto dump_padop;
	2476	case OP_PADRANGE:
	2477	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2478	dump_padop:
	2479	/* print the lexical's name */
	2480	{
	2481	CV * const cv = deb_curcv(cxstack_ix);
	2482	SV *sv;
	2483	PAD * comppad = NULL;
	2484	int i;
	2485
	2486	if (cv) {
	2487	PADLIST * const padlist = CvPADLIST(cv);
	2488	comppad = *PadlistARRAY(padlist);
	2489	}
	2490	PerlIO_printf(Perl_debug_log, "(");
	2491	for (i = 0; i < count; i++) {
	2492	if (comppad &&
	2493	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2494	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2495	else
	2496	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2497	(UV)o->op_targ+i);
	2498	if (i < count-1)
	2499	PerlIO_printf(Perl_debug_log, ",");
	2500	}
	2501	PerlIO_printf(Perl_debug_log, ")");
	2502	}
	2503	break;
	2504	}
	2505
	2506	default:
	2507	break;
	2508	}
	2509	PerlIO_printf(Perl_debug_log, "\n");
	2510	return 0;
	2511	}
	2512
	2513	STATIC CV*
	2514	S_deb_curcv(pTHX_ const I32 ix)
	2515	{
	2516	dVAR;
	2517	const PERL_CONTEXT * const cx = &cxstack[ix];
	2518	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2519	return cx->blk_sub.cv;
	2520	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2521	return cx->blk_eval.cv;
	2522	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2523	return PL_main_cv;
	2524	else if (ix <= 0)
	2525	return NULL;
	2526	else
	2527	return deb_curcv(ix - 1);
	2528	}
	2529
	2530	void
	2531	Perl_watch(pTHX_ char **addr)
	2532	{
	2533	dVAR;
	2534
	2535	PERL_ARGS_ASSERT_WATCH;
	2536
	2537	PL_watchaddr = addr;
	2538	PL_watchok = *addr;
	2539	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2540	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2541	}
	2542
	2543	STATIC void
	2544	S_debprof(pTHX_ const OP *o)
	2545	{
	2546	dVAR;
	2547
	2548	PERL_ARGS_ASSERT_DEBPROF;
	2549
	2550	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2551	return;
	2552	if (!PL_profiledata)
	2553	Newxz(PL_profiledata, MAXO, U32);
	2554	++PL_profiledata[o->op_type];
	2555	}
	2556
	2557	void
	2558	Perl_debprofdump(pTHX)
	2559	{
	2560	dVAR;
	2561	unsigned i;
	2562	if (!PL_profiledata)
	2563	return;
	2564	for (i = 0; i < MAXO; i++) {
	2565	if (PL_profiledata[i])
	2566	PerlIO_printf(Perl_debug_log,
	2567	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2568	PL_op_name[i]);
	2569	}
	2570	}
	2571
	2572	#ifdef PERL_MAD
	2573	/*
	2574	* XML variants of most of the above routines
	2575	*/
	2576
	2577	STATIC void
	2578	S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2579	{
	2580	va_list args;
	2581
	2582	PERL_ARGS_ASSERT_XMLDUMP_ATTR;
	2583
	2584	PerlIO_printf(file, "\n ");
	2585	va_start(args, pat);
	2586	xmldump_vindent(level, file, pat, &args);
	2587	va_end(args);
	2588	}
	2589
	2590
	2591	void
	2592	Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2593	{
	2594	va_list args;
	2595	PERL_ARGS_ASSERT_XMLDUMP_INDENT;
	2596	va_start(args, pat);
	2597	xmldump_vindent(level, file, pat, &args);
	2598	va_end(args);
	2599	}
	2600
	2601	void
	2602	Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	2603	{
	2604	PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
	2605
	2606	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	2607	PerlIO_vprintf(file, pat, *args);
	2608	}
	2609
	2610	void
	2611	Perl_xmldump_all(pTHX)
	2612	{
	2613	xmldump_all_perl(FALSE);
	2614	}
	2615
	2616	void
	2617	Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
	2618	{
	2619	PerlIO_setlinebuf(PL_xmlfp);
	2620	if (PL_main_root)
	2621	op_xmldump(PL_main_root);
	2622	/* someday we might call this, when it outputs XML: */
	2623	/* xmldump_packsubs_perl(PL_defstash, justperl); */
	2624	if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
	2625	PerlIO_close(PL_xmlfp);
	2626	PL_xmlfp = 0;
	2627	}
	2628
	2629	void
	2630	Perl_xmldump_packsubs(pTHX_ const HV *stash)
	2631	{
	2632	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
	2633	xmldump_packsubs_perl(stash, FALSE);
	2634	}
	2635
	2636	void
	2637	Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	2638	{
	2639	I32 i;
	2640	HE *entry;
	2641
	2642	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
	2643
	2644	if (!HvARRAY(stash))
	2645	return;
	2646	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	2647	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	2648	GV *gv = MUTABLE_GV(HeVAL(entry));
	2649	HV *hv;
	2650	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	2651	continue;
	2652	if (GvCVu(gv))
	2653	xmldump_sub_perl(gv, justperl);
	2654	if (GvFORM(gv))
	2655	xmldump_form(gv);
	2656	if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
	2657	&& (hv = GvHV(gv)) && hv != PL_defstash)
	2658	xmldump_packsubs_perl(hv, justperl); /* nested package */
	2659	}
	2660	}
	2661	}
	2662
	2663	void
	2664	Perl_xmldump_sub(pTHX_ const GV *gv)
	2665	{
	2666	PERL_ARGS_ASSERT_XMLDUMP_SUB;
	2667	xmldump_sub_perl(gv, FALSE);
	2668	}
	2669
	2670	void
	2671	Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
	2672	{
	2673	SV * sv;
	2674
	2675	PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
	2676
	2677	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	2678	return;
	2679
	2680	sv = sv_newmortal();
	2681	gv_fullname3(sv, gv, NULL);
	2682	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
	2683	if (CvXSUB(GvCV(gv)))
	2684	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
	2685	PTR2UV(CvXSUB(GvCV(gv))),
	2686	(int)CvXSUBANY(GvCV(gv)).any_i32);
	2687	else if (CvROOT(GvCV(gv)))
	2688	op_xmldump(CvROOT(GvCV(gv)));
	2689	else
	2690	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2691	}
	2692
	2693	void
	2694	Perl_xmldump_form(pTHX_ const GV *gv)
	2695	{
	2696	SV * const sv = sv_newmortal();
	2697
	2698	PERL_ARGS_ASSERT_XMLDUMP_FORM;
	2699
	2700	gv_fullname3(sv, gv, NULL);
	2701	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
	2702	if (CvROOT(GvFORM(gv)))
	2703	op_xmldump(CvROOT(GvFORM(gv)));
	2704	else
	2705	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2706	}
	2707
	2708	void
	2709	Perl_xmldump_eval(pTHX)
	2710	{
	2711	op_xmldump(PL_eval_root);
	2712	}
	2713
	2714	char *
	2715	Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
	2716	{
	2717	PERL_ARGS_ASSERT_SV_CATXMLSV;
	2718	return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
	2719	}
	2720
	2721	char *
	2722	Perl_sv_catxmlpv(pTHX_ SV dsv, const char pv, int utf8)
	2723	{
	2724	PERL_ARGS_ASSERT_SV_CATXMLPV;
	2725	return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
	2726	}
	2727
	2728	char *
	2729	Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
	2730	{
	2731	unsigned int c;
	2732	const char * const e = pv + len;
	2733	const char * const start = pv;
	2734	STRLEN dsvcur;
	2735	STRLEN cl;
	2736
	2737	PERL_ARGS_ASSERT_SV_CATXMLPVN;
	2738
	2739	sv_catpvs(dsv,"");
	2740	dsvcur = SvCUR(dsv); /* in case we have to restart */
	2741
	2742	retry:
	2743	while (pv < e) {
	2744	if (utf8) {
	2745	c = utf8_to_uvchr_buf((U8)pv, (U8)e, &cl);
	2746	if (cl == 0) {
	2747	SvCUR(dsv) = dsvcur;
	2748	pv = start;
	2749	utf8 = 0;
	2750	goto retry;
	2751	}
	2752	}
	2753	else
	2754	c = (*pv & 255);
	2755
	2756	if (isCNTRL_L1(c)
	2757	&& c != '\t'
	2758	&& c != '\n'
	2759	&& c != '\r'
	2760	&& c != LATIN1_TO_NATIVE(0x85))
	2761	{
	2762	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2763	}
	2764	else switch (c) {
	2765	case '<':
	2766	sv_catpvs(dsv, "<");
	2767	break;
	2768	case '>':
	2769	sv_catpvs(dsv, ">");
	2770	break;
	2771	case '&':
	2772	sv_catpvs(dsv, "&");
	2773	break;
	2774	case '"':
	2775	sv_catpvs(dsv, """);
	2776	break;
	2777	default:
	2778	if (c < 0xD800) {
	2779	if (! isPRINT(c)) {
	2780	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2781	}
	2782	else {
	2783	const char string = (char) c;
	2784	sv_catpvn(dsv, &string, 1);
	2785	}
	2786	break;
	2787	}
	2788	if ((c >= 0xD800 && c <= 0xDB7F) \|\|
	2789	(c >= 0xDC00 && c <= 0xDFFF) \|\|
	2790	(c >= 0xFFF0 && c <= 0xFFFF) \|\|
	2791	c > 0x10ffff)
	2792	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2793	else
	2794	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2795	}
	2796
	2797	if (utf8)
	2798	pv += UTF8SKIP(pv);
	2799	else
	2800	pv++;
	2801	}
	2802
	2803	return SvPVX(dsv);
	2804	}
	2805
	2806	char *
	2807	Perl_sv_xmlpeek(pTHX_ SV *sv)
	2808	{
	2809	SV * const t = sv_newmortal();
	2810	STRLEN n_a;
	2811	int unref = 0;
	2812
	2813	PERL_ARGS_ASSERT_SV_XMLPEEK;
	2814
	2815	sv_utf8_upgrade(t);
	2816	sv_setpvs(t, "");
	2817	/* retry: */
	2818	if (!sv) {
	2819	sv_catpv(t, "VOID=\"\"");
	2820	goto finish;
	2821	}
	2822	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	2823	sv_catpv(t, "WILD=\"\"");
	2824	goto finish;
	2825	}
	2826	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	2827	if (sv == &PL_sv_undef) {
	2828	sv_catpv(t, "SV_UNDEF=\"1\"");
	2829	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2830	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2831	SvREADONLY(sv))
	2832	goto finish;
	2833	}
	2834	else if (sv == &PL_sv_no) {
	2835	sv_catpv(t, "SV_NO=\"1\"");
	2836	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2837	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2838	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2839	SVp_POK\|SVp_NOK)) &&
	2840	SvCUR(sv) == 0 &&
	2841	SvNVX(sv) == 0.0)
	2842	goto finish;
	2843	}
	2844	else if (sv == &PL_sv_yes) {
	2845	sv_catpv(t, "SV_YES=\"1\"");
	2846	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2847	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2848	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2849	SVp_POK\|SVp_NOK)) &&
	2850	SvCUR(sv) == 1 &&
	2851	SvPVX(sv) && *SvPVX(sv) == '1' &&
	2852	SvNVX(sv) == 1.0)
	2853	goto finish;
	2854	}
	2855	else {
	2856	sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
	2857	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2858	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2859	SvREADONLY(sv))
	2860	goto finish;
	2861	}
	2862	sv_catpv(t, " XXX=\"\" ");
	2863	}
	2864	else if (SvREFCNT(sv) == 0) {
	2865	sv_catpv(t, " refcnt=\"0\"");
	2866	unref++;
	2867	}
	2868	else if (DEBUG_R_TEST_) {
	2869	int is_tmp = 0;
	2870	SSize_t ix;
	2871	/* is this SV on the tmps stack? */
	2872	for (ix=PL_tmps_ix; ix>=0; ix--) {
	2873	if (PL_tmps_stack[ix] == sv) {
	2874	is_tmp = 1;
	2875	break;
	2876	}
	2877	}
	2878	if (SvREFCNT(sv) > 1)
	2879	Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
	2880	is_tmp ? "T" : "");
	2881	else if (is_tmp)
	2882	sv_catpv(t, " DRT=\"<T>\"");
	2883	}
	2884
	2885	if (SvROK(sv)) {
	2886	sv_catpv(t, " ROK=\"\"");
	2887	}
	2888	switch (SvTYPE(sv)) {
	2889	default:
	2890	sv_catpv(t, " FREED=\"1\"");
	2891	goto finish;
	2892
	2893	case SVt_NULL:
	2894	sv_catpv(t, " UNDEF=\"1\"");
	2895	goto finish;
	2896	case SVt_IV:
	2897	sv_catpv(t, " IV=\"");
	2898	break;
	2899	case SVt_NV:
	2900	sv_catpv(t, " NV=\"");
	2901	break;
	2902	case SVt_PV:
	2903	sv_catpv(t, " PV=\"");
	2904	break;
	2905	case SVt_PVIV:
	2906	sv_catpv(t, " PVIV=\"");
	2907	break;
	2908	case SVt_PVNV:
	2909	sv_catpv(t, " PVNV=\"");
	2910	break;
	2911	case SVt_PVMG:
	2912	sv_catpv(t, " PVMG=\"");
	2913	break;
	2914	case SVt_PVLV:
	2915	sv_catpv(t, " PVLV=\"");
	2916	break;
	2917	case SVt_PVAV:
	2918	sv_catpv(t, " AV=\"");
	2919	break;
	2920	case SVt_PVHV:
	2921	sv_catpv(t, " HV=\"");
	2922	break;
	2923	case SVt_PVCV:
	2924	if (CvGV(sv))
	2925	Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
	2926	else
	2927	sv_catpv(t, " CV=\"()\"");
	2928	goto finish;
	2929	case SVt_PVGV:
	2930	sv_catpv(t, " GV=\"");
	2931	break;
	2932	case SVt_INVLIST:
	2933	sv_catpv(t, " DUMMY=\"");
	2934	break;
	2935	case SVt_REGEXP:
	2936	sv_catpv(t, " REGEXP=\"");
	2937	break;
	2938	case SVt_PVFM:
	2939	sv_catpv(t, " FM=\"");
	2940	break;
	2941	case SVt_PVIO:
	2942	sv_catpv(t, " IO=\"");
	2943	break;
	2944	}
	2945
	2946	if (SvPOKp(sv)) {
	2947	if (SvPVX(sv)) {
	2948	sv_catxmlsv(t, sv);
	2949	}
	2950	}
	2951	else if (SvNOKp(sv)) {
	2952	STORE_NUMERIC_LOCAL_SET_STANDARD();
	2953	Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
	2954	RESTORE_NUMERIC_LOCAL();
	2955	}
	2956	else if (SvIOKp(sv)) {
	2957	if (SvIsUV(sv))
	2958	Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
	2959	else
	2960	Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
	2961	}
	2962	else
	2963	sv_catpv(t, "");
	2964	sv_catpv(t, "\"");
	2965
	2966	finish:
	2967	while (unref--)
	2968	sv_catpv(t, ")");
	2969	return SvPV(t, n_a);
	2970	}
	2971
	2972	void
	2973	Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	2974	{
	2975	PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
	2976
	2977	if (!pm) {
	2978	Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
	2979	return;
	2980	}
	2981	Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
	2982	level++;
	2983	if (PM_GETRE(pm)) {
	2984	REGEXP *const r = PM_GETRE(pm);
	2985	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2986	sv_catxmlsv(tmpsv, MUTABLE_SV(r));
	2987	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
	2988	SvPVX(tmpsv));
	2989	SvREFCNT_dec_NN(tmpsv);
	2990	Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
	2991	(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
	2992	}
	2993	else
	2994	Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
	2995	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	2996	SV * const tmpsv = pm_description(pm);
	2997	Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2998	SvREFCNT_dec_NN(tmpsv);
	2999	}
	3000
	3001	level--;
	3002	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	3003	Perl_xmldump_indent(aTHX_ level, file, ">\n");
	3004	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
	3005	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
	3006	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
	3007	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
	3008	}
	3009	else
	3010	Perl_xmldump_indent(aTHX_ level, file, "/>\n");
	3011	}
	3012
	3013	void
	3014	Perl_pmop_xmldump(pTHX_ const PMOP *pm)
	3015	{
	3016	do_pmop_xmldump(0, PL_xmlfp, pm);
	3017	}
	3018
	3019	void
	3020	Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
	3021	{
	3022	UV seq;
	3023	int contents = 0;
	3024	const OPCODE optype = o->op_type;
	3025
	3026	PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
	3027
	3028	if (!o)
	3029	return;
	3030	seq = sequence_num(o);
	3031	Perl_xmldump_indent(aTHX_ level, file,
	3032	"<op_%s seq=\"%"UVuf" -> ",
	3033	OP_NAME(o),
	3034	seq);
	3035	level++;
	3036	if (o->op_next)
	3037	PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
	3038	sequence_num(o->op_next));
	3039	else
	3040	PerlIO_printf(file, "DONE\"");
	3041
	3042	if (o->op_targ) {
	3043	if (optype == OP_NULL)
	3044	{
	3045	PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
	3046	if (o->op_targ == OP_NEXTSTATE)
	3047	{
	3048	if (CopLINE(cCOPo))
	3049	PerlIO_printf(file, " line=\"%"UVuf"\"",
	3050	(UV)CopLINE(cCOPo));
	3051	if (CopSTASHPV(cCOPo))
	3052	PerlIO_printf(file, " package=\"%s\"",
	3053	CopSTASHPV(cCOPo));
	3054	if (CopLABEL(cCOPo))
	3055	PerlIO_printf(file, " label=\"%s\"",
	3056	CopLABEL(cCOPo));
	3057	}
	3058	}
	3059	else
	3060	PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
	3061	}
	3062	#ifdef DUMPADDR
	3063	PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
	3064	#endif
	3065
	3066	DUMP_OP_FLAGS(o,1,0,file);
	3067	DUMP_OP_PRIVATE(o,1,0,file);
	3068
	3069	switch (optype) {
	3070	case OP_AELEMFAST:
	3071	if (o->op_flags & OPf_SPECIAL) {
	3072	break;
	3073	}
	3074	case OP_GVSV:
	3075	case OP_GV:
	3076	#ifdef USE_ITHREADS
	3077	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
	3078	#else
	3079	if (cSVOPo->op_sv) {
	3080	SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
	3081	SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
	3082	char *s;
	3083	STRLEN len;
	3084	ENTER;
	3085	SAVEFREESV(tmpsv1);
	3086	SAVEFREESV(tmpsv2);
	3087	gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
	3088	s = SvPV(tmpsv1,len);
	3089	sv_catxmlpvn(tmpsv2, s, len, 1);
	3090	S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
	3091	LEAVE;
	3092	}
	3093	else
	3094	S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
	3095	#endif
	3096	break;
	3097	case OP_CONST:
	3098	case OP_HINTSEVAL:
	3099	case OP_METHOD_NAMED:
	3100	#ifndef USE_ITHREADS
	3101	/* with ITHREADS, consts are stored in the pad, and the right pad
	3102	* may not be active here, so skip */
	3103	S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
	3104	#endif
	3105	break;
	3106	case OP_ANONCODE:
	3107	if (!contents) {
	3108	contents = 1;
	3109	PerlIO_printf(file, ">\n");
	3110	}
	3111	do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
	3112	break;
	3113	case OP_NEXTSTATE:
	3114	case OP_DBSTATE:
	3115	if (CopLINE(cCOPo))
	3116	S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
	3117	(UV)CopLINE(cCOPo));
	3118	if (CopSTASHPV(cCOPo))
	3119	S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
	3120	CopSTASHPV(cCOPo));
	3121	if (CopLABEL(cCOPo))
	3122	S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
	3123	CopLABEL(cCOPo));
	3124	break;
	3125	case OP_ENTERLOOP:
	3126	S_xmldump_attr(aTHX_ level, file, "redo=\"");
	3127	if (cLOOPo->op_redoop)
	3128	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
	3129	else
	3130	PerlIO_printf(file, "DONE\"");
	3131	S_xmldump_attr(aTHX_ level, file, "next=\"");
	3132	if (cLOOPo->op_nextop)
	3133	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
	3134	else
	3135	PerlIO_printf(file, "DONE\"");
	3136	S_xmldump_attr(aTHX_ level, file, "last=\"");
	3137	if (cLOOPo->op_lastop)
	3138	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
	3139	else
	3140	PerlIO_printf(file, "DONE\"");
	3141	break;
	3142	case OP_COND_EXPR:
	3143	case OP_RANGE:
	3144	case OP_MAPWHILE:
	3145	case OP_GREPWHILE:
	3146	case OP_OR:
	3147	case OP_AND:
	3148	S_xmldump_attr(aTHX_ level, file, "other=\"");
	3149	if (cLOGOPo->op_other)
	3150	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
	3151	else
	3152	PerlIO_printf(file, "DONE\"");
	3153	break;
	3154	case OP_LEAVE:
	3155	case OP_LEAVEEVAL:
	3156	case OP_LEAVESUB:
	3157	case OP_LEAVESUBLV:
	3158	case OP_LEAVEWRITE:
	3159	case OP_SCOPE:
	3160	if (o->op_private & OPpREFCOUNTED)
	3161	S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
	3162	break;
	3163	default:
	3164	break;
	3165	}
	3166
	3167	if (PL_madskills && o->op_madprop) {
	3168	char prevkey = '\0';
	3169	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	3170	const MADPROP* mp = o->op_madprop;
	3171
	3172	if (!contents) {
	3173	contents = 1;
	3174	PerlIO_printf(file, ">\n");
	3175	}
	3176	Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
	3177	level++;
	3178	while (mp) {
	3179	char tmp = mp->mad_key;
	3180	sv_setpvs(tmpsv,"\"");
	3181	if (tmp)
	3182	sv_catxmlpvn(tmpsv, &tmp, 1, 0);
	3183	if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
	3184	sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
	3185	else
	3186	prevkey = tmp;
	3187	sv_catpv(tmpsv, "\"");
	3188	switch (mp->mad_type) {
	3189	case MAD_NULL:
	3190	sv_catpv(tmpsv, "NULL");
	3191	Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
	3192	break;
	3193	case MAD_PV:
	3194	sv_catpv(tmpsv, " val=\"");
	3195	sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
	3196	sv_catpv(tmpsv, "\"");
	3197	Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
	3198	break;
	3199	case MAD_SV:
	3200	sv_catpv(tmpsv, " val=\"");
	3201	sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
	3202	sv_catpv(tmpsv, "\"");
	3203	Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
	3204	break;
	3205	case MAD_OP:
	3206	if ((OP*)mp->mad_val) {
	3207	Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
	3208	do_op_xmldump(level+1, file, (OP*)mp->mad_val);
	3209	Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
	3210	}
	3211	break;
	3212	default:
	3213	Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
	3214	break;
	3215	}
	3216	mp = mp->mad_next;
	3217	}
	3218	level--;
	3219	Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
	3220
	3221	SvREFCNT_dec_NN(tmpsv);
	3222	}
	3223
	3224	switch (optype) {
	3225	case OP_PUSHRE:
	3226	case OP_MATCH:
	3227	case OP_QR:
	3228	case OP_SUBST:
	3229	if (!contents) {
	3230	contents = 1;
	3231	PerlIO_printf(file, ">\n");
	3232	}
	3233	do_pmop_xmldump(level, file, cPMOPo);
	3234	break;
	3235	default:
	3236	break;
	3237	}
	3238
	3239	if (o->op_flags & OPf_KIDS) {
	3240	OP *kid;
	3241	if (!contents) {
	3242	contents = 1;
	3243	PerlIO_printf(file, ">\n");
	3244	}
	3245	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	3246	do_op_xmldump(level, file, kid);
	3247	}
	3248
	3249	if (contents)
	3250	Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
	3251	else
	3252	PerlIO_printf(file, " />\n");
	3253	}
	3254
	3255	void
	3256	Perl_op_xmldump(pTHX_ const OP *o)
	3257	{
	3258	PERL_ARGS_ASSERT_OP_XMLDUMP;
	3259
	3260	do_op_xmldump(0, PL_xmlfp, o);
	3261	}
	3262	#endif
	3263
	3264	/*
	3265	* Local variables:
	3266	* c-indentation-style: bsd
	3267	* c-basic-offset: 4
	3268	* indent-tabs-mode: nil
	3269	* End:
	3270	*
	3271	* ex: set ts=8 sts=4 sw=4 et:
	3272	*/