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

... / ...

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