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