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