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))
	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)) {
	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	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1830	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1831	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1832	if (type == SVt_PVFM)
	1833	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
	1834	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1835	if (nest < maxnest) {
	1836	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1837	}
	1838	{
	1839	const CV * const outside = CvOUTSIDE(sv);
	1840	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1841	PTR2UV(outside),
	1842	(!outside ? "null"
	1843	: CvANON(outside) ? "ANON"
	1844	: (outside == PL_main_cv) ? "MAIN"
	1845	: CvUNIQUE(outside) ? "UNIQUE"
	1846	: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
	1847	}
	1848	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	1849	do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
	1850	break;
	1851	case SVt_PVGV:
	1852	case SVt_PVLV:
	1853	if (type == SVt_PVLV) {
	1854	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	1855	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	1856	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	1857	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	1858	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
	1859	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	1860	dumpops, pvlim);
	1861	}
	1862	if (SvVALID(sv)) {
	1863	Perl_dump_indent(aTHX_ level, file, " FLAGS = %u\n", (U8)BmFLAGS(sv));
	1864	Perl_dump_indent(aTHX_ level, file, " RARE = %u\n", (U8)BmRARE(sv));
	1865	Perl_dump_indent(aTHX_ level, file, " PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
	1866	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1867	}
	1868	if (!isGV_with_GP(sv))
	1869	break;
	1870	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
	1871	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	1872	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	1873	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	1874	if (!GvGP(sv))
	1875	break;
	1876	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	1877	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	1878	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	1879	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	1880	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	1881	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	1882	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	1883	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	1884	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	1885	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	1886	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	1887	do_gv_dump (level, file, " EGV", GvEGV(sv));
	1888	break;
	1889	case SVt_PVIO:
	1890	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	1891	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	1892	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	1893	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	1894	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	1895	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	1896	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	1897	if (IoTOP_NAME(sv))
	1898	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	1899	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	1900	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	1901	else {
	1902	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	1903	PTR2UV(IoTOP_GV(sv)));
	1904	do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest,
	1905	dumpops, pvlim);
	1906	}
	1907	/* Source filters hide things that are not GVs in these three, so let's
	1908	be careful out there. */
	1909	if (IoFMT_NAME(sv))
	1910	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	1911	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	1912	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	1913	else {
	1914	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	1915	PTR2UV(IoFMT_GV(sv)));
	1916	do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest,
	1917	dumpops, pvlim);
	1918	}
	1919	if (IoBOTTOM_NAME(sv))
	1920	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	1921	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	1922	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	1923	else {
	1924	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	1925	PTR2UV(IoBOTTOM_GV(sv)));
	1926	do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
	1927	dumpops, pvlim);
	1928	}
	1929	if (isPRINT(IoTYPE(sv)))
	1930	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	1931	else
	1932	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	1933	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	1934	break;
	1935	}
	1936	SvREFCNT_dec(d);
	1937	}
	1938
	1939	void
	1940	Perl_sv_dump(pTHX_ SV *sv)
	1941	{
	1942	dVAR;
	1943
	1944	PERL_ARGS_ASSERT_SV_DUMP;
	1945
	1946	if (SvROK(sv))
	1947	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	1948	else
	1949	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	1950	}
	1951
	1952	int
	1953	Perl_runops_debug(pTHX)
	1954	{
	1955	dVAR;
	1956	if (!PL_op) {
	1957	if (ckWARN_d(WARN_DEBUGGING))
	1958	Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	1959	return 0;
	1960	}
	1961
	1962	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	1963	do {
	1964	PERL_ASYNC_CHECK();
	1965	if (PL_debug) {
	1966	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	1967	PerlIO_printf(Perl_debug_log,
	1968	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	1969	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	1970	PTR2UV(*PL_watchaddr));
	1971	if (DEBUG_s_TEST_) {
	1972	if (DEBUG_v_TEST_) {
	1973	PerlIO_printf(Perl_debug_log, "\n");
	1974	deb_stack_all();
	1975	}
	1976	else
	1977	debstack();
	1978	}
	1979
	1980
	1981	if (DEBUG_t_TEST_) debop(PL_op);
	1982	if (DEBUG_P_TEST_) debprof(PL_op);
	1983	}
	1984	} while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
	1985	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	1986
	1987	TAINT_NOT;
	1988	return 0;
	1989	}
	1990
	1991	I32
	1992	Perl_debop(pTHX_ const OP *o)
	1993	{
	1994	dVAR;
	1995
	1996	PERL_ARGS_ASSERT_DEBOP;
	1997
	1998	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	1999	return 0;
	2000
	2001	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2002	switch (o->op_type) {
	2003	case OP_CONST:
	2004	case OP_HINTSEVAL:
	2005	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2006	break;
	2007	case OP_GVSV:
	2008	case OP_GV:
	2009	if (cGVOPo_gv) {
	2010	SV * const sv = newSV(0);
	2011	#ifdef PERL_MAD
	2012	/* FIXME - is this making unwarranted assumptions about the
	2013	UTF-8 cleanliness of the dump file handle? */
	2014	SvUTF8_on(sv);
	2015	#endif
	2016	gv_fullname3(sv, cGVOPo_gv, NULL);
	2017	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2018	SvREFCNT_dec(sv);
	2019	}
	2020	else
	2021	PerlIO_printf(Perl_debug_log, "(NULL)");
	2022	break;
	2023	case OP_PADSV:
	2024	case OP_PADAV:
	2025	case OP_PADHV:
	2026	{
	2027	/* print the lexical's name */
	2028	CV * const cv = deb_curcv(cxstack_ix);
	2029	SV *sv;
	2030	if (cv) {
	2031	AV * const padlist = CvPADLIST(cv);
	2032	AV * const comppad = (AV)(av_fetch(padlist, 0, FALSE));
	2033	sv = *av_fetch(comppad, o->op_targ, FALSE);
	2034	} else
	2035	sv = NULL;
	2036	if (sv)
	2037	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2038	else
	2039	PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
	2040	}
	2041	break;
	2042	default:
	2043	break;
	2044	}
	2045	PerlIO_printf(Perl_debug_log, "\n");
	2046	return 0;
	2047	}
	2048
	2049	STATIC CV*
	2050	S_deb_curcv(pTHX_ const I32 ix)
	2051	{
	2052	dVAR;
	2053	const PERL_CONTEXT * const cx = &cxstack[ix];
	2054	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2055	return cx->blk_sub.cv;
	2056	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2057	return PL_compcv;
	2058	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2059	return PL_main_cv;
	2060	else if (ix <= 0)
	2061	return NULL;
	2062	else
	2063	return deb_curcv(ix - 1);
	2064	}
	2065
	2066	void
	2067	Perl_watch(pTHX_ char **addr)
	2068	{
	2069	dVAR;
	2070
	2071	PERL_ARGS_ASSERT_WATCH;
	2072
	2073	PL_watchaddr = addr;
	2074	PL_watchok = *addr;
	2075	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2076	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2077	}
	2078
	2079	STATIC void
	2080	S_debprof(pTHX_ const OP *o)
	2081	{
	2082	dVAR;
	2083
	2084	PERL_ARGS_ASSERT_DEBPROF;
	2085
	2086	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2087	return;
	2088	if (!PL_profiledata)
	2089	Newxz(PL_profiledata, MAXO, U32);
	2090	++PL_profiledata[o->op_type];
	2091	}
	2092
	2093	void
	2094	Perl_debprofdump(pTHX)
	2095	{
	2096	dVAR;
	2097	unsigned i;
	2098	if (!PL_profiledata)
	2099	return;
	2100	for (i = 0; i < MAXO; i++) {
	2101	if (PL_profiledata[i])
	2102	PerlIO_printf(Perl_debug_log,
	2103	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2104	PL_op_name[i]);
	2105	}
	2106	}
	2107
	2108	#ifdef PERL_MAD
	2109	/*
	2110	* XML variants of most of the above routines
	2111	*/
	2112
	2113	STATIC void
	2114	S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2115	{
	2116	va_list args;
	2117
	2118	PERL_ARGS_ASSERT_XMLDUMP_ATTR;
	2119
	2120	PerlIO_printf(file, "\n ");
	2121	va_start(args, pat);
	2122	xmldump_vindent(level, file, pat, &args);
	2123	va_end(args);
	2124	}
	2125
	2126
	2127	void
	2128	Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	2129	{
	2130	va_list args;
	2131	PERL_ARGS_ASSERT_XMLDUMP_INDENT;
	2132	va_start(args, pat);
	2133	xmldump_vindent(level, file, pat, &args);
	2134	va_end(args);
	2135	}
	2136
	2137	void
	2138	Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	2139	{
	2140	PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
	2141
	2142	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	2143	PerlIO_vprintf(file, pat, *args);
	2144	}
	2145
	2146	void
	2147	Perl_xmldump_all(pTHX)
	2148	{
	2149	PerlIO_setlinebuf(PL_xmlfp);
	2150	if (PL_main_root)
	2151	op_xmldump(PL_main_root);
	2152	if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
	2153	PerlIO_close(PL_xmlfp);
	2154	PL_xmlfp = 0;
	2155	}
	2156
	2157	void
	2158	Perl_xmldump_packsubs(pTHX_ const HV *stash)
	2159	{
	2160	I32 i;
	2161	HE *entry;
	2162
	2163	PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
	2164
	2165	if (!HvARRAY(stash))
	2166	return;
	2167	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	2168	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	2169	GV gv = (GV)HeVAL(entry);
	2170	HV *hv;
	2171	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	2172	continue;
	2173	if (GvCVu(gv))
	2174	xmldump_sub(gv);
	2175	if (GvFORM(gv))
	2176	xmldump_form(gv);
	2177	if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
	2178	&& (hv = GvHV(gv)) && hv != PL_defstash)
	2179	xmldump_packsubs(hv); /* nested package */
	2180	}
	2181	}
	2182	}
	2183
	2184	void
	2185	Perl_xmldump_sub(pTHX_ const GV *gv)
	2186	{
	2187	SV * const sv = sv_newmortal();
	2188
	2189	PERL_ARGS_ASSERT_XMLDUMP_SUB;
	2190
	2191	gv_fullname3(sv, gv, NULL);
	2192	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
	2193	if (CvXSUB(GvCV(gv)))
	2194	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
	2195	PTR2UV(CvXSUB(GvCV(gv))),
	2196	(int)CvXSUBANY(GvCV(gv)).any_i32);
	2197	else if (CvROOT(GvCV(gv)))
	2198	op_xmldump(CvROOT(GvCV(gv)));
	2199	else
	2200	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2201	}
	2202
	2203	void
	2204	Perl_xmldump_form(pTHX_ const GV *gv)
	2205	{
	2206	SV * const sv = sv_newmortal();
	2207
	2208	PERL_ARGS_ASSERT_XMLDUMP_FORM;
	2209
	2210	gv_fullname3(sv, gv, NULL);
	2211	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
	2212	if (CvROOT(GvFORM(gv)))
	2213	op_xmldump(CvROOT(GvFORM(gv)));
	2214	else
	2215	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
	2216	}
	2217
	2218	void
	2219	Perl_xmldump_eval(pTHX)
	2220	{
	2221	op_xmldump(PL_eval_root);
	2222	}
	2223
	2224	char *
	2225	Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
	2226	{
	2227	PERL_ARGS_ASSERT_SV_CATXMLSV;
	2228	return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
	2229	}
	2230
	2231	char *
	2232	Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
	2233	{
	2234	unsigned int c;
	2235	const char * const e = pv + len;
	2236	const char * const start = pv;
	2237	STRLEN dsvcur;
	2238	STRLEN cl;
	2239
	2240	PERL_ARGS_ASSERT_SV_CATXMLPVN;
	2241
	2242	sv_catpvn(dsv,"",0);
	2243	dsvcur = SvCUR(dsv); /* in case we have to restart */
	2244
	2245	retry:
	2246	while (pv < e) {
	2247	if (utf8) {
	2248	c = utf8_to_uvchr((U8*)pv, &cl);
	2249	if (cl == 0) {
	2250	SvCUR(dsv) = dsvcur;
	2251	pv = start;
	2252	utf8 = 0;
	2253	goto retry;
	2254	}
	2255	}
	2256	else
	2257	c = (*pv & 255);
	2258
	2259	switch (c) {
	2260	case 0x00:
	2261	case 0x01:
	2262	case 0x02:
	2263	case 0x03:
	2264	case 0x04:
	2265	case 0x05:
	2266	case 0x06:
	2267	case 0x07:
	2268	case 0x08:
	2269	case 0x0b:
	2270	case 0x0c:
	2271	case 0x0e:
	2272	case 0x0f:
	2273	case 0x10:
	2274	case 0x11:
	2275	case 0x12:
	2276	case 0x13:
	2277	case 0x14:
	2278	case 0x15:
	2279	case 0x16:
	2280	case 0x17:
	2281	case 0x18:
	2282	case 0x19:
	2283	case 0x1a:
	2284	case 0x1b:
	2285	case 0x1c:
	2286	case 0x1d:
	2287	case 0x1e:
	2288	case 0x1f:
	2289	case 0x7f:
	2290	case 0x80:
	2291	case 0x81:
	2292	case 0x82:
	2293	case 0x83:
	2294	case 0x84:
	2295	case 0x86:
	2296	case 0x87:
	2297	case 0x88:
	2298	case 0x89:
	2299	case 0x90:
	2300	case 0x91:
	2301	case 0x92:
	2302	case 0x93:
	2303	case 0x94:
	2304	case 0x95:
	2305	case 0x96:
	2306	case 0x97:
	2307	case 0x98:
	2308	case 0x99:
	2309	case 0x9a:
	2310	case 0x9b:
	2311	case 0x9c:
	2312	case 0x9d:
	2313	case 0x9e:
	2314	case 0x9f:
	2315	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2316	break;
	2317	case '<':
	2318	sv_catpvs(dsv, "<");
	2319	break;
	2320	case '>':
	2321	sv_catpvs(dsv, ">");
	2322	break;
	2323	case '&':
	2324	sv_catpvs(dsv, "&");
	2325	break;
	2326	case '"':
	2327	sv_catpvs(dsv, """);
	2328	break;
	2329	default:
	2330	if (c < 0xD800) {
	2331	if (c < 32 \|\| c > 127) {
	2332	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2333	}
	2334	else {
	2335	const char string = (char) c;
	2336	sv_catpvn(dsv, &string, 1);
	2337	}
	2338	break;
	2339	}
	2340	if ((c >= 0xD800 && c <= 0xDB7F) \|\|
	2341	(c >= 0xDC00 && c <= 0xDFFF) \|\|
	2342	(c >= 0xFFF0 && c <= 0xFFFF) \|\|
	2343	c > 0x10ffff)
	2344	Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
	2345	else
	2346	Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
	2347	}
	2348
	2349	if (utf8)
	2350	pv += UTF8SKIP(pv);
	2351	else
	2352	pv++;
	2353	}
	2354
	2355	return SvPVX(dsv);
	2356	}
	2357
	2358	char *
	2359	Perl_sv_xmlpeek(pTHX_ SV *sv)
	2360	{
	2361	SV * const t = sv_newmortal();
	2362	STRLEN n_a;
	2363	int unref = 0;
	2364
	2365	PERL_ARGS_ASSERT_SV_XMLPEEK;
	2366
	2367	sv_utf8_upgrade(t);
	2368	sv_setpvn(t, "", 0);
	2369	/* retry: */
	2370	if (!sv) {
	2371	sv_catpv(t, "VOID=\"\"");
	2372	goto finish;
	2373	}
	2374	else if (sv == (SV*)0x55555555 \|\| SvTYPE(sv) == 'U') {
	2375	sv_catpv(t, "WILD=\"\"");
	2376	goto finish;
	2377	}
	2378	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	2379	if (sv == &PL_sv_undef) {
	2380	sv_catpv(t, "SV_UNDEF=\"1\"");
	2381	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2382	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2383	SvREADONLY(sv))
	2384	goto finish;
	2385	}
	2386	else if (sv == &PL_sv_no) {
	2387	sv_catpv(t, "SV_NO=\"1\"");
	2388	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2389	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2390	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2391	SVp_POK\|SVp_NOK)) &&
	2392	SvCUR(sv) == 0 &&
	2393	SvNVX(sv) == 0.0)
	2394	goto finish;
	2395	}
	2396	else if (sv == &PL_sv_yes) {
	2397	sv_catpv(t, "SV_YES=\"1\"");
	2398	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	2399	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2400	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	2401	SVp_POK\|SVp_NOK)) &&
	2402	SvCUR(sv) == 1 &&
	2403	SvPVX(sv) && *SvPVX(sv) == '1' &&
	2404	SvNVX(sv) == 1.0)
	2405	goto finish;
	2406	}
	2407	else {
	2408	sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
	2409	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	2410	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	2411	SvREADONLY(sv))
	2412	goto finish;
	2413	}
	2414	sv_catpv(t, " XXX=\"\" ");
	2415	}
	2416	else if (SvREFCNT(sv) == 0) {
	2417	sv_catpv(t, " refcnt=\"0\"");
	2418	unref++;
	2419	}
	2420	else if (DEBUG_R_TEST_) {
	2421	int is_tmp = 0;
	2422	I32 ix;
	2423	/* is this SV on the tmps stack? */
	2424	for (ix=PL_tmps_ix; ix>=0; ix--) {
	2425	if (PL_tmps_stack[ix] == sv) {
	2426	is_tmp = 1;
	2427	break;
	2428	}
	2429	}
	2430	if (SvREFCNT(sv) > 1)
	2431	Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
	2432	is_tmp ? "T" : "");
	2433	else if (is_tmp)
	2434	sv_catpv(t, " DRT=\"<T>\"");
	2435	}
	2436
	2437	if (SvROK(sv)) {
	2438	sv_catpv(t, " ROK=\"\"");
	2439	}
	2440	switch (SvTYPE(sv)) {
	2441	default:
	2442	sv_catpv(t, " FREED=\"1\"");
	2443	goto finish;
	2444
	2445	case SVt_NULL:
	2446	sv_catpv(t, " UNDEF=\"1\"");
	2447	goto finish;
	2448	case SVt_IV:
	2449	sv_catpv(t, " IV=\"");
	2450	break;
	2451	case SVt_NV:
	2452	sv_catpv(t, " NV=\"");
	2453	break;
	2454	case SVt_PV:
	2455	sv_catpv(t, " PV=\"");
	2456	break;
	2457	case SVt_PVIV:
	2458	sv_catpv(t, " PVIV=\"");
	2459	break;
	2460	case SVt_PVNV:
	2461	sv_catpv(t, " PVNV=\"");
	2462	break;
	2463	case SVt_PVMG:
	2464	sv_catpv(t, " PVMG=\"");
	2465	break;
	2466	case SVt_PVLV:
	2467	sv_catpv(t, " PVLV=\"");
	2468	break;
	2469	case SVt_PVAV:
	2470	sv_catpv(t, " AV=\"");
	2471	break;
	2472	case SVt_PVHV:
	2473	sv_catpv(t, " HV=\"");
	2474	break;
	2475	case SVt_PVCV:
	2476	if (CvGV(sv))
	2477	Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
	2478	else
	2479	sv_catpv(t, " CV=\"()\"");
	2480	goto finish;
	2481	case SVt_PVGV:
	2482	sv_catpv(t, " GV=\"");
	2483	break;
	2484	case SVt_BIND:
	2485	sv_catpv(t, " BIND=\"");
	2486	break;
	2487	case SVt_REGEXP:
	2488	sv_catpv(t, " ORANGE=\"");
	2489	break;
	2490	case SVt_PVFM:
	2491	sv_catpv(t, " FM=\"");
	2492	break;
	2493	case SVt_PVIO:
	2494	sv_catpv(t, " IO=\"");
	2495	break;
	2496	}
	2497
	2498	if (SvPOKp(sv)) {
	2499	if (SvPVX(sv)) {
	2500	sv_catxmlsv(t, sv);
	2501	}
	2502	}
	2503	else if (SvNOKp(sv)) {
	2504	STORE_NUMERIC_LOCAL_SET_STANDARD();
	2505	Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
	2506	RESTORE_NUMERIC_LOCAL();
	2507	}
	2508	else if (SvIOKp(sv)) {
	2509	if (SvIsUV(sv))
	2510	Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
	2511	else
	2512	Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
	2513	}
	2514	else
	2515	sv_catpv(t, "");
	2516	sv_catpv(t, "\"");
	2517
	2518	finish:
	2519	while (unref--)
	2520	sv_catpv(t, ")");
	2521	return SvPV(t, n_a);
	2522	}
	2523
	2524	void
	2525	Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	2526	{
	2527	PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
	2528
	2529	if (!pm) {
	2530	Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
	2531	return;
	2532	}
	2533	Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
	2534	level++;
	2535	if (PM_GETRE(pm)) {
	2536	REGEXP *const r = PM_GETRE(pm);
	2537	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2538	sv_catxmlsv(tmpsv, (SV*)r);
	2539	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
	2540	SvPVX(tmpsv));
	2541	SvREFCNT_dec(tmpsv);
	2542	Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
	2543	(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
	2544	}
	2545	else
	2546	Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
	2547	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	2548	SV * const tmpsv = pm_description(pm);
	2549	Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2550	SvREFCNT_dec(tmpsv);
	2551	}
	2552
	2553	level--;
	2554	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	2555	Perl_xmldump_indent(aTHX_ level, file, ">\n");
	2556	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
	2557	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
	2558	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
	2559	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
	2560	}
	2561	else
	2562	Perl_xmldump_indent(aTHX_ level, file, "/>\n");
	2563	}
	2564
	2565	void
	2566	Perl_pmop_xmldump(pTHX_ const PMOP *pm)
	2567	{
	2568	do_pmop_xmldump(0, PL_xmlfp, pm);
	2569	}
	2570
	2571	void
	2572	Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
	2573	{
	2574	UV seq;
	2575	int contents = 0;
	2576
	2577	PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
	2578
	2579	if (!o)
	2580	return;
	2581	sequence(o);
	2582	seq = sequence_num(o);
	2583	Perl_xmldump_indent(aTHX_ level, file,
	2584	"<op_%s seq=\"%"UVuf" -> ",
	2585	OP_NAME(o),
	2586	seq);
	2587	level++;
	2588	if (o->op_next)
	2589	PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
	2590	sequence_num(o->op_next));
	2591	else
	2592	PerlIO_printf(file, "DONE\"");
	2593
	2594	if (o->op_targ) {
	2595	if (o->op_type == OP_NULL)
	2596	{
	2597	PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
	2598	if (o->op_targ == OP_NEXTSTATE)
	2599	{
	2600	if (CopLINE(cCOPo))
	2601	PerlIO_printf(file, " line=\"%"UVuf"\"",
	2602	(UV)CopLINE(cCOPo));
	2603	if (CopSTASHPV(cCOPo))
	2604	PerlIO_printf(file, " package=\"%s\"",
	2605	CopSTASHPV(cCOPo));
	2606	if (CopLABEL(cCOPo))
	2607	PerlIO_printf(file, " label=\"%s\"",
	2608	CopLABEL(cCOPo));
	2609	}
	2610	}
	2611	else
	2612	PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
	2613	}
	2614	#ifdef DUMPADDR
	2615	PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
	2616	#endif
	2617	if (o->op_flags) {
	2618	SV * const tmpsv = newSVpvn("", 0);
	2619	switch (o->op_flags & OPf_WANT) {
	2620	case OPf_WANT_VOID:
	2621	sv_catpv(tmpsv, ",VOID");
	2622	break;
	2623	case OPf_WANT_SCALAR:
	2624	sv_catpv(tmpsv, ",SCALAR");
	2625	break;
	2626	case OPf_WANT_LIST:
	2627	sv_catpv(tmpsv, ",LIST");
	2628	break;
	2629	default:
	2630	sv_catpv(tmpsv, ",UNKNOWN");
	2631	break;
	2632	}
	2633	if (o->op_flags & OPf_KIDS)
	2634	sv_catpv(tmpsv, ",KIDS");
	2635	if (o->op_flags & OPf_PARENS)
	2636	sv_catpv(tmpsv, ",PARENS");
	2637	if (o->op_flags & OPf_STACKED)
	2638	sv_catpv(tmpsv, ",STACKED");
	2639	if (o->op_flags & OPf_REF)
	2640	sv_catpv(tmpsv, ",REF");
	2641	if (o->op_flags & OPf_MOD)
	2642	sv_catpv(tmpsv, ",MOD");
	2643	if (o->op_flags & OPf_SPECIAL)
	2644	sv_catpv(tmpsv, ",SPECIAL");
	2645	PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
	2646	SvREFCNT_dec(tmpsv);
	2647	}
	2648	if (o->op_private) {
	2649	SV * const tmpsv = newSVpvn("", 0);
	2650	if (PL_opargs[o->op_type] & OA_TARGLEX) {
	2651	if (o->op_private & OPpTARGET_MY)
	2652	sv_catpv(tmpsv, ",TARGET_MY");
	2653	}
	2654	else if (o->op_type == OP_LEAVESUB \|\|
	2655	o->op_type == OP_LEAVE \|\|
	2656	o->op_type == OP_LEAVESUBLV \|\|
	2657	o->op_type == OP_LEAVEWRITE) {
	2658	if (o->op_private & OPpREFCOUNTED)
	2659	sv_catpv(tmpsv, ",REFCOUNTED");
	2660	}
	2661	else if (o->op_type == OP_AASSIGN) {
	2662	if (o->op_private & OPpASSIGN_COMMON)
	2663	sv_catpv(tmpsv, ",COMMON");
	2664	}
	2665	else if (o->op_type == OP_SASSIGN) {
	2666	if (o->op_private & OPpASSIGN_BACKWARDS)
	2667	sv_catpv(tmpsv, ",BACKWARDS");
	2668	}
	2669	else if (o->op_type == OP_TRANS) {
	2670	if (o->op_private & OPpTRANS_SQUASH)
	2671	sv_catpv(tmpsv, ",SQUASH");
	2672	if (o->op_private & OPpTRANS_DELETE)
	2673	sv_catpv(tmpsv, ",DELETE");
	2674	if (o->op_private & OPpTRANS_COMPLEMENT)
	2675	sv_catpv(tmpsv, ",COMPLEMENT");
	2676	if (o->op_private & OPpTRANS_IDENTICAL)
	2677	sv_catpv(tmpsv, ",IDENTICAL");
	2678	if (o->op_private & OPpTRANS_GROWS)
	2679	sv_catpv(tmpsv, ",GROWS");
	2680	}
	2681	else if (o->op_type == OP_REPEAT) {
	2682	if (o->op_private & OPpREPEAT_DOLIST)
	2683	sv_catpv(tmpsv, ",DOLIST");
	2684	}
	2685	else if (o->op_type == OP_ENTERSUB \|\|
	2686	o->op_type == OP_RV2SV \|\|
	2687	o->op_type == OP_GVSV \|\|
	2688	o->op_type == OP_RV2AV \|\|
	2689	o->op_type == OP_RV2HV \|\|
	2690	o->op_type == OP_RV2GV \|\|
	2691	o->op_type == OP_AELEM \|\|
	2692	o->op_type == OP_HELEM )
	2693	{
	2694	if (o->op_type == OP_ENTERSUB) {
	2695	if (o->op_private & OPpENTERSUB_AMPER)
	2696	sv_catpv(tmpsv, ",AMPER");
	2697	if (o->op_private & OPpENTERSUB_DB)
	2698	sv_catpv(tmpsv, ",DB");
	2699	if (o->op_private & OPpENTERSUB_HASTARG)
	2700	sv_catpv(tmpsv, ",HASTARG");
	2701	if (o->op_private & OPpENTERSUB_NOPAREN)
	2702	sv_catpv(tmpsv, ",NOPAREN");
	2703	if (o->op_private & OPpENTERSUB_INARGS)
	2704	sv_catpv(tmpsv, ",INARGS");
	2705	if (o->op_private & OPpENTERSUB_NOMOD)
	2706	sv_catpv(tmpsv, ",NOMOD");
	2707	}
	2708	else {
	2709	switch (o->op_private & OPpDEREF) {
	2710	case OPpDEREF_SV:
	2711	sv_catpv(tmpsv, ",SV");
	2712	break;
	2713	case OPpDEREF_AV:
	2714	sv_catpv(tmpsv, ",AV");
	2715	break;
	2716	case OPpDEREF_HV:
	2717	sv_catpv(tmpsv, ",HV");
	2718	break;
	2719	}
	2720	if (o->op_private & OPpMAYBE_LVSUB)
	2721	sv_catpv(tmpsv, ",MAYBE_LVSUB");
	2722	}
	2723	if (o->op_type == OP_AELEM \|\| o->op_type == OP_HELEM) {
	2724	if (o->op_private & OPpLVAL_DEFER)
	2725	sv_catpv(tmpsv, ",LVAL_DEFER");
	2726	}
	2727	else {
	2728	if (o->op_private & HINT_STRICT_REFS)
	2729	sv_catpv(tmpsv, ",STRICT_REFS");
	2730	if (o->op_private & OPpOUR_INTRO)
	2731	sv_catpv(tmpsv, ",OUR_INTRO");
	2732	}
	2733	}
	2734	else if (o->op_type == OP_CONST) {
	2735	if (o->op_private & OPpCONST_BARE)
	2736	sv_catpv(tmpsv, ",BARE");
	2737	if (o->op_private & OPpCONST_STRICT)
	2738	sv_catpv(tmpsv, ",STRICT");
	2739	if (o->op_private & OPpCONST_ARYBASE)
	2740	sv_catpv(tmpsv, ",ARYBASE");
	2741	if (o->op_private & OPpCONST_WARNING)
	2742	sv_catpv(tmpsv, ",WARNING");
	2743	if (o->op_private & OPpCONST_ENTERED)
	2744	sv_catpv(tmpsv, ",ENTERED");
	2745	}
	2746	else if (o->op_type == OP_FLIP) {
	2747	if (o->op_private & OPpFLIP_LINENUM)
	2748	sv_catpv(tmpsv, ",LINENUM");
	2749	}
	2750	else if (o->op_type == OP_FLOP) {
	2751	if (o->op_private & OPpFLIP_LINENUM)
	2752	sv_catpv(tmpsv, ",LINENUM");
	2753	}
	2754	else if (o->op_type == OP_RV2CV) {
	2755	if (o->op_private & OPpLVAL_INTRO)
	2756	sv_catpv(tmpsv, ",INTRO");
	2757	}
	2758	else if (o->op_type == OP_GV) {
	2759	if (o->op_private & OPpEARLY_CV)
	2760	sv_catpv(tmpsv, ",EARLY_CV");
	2761	}
	2762	else if (o->op_type == OP_LIST) {
	2763	if (o->op_private & OPpLIST_GUESSED)
	2764	sv_catpv(tmpsv, ",GUESSED");
	2765	}
	2766	else if (o->op_type == OP_DELETE) {
	2767	if (o->op_private & OPpSLICE)
	2768	sv_catpv(tmpsv, ",SLICE");
	2769	}
	2770	else if (o->op_type == OP_EXISTS) {
	2771	if (o->op_private & OPpEXISTS_SUB)
	2772	sv_catpv(tmpsv, ",EXISTS_SUB");
	2773	}
	2774	else if (o->op_type == OP_SORT) {
	2775	if (o->op_private & OPpSORT_NUMERIC)
	2776	sv_catpv(tmpsv, ",NUMERIC");
	2777	if (o->op_private & OPpSORT_INTEGER)
	2778	sv_catpv(tmpsv, ",INTEGER");
	2779	if (o->op_private & OPpSORT_REVERSE)
	2780	sv_catpv(tmpsv, ",REVERSE");
	2781	}
	2782	else if (o->op_type == OP_OPEN \|\| o->op_type == OP_BACKTICK) {
	2783	if (o->op_private & OPpOPEN_IN_RAW)
	2784	sv_catpv(tmpsv, ",IN_RAW");
	2785	if (o->op_private & OPpOPEN_IN_CRLF)
	2786	sv_catpv(tmpsv, ",IN_CRLF");
	2787	if (o->op_private & OPpOPEN_OUT_RAW)
	2788	sv_catpv(tmpsv, ",OUT_RAW");
	2789	if (o->op_private & OPpOPEN_OUT_CRLF)
	2790	sv_catpv(tmpsv, ",OUT_CRLF");
	2791	}
	2792	else if (o->op_type == OP_EXIT) {
	2793	if (o->op_private & OPpEXIT_VMSISH)
	2794	sv_catpv(tmpsv, ",EXIT_VMSISH");
	2795	if (o->op_private & OPpHUSH_VMSISH)
	2796	sv_catpv(tmpsv, ",HUSH_VMSISH");
	2797	}
	2798	else if (o->op_type == OP_DIE) {
	2799	if (o->op_private & OPpHUSH_VMSISH)
	2800	sv_catpv(tmpsv, ",HUSH_VMSISH");
	2801	}
	2802	else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
	2803	if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
	2804	sv_catpv(tmpsv, ",FT_ACCESS");
	2805	if (o->op_private & OPpFT_STACKED)
	2806	sv_catpv(tmpsv, ",FT_STACKED");
	2807	}
	2808	if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
	2809	sv_catpv(tmpsv, ",INTRO");
	2810	if (SvCUR(tmpsv))
	2811	S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
	2812	SvREFCNT_dec(tmpsv);
	2813	}
	2814
	2815	switch (o->op_type) {
	2816	case OP_AELEMFAST:
	2817	if (o->op_flags & OPf_SPECIAL) {
	2818	break;
	2819	}
	2820	case OP_GVSV:
	2821	case OP_GV:
	2822	#ifdef USE_ITHREADS
	2823	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
	2824	#else
	2825	if (cSVOPo->op_sv) {
	2826	SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
	2827	SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
	2828	char *s;
	2829	STRLEN len;
	2830	ENTER;
	2831	SAVEFREESV(tmpsv1);
	2832	SAVEFREESV(tmpsv2);
	2833	gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, NULL);
	2834	s = SvPV(tmpsv1,len);
	2835	sv_catxmlpvn(tmpsv2, s, len, 1);
	2836	S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
	2837	LEAVE;
	2838	}
	2839	else
	2840	S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
	2841	#endif
	2842	break;
	2843	case OP_CONST:
	2844	case OP_HINTSEVAL:
	2845	case OP_METHOD_NAMED:
	2846	#ifndef USE_ITHREADS
	2847	/* with ITHREADS, consts are stored in the pad, and the right pad
	2848	* may not be active here, so skip */
	2849	S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
	2850	#endif
	2851	break;
	2852	case OP_ANONCODE:
	2853	if (!contents) {
	2854	contents = 1;
	2855	PerlIO_printf(file, ">\n");
	2856	}
	2857	do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
	2858	break;
	2859	case OP_NEXTSTATE:
	2860	case OP_DBSTATE:
	2861	if (CopLINE(cCOPo))
	2862	S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
	2863	(UV)CopLINE(cCOPo));
	2864	if (CopSTASHPV(cCOPo))
	2865	S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
	2866	CopSTASHPV(cCOPo));
	2867	if (CopLABEL(cCOPo))
	2868	S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
	2869	CopLABEL(cCOPo));
	2870	break;
	2871	case OP_ENTERLOOP:
	2872	S_xmldump_attr(aTHX_ level, file, "redo=\"");
	2873	if (cLOOPo->op_redoop)
	2874	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
	2875	else
	2876	PerlIO_printf(file, "DONE\"");
	2877	S_xmldump_attr(aTHX_ level, file, "next=\"");
	2878	if (cLOOPo->op_nextop)
	2879	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
	2880	else
	2881	PerlIO_printf(file, "DONE\"");
	2882	S_xmldump_attr(aTHX_ level, file, "last=\"");
	2883	if (cLOOPo->op_lastop)
	2884	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
	2885	else
	2886	PerlIO_printf(file, "DONE\"");
	2887	break;
	2888	case OP_COND_EXPR:
	2889	case OP_RANGE:
	2890	case OP_MAPWHILE:
	2891	case OP_GREPWHILE:
	2892	case OP_OR:
	2893	case OP_AND:
	2894	S_xmldump_attr(aTHX_ level, file, "other=\"");
	2895	if (cLOGOPo->op_other)
	2896	PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
	2897	else
	2898	PerlIO_printf(file, "DONE\"");
	2899	break;
	2900	case OP_LEAVE:
	2901	case OP_LEAVEEVAL:
	2902	case OP_LEAVESUB:
	2903	case OP_LEAVESUBLV:
	2904	case OP_LEAVEWRITE:
	2905	case OP_SCOPE:
	2906	if (o->op_private & OPpREFCOUNTED)
	2907	S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
	2908	break;
	2909	default:
	2910	break;
	2911	}
	2912
	2913	if (PL_madskills && o->op_madprop) {
	2914	char prevkey = '\0';
	2915	SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
	2916	const MADPROP* mp = o->op_madprop;
	2917
	2918	if (!contents) {
	2919	contents = 1;
	2920	PerlIO_printf(file, ">\n");
	2921	}
	2922	Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
	2923	level++;
	2924	while (mp) {
	2925	char tmp = mp->mad_key;
	2926	sv_setpvn(tmpsv,"\"",1);
	2927	if (tmp)
	2928	sv_catxmlpvn(tmpsv, &tmp, 1, 0);
	2929	if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
	2930	sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
	2931	else
	2932	prevkey = tmp;
	2933	sv_catpv(tmpsv, "\"");
	2934	switch (mp->mad_type) {
	2935	case MAD_NULL:
	2936	sv_catpv(tmpsv, "NULL");
	2937	Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
	2938	break;
	2939	case MAD_PV:
	2940	sv_catpv(tmpsv, " val=\"");
	2941	sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
	2942	sv_catpv(tmpsv, "\"");
	2943	Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
	2944	break;
	2945	case MAD_SV:
	2946	sv_catpv(tmpsv, " val=\"");
	2947	sv_catxmlsv(tmpsv, (SV*)mp->mad_val);
	2948	sv_catpv(tmpsv, "\"");
	2949	Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
	2950	break;
	2951	case MAD_OP:
	2952	if ((OP*)mp->mad_val) {
	2953	Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
	2954	do_op_xmldump(level+1, file, (OP*)mp->mad_val);
	2955	Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
	2956	}
	2957	break;
	2958	default:
	2959	Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
	2960	break;
	2961	}
	2962	mp = mp->mad_next;
	2963	}
	2964	level--;
	2965	Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
	2966
	2967	SvREFCNT_dec(tmpsv);
	2968	}
	2969
	2970	switch (o->op_type) {
	2971	case OP_PUSHRE:
	2972	case OP_MATCH:
	2973	case OP_QR:
	2974	case OP_SUBST:
	2975	if (!contents) {
	2976	contents = 1;
	2977	PerlIO_printf(file, ">\n");
	2978	}
	2979	do_pmop_xmldump(level, file, cPMOPo);
	2980	break;
	2981	default:
	2982	break;
	2983	}
	2984
	2985	if (o->op_flags & OPf_KIDS) {
	2986	OP *kid;
	2987	if (!contents) {
	2988	contents = 1;
	2989	PerlIO_printf(file, ">\n");
	2990	}
	2991	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
	2992	do_op_xmldump(level, file, kid);
	2993	}
	2994
	2995	if (contents)
	2996	Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
	2997	else
	2998	PerlIO_printf(file, " />\n");
	2999	}
	3000
	3001	void
	3002	Perl_op_xmldump(pTHX_ const OP *o)
	3003	{
	3004	PERL_ARGS_ASSERT_OP_XMLDUMP;
	3005
	3006	do_op_xmldump(0, PL_xmlfp, o);
	3007	}
	3008	#endif
	3009
	3010	/*
	3011	* Local variables:
	3012	* c-indentation-style: bsd
	3013	* c-basic-offset: 4
	3014	* indent-tabs-mode: t
	3015	* End:
	3016	*
	3017	* ex: set ts=8 sts=4 sw=4 noet:
	3018	*/