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