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_IsCOW, "IsCOW,"},
	1311	{SVf_BREAK, "BREAK,"},
	1312	{SVf_AMAGIC, "OVERLOAD,"},
	1313	{SVp_IOK, "pIOK,"},
	1314	{SVp_NOK, "pNOK,"},
	1315	{SVp_POK, "pPOK,"}
	1316	};
	1317
	1318	const struct flag_to_name cv_flags_names[] = {
	1319	{CVf_ANON, "ANON,"},
	1320	{CVf_UNIQUE, "UNIQUE,"},
	1321	{CVf_CLONE, "CLONE,"},
	1322	{CVf_CLONED, "CLONED,"},
	1323	{CVf_CONST, "CONST,"},
	1324	{CVf_NODEBUG, "NODEBUG,"},
	1325	{CVf_LVALUE, "LVALUE,"},
	1326	{CVf_METHOD, "METHOD,"},
	1327	{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
	1328	{CVf_CVGV_RC, "CVGV_RC,"},
	1329	{CVf_DYNFILE, "DYNFILE,"},
	1330	{CVf_AUTOLOAD, "AUTOLOAD,"},
	1331	{CVf_HASEVAL, "HASEVAL,"},
	1332	{CVf_SLABBED, "SLABBED,"},
	1333	{CVf_NAMED, "NAMED,"},
	1334	{CVf_LEXICAL, "LEXICAL,"},
	1335	{CVf_ISXSUB, "ISXSUB,"}
	1336	};
	1337
	1338	const struct flag_to_name hv_flags_names[] = {
	1339	{SVphv_SHAREKEYS, "SHAREKEYS,"},
	1340	{SVphv_LAZYDEL, "LAZYDEL,"},
	1341	{SVphv_HASKFLAGS, "HASKFLAGS,"},
	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	append_flags(d, flags, second_sv_flags_names);
	1446	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
	1447	&& type != SVt_PVAV) {
	1448	if (SvPCS_IMPORTED(sv))
	1449	sv_catpv(d, "PCS_IMPORTED,");
	1450	else
	1451	sv_catpv(d, "SCREAM,");
	1452	}
	1453
	1454	/* process type-specific SV flags */
	1455
	1456	switch (type) {
	1457	case SVt_PVCV:
	1458	case SVt_PVFM:
	1459	append_flags(d, CvFLAGS(sv), cv_flags_names);
	1460	break;
	1461	case SVt_PVHV:
	1462	append_flags(d, flags, hv_flags_names);
	1463	break;
	1464	case SVt_PVGV:
	1465	case SVt_PVLV:
	1466	if (isGV_with_GP(sv)) {
	1467	append_flags(d, GvFLAGS(sv), gp_flags_names);
	1468	}
	1469	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
	1470	sv_catpv(d, "IMPORT");
	1471	if (GvIMPORTED(sv) == GVf_IMPORTED)
	1472	sv_catpv(d, "ALL,");
	1473	else {
	1474	sv_catpv(d, "(");
	1475	append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
	1476	sv_catpv(d, " ),");
	1477	}
	1478	}
	1479	/* FALLTHROUGH */
	1480	default:
	1481	evaled_or_uv:
	1482	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
	1483	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
	1484	break;
	1485	case SVt_PVMG:
	1486	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
	1487	if (SvVALID(sv)) sv_catpv(d, "VALID,");
	1488	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
	1489	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
	1490	/* FALLTHROUGH */
	1491	case SVt_PVNV:
	1492	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
	1493	goto evaled_or_uv;
	1494	case SVt_PVAV:
	1495	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
	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	/* dump initial SV details */
	1510
	1511	#ifdef DEBUG_LEAKING_SCALARS
	1512	Perl_dump_indent(aTHX_ level, file,
	1513	"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
	1514	sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
	1515	sv->sv_debug_line,
	1516	sv->sv_debug_inpad ? "for" : "by",
	1517	sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
	1518	PTR2UV(sv->sv_debug_parent),
	1519	sv->sv_debug_serial
	1520	);
	1521	#endif
	1522	Perl_dump_indent(aTHX_ level, file, "SV = ");
	1523
	1524	/* Dump SV type */
	1525
	1526	if (type < SVt_LAST) {
	1527	PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
	1528
	1529	if (type == SVt_NULL) {
	1530	SvREFCNT_dec_NN(d);
	1531	return;
	1532	}
	1533	} else {
	1534	PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
	1535	SvREFCNT_dec_NN(d);
	1536	return;
	1537	}
	1538
	1539	/* Dump general SV fields */
	1540
	1541	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
	1542	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
	1543	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
	1544	\|\| (type == SVt_IV && !SvROK(sv))) {
	1545	if (SvIsUV(sv)
	1546	#ifdef PERL_OLD_COPY_ON_WRITE
	1547	\|\| SvIsCOW(sv)
	1548	#endif
	1549	)
	1550	Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
	1551	else
	1552	Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
	1553	#ifdef PERL_OLD_COPY_ON_WRITE
	1554	if (SvIsCOW_shared_hash(sv))
	1555	PerlIO_printf(file, " (HASH)");
	1556	else if (SvIsCOW_normal(sv))
	1557	PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
	1558	#endif
	1559	PerlIO_putc(file, '\n');
	1560	}
	1561
	1562	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
	1563	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
	1564	Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
	1565	(UV) COP_SEQ_RANGE_LOW(sv));
	1566	Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
	1567	(UV) COP_SEQ_RANGE_HIGH(sv));
	1568	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
	1569	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
	1570	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
	1571	\|\| type == SVt_NV) {
	1572	STORE_NUMERIC_LOCAL_SET_STANDARD();
	1573	Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
	1574	RESTORE_NUMERIC_LOCAL();
	1575	}
	1576
	1577	if (SvROK(sv)) {
	1578	Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
	1579	if (nest < maxnest)
	1580	do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
	1581	}
	1582
	1583	if (type < SVt_PV) {
	1584	SvREFCNT_dec_NN(d);
	1585	return;
	1586	}
	1587
	1588	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
	1589	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
	1590	const bool re = isREGEXP(sv);
	1591	const char * const ptr =
	1592	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
	1593	if (ptr) {
	1594	STRLEN delta;
	1595	if (SvOOK(sv)) {
	1596	SvOOK_offset(sv, delta);
	1597	Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
	1598	(UV) delta);
	1599	} else {
	1600	delta = 0;
	1601	}
	1602	Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
	1603	if (SvOOK(sv)) {
	1604	PerlIO_printf(file, "( %s . ) ",
	1605	pv_display(d, ptr - delta, delta, 0,
	1606	pvlim));
	1607	}
	1608	if (type == SVt_INVLIST) {
	1609	PerlIO_printf(file, "\n");
	1610	/* 4 blanks indents 2 beyond the PV, etc */
	1611	_invlist_dump(file, level, " ", sv);
	1612	}
	1613	else {
	1614	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
	1615	re ? 0 : SvLEN(sv),
	1616	pvlim));
	1617	if (SvUTF8(sv)) /* the 6? \x{....} */
	1618	PerlIO_printf(file, " [UTF8 \"%s\"]",
	1619	sv_uni_display(d, sv, 6 * SvCUR(sv),
	1620	UNI_DISPLAY_QQ));
	1621	PerlIO_printf(file, "\n");
	1622	}
	1623	Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
	1624	if (!re)
	1625	Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
	1626	(IV)SvLEN(sv));
	1627	#ifdef PERL_NEW_COPY_ON_WRITE
	1628	if (SvIsCOW(sv) && SvLEN(sv))
	1629	Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
	1630	CowREFCNT(sv));
	1631	#endif
	1632	}
	1633	else
	1634	Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
	1635	}
	1636
	1637	if (type >= SVt_PVMG) {
	1638	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
	1639	HV * const ost = SvOURSTASH(sv);
	1640	if (ost)
	1641	do_hv_dump(level, file, " OURSTASH", ost);
	1642	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
	1643	Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
	1644	(UV)PadnamelistMAXNAMED(sv));
	1645	} else {
	1646	if (SvMAGIC(sv))
	1647	do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
	1648	}
	1649	if (SvSTASH(sv))
	1650	do_hv_dump(level, file, " STASH", SvSTASH(sv));
	1651
	1652	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
	1653	Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
	1654	}
	1655	}
	1656
	1657	/* Dump type-specific SV fields */
	1658
	1659	switch (type) {
	1660	case SVt_PVAV:
	1661	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
	1662	if (AvARRAY(sv) != AvALLOC(sv)) {
	1663	PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
	1664	Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
	1665	}
	1666	else
	1667	PerlIO_putc(file, '\n');
	1668	Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
	1669	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
	1670	/* arylen is stored in magic, and padnamelists use SvMAGIC for
	1671	something else. */
	1672	if (!AvPAD_NAMELIST(sv))
	1673	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
	1674	SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
	1675	sv_setpvs(d, "");
	1676	if (AvREAL(sv)) sv_catpv(d, ",REAL");
	1677	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
	1678	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
	1679	SvCUR(d) ? SvPVX_const(d) + 1 : "");
	1680	if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
	1681	SSize_t count;
	1682	for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
	1683	SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
	1684
	1685	Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
	1686	if (elt)
	1687	do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
	1688	}
	1689	}
	1690	break;
	1691	case SVt_PVHV: {
	1692	U32 usedkeys;
	1693	if (SvOOK(sv)) {
	1694	struct xpvhv_aux *const aux = HvAUX(sv);
	1695	Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
	1696	(UV)aux->xhv_aux_flags);
	1697	}
	1698	Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
	1699	usedkeys = HvUSEDKEYS(sv);
	1700	if (HvARRAY(sv) && usedkeys) {
	1701	/* Show distribution of HEs in the ARRAY */
	1702	int freq[200];
	1703	#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
	1704	int i;
	1705	int max = 0;
	1706	U32 pow2 = 2, keys = usedkeys;
	1707	NV theoret, sum = 0;
	1708
	1709	PerlIO_printf(file, " (");
	1710	Zero(freq, FREQ_MAX + 1, int);
	1711	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
	1712	HE* h;
	1713	int count = 0;
	1714	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
	1715	count++;
	1716	if (count > FREQ_MAX)
	1717	count = FREQ_MAX;
	1718	freq[count]++;
	1719	if (max < count)
	1720	max = count;
	1721	}
	1722	for (i = 0; i <= max; i++) {
	1723	if (freq[i]) {
	1724	PerlIO_printf(file, "%d%s:%d", i,
	1725	(i == FREQ_MAX) ? "+" : "",
	1726	freq[i]);
	1727	if (i != max)
	1728	PerlIO_printf(file, ", ");
	1729	}
	1730	}
	1731	PerlIO_putc(file, ')');
	1732	/* The "quality" of a hash is defined as the total number of
	1733	comparisons needed to access every element once, relative
	1734	to the expected number needed for a random hash.
	1735
	1736	The total number of comparisons is equal to the sum of
	1737	the squares of the number of entries in each bucket.
	1738	For a random hash of n keys into k buckets, the expected
	1739	value is
	1740	n + n(n-1)/2k
	1741	*/
	1742
	1743	for (i = max; i > 0; i--) { /* Precision: count down. */
	1744	sum += freq[i] * i * i;
	1745	}
	1746	while ((keys = keys >> 1))
	1747	pow2 = pow2 << 1;
	1748	theoret = usedkeys;
	1749	theoret += theoret * (theoret-1)/pow2;
	1750	PerlIO_putc(file, '\n');
	1751	Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
	1752	}
	1753	PerlIO_putc(file, '\n');
	1754	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
	1755	{
	1756	STRLEN count = 0;
	1757	HE **ents = HvARRAY(sv);
	1758
	1759	if (ents) {
	1760	HE const const last = ents + HvMAX(sv);
	1761	count = last + 1 - ents;
	1762
	1763	do {
	1764	if (!*ents)
	1765	--count;
	1766	} while (++ents <= last);
	1767	}
	1768
	1769	if (SvOOK(sv)) {
	1770	struct xpvhv_aux *const aux = HvAUX(sv);
	1771	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
	1772	" (cached = %"UVuf")\n",
	1773	(UV)count, (UV)aux->xhv_fill_lazy);
	1774	} else {
	1775	Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
	1776	(UV)count);
	1777	}
	1778	}
	1779	Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
	1780	if (SvOOK(sv)) {
	1781	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
	1782	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
	1783	#ifdef PERL_HASH_RANDOMIZE_KEYS
	1784	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
	1785	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
	1786	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
	1787	}
	1788	#endif
	1789	PerlIO_putc(file, '\n');
	1790	}
	1791	{
	1792	MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
	1793	if (mg && mg->mg_obj) {
	1794	Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
	1795	}
	1796	}
	1797	{
	1798	const char * const hvname = HvNAME_get(sv);
	1799	if (hvname) {
	1800	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1801	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1802	generic_pv_escape( tmpsv, hvname,
	1803	HvNAMELEN(sv), HvNAMEUTF8(sv)));
	1804	}
	1805	}
	1806	if (SvOOK(sv)) {
	1807	AV * const backrefs
	1808	= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
	1809	struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
	1810	if (HvAUX(sv)->xhv_name_count)
	1811	Perl_dump_indent(aTHX_
	1812	level, file, " NAMECOUNT = %"IVdf"\n",
	1813	(IV)HvAUX(sv)->xhv_name_count
	1814	);
	1815	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
	1816	const I32 count = HvAUX(sv)->xhv_name_count;
	1817	if (count) {
	1818	SV * const names = newSVpvs_flags("", SVs_TEMP);
	1819	/* The starting point is the first element if count is
	1820	positive and the second element if count is negative. */
	1821	HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1822	+ (count < 0 ? 1 : 0);
	1823	HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
	1824	+ (count < 0 ? -count : count);
	1825	while (hekp < endp) {
	1826	if (HEK_LEN(*hekp)) {
	1827	SV *tmp = newSVpvs_flags("", SVs_TEMP);
	1828	Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
	1829	generic_pv_escape(tmp, HEK_KEY(hekp), HEK_LEN(hekp), HEK_UTF8(*hekp)));
	1830	} else {
	1831	/* This should never happen. */
	1832	sv_catpvs(names, ", (null)");
	1833	}
	1834	++hekp;
	1835	}
	1836	Perl_dump_indent(aTHX_
	1837	level, file, " ENAME = %s\n", SvPV_nolen(names)+2
	1838	);
	1839	}
	1840	else {
	1841	SV * const tmp = newSVpvs_flags("", SVs_TEMP);
	1842	const char *const hvename = HvENAME_get(sv);
	1843	Perl_dump_indent(aTHX_
	1844	level, file, " ENAME = \"%s\"\n",
	1845	generic_pv_escape(tmp, hvename,
	1846	HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
	1847	}
	1848	}
	1849	if (backrefs) {
	1850	Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
	1851	PTR2UV(backrefs));
	1852	do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
	1853	dumpops, pvlim);
	1854	}
	1855	if (meta) {
	1856	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1857	Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
	1858	generic_pv_escape( tmpsv, meta->mro_which->name,
	1859	meta->mro_which->length,
	1860	(meta->mro_which->kflags & HVhek_UTF8)),
	1861	PTR2UV(meta->mro_which));
	1862	Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
	1863	(UV)meta->cache_gen);
	1864	Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
	1865	(UV)meta->pkg_gen);
	1866	if (meta->mro_linear_all) {
	1867	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
	1868	PTR2UV(meta->mro_linear_all));
	1869	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
	1870	dumpops, pvlim);
	1871	}
	1872	if (meta->mro_linear_current) {
	1873	Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
	1874	PTR2UV(meta->mro_linear_current));
	1875	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
	1876	dumpops, pvlim);
	1877	}
	1878	if (meta->mro_nextmethod) {
	1879	Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
	1880	PTR2UV(meta->mro_nextmethod));
	1881	do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
	1882	dumpops, pvlim);
	1883	}
	1884	if (meta->isa) {
	1885	Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
	1886	PTR2UV(meta->isa));
	1887	do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
	1888	dumpops, pvlim);
	1889	}
	1890	}
	1891	}
	1892	if (nest < maxnest) {
	1893	HV * const hv = MUTABLE_HV(sv);
	1894	STRLEN i;
	1895	HE *he;
	1896
	1897	if (HvARRAY(hv)) {
	1898	int count = maxnest - nest;
	1899	for (i=0; i <= HvMAX(hv); i++) {
	1900	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
	1901	U32 hash;
	1902	SV * keysv;
	1903	const char * keypv;
	1904	SV * elt;
	1905	STRLEN len;
	1906
	1907	if (count-- <= 0) goto DONEHV;
	1908
	1909	hash = HeHASH(he);
	1910	keysv = hv_iterkeysv(he);
	1911	keypv = SvPV_const(keysv, len);
	1912	elt = HeVAL(he);
	1913
	1914	Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
	1915	if (SvUTF8(keysv))
	1916	PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
	1917	if (HvEITER_get(hv) == he)
	1918	PerlIO_printf(file, "[CURRENT] ");
	1919	PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
	1920	do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
	1921	}
	1922	}
	1923	DONEHV:;
	1924	}
	1925	}
	1926	break;
	1927	} /* case SVt_PVHV */
	1928
	1929	case SVt_PVCV:
	1930	if (CvAUTOLOAD(sv)) {
	1931	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1932	STRLEN len;
	1933	const char *const name = SvPV_const(sv, len);
	1934	Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
	1935	generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
	1936	}
	1937	if (SvPOK(sv)) {
	1938	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	1939	const char *const proto = CvPROTO(sv);
	1940	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
	1941	generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
	1942	SvUTF8(sv)));
	1943	}
	1944	/* FALLTHROUGH */
	1945	case SVt_PVFM:
	1946	do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
	1947	if (!CvISXSUB(sv)) {
	1948	if (CvSTART(sv)) {
	1949	Perl_dump_indent(aTHX_ level, file,
	1950	" START = 0x%"UVxf" ===> %"IVdf"\n",
	1951	PTR2UV(CvSTART(sv)),
	1952	(IV)sequence_num(CvSTART(sv)));
	1953	}
	1954	Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
	1955	PTR2UV(CvROOT(sv)));
	1956	if (CvROOT(sv) && dumpops) {
	1957	do_op_dump(level+1, file, CvROOT(sv));
	1958	}
	1959	} else {
	1960	SV * const constant = cv_const_sv((const CV *)sv);
	1961
	1962	Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
	1963
	1964	if (constant) {
	1965	Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
	1966	" (CONST SV)\n",
	1967	PTR2UV(CvXSUBANY(sv).any_ptr));
	1968	do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
	1969	pvlim);
	1970	} else {
	1971	Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
	1972	(IV)CvXSUBANY(sv).any_i32);
	1973	}
	1974	}
	1975	if (CvNAMED(sv))
	1976	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	1977	HEK_KEY(CvNAME_HEK((CV *)sv)));
	1978	else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
	1979	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
	1980	Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
	1981	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
	1982	Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
	1983	Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
	1984	if (nest < maxnest) {
	1985	do_dump_pad(level+1, file, CvPADLIST(sv), 0);
	1986	}
	1987	{
	1988	const CV * const outside = CvOUTSIDE(sv);
	1989	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
	1990	PTR2UV(outside),
	1991	(!outside ? "null"
	1992	: CvANON(outside) ? "ANON"
	1993	: (outside == PL_main_cv) ? "MAIN"
	1994	: CvUNIQUE(outside) ? "UNIQUE"
	1995	: CvGV(outside) ?
	1996	generic_pv_escape(
	1997	newSVpvs_flags("", SVs_TEMP),
	1998	GvNAME(CvGV(outside)),
	1999	GvNAMELEN(CvGV(outside)),
	2000	GvNAMEUTF8(CvGV(outside)))
	2001	: "UNDEFINED"));
	2002	}
	2003	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
	2004	do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
	2005	break;
	2006
	2007	case SVt_PVGV:
	2008	case SVt_PVLV:
	2009	if (type == SVt_PVLV) {
	2010	Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
	2011	Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
	2012	Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
	2013	Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
	2014	Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
	2015	if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
	2016	do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
	2017	dumpops, pvlim);
	2018	}
	2019	if (isREGEXP(sv)) goto dumpregexp;
	2020	if (!isGV_with_GP(sv))
	2021	break;
	2022	{
	2023	SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
	2024	Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
	2025	generic_pv_escape(tmpsv, GvNAME(sv),
	2026	GvNAMELEN(sv),
	2027	GvNAMEUTF8(sv)));
	2028	}
	2029	Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
	2030	do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
	2031	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
	2032	Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
	2033	if (!GvGP(sv))
	2034	break;
	2035	Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
	2036	Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
	2037	Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
	2038	Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
	2039	Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
	2040	Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
	2041	Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
	2042	Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
	2043	Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
	2044	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
	2045	do_gv_dump (level, file, " EGV", GvEGV(sv));
	2046	break;
	2047	case SVt_PVIO:
	2048	Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
	2049	Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
	2050	Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
	2051	Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
	2052	Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
	2053	Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
	2054	Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
	2055	if (IoTOP_NAME(sv))
	2056	Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
	2057	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
	2058	do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
	2059	else {
	2060	Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
	2061	PTR2UV(IoTOP_GV(sv)));
	2062	do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
	2063	maxnest, dumpops, pvlim);
	2064	}
	2065	/* Source filters hide things that are not GVs in these three, so let's
	2066	be careful out there. */
	2067	if (IoFMT_NAME(sv))
	2068	Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
	2069	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
	2070	do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
	2071	else {
	2072	Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
	2073	PTR2UV(IoFMT_GV(sv)));
	2074	do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
	2075	maxnest, dumpops, pvlim);
	2076	}
	2077	if (IoBOTTOM_NAME(sv))
	2078	Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
	2079	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
	2080	do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
	2081	else {
	2082	Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
	2083	PTR2UV(IoBOTTOM_GV(sv)));
	2084	do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
	2085	maxnest, dumpops, pvlim);
	2086	}
	2087	if (isPRINT(IoTYPE(sv)))
	2088	Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
	2089	else
	2090	Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
	2091	Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
	2092	break;
	2093	case SVt_REGEXP:
	2094	dumpregexp:
	2095	{
	2096	struct regexp * const r = ReANY((REGEXP*)sv);
	2097
	2098	#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
	2099	sv_setpv(d,""); \
	2100	append_flags(d, flags, names); \
	2101	if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
	2102	SvCUR_set(d, SvCUR(d) - 1); \
	2103	SvPVX(d)[SvCUR(d)] = '\0'; \
	2104	} \
	2105	} STMT_END
	2106	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
	2107	Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
	2108	(UV)(r->compflags), SvPVX_const(d));
	2109
	2110	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
	2111	Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
	2112	(UV)(r->extflags), SvPVX_const(d));
	2113
	2114	Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
	2115	PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
	2116	if (r->engine == &PL_core_reg_engine) {
	2117	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
	2118	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
	2119	(UV)(r->intflags), SvPVX_const(d));
	2120	} else {
	2121	Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
	2122	(UV)(r->intflags));
	2123	}
	2124	#undef SV_SET_STRINGIFY_REGEXP_FLAGS
	2125	Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
	2126	(UV)(r->nparens));
	2127	Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
	2128	(UV)(r->lastparen));
	2129	Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
	2130	(UV)(r->lastcloseparen));
	2131	Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
	2132	(IV)(r->minlen));
	2133	Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
	2134	(IV)(r->minlenret));
	2135	Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
	2136	(UV)(r->gofs));
	2137	Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
	2138	(UV)(r->pre_prefix));
	2139	Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
	2140	(IV)(r->sublen));
	2141	Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
	2142	(IV)(r->suboffset));
	2143	Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
	2144	(IV)(r->subcoffset));
	2145	if (r->subbeg)
	2146	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
	2147	PTR2UV(r->subbeg),
	2148	pv_display(d, r->subbeg, r->sublen, 50, pvlim));
	2149	else
	2150	Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
	2151	Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
	2152	PTR2UV(r->mother_re));
	2153	if (nest < maxnest && r->mother_re)
	2154	do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
	2155	maxnest, dumpops, pvlim);
	2156	Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
	2157	PTR2UV(r->paren_names));
	2158	Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
	2159	PTR2UV(r->substrs));
	2160	Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
	2161	PTR2UV(r->pprivate));
	2162	Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
	2163	PTR2UV(r->offs));
	2164	Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
	2165	PTR2UV(r->qr_anoncv));
	2166	#ifdef PERL_ANY_COW
	2167	Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
	2168	PTR2UV(r->saved_copy));
	2169	#endif
	2170	}
	2171	break;
	2172	}
	2173	SvREFCNT_dec_NN(d);
	2174	}
	2175
	2176	/*
	2177	=for apidoc sv_dump
	2178
	2179	Dumps the contents of an SV to the C<STDERR> filehandle.
	2180
	2181	For an example of its output, see L<Devel::Peek>.
	2182
	2183	=cut
	2184	*/
	2185
	2186	void
	2187	Perl_sv_dump(pTHX_ SV *sv)
	2188	{
	2189	PERL_ARGS_ASSERT_SV_DUMP;
	2190
	2191	if (SvROK(sv))
	2192	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
	2193	else
	2194	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
	2195	}
	2196
	2197	int
	2198	Perl_runops_debug(pTHX)
	2199	{
	2200	if (!PL_op) {
	2201	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
	2202	return 0;
	2203	}
	2204
	2205	DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
	2206	do {
	2207	#ifdef PERL_TRACE_OPS
	2208	++PL_op_exec_cnt[PL_op->op_type];
	2209	#endif
	2210	if (PL_debug) {
	2211	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
	2212	PerlIO_printf(Perl_debug_log,
	2213	"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
	2214	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
	2215	PTR2UV(*PL_watchaddr));
	2216	if (DEBUG_s_TEST_) {
	2217	if (DEBUG_v_TEST_) {
	2218	PerlIO_printf(Perl_debug_log, "\n");
	2219	deb_stack_all();
	2220	}
	2221	else
	2222	debstack();
	2223	}
	2224
	2225
	2226	if (DEBUG_t_TEST_) debop(PL_op);
	2227	if (DEBUG_P_TEST_) debprof(PL_op);
	2228	}
	2229
	2230	OP_ENTRY_PROBE(OP_NAME(PL_op));
	2231	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
	2232	DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
	2233	PERL_ASYNC_CHECK();
	2234
	2235	TAINT_NOT;
	2236	return 0;
	2237	}
	2238
	2239	I32
	2240	Perl_debop(pTHX_ const OP *o)
	2241	{
	2242	int count;
	2243
	2244	PERL_ARGS_ASSERT_DEBOP;
	2245
	2246	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
	2247	return 0;
	2248
	2249	Perl_deb(aTHX_ "%s", OP_NAME(o));
	2250	switch (o->op_type) {
	2251	case OP_CONST:
	2252	case OP_HINTSEVAL:
	2253	/* With ITHREADS, consts are stored in the pad, and the right pad
	2254	* may not be active here, so check.
	2255	* Looks like only during compiling the pads are illegal.
	2256	*/
	2257	#ifdef USE_ITHREADS
	2258	if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
	2259	#endif
	2260	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	2261	break;
	2262	case OP_GVSV:
	2263	case OP_GV:
	2264	if (cGVOPo_gv) {
	2265	SV * const sv = newSV(0);
	2266	gv_fullname3(sv, cGVOPo_gv, NULL);
	2267	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
	2268	SvREFCNT_dec_NN(sv);
	2269	}
	2270	else
	2271	PerlIO_printf(Perl_debug_log, "(NULL)");
	2272	break;
	2273
	2274	case OP_PADSV:
	2275	case OP_PADAV:
	2276	case OP_PADHV:
	2277	count = 1;
	2278	goto dump_padop;
	2279	case OP_PADRANGE:
	2280	count = o->op_private & OPpPADRANGE_COUNTMASK;
	2281	dump_padop:
	2282	/* print the lexical's name */
	2283	{
	2284	CV * const cv = deb_curcv(cxstack_ix);
	2285	SV *sv;
	2286	PAD * comppad = NULL;
	2287	int i;
	2288
	2289	if (cv) {
	2290	PADLIST * const padlist = CvPADLIST(cv);
	2291	comppad = *PadlistARRAY(padlist);
	2292	}
	2293	PerlIO_printf(Perl_debug_log, "(");
	2294	for (i = 0; i < count; i++) {
	2295	if (comppad &&
	2296	(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
	2297	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
	2298	else
	2299	PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
	2300	(UV)o->op_targ+i);
	2301	if (i < count-1)
	2302	PerlIO_printf(Perl_debug_log, ",");
	2303	}
	2304	PerlIO_printf(Perl_debug_log, ")");
	2305	}
	2306	break;
	2307
	2308	default:
	2309	break;
	2310	}
	2311	PerlIO_printf(Perl_debug_log, "\n");
	2312	return 0;
	2313	}
	2314
	2315	STATIC CV*
	2316	S_deb_curcv(pTHX_ const I32 ix)
	2317	{
	2318	const PERL_CONTEXT * const cx = &cxstack[ix];
	2319	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
	2320	return cx->blk_sub.cv;
	2321	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
	2322	return cx->blk_eval.cv;
	2323	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
	2324	return PL_main_cv;
	2325	else if (ix <= 0)
	2326	return NULL;
	2327	else
	2328	return deb_curcv(ix - 1);
	2329	}
	2330
	2331	void
	2332	Perl_watch(pTHX_ char **addr)
	2333	{
	2334	PERL_ARGS_ASSERT_WATCH;
	2335
	2336	PL_watchaddr = addr;
	2337	PL_watchok = *addr;
	2338	PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	2339	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
	2340	}
	2341
	2342	STATIC void
	2343	S_debprof(pTHX_ const OP *o)
	2344	{
	2345	PERL_ARGS_ASSERT_DEBPROF;
	2346
	2347	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
	2348	return;
	2349	if (!PL_profiledata)
	2350	Newxz(PL_profiledata, MAXO, U32);
	2351	++PL_profiledata[o->op_type];
	2352	}
	2353
	2354	void
	2355	Perl_debprofdump(pTHX)
	2356	{
	2357	unsigned i;
	2358	if (!PL_profiledata)
	2359	return;
	2360	for (i = 0; i < MAXO; i++) {
	2361	if (PL_profiledata[i])
	2362	PerlIO_printf(Perl_debug_log,
	2363	"%5lu %s\n", (unsigned long)PL_profiledata[i],
	2364	PL_op_name[i]);
	2365	}
	2366	}
	2367
	2368
	2369	/*
	2370	* Local variables:
	2371	* c-indentation-style: bsd
	2372	* c-basic-offset: 4
	2373	* indent-tabs-mode: nil
	2374	* End:
	2375	*
	2376	* ex: set ts=8 sts=4 sw=4 et:
	2377	*/