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