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_EXTFLAGS(regex) & RXf_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	const struct flag_to_name regexp_flags_names[] = {
	1546	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1547	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1548	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1549	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1550	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1551	{RXf_ANCH_BOL, "ANCH_BOL,"},
	1552	{RXf_ANCH_MBOL, "ANCH_MBOL,"},
	1553	{RXf_ANCH_SBOL, "ANCH_SBOL,"},
	1554	{RXf_ANCH_GPOS, "ANCH_GPOS,"},
	1555	{RXf_GPOS_SEEN, "GPOS_SEEN,"},
	1556	{RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1557	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1558	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1559	{RXf_CANY_SEEN, "CANY_SEEN,"},
	1560	{RXf_NOSCAN, "NOSCAN,"},
	1561	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1562	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1563	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1564	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1565	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1566	{RXf_SPLIT, "SPLIT,"},
	1567	{RXf_COPY_DONE, "COPY_DONE,"},
	1568	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1569	{RXf_TAINTED, "TAINTED,"},
	1570	{RXf_START_ONLY, "START_ONLY,"},
	1571	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1572	{RXf_WHITE, "WHITE,"},
	1573	{RXf_NULL, "NULL,"},
	1574	};
	1575
	1576	void
	1577	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1578	{
	1579	dVAR;
	1580	SV *d;
	1581	const char *s;
	1582	U32 flags;
	1583	U32 type;
	1584
	1585	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1586
	1587	if (!sv) {
	1588	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1589	return;
	1590	}
	1591
	1592	flags = SvFLAGS(sv);
	1593	type = SvTYPE(sv);
	1594
	1595	/* process general SV flags */
	1596
	1597	d = Perl_newSVpvf(aTHX_
	1598	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1599	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1600	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1601	(int)(PL_dumpindent*level), "");
	1602
	1603	if (!((flags & SVpad_NAME) == SVpad_NAME
	1604	&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1605	if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
	1606	sv_catpv(d, "PADSTALE,");
	1607	}
	1608	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
	1609	if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
	1610	sv_catpv(d, "PADTMP,");
	1611	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
	1612	}
	1613	append_flags(d, flags, first_sv_flags_names);
	1614	if (flags & SVf_ROK) {
	1615	sv_catpv(d, "ROK,");
	1616	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1617	}
	1618	append_flags(d, flags, second_sv_flags_names);
	1619	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1620	&& type != SVt_PVAV) {
	1621	if (SvPCS_IMPORTED(sv))
	1622	sv_catpv(d, "PCS_IMPORTED,");
	1623	else
	1624	sv_catpv(d, "SCREAM,");
	1625	}
	1626
	1627	/* process type-specific SV flags */
	1628
	1629	switch (type) {
	1630	case SVt_PVCV:
	1631	case SVt_PVFM:
	1632	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1633	break;
	1634	case SVt_PVHV:
	1635	append_flags(d, flags, hv_flags_names);
	1636	break;
	1637	case SVt_PVGV:
	1638	case SVt_PVLV:
	1639	if (isGV_with_GP(sv)) {
	1640	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1641	}
	1642	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1643	sv_catpv(d, "IMPORT");
	1644	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1645	sv_catpv(d, "ALL,");
	1646	else {
	1647	sv_catpv(d, "(");
	1648	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1649	sv_catpv(d, " ),");
	1650	}
	1651	}
	1652	/* FALL THROUGH */
	1653	default:
	1654	evaled_or_uv:
	1655	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1656	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1657	break;
	1658	case SVt_PVMG:
	1659	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1660	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1661	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1662	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1663	/* FALL THROUGH */
	1664	case SVt_PVNV:
	1665	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1666	goto evaled_or_uv;
	1667	case SVt_PVAV:
	1668	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
	1669	break;
	1670	}
	1671	/* SVphv_SHAREKEYS is also 0x20000000 */
	1672	if ((type != SVt_PVHV) && SvUTF8(sv))
	1673	sv_catpv(d, "UTF8");
	1674
	1675	if (*(SvEND(d) - 1) == ',') {
	1676	SvCUR_set(d, SvCUR(d) - 1);
	1677	SvPVX(d)[SvCUR(d)] = '\0';
	1678	}
	1679	sv_catpv(d, ")");
	1680	s = SvPVX_const(d);
	1681
	1682	/* dump initial SV details */
	1683
	1684	#ifdef DEBUG_LEAKING_SCALARS
	1685	Perl_dump_indent(aTHX_ level, file,
	1686	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1687	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1688	sv->sv_debug_line,
	1689	sv->sv_debug_inpad ? "for" : "by",
	1690	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1691	PTR2UV(sv->sv_debug_parent),
	1692	sv->sv_debug_serial
	1693	);
	1694	#endif
	1695	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1696
	1697	/* Dump SV type */
	1698
	1699	if (type < SVt_LAST) {
	1700	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1701
	1702	if (type == SVt_NULL) {
	1703	SvREFCNT_dec_NN(d);
	1704	return;
	1705	}
	1706	} else {
	1707	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1708	SvREFCNT_dec_NN(d);
	1709	return;
	1710	}
	1711
	1712	/* Dump general SV fields */
	1713
	1714	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1715	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1716	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1717	\|\| (type == SVt_IV && !SvROK(sv))) {
	1718	if (SvIsUV(sv)
	1719	#ifdef PERL_OLD_COPY_ON_WRITE
	1720	\|\| SvIsCOW(sv)
	1721	#endif
	1722	)
	1723	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1724	else
	1725	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1726	#ifdef PERL_OLD_COPY_ON_WRITE
	1727	if (SvIsCOW_shared_hash(sv))
	1728	PerlIO_printf(file, " (HASH)");
	1729	else if (SvIsCOW_normal(sv))
	1730	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1731	#endif
	1732	PerlIO_putc(file, '\n');
	1733	}
	1734
	1735	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1736	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1737	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1738	(UV) COP_SEQ_RANGE_LOW(sv));
	1739	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1740	(UV) COP_SEQ_RANGE_HIGH(sv));
	1741	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1742	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1743	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1744	\|\| type == SVt_NV) {
	1745	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1746	/* %Vg doesn't work? --jhi */
	1747	#ifdef USE_LONG_DOUBLE
	1748	Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
	1749	#else
	1750	Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
	1751	#endif
	1752	RESTORE_NUMERIC_LOCAL();
	1753	}
	1754
	1755	if (SvROK(sv)) {
	1756	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1757	if (nest < maxnest)
	1758	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1759	}
	1760
	1761	if (type < SVt_PV) {
	1762	SvREFCNT_dec_NN(d);
	1763	return;
	1764	}
	1765
	1766	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1767	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1768	const bool re = isREGEXP(sv);
	1769	const char * const ptr =
	1770	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1771	if (ptr) {
	1772	STRLEN delta;
	1773	if (SvOOK(sv)) {
	1774	SvOOK_offset(sv, delta);
	1775	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1776	(UV) delta);
	1777	} else {
	1778	delta = 0;
	1779	}
	1780	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1781	if (SvOOK(sv)) {
	1782	PerlIO_printf(file, "( %s . ) ",
	1783	pv_display(d, ptr - delta, delta, 0,
	1784	pvlim));
	1785	}
	1786	if (type == SVt_INVLIST) {
	1787	PerlIO_printf(file, "\n");
	1788	/* 4 blanks indents 2 beyond the PV, etc */
	1789	_invlist_dump(file, level, " ", sv);
	1790	}
	1791	else {
	1792	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1793	re ? 0 : SvLEN(sv),
	1794	pvlim));
	1795	if (SvUTF8(sv)) /* the 6? \x{....} */
	1796	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1797	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1798	UNI_DISPLAY_QQ));
	1799	PerlIO_printf(file, "\n");
	1800	}
	1801	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1802	if (!re)
	1803	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1804	(IV)SvLEN(sv));
	1805	#ifdef PERL_NEW_COPY_ON_WRITE
	1806	if (SvIsCOW(sv) && SvLEN(sv))
	1807	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1808	CowREFCNT(sv));
	1809	#endif
	1810	}
	1811	else
	1812	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1813	}
	1814
	1815	if (type >= SVt_PVMG) {
	1816	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1817	HV * const ost = SvOURSTASH(sv);
	1818	if (ost)
	1819	do_hv_dump(level, file, " OURSTASH", ost);
	1820	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
	1821	Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
	1822	(UV)PadnamelistMAXNAMED(sv));
	1823	} else {
	1824	if (SvMAGIC(sv))
	1825	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1826	}
	1827	if (SvSTASH(sv))
	1828	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1829
	1830	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1831	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1832	}
	1833	}
	1834
	1835	/* Dump type-specific SV fields */
	1836
	1837	switch (type) {
	1838	case SVt_PVAV:
	1839	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1840	if (AvARRAY(sv) != AvALLOC(sv)) {
	1841	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1842	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1843	}
	1844	else
	1845	PerlIO_putc(file, '\n');
	1846	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1847	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1848	/* arylen is stored in magic, and padnamelists use SvMAGIC for
	1849	something else. */
	1850	if (!AvPAD_NAMELIST(sv))
	1851	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1852	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1853	sv_setpvs(d, "");
	1854	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1855	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1856	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1857	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1858	if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
	1859	SSize_t count;
	1860	for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1861	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1862
	1863	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1864	if (elt)
	1865	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1866	}
	1867	}
	1868	break;
	1869	case SVt_PVHV:
	1870	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1871	if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
	1872	/* Show distribution of HEs in the ARRAY */
	1873	int freq[200];
	1874	#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
	1875	int i;
	1876	int max = 0;
	1877	U32 pow2 = 2, keys = HvUSEDKEYS(sv);
	1878	NV theoret, sum = 0;
	1879
	1880	PerlIO_printf(file, " (");
	1881	Zero(freq, FREQ_MAX + 1, int);
	1882	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1883	HE* h;
	1884	int count = 0;
	1885	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1886	count++;
	1887	if (count > FREQ_MAX)
	1888	count = FREQ_MAX;
	1889	freq[count]++;
	1890	if (max < count)
	1891	max = count;
	1892	}
	1893	for (i = 0; i <= max; i++) {
	1894	if (freq[i]) {
	1895	PerlIO_printf(file, "%d%s:%d", i,
	1896	(i == FREQ_MAX) ? "+" : "",
	1897	freq[i]);
	1898	if (i != max)
	1899	PerlIO_printf(file, ", ");
	1900	}
	1901	}
	1902	PerlIO_putc(file, ')');
	1903	/* The "quality" of a hash is defined as the total number of
	1904	comparisons needed to access every element once, relative
	1905	to the expected number needed for a random hash.
	1906
	1907	The total number of comparisons is equal to the sum of
	1908	the squares of the number of entries in each bucket.
	1909	For a random hash of n keys into k buckets, the expected
	1910	value is
	1911	n + n(n-1)/2k
	1912	*/
	1913
	1914	for (i = max; i > 0; i--) { /* Precision: count down. */
	1915	sum += freq[i] * i * i;
	1916	}
	1917	while ((keys = keys >> 1))
	1918	pow2 = pow2 << 1;
	1919	theoret = HvUSEDKEYS(sv);
	1920	theoret += theoret * (theoret-1)/pow2;
	1921	PerlIO_putc(file, '\n');
	1922	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1923	}
	1924	PerlIO_putc(file, '\n');
	1925	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
	1926	{
	1927	STRLEN count = 0;
	1928	HE **ents = HvARRAY(sv);
	1929
	1930	if (ents) {
	1931	HE const const last = ents + HvMAX(sv);
	1932	count = last + 1 - ents;
	1933
	1934	do {
	1935	if (!*ents)
	1936	--count;
	1937	} while (++ents <= last);
	1938	}
	1939
	1940	if (SvOOK(sv)) {
	1941	struct xpvhv_aux *const aux = HvAUX(sv);
	1942	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1943	" (cached = %"UVuf")\n",
	1944	(UV)count, (UV)aux->xhv_fill_lazy);
	1945	} else {
	1946	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1947	(UV)count);
	1948	}
	1949	}
	1950	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1951	if (SvOOK(sv)) {
	1952	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1953	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1954	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1955	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1956	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1957	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1958	}
	1959	#endif
	1960	PerlIO_putc(file, '\n');
	1961	}
	1962	{
	1963	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1964	if (mg && mg->mg_obj) {
	1965	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1966	}
	1967	}
	1968	{
	1969	const char * const hvname = HvNAME_get(sv);
	1970	if (hvname) {
	1971	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1972	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1973	generic_pv_escape( tmpsv, hvname,
	1974	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1975	}
	1976	}
	1977	if (SvOOK(sv)) {
	1978	AV * const backrefs
	1979	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1980	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1981	if (HvAUX(sv)->xhv_name_count)
	1982	Perl_dump_indent(aTHX_
	1983	level, file, " NAMECOUNT = %"IVdf"\n",
	1984	(IV)HvAUX(sv)->xhv_name_count
	1985	);
	1986	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1987	const I32 count = HvAUX(sv)->xhv_name_count;
	1988	if (count) {
	1989	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1990	/* The starting point is the first element if count is
	1991	positive and the second element if count is negative. */
	1992	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1993	+ (count < 0 ? 1 : 0);
	1994	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1995	+ (count < 0 ? -count : count);
	1996	while (hekp < endp) {
	1997	if (HEK_LEN(*hekp)) {
	1998	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1999	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	2000	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	2001	} else {
	2002	/* This should never happen. */
	2003	sv_catpvs(names, ", (null)");
	2004	}
	2005	++hekp;
	2006	}
	2007	Perl_dump_indent(aTHX_
	2008	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	2009	);
	2010	}
	2011	else {
	2012	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	2013	const char *const hvename = HvENAME_get(sv);
	2014	Perl_dump_indent(aTHX_
	2015	level, file, " ENAME = \"%s\"\n",
	2016	generic_pv_escape(tmp, hvename,
	2017	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	2018	}
	2019	}
	2020	if (backrefs) {
	2021	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	2022	PTR2UV(backrefs));
	2023	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	2024	dumpops, pvlim);
	2025	}
	2026	if (meta) {
	2027	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2028	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	2029	generic_pv_escape( tmpsv, meta->mro_which->name,
	2030	meta->mro_which->length,
	2031	(meta->mro_which->kflags & HVhek_UTF8)),
	2032	PTR2UV(meta->mro_which));
	2033	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	2034	(UV)meta->cache_gen);
	2035	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	2036	(UV)meta->pkg_gen);
	2037	if (meta->mro_linear_all) {
	2038	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	2039	PTR2UV(meta->mro_linear_all));
	2040	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	2041	dumpops, pvlim);
	2042	}
	2043	if (meta->mro_linear_current) {
	2044	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	2045	PTR2UV(meta->mro_linear_current));
	2046	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	2047	dumpops, pvlim);
	2048	}
	2049	if (meta->mro_nextmethod) {
	2050	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	2051	PTR2UV(meta->mro_nextmethod));
	2052	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	2053	dumpops, pvlim);
	2054	}
	2055	if (meta->isa) {
	2056	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	2057	PTR2UV(meta->isa));
	2058	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	2059	dumpops, pvlim);
	2060	}
	2061	}
	2062	}
	2063	if (nest < maxnest) {
	2064	HV * const hv = MUTABLE_HV(sv);
	2065	STRLEN i;
	2066	HE *he;
	2067
	2068	if (HvARRAY(hv)) {
	2069	int count = maxnest - nest;
	2070	for (i=0; i <= HvMAX(hv); i++) {
	2071	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	2072	U32 hash;
	2073	SV * keysv;
	2074	const char * keypv;
	2075	SV * elt;
	2076	STRLEN len;
	2077
	2078	if (count-- <= 0) goto DONEHV;
	2079
	2080	hash = HeHASH(he);
	2081	keysv = hv_iterkeysv(he);
	2082	keypv = SvPV_const(keysv, len);
	2083	elt = HeVAL(he);
	2084
	2085	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	2086	if (SvUTF8(keysv))
	2087	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	2088	if (HvEITER_get(hv) == he)
	2089	PerlIO_printf(file, "[CURRENT] ");
	2090	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	2091	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	2092	}
	2093	}
	2094	DONEHV:;
	2095	}
	2096	}
	2097	break;
	2098
	2099	case SVt_PVCV:
	2100	if (CvAUTOLOAD(sv)) {
	2101	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2102	STRLEN len;
	2103	const char *const name = SvPV_const(sv, len);
	2104	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	2105	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	2106	}
	2107	if (SvPOK(sv)) {
	2108	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2109	const char *const proto = CvPROTO(sv);
	2110	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	2111	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	2112	SvUTF8(sv)));
	2113	}
	2114	/* FALL THROUGH */
	2115	case SVt_PVFM:
	2116	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	2117	if (!CvISXSUB(sv)) {
	2118	if (CvSTART(sv)) {
	2119	Perl_dump_indent(aTHX_ level, file,
	2120	" START = 0x%"UVxf" ===> %"IVdf"\n",
	2121	PTR2UV(CvSTART(sv)),
	2122	(IV)sequence_num(CvSTART(sv)));
	2123	}
	2124	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	2125	PTR2UV(CvROOT(sv)));
	2126	if (CvROOT(sv) && dumpops) {
	2127	do_op_dump(level+1, file, CvROOT(sv));
	2128	}
	2129	} else {
	2130	SV * const constant = cv_const_sv((const CV *)sv);
	2131
	2132	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	2133
	2134	if (constant) {
	2135	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	2136	" (CONST SV)\n",
	2137	PTR2UV(CvXSUBANY(sv).any_ptr));
	2138	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	2139	pvlim);
	2140	} else {
	2141	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	2142	(IV)CvXSUBANY(sv).any_i32);
	2143	}
	2144	}
	2145	if (CvNAMED(sv))
	2146	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2147	HEK_KEY(CvNAME_HEK((CV *)sv)));
	2148	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	2149	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	2150	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	2151	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	2152	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	2153	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	2154	if (nest < maxnest) {
	2155	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	2156	}
	2157	{
	2158	const CV * const outside = CvOUTSIDE(sv);
	2159	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	2160	PTR2UV(outside),
	2161	(!outside ? "null"
	2162	: CvANON(outside) ? "ANON"
	2163	: (outside == PL_main_cv) ? "MAIN"
	2164	: CvUNIQUE(outside) ? "UNIQUE"
	2165	: CvGV(outside) ?
	2166	generic_pv_escape(
	2167	newSVpvs_flags("", SVs_TEMP),
	2168	GvNAME(CvGV(outside)),
	2169	GvNAMELEN(CvGV(outside)),
	2170	GvNAMEUTF8(CvGV(outside)))
	2171	: "UNDEFINED"));
	2172	}
	2173	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2174	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2175	break;
	2176
	2177	case SVt_PVGV:
	2178	case SVt_PVLV:
	2179	if (type == SVt_PVLV) {
	2180	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2181	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2182	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2183	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2184	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2185	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
	2186	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2187	dumpops, pvlim);
	2188	}
	2189	if (isREGEXP(sv)) goto dumpregexp;
	2190	if (!isGV_with_GP(sv))
	2191	break;
	2192	{
	2193	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2194	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2195	generic_pv_escape(tmpsv, GvNAME(sv),
	2196	GvNAMELEN(sv),
	2197	GvNAMEUTF8(sv)));
	2198	}
	2199	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2200	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2201	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2202	if (!GvGP(sv))
	2203	break;
	2204	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2205	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2206	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2207	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2208	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2209	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2210	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2211	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2212	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2213	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2214	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2215	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2216	break;
	2217	case SVt_PVIO:
	2218	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2219	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2220	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2221	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2222	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2223	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2224	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2225	if (IoTOP_NAME(sv))
	2226	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2227	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2228	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2229	else {
	2230	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2231	PTR2UV(IoTOP_GV(sv)));
	2232	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2233	maxnest, dumpops, pvlim);
	2234	}
	2235	/* Source filters hide things that are not GVs in these three, so let's
	2236	be careful out there. */
	2237	if (IoFMT_NAME(sv))
	2238	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2239	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2240	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2241	else {
	2242	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2243	PTR2UV(IoFMT_GV(sv)));
	2244	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2245	maxnest, dumpops, pvlim);
	2246	}
	2247	if (IoBOTTOM_NAME(sv))
	2248	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2249	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2250	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2251	else {
	2252	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2253	PTR2UV(IoBOTTOM_GV(sv)));
	2254	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2255	maxnest, dumpops, pvlim);
	2256	}
	2257	if (isPRINT(IoTYPE(sv)))
	2258	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2259	else
	2260	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2261	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2262	break;
	2263	case SVt_REGEXP:
	2264	dumpregexp:
	2265	{
	2266	struct regexp * const r = ReANY((REGEXP*)sv);
	2267	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
	2268	sv_setpv(d,""); \
	2269	append_flags(d, flags, regexp_flags_names); \
	2270	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2271	SvCUR_set(d, SvCUR(d) - 1); \
	2272	SvPVX(d)[SvCUR(d)] = '\0'; \
	2273	} \
	2274	} STMT_END
	2275	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
	2276	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2277	(UV)(r->compflags), SvPVX_const(d));
	2278
	2279	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
	2280	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2281	(UV)(r->extflags), SvPVX_const(d));
	2282	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2283
	2284	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2285	(UV)(r->intflags));
	2286	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2287	(UV)(r->nparens));
	2288	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2289	(UV)(r->lastparen));
	2290	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2291	(UV)(r->lastcloseparen));
	2292	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2293	(IV)(r->minlen));
	2294	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2295	(IV)(r->minlenret));
	2296	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2297	(UV)(r->gofs));
	2298	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2299	(UV)(r->pre_prefix));
	2300	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2301	(IV)(r->sublen));
	2302	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2303	(IV)(r->suboffset));
	2304	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2305	(IV)(r->subcoffset));
	2306	if (r->subbeg)
	2307	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2308	PTR2UV(r->subbeg),
	2309	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2310	else
	2311	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2312	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
	2313	PTR2UV(r->engine));
	2314	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2315	PTR2UV(r->mother_re));
	2316	if (nest < maxnest && r->mother_re)
	2317	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2318	maxnest, dumpops, pvlim);
	2319	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2320	PTR2UV(r->paren_names));
	2321	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2322	PTR2UV(r->substrs));
	2323	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2324	PTR2UV(r->pprivate));
	2325	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2326	PTR2UV(r->offs));
	2327	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2328	PTR2UV(r->qr_anoncv));
	2329	#ifdef PERL_ANY_COW
	2330	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2331	PTR2UV(r->saved_copy));
	2332	#endif
	2333	}
	2334	break;
	2335	}
	2336	SvREFCNT_dec_NN(d);
	2337	}
	2338
	2339	/*
	2340	=for apidoc sv_dump
	2341
	2342	Dumps the contents of an SV to the C<STDERR> filehandle.
	2343
	2344	For an example of its output, see L<Devel::Peek>.
	2345
	2346	=cut
	2347	*/
	2348
	2349	void
	2350	Perl_sv_dump(pTHX_ SV *sv)
	2351	{
	2352	dVAR;
	2353
	2354	PERL_ARGS_ASSERT_SV_DUMP;
	2355
	2356	if (SvROK(sv))
	2357	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2358	else
	2359	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2360	}
	2361
	2362	int
	2363	Perl_runops_debug(pTHX)
	2364	{
	2365	dVAR;
	2366	if (!PL_op) {
	2367	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2368	return 0;
	2369	}
	2370
	2371	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2372	do {
	2373	#ifdef PERL_TRACE_OPS
	2374	++PL_op_exec_cnt[PL_op->op_type];
	2375	#endif
	2376	if (PL_debug) {
	2377	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2378	PerlIO_printf(Perl_debug_log,
	2379	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2380	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2381	PTR2UV(*PL_watchaddr));
	2382	if (DEBUG_s_TEST_) {
	2383	if (DEBUG_v_TEST_) {
	2384	PerlIO_printf(Perl_debug_log, "\n");
	2385	deb_stack_all();
	2386	}
	2387	else
	2388	debstack();
	2389	}
	2390
	2391
	2392	if (DEBUG_t_TEST_) debop(PL_op);
	2393	if (DEBUG_P_TEST_) debprof(PL_op);
	2394	}
	2395
	2396	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2397	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2398	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2399	PERL_ASYNC_CHECK();
	2400
	2401	TAINT_NOT;
	2402	return 0;
	2403	}
	2404
	2405	I32
	2406	Perl_debop(pTHX_ const OP *o)
	2407	{
	2408	dVAR;
	2409
	2410	PERL_ARGS_ASSERT_DEBOP;
	2411
	2412	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2413	return 0;
	2414
	2415	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2416	switch (o->op_type) {
	2417	case OP_CONST:
	2418	case OP_HINTSEVAL:
	2419	/* With ITHREADS, consts are stored in the pad, and the right pad
	2420	* may not be active here, so check.
	2421	* Looks like only during compiling the pads are illegal.
	2422	*/
	2423	#ifdef USE_ITHREADS
	2424	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2425	#endif
	2426	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2427	break;
	2428	case OP_GVSV:
	2429	case OP_GV:
	2430	if (cGVOPo_gv) {
	2431	SV * const sv = newSV(0);
	2432	#ifdef PERL_MAD
	2433	/* FIXME - is this making unwarranted assumptions about the
	2434	UTF-8 cleanliness of the dump file handle? */
	2435	SvUTF8_on(sv);
	2436	#endif
	2437	gv_fullname3(sv, cGVOPo_gv, NULL);
	2438	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2439	SvREFCNT_dec_NN(sv);
	2440	}
	2441	else
	2442	PerlIO_printf(Perl_debug_log, "(NULL)");
	2443	break;
	2444
	2445	{
	2446	int count;
	2447
	2448	case OP_PADSV:
	2449	case OP_PADAV:
	2450	case OP_PADHV:
	2451	count = 1;
	2452	goto dump_padop;
	2453	case OP_PADRANGE:
	2454	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2455	dump_padop:
	2456	/* print the lexical's name */
	2457	{
	2458	CV * const cv = deb_curcv(cxstack_ix);
	2459	SV *sv;
	2460	PAD * comppad = NULL;
	2461	int i;
	2462
	2463	if (cv) {
	2464	PADLIST * const padlist = CvPADLIST(cv);
	2465	comppad = *PadlistARRAY(padlist);
	2466	}
	2467	PerlIO_printf(Perl_debug_log, "(");
	2468	for (i = 0; i < count; i++) {
	2469	if (comppad &&
	2470	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2471	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2472	else
	2473	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2474	(UV)o->op_targ+i);
	2475	if (i < count-1)
	2476	PerlIO_printf(Perl_debug_log, ",");
	2477	}
	2478	PerlIO_printf(Perl_debug_log, ")");
	2479	}
	2480	break;
	2481	}
	2482
	2483	default:
	2484	break;
	2485	}
	2486	PerlIO_printf(Perl_debug_log, "\n");
	2487	return 0;
	2488	}
	2489
	2490	STATIC CV*
	2491	S_deb_curcv(pTHX_ const I32 ix)
	2492	{
	2493	dVAR;
	2494	const PERL_CONTEXT * const cx = &cxstack[ix];
	2495	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2496	return cx->blk_sub.cv;
	2497	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2498	return cx->blk_eval.cv;
	2499	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2500	return PL_main_cv;
	2501	else if (ix <= 0)
	2502	return NULL;
	2503	else
	2504	return deb_curcv(ix - 1);
	2505	}
	2506
	2507	void
	2508	Perl_watch(pTHX_ char **addr)
	2509	{
	2510	dVAR;
	2511
	2512	PERL_ARGS_ASSERT_WATCH;
	2513
	2514	PL_watchaddr = addr;
	2515	PL_watchok = *addr;
	2516	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2517	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2518	}
	2519
	2520	STATIC void
	2521	S_debprof(pTHX_ const OP *o)
	2522	{
	2523	dVAR;
	2524
	2525	PERL_ARGS_ASSERT_DEBPROF;
	2526
	2527	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2528	return;
	2529	if (!PL_profiledata)
	2530	Newxz(PL_profiledata, MAXO, U32);
	2531	++PL_profiledata[o->op_type];
	2532	}
	2533
	2534	void
	2535	Perl_debprofdump(pTHX)
	2536	{
	2537	dVAR;
	2538	unsigned i;
	2539	if (!PL_profiledata)
	2540	return;
	2541	for (i = 0; i < MAXO; i++) {
	2542	if (PL_profiledata[i])
	2543	PerlIO_printf(Perl_debug_log,
	2544	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2545	PL_op_name[i]);
	2546	}
	2547	}
	2548
	2549	#ifdef PERL_MAD
	2550	/*
	2551	* XML variants of most of the above routines
	2552	*/
	2553
	2554	STATIC void
	2555	S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2556	{
	2557	va_list args;
	2558
	2559	PERL_ARGS_ASSERT_XMLDUMP_ATTR;
	2560
	2561	PerlIO_printf(file, "\n ");
	2562	va_start(args, pat);
	2563	xmldump_vindent(level, file, pat, &args);
	2564	va_end(args);
	2565	}
	2566
	2567
	2568	void
	2569	Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2570	{
	2571	va_list args;
	2572	PERL_ARGS_ASSERT_XMLDUMP_INDENT;
	2573	va_start(args, pat);
	2574	xmldump_vindent(level, file, pat, &args);
	2575	va_end(args);
	2576	}
	2577
	2578	void
	2579	Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	2580	{
	2581	PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
	2582
	2583	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	2584	PerlIO_vprintf(file, pat, *args);
	2585	}
	2586
	2587	void
	2588	Perl_xmldump_all(pTHX)
	2589	{
	2590	xmldump_all_perl(FALSE);
	2591	}
	2592
	2593	void
	2594	Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
	2595	{
	2596	PerlIO_setlinebuf(PL_xmlfp);
	2597	if (PL_main_root)
	2598	op_xmldump(PL_main_root);
	2599	/* someday we might call this, when it outputs XML: */
	2600	/* xmldump_packsubs_perl(PL_defstash, justperl); */
	2601	if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
	2602	PerlIO_close(PL_xmlfp);
	2603	PL_xmlfp = 0;
	2604	}
	2605
	2606	void
	2607	Perl_xmldump_packsubs(pTHX_ const HV *stash)
	2608	{
	2609	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
	2610	xmldump_packsubs_perl(stash, FALSE);
	2611	}
	2612
	2613	void
	2614	Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	2615	{
	2616	I32 i;
	2617	HE *entry;
	2618
	2619	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
	2620
	2621	if (!HvARRAY(stash))
	2622	return;
	2623	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	2624	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	2625	GV *gv = MUTABLE_GV(HeVAL(entry));
	2626	HV *hv;
	2627	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	2628	continue;
	2629	if (GvCVu(gv))
	2630	xmldump_sub_perl(gv, justperl);
	2631	if (GvFORM(gv))
	2632	xmldump_form(gv);
	2633	if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
	2634	&& (hv = GvHV(gv)) && hv != PL_defstash)
	2635	xmldump_packsubs_perl(hv, justperl); /* nested package */
	2636	}
	2637	}
	2638	}
	2639
	2640	void
	2641	Perl_xmldump_sub(pTHX_ const GV *gv)
	2642	{
	2643	PERL_ARGS_ASSERT_XMLDUMP_SUB;
	2644	xmldump_sub_perl(gv, FALSE);
	2645	}
	2646
	2647	void
	2648	Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
	2649	{
	2650	SV * sv;
	2651
	2652	PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
	2653
	2654	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	2655	return;
	2656
	2657	sv = sv_newmortal();
	2658	gv_fullname3(sv, gv, NULL);
	2659	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
	2660	if (CvXSUB(GvCV(gv)))
	2661	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
	2662	PTR2UV(CvXSUB(GvCV(gv))),
	2663	(int)CvXSUBANY(GvCV(gv)).any_i32);
	2664	else if (CvROOT(GvCV(gv)))
	2665	op_xmldump(CvROOT(GvCV(gv)));
	2666	else
	2667	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2668	}
	2669
	2670	void
	2671	Perl_xmldump_form(pTHX_ const GV *gv)
	2672	{
	2673	SV * const sv = sv_newmortal();
	2674
	2675	PERL_ARGS_ASSERT_XMLDUMP_FORM;
	2676
	2677	gv_fullname3(sv, gv, NULL);
	2678	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
	2679	if (CvROOT(GvFORM(gv)))
	2680	op_xmldump(CvROOT(GvFORM(gv)));
	2681	else
	2682	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2683	}
	2684
	2685	void
	2686	Perl_xmldump_eval(pTHX)
	2687	{
	2688	op_xmldump(PL_eval_root);
	2689	}
	2690
	2691	char *
	2692	Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
	2693	{
	2694	PERL_ARGS_ASSERT_SV_CATXMLSV;
	2695	return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
	2696	}
	2697
	2698	char *
	2699	Perl_sv_catxmlpv(pTHX_ SV dsv, const char pv, int utf8)
	2700	{
	2701	PERL_ARGS_ASSERT_SV_CATXMLPV;
	2702	return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
	2703	}
	2704
	2705	char *
	2706	Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
	2707	{
	2708	unsigned int c;
	2709	const char * const e = pv + len;
	2710	const char * const start = pv;
	2711	STRLEN dsvcur;
	2712	STRLEN cl;
	2713
	2714	PERL_ARGS_ASSERT_SV_CATXMLPVN;
	2715
	2716	sv_catpvs(dsv,"");
	2717	dsvcur = SvCUR(dsv); /* in case we have to restart */
	2718
	2719	retry:
	2720	while (pv < e) {
	2721	if (utf8) {
	2722	c = utf8_to_uvchr_buf((U8)pv, (U8)e, &cl);
	2723	if (cl == 0) {
	2724	SvCUR(dsv) = dsvcur;
	2725	pv = start;
	2726	utf8 = 0;
	2727	goto retry;
	2728	}
	2729	}
	2730	else
	2731	c = (*pv & 255);
	2732
	2733	if (isCNTRL_L1(c)
	2734	&& c != '\t'
	2735	&& c != '\n'
	2736	&& c != '\r'
	2737	&& c != LATIN1_TO_NATIVE(0x85))
	2738	{
	2739	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2740	}
	2741	else switch (c) {
	2742	case '<':
	2743	sv_catpvs(dsv, "<");
	2744	break;
	2745	case '>':
	2746	sv_catpvs(dsv, ">");
	2747	break;
	2748	case '&':
	2749	sv_catpvs(dsv, "&");
	2750	break;
	2751	case '"':
	2752	sv_catpvs(dsv, """);
	2753	break;
	2754	default:
	2755	if (c < 0xD800) {
	2756	if (! isPRINT(c)) {
	2757	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2758	}
	2759	else {
	2760	const char string = (char) c;
	2761	sv_catpvn(dsv, &string, 1);
	2762	}
	2763	break;
	2764	}
	2765	if ((c >= 0xD800 && c <= 0xDB7F) \|\|
	2766	(c >= 0xDC00 && c <= 0xDFFF) \|\|
	2767	(c >= 0xFFF0 && c <= 0xFFFF) \|\|
	2768	c > 0x10ffff)
	2769	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2770	else
	2771	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2772	}
	2773
	2774	if (utf8)
	2775	pv += UTF8SKIP(pv);
	2776	else
	2777	pv++;
	2778	}
	2779
	2780	return SvPVX(dsv);
	2781	}
	2782
	2783	char *
	2784	Perl_sv_xmlpeek(pTHX_ SV *sv)
	2785	{
	2786	SV * const t = sv_newmortal();
	2787	STRLEN n_a;
	2788	int unref = 0;
	2789
	2790	PERL_ARGS_ASSERT_SV_XMLPEEK;
	2791
	2792	sv_utf8_upgrade(t);
	2793	sv_setpvs(t, "");
	2794	/* retry: */
	2795	if (!sv) {
	2796	sv_catpv(t, "VOID=\"\"");
	2797	goto finish;
	2798	}
	2799	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	2800	sv_catpv(t, "WILD=\"\"");
	2801	goto finish;
	2802	}
	2803	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	2804	if (sv == &PL_sv_undef) {
	2805	sv_catpv(t, "SV_UNDEF=\"1\"");
	2806	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2807	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2808	SvREADONLY(sv))
	2809	goto finish;
	2810	}
	2811	else if (sv == &PL_sv_no) {
	2812	sv_catpv(t, "SV_NO=\"1\"");
	2813	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2814	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2815	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2816	SVp_POK\|SVp_NOK)) &&
	2817	SvCUR(sv) == 0 &&
	2818	SvNVX(sv) == 0.0)
	2819	goto finish;
	2820	}
	2821	else if (sv == &PL_sv_yes) {
	2822	sv_catpv(t, "SV_YES=\"1\"");
	2823	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2824	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2825	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2826	SVp_POK\|SVp_NOK)) &&
	2827	SvCUR(sv) == 1 &&
	2828	SvPVX(sv) && *SvPVX(sv) == '1' &&
	2829	SvNVX(sv) == 1.0)
	2830	goto finish;
	2831	}
	2832	else {
	2833	sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
	2834	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2835	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2836	SvREADONLY(sv))
	2837	goto finish;
	2838	}
	2839	sv_catpv(t, " XXX=\"\" ");
	2840	}
	2841	else if (SvREFCNT(sv) == 0) {
	2842	sv_catpv(t, " refcnt=\"0\"");
	2843	unref++;
	2844	}
	2845	else if (DEBUG_R_TEST_) {
	2846	int is_tmp = 0;
	2847	SSize_t ix;
	2848	/* is this SV on the tmps stack? */
	2849	for (ix=PL_tmps_ix; ix>=0; ix--) {
	2850	if (PL_tmps_stack[ix] == sv) {
	2851	is_tmp = 1;
	2852	break;
	2853	}
	2854	}
	2855	if (SvREFCNT(sv) > 1)
	2856	Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
	2857	is_tmp ? "T" : "");
	2858	else if (is_tmp)
	2859	sv_catpv(t, " DRT=\"<T>\"");
	2860	}
	2861
	2862	if (SvROK(sv)) {
	2863	sv_catpv(t, " ROK=\"\"");
	2864	}
	2865	switch (SvTYPE(sv)) {
	2866	default:
	2867	sv_catpv(t, " FREED=\"1\"");
	2868	goto finish;
	2869
	2870	case SVt_NULL:
	2871	sv_catpv(t, " UNDEF=\"1\"");
	2872	goto finish;
	2873	case SVt_IV:
	2874	sv_catpv(t, " IV=\"");
	2875	break;
	2876	case SVt_NV:
	2877	sv_catpv(t, " NV=\"");
	2878	break;
	2879	case SVt_PV:
	2880	sv_catpv(t, " PV=\"");
	2881	break;
	2882	case SVt_PVIV:
	2883	sv_catpv(t, " PVIV=\"");
	2884	break;
	2885	case SVt_PVNV:
	2886	sv_catpv(t, " PVNV=\"");
	2887	break;
	2888	case SVt_PVMG:
	2889	sv_catpv(t, " PVMG=\"");
	2890	break;
	2891	case SVt_PVLV:
	2892	sv_catpv(t, " PVLV=\"");
	2893	break;
	2894	case SVt_PVAV:
	2895	sv_catpv(t, " AV=\"");
	2896	break;
	2897	case SVt_PVHV:
	2898	sv_catpv(t, " HV=\"");
	2899	break;
	2900	case SVt_PVCV:
	2901	if (CvGV(sv))
	2902	Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
	2903	else
	2904	sv_catpv(t, " CV=\"()\"");
	2905	goto finish;
	2906	case SVt_PVGV:
	2907	sv_catpv(t, " GV=\"");
	2908	break;
	2909	case SVt_INVLIST:
	2910	sv_catpv(t, " DUMMY=\"");
	2911	break;
	2912	case SVt_REGEXP:
	2913	sv_catpv(t, " REGEXP=\"");
	2914	break;
	2915	case SVt_PVFM:
	2916	sv_catpv(t, " FM=\"");
	2917	break;
	2918	case SVt_PVIO:
	2919	sv_catpv(t, " IO=\"");
	2920	break;
	2921	}
	2922
	2923	if (SvPOKp(sv)) {
	2924	if (SvPVX(sv)) {
	2925	sv_catxmlsv(t, sv);
	2926	}
	2927	}
	2928	else if (SvNOKp(sv)) {
	2929	STORE_NUMERIC_LOCAL_SET_STANDARD();
	2930	Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
	2931	RESTORE_NUMERIC_LOCAL();
	2932	}
	2933	else if (SvIOKp(sv)) {
	2934	if (SvIsUV(sv))
	2935	Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
	2936	else
	2937	Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
	2938	}
	2939	else
	2940	sv_catpv(t, "");
	2941	sv_catpv(t, "\"");
	2942
	2943	finish:
	2944	while (unref--)
	2945	sv_catpv(t, ")");
	2946	return SvPV(t, n_a);
	2947	}
	2948
	2949	void
	2950	Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	2951	{
	2952	PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
	2953
	2954	if (!pm) {
	2955	Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
	2956	return;
	2957	}
	2958	Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
	2959	level++;
	2960	if (PM_GETRE(pm)) {
	2961	REGEXP *const r = PM_GETRE(pm);
	2962	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2963	sv_catxmlsv(tmpsv, MUTABLE_SV(r));
	2964	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
	2965	SvPVX(tmpsv));
	2966	SvREFCNT_dec_NN(tmpsv);
	2967	Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
	2968	(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
	2969	}
	2970	else
	2971	Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
	2972	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	2973	SV * const tmpsv = pm_description(pm);
	2974	Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2975	SvREFCNT_dec_NN(tmpsv);
	2976	}
	2977
	2978	level--;
	2979	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	2980	Perl_xmldump_indent(aTHX_ level, file, ">\n");
	2981	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
	2982	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
	2983	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
	2984	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
	2985	}
	2986	else
	2987	Perl_xmldump_indent(aTHX_ level, file, "/>\n");
	2988	}
	2989
	2990	void
	2991	Perl_pmop_xmldump(pTHX_ const PMOP *pm)
	2992	{
	2993	do_pmop_xmldump(0, PL_xmlfp, pm);
	2994	}
	2995
	2996	void
	2997	Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
	2998	{
	2999	UV seq;
	3000	int contents = 0;
	3001	const OPCODE optype = o->op_type;
	3002
	3003	PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
	3004
	3005	if (!o)
	3006	return;
	3007	seq = sequence_num(o);
	3008	Perl_xmldump_indent(aTHX_ level, file,
	3009	"<op_%s seq=\"%"UVuf" -> ",
	3010	OP_NAME(o),
	3011	seq);
	3012	level++;
	3013	if (o->op_next)
	3014	PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
	3015	sequence_num(o->op_next));
	3016	else
	3017	PerlIO_printf(file, "DONE\"");
	3018
	3019	if (o->op_targ) {
	3020	if (optype == OP_NULL)
	3021	{
	3022	PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
	3023	if (o->op_targ == OP_NEXTSTATE)
	3024	{
	3025	if (CopLINE(cCOPo))
	3026	PerlIO_printf(file, " line=\"%"UVuf"\"",
	3027	(UV)CopLINE(cCOPo));
	3028	if (CopSTASHPV(cCOPo))
	3029	PerlIO_printf(file, " package=\"%s\"",
	3030	CopSTASHPV(cCOPo));
	3031	if (CopLABEL(cCOPo))
	3032	PerlIO_printf(file, " label=\"%s\"",
	3033	CopLABEL(cCOPo));
	3034	}
	3035	}
	3036	else
	3037	PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
	3038	}
	3039	#ifdef DUMPADDR
	3040	PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
	3041	#endif
	3042
	3043	DUMP_OP_FLAGS(o,1,0,file);
	3044	DUMP_OP_PRIVATE(o,1,0,file);
	3045
	3046	switch (optype) {
	3047	case OP_AELEMFAST:
	3048	if (o->op_flags & OPf_SPECIAL) {
	3049	break;
	3050	}
	3051	case OP_GVSV:
	3052	case OP_GV:
	3053	#ifdef USE_ITHREADS
	3054	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
	3055	#else
	3056	if (cSVOPo->op_sv) {
	3057	SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
	3058	SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
	3059	char *s;
	3060	STRLEN len;
	3061	ENTER;
	3062	SAVEFREESV(tmpsv1);
	3063	SAVEFREESV(tmpsv2);
	3064	gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
	3065	s = SvPV(tmpsv1,len);
	3066	sv_catxmlpvn(tmpsv2, s, len, 1);
	3067	S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
	3068	LEAVE;
	3069	}
	3070	else
	3071	S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
	3072	#endif
	3073	break;
	3074	case OP_CONST:
	3075	case OP_HINTSEVAL:
	3076	case OP_METHOD_NAMED:
	3077	#ifndef USE_ITHREADS
	3078	/* with ITHREADS, consts are stored in the pad, and the right pad
	3079	* may not be active here, so skip */
	3080	S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
	3081	#endif
	3082	break;
	3083	case OP_ANONCODE:
	3084	if (!contents) {
	3085	contents = 1;
	3086	PerlIO_printf(file, ">\n");
	3087	}
	3088	do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
	3089	break;
	3090	case OP_NEXTSTATE:
	3091	case OP_DBSTATE:
	3092	if (CopLINE(cCOPo))
	3093	S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
	3094	(UV)CopLINE(cCOPo));
	3095	if (CopSTASHPV(cCOPo))
	3096	S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
	3097	CopSTASHPV(cCOPo));
	3098	if (CopLABEL(cCOPo))
	3099	S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
	3100	CopLABEL(cCOPo));
	3101	break;
	3102	case OP_ENTERLOOP:
	3103	S_xmldump_attr(aTHX_ level, file, "redo=\"");
	3104	if (cLOOPo->op_redoop)
	3105	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
	3106	else
	3107	PerlIO_printf(file, "DONE\"");
	3108	S_xmldump_attr(aTHX_ level, file, "next=\"");
	3109	if (cLOOPo->op_nextop)
	3110	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
	3111	else
	3112	PerlIO_printf(file, "DONE\"");
	3113	S_xmldump_attr(aTHX_ level, file, "last=\"");
	3114	if (cLOOPo->op_lastop)
	3115	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
	3116	else
	3117	PerlIO_printf(file, "DONE\"");
	3118	break;
	3119	case OP_COND_EXPR:
	3120	case OP_RANGE:
	3121	case OP_MAPWHILE:
	3122	case OP_GREPWHILE:
	3123	case OP_OR:
	3124	case OP_AND:
	3125	S_xmldump_attr(aTHX_ level, file, "other=\"");
	3126	if (cLOGOPo->op_other)
	3127	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
	3128	else
	3129	PerlIO_printf(file, "DONE\"");
	3130	break;
	3131	case OP_LEAVE:
	3132	case OP_LEAVEEVAL:
	3133	case OP_LEAVESUB:
	3134	case OP_LEAVESUBLV:
	3135	case OP_LEAVEWRITE:
	3136	case OP_SCOPE:
	3137	if (o->op_private & OPpREFCOUNTED)
	3138	S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
	3139	break;
	3140	default:
	3141	break;
	3142	}
	3143
	3144	if (PL_madskills && o->op_madprop) {
	3145	char prevkey = '\0';
	3146	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	3147	const MADPROP* mp = o->op_madprop;
	3148
	3149	if (!contents) {
	3150	contents = 1;
	3151	PerlIO_printf(file, ">\n");
	3152	}
	3153	Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
	3154	level++;
	3155	while (mp) {
	3156	char tmp = mp->mad_key;
	3157	sv_setpvs(tmpsv,"\"");
	3158	if (tmp)
	3159	sv_catxmlpvn(tmpsv, &tmp, 1, 0);
	3160	if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
	3161	sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
	3162	else
	3163	prevkey = tmp;
	3164	sv_catpv(tmpsv, "\"");
	3165	switch (mp->mad_type) {
	3166	case MAD_NULL:
	3167	sv_catpv(tmpsv, "NULL");
	3168	Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
	3169	break;
	3170	case MAD_PV:
	3171	sv_catpv(tmpsv, " val=\"");
	3172	sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
	3173	sv_catpv(tmpsv, "\"");
	3174	Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
	3175	break;
	3176	case MAD_SV:
	3177	sv_catpv(tmpsv, " val=\"");
	3178	sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
	3179	sv_catpv(tmpsv, "\"");
	3180	Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
	3181	break;
	3182	case MAD_OP:
	3183	if ((OP*)mp->mad_val) {
	3184	Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
	3185	do_op_xmldump(level+1, file, (OP*)mp->mad_val);
	3186	Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
	3187	}
	3188	break;
	3189	default:
	3190	Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
	3191	break;
	3192	}
	3193	mp = mp->mad_next;
	3194	}
	3195	level--;
	3196	Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
	3197
	3198	SvREFCNT_dec_NN(tmpsv);
	3199	}
	3200
	3201	switch (optype) {
	3202	case OP_PUSHRE:
	3203	case OP_MATCH:
	3204	case OP_QR:
	3205	case OP_SUBST:
	3206	if (!contents) {
	3207	contents = 1;
	3208	PerlIO_printf(file, ">\n");
	3209	}
	3210	do_pmop_xmldump(level, file, cPMOPo);
	3211	break;
	3212	default:
	3213	break;
	3214	}
	3215
	3216	if (o->op_flags & OPf_KIDS) {
	3217	OP *kid;
	3218	if (!contents) {
	3219	contents = 1;
	3220	PerlIO_printf(file, ">\n");
	3221	}
	3222	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	3223	do_op_xmldump(level, file, kid);
	3224	}
	3225
	3226	if (contents)
	3227	Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
	3228	else
	3229	PerlIO_printf(file, " />\n");
	3230	}
	3231
	3232	void
	3233	Perl_op_xmldump(pTHX_ const OP *o)
	3234	{
	3235	PERL_ARGS_ASSERT_OP_XMLDUMP;
	3236
	3237	do_op_xmldump(0, PL_xmlfp, o);
	3238	}
	3239	#endif
	3240
	3241	/*
	3242	* Local variables:
	3243	* c-indentation-style: bsd
	3244	* c-basic-offset: 4
	3245	* indent-tabs-mode: nil
	3246	* End:
	3247	*
	3248	* ex: set ts=8 sts=4 sw=4 et:
	3249	*/