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

... / ...

Commit	Line	Data
	1	/* dump.c
	2	*
	3	* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
	4	* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
	5	*
	6	* You may distribute under the terms of either the GNU General Public
	7	* License or the Artistic License, as specified in the README file.
	8	*
	9	*/
	10
	11	/*
	12	* 'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
	13	* it has not been hard for me to read your mind and memory.'
	14	*
	15	* [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
	16	*/
	17
	18	/* This file contains utility routines to dump the contents of SV and OP
	19	* structures, as used by command-line options like -Dt and -Dx, and
	20	* by Devel::Peek.
	21	*
	22	* It also holds the debugging version of the runops function.
	23
	24	=head1 Display and Dump functions
	25	*/
	26
	27	#include "EXTERN.h"
	28	#define PERL_IN_DUMP_C
	29	#include "perl.h"
	30	#include "regcomp.h"
	31
	32	static const char* const svtypenames[SVt_LAST] = {
	33	"NULL",
	34	"IV",
	35	"NV",
	36	"PV",
	37	"INVLIST",
	38	"PVIV",
	39	"PVNV",
	40	"PVMG",
	41	"REGEXP",
	42	"PVGV",
	43	"PVLV",
	44	"PVAV",
	45	"PVHV",
	46	"PVCV",
	47	"PVFM",
	48	"PVIO"
	49	};
	50
	51
	52	static const char* const svshorttypenames[SVt_LAST] = {
	53	"UNDEF",
	54	"IV",
	55	"NV",
	56	"PV",
	57	"INVLST",
	58	"PVIV",
	59	"PVNV",
	60	"PVMG",
	61	"REGEXP",
	62	"GV",
	63	"PVLV",
	64	"AV",
	65	"HV",
	66	"CV",
	67	"FM",
	68	"IO"
	69	};
	70
	71	struct flag_to_name {
	72	U32 flag;
	73	const char *name;
	74	};
	75
	76	static void
	77	S_append_flags(pTHX_ SV sv, U32 flags, const struct flag_to_name start,
	78	const struct flag_to_name *const end)
	79	{
	80	do {
	81	if (flags & start->flag)
	82	sv_catpv(sv, start->name);
	83	} while (++start < end);
	84	}
	85
	86	#define append_flags(sv, f, flags) \
	87	S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
	88
	89	#define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
	90	(len) * (4+UTF8_MAXBYTES) + 1, NULL, \
	91	PERL_PV_ESCAPE_NONASCII \| PERL_PV_ESCAPE_DWIM \
	92	\| ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
	93
	94	/*
	95	=for apidoc pv_escape
	96
	97	Escapes at most the first "count" chars of pv and puts the results into
	98	dsv such that the size of the escaped string will not exceed "max" chars
	99	and will not contain any incomplete escape sequences.
	100
	101	If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
	102	will also be escaped.
	103
	104	Normally the SV will be cleared before the escaped string is prepared,
	105	but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
	106
	107	If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
	108	if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
	109	using C<is_utf8_string()> to determine if it is Unicode.
	110
	111	If PERL_PV_ESCAPE_ALL is set then all input chars will be output
	112	using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
	113	non-ASCII chars will be escaped using this style; otherwise, only chars above
	114	255 will be so escaped; other non printable chars will use octal or
	115	common escaped patterns like C<\n>.
	116	Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
	117	then all chars below 255 will be treated as printable and
	118	will be output as literals.
	119
	120	If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
	121	string will be escaped, regardless of max. If the output is to be in hex,
	122	then it will be returned as a plain hex
	123	sequence. Thus the output will either be a single char,
	124	an octal escape sequence, a special escape like C<\n> or a hex value.
	125
	126	If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
	127	not a '\\'. This is because regexes very often contain backslashed
	128	sequences, whereas '%' is not a particularly common character in patterns.
	129
	130	Returns a pointer to the escaped text as held by dsv.
	131
	132	=cut
	133	*/
	134	#define PV_ESCAPE_OCTBUFSIZE 32
	135
	136	char *
	137	Perl_pv_escape( pTHX_ SV dsv, char const const str,
	138	const STRLEN count, const STRLEN max,
	139	STRLEN * const escaped, const U32 flags )
	140	{
	141	const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
	142	const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
	143	char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
	144	STRLEN wrote = 0; /* chars written so far */
	145	STRLEN chsize = 0; /* size of data to be written */
	146	STRLEN readsize = 1; /* size of data just read */
	147	bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
	148	const char *pv = str;
	149	const char * const end = pv + count; /* end of string */
	150	octbuf[0] = esc;
	151
	152	PERL_ARGS_ASSERT_PV_ESCAPE;
	153
	154	if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
	155	/* This won't alter the UTF-8 flag */
	156	sv_setpvs(dsv, "");
	157	}
	158
	159	if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
	160	isuni = 1;
	161
	162	for ( ; (pv < end && (!max \|\| (wrote < max))) ; pv += readsize ) {
	163	const UV u= (isuni) ? utf8_to_uvchr_buf((U8)pv, (U8) end, &readsize) : (U8)*pv;
	164	const U8 c = (U8)u & 0xFF;
	165
	166	if ( ( u > 255 )
	167	\|\| (flags & PERL_PV_ESCAPE_ALL)
	168	\|\| (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII\|PERL_PV_ESCAPE_DWIM))))
	169	{
	170	if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
	171	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	172	"%"UVxf, u);
	173	else
	174	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	175	((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
	176	? "%cx%02"UVxf
	177	: "%cx{%02"UVxf"}", esc, u);
	178
	179	} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
	180	chsize = 1;
	181	} else {
	182	if ( (c == dq) \|\| (c == esc) \|\| !isPRINT(c) ) {
	183	chsize = 2;
	184	switch (c) {
	185
	186	case '\\' : /* FALLTHROUGH */
	187	case '%' : if ( c == esc ) {
	188	octbuf[1] = esc;
	189	} else {
	190	chsize = 1;
	191	}
	192	break;
	193	case '\v' : octbuf[1] = 'v'; break;
	194	case '\t' : octbuf[1] = 't'; break;
	195	case '\r' : octbuf[1] = 'r'; break;
	196	case '\n' : octbuf[1] = 'n'; break;
	197	case '\f' : octbuf[1] = 'f'; break;
	198	case '"' :
	199	if ( dq == '"' )
	200	octbuf[1] = '"';
	201	else
	202	chsize = 1;
	203	break;
	204	default:
	205	if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
	206	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	207	isuni ? "%cx{%02"UVxf"}" : "%cx%02"UVxf,
	208	esc, u);
	209	}
	210	else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
	211	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	212	"%c%03o", esc, c);
	213	else
	214	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
	215	"%c%o", esc, c);
	216	}
	217	} else {
	218	chsize = 1;
	219	}
	220	}
	221	if ( max && (wrote + chsize > max) ) {
	222	break;
	223	} else if (chsize > 1) {
	224	sv_catpvn(dsv, octbuf, chsize);
	225	wrote += chsize;
	226	} else {
	227	/* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
	228	can be appended raw to the dsv. If dsv happens to be
	229	UTF-8 then we need catpvf to upgrade them for us.
	230	Or add a new API call sv_catpvc(). Think about that name, and
	231	how to keep it clear that it's unlike the s of catpvs, which is
	232	really an array of octets, not a string. */
	233	Perl_sv_catpvf( aTHX_ dsv, "%c", c);
	234	wrote++;
	235	}
	236	if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
	237	break;
	238	}
	239	if (escaped != NULL)
	240	*escaped= pv - str;
	241	return SvPVX(dsv);
	242	}
	243	/*
	244	=for apidoc pv_pretty
	245
	246	Converts a string into something presentable, handling escaping via
	247	pv_escape() and supporting quoting and ellipses.
	248
	249	If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
	250	double quoted with any double quotes in the string escaped. Otherwise
	251	if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
	252	angle brackets.
	253
	254	If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
	255	string were output then an ellipsis C<...> will be appended to the
	256	string. Note that this happens AFTER it has been quoted.
	257
	258	If start_color is non-null then it will be inserted after the opening
	259	quote (if there is one) but before the escaped text. If end_color
	260	is non-null then it will be inserted after the escaped text but before
	261	any quotes or ellipses.
	262
	263	Returns a pointer to the prettified text as held by dsv.
	264
	265	=cut
	266	*/
	267
	268	char *
	269	Perl_pv_pretty( pTHX_ SV dsv, char const const str, const STRLEN count,
	270	const STRLEN max, char const * const start_color, char const * const end_color,
	271	const U32 flags )
	272	{
	273	const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
	274	STRLEN escaped;
	275
	276	PERL_ARGS_ASSERT_PV_PRETTY;
	277
	278	if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
	279	/* This won't alter the UTF-8 flag */
	280	sv_setpvs(dsv, "");
	281	}
	282
	283	if ( dq == '"' )
	284	sv_catpvs(dsv, "\"");
	285	else if ( flags & PERL_PV_PRETTY_LTGT )
	286	sv_catpvs(dsv, "<");
	287
	288	if ( start_color != NULL )
	289	sv_catpv(dsv, start_color);
	290
	291	pv_escape( dsv, str, count, max, &escaped, flags \| PERL_PV_ESCAPE_NOCLEAR );
	292
	293	if ( end_color != NULL )
	294	sv_catpv(dsv, end_color);
	295
	296	if ( dq == '"' )
	297	sv_catpvs( dsv, "\"");
	298	else if ( flags & PERL_PV_PRETTY_LTGT )
	299	sv_catpvs(dsv, ">");
	300
	301	if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
	302	sv_catpvs(dsv, "...");
	303
	304	return SvPVX(dsv);
	305	}
	306
	307	/*
	308	=for apidoc pv_display
	309
	310	Similar to
	311
	312	pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
	313
	314	except that an additional "\0" will be appended to the string when
	315	len > cur and pv[cur] is "\0".
	316
	317	Note that the final string may be up to 7 chars longer than pvlim.
	318
	319	=cut
	320	*/
	321
	322	char *
	323	Perl_pv_display(pTHX_ SV dsv, const char pv, STRLEN cur, STRLEN len, STRLEN pvlim)
	324	{
	325	PERL_ARGS_ASSERT_PV_DISPLAY;
	326
	327	pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
	328	if (len > cur && pv[cur] == '\0')
	329	sv_catpvs( dsv, "\\0");
	330	return SvPVX(dsv);
	331	}
	332
	333	char *
	334	Perl_sv_peek(pTHX_ SV *sv)
	335	{
	336	dVAR;
	337	SV * const t = sv_newmortal();
	338	int unref = 0;
	339	U32 type;
	340
	341	sv_setpvs(t, "");
	342	retry:
	343	if (!sv) {
	344	sv_catpv(t, "VOID");
	345	goto finish;
	346	}
	347	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
	348	/* detect data corruption under memory poisoning */
	349	sv_catpv(t, "WILD");
	350	goto finish;
	351	}
	352	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
	353	if (sv == &PL_sv_undef) {
	354	sv_catpv(t, "SV_UNDEF");
	355	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	356	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	357	SvREADONLY(sv))
	358	goto finish;
	359	}
	360	else if (sv == &PL_sv_no) {
	361	sv_catpv(t, "SV_NO");
	362	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	363	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	364	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	365	SVp_POK\|SVp_NOK)) &&
	366	SvCUR(sv) == 0 &&
	367	SvNVX(sv) == 0.0)
	368	goto finish;
	369	}
	370	else if (sv == &PL_sv_yes) {
	371	sv_catpv(t, "SV_YES");
	372	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
	373	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	374	!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
	375	SVp_POK\|SVp_NOK)) &&
	376	SvCUR(sv) == 1 &&
	377	SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
	378	SvNVX(sv) == 1.0)
	379	goto finish;
	380	}
	381	else {
	382	sv_catpv(t, "SV_PLACEHOLDER");
	383	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
	384	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
	385	SvREADONLY(sv))
	386	goto finish;
	387	}
	388	sv_catpv(t, ":");
	389	}
	390	else if (SvREFCNT(sv) == 0) {
	391	sv_catpv(t, "(");
	392	unref++;
	393	}
	394	else if (DEBUG_R_TEST_) {
	395	int is_tmp = 0;
	396	SSize_t ix;
	397	/* is this SV on the tmps stack? */
	398	for (ix=PL_tmps_ix; ix>=0; ix--) {
	399	if (PL_tmps_stack[ix] == sv) {
	400	is_tmp = 1;
	401	break;
	402	}
	403	}
	404	if (SvREFCNT(sv) > 1)
	405	Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
	406	is_tmp ? "T" : "");
	407	else if (is_tmp)
	408	sv_catpv(t, "<T>");
	409	}
	410
	411	if (SvROK(sv)) {
	412	sv_catpv(t, "\\");
	413	if (SvCUR(t) + unref > 10) {
	414	SvCUR_set(t, unref + 3);
	415	*SvEND(t) = '\0';
	416	sv_catpv(t, "...");
	417	goto finish;
	418	}
	419	sv = SvRV(sv);
	420	goto retry;
	421	}
	422	type = SvTYPE(sv);
	423	if (type == SVt_PVCV) {
	424	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	425	GV* gvcv = CvGV(sv);
	426	Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
	427	? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
	428	: "");
	429	goto finish;
	430	} else if (type < SVt_LAST) {
	431	sv_catpv(t, svshorttypenames[type]);
	432
	433	if (type == SVt_NULL)
	434	goto finish;
	435	} else {
	436	sv_catpv(t, "FREED");
	437	goto finish;
	438	}
	439
	440	if (SvPOKp(sv)) {
	441	if (!SvPVX_const(sv))
	442	sv_catpv(t, "(null)");
	443	else {
	444	SV * const tmp = newSVpvs("");
	445	sv_catpv(t, "(");
	446	if (SvOOK(sv)) {
	447	STRLEN delta;
	448	SvOOK_offset(sv, delta);
	449	Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
	450	}
	451	Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
	452	if (SvUTF8(sv))
	453	Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
	454	sv_uni_display(tmp, sv, 6 * SvCUR(sv),
	455	UNI_DISPLAY_QQ));
	456	SvREFCNT_dec_NN(tmp);
	457	}
	458	}
	459	else if (SvNOKp(sv)) {
	460	STORE_NUMERIC_LOCAL_SET_STANDARD();
	461	Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
	462	RESTORE_NUMERIC_LOCAL();
	463	}
	464	else if (SvIOKp(sv)) {
	465	if (SvIsUV(sv))
	466	Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
	467	else
	468	Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
	469	}
	470	else
	471	sv_catpv(t, "()");
	472
	473	finish:
	474	while (unref--)
	475	sv_catpv(t, ")");
	476	if (TAINTING_get && sv && SvTAINTED(sv))
	477	sv_catpv(t, " [tainted]");
	478	return SvPV_nolen(t);
	479	}
	480
	481	/*
	482	=head1 Debugging Utilities
	483	*/
	484
	485	void
	486	Perl_dump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
	487	{
	488	va_list args;
	489	PERL_ARGS_ASSERT_DUMP_INDENT;
	490	va_start(args, pat);
	491	dump_vindent(level, file, pat, &args);
	492	va_end(args);
	493	}
	494
	495	void
	496	Perl_dump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
	497	{
	498	PERL_ARGS_ASSERT_DUMP_VINDENT;
	499	PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
	500	PerlIO_vprintf(file, pat, *args);
	501	}
	502
	503	/*
	504	=for apidoc dump_all
	505
	506	Dumps the entire optree of the current program starting at C<PL_main_root> to
	507	C<STDERR>. Also dumps the optrees for all visible subroutines in
	508	C<PL_defstash>.
	509
	510	=cut
	511	*/
	512
	513	void
	514	Perl_dump_all(pTHX)
	515	{
	516	dump_all_perl(FALSE);
	517	}
	518
	519	void
	520	Perl_dump_all_perl(pTHX_ bool justperl)
	521	{
	522	PerlIO_setlinebuf(Perl_debug_log);
	523	if (PL_main_root)
	524	op_dump(PL_main_root);
	525	dump_packsubs_perl(PL_defstash, justperl);
	526	}
	527
	528	/*
	529	=for apidoc dump_packsubs
	530
	531	Dumps the optrees for all visible subroutines in C<stash>.
	532
	533	=cut
	534	*/
	535
	536	void
	537	Perl_dump_packsubs(pTHX_ const HV *stash)
	538	{
	539	PERL_ARGS_ASSERT_DUMP_PACKSUBS;
	540	dump_packsubs_perl(stash, FALSE);
	541	}
	542
	543	void
	544	Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
	545	{
	546	I32 i;
	547
	548	PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
	549
	550	if (!HvARRAY(stash))
	551	return;
	552	for (i = 0; i <= (I32) HvMAX(stash); i++) {
	553	const HE *entry;
	554	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	555	const GV * const gv = (const GV *)HeVAL(entry);
	556	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
	557	continue;
	558	if (GvCVu(gv))
	559	dump_sub_perl(gv, justperl);
	560	if (GvFORM(gv))
	561	dump_form(gv);
	562	if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
	563	const HV * const hv = GvHV(gv);
	564	if (hv && (hv != PL_defstash))
	565	dump_packsubs_perl(hv, justperl); /* nested package */
	566	}
	567	}
	568	}
	569	}
	570
	571	void
	572	Perl_dump_sub(pTHX_ const GV *gv)
	573	{
	574	PERL_ARGS_ASSERT_DUMP_SUB;
	575	dump_sub_perl(gv, FALSE);
	576	}
	577
	578	void
	579	Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
	580	{
	581	STRLEN len;
	582	SV * const sv = newSVpvs_flags("", SVs_TEMP);
	583	SV *tmpsv;
	584	const char * name;
	585
	586	PERL_ARGS_ASSERT_DUMP_SUB_PERL;
	587
	588	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
	589	return;
	590
	591	tmpsv = newSVpvs_flags("", SVs_TEMP);
	592	gv_fullname3(sv, gv, NULL);
	593	name = SvPV_const(sv, len);
	594	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
	595	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	596	if (CvISXSUB(GvCV(gv)))
	597	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
	598	PTR2UV(CvXSUB(GvCV(gv))),
	599	(int)CvXSUBANY(GvCV(gv)).any_i32);
	600	else if (CvROOT(GvCV(gv)))
	601	op_dump(CvROOT(GvCV(gv)));
	602	else
	603	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	604	}
	605
	606	void
	607	Perl_dump_form(pTHX_ const GV *gv)
	608	{
	609	SV * const sv = sv_newmortal();
	610
	611	PERL_ARGS_ASSERT_DUMP_FORM;
	612
	613	gv_fullname3(sv, gv, NULL);
	614	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
	615	if (CvROOT(GvFORM(gv)))
	616	op_dump(CvROOT(GvFORM(gv)));
	617	else
	618	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
	619	}
	620
	621	void
	622	Perl_dump_eval(pTHX)
	623	{
	624	op_dump(PL_eval_root);
	625	}
	626
	627	void
	628	Perl_do_pmop_dump(pTHX_ I32 level, PerlIO file, const PMOP pm)
	629	{
	630	char ch;
	631
	632	PERL_ARGS_ASSERT_DO_PMOP_DUMP;
	633
	634	if (!pm) {
	635	Perl_dump_indent(aTHX_ level, file, "{}\n");
	636	return;
	637	}
	638	Perl_dump_indent(aTHX_ level, file, "{\n");
	639	level++;
	640	if (pm->op_pmflags & PMf_ONCE)
	641	ch = '?';
	642	else
	643	ch = '/';
	644	if (PM_GETRE(pm))
	645	Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
	646	ch, RX_PRECOMP(PM_GETRE(pm)), ch,
	647	(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
	648	else
	649	Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
	650	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
	651	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
	652	op_dump(pm->op_pmreplrootu.op_pmreplroot);
	653	}
	654	if (pm->op_code_list) {
	655	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
	656	Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
	657	do_op_dump(level, file, pm->op_code_list);
	658	}
	659	else
	660	Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
	661	PTR2UV(pm->op_code_list));
	662	}
	663	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
	664	SV * const tmpsv = pm_description(pm);
	665	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	666	SvREFCNT_dec_NN(tmpsv);
	667	}
	668
	669	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	670	}
	671
	672	const struct flag_to_name pmflags_flags_names[] = {
	673	{PMf_CONST, ",CONST"},
	674	{PMf_KEEP, ",KEEP"},
	675	{PMf_GLOBAL, ",GLOBAL"},
	676	{PMf_CONTINUE, ",CONTINUE"},
	677	{PMf_RETAINT, ",RETAINT"},
	678	{PMf_EVAL, ",EVAL"},
	679	{PMf_NONDESTRUCT, ",NONDESTRUCT"},
	680	{PMf_HAS_CV, ",HAS_CV"},
	681	{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
	682	{PMf_IS_QR, ",IS_QR"}
	683	};
	684
	685	static SV *
	686	S_pm_description(pTHX_ const PMOP *pm)
	687	{
	688	SV * const desc = newSVpvs("");
	689	const REGEXP * const regex = PM_GETRE(pm);
	690	const U32 pmflags = pm->op_pmflags;
	691
	692	PERL_ARGS_ASSERT_PM_DESCRIPTION;
	693
	694	if (pmflags & PMf_ONCE)
	695	sv_catpv(desc, ",ONCE");
	696	#ifdef USE_ITHREADS
	697	if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
	698	sv_catpv(desc, ":USED");
	699	#else
	700	if (pmflags & PMf_USED)
	701	sv_catpv(desc, ":USED");
	702	#endif
	703
	704	if (regex) {
	705	if (RX_ISTAINTED(regex))
	706	sv_catpv(desc, ",TAINTED");
	707	if (RX_CHECK_SUBSTR(regex)) {
	708	if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
	709	sv_catpv(desc, ",SCANFIRST");
	710	if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
	711	sv_catpv(desc, ",ALL");
	712	}
	713	if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
	714	sv_catpv(desc, ",SKIPWHITE");
	715	}
	716
	717	append_flags(desc, pmflags, pmflags_flags_names);
	718	return desc;
	719	}
	720
	721	void
	722	Perl_pmop_dump(pTHX_ PMOP *pm)
	723	{
	724	do_pmop_dump(0, Perl_debug_log, pm);
	725	}
	726
	727	/* Return a unique integer to represent the address of op o.
	728	* If it already exists in PL_op_sequence, just return it;
	729	* otherwise add it.
	730	* *** Note that this isn't thread-safe */
	731
	732	STATIC UV
	733	S_sequence_num(pTHX_ const OP *o)
	734	{
	735	dVAR;
	736	SV *op,
	737	**seq;
	738	const char *key;
	739	STRLEN len;
	740	if (!o)
	741	return 0;
	742	op = newSVuv(PTR2UV(o));
	743	sv_2mortal(op);
	744	key = SvPV_const(op, len);
	745	if (!PL_op_sequence)
	746	PL_op_sequence = newHV();
	747	seq = hv_fetch(PL_op_sequence, key, len, 0);
	748	if (seq)
	749	return SvUV(*seq);
	750	(void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
	751	return PL_op_seq;
	752	}
	753
	754
	755
	756
	757
	758	const struct flag_to_name op_flags_names[] = {
	759	{OPf_KIDS, ",KIDS"},
	760	{OPf_PARENS, ",PARENS"},
	761	{OPf_REF, ",REF"},
	762	{OPf_MOD, ",MOD"},
	763	{OPf_STACKED, ",STACKED"},
	764	{OPf_SPECIAL, ",SPECIAL"}
	765	};
	766
	767
	768	void
	769	Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
	770	{
	771	UV seq;
	772	const OPCODE optype = o->op_type;
	773
	774	PERL_ARGS_ASSERT_DO_OP_DUMP;
	775
	776	Perl_dump_indent(aTHX_ level, file, "{\n");
	777	level++;
	778	seq = sequence_num(o);
	779	if (seq)
	780	PerlIO_printf(file, "%-4"UVuf, seq);
	781	else
	782	PerlIO_printf(file, "????");
	783	PerlIO_printf(file,
	784	"%*sTYPE = %s ===> ",
	785	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
	786	if (o->op_next)
	787	PerlIO_printf(file,
	788	o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
	789	sequence_num(o->op_next));
	790	else
	791	PerlIO_printf(file, "NULL\n");
	792	if (o->op_targ) {
	793	if (optype == OP_NULL) {
	794	Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
	795	if (o->op_targ == OP_NEXTSTATE) {
	796	if (CopLINE(cCOPo))
	797	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	798	(UV)CopLINE(cCOPo));
	799	if (CopSTASHPV(cCOPo)) {
	800	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	801	HV *stash = CopSTASH(cCOPo);
	802	const char * const hvname = HvNAME_get(stash);
	803
	804	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	805	generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
	806	}
	807	if (CopLABEL(cCOPo)) {
	808	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	809	STRLEN label_len;
	810	U32 label_flags;
	811	const char *label = CopLABEL_len_flags(cCOPo,
	812	&label_len,
	813	&label_flags);
	814	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	815	generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
	816	}
	817
	818	}
	819	}
	820	else
	821	Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
	822	}
	823	#ifdef DUMPADDR
	824	Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
	825	#endif
	826
	827	if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) {
	828	SV * const tmpsv = newSVpvs("");
	829	switch (o->op_flags & OPf_WANT) {
	830	case OPf_WANT_VOID:
	831	sv_catpv(tmpsv, ",VOID");
	832	break;
	833	case OPf_WANT_SCALAR:
	834	sv_catpv(tmpsv, ",SCALAR");
	835	break;
	836	case OPf_WANT_LIST:
	837	sv_catpv(tmpsv, ",LIST");
	838	break;
	839	default:
	840	sv_catpv(tmpsv, ",UNKNOWN");
	841	break;
	842	}
	843	append_flags(tmpsv, o->op_flags, op_flags_names);
	844	if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED");
	845	if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
	846	if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
	847	if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
	848	if (o->op_lastsib) sv_catpvs(tmpsv, ",LASTSIB");
	849	Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
	850	SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
	851	}
	852
	853	if (o->op_private) {
	854	U16 oppriv = o->op_private;
	855	I16 op_ix = PL_op_private_bitdef_ix[o->op_type];
	856	SV * tmpsv = NULL;
	857
	858	if (op_ix != -1) {
	859	U16 stop = 0;
	860	tmpsv = newSVpvs("");
	861	for (; !stop; op_ix++) {
	862	U16 entry = PL_op_private_bitdefs[op_ix];
	863	U16 bit = (entry >> 2) & 7;
	864	U16 ix = entry >> 5;
	865
	866	stop = (entry & 1);
	867
	868	if (entry & 2) {
	869	/* bitfield */
	870	I16 const *p = &PL_op_private_bitfields[ix];
	871	U16 bitmin = (U16) *p++;
	872	I16 label = *p++;
	873	I16 enum_label;
	874	U16 mask = 0;
	875	U16 i;
	876	U16 val;
	877
	878	for (i = bitmin; i<= bit; i++)
	879	mask \|= (1<<i);
	880	bit = bitmin;
	881	val = (oppriv & mask);
	882
	883	if ( label != -1
	884	&& PL_op_private_labels[label] == '-'
	885	&& PL_op_private_labels[label+1] == '\0'
	886	)
	887	/* display as raw number */
	888	continue;
	889
	890	oppriv -= val;
	891	val >>= bit;
	892	enum_label = -1;
	893	while (*p != -1) {
	894	if (val == *p++) {
	895	enum_label = *p;
	896	break;
	897	}
	898	p++;
	899	}
	900	if (val == 0 && enum_label == -1)
	901	/* don't display anonymous zero values */
	902	continue;
	903
	904	sv_catpv(tmpsv, ",");
	905	if (label != -1) {
	906	sv_catpv(tmpsv, &PL_op_private_labels[label]);
	907	sv_catpv(tmpsv, "=");
	908	}
	909	sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
	910
	911	}
	912	else {
	913	/* bit flag */
	914	if ( oppriv & (1<<bit)
	915	&& !(PL_op_private_labels[ix] == '-'
	916	&& PL_op_private_labels[ix+1] == '\0'))
	917	{
	918	oppriv -= (1<<bit);
	919	sv_catpv(tmpsv, ",");
	920	sv_catpv(tmpsv, &PL_op_private_labels[ix]);
	921	}
	922	}
	923	}
	924	if (oppriv) {
	925	sv_catpv(tmpsv, ",");
	926	Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)oppriv);
	927	}
	928	}
	929	if (tmpsv && SvCUR(tmpsv)) {
	930	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
	931	} else
	932	Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
	933	(UV)oppriv);
	934	}
	935
	936	switch (optype) {
	937	case OP_AELEMFAST:
	938	case OP_GVSV:
	939	case OP_GV:
	940	#ifdef USE_ITHREADS
	941	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
	942	#else
	943	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
	944	if (cSVOPo->op_sv) {
	945	STRLEN len;
	946	const char * name;
	947	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	948	SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
	949	gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
	950	name = SvPV_const(tmpsv, len);
	951	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
	952	generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
	953	}
	954	else
	955	Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
	956	}
	957	#endif
	958	break;
	959	case OP_CONST:
	960	case OP_HINTSEVAL:
	961	case OP_METHOD_NAMED:
	962	#ifndef USE_ITHREADS
	963	/* with ITHREADS, consts are stored in the pad, and the right pad
	964	* may not be active here, so skip */
	965	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
	966	#endif
	967	break;
	968	case OP_NEXTSTATE:
	969	case OP_DBSTATE:
	970	if (CopLINE(cCOPo))
	971	Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
	972	(UV)CopLINE(cCOPo));
	973	if (CopSTASHPV(cCOPo)) {
	974	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	975	HV *stash = CopSTASH(cCOPo);
	976	const char * const hvname = HvNAME_get(stash);
	977
	978	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
	979	generic_pv_escape(tmpsv, hvname,
	980	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	981	}
	982	if (CopLABEL(cCOPo)) {
	983	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	984	STRLEN label_len;
	985	U32 label_flags;
	986	const char *label = CopLABEL_len_flags(cCOPo,
	987	&label_len, &label_flags);
	988	Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
	989	generic_pv_escape( tmpsv, label, label_len,
	990	(label_flags & SVf_UTF8)));
	991	}
	992	break;
	993	case OP_ENTERLOOP:
	994	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
	995	if (cLOOPo->op_redoop)
	996	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
	997	else
	998	PerlIO_printf(file, "DONE\n");
	999	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
	1000	if (cLOOPo->op_nextop)
	1001	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
	1002	else
	1003	PerlIO_printf(file, "DONE\n");
	1004	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
	1005	if (cLOOPo->op_lastop)
	1006	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
	1007	else
	1008	PerlIO_printf(file, "DONE\n");
	1009	break;
	1010	case OP_COND_EXPR:
	1011	case OP_RANGE:
	1012	case OP_MAPWHILE:
	1013	case OP_GREPWHILE:
	1014	case OP_OR:
	1015	case OP_AND:
	1016	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
	1017	if (cLOGOPo->op_other)
	1018	PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
	1019	else
	1020	PerlIO_printf(file, "DONE\n");
	1021	break;
	1022	case OP_PUSHRE:
	1023	case OP_MATCH:
	1024	case OP_QR:
	1025	case OP_SUBST:
	1026	do_pmop_dump(level, file, cPMOPo);
	1027	break;
	1028	case OP_LEAVE:
	1029	case OP_LEAVEEVAL:
	1030	case OP_LEAVESUB:
	1031	case OP_LEAVESUBLV:
	1032	case OP_LEAVEWRITE:
	1033	case OP_SCOPE:
	1034	if (o->op_private & OPpREFCOUNTED)
	1035	Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
	1036	break;
	1037	default:
	1038	break;
	1039	}
	1040	if (o->op_flags & OPf_KIDS) {
	1041	OP *kid;
	1042	for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
	1043	do_op_dump(level, file, kid);
	1044	}
	1045	Perl_dump_indent(aTHX_ level-1, file, "}\n");
	1046	}
	1047
	1048	/*
	1049	=for apidoc op_dump
	1050
	1051	Dumps the optree starting at OP C<o> to C<STDERR>.
	1052
	1053	=cut
	1054	*/
	1055
	1056	void
	1057	Perl_op_dump(pTHX_ const OP *o)
	1058	{
	1059	PERL_ARGS_ASSERT_OP_DUMP;
	1060	do_op_dump(0, Perl_debug_log, o);
	1061	}
	1062
	1063	void
	1064	Perl_gv_dump(pTHX_ GV *gv)
	1065	{
	1066	STRLEN len;
	1067	const char* name;
	1068	SV sv, tmp = newSVpvs_flags("", SVs_TEMP);
	1069
	1070
	1071	PERL_ARGS_ASSERT_GV_DUMP;
	1072
	1073	if (!gv) {
	1074	PerlIO_printf(Perl_debug_log, "{}\n");
	1075	return;
	1076	}
	1077	sv = sv_newmortal();
	1078	PerlIO_printf(Perl_debug_log, "{\n");
	1079	gv_fullname3(sv, gv, NULL);
	1080	name = SvPV_const(sv, len);
	1081	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
	1082	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1083	if (gv != GvEGV(gv)) {
	1084	gv_efullname3(sv, GvEGV(gv), NULL);
	1085	name = SvPV_const(sv, len);
	1086	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
	1087	generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
	1088	}
	1089	PerlIO_putc(Perl_debug_log, '\n');
	1090	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
	1091	}
	1092
	1093
	1094	/* map magic types to the symbolic names
	1095	* (with the PERL_MAGIC_ prefixed stripped)
	1096	*/
	1097
	1098	static const struct { const char type; const char *name; } magic_names[] = {
	1099	#include "mg_names.c"
	1100	/* this null string terminates the list */
	1101	{ 0, NULL },
	1102	};
	1103
	1104	void
	1105	Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1106	{
	1107	PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
	1108
	1109	for (; mg; mg = mg->mg_moremagic) {
	1110	Perl_dump_indent(aTHX_ level, file,
	1111	" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
	1112	if (mg->mg_virtual) {
	1113	const MGVTBL * const v = mg->mg_virtual;
	1114	if (v >= PL_magic_vtables
	1115	&& v < PL_magic_vtables + magic_vtable_max) {
	1116	const U32 i = v - PL_magic_vtables;
	1117	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
	1118	}
	1119	else
	1120	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
	1121	}
	1122	else
	1123	Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
	1124
	1125	if (mg->mg_private)
	1126	Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
	1127
	1128	{
	1129	int n;
	1130	const char *name = NULL;
	1131	for (n = 0; magic_names[n].name; n++) {
	1132	if (mg->mg_type == magic_names[n].type) {
	1133	name = magic_names[n].name;
	1134	break;
	1135	}
	1136	}
	1137	if (name)
	1138	Perl_dump_indent(aTHX_ level, file,
	1139	" MG_TYPE = PERL_MAGIC_%s\n", name);
	1140	else
	1141	Perl_dump_indent(aTHX_ level, file,
	1142	" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
	1143	}
	1144
	1145	if (mg->mg_flags) {
	1146	Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
	1147	if (mg->mg_type == PERL_MAGIC_envelem &&
	1148	mg->mg_flags & MGf_TAINTEDDIR)
	1149	Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
	1150	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1151	mg->mg_flags & MGf_MINMATCH)
	1152	Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
	1153	if (mg->mg_flags & MGf_REFCOUNTED)
	1154	Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
	1155	if (mg->mg_flags & MGf_GSKIP)
	1156	Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
	1157	if (mg->mg_flags & MGf_COPY)
	1158	Perl_dump_indent(aTHX_ level, file, " COPY\n");
	1159	if (mg->mg_flags & MGf_DUP)
	1160	Perl_dump_indent(aTHX_ level, file, " DUP\n");
	1161	if (mg->mg_flags & MGf_LOCAL)
	1162	Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
	1163	if (mg->mg_type == PERL_MAGIC_regex_global &&
	1164	mg->mg_flags & MGf_BYTES)
	1165	Perl_dump_indent(aTHX_ level, file, " BYTES\n");
	1166	}
	1167	if (mg->mg_obj) {
	1168	Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
	1169	PTR2UV(mg->mg_obj));
	1170	if (mg->mg_type == PERL_MAGIC_qr) {
	1171	REGEXP* const re = (REGEXP *)mg->mg_obj;
	1172	SV * const dsv = sv_newmortal();
	1173	const char * const s
	1174	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
	1175	60, NULL, NULL,
	1176	( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
	1177	(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
	1178	);
	1179	Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
	1180	Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
	1181	(IV)RX_REFCNT(re));
	1182	}
	1183	if (mg->mg_flags & MGf_REFCOUNTED)
	1184	do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
	1185	}
	1186	if (mg->mg_len)
	1187	Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
	1188	if (mg->mg_ptr) {
	1189	Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
	1190	if (mg->mg_len >= 0) {
	1191	if (mg->mg_type != PERL_MAGIC_utf8) {
	1192	SV * const sv = newSVpvs("");
	1193	PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
	1194	SvREFCNT_dec_NN(sv);
	1195	}
	1196	}
	1197	else if (mg->mg_len == HEf_SVKEY) {
	1198	PerlIO_puts(file, " => HEf_SVKEY\n");
	1199	do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
	1200	maxnest, dumpops, pvlim); /* MG is already +1 */
	1201	continue;
	1202	}
	1203	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
	1204	else
	1205	PerlIO_puts(
	1206	file,
	1207	" ???? - " __FILE__
	1208	" does not know how to handle this MG_LEN"
	1209	);
	1210	PerlIO_putc(file, '\n');
	1211	}
	1212	if (mg->mg_type == PERL_MAGIC_utf8) {
	1213	const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
	1214	if (cache) {
	1215	IV i;
	1216	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
	1217	Perl_dump_indent(aTHX_ level, file,
	1218	" %2"IVdf": %"UVuf" -> %"UVuf"\n",
	1219	i,
	1220	(UV)cache[i * 2],
	1221	(UV)cache[i * 2 + 1]);
	1222	}
	1223	}
	1224	}
	1225	}
	1226
	1227	void
	1228	Perl_magic_dump(pTHX_ const MAGIC *mg)
	1229	{
	1230	do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
	1231	}
	1232
	1233	void
	1234	Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
	1235	{
	1236	const char *hvname;
	1237
	1238	PERL_ARGS_ASSERT_DO_HV_DUMP;
	1239
	1240	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1241	if (sv && (hvname = HvNAME_get(sv)))
	1242	{
	1243	/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
	1244	name which quite legally could contain insane things like tabs, newlines, nulls or
	1245	other scary crap - this should produce sane results - except maybe for unicode package
	1246	names - but we will wait for someone to file a bug on that - demerphq */
	1247	SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
	1248	PerlIO_printf(file, "\t\"%s\"\n",
	1249	generic_pv_escape( tmpsv, hvname,
	1250	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1251	}
	1252	else
	1253	PerlIO_putc(file, '\n');
	1254	}
	1255
	1256	void
	1257	Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1258	{
	1259	PERL_ARGS_ASSERT_DO_GV_DUMP;
	1260
	1261	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1262	if (sv && GvNAME(sv)) {
	1263	SV * const tmpsv = newSVpvs("");
	1264	PerlIO_printf(file, "\t\"%s\"\n",
	1265	generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
	1266	}
	1267	else
	1268	PerlIO_putc(file, '\n');
	1269	}
	1270
	1271	void
	1272	Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
	1273	{
	1274	PERL_ARGS_ASSERT_DO_GVGV_DUMP;
	1275
	1276	Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
	1277	if (sv && GvNAME(sv)) {
	1278	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1279	const char *hvname;
	1280	HV * const stash = GvSTASH(sv);
	1281	PerlIO_printf(file, "\t");
	1282	/* TODO might have an extra \" here */
	1283	if (stash && (hvname = HvNAME_get(stash))) {
	1284	PerlIO_printf(file, "\"%s\" :: \"",
	1285	generic_pv_escape(tmp, hvname,
	1286	HvNAMELEN(stash), HvNAMEUTF8(stash)));
	1287	}
	1288	PerlIO_printf(file, "%s\"\n",
	1289	generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
	1290	}
	1291	else
	1292	PerlIO_putc(file, '\n');
	1293	}
	1294
	1295	const struct flag_to_name first_sv_flags_names[] = {
	1296	{SVs_TEMP, "TEMP,"},
	1297	{SVs_OBJECT, "OBJECT,"},
	1298	{SVs_GMG, "GMG,"},
	1299	{SVs_SMG, "SMG,"},
	1300	{SVs_RMG, "RMG,"},
	1301	{SVf_IOK, "IOK,"},
	1302	{SVf_NOK, "NOK,"},
	1303	{SVf_POK, "POK,"}
	1304	};
	1305
	1306	const struct flag_to_name second_sv_flags_names[] = {
	1307	{SVf_OOK, "OOK,"},
	1308	{SVf_FAKE, "FAKE,"},
	1309	{SVf_READONLY, "READONLY,"},
	1310	{SVf_PROTECT, "PROTECT,"},
	1311	{SVf_BREAK, "BREAK,"},
	1312	{SVp_IOK, "pIOK,"},
	1313	{SVp_NOK, "pNOK,"},
	1314	{SVp_POK, "pPOK,"}
	1315	};
	1316
	1317	const struct flag_to_name cv_flags_names[] = {
	1318	{CVf_ANON, "ANON,"},
	1319	{CVf_UNIQUE, "UNIQUE,"},
	1320	{CVf_CLONE, "CLONE,"},
	1321	{CVf_CLONED, "CLONED,"},
	1322	{CVf_CONST, "CONST,"},
	1323	{CVf_NODEBUG, "NODEBUG,"},
	1324	{CVf_LVALUE, "LVALUE,"},
	1325	{CVf_METHOD, "METHOD,"},
	1326	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1327	{CVf_CVGV_RC, "CVGV_RC,"},
	1328	{CVf_DYNFILE, "DYNFILE,"},
	1329	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1330	{CVf_HASEVAL, "HASEVAL,"},
	1331	{CVf_SLABBED, "SLABBED,"},
	1332	{CVf_NAMED, "NAMED,"},
	1333	{CVf_LEXICAL, "LEXICAL,"},
	1334	{CVf_ISXSUB, "ISXSUB,"}
	1335	};
	1336
	1337	const struct flag_to_name hv_flags_names[] = {
	1338	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1339	{SVphv_LAZYDEL, "LAZYDEL,"},
	1340	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	1341	{SVf_AMAGIC, "OVERLOAD,"},
	1342	{SVphv_CLONEABLE, "CLONEABLE,"}
	1343	};
	1344
	1345	const struct flag_to_name gp_flags_names[] = {
	1346	{GVf_INTRO, "INTRO,"},
	1347	{GVf_MULTI, "MULTI,"},
	1348	{GVf_ASSUMECV, "ASSUMECV,"},
	1349	};
	1350
	1351	const struct flag_to_name gp_flags_imported_names[] = {
	1352	{GVf_IMPORTED_SV, " SV"},
	1353	{GVf_IMPORTED_AV, " AV"},
	1354	{GVf_IMPORTED_HV, " HV"},
	1355	{GVf_IMPORTED_CV, " CV"},
	1356	};
	1357
	1358	/* NOTE: this structure is mostly duplicative of one generated by
	1359	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1360	* the two. - Yves */
	1361	const struct flag_to_name regexp_extflags_names[] = {
	1362	{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
	1363	{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
	1364	{RXf_PMf_FOLD, "PMf_FOLD,"},
	1365	{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
	1366	{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
	1367	{RXf_IS_ANCHORED, "IS_ANCHORED,"},
	1368	{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
	1369	{RXf_EVAL_SEEN, "EVAL_SEEN,"},
	1370	{RXf_CHECK_ALL, "CHECK_ALL,"},
	1371	{RXf_MATCH_UTF8, "MATCH_UTF8,"},
	1372	{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
	1373	{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
	1374	{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
	1375	{RXf_SPLIT, "SPLIT,"},
	1376	{RXf_COPY_DONE, "COPY_DONE,"},
	1377	{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
	1378	{RXf_TAINTED, "TAINTED,"},
	1379	{RXf_START_ONLY, "START_ONLY,"},
	1380	{RXf_SKIPWHITE, "SKIPWHITE,"},
	1381	{RXf_WHITE, "WHITE,"},
	1382	{RXf_NULL, "NULL,"},
	1383	};
	1384
	1385	/* NOTE: this structure is mostly duplicative of one generated by
	1386	* 'make regen' in regnodes.h - perhaps we should somehow integrate
	1387	* the two. - Yves */
	1388	const struct flag_to_name regexp_core_intflags_names[] = {
	1389	{PREGf_SKIP, "SKIP,"},
	1390	{PREGf_IMPLICIT, "IMPLICIT,"},
	1391	{PREGf_NAUGHTY, "NAUGHTY,"},
	1392	{PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
	1393	{PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
	1394	{PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
	1395	{PREGf_NOSCAN, "NOSCAN,"},
	1396	{PREGf_CANY_SEEN, "CANY_SEEN,"},
	1397	{PREGf_GPOS_SEEN, "GPOS_SEEN,"},
	1398	{PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
	1399	{PREGf_ANCH_MBOL, "ANCH_MBOL,"},
	1400	{PREGf_ANCH_SBOL, "ANCH_SBOL,"},
	1401	{PREGf_ANCH_GPOS, "ANCH_GPOS,"},
	1402	};
	1403
	1404	void
	1405	Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
	1406	{
	1407	SV *d;
	1408	const char *s;
	1409	U32 flags;
	1410	U32 type;
	1411
	1412	PERL_ARGS_ASSERT_DO_SV_DUMP;
	1413
	1414	if (!sv) {
	1415	Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
	1416	return;
	1417	}
	1418
	1419	flags = SvFLAGS(sv);
	1420	type = SvTYPE(sv);
	1421
	1422	/* process general SV flags */
	1423
	1424	d = Perl_newSVpvf(aTHX_
	1425	"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
	1426	PTR2UV(SvANY(sv)), PTR2UV(sv),
	1427	(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
	1428	(int)(PL_dumpindent*level), "");
	1429
	1430	if (!((flags & SVpad_NAME) == SVpad_NAME
	1431	&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
	1432	if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
	1433	sv_catpv(d, "PADSTALE,");
	1434	}
	1435	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
	1436	if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
	1437	sv_catpv(d, "PADTMP,");
	1438	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
	1439	}
	1440	append_flags(d, flags, first_sv_flags_names);
	1441	if (flags & SVf_ROK) {
	1442	sv_catpv(d, "ROK,");
	1443	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
	1444	}
	1445	if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
	1446	append_flags(d, flags, second_sv_flags_names);
	1447	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1448	&& type != SVt_PVAV) {
	1449	if (SvPCS_IMPORTED(sv))
	1450	sv_catpv(d, "PCS_IMPORTED,");
	1451	else
	1452	sv_catpv(d, "SCREAM,");
	1453	}
	1454
	1455	/* process type-specific SV flags */
	1456
	1457	switch (type) {
	1458	case SVt_PVCV:
	1459	case SVt_PVFM:
	1460	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1461	break;
	1462	case SVt_PVHV:
	1463	append_flags(d, flags, hv_flags_names);
	1464	break;
	1465	case SVt_PVGV:
	1466	case SVt_PVLV:
	1467	if (isGV_with_GP(sv)) {
	1468	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1469	}
	1470	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1471	sv_catpv(d, "IMPORT");
	1472	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1473	sv_catpv(d, "ALL,");
	1474	else {
	1475	sv_catpv(d, "(");
	1476	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1477	sv_catpv(d, " ),");
	1478	}
	1479	}
	1480	/* FALLTHROUGH */
	1481	default:
	1482	evaled_or_uv:
	1483	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1484	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1485	break;
	1486	case SVt_PVMG:
	1487	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1488	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1489	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1490	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1491	/* FALLTHROUGH */
	1492	case SVt_PVNV:
	1493	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1494	goto evaled_or_uv;
	1495	case SVt_PVAV:
	1496	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
	1497	break;
	1498	}
	1499	/* SVphv_SHAREKEYS is also 0x20000000 */
	1500	if ((type != SVt_PVHV) && SvUTF8(sv))
	1501	sv_catpv(d, "UTF8");
	1502
	1503	if (*(SvEND(d) - 1) == ',') {
	1504	SvCUR_set(d, SvCUR(d) - 1);
	1505	SvPVX(d)[SvCUR(d)] = '\0';
	1506	}
	1507	sv_catpv(d, ")");
	1508	s = SvPVX_const(d);
	1509
	1510	/* dump initial SV details */
	1511
	1512	#ifdef DEBUG_LEAKING_SCALARS
	1513	Perl_dump_indent(aTHX_ level, file,
	1514	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1515	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1516	sv->sv_debug_line,
	1517	sv->sv_debug_inpad ? "for" : "by",
	1518	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1519	PTR2UV(sv->sv_debug_parent),
	1520	sv->sv_debug_serial
	1521	);
	1522	#endif
	1523	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1524
	1525	/* Dump SV type */
	1526
	1527	if (type < SVt_LAST) {
	1528	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1529
	1530	if (type == SVt_NULL) {
	1531	SvREFCNT_dec_NN(d);
	1532	return;
	1533	}
	1534	} else {
	1535	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1536	SvREFCNT_dec_NN(d);
	1537	return;
	1538	}
	1539
	1540	/* Dump general SV fields */
	1541
	1542	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1543	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1544	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1545	\|\| (type == SVt_IV && !SvROK(sv))) {
	1546	if (SvIsUV(sv)
	1547	#ifdef PERL_OLD_COPY_ON_WRITE
	1548	\|\| SvIsCOW(sv)
	1549	#endif
	1550	)
	1551	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1552	else
	1553	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1554	#ifdef PERL_OLD_COPY_ON_WRITE
	1555	if (SvIsCOW_shared_hash(sv))
	1556	PerlIO_printf(file, " (HASH)");
	1557	else if (SvIsCOW_normal(sv))
	1558	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1559	#endif
	1560	PerlIO_putc(file, '\n');
	1561	}
	1562
	1563	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1564	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1565	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1566	(UV) COP_SEQ_RANGE_LOW(sv));
	1567	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1568	(UV) COP_SEQ_RANGE_HIGH(sv));
	1569	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1570	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1571	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1572	\|\| type == SVt_NV) {
	1573	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1574	Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
	1575	RESTORE_NUMERIC_LOCAL();
	1576	}
	1577
	1578	if (SvROK(sv)) {
	1579	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1580	if (nest < maxnest)
	1581	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1582	}
	1583
	1584	if (type < SVt_PV) {
	1585	SvREFCNT_dec_NN(d);
	1586	return;
	1587	}
	1588
	1589	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1590	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1591	const bool re = isREGEXP(sv);
	1592	const char * const ptr =
	1593	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1594	if (ptr) {
	1595	STRLEN delta;
	1596	if (SvOOK(sv)) {
	1597	SvOOK_offset(sv, delta);
	1598	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1599	(UV) delta);
	1600	} else {
	1601	delta = 0;
	1602	}
	1603	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1604	if (SvOOK(sv)) {
	1605	PerlIO_printf(file, "( %s . ) ",
	1606	pv_display(d, ptr - delta, delta, 0,
	1607	pvlim));
	1608	}
	1609	if (type == SVt_INVLIST) {
	1610	PerlIO_printf(file, "\n");
	1611	/* 4 blanks indents 2 beyond the PV, etc */
	1612	_invlist_dump(file, level, " ", sv);
	1613	}
	1614	else {
	1615	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1616	re ? 0 : SvLEN(sv),
	1617	pvlim));
	1618	if (SvUTF8(sv)) /* the 6? \x{....} */
	1619	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1620	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1621	UNI_DISPLAY_QQ));
	1622	PerlIO_printf(file, "\n");
	1623	}
	1624	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1625	if (!re)
	1626	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1627	(IV)SvLEN(sv));
	1628	#ifdef PERL_NEW_COPY_ON_WRITE
	1629	if (SvIsCOW(sv) && SvLEN(sv))
	1630	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1631	CowREFCNT(sv));
	1632	#endif
	1633	}
	1634	else
	1635	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1636	}
	1637
	1638	if (type >= SVt_PVMG) {
	1639	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1640	HV * const ost = SvOURSTASH(sv);
	1641	if (ost)
	1642	do_hv_dump(level, file, " OURSTASH", ost);
	1643	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
	1644	Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
	1645	(UV)PadnamelistMAXNAMED(sv));
	1646	} else {
	1647	if (SvMAGIC(sv))
	1648	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1649	}
	1650	if (SvSTASH(sv))
	1651	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1652
	1653	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1654	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1655	}
	1656	}
	1657
	1658	/* Dump type-specific SV fields */
	1659
	1660	switch (type) {
	1661	case SVt_PVAV:
	1662	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1663	if (AvARRAY(sv) != AvALLOC(sv)) {
	1664	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1665	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1666	}
	1667	else
	1668	PerlIO_putc(file, '\n');
	1669	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1670	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1671	/* arylen is stored in magic, and padnamelists use SvMAGIC for
	1672	something else. */
	1673	if (!AvPAD_NAMELIST(sv))
	1674	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1675	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1676	sv_setpvs(d, "");
	1677	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1678	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1679	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1680	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1681	if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
	1682	SSize_t count;
	1683	for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1684	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1685
	1686	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1687	if (elt)
	1688	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1689	}
	1690	}
	1691	break;
	1692	case SVt_PVHV: {
	1693	U32 usedkeys;
	1694	if (SvOOK(sv)) {
	1695	struct xpvhv_aux *const aux = HvAUX(sv);
	1696	Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
	1697	(UV)aux->xhv_aux_flags);
	1698	}
	1699	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1700	usedkeys = HvUSEDKEYS(sv);
	1701	if (HvARRAY(sv) && usedkeys) {
	1702	/* Show distribution of HEs in the ARRAY */
	1703	int freq[200];
	1704	#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
	1705	int i;
	1706	int max = 0;
	1707	U32 pow2 = 2, keys = usedkeys;
	1708	NV theoret, sum = 0;
	1709
	1710	PerlIO_printf(file, " (");
	1711	Zero(freq, FREQ_MAX + 1, int);
	1712	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1713	HE* h;
	1714	int count = 0;
	1715	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1716	count++;
	1717	if (count > FREQ_MAX)
	1718	count = FREQ_MAX;
	1719	freq[count]++;
	1720	if (max < count)
	1721	max = count;
	1722	}
	1723	for (i = 0; i <= max; i++) {
	1724	if (freq[i]) {
	1725	PerlIO_printf(file, "%d%s:%d", i,
	1726	(i == FREQ_MAX) ? "+" : "",
	1727	freq[i]);
	1728	if (i != max)
	1729	PerlIO_printf(file, ", ");
	1730	}
	1731	}
	1732	PerlIO_putc(file, ')');
	1733	/* The "quality" of a hash is defined as the total number of
	1734	comparisons needed to access every element once, relative
	1735	to the expected number needed for a random hash.
	1736
	1737	The total number of comparisons is equal to the sum of
	1738	the squares of the number of entries in each bucket.
	1739	For a random hash of n keys into k buckets, the expected
	1740	value is
	1741	n + n(n-1)/2k
	1742	*/
	1743
	1744	for (i = max; i > 0; i--) { /* Precision: count down. */
	1745	sum += freq[i] * i * i;
	1746	}
	1747	while ((keys = keys >> 1))
	1748	pow2 = pow2 << 1;
	1749	theoret = usedkeys;
	1750	theoret += theoret * (theoret-1)/pow2;
	1751	PerlIO_putc(file, '\n');
	1752	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1753	}
	1754	PerlIO_putc(file, '\n');
	1755	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
	1756	{
	1757	STRLEN count = 0;
	1758	HE **ents = HvARRAY(sv);
	1759
	1760	if (ents) {
	1761	HE const const last = ents + HvMAX(sv);
	1762	count = last + 1 - ents;
	1763
	1764	do {
	1765	if (!*ents)
	1766	--count;
	1767	} while (++ents <= last);
	1768	}
	1769
	1770	if (SvOOK(sv)) {
	1771	struct xpvhv_aux *const aux = HvAUX(sv);
	1772	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1773	" (cached = %"UVuf")\n",
	1774	(UV)count, (UV)aux->xhv_fill_lazy);
	1775	} else {
	1776	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1777	(UV)count);
	1778	}
	1779	}
	1780	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1781	if (SvOOK(sv)) {
	1782	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1783	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1784	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1785	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1786	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1787	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1788	}
	1789	#endif
	1790	PerlIO_putc(file, '\n');
	1791	}
	1792	{
	1793	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1794	if (mg && mg->mg_obj) {
	1795	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1796	}
	1797	}
	1798	{
	1799	const char * const hvname = HvNAME_get(sv);
	1800	if (hvname) {
	1801	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1802	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1803	generic_pv_escape( tmpsv, hvname,
	1804	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1805	}
	1806	}
	1807	if (SvOOK(sv)) {
	1808	AV * const backrefs
	1809	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1810	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1811	if (HvAUX(sv)->xhv_name_count)
	1812	Perl_dump_indent(aTHX_
	1813	level, file, " NAMECOUNT = %"IVdf"\n",
	1814	(IV)HvAUX(sv)->xhv_name_count
	1815	);
	1816	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1817	const I32 count = HvAUX(sv)->xhv_name_count;
	1818	if (count) {
	1819	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1820	/* The starting point is the first element if count is
	1821	positive and the second element if count is negative. */
	1822	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1823	+ (count < 0 ? 1 : 0);
	1824	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1825	+ (count < 0 ? -count : count);
	1826	while (hekp < endp) {
	1827	if (HEK_LEN(*hekp)) {
	1828	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1829	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	1830	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	1831	} else {
	1832	/* This should never happen. */
	1833	sv_catpvs(names, ", (null)");
	1834	}
	1835	++hekp;
	1836	}
	1837	Perl_dump_indent(aTHX_
	1838	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	1839	);
	1840	}
	1841	else {
	1842	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	1843	const char *const hvename = HvENAME_get(sv);
	1844	Perl_dump_indent(aTHX_
	1845	level, file, " ENAME = \"%s\"\n",
	1846	generic_pv_escape(tmp, hvename,
	1847	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	1848	}
	1849	}
	1850	if (backrefs) {
	1851	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1852	PTR2UV(backrefs));
	1853	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1854	dumpops, pvlim);
	1855	}
	1856	if (meta) {
	1857	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1858	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	1859	generic_pv_escape( tmpsv, meta->mro_which->name,
	1860	meta->mro_which->length,
	1861	(meta->mro_which->kflags & HVhek_UTF8)),
	1862	PTR2UV(meta->mro_which));
	1863	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1864	(UV)meta->cache_gen);
	1865	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1866	(UV)meta->pkg_gen);
	1867	if (meta->mro_linear_all) {
	1868	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1869	PTR2UV(meta->mro_linear_all));
	1870	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1871	dumpops, pvlim);
	1872	}
	1873	if (meta->mro_linear_current) {
	1874	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1875	PTR2UV(meta->mro_linear_current));
	1876	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1877	dumpops, pvlim);
	1878	}
	1879	if (meta->mro_nextmethod) {
	1880	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1881	PTR2UV(meta->mro_nextmethod));
	1882	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1883	dumpops, pvlim);
	1884	}
	1885	if (meta->isa) {
	1886	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1887	PTR2UV(meta->isa));
	1888	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1889	dumpops, pvlim);
	1890	}
	1891	}
	1892	}
	1893	if (nest < maxnest) {
	1894	HV * const hv = MUTABLE_HV(sv);
	1895	STRLEN i;
	1896	HE *he;
	1897
	1898	if (HvARRAY(hv)) {
	1899	int count = maxnest - nest;
	1900	for (i=0; i <= HvMAX(hv); i++) {
	1901	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	1902	U32 hash;
	1903	SV * keysv;
	1904	const char * keypv;
	1905	SV * elt;
	1906	STRLEN len;
	1907
	1908	if (count-- <= 0) goto DONEHV;
	1909
	1910	hash = HeHASH(he);
	1911	keysv = hv_iterkeysv(he);
	1912	keypv = SvPV_const(keysv, len);
	1913	elt = HeVAL(he);
	1914
	1915	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1916	if (SvUTF8(keysv))
	1917	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1918	if (HvEITER_get(hv) == he)
	1919	PerlIO_printf(file, "[CURRENT] ");
	1920	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	1921	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1922	}
	1923	}
	1924	DONEHV:;
	1925	}
	1926	}
	1927	break;
	1928	} /* case SVt_PVHV */
	1929
	1930	case SVt_PVCV:
	1931	if (CvAUTOLOAD(sv)) {
	1932	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1933	STRLEN len;
	1934	const char *const name = SvPV_const(sv, len);
	1935	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	1936	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	1937	}
	1938	if (SvPOK(sv)) {
	1939	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1940	const char *const proto = CvPROTO(sv);
	1941	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	1942	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	1943	SvUTF8(sv)));
	1944	}
	1945	/* FALLTHROUGH */
	1946	case SVt_PVFM:
	1947	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1948	if (!CvISXSUB(sv)) {
	1949	if (CvSTART(sv)) {
	1950	Perl_dump_indent(aTHX_ level, file,
	1951	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1952	PTR2UV(CvSTART(sv)),
	1953	(IV)sequence_num(CvSTART(sv)));
	1954	}
	1955	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1956	PTR2UV(CvROOT(sv)));
	1957	if (CvROOT(sv) && dumpops) {
	1958	do_op_dump(level+1, file, CvROOT(sv));
	1959	}
	1960	} else {
	1961	SV * const constant = cv_const_sv((const CV *)sv);
	1962
	1963	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	1964
	1965	if (constant) {
	1966	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	1967	" (CONST SV)\n",
	1968	PTR2UV(CvXSUBANY(sv).any_ptr));
	1969	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	1970	pvlim);
	1971	} else {
	1972	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	1973	(IV)CvXSUBANY(sv).any_i32);
	1974	}
	1975	}
	1976	if (CvNAMED(sv))
	1977	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1978	HEK_KEY(CvNAME_HEK((CV *)sv)));
	1979	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	1980	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	1981	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1982	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1983	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1984	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1985	if (nest < maxnest) {
	1986	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1987	}
	1988	{
	1989	const CV * const outside = CvOUTSIDE(sv);
	1990	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1991	PTR2UV(outside),
	1992	(!outside ? "null"
	1993	: CvANON(outside) ? "ANON"
	1994	: (outside == PL_main_cv) ? "MAIN"
	1995	: CvUNIQUE(outside) ? "UNIQUE"
	1996	: CvGV(outside) ?
	1997	generic_pv_escape(
	1998	newSVpvs_flags("", SVs_TEMP),
	1999	GvNAME(CvGV(outside)),
	2000	GvNAMELEN(CvGV(outside)),
	2001	GvNAMEUTF8(CvGV(outside)))
	2002	: "UNDEFINED"));
	2003	}
	2004	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2005	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2006	break;
	2007
	2008	case SVt_PVGV:
	2009	case SVt_PVLV:
	2010	if (type == SVt_PVLV) {
	2011	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2012	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2013	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2014	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2015	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2016	if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
	2017	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2018	dumpops, pvlim);
	2019	}
	2020	if (isREGEXP(sv)) goto dumpregexp;
	2021	if (!isGV_with_GP(sv))
	2022	break;
	2023	{
	2024	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2025	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2026	generic_pv_escape(tmpsv, GvNAME(sv),
	2027	GvNAMELEN(sv),
	2028	GvNAMEUTF8(sv)));
	2029	}
	2030	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2031	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2032	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2033	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2034	if (!GvGP(sv))
	2035	break;
	2036	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2037	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2038	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2039	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2040	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2041	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2042	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2043	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2044	Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf
	2045	" (%s)\n",
	2046	(UV)GvGPFLAGS(sv),
	2047	GvALIASED_SV(sv) ? "ALIASED_SV" : "");
	2048	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2049	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2050	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2051	break;
	2052	case SVt_PVIO:
	2053	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2054	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2055	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2056	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2057	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2058	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2059	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2060	if (IoTOP_NAME(sv))
	2061	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2062	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2063	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2064	else {
	2065	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2066	PTR2UV(IoTOP_GV(sv)));
	2067	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2068	maxnest, dumpops, pvlim);
	2069	}
	2070	/* Source filters hide things that are not GVs in these three, so let's
	2071	be careful out there. */
	2072	if (IoFMT_NAME(sv))
	2073	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2074	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2075	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2076	else {
	2077	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2078	PTR2UV(IoFMT_GV(sv)));
	2079	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2080	maxnest, dumpops, pvlim);
	2081	}
	2082	if (IoBOTTOM_NAME(sv))
	2083	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2084	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2085	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2086	else {
	2087	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2088	PTR2UV(IoBOTTOM_GV(sv)));
	2089	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2090	maxnest, dumpops, pvlim);
	2091	}
	2092	if (isPRINT(IoTYPE(sv)))
	2093	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2094	else
	2095	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2096	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2097	break;
	2098	case SVt_REGEXP:
	2099	dumpregexp:
	2100	{
	2101	struct regexp * const r = ReANY((REGEXP*)sv);
	2102
	2103	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
	2104	sv_setpv(d,""); \
	2105	append_flags(d, flags, names); \
	2106	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2107	SvCUR_set(d, SvCUR(d) - 1); \
	2108	SvPVX(d)[SvCUR(d)] = '\0'; \
	2109	} \
	2110	} STMT_END
	2111	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
	2112	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2113	(UV)(r->compflags), SvPVX_const(d));
	2114
	2115	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
	2116	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2117	(UV)(r->extflags), SvPVX_const(d));
	2118
	2119	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
	2120	PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
	2121	if (r->engine == &PL_core_reg_engine) {
	2122	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
	2123	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
	2124	(UV)(r->intflags), SvPVX_const(d));
	2125	} else {
	2126	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2127	(UV)(r->intflags));
	2128	}
	2129	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2130	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2131	(UV)(r->nparens));
	2132	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2133	(UV)(r->lastparen));
	2134	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2135	(UV)(r->lastcloseparen));
	2136	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2137	(IV)(r->minlen));
	2138	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2139	(IV)(r->minlenret));
	2140	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2141	(UV)(r->gofs));
	2142	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2143	(UV)(r->pre_prefix));
	2144	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2145	(IV)(r->sublen));
	2146	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2147	(IV)(r->suboffset));
	2148	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2149	(IV)(r->subcoffset));
	2150	if (r->subbeg)
	2151	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2152	PTR2UV(r->subbeg),
	2153	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2154	else
	2155	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2156	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2157	PTR2UV(r->mother_re));
	2158	if (nest < maxnest && r->mother_re)
	2159	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2160	maxnest, dumpops, pvlim);
	2161	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2162	PTR2UV(r->paren_names));
	2163	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2164	PTR2UV(r->substrs));
	2165	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2166	PTR2UV(r->pprivate));
	2167	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2168	PTR2UV(r->offs));
	2169	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2170	PTR2UV(r->qr_anoncv));
	2171	#ifdef PERL_ANY_COW
	2172	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2173	PTR2UV(r->saved_copy));
	2174	#endif
	2175	}
	2176	break;
	2177	}
	2178	SvREFCNT_dec_NN(d);
	2179	}
	2180
	2181	/*
	2182	=for apidoc sv_dump
	2183
	2184	Dumps the contents of an SV to the C<STDERR> filehandle.
	2185
	2186	For an example of its output, see L<Devel::Peek>.
	2187
	2188	=cut
	2189	*/
	2190
	2191	void
	2192	Perl_sv_dump(pTHX_ SV *sv)
	2193	{
	2194	PERL_ARGS_ASSERT_SV_DUMP;
	2195
	2196	if (SvROK(sv))
	2197	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2198	else
	2199	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2200	}
	2201
	2202	int
	2203	Perl_runops_debug(pTHX)
	2204	{
	2205	if (!PL_op) {
	2206	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2207	return 0;
	2208	}
	2209
	2210	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2211	do {
	2212	#ifdef PERL_TRACE_OPS
	2213	++PL_op_exec_cnt[PL_op->op_type];
	2214	#endif
	2215	if (PL_debug) {
	2216	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2217	PerlIO_printf(Perl_debug_log,
	2218	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2219	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2220	PTR2UV(*PL_watchaddr));
	2221	if (DEBUG_s_TEST_) {
	2222	if (DEBUG_v_TEST_) {
	2223	PerlIO_printf(Perl_debug_log, "\n");
	2224	deb_stack_all();
	2225	}
	2226	else
	2227	debstack();
	2228	}
	2229
	2230
	2231	if (DEBUG_t_TEST_) debop(PL_op);
	2232	if (DEBUG_P_TEST_) debprof(PL_op);
	2233	}
	2234
	2235	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2236	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2237	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2238	PERL_ASYNC_CHECK();
	2239
	2240	TAINT_NOT;
	2241	return 0;
	2242	}
	2243
	2244	I32
	2245	Perl_debop(pTHX_ const OP *o)
	2246	{
	2247	int count;
	2248
	2249	PERL_ARGS_ASSERT_DEBOP;
	2250
	2251	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2252	return 0;
	2253
	2254	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2255	switch (o->op_type) {
	2256	case OP_CONST:
	2257	case OP_HINTSEVAL:
	2258	/* With ITHREADS, consts are stored in the pad, and the right pad
	2259	* may not be active here, so check.
	2260	* Looks like only during compiling the pads are illegal.
	2261	*/
	2262	#ifdef USE_ITHREADS
	2263	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2264	#endif
	2265	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2266	break;
	2267	case OP_GVSV:
	2268	case OP_GV:
	2269	if (cGVOPo_gv && isGV(cGVOPo_gv)) {
	2270	SV * const sv = newSV(0);
	2271	gv_fullname3(sv, cGVOPo_gv, NULL);
	2272	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2273	SvREFCNT_dec_NN(sv);
	2274	}
	2275	else if (cGVOPo_gv) {
	2276	SV * const sv = newSV(0);
	2277	assert(SvROK(cGVOPo_gv));
	2278	assert(SvTYPE(SvRV(cGVOPo_gv)) == SVt_PVCV);
	2279	PerlIO_printf(Perl_debug_log, "(cv ref: %s)",
	2280	SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv)));
	2281	SvREFCNT_dec_NN(sv);
	2282	}
	2283	else
	2284	PerlIO_printf(Perl_debug_log, "(NULL)");
	2285	break;
	2286
	2287	case OP_PADSV:
	2288	case OP_PADAV:
	2289	case OP_PADHV:
	2290	count = 1;
	2291	goto dump_padop;
	2292	case OP_PADRANGE:
	2293	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2294	dump_padop:
	2295	/* print the lexical's name */
	2296	{
	2297	CV * const cv = deb_curcv(cxstack_ix);
	2298	SV *sv;
	2299	PAD * comppad = NULL;
	2300	int i;
	2301
	2302	if (cv) {
	2303	PADLIST * const padlist = CvPADLIST(cv);
	2304	comppad = *PadlistARRAY(padlist);
	2305	}
	2306	PerlIO_printf(Perl_debug_log, "(");
	2307	for (i = 0; i < count; i++) {
	2308	if (comppad &&
	2309	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2310	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2311	else
	2312	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2313	(UV)o->op_targ+i);
	2314	if (i < count-1)
	2315	PerlIO_printf(Perl_debug_log, ",");
	2316	}
	2317	PerlIO_printf(Perl_debug_log, ")");
	2318	}
	2319	break;
	2320
	2321	default:
	2322	break;
	2323	}
	2324	PerlIO_printf(Perl_debug_log, "\n");
	2325	return 0;
	2326	}
	2327
	2328	STATIC CV*
	2329	S_deb_curcv(pTHX_ const I32 ix)
	2330	{
	2331	const PERL_CONTEXT * const cx = &cxstack[ix];
	2332	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2333	return cx->blk_sub.cv;
	2334	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2335	return cx->blk_eval.cv;
	2336	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2337	return PL_main_cv;
	2338	else if (ix <= 0)
	2339	return NULL;
	2340	else
	2341	return deb_curcv(ix - 1);
	2342	}
	2343
	2344	void
	2345	Perl_watch(pTHX_ char **addr)
	2346	{
	2347	PERL_ARGS_ASSERT_WATCH;
	2348
	2349	PL_watchaddr = addr;
	2350	PL_watchok = *addr;
	2351	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2352	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2353	}
	2354
	2355	STATIC void
	2356	S_debprof(pTHX_ const OP *o)
	2357	{
	2358	PERL_ARGS_ASSERT_DEBPROF;
	2359
	2360	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2361	return;
	2362	if (!PL_profiledata)
	2363	Newxz(PL_profiledata, MAXO, U32);
	2364	++PL_profiledata[o->op_type];
	2365	}
	2366
	2367	void
	2368	Perl_debprofdump(pTHX)
	2369	{
	2370	unsigned i;
	2371	if (!PL_profiledata)
	2372	return;
	2373	for (i = 0; i < MAXO; i++) {
	2374	if (PL_profiledata[i])
	2375	PerlIO_printf(Perl_debug_log,
	2376	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2377	PL_op_name[i]);
	2378	}
	2379	}
	2380
	2381
	2382	/*
	2383	* Local variables:
	2384	* c-indentation-style: bsd
	2385	* c-basic-offset: 4
	2386	* indent-tabs-mode: nil
	2387	* End:
	2388	*
	2389	* ex: set ts=8 sts=4 sw=4 et:
	2390	*/