File Coverage

dump.c

Criterion	Covered	Total	%
statement	241	1003	24.0
branch	216	1102	19.6
condition			n/a
subroutine			n/a
total	457	2105	21.7

line	stmt	bran	code
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
25			#include "EXTERN.h"
26			#define PERL_IN_DUMP_C
27			#include "perl.h"
28			#include "regcomp.h"
29
30			static const char* const svtypenames[SVt_LAST] = {
31			"NULL",
32			"IV",
33			"NV",
34			"PV",
35			"INVLIST",
36			"PVIV",
37			"PVNV",
38			"PVMG",
39			"REGEXP",
40			"PVGV",
41			"PVLV",
42			"PVAV",
43			"PVHV",
44			"PVCV",
45			"PVFM",
46			"PVIO"
47			};
48
49
50			static const char* const svshorttypenames[SVt_LAST] = {
51			"UNDEF",
52			"IV",
53			"NV",
54			"PV",
55			"INVLST",
56			"PVIV",
57			"PVNV",
58			"PVMG",
59			"REGEXP",
60			"GV",
61			"PVLV",
62			"AV",
63			"HV",
64			"CV",
65			"FM",
66			"IO"
67			};
68
69			struct flag_to_name {
70			U32 flag;
71			const char *name;
72			};
73
74			static void
75	580		S_append_flags(pTHX_ SV sv, U32 flags, const struct flag_to_name start,
76			const struct flag_to_name *const end)
77			{
78			do {
79	4696	100	if (flags & start->flag)
80	480		sv_catpv(sv, start->name);
81	4696	100	} while (++start < end);
82	580		}
83
84			#define append_flags(sv, f, flags) \
85			S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
86
87
88
89			void
90	1064		Perl_dump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
91			{
92			va_list args;
93			PERL_ARGS_ASSERT_DUMP_INDENT;
94	1064		va_start(args, pat);
95	1064		dump_vindent(level, file, pat, &args);
96	1064		va_end(args);
97	1064		}
98
99			void
100	1064		Perl_dump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
101			{
102			dVAR;
103			PERL_ARGS_ASSERT_DUMP_VINDENT;
104	1064		PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
105	1064		PerlIO_vprintf(file, pat, *args);
106	1064		}
107
108			void
109	0		Perl_dump_all(pTHX)
110			{
111	0		dump_all_perl(FALSE);
112	0		}
113
114			void
115	0		Perl_dump_all_perl(pTHX_ bool justperl)
116			{
117
118			dVAR;
119	0		PerlIO_setlinebuf(Perl_debug_log);
120	0	0	if (PL_main_root)
121	0		op_dump(PL_main_root);
122	0		dump_packsubs_perl(PL_defstash, justperl);
123	0		}
124
125			void
126	0		Perl_dump_packsubs(pTHX_ const HV *stash)
127			{
128			PERL_ARGS_ASSERT_DUMP_PACKSUBS;
129	0		dump_packsubs_perl(stash, FALSE);
130	0		}
131
132			void
133	0		Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
134			{
135			dVAR;
136			I32 i;
137
138			PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
139
140	0	0	if (!HvARRAY(stash))
141	0		return;
142	0	0	for (i = 0; i <= (I32) HvMAX(stash); i++) {
143			const HE *entry;
144	0	0	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
145	0		const GV * const gv = (const GV *)HeVAL(entry);
146	0	0	if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
		0
147	0		continue;
148	0	0	if (GvCVu(gv))
		0
149	0		dump_sub_perl(gv, justperl);
150	0	0	if (GvFORM(gv))
151	0		dump_form(gv);
152	0	0	if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
153	0		const HV * const hv = GvHV(gv);
154	0	0	if (hv && (hv != PL_defstash))
		0
155	0		dump_packsubs_perl(hv, justperl); /* nested package */
156			}
157			}
158			}
159			}
160
161			void
162	0		Perl_dump_sub(pTHX_ const GV *gv)
163			{
164			PERL_ARGS_ASSERT_DUMP_SUB;
165	0		dump_sub_perl(gv, FALSE);
166	0		}
167
168			void
169	0		Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
170			{
171			SV * sv;
172
173			PERL_ARGS_ASSERT_DUMP_SUB_PERL;
174
175	0	0	if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
		0
		0
176	0		return;
177
178	0		sv = sv_newmortal();
179	0		gv_fullname3(sv, gv, NULL);
180	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
181	0	0	if (CvISXSUB(GvCV(gv)))
182	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
183	0		PTR2UV(CvXSUB(GvCV(gv))),
184	0		(int)CvXSUBANY(GvCV(gv)).any_i32);
185	0	0	else if (CvROOT(GvCV(gv)))
186	0		op_dump(CvROOT(GvCV(gv)));
187			else
188	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n");
189			}
190
191			void
192	0		Perl_dump_form(pTHX_ const GV *gv)
193			{
194	0		SV * const sv = sv_newmortal();
195
196			PERL_ARGS_ASSERT_DUMP_FORM;
197
198	0		gv_fullname3(sv, gv, NULL);
199	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
200	0	0	if (CvROOT(GvFORM(gv)))
201	0		op_dump(CvROOT(GvFORM(gv)));
202			else
203	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n");
204	0		}
205
206			void
207	0		Perl_dump_eval(pTHX)
208			{
209			dVAR;
210	0		op_dump(PL_eval_root);
211	0		}
212
213
214			/*
215			=for apidoc pv_escape
216
217			Escapes at most the first "count" chars of pv and puts the results into
218			dsv such that the size of the escaped string will not exceed "max" chars
219			and will not contain any incomplete escape sequences.
220
221			If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
222			will also be escaped.
223
224			Normally the SV will be cleared before the escaped string is prepared,
225			but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
226
227			If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
228			if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
229			using C to determine if it is Unicode.
230
231			If PERL_PV_ESCAPE_ALL is set then all input chars will be output
232			using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
233			non-ASCII chars will be escaped using this style; otherwise, only chars above
234			255 will be so escaped; other non printable chars will use octal or
235			common escaped patterns like C<\n>. Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
236			then all chars below 255 will be treated as printable and
237			will be output as literals.
238
239			If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
240			string will be escaped, regardless of max. If the output is to be in hex,
241			then it will be returned as a plain hex
242			sequence. Thus the output will either be a single char,
243			an octal escape sequence, a special escape like C<\n> or a hex value.
244
245			If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
246			not a '\\'. This is because regexes very often contain backslashed
247			sequences, whereas '%' is not a particularly common character in patterns.
248
249			Returns a pointer to the escaped text as held by dsv.
250
251			=cut
252			*/
253			#define PV_ESCAPE_OCTBUFSIZE 32
254
255			char *
256	148882		Perl_pv_escape( pTHX_ SV dsv, char const const str,
257			const STRLEN count, const STRLEN max,
258			STRLEN * const escaped, const U32 flags )
259			{
260	148882	100	const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
261	148882	100	const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
262	148882		char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
263			STRLEN wrote = 0; /* chars written so far */
264			STRLEN chsize = 0; /* size of data to be written */
265	148882		STRLEN readsize = 1; /* size of data just read */
266	148882		bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
267			const char *pv = str;
268	148882		const char * const end = pv + count; /* end of string */
269	148882		octbuf[0] = esc;
270
271			PERL_ARGS_ASSERT_PV_ESCAPE;
272
273	148882	100	if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
274			/* This won't alter the UTF-8 flag */
275	6		sv_setpvs(dsv, "");
276			}
277
278	148882	100	if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
		50
279			isuni = 1;
280
281	285091	100	for ( ; (pv < end && (!max \|\| (wrote < max))) ; pv += readsize ) {
		100
282	208584	100	const UV u= (isuni) ? utf8_to_uvchr_buf((U8)pv, (U8) end, &readsize) : (U8)*pv;
		100
283	208584		const U8 c = (U8)u & 0xFF;
284
285	208584	100	if ( ( u > 255 )
286	208466	50	\|\| (flags & PERL_PV_ESCAPE_ALL)
287	208466	100	\|\| (( ! isASCII(u) ) && (flags & PERL_PV_ESCAPE_NONASCII)))
		100
288			{
289	216	50	if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
290	0	0	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
291			"%"UVxf, u);
292			else
293	324	50	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
294			"%cx{%"UVxf"}", esc, u);
295	208368	50	} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
296			chsize = 1;
297			} else {
298	208368	100	if ( (c == dq) \|\| (c == esc) \|\| !isPRINT(c) ) {
		100
		100
299			chsize = 2;
300	3380		switch (c) {
301
302			case '\\' : /* fallthrough */
303	3326	50	case '%' : if ( c == esc ) {
304	3326		octbuf[1] = esc;
305			} else {
306			chsize = 1;
307			}
308			break;
309	0		case '\v' : octbuf[1] = 'v'; break;
310	4		case '\t' : octbuf[1] = 't'; break;
311	4		case '\r' : octbuf[1] = 'r'; break;
312	6		case '\n' : octbuf[1] = 'n'; break;
313	2		case '\f' : octbuf[1] = 'f'; break;
314			case '"' :
315	4	50	if ( dq == '"' )
316	4		octbuf[1] = '"';
317			else
318			chsize = 1;
319			break;
320			default:
321	34	100	if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
		100
322	3	50	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
323			"%c%03o", esc, c);
324			else
325	48	50	chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
326			"%c%o", esc, c);
327			}
328			} else {
329			chsize = 1;
330			}
331			}
332	208584	100	if ( max && (wrote + chsize > max) ) {
		50
333			break;
334	208584	100	} else if (chsize > 1) {
335	3596		sv_catpvn(dsv, octbuf, chsize);
336	3596		wrote += chsize;
337			} else {
338			/* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
339			can be appended raw to the dsv. If dsv happens to be
340			UTF-8 then we need catpvf to upgrade them for us.
341			Or add a new API call sv_catpvc(). Think about that name, and
342			how to keep it clear that it's unlike the s of catpvs, which is
343			really an array of octets, not a string. */
344	204988		Perl_sv_catpvf( aTHX_ dsv, "%c", c);
345	204988		wrote++;
346			}
347	208584	100	if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
348			break;
349			}
350	148882	100	if (escaped != NULL)
351	148876		*escaped= pv - str;
352	148882		return SvPVX(dsv);
353			}
354			/*
355			=for apidoc pv_pretty
356
357			Converts a string into something presentable, handling escaping via
358			pv_escape() and supporting quoting and ellipses.
359
360			If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
361			double quoted with any double quotes in the string escaped. Otherwise
362			if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
363			angle brackets.
364
365			If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
366			string were output then an ellipsis C<...> will be appended to the
367			string. Note that this happens AFTER it has been quoted.
368
369			If start_color is non-null then it will be inserted after the opening
370			quote (if there is one) but before the escaped text. If end_color
371			is non-null then it will be inserted after the escaped text but before
372			any quotes or ellipses.
373
374			Returns a pointer to the prettified text as held by dsv.
375
376			=cut
377			*/
378
379			char *
380	148876		Perl_pv_pretty( pTHX_ SV dsv, char const const str, const STRLEN count,
381			const STRLEN max, char const * const start_color, char const * const end_color,
382			const U32 flags )
383			{
384	148876	100	const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
385			STRLEN escaped;
386
387			PERL_ARGS_ASSERT_PV_PRETTY;
388
389	148876	100	if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
390			/* This won't alter the UTF-8 flag */
391	148640		sv_setpvs(dsv, "");
392			}
393
394	148876	100	if ( dq == '"' )
395	914		sv_catpvs(dsv, "\"");
396	147962	100	else if ( flags & PERL_PV_PRETTY_LTGT )
397	274		sv_catpvs(dsv, "<");
398
399	148876	100	if ( start_color != NULL )
400	1566		sv_catpv(dsv, start_color);
401
402	148876		pv_escape( dsv, str, count, max, &escaped, flags \| PERL_PV_ESCAPE_NOCLEAR );
403
404	148876	100	if ( end_color != NULL )
405	1566		sv_catpv(dsv, end_color);
406
407	148876	100	if ( dq == '"' )
408	914		sv_catpvs( dsv, "\"");
409	147962	100	else if ( flags & PERL_PV_PRETTY_LTGT )
410	274		sv_catpvs(dsv, ">");
411
412	148876	100	if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
		100
413	12		sv_catpvs(dsv, "...");
414
415	148876		return SvPVX(dsv);
416			}
417
418			/*
419			=for apidoc pv_display
420
421			Similar to
422
423			pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
424
425			except that an additional "\0" will be appended to the string when
426			len > cur and pv[cur] is "\0".
427
428			Note that the final string may be up to 7 chars longer than pvlim.
429
430			=cut
431			*/
432
433			char *
434	164		Perl_pv_display(pTHX_ SV dsv, const char pv, STRLEN cur, STRLEN len, STRLEN pvlim)
435			{
436			PERL_ARGS_ASSERT_PV_DISPLAY;
437
438	164		pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
439	164	100	if (len > cur && pv[cur] == '\0')
		50
440	8		sv_catpvs( dsv, "\\0");
441	164		return SvPVX(dsv);
442			}
443
444			char *
445	0		Perl_sv_peek(pTHX_ SV *sv)
446			{
447			dVAR;
448	0		SV * const t = sv_newmortal();
449			int unref = 0;
450			U32 type;
451
452	0		sv_setpvs(t, "");
453			retry:
454	0	0	if (!sv) {
455	0		sv_catpv(t, "VOID");
456	0		goto finish;
457			}
458	0	0	else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
		0
459			/* detect data corruption under memory poisoning */
460	0		sv_catpv(t, "WILD");
461	0		goto finish;
462			}
463	0	0	else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
		0
		0
		0
464	0	0	if (sv == &PL_sv_undef) {
465	0		sv_catpv(t, "SV_UNDEF");
466	0	0	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
467	0		SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
468			SvREADONLY(sv))
469			goto finish;
470			}
471	0	0	else if (sv == &PL_sv_no) {
472	0		sv_catpv(t, "SV_NO");
473	0	0	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
474	0	0	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
475	0		!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
476	0	0	SVp_POK\|SVp_NOK)) &&
477	0	0	SvCUR(sv) == 0 &&
478	0		SvNVX(sv) == 0.0)
479			goto finish;
480			}
481	0	0	else if (sv == &PL_sv_yes) {
482	0		sv_catpv(t, "SV_YES");
483	0	0	if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
484	0	0	SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
485	0		!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
486	0	0	SVp_POK\|SVp_NOK)) &&
487	0	0	SvCUR(sv) == 1 &&
488	0	0	SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
		0
489	0		SvNVX(sv) == 1.0)
490			goto finish;
491			}
492			else {
493	0		sv_catpv(t, "SV_PLACEHOLDER");
494	0	0	if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
495	0		SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
496			SvREADONLY(sv))
497			goto finish;
498			}
499	0		sv_catpv(t, ":");
500			}
501	0	0	else if (SvREFCNT(sv) == 0) {
502	0		sv_catpv(t, "(");
503	0		unref++;
504			}
505	0	0	else if (DEBUG_R_TEST_) {
506			int is_tmp = 0;
507			SSize_t ix;
508			/* is this SV on the tmps stack? */
509	0	0	for (ix=PL_tmps_ix; ix>=0; ix--) {
510	0	0	if (PL_tmps_stack[ix] == sv) {
511			is_tmp = 1;
512			break;
513			}
514			}
515	0	0	if (SvREFCNT(sv) > 1)
516	0	0	Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
517			is_tmp ? "T" : "");
518	0	0	else if (is_tmp)
519	0		sv_catpv(t, "");
520			}
521
522	0	0	if (SvROK(sv)) {
523	0		sv_catpv(t, "\\");
524	0	0	if (SvCUR(t) + unref > 10) {
525	0		SvCUR_set(t, unref + 3);
526	0		*SvEND(t) = '\0';
527	0		sv_catpv(t, "...");
528	0		goto finish;
529			}
530	0		sv = SvRV(sv);
531	0		goto retry;
532			}
533	0		type = SvTYPE(sv);
534	0	0	if (type == SVt_PVCV) {
535	0	0	Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
536	0		goto finish;
537	0	0	} else if (type < SVt_LAST) {
538	0		sv_catpv(t, svshorttypenames[type]);
539
540	0	0	if (type == SVt_NULL)
541			goto finish;
542			} else {
543	0		sv_catpv(t, "FREED");
544	0		goto finish;
545			}
546
547	0	0	if (SvPOKp(sv)) {
548	0	0	if (!SvPVX_const(sv))
549	0		sv_catpv(t, "(null)");
550			else {
551	0		SV * const tmp = newSVpvs("");
552	0		sv_catpv(t, "(");
553	0	0	if (SvOOK(sv)) {
554			STRLEN delta;
555	0	0	SvOOK_offset(sv, delta);
		0
556	0		Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
557			}
558	0		Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
559	0	0	if (SvUTF8(sv))
560	0		Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
561	0		sv_uni_display(tmp, sv, 6 * SvCUR(sv),
562			UNI_DISPLAY_QQ));
563	0		SvREFCNT_dec_NN(tmp);
564			}
565			}
566	0	0	else if (SvNOKp(sv)) {
567	0	0	STORE_NUMERIC_LOCAL_SET_STANDARD();
		0
		0
		0
		0
568	0		Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
569	0	0	RESTORE_NUMERIC_LOCAL();
570			}
571	0	0	else if (SvIOKp(sv)) {
572	0	0	if (SvIsUV(sv))
573	0		Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
574			else
575	0		Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
576			}
577			else
578	0		sv_catpv(t, "()");
579
580			finish:
581	0	0	while (unref--)
582	0		sv_catpv(t, ")");
583	0	0	if (TAINTING_get && SvTAINTED(sv))
		0
		0
584	0		sv_catpv(t, " [tainted]");
585	0	0	return SvPV_nolen(t);
586			}
587
588			void
589	0		Perl_do_pmop_dump(pTHX_ I32 level, PerlIO file, const PMOP pm)
590			{
591			char ch;
592
593			PERL_ARGS_ASSERT_DO_PMOP_DUMP;
594
595	0	0	if (!pm) {
596	0		Perl_dump_indent(aTHX_ level, file, "{}\n");
597	0		return;
598			}
599	0		Perl_dump_indent(aTHX_ level, file, "{\n");
600	0		level++;
601	0	0	if (pm->op_pmflags & PMf_ONCE)
602			ch = '?';
603			else
604			ch = '/';
605	0	0	if (PM_GETRE(pm))
606	0	0	Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
607	0		ch, RX_PRECOMP(PM_GETRE(pm)), ch,
608	0		(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
609			else
610	0		Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
611	0	0	if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
		0
612	0		Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
613	0		op_dump(pm->op_pmreplrootu.op_pmreplroot);
614			}
615	0	0	if (pm->op_code_list) {
616	0	0	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
617	0		Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
618	0		do_op_dump(level, file, pm->op_code_list);
619			}
620			else
621	0		Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
622	0		PTR2UV(pm->op_code_list));
623			}
624	0	0	if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
		0
		0
625	0		SV * const tmpsv = pm_description(pm);
626	0	0	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
627	0		SvREFCNT_dec_NN(tmpsv);
628			}
629
630	0		Perl_dump_indent(aTHX_ level-1, file, "}\n");
631			}
632
633			const struct flag_to_name pmflags_flags_names[] = {
634			{PMf_CONST, ",CONST"},
635			{PMf_KEEP, ",KEEP"},
636			{PMf_GLOBAL, ",GLOBAL"},
637			{PMf_CONTINUE, ",CONTINUE"},
638			{PMf_RETAINT, ",RETAINT"},
639			{PMf_EVAL, ",EVAL"},
640			{PMf_NONDESTRUCT, ",NONDESTRUCT"},
641			{PMf_HAS_CV, ",HAS_CV"},
642			{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
643			{PMf_IS_QR, ",IS_QR"}
644			};
645
646			static SV *
647	0		S_pm_description(pTHX_ const PMOP *pm)
648			{
649	0		SV * const desc = newSVpvs("");
650	0		const REGEXP * const regex = PM_GETRE(pm);
651	0		const U32 pmflags = pm->op_pmflags;
652
653			PERL_ARGS_ASSERT_PM_DESCRIPTION;
654
655	0	0	if (pmflags & PMf_ONCE)
656	0		sv_catpv(desc, ",ONCE");
657			#ifdef USE_ITHREADS
658			if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
659			sv_catpv(desc, ":USED");
660			#else
661	0	0	if (pmflags & PMf_USED)
662	0		sv_catpv(desc, ":USED");
663			#endif
664
665	0	0	if (regex) {
666	0	0	if (RX_ISTAINTED(regex))
667	0		sv_catpv(desc, ",TAINTED");
668	0	0	if (RX_CHECK_SUBSTR(regex)) {
669	0	0	if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
670	0		sv_catpv(desc, ",SCANFIRST");
671	0	0	if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
672	0		sv_catpv(desc, ",ALL");
673			}
674	0	0	if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
675	0		sv_catpv(desc, ",SKIPWHITE");
676			}
677
678	0		append_flags(desc, pmflags, pmflags_flags_names);
679	0		return desc;
680			}
681
682			void
683	0		Perl_pmop_dump(pTHX_ PMOP *pm)
684			{
685	0		do_pmop_dump(0, Perl_debug_log, pm);
686	0		}
687
688			/* Return a unique integer to represent the address of op o.
689			* If it already exists in PL_op_sequence, just return it;
690			* otherwise add it.
691			* *** Note that this isn't thread-safe */
692
693			STATIC UV
694	0		S_sequence_num(pTHX_ const OP *o)
695			{
696			dVAR;
697			SV *op,
698			**seq;
699			const char *key;
700			STRLEN len;
701	0	0	if (!o)
702			return 0;
703	0		op = newSVuv(PTR2UV(o));
704	0		sv_2mortal(op);
705	0	0	key = SvPV_const(op, len);
706	0	0	if (!PL_op_sequence)
707	0		PL_op_sequence = newHV();
708	0		seq = hv_fetch(PL_op_sequence, key, len, 0);
709	0	0	if (seq)
710	0	0	return SvUV(*seq);
711	0		(void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
712	0		return PL_op_seq;
713			}
714
715			const struct flag_to_name op_flags_names[] = {
716			{OPf_KIDS, ",KIDS"},
717			{OPf_PARENS, ",PARENS"},
718			{OPf_REF, ",REF"},
719			{OPf_MOD, ",MOD"},
720			{OPf_STACKED, ",STACKED"},
721			{OPf_SPECIAL, ",SPECIAL"}
722			};
723
724			const struct flag_to_name op_trans_names[] = {
725			{OPpTRANS_FROM_UTF, ",FROM_UTF"},
726			{OPpTRANS_TO_UTF, ",TO_UTF"},
727			{OPpTRANS_IDENTICAL, ",IDENTICAL"},
728			{OPpTRANS_SQUASH, ",SQUASH"},
729			{OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
730			{OPpTRANS_GROWS, ",GROWS"},
731			{OPpTRANS_DELETE, ",DELETE"}
732			};
733
734			const struct flag_to_name op_entersub_names[] = {
735			{OPpENTERSUB_DB, ",DB"},
736			{OPpENTERSUB_HASTARG, ",HASTARG"},
737			{OPpENTERSUB_AMPER, ",AMPER"},
738			{OPpENTERSUB_NOPAREN, ",NOPAREN"},
739			{OPpENTERSUB_INARGS, ",INARGS"}
740			};
741
742			const struct flag_to_name op_const_names[] = {
743			{OPpCONST_NOVER, ",NOVER"},
744			{OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
745			{OPpCONST_STRICT, ",STRICT"},
746			{OPpCONST_ENTERED, ",ENTERED"},
747			{OPpCONST_FOLDED, ",FOLDED"},
748			{OPpCONST_BARE, ",BARE"}
749			};
750
751			const struct flag_to_name op_sort_names[] = {
752			{OPpSORT_NUMERIC, ",NUMERIC"},
753			{OPpSORT_INTEGER, ",INTEGER"},
754			{OPpSORT_REVERSE, ",REVERSE"},
755			{OPpSORT_INPLACE, ",INPLACE"},
756			{OPpSORT_DESCEND, ",DESCEND"},
757			{OPpSORT_QSORT, ",QSORT"},
758			{OPpSORT_STABLE, ",STABLE"}
759			};
760
761			const struct flag_to_name op_open_names[] = {
762			{OPpOPEN_IN_RAW, ",IN_RAW"},
763			{OPpOPEN_IN_CRLF, ",IN_CRLF"},
764			{OPpOPEN_OUT_RAW, ",OUT_RAW"},
765			{OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
766			};
767
768			const struct flag_to_name op_exit_names[] = {
769			{OPpEXIT_VMSISH, ",EXIT_VMSISH"},
770			{OPpHUSH_VMSISH, ",HUSH_VMSISH"}
771			};
772
773			const struct flag_to_name op_sassign_names[] = {
774			{OPpASSIGN_BACKWARDS, ",BACKWARDS"},
775			{OPpASSIGN_CV_TO_GV, ",CV2GV"}
776			};
777
778			#define OP_PRIVATE_ONCE(op, flag, name) \
779			const struct flag_to_name CAT2(op, _names)[] = { \
780			{(flag), (name)} \
781			}
782
783			OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
784			OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
785			OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
786			OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
787			OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
788			OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
789			OP_PRIVATE_ONCE(op_list, OPpLIST_GUESSED, ",GUESSED");
790			OP_PRIVATE_ONCE(op_delete, OPpSLICE, ",SLICE");
791			OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
792			OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
793			OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
794
795			struct op_private_by_op {
796			U16 op_type;
797			U16 len;
798			const struct flag_to_name *start;
799			};
800
801			const struct op_private_by_op op_private_names[] = {
802			{OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
803			{OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
804			{OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
805			{OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
806			{OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
807			{OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
808			{OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
809			{OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
810			{OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
811			{OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
812			{OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
813			{OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
814			{OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
815			{OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
816			{OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
817			{OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
818			{OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
819			{OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
820			{OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
821			{OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
822			{OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
823			};
824
825			static bool
826			S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
827			const struct op_private_by_op *start = op_private_names;
828			const struct op_private_by_op *const end
829			= op_private_names + C_ARRAY_LENGTH(op_private_names);
830
831			/* This is a linear search, but no worse than the code that it replaced.
832			It's debugging code - size is more important than speed. */
833			do {
834	0	0	if (optype == start->op_type) {
835	0		S_append_flags(aTHX_ tmpsv, op_private, start->start,
836	0		start->start + start->len);
837			return TRUE;
838			}
839	0	0	} while (++start < end);
840			return FALSE;
841			}
842
843			#define DUMP_OP_FLAGS(o,xml,level,file) \
844			if (o->op_flags \|\| o->op_slabbed \|\| o->op_savefree \|\| o->op_static) { \
845			SV * const tmpsv = newSVpvs(""); \
846			switch (o->op_flags & OPf_WANT) { \
847			case OPf_WANT_VOID: \
848			sv_catpv(tmpsv, ",VOID"); \
849			break; \
850			case OPf_WANT_SCALAR: \
851			sv_catpv(tmpsv, ",SCALAR"); \
852			break; \
853			case OPf_WANT_LIST: \
854			sv_catpv(tmpsv, ",LIST"); \
855			break; \
856			default: \
857			sv_catpv(tmpsv, ",UNKNOWN"); \
858			break; \
859			} \
860			append_flags(tmpsv, o->op_flags, op_flags_names); \
861			if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
862			if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
863			if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
864			if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED"); \
865			if (!xml) \
866			Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
867			SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
868			else \
869			PerlIO_printf(file, " flags=\"%s\"", \
870			SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
871			SvREFCNT_dec_NN(tmpsv); \
872			}
873
874			#if !defined(PERL_MAD)
875			# define xmldump_attr1(level, file, pat, arg)
876			#else
877			# define xmldump_attr1(level, file, pat, arg) \
878			S_xmldump_attr(aTHX_ level, file, pat, arg)
879			#endif
880
881			#define DUMP_OP_PRIVATE(o,xml,level,file) \
882			if (o->op_private) { \
883			U32 optype = o->op_type; \
884			U32 oppriv = o->op_private; \
885			SV * const tmpsv = newSVpvs(""); \
886			if (PL_opargs[optype] & OA_TARGLEX) { \
887			if (oppriv & OPpTARGET_MY) \
888			sv_catpv(tmpsv, ",TARGET_MY"); \
889			} \
890			else if (optype == OP_ENTERSUB \|\| \
891			optype == OP_RV2SV \|\| \
892			optype == OP_GVSV \|\| \
893			optype == OP_RV2AV \|\| \
894			optype == OP_RV2HV \|\| \
895			optype == OP_RV2GV \|\| \
896			optype == OP_AELEM \|\| \
897			optype == OP_HELEM ) \
898			{ \
899			if (optype == OP_ENTERSUB) { \
900			append_flags(tmpsv, oppriv, op_entersub_names); \
901			} \
902			else { \
903			switch (oppriv & OPpDEREF) { \
904			case OPpDEREF_SV: \
905			sv_catpv(tmpsv, ",SV"); \
906			break; \
907			case OPpDEREF_AV: \
908			sv_catpv(tmpsv, ",AV"); \
909			break; \
910			case OPpDEREF_HV: \
911			sv_catpv(tmpsv, ",HV"); \
912			break; \
913			} \
914			if (oppriv & OPpMAYBE_LVSUB) \
915			sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
916			} \
917			if (optype == OP_AELEM \|\| optype == OP_HELEM) { \
918			if (oppriv & OPpLVAL_DEFER) \
919			sv_catpv(tmpsv, ",LVAL_DEFER"); \
920			} \
921			else if (optype == OP_RV2HV \|\| optype == OP_PADHV) { \
922			if (oppriv & OPpMAYBE_TRUEBOOL) \
923			sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
924			if (oppriv & OPpTRUEBOOL) \
925			sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
926			} \
927			else { \
928			if (oppriv & HINT_STRICT_REFS) \
929			sv_catpv(tmpsv, ",STRICT_REFS"); \
930			if (oppriv & OPpOUR_INTRO) \
931			sv_catpv(tmpsv, ",OUR_INTRO"); \
932			} \
933			} \
934			else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
935			} \
936			else if (OP_IS_FILETEST(o->op_type)) { \
937			if (oppriv & OPpFT_ACCESS) \
938			sv_catpv(tmpsv, ",FT_ACCESS"); \
939			if (oppriv & OPpFT_STACKED) \
940			sv_catpv(tmpsv, ",FT_STACKED"); \
941			if (oppriv & OPpFT_STACKING) \
942			sv_catpv(tmpsv, ",FT_STACKING"); \
943			if (oppriv & OPpFT_AFTER_t) \
944			sv_catpv(tmpsv, ",AFTER_t"); \
945			} \
946			else if (o->op_type == OP_AASSIGN) { \
947			if (oppriv & OPpASSIGN_COMMON) \
948			sv_catpvs(tmpsv, ",COMMON"); \
949			if (oppriv & OPpMAYBE_LVSUB) \
950			sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
951			} \
952			if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
953			sv_catpv(tmpsv, ",INTRO"); \
954			if (o->op_type == OP_PADRANGE) \
955			Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
956			(UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
957			if (SvCUR(tmpsv)) { \
958			if (xml) \
959			xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
960			else \
961			Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
962			} else if (!xml) \
963			Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
964			(UV)oppriv); \
965			SvREFCNT_dec_NN(tmpsv); \
966			}
967
968
969			void
970	0		Perl_do_op_dump(pTHX_ I32 level, PerlIO file, const OP o)
971			{
972			dVAR;
973			UV seq;
974	0		const OPCODE optype = o->op_type;
975
976			PERL_ARGS_ASSERT_DO_OP_DUMP;
977
978	0		Perl_dump_indent(aTHX_ level, file, "{\n");
979	0		level++;
980	0		seq = sequence_num(o);
981	0	0	if (seq)
982	0		PerlIO_printf(file, "%-4"UVuf, seq);
983			else
984	0		PerlIO_printf(file, "????");
985	0	0	PerlIO_printf(file,
986			"%*sTYPE = %s ===> ",
987	0	0	(int)(PL_dumpindent*level-4), "", OP_NAME(o));
988	0	0	if (o->op_next)
989	0	0	PerlIO_printf(file,
990	0		o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
991	0		sequence_num(o->op_next));
992			else
993	0		PerlIO_printf(file, "NULL\n");
994	0	0	if (o->op_targ) {
995	0	0	if (optype == OP_NULL) {
996	0		Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
997	0	0	if (o->op_targ == OP_NEXTSTATE) {
998	0	0	if (CopLINE(cCOPo))
999	0		Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1000	0		(UV)CopLINE(cCOPo));
1001	0	0	if (CopSTASHPV(cCOPo))
		0
		0
		0
		0
		0
		0
1002	0	0	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1003	0	0	CopSTASHPV(cCOPo));
		0
		0
		0
		0
		0
1004	0	0	if (CopLABEL(cCOPo))
1005	0		Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1006			CopLABEL(cCOPo));
1007			}
1008			}
1009			else
1010	0		Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
1011			}
1012			#ifdef DUMPADDR
1013			Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
1014			#endif
1015
1016	0	0	DUMP_OP_FLAGS(o,0,level,file);
		0
		0
		0
		0
		0
1017	0	0	DUMP_OP_PRIVATE(o,0,level,file);
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
1018
1019			#ifdef PERL_MAD
1020			if (PL_madskills && o->op_madprop) {
1021			SV * const tmpsv = newSVpvs("");
1022			MADPROP* mp = o->op_madprop;
1023			Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
1024			level++;
1025			while (mp) {
1026			const char tmp = mp->mad_key;
1027			sv_setpvs(tmpsv,"'");
1028			if (tmp)
1029			sv_catpvn(tmpsv, &tmp, 1);
1030			sv_catpv(tmpsv, "'=");
1031			switch (mp->mad_type) {
1032			case MAD_NULL:
1033			sv_catpv(tmpsv, "NULL");
1034			Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1035			break;
1036			case MAD_PV:
1037			sv_catpv(tmpsv, "<");
1038			sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
1039			sv_catpv(tmpsv, ">");
1040			Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1041			break;
1042			case MAD_OP:
1043			if ((OP*)mp->mad_val) {
1044			Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1045			do_op_dump(level, file, (OP*)mp->mad_val);
1046			}
1047			break;
1048			default:
1049			sv_catpv(tmpsv, "(UNK)");
1050			Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1051			break;
1052			}
1053			mp = mp->mad_next;
1054			}
1055			level--;
1056			Perl_dump_indent(aTHX_ level, file, "}\n");
1057
1058			SvREFCNT_dec_NN(tmpsv);
1059			}
1060			#endif
1061
1062	0		switch (optype) {
1063			case OP_AELEMFAST:
1064			case OP_GVSV:
1065			case OP_GV:
1066			#ifdef USE_ITHREADS
1067			Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
1068			#else
1069	0	0	if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
1070	0	0	if (cSVOPo->op_sv) {
1071	0		SV * const tmpsv = newSV(0);
1072	0		ENTER;
1073	0		SAVEFREESV(tmpsv);
1074			#ifdef PERL_MAD
1075			/* FIXME - is this making unwarranted assumptions about the
1076			UTF-8 cleanliness of the dump file handle? */
1077			SvUTF8_on(tmpsv);
1078			#endif
1079	0		gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
1080	0	0	Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
1081	0		SvPV_nolen_const(tmpsv));
1082	0		LEAVE;
1083			}
1084			else
1085	0		Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
1086			}
1087			#endif
1088			break;
1089			case OP_CONST:
1090			case OP_HINTSEVAL:
1091			case OP_METHOD_NAMED:
1092			#ifndef USE_ITHREADS
1093			/* with ITHREADS, consts are stored in the pad, and the right pad
1094			* may not be active here, so skip */
1095	0		Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
1096			#endif
1097	0		break;
1098			case OP_NEXTSTATE:
1099			case OP_DBSTATE:
1100	0	0	if (CopLINE(cCOPo))
1101	0		Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1102	0		(UV)CopLINE(cCOPo));
1103	0	0	if (CopSTASHPV(cCOPo))
		0
		0
		0
		0
		0
		0
1104	0	0	Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1105	0	0	CopSTASHPV(cCOPo));
		0
		0
		0
		0
		0
1106	0	0	if (CopLABEL(cCOPo))
1107	0		Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1108			CopLABEL(cCOPo));
1109			break;
1110			case OP_ENTERLOOP:
1111	0		Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
1112	0	0	if (cLOOPo->op_redoop)
1113	0		PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
1114			else
1115	0		PerlIO_printf(file, "DONE\n");
1116	0		Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
1117	0	0	if (cLOOPo->op_nextop)
1118	0		PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
1119			else
1120	0		PerlIO_printf(file, "DONE\n");
1121	0		Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
1122	0	0	if (cLOOPo->op_lastop)
1123	0		PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
1124			else
1125	0		PerlIO_printf(file, "DONE\n");
1126			break;
1127			case OP_COND_EXPR:
1128			case OP_RANGE:
1129			case OP_MAPWHILE:
1130			case OP_GREPWHILE:
1131			case OP_OR:
1132			case OP_AND:
1133	0		Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
1134	0	0	if (cLOGOPo->op_other)
1135	0		PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
1136			else
1137	0		PerlIO_printf(file, "DONE\n");
1138			break;
1139			case OP_PUSHRE:
1140			case OP_MATCH:
1141			case OP_QR:
1142			case OP_SUBST:
1143	0		do_pmop_dump(level, file, cPMOPo);
1144	0		break;
1145			case OP_LEAVE:
1146			case OP_LEAVEEVAL:
1147			case OP_LEAVESUB:
1148			case OP_LEAVESUBLV:
1149			case OP_LEAVEWRITE:
1150			case OP_SCOPE:
1151	0	0	if (o->op_private & OPpREFCOUNTED)
1152	0		Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1153			break;
1154			default:
1155			break;
1156			}
1157	0	0	if (o->op_flags & OPf_KIDS) {
1158			OP *kid;
1159	0	0	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
1160	0		do_op_dump(level, file, kid);
1161			}
1162	0		Perl_dump_indent(aTHX_ level-1, file, "}\n");
1163	0		}
1164
1165			void
1166	0		Perl_op_dump(pTHX_ const OP *o)
1167			{
1168			PERL_ARGS_ASSERT_OP_DUMP;
1169	0		do_op_dump(0, Perl_debug_log, o);
1170	0		}
1171
1172			void
1173	0		Perl_gv_dump(pTHX_ GV *gv)
1174			{
1175			SV *sv;
1176
1177			PERL_ARGS_ASSERT_GV_DUMP;
1178
1179	0	0	if (!gv) {
1180	0		PerlIO_printf(Perl_debug_log, "{}\n");
1181	0		return;
1182			}
1183	0		sv = sv_newmortal();
1184	0		PerlIO_printf(Perl_debug_log, "{\n");
1185	0		gv_fullname3(sv, gv, NULL);
1186	0		Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
1187	0	0	if (gv != GvEGV(gv)) {
1188	0		gv_efullname3(sv, GvEGV(gv), NULL);
1189	0		Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
1190			}
1191	0		PerlIO_putc(Perl_debug_log, '\n');
1192	0		Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
1193			}
1194
1195
1196			/* map magic types to the symbolic names
1197			* (with the PERL_MAGIC_ prefixed stripped)
1198			*/
1199
1200			static const struct { const char type; const char *name; } magic_names[] = {
1201			#include "mg_names.c"
1202			/* this null string terminates the list */
1203			{ 0, NULL },
1204			};
1205
1206			void
1207	0		Perl_do_magic_dump(pTHX_ I32 level, PerlIO file, const MAGIC mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1208			{
1209			PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1210
1211	0	0	for (; mg; mg = mg->mg_moremagic) {
1212	0		Perl_dump_indent(aTHX_ level, file,
1213			" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
1214	0	0	if (mg->mg_virtual) {
1215	0		const MGVTBL * const v = mg->mg_virtual;
1216	0	0	if (v >= PL_magic_vtables
1217	0	0	&& v < PL_magic_vtables + magic_vtable_max) {
1218	0		const U32 i = v - PL_magic_vtables;
1219	0		Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1220			}
1221			else
1222	0		Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
1223			}
1224			else
1225	0		Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
1226
1227	0	0	if (mg->mg_private)
1228	0		Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
1229
1230			{
1231			int n;
1232			const char *name = NULL;
1233	0	0	for (n = 0; magic_names[n].name; n++) {
1234	0	0	if (mg->mg_type == magic_names[n].type) {
1235	0		name = magic_names[n].name;
1236	0		break;
1237			}
1238			}
1239	0	0	if (name)
1240	0		Perl_dump_indent(aTHX_ level, file,
1241			" MG_TYPE = PERL_MAGIC_%s\n", name);
1242			else
1243	0		Perl_dump_indent(aTHX_ level, file,
1244	0		" MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1245			}
1246
1247	0	0	if (mg->mg_flags) {
1248	0		Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
1249	0	0	if (mg->mg_type == PERL_MAGIC_envelem &&
		0
1250	0		mg->mg_flags & MGf_TAINTEDDIR)
1251	0		Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
1252	0	0	if (mg->mg_type == PERL_MAGIC_regex_global &&
		0
1253	0		mg->mg_flags & MGf_MINMATCH)
1254	0		Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
1255	0	0	if (mg->mg_flags & MGf_REFCOUNTED)
1256	0		Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
1257	0	0	if (mg->mg_flags & MGf_GSKIP)
1258	0		Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
1259	0	0	if (mg->mg_flags & MGf_COPY)
1260	0		Perl_dump_indent(aTHX_ level, file, " COPY\n");
1261	0	0	if (mg->mg_flags & MGf_DUP)
1262	0		Perl_dump_indent(aTHX_ level, file, " DUP\n");
1263	0	0	if (mg->mg_flags & MGf_LOCAL)
1264	0		Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
1265	0	0	if (mg->mg_type == PERL_MAGIC_regex_global &&
		0
1266	0		mg->mg_flags & MGf_BYTES)
1267	0		Perl_dump_indent(aTHX_ level, file, " BYTES\n");
1268			}
1269	0	0	if (mg->mg_obj) {
1270	0		Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
1271	0		PTR2UV(mg->mg_obj));
1272	0	0	if (mg->mg_type == PERL_MAGIC_qr) {
1273	0		REGEXP* const re = (REGEXP *)mg->mg_obj;
1274	0		SV * const dsv = sv_newmortal();
1275	0		const char * const s
1276	0	0	= pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
1277			60, NULL, NULL,
1278			( PERL_PV_PRETTY_QUOTE \| PERL_PV_ESCAPE_RE \| PERL_PV_PRETTY_ELLIPSES \|
1279			(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
1280			);
1281	0		Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1282	0		Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
1283	0		(IV)RX_REFCNT(re));
1284			}
1285	0	0	if (mg->mg_flags & MGf_REFCOUNTED)
1286	0		do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1287			}
1288	0	0	if (mg->mg_len)
1289	0		Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
1290	0	0	if (mg->mg_ptr) {
1291	0		Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
1292	0	0	if (mg->mg_len >= 0) {
1293	0	0	if (mg->mg_type != PERL_MAGIC_utf8) {
1294	0		SV * const sv = newSVpvs("");
1295	0		PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1296	0		SvREFCNT_dec_NN(sv);
1297			}
1298			}
1299	0	0	else if (mg->mg_len == HEf_SVKEY) {
1300	0		PerlIO_puts(file, " => HEf_SVKEY\n");
1301	0		do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1302			maxnest, dumpops, pvlim); /* MG is already +1 */
1303	0		continue;
1304			}
1305	0	0	else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
		0
1306			else
1307	0		PerlIO_puts(
1308			file,
1309			" ???? - " __FILE__
1310			" does not know how to handle this MG_LEN"
1311			);
1312	0		PerlIO_putc(file, '\n');
1313			}
1314	0	0	if (mg->mg_type == PERL_MAGIC_utf8) {
1315	0		const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
1316	0	0	if (cache) {
1317			IV i;
1318	0	0	for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1319	0		Perl_dump_indent(aTHX_ level, file,
1320			" %2"IVdf": %"UVuf" -> %"UVuf"\n",
1321			i,
1322	0		(UV)cache[i * 2],
1323	0		(UV)cache[i * 2 + 1]);
1324			}
1325			}
1326			}
1327	0		}
1328
1329			void
1330	0		Perl_magic_dump(pTHX_ const MAGIC *mg)
1331			{
1332	0		do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
1333	0		}
1334
1335			void
1336	0		Perl_do_hv_dump(pTHX_ I32 level, PerlIO file, const char name, HV *sv)
1337			{
1338			const char *hvname;
1339
1340			PERL_ARGS_ASSERT_DO_HV_DUMP;
1341
1342	0		Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1343	0	0	if (sv && (hvname = HvNAME_get(sv)))
		0
		0
		0
		0
		0
		0
		0
1344	0		{
1345			/* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1346			name which quite legally could contain insane things like tabs, newlines, nulls or
1347			other scary crap - this should produce sane results - except maybe for unicode package
1348			names - but we will wait for someone to file a bug on that - demerphq */
1349	0		SV * const tmpsv = newSVpvs("");
1350	0	0	PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
		0
		0
		0
		0
		0
1351			}
1352			else
1353	0		PerlIO_putc(file, '\n');
1354	0		}
1355
1356			void
1357	0		Perl_do_gv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
1358			{
1359			PERL_ARGS_ASSERT_DO_GV_DUMP;
1360
1361	0		Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1362	0	0	if (sv && GvNAME(sv))
		0
1363	0		PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
1364			else
1365	0		PerlIO_putc(file, '\n');
1366	0		}
1367
1368			void
1369	0		Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO file, const char name, GV *sv)
1370			{
1371			PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1372
1373	0		Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1374	0	0	if (sv && GvNAME(sv)) {
		0
1375			const char *hvname;
1376	0		PerlIO_printf(file, "\t\"");
1377	0	0	if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
		0
		0
		0
		0
		0
		0
		0
1378	0		PerlIO_printf(file, "%s\" :: \"", hvname);
1379	0		PerlIO_printf(file, "%s\"\n", GvNAME(sv));
1380			}
1381			else
1382	0		PerlIO_putc(file, '\n');
1383	0		}
1384
1385			const struct flag_to_name first_sv_flags_names[] = {
1386			{SVs_TEMP, "TEMP,"},
1387			{SVs_OBJECT, "OBJECT,"},
1388			{SVs_GMG, "GMG,"},
1389			{SVs_SMG, "SMG,"},
1390			{SVs_RMG, "RMG,"},
1391			{SVf_IOK, "IOK,"},
1392			{SVf_NOK, "NOK,"},
1393			{SVf_POK, "POK,"}
1394			};
1395
1396			const struct flag_to_name second_sv_flags_names[] = {
1397			{SVf_OOK, "OOK,"},
1398			{SVf_FAKE, "FAKE,"},
1399			{SVf_READONLY, "READONLY,"},
1400			{SVf_IsCOW, "IsCOW,"},
1401			{SVf_BREAK, "BREAK,"},
1402			{SVf_AMAGIC, "OVERLOAD,"},
1403			{SVp_IOK, "pIOK,"},
1404			{SVp_NOK, "pNOK,"},
1405			{SVp_POK, "pPOK,"}
1406			};
1407
1408			const struct flag_to_name cv_flags_names[] = {
1409			{CVf_ANON, "ANON,"},
1410			{CVf_UNIQUE, "UNIQUE,"},
1411			{CVf_CLONE, "CLONE,"},
1412			{CVf_CLONED, "CLONED,"},
1413			{CVf_CONST, "CONST,"},
1414			{CVf_NODEBUG, "NODEBUG,"},
1415			{CVf_LVALUE, "LVALUE,"},
1416			{CVf_METHOD, "METHOD,"},
1417			{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
1418			{CVf_CVGV_RC, "CVGV_RC,"},
1419			{CVf_DYNFILE, "DYNFILE,"},
1420			{CVf_AUTOLOAD, "AUTOLOAD,"},
1421			{CVf_HASEVAL, "HASEVAL"},
1422			{CVf_SLABBED, "SLABBED,"},
1423			{CVf_ISXSUB, "ISXSUB,"}
1424			};
1425
1426			const struct flag_to_name hv_flags_names[] = {
1427			{SVphv_SHAREKEYS, "SHAREKEYS,"},
1428			{SVphv_LAZYDEL, "LAZYDEL,"},
1429			{SVphv_HASKFLAGS, "HASKFLAGS,"},
1430			{SVphv_CLONEABLE, "CLONEABLE,"}
1431			};
1432
1433			const struct flag_to_name gp_flags_names[] = {
1434			{GVf_INTRO, "INTRO,"},
1435			{GVf_MULTI, "MULTI,"},
1436			{GVf_ASSUMECV, "ASSUMECV,"},
1437			{GVf_IN_PAD, "IN_PAD,"}
1438			};
1439
1440			const struct flag_to_name gp_flags_imported_names[] = {
1441			{GVf_IMPORTED_SV, " SV"},
1442			{GVf_IMPORTED_AV, " AV"},
1443			{GVf_IMPORTED_HV, " HV"},
1444			{GVf_IMPORTED_CV, " CV"},
1445			};
1446
1447			const struct flag_to_name regexp_flags_names[] = {
1448			{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1449			{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1450			{RXf_PMf_FOLD, "PMf_FOLD,"},
1451			{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1452			{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
1453			{RXf_ANCH_BOL, "ANCH_BOL,"},
1454			{RXf_ANCH_MBOL, "ANCH_MBOL,"},
1455			{RXf_ANCH_SBOL, "ANCH_SBOL,"},
1456			{RXf_ANCH_GPOS, "ANCH_GPOS,"},
1457			{RXf_GPOS_SEEN, "GPOS_SEEN,"},
1458			{RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
1459			{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
1460			{RXf_EVAL_SEEN, "EVAL_SEEN,"},
1461			{RXf_CANY_SEEN, "CANY_SEEN,"},
1462			{RXf_NOSCAN, "NOSCAN,"},
1463			{RXf_CHECK_ALL, "CHECK_ALL,"},
1464			{RXf_MATCH_UTF8, "MATCH_UTF8,"},
1465			{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1466			{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1467			{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
1468			{RXf_SPLIT, "SPLIT,"},
1469			{RXf_COPY_DONE, "COPY_DONE,"},
1470			{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1471			{RXf_TAINTED, "TAINTED,"},
1472			{RXf_START_ONLY, "START_ONLY,"},
1473			{RXf_SKIPWHITE, "SKIPWHITE,"},
1474			{RXf_WHITE, "WHITE,"},
1475			{RXf_NULL, "NULL,"},
1476			};
1477
1478			void
1479	264		Perl_do_sv_dump(pTHX_ I32 level, PerlIO file, SV sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1480			{
1481			dVAR;
1482			SV *d;
1483			const char *s;
1484			U32 flags;
1485			U32 type;
1486
1487			PERL_ARGS_ASSERT_DO_SV_DUMP;
1488
1489	264	50	if (!sv) {
1490	0		Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
1491	0		return;
1492			}
1493
1494	264		flags = SvFLAGS(sv);
1495	264		type = SvTYPE(sv);
1496
1497			/* process general SV flags */
1498
1499	396		d = Perl_newSVpvf(aTHX_
1500			"(0x%"UVxf") at 0x%"UVxf"\n%s REFCNT = %"IVdf"\n%s FLAGS = (",
1501	264		PTR2UV(SvANY(sv)), PTR2UV(sv),
1502	264		(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1503			(int)(PL_dumpindent*level), "");
1504
1505	264	50	if (!((flags & SVpad_NAME) == SVpad_NAME
		0
1506	0		&& (type == SVt_PVMG \|\| type == SVt_PVNV))) {
1507	264	50	if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1508	0		sv_catpv(d, "PADSTALE,");
1509			}
1510	264	50	if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
1511	264	50	if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1512	0		sv_catpv(d, "PADTMP,");
1513	264	100	if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1514			}
1515	264		append_flags(d, flags, first_sv_flags_names);
1516	264	100	if (flags & SVf_ROK) {
1517	52		sv_catpv(d, "ROK,");
1518	52	50	if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1519			}
1520	264		append_flags(d, flags, second_sv_flags_names);
1521	264	50	if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
		0
		0
1522	0	0	&& type != SVt_PVAV) {
1523	0	0	if (SvPCS_IMPORTED(sv))
1524	0		sv_catpv(d, "PCS_IMPORTED,");
1525			else
1526	0		sv_catpv(d, "SCREAM,");
1527			}
1528
1529			/* process type-specific SV flags */
1530
1531	264		switch (type) {
1532			case SVt_PVCV:
1533			case SVt_PVFM:
1534	0		append_flags(d, CvFLAGS(sv), cv_flags_names);
1535	0		break;
1536			case SVt_PVHV:
1537	52		append_flags(d, flags, hv_flags_names);
1538	52		break;
1539			case SVt_PVGV:
1540			case SVt_PVLV:
1541	0	0	if (isGV_with_GP(sv)) {
		0
1542	0		append_flags(d, GvFLAGS(sv), gp_flags_names);
1543			}
1544	0	0	if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
		0
		0
1545	0		sv_catpv(d, "IMPORT");
1546	0	0	if (GvIMPORTED(sv) == GVf_IMPORTED)
1547	0		sv_catpv(d, "ALL,");
1548			else {
1549	0		sv_catpv(d, "(");
1550	0		append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
1551	0		sv_catpv(d, " ),");
1552			}
1553			}
1554			/* FALL THROUGH */
1555			default:
1556			evaled_or_uv:
1557	212	50	if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
1558	212	50	if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
		0
1559			break;
1560			case SVt_PVMG:
1561	4	50	if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1562	4	50	if (SvVALID(sv)) sv_catpv(d, "VALID,");
1563	4	50	if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
1564	4	50	if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
1565			/* FALL THROUGH */
1566			case SVt_PVNV:
1567	4	50	if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1568			goto evaled_or_uv;
1569			case SVt_PVAV:
1570	0	0	if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
1571			break;
1572			}
1573			/* SVphv_SHAREKEYS is also 0x20000000 */
1574	264	100	if ((type != SVt_PVHV) && SvUTF8(sv))
		50
1575	0		sv_catpv(d, "UTF8");
1576
1577	264	50	if (*(SvEND(d) - 1) == ',') {
1578	264		SvCUR_set(d, SvCUR(d) - 1);
1579	264		SvPVX(d)[SvCUR(d)] = '\0';
1580			}
1581	264		sv_catpv(d, ")");
1582	264		s = SvPVX_const(d);
1583
1584			/* dump initial SV details */
1585
1586			#ifdef DEBUG_LEAKING_SCALARS
1587			Perl_dump_indent(aTHX_ level, file,
1588			"ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
1589			sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1590			sv->sv_debug_line,
1591			sv->sv_debug_inpad ? "for" : "by",
1592			sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1593			PTR2UV(sv->sv_debug_parent),
1594			sv->sv_debug_serial
1595			);
1596			#endif
1597	264		Perl_dump_indent(aTHX_ level, file, "SV = ");
1598
1599			/* Dump SV type */
1600
1601	264	50	if (type < SVt_LAST) {
1602	264		PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1603
1604	264	50	if (type == SVt_NULL) {
1605	0		SvREFCNT_dec_NN(d);
1606	0		return;
1607			}
1608			} else {
1609	0		PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
1610	0		SvREFCNT_dec_NN(d);
1611	0		return;
1612			}
1613
1614			/* Dump general SV fields */
1615
1616	264	100	if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1617	56	100	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
		50
1618	4	50	&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
		50
		0
		50
1619	260	100	\|\| (type == SVt_IV && !SvROK(sv))) {
		100
1620	160	50	if (SvIsUV(sv)
1621			#ifdef PERL_OLD_COPY_ON_WRITE
1622			\|\| SvIsCOW(sv)
1623			#endif
1624			)
1625	0		Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
1626			else
1627	160		Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
1628			#ifdef PERL_OLD_COPY_ON_WRITE
1629			if (SvIsCOW_shared_hash(sv))
1630			PerlIO_printf(file, " (HASH)");
1631			else if (SvIsCOW_normal(sv))
1632			PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1633			#endif
1634	160		PerlIO_putc(file, '\n');
1635			}
1636
1637	264	100	if ((type == SVt_PVNV \|\| type == SVt_PVMG)
1638	4	50	&& (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
1639	0		Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1640	0		(UV) COP_SEQ_RANGE_LOW(sv));
1641	0		Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1642	0		(UV) COP_SEQ_RANGE_HIGH(sv));
1643	264	100	} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
1644	56	100	&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
		50
1645	4	50	&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
		50
		0
		50
1646	260	50	\|\| type == SVt_NV) {
1647	4	50	STORE_NUMERIC_LOCAL_SET_STANDARD();
		0
		0
		0
		50
1648			/* %Vg doesn't work? --jhi */
1649			#ifdef USE_LONG_DOUBLE
1650			Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
1651			#else
1652	4		Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
1653			#endif
1654	4	50	RESTORE_NUMERIC_LOCAL();
1655			}
1656
1657	264	100	if (SvROK(sv)) {
1658	52		Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
1659	52	50	if (nest < maxnest)
1660	52		do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
1661			}
1662
1663	264	100	if (type < SVt_PV) {
1664	208		SvREFCNT_dec_NN(d);
1665	208		return;
1666			}
1667
1668	56	100	if ((type <= SVt_PVLV && !isGV_with_GP(sv))
		50
		0
1669	52	50	\|\| (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
		0
1670	4	50	const bool re = isREGEXP(sv);
		50
1671			const char * const ptr =
1672	4	50	re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1673	4	50	if (ptr) {
1674			STRLEN delta;
1675	4	50	if (SvOOK(sv)) {
1676	0	0	SvOOK_offset(sv, delta);
		0
1677	0		Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
1678			(UV) delta);
1679			} else {
1680	4		delta = 0;
1681			}
1682	4		Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
1683	4	50	if (SvOOK(sv)) {
1684	0		PerlIO_printf(file, "( %s . ) ",
1685	0		pv_display(d, ptr - delta, delta, 0,
1686			pvlim));
1687			}
1688	4	50	if (type == SVt_INVLIST) {
1689	0		PerlIO_printf(file, "\n");
1690			/* 4 blanks indents 2 beyond the PV, etc */
1691	0		_invlist_dump(file, level, " ", sv);
1692			}
1693			else {
1694	4	50	PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1695			re ? 0 : SvLEN(sv),
1696			pvlim));
1697	4	50	if (SvUTF8(sv)) /* the 6? \x{....} */
1698	0		PerlIO_printf(file, " [UTF8 \"%s\"]",
1699	0		sv_uni_display(d, sv, 6 * SvCUR(sv),
1700			UNI_DISPLAY_QQ));
1701	4		PerlIO_printf(file, "\n");
1702			}
1703	4		Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
1704	4	50	if (!re)
1705	4		Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1706	4		(IV)SvLEN(sv));
1707			#ifdef PERL_NEW_COPY_ON_WRITE
1708	4	50	if (SvIsCOW(sv) && SvLEN(sv))
		0
1709	0		Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1710	0		CowREFCNT(sv));
1711			#endif
1712			}
1713			else
1714	0		Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
1715			}
1716
1717	56	50	if (type >= SVt_PVMG) {
1718	56	100	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
		50
1719	0	0	HV * const ost = SvOURSTASH(sv);
1720	0	0	if (ost)
1721	0		do_hv_dump(level, file, " OURSTASH", ost);
1722	56	50	} else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
1723	0		Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
1724	0		(UV)PadnamelistMAXNAMED(sv));
1725			} else {
1726	56	50	if (SvMAGIC(sv))
1727	0		do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
1728			}
1729	56	50	if (SvSTASH(sv))
1730	0		do_hv_dump(level, file, " STASH", SvSTASH(sv));
1731
1732	56	100	if ((type == SVt_PVMG \|\| type == SVt_PVLV) && SvVALID(sv)) {
		50
1733	0		Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1734			}
1735			}
1736
1737			/* Dump type-specific SV fields */
1738
1739	56		switch (type) {
1740			case SVt_PVAV:
1741	0		Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
1742	0	0	if (AvARRAY(sv) != AvALLOC(sv)) {
1743	0		PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1744	0		Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
1745			}
1746			else
1747	0		PerlIO_putc(file, '\n');
1748	0		Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1749	0		Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
1750			/* arylen is stored in magic, and padnamelists use SvMAGIC for
1751			something else. */
1752	0	0	if (!AvPAD_NAMELIST(sv))
1753	0	0	Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
1754	0		SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
1755	0		sv_setpvs(d, "");
1756	0	0	if (AvREAL(sv)) sv_catpv(d, ",REAL");
1757	0	0	if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
1758	0	0	Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1759	0		SvCUR(d) ? SvPVX_const(d) + 1 : "");
1760	0	0	if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
		0
1761			SSize_t count;
1762	0	0	for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
		0
1763	0		SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
1764
1765	0		Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
1766	0	0	if (elt)
1767	0		do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1768			}
1769			}
1770			break;
1771			case SVt_PVHV:
1772	52		Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1773	52	50	if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
		50
		50
1774			/* Show distribution of HEs in the ARRAY */
1775			int freq[200];
1776			#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
1777			int i;
1778			int max = 0;
1779	52	50	U32 pow2 = 2, keys = HvUSEDKEYS(sv);
1780			NV theoret, sum = 0;
1781
1782	52		PerlIO_printf(file, " (");
1783			Zero(freq, FREQ_MAX + 1, int);
1784	1716	100	for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
1785			HE* h;
1786			int count = 0;
1787	3016	100	for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1788	1352		count++;
1789	1664	50	if (count > FREQ_MAX)
1790			count = FREQ_MAX;
1791	1664		freq[count]++;
1792	1664	100	if (max < count)
1793			max = count;
1794			}
1795	182	100	for (i = 0; i <= max; i++) {
1796	156	50	if (freq[i]) {
1797	156	50	PerlIO_printf(file, "%d%s:%d", i,
1798			(i == FREQ_MAX) ? "+" : "",
1799			freq[i]);
1800	156	100	if (i != max)
1801	104		PerlIO_printf(file, ", ");
1802			}
1803			}
1804	52		PerlIO_putc(file, ')');
1805			/* The "quality" of a hash is defined as the total number of
1806			comparisons needed to access every element once, relative
1807			to the expected number needed for a random hash.
1808
1809			The total number of comparisons is equal to the sum of
1810			the squares of the number of entries in each bucket.
1811			For a random hash of n keys into k buckets, the expected
1812			value is
1813			n + n(n-1)/2k
1814			*/
1815
1816	156	100	for (i = max; i > 0; i--) { /* Precision: count down. */
1817	104		sum += freq[i] * i * i;
1818			}
1819	260	100	while ((keys = keys >> 1))
1820	208		pow2 = pow2 << 1;
1821	52	50	theoret = HvUSEDKEYS(sv);
1822	52		theoret += theoret * (theoret-1)/pow2;
1823	52		PerlIO_putc(file, '\n');
1824	52		Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
1825			}
1826	52		PerlIO_putc(file, '\n');
1827	52	50	Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
1828			{
1829			STRLEN count = 0;
1830	52		HE **ents = HvARRAY(sv);
1831
1832	52	50	if (ents) {
1833	52		HE const const last = ents + HvMAX(sv);
1834	52		count = last + 1 - ents;
1835
1836			do {
1837	1664	100	if (!*ents)
1838	624		--count;
1839	1664	100	} while (++ents <= last);
1840			}
1841
1842	52	50	if (SvOOK(sv)) {
1843	52		struct xpvhv_aux *const aux = HvAUX(sv);
1844	52		Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1845			" (cached = %"UVuf")\n",
1846	52		(UV)count, (UV)aux->xhv_fill_lazy);
1847			} else {
1848	0		Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1849			(UV)count);
1850			}
1851			}
1852	52		Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
1853	52	50	if (SvOOK(sv)) {
1854	52	50	Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1855	52	50	Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
1856			#ifdef PERL_HASH_RANDOMIZE_KEYS
1857	52	50	Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1858	52	50	if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
		50
		50
		0
		0
1859	0	0	PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
1860			}
1861			#endif
1862	52		PerlIO_putc(file, '\n');
1863			}
1864			{
1865	52		MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
1866	52	50	if (mg && mg->mg_obj) {
		0
1867	0		Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1868			}
1869			}
1870			{
1871	52	50	const char * const hvname = HvNAME_get(sv);
		50
		0
		0
		0
		0
1872	52	50	if (hvname)
1873	0		Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
1874			}
1875	52	50	if (SvOOK(sv)) {
1876	52		AV * const backrefs
1877	52		= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
1878	52		struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
1879	52	50	if (HvAUX(sv)->xhv_name_count)
1880	0		Perl_dump_indent(aTHX_
1881			level, file, " NAMECOUNT = %"IVdf"\n",
1882	0		(IV)HvAUX(sv)->xhv_name_count
1883			);
1884	52	50	if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
		0
		0
		0
		0
		0
1885	0		const I32 count = HvAUX(sv)->xhv_name_count;
1886	0	0	if (count) {
1887	0		SV * const names = newSVpvs_flags("", SVs_TEMP);
1888			/* The starting point is the first element if count is
1889			positive and the second element if count is negative. */
1890	0		HEK const hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1891	0	0	+ (count < 0 ? 1 : 0);
1892	0		HEK const const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1893	0	0	+ (count < 0 ? -count : count);
1894	0	0	while (hekp < endp) {
1895	0	0	if (*hekp) {
1896	0		sv_catpvs(names, ", \"");
1897	0		sv_catpvn(names, HEK_KEY(hekp), HEK_LEN(hekp));
1898	0		sv_catpvs(names, "\"");
1899			} else {
1900			/* This should never happen. */
1901	0		sv_catpvs(names, ", (null)");
1902			}
1903	0		++hekp;
1904			}
1905	0	0	Perl_dump_indent(aTHX_
1906	0		level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1907			);
1908			}
1909			else
1910	0	0	Perl_dump_indent(aTHX_
1911	0	0	level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
		0
		0
		0
		0
1912			);
1913			}
1914	52	50	if (backrefs) {
1915	0		Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1916			PTR2UV(backrefs));
1917	0		do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
1918			dumpops, pvlim);
1919			}
1920	52	50	if (meta) {
1921			/* FIXME - mro_algs kflags can signal a UTF-8 name. */
1922	0		Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
1923	0		(int)meta->mro_which->length,
1924	0		meta->mro_which->name,
1925	0		PTR2UV(meta->mro_which));
1926	0		Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1927	0		(UV)meta->cache_gen);
1928	0		Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
1929	0		(UV)meta->pkg_gen);
1930	0	0	if (meta->mro_linear_all) {
1931	0		Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
1932	0		PTR2UV(meta->mro_linear_all));
1933	0		do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1934			dumpops, pvlim);
1935			}
1936	0	0	if (meta->mro_linear_current) {
1937	0		Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1938	0		PTR2UV(meta->mro_linear_current));
1939	0		do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1940			dumpops, pvlim);
1941			}
1942	0	0	if (meta->mro_nextmethod) {
1943	0		Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
1944	0		PTR2UV(meta->mro_nextmethod));
1945	0		do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1946			dumpops, pvlim);
1947			}
1948	0	0	if (meta->isa) {
1949	0		Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
1950	0		PTR2UV(meta->isa));
1951	0		do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1952			dumpops, pvlim);
1953			}
1954			}
1955			}
1956	52	50	if (nest < maxnest) {
1957			HV * const hv = MUTABLE_HV(sv);
1958			STRLEN i;
1959			HE *he;
1960
1961	52	50	if (HvARRAY(hv)) {
1962	52		int count = maxnest - nest;
1963	260	50	for (i=0; i <= HvMAX(hv); i++) {
1964	416	100	for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1965			U32 hash;
1966			SV * keysv;
1967			const char * keypv;
1968			SV * elt;
1969			STRLEN len;
1970
1971	208	100	if (count-- <= 0) goto DONEHV;
1972
1973	156		hash = HeHASH(he);
1974	156		keysv = hv_iterkeysv(he);
1975	156	50	keypv = SvPV_const(keysv, len);
1976	156		elt = HeVAL(he);
1977
1978	156		Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1979	156	50	if (SvUTF8(keysv))
1980	0		PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
1981	156	50	if (HvEITER_get(hv) == he)
		100
1982	6		PerlIO_printf(file, "[CURRENT] ");
1983	156		PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1984	156		do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1985			}
1986			}
1987			DONEHV:;
1988			}
1989			}
1990			break;
1991
1992			case SVt_PVCV:
1993	0	0	if (CvAUTOLOAD(sv)) {
1994			STRLEN len;
1995	0	0	const char *const name = SvPV_const(sv, len);
1996	0		Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%.*s\"\n",
1997			(int) len, name);
1998			}
1999	0	0	if (SvPOK(sv)) {
2000	0	0	Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
		0
		0
2001	0	0	(int) CvPROTOLEN(sv), CvPROTO(sv));
		0
		0
2002			}
2003			/* FALL THROUGH */
2004			case SVt_PVFM:
2005	0		do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
2006	0	0	if (!CvISXSUB(sv)) {
2007	0	0	if (CvSTART(sv)) {
2008	0		Perl_dump_indent(aTHX_ level, file,
2009			" START = 0x%"UVxf" ===> %"IVdf"\n",
2010	0		PTR2UV(CvSTART(sv)),
2011	0		(IV)sequence_num(CvSTART(sv)));
2012			}
2013	0		Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
2014	0		PTR2UV(CvROOT(sv)));
2015	0	0	if (CvROOT(sv) && dumpops) {
		0
2016	0		do_op_dump(level+1, file, CvROOT(sv));
2017			}
2018			} else {
2019	0		SV * const constant = cv_const_sv((const CV *)sv);
2020
2021	0		Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
2022
2023	0	0	if (constant) {
2024	0		Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
2025			" (CONST SV)\n",
2026	0		PTR2UV(CvXSUBANY(sv).any_ptr));
2027	0		do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2028			pvlim);
2029			} else {
2030	0		Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
2031	0		(IV)CvXSUBANY(sv).any_i32);
2032			}
2033			}
2034	0	0	if (CvNAMED(sv))
2035	0		Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2036	0		HEK_KEY(CvNAME_HEK((CV *)sv)));
2037	0		else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
2038	0		Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
2039	0		Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
2040	0		Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
2041	0		Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
2042	0		Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
2043	0	0	if (nest < maxnest) {
2044	0		do_dump_pad(level+1, file, CvPADLIST(sv), 0);
2045			}
2046			{
2047	0		const CV * const outside = CvOUTSIDE(sv);
2048	0	0	Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
2049			PTR2UV(outside),
2050			(!outside ? "null"
2051	0		: CvANON(outside) ? "ANON"
2052	0	0	: (outside == PL_main_cv) ? "MAIN"
2053	0	0	: CvUNIQUE(outside) ? "UNIQUE"
2054	0	0	: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
		0
2055			}
2056	0	0	if (nest < maxnest && (CvCLONE(sv) \|\| CvCLONED(sv)))
		0
		0
2057	0		do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
2058			break;
2059
2060			case SVt_PVGV:
2061			case SVt_PVLV:
2062	0	0	if (type == SVt_PVLV) {
2063	0		Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2064	0		Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2065	0		Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2066	0		Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
2067	0		Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
2068	0	0	if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2069	0		do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2070			dumpops, pvlim);
2071			}
2072	0	0	if (isREGEXP(sv)) goto dumpregexp;
		0
2073	0	0	if (!isGV_with_GP(sv))
		0
2074			break;
2075	0		Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
2076	0		Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
2077	0		do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
2078	0		Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
2079	0	0	if (!GvGP(sv))
2080			break;
2081	0		Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2082	0		Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2083	0		Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2084	0		Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2085	0		Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2086	0		Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2087	0		Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2088	0		Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
2089	0		Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
2090	0	0	Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
2091	0		Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
2092	0		do_gv_dump (level, file, " EGV", GvEGV(sv));
2093	0		break;
2094			case SVt_PVIO:
2095	0		Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2096	0		Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2097	0		Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2098	0		Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2099	0		Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2100	0		Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2101	0		Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
2102	0	0	if (IoTOP_NAME(sv))
2103	0		Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
2104	0	0	if (!IoTOP_GV(sv) \|\| SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
		0
2105	0		do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2106			else {
2107	0		Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2108	0		PTR2UV(IoTOP_GV(sv)));
2109	0		do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2110			maxnest, dumpops, pvlim);
2111			}
2112			/* Source filters hide things that are not GVs in these three, so let's
2113			be careful out there. */
2114	0	0	if (IoFMT_NAME(sv))
2115	0		Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
2116	0	0	if (!IoFMT_GV(sv) \|\| SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
		0
2117	0		do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2118			else {
2119	0		Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2120	0		PTR2UV(IoFMT_GV(sv)));
2121	0		do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2122			maxnest, dumpops, pvlim);
2123			}
2124	0	0	if (IoBOTTOM_NAME(sv))
2125	0		Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
2126	0	0	if (!IoBOTTOM_GV(sv) \|\| SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
		0
2127	0		do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2128			else {
2129	0		Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2130	0		PTR2UV(IoBOTTOM_GV(sv)));
2131	0		do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2132			maxnest, dumpops, pvlim);
2133			}
2134	0	0	if (isPRINT(IoTYPE(sv)))
2135	0		Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
2136			else
2137	0		Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
2138	0		Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
2139	0		break;
2140			case SVt_REGEXP:
2141			dumpregexp:
2142			{
2143			struct regexp * const r = ReANY((REGEXP*)sv);
2144			#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
2145			sv_setpv(d,""); \
2146			append_flags(d, flags, regexp_flags_names); \
2147			if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2148			SvCUR_set(d, SvCUR(d) - 1); \
2149			SvPVX(d)[SvCUR(d)] = '\0'; \
2150			} \
2151			} STMT_END
2152	0	0	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
		0
2153	0		Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2154	0		(UV)(r->compflags), SvPVX_const(d));
2155
2156	0	0	SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
		0
2157	0		Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
2158	0		(UV)(r->extflags), SvPVX_const(d));
2159			#undef SV_SET_STRINGIFY_REGEXP_FLAGS
2160
2161	0		Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
2162	0		(UV)(r->intflags));
2163	0		Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2164	0		(UV)(r->nparens));
2165	0		Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2166	0		(UV)(r->lastparen));
2167	0		Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2168	0		(UV)(r->lastcloseparen));
2169	0		Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2170			(IV)(r->minlen));
2171	0		Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2172			(IV)(r->minlenret));
2173	0		Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2174			(UV)(r->gofs));
2175	0		Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2176	0		(UV)(r->pre_prefix));
2177	0		Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2178			(IV)(r->sublen));
2179	0		Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2180			(IV)(r->suboffset));
2181	0		Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2182			(IV)(r->subcoffset));
2183	0	0	if (r->subbeg)
2184	0		Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2185	0		PTR2UV(r->subbeg),
2186	0		pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2187			else
2188	0		Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
2189	0		Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
2190	0		PTR2UV(r->engine));
2191	0		Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2192	0		PTR2UV(r->mother_re));
2193	0	0	if (nest < maxnest && r->mother_re)
		0
2194	0		do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2195			maxnest, dumpops, pvlim);
2196	0		Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2197	0		PTR2UV(r->paren_names));
2198	0		Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2199	0		PTR2UV(r->substrs));
2200	0		Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2201	0		PTR2UV(r->pprivate));
2202	0		Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2203	0		PTR2UV(r->offs));
2204	0		Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2205	0		PTR2UV(r->qr_anoncv));
2206			#ifdef PERL_ANY_COW
2207	0		Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2208	0		PTR2UV(r->saved_copy));
2209			#endif
2210			}
2211	0		break;
2212			}
2213	160		SvREFCNT_dec_NN(d);
2214			}
2215
2216			void
2217	0		Perl_sv_dump(pTHX_ SV *sv)
2218			{
2219			dVAR;
2220
2221			PERL_ARGS_ASSERT_SV_DUMP;
2222
2223	0	0	if (SvROK(sv))
2224	0		do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2225			else
2226	0		do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
2227	0		}
2228
2229			int
2230	0		Perl_runops_debug(pTHX)
2231			{
2232			dVAR;
2233	0	0	if (!PL_op) {
2234	0		Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2235	0		return 0;
2236			}
2237
2238			DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
2239			do {
2240			#ifdef PERL_TRACE_OPS
2241			++PL_op_exec_cnt[PL_op->op_type];
2242			#endif
2243	0	0	if (PL_debug) {
2244	0	0	if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
		0
2245	0		PerlIO_printf(Perl_debug_log,
2246			"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2247			PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2248	0		PTR2UV(*PL_watchaddr));
2249	0	0	if (DEBUG_s_TEST_) {
2250	0	0	if (DEBUG_v_TEST_) {
2251	0		PerlIO_printf(Perl_debug_log, "\n");
2252	0		deb_stack_all();
2253			}
2254			else
2255	0		debstack();
2256			}
2257
2258
2259	0	0	if (DEBUG_t_TEST_) debop(PL_op);
2260	0	0	if (DEBUG_P_TEST_) debprof(PL_op);
2261			}
2262
2263			OP_ENTRY_PROBE(OP_NAME(PL_op));
2264	0	0	} while ((PL_op = PL_op->op_ppaddr(aTHX)));
2265			DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
2266	0	0	PERL_ASYNC_CHECK();
2267
2268	0		TAINT_NOT;
2269	0		return 0;
2270			}
2271
2272			I32
2273	0		Perl_debop(pTHX_ const OP *o)
2274			{
2275			dVAR;
2276
2277			PERL_ARGS_ASSERT_DEBOP;
2278
2279	0	0	if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
		0
2280			return 0;
2281
2282	0	0	Perl_deb(aTHX_ "%s", OP_NAME(o));
		0
2283	0		switch (o->op_type) {
2284			case OP_CONST:
2285			case OP_HINTSEVAL:
2286			/* With ITHREADS, consts are stored in the pad, and the right pad
2287			* may not be active here, so check.
2288			* Looks like only during compiling the pads are illegal.
2289			*/
2290			#ifdef USE_ITHREADS
2291			if ((((SVOP*)o)->op_sv) \|\| !IN_PERL_COMPILETIME)
2292			#endif
2293	0		PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
2294	0		break;
2295			case OP_GVSV:
2296			case OP_GV:
2297	0	0	if (cGVOPo_gv) {
2298	0		SV * const sv = newSV(0);
2299			#ifdef PERL_MAD
2300			/* FIXME - is this making unwarranted assumptions about the
2301			UTF-8 cleanliness of the dump file handle? */
2302			SvUTF8_on(sv);
2303			#endif
2304	0		gv_fullname3(sv, cGVOPo_gv, NULL);
2305	0	0	PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2306	0		SvREFCNT_dec_NN(sv);
2307			}
2308			else
2309	0		PerlIO_printf(Perl_debug_log, "(NULL)");
2310			break;
2311
2312			{
2313			int count;
2314
2315			case OP_PADSV:
2316			case OP_PADAV:
2317			case OP_PADHV:
2318			count = 1;
2319			goto dump_padop;
2320			case OP_PADRANGE:
2321	0		count = o->op_private & OPpPADRANGE_COUNTMASK;
2322			dump_padop:
2323			/* print the lexical's name */
2324			{
2325	0		CV * const cv = deb_curcv(cxstack_ix);
2326			SV *sv;
2327			PAD * comppad = NULL;
2328			int i;
2329
2330	0	0	if (cv) {
2331	0		PADLIST * const padlist = CvPADLIST(cv);
2332	0		comppad = *PadlistARRAY(padlist);
2333			}
2334	0		PerlIO_printf(Perl_debug_log, "(");
2335	0	0	for (i = 0; i < count; i++) {
2336	0		if (comppad &&
2337	0		(sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2338	0	0	PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2339			else
2340	0		PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2341	0		(UV)o->op_targ+i);
2342	0	0	if (i < count-1)
2343	0		PerlIO_printf(Perl_debug_log, ",");
2344			}
2345	0		PerlIO_printf(Perl_debug_log, ")");
2346			}
2347	0		break;
2348			}
2349
2350			default:
2351			break;
2352			}
2353	0		PerlIO_printf(Perl_debug_log, "\n");
2354	0		return 0;
2355			}
2356
2357			STATIC CV*
2358			S_deb_curcv(pTHX_ const I32 ix)
2359			{
2360			dVAR;
2361	0		const PERL_CONTEXT * const cx = &cxstack[ix];
2362	0	0	if (CxTYPE(cx) == CXt_SUB \|\| CxTYPE(cx) == CXt_FORMAT)
2363	0		return cx->blk_sub.cv;
2364	0	0	else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
		0
2365	0		return cx->blk_eval.cv;
2366	0	0	else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
		0
2367	0		return PL_main_cv;
2368	0	0	else if (ix <= 0)
2369			return NULL;
2370			else
2371	0		return deb_curcv(ix - 1);
2372			}
2373
2374			void
2375	0		Perl_watch(pTHX_ char **addr)
2376			{
2377			dVAR;
2378
2379			PERL_ARGS_ASSERT_WATCH;
2380
2381	0		PL_watchaddr = addr;
2382	0		PL_watchok = *addr;
2383	0		PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2384			PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2385	0		}
2386
2387			STATIC void
2388			S_debprof(pTHX_ const OP *o)
2389			{
2390			dVAR;
2391
2392			PERL_ARGS_ASSERT_DEBPROF;
2393
2394	0	0	if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
		0
2395			return;
2396	0	0	if (!PL_profiledata)
2397	0		Newxz(PL_profiledata, MAXO, U32);
2398	0		++PL_profiledata[o->op_type];
2399			}
2400
2401			void
2402	0		Perl_debprofdump(pTHX)
2403			{
2404			dVAR;
2405			unsigned i;
2406	0	0	if (!PL_profiledata)
2407	0		return;
2408	0	0	for (i = 0; i < MAXO; i++) {
2409	0	0	if (PL_profiledata[i])
2410	0		PerlIO_printf(Perl_debug_log,
2411	0		"%5lu %s\n", (unsigned long)PL_profiledata[i],
2412			PL_op_name[i]);
2413			}
2414	0		}
2415
2416			#ifdef PERL_MAD
2417			/*
2418			* XML variants of most of the above routines
2419			*/
2420
2421			STATIC void
2422			S_xmldump_attr(pTHX_ I32 level, PerlIO file, const char pat, ...)
2423			{
2424			va_list args;
2425
2426			PERL_ARGS_ASSERT_XMLDUMP_ATTR;
2427
2428			PerlIO_printf(file, "\n ");
2429			va_start(args, pat);
2430			xmldump_vindent(level, file, pat, &args);
2431			va_end(args);
2432			}
2433
2434
2435			void
2436			Perl_xmldump_indent(pTHX_ I32 level, PerlIO file, const char pat, ...)
2437			{
2438			va_list args;
2439			PERL_ARGS_ASSERT_XMLDUMP_INDENT;
2440			va_start(args, pat);
2441			xmldump_vindent(level, file, pat, &args);
2442			va_end(args);
2443			}
2444
2445			void
2446			Perl_xmldump_vindent(pTHX_ I32 level, PerlIO file, const char pat, va_list *args)
2447			{
2448			PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
2449
2450			PerlIO_printf(file, "%s", (int)(levelPL_dumpindent), "");
2451			PerlIO_vprintf(file, pat, *args);
2452			}
2453
2454			void
2455			Perl_xmldump_all(pTHX)
2456			{
2457			xmldump_all_perl(FALSE);
2458			}
2459
2460			void
2461			Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
2462			{
2463			PerlIO_setlinebuf(PL_xmlfp);
2464			if (PL_main_root)
2465			op_xmldump(PL_main_root);
2466			/* someday we might call this, when it outputs XML: */
2467			/* xmldump_packsubs_perl(PL_defstash, justperl); */
2468			if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2469			PerlIO_close(PL_xmlfp);
2470			PL_xmlfp = 0;
2471			}
2472
2473			void
2474			Perl_xmldump_packsubs(pTHX_ const HV *stash)
2475			{
2476			PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
2477			xmldump_packsubs_perl(stash, FALSE);
2478			}
2479
2480			void
2481			Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
2482			{
2483			I32 i;
2484			HE *entry;
2485
2486			PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
2487
2488			if (!HvARRAY(stash))
2489			return;
2490			for (i = 0; i <= (I32) HvMAX(stash); i++) {
2491			for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
2492			GV *gv = MUTABLE_GV(HeVAL(entry));
2493			HV *hv;
2494			if (SvTYPE(gv) != SVt_PVGV \|\| !GvGP(gv))
2495			continue;
2496			if (GvCVu(gv))
2497			xmldump_sub_perl(gv, justperl);
2498			if (GvFORM(gv))
2499			xmldump_form(gv);
2500			if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2501			&& (hv = GvHV(gv)) && hv != PL_defstash)
2502			xmldump_packsubs_perl(hv, justperl); /* nested package */
2503			}
2504			}
2505			}
2506
2507			void
2508			Perl_xmldump_sub(pTHX_ const GV *gv)
2509			{
2510			PERL_ARGS_ASSERT_XMLDUMP_SUB;
2511			xmldump_sub_perl(gv, FALSE);
2512			}
2513
2514			void
2515			Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
2516			{
2517			SV * sv;
2518
2519			PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
2520
2521			if (justperl && (CvISXSUB(GvCV(gv)) \|\| !CvROOT(GvCV(gv))))
2522			return;
2523
2524			sv = sv_newmortal();
2525			gv_fullname3(sv, gv, NULL);
2526			Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2527			if (CvXSUB(GvCV(gv)))
2528			Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2529			PTR2UV(CvXSUB(GvCV(gv))),
2530			(int)CvXSUBANY(GvCV(gv)).any_i32);
2531			else if (CvROOT(GvCV(gv)))
2532			op_xmldump(CvROOT(GvCV(gv)));
2533			else
2534			Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\n");
2535			}
2536
2537			void
2538			Perl_xmldump_form(pTHX_ const GV *gv)
2539			{
2540			SV * const sv = sv_newmortal();
2541
2542			PERL_ARGS_ASSERT_XMLDUMP_FORM;
2543
2544			gv_fullname3(sv, gv, NULL);
2545			Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2546			if (CvROOT(GvFORM(gv)))
2547			op_xmldump(CvROOT(GvFORM(gv)));
2548			else
2549			Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\n");
2550			}
2551
2552			void
2553			Perl_xmldump_eval(pTHX)
2554			{
2555			op_xmldump(PL_eval_root);
2556			}
2557
2558			char *
2559			Perl_sv_catxmlsv(pTHX_ SV dsv, SV ssv)
2560			{
2561			PERL_ARGS_ASSERT_SV_CATXMLSV;
2562			return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2563			}
2564
2565			char *
2566			Perl_sv_catxmlpv(pTHX_ SV dsv, const char pv, int utf8)
2567			{
2568			PERL_ARGS_ASSERT_SV_CATXMLPV;
2569			return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
2570			}
2571
2572			char *
2573			Perl_sv_catxmlpvn(pTHX_ SV dsv, const char pv, STRLEN len, int utf8)
2574			{
2575			unsigned int c;
2576			const char * const e = pv + len;
2577			const char * const start = pv;
2578			STRLEN dsvcur;
2579			STRLEN cl;
2580
2581			PERL_ARGS_ASSERT_SV_CATXMLPVN;
2582
2583			sv_catpvs(dsv,"");
2584			dsvcur = SvCUR(dsv); /* in case we have to restart */
2585
2586			retry:
2587			while (pv < e) {
2588			if (utf8) {
2589			c = utf8_to_uvchr_buf((U8)pv, (U8)e, &cl);
2590			if (cl == 0) {
2591			SvCUR(dsv) = dsvcur;
2592			pv = start;
2593			utf8 = 0;
2594			goto retry;
2595			}
2596			}
2597			else
2598			c = (*pv & 255);
2599
2600			if (isCNTRL_L1(c)
2601			&& c != '\t'
2602			&& c != '\n'
2603			&& c != '\r'
2604			&& c != LATIN1_TO_NATIVE(0x85))
2605			{
2606			Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2607			}
2608			else switch (c) {
2609			case '<':
2610			sv_catpvs(dsv, "<");
2611			break;
2612			case '>':
2613			sv_catpvs(dsv, ">");
2614			break;
2615			case '&':
2616			sv_catpvs(dsv, "&");
2617			break;
2618			case '"':
2619			sv_catpvs(dsv, """);
2620			break;
2621			default:
2622			if (c < 0xD800) {
2623			if (! isPRINT(c)) {
2624			Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2625			}
2626			else {
2627			const char string = (char) c;
2628			sv_catpvn(dsv, &string, 1);
2629			}
2630			break;
2631			}
2632			if ((c >= 0xD800 && c <= 0xDB7F) \|\|
2633			(c >= 0xDC00 && c <= 0xDFFF) \|\|
2634			(c >= 0xFFF0 && c <= 0xFFFF) \|\|
2635			c > 0x10ffff)
2636			Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2637			else
2638			Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2639			}
2640
2641			if (utf8)
2642			pv += UTF8SKIP(pv);
2643			else
2644			pv++;
2645			}
2646
2647			return SvPVX(dsv);
2648			}
2649
2650			char *
2651			Perl_sv_xmlpeek(pTHX_ SV *sv)
2652			{
2653			SV * const t = sv_newmortal();
2654			STRLEN n_a;
2655			int unref = 0;
2656
2657			PERL_ARGS_ASSERT_SV_XMLPEEK;
2658
2659			sv_utf8_upgrade(t);
2660			sv_setpvs(t, "");
2661			/* retry: */
2662			if (!sv) {
2663			sv_catpv(t, "VOID=\"\"");
2664			goto finish;
2665			}
2666			else if (sv == (const SV *)0x55555555 \|\| ((char)SvTYPE(sv)) == 'U') {
2667			sv_catpv(t, "WILD=\"\"");
2668			goto finish;
2669			}
2670			else if (sv == &PL_sv_undef \|\| sv == &PL_sv_no \|\| sv == &PL_sv_yes \|\| sv == &PL_sv_placeholder) {
2671			if (sv == &PL_sv_undef) {
2672			sv_catpv(t, "SV_UNDEF=\"1\"");
2673			if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
2674			SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
2675			SvREADONLY(sv))
2676			goto finish;
2677			}
2678			else if (sv == &PL_sv_no) {
2679			sv_catpv(t, "SV_NO=\"1\"");
2680			if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
2681			SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
2682			!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
2683			SVp_POK\|SVp_NOK)) &&
2684			SvCUR(sv) == 0 &&
2685			SvNVX(sv) == 0.0)
2686			goto finish;
2687			}
2688			else if (sv == &PL_sv_yes) {
2689			sv_catpv(t, "SV_YES=\"1\"");
2690			if (!(SvFLAGS(sv) & (SVf_ROK\|SVf_OOK\|SVs_OBJECT\|
2691			SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
2692			!(~SvFLAGS(sv) & (SVf_POK\|SVf_NOK\|SVf_READONLY\|
2693			SVp_POK\|SVp_NOK)) &&
2694			SvCUR(sv) == 1 &&
2695			SvPVX(sv) && *SvPVX(sv) == '1' &&
2696			SvNVX(sv) == 1.0)
2697			goto finish;
2698			}
2699			else {
2700			sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2701			if (!(SvFLAGS(sv) & (SVf_OK\|SVf_OOK\|SVs_OBJECT\|
2702			SVs_GMG\|SVs_SMG\|SVs_RMG)) &&
2703			SvREADONLY(sv))
2704			goto finish;
2705			}
2706			sv_catpv(t, " XXX=\"\" ");
2707			}
2708			else if (SvREFCNT(sv) == 0) {
2709			sv_catpv(t, " refcnt=\"0\"");
2710			unref++;
2711			}
2712			else if (DEBUG_R_TEST_) {
2713			int is_tmp = 0;
2714			SSize_t ix;
2715			/* is this SV on the tmps stack? */
2716			for (ix=PL_tmps_ix; ix>=0; ix--) {
2717			if (PL_tmps_stack[ix] == sv) {
2718			is_tmp = 1;
2719			break;
2720			}
2721			}
2722			if (SvREFCNT(sv) > 1)
2723			Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2724			is_tmp ? "T" : "");
2725			else if (is_tmp)
2726			sv_catpv(t, " DRT=\"\"");
2727			}
2728
2729			if (SvROK(sv)) {
2730			sv_catpv(t, " ROK=\"\"");
2731			}
2732			switch (SvTYPE(sv)) {
2733			default:
2734			sv_catpv(t, " FREED=\"1\"");
2735			goto finish;
2736
2737			case SVt_NULL:
2738			sv_catpv(t, " UNDEF=\"1\"");
2739			goto finish;
2740			case SVt_IV:
2741			sv_catpv(t, " IV=\"");
2742			break;
2743			case SVt_NV:
2744			sv_catpv(t, " NV=\"");
2745			break;
2746			case SVt_PV:
2747			sv_catpv(t, " PV=\"");
2748			break;
2749			case SVt_PVIV:
2750			sv_catpv(t, " PVIV=\"");
2751			break;
2752			case SVt_PVNV:
2753			sv_catpv(t, " PVNV=\"");
2754			break;
2755			case SVt_PVMG:
2756			sv_catpv(t, " PVMG=\"");
2757			break;
2758			case SVt_PVLV:
2759			sv_catpv(t, " PVLV=\"");
2760			break;
2761			case SVt_PVAV:
2762			sv_catpv(t, " AV=\"");
2763			break;
2764			case SVt_PVHV:
2765			sv_catpv(t, " HV=\"");
2766			break;
2767			case SVt_PVCV:
2768			if (CvGV(sv))
2769			Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2770			else
2771			sv_catpv(t, " CV=\"()\"");
2772			goto finish;
2773			case SVt_PVGV:
2774			sv_catpv(t, " GV=\"");
2775			break;
2776			case SVt_INVLIST:
2777			sv_catpv(t, " DUMMY=\"");
2778			break;
2779			case SVt_REGEXP:
2780			sv_catpv(t, " REGEXP=\"");
2781			break;
2782			case SVt_PVFM:
2783			sv_catpv(t, " FM=\"");
2784			break;
2785			case SVt_PVIO:
2786			sv_catpv(t, " IO=\"");
2787			break;
2788			}
2789
2790			if (SvPOKp(sv)) {
2791			if (SvPVX(sv)) {
2792			sv_catxmlsv(t, sv);
2793			}
2794			}
2795			else if (SvNOKp(sv)) {
2796			STORE_NUMERIC_LOCAL_SET_STANDARD();
2797			Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2798			RESTORE_NUMERIC_LOCAL();
2799			}
2800			else if (SvIOKp(sv)) {
2801			if (SvIsUV(sv))
2802			Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2803			else
2804			Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2805			}
2806			else
2807			sv_catpv(t, "");
2808			sv_catpv(t, "\"");
2809
2810			finish:
2811			while (unref--)
2812			sv_catpv(t, ")");
2813			return SvPV(t, n_a);
2814			}
2815
2816			void
2817			Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO file, const PMOP pm)
2818			{
2819			PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
2820
2821			if (!pm) {
2822			Perl_xmldump_indent(aTHX_ level, file, "\n");
2823			return;
2824			}
2825			Perl_xmldump_indent(aTHX_ level, file, "
2826			level++;
2827			if (PM_GETRE(pm)) {
2828			REGEXP *const r = PM_GETRE(pm);
2829			SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
2830			sv_catxmlsv(tmpsv, MUTABLE_SV(r));
2831			Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2832			SvPVX(tmpsv));
2833			SvREFCNT_dec_NN(tmpsv);
2834			Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2835			(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2836			}
2837			else
2838			Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
2839			if (pm->op_pmflags \|\| (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
2840			SV * const tmpsv = pm_description(pm);
2841			Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2842			SvREFCNT_dec_NN(tmpsv);
2843			}
2844
2845			level--;
2846			if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
2847			Perl_xmldump_indent(aTHX_ level, file, ">\n");
2848			Perl_xmldump_indent(aTHX_ level+1, file, "\n");
2849			do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
2850			Perl_xmldump_indent(aTHX_ level+1, file, "\n");
2851			Perl_xmldump_indent(aTHX_ level, file, "\n");
2852			}
2853			else
2854			Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2855			}
2856
2857			void
2858			Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2859			{
2860			do_pmop_xmldump(0, PL_xmlfp, pm);
2861			}
2862
2863			void
2864			Perl_do_op_xmldump(pTHX_ I32 level, PerlIO file, const OP o)
2865			{
2866			UV seq;
2867			int contents = 0;
2868			const OPCODE optype = o->op_type;
2869
2870			PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
2871
2872			if (!o)
2873			return;
2874			seq = sequence_num(o);
2875			Perl_xmldump_indent(aTHX_ level, file,
2876			" ",
2877			OP_NAME(o),
2878			seq);
2879			level++;
2880			if (o->op_next)
2881			PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2882			sequence_num(o->op_next));
2883			else
2884			PerlIO_printf(file, "DONE\"");
2885
2886			if (o->op_targ) {
2887			if (optype == OP_NULL)
2888			{
2889			PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2890			if (o->op_targ == OP_NEXTSTATE)
2891			{
2892			if (CopLINE(cCOPo))
2893			PerlIO_printf(file, " line=\"%"UVuf"\"",
2894			(UV)CopLINE(cCOPo));
2895			if (CopSTASHPV(cCOPo))
2896			PerlIO_printf(file, " package=\"%s\"",
2897			CopSTASHPV(cCOPo));
2898			if (CopLABEL(cCOPo))
2899			PerlIO_printf(file, " label=\"%s\"",
2900			CopLABEL(cCOPo));
2901			}
2902			}
2903			else
2904			PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2905			}
2906			#ifdef DUMPADDR
2907			PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2908			#endif
2909
2910			DUMP_OP_FLAGS(o,1,0,file);
2911			DUMP_OP_PRIVATE(o,1,0,file);
2912
2913			switch (optype) {
2914			case OP_AELEMFAST:
2915			if (o->op_flags & OPf_SPECIAL) {
2916			break;
2917			}
2918			case OP_GVSV:
2919			case OP_GV:
2920			#ifdef USE_ITHREADS
2921			S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
2922			#else
2923			if (cSVOPo->op_sv) {
2924			SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
2925			SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
2926			char *s;
2927			STRLEN len;
2928			ENTER;
2929			SAVEFREESV(tmpsv1);
2930			SAVEFREESV(tmpsv2);
2931			gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
2932			s = SvPV(tmpsv1,len);
2933			sv_catxmlpvn(tmpsv2, s, len, 1);
2934			S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
2935			LEAVE;
2936			}
2937			else
2938			S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
2939			#endif
2940			break;
2941			case OP_CONST:
2942			case OP_HINTSEVAL:
2943			case OP_METHOD_NAMED:
2944			#ifndef USE_ITHREADS
2945			/* with ITHREADS, consts are stored in the pad, and the right pad
2946			* may not be active here, so skip */
2947			S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
2948			#endif
2949			break;
2950			case OP_ANONCODE:
2951			if (!contents) {
2952			contents = 1;
2953			PerlIO_printf(file, ">\n");
2954			}
2955			do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
2956			break;
2957			case OP_NEXTSTATE:
2958			case OP_DBSTATE:
2959			if (CopLINE(cCOPo))
2960			S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
2961			(UV)CopLINE(cCOPo));
2962			if (CopSTASHPV(cCOPo))
2963			S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
2964			CopSTASHPV(cCOPo));
2965			if (CopLABEL(cCOPo))
2966			S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
2967			CopLABEL(cCOPo));
2968			break;
2969			case OP_ENTERLOOP:
2970			S_xmldump_attr(aTHX_ level, file, "redo=\"");
2971			if (cLOOPo->op_redoop)
2972			PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
2973			else
2974			PerlIO_printf(file, "DONE\"");
2975			S_xmldump_attr(aTHX_ level, file, "next=\"");
2976			if (cLOOPo->op_nextop)
2977			PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
2978			else
2979			PerlIO_printf(file, "DONE\"");
2980			S_xmldump_attr(aTHX_ level, file, "last=\"");
2981			if (cLOOPo->op_lastop)
2982			PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
2983			else
2984			PerlIO_printf(file, "DONE\"");
2985			break;
2986			case OP_COND_EXPR:
2987			case OP_RANGE:
2988			case OP_MAPWHILE:
2989			case OP_GREPWHILE:
2990			case OP_OR:
2991			case OP_AND:
2992			S_xmldump_attr(aTHX_ level, file, "other=\"");
2993			if (cLOGOPo->op_other)
2994			PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
2995			else
2996			PerlIO_printf(file, "DONE\"");
2997			break;
2998			case OP_LEAVE:
2999			case OP_LEAVEEVAL:
3000			case OP_LEAVESUB:
3001			case OP_LEAVESUBLV:
3002			case OP_LEAVEWRITE:
3003			case OP_SCOPE:
3004			if (o->op_private & OPpREFCOUNTED)
3005			S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
3006			break;
3007			default:
3008			break;
3009			}
3010
3011			if (PL_madskills && o->op_madprop) {
3012			char prevkey = '\0';
3013			SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
3014			const MADPROP* mp = o->op_madprop;
3015
3016			if (!contents) {
3017			contents = 1;
3018			PerlIO_printf(file, ">\n");
3019			}
3020			Perl_xmldump_indent(aTHX_ level, file, "\n");
3021			level++;
3022			while (mp) {
3023			char tmp = mp->mad_key;
3024			sv_setpvs(tmpsv,"\"");
3025			if (tmp)
3026			sv_catxmlpvn(tmpsv, &tmp, 1, 0);
3027			if ((tmp == '_') \|\| (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
3028			sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
3029			else
3030			prevkey = tmp;
3031			sv_catpv(tmpsv, "\"");
3032			switch (mp->mad_type) {
3033			case MAD_NULL:
3034			sv_catpv(tmpsv, "NULL");
3035			Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv));
3036			break;
3037			case MAD_PV:
3038			sv_catpv(tmpsv, " val=\"");
3039			sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
3040			sv_catpv(tmpsv, "\"");
3041			Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv));
3042			break;
3043			case MAD_SV:
3044			sv_catpv(tmpsv, " val=\"");
3045			sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
3046			sv_catpv(tmpsv, "\"");
3047			Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv));
3048			break;
3049			case MAD_OP:
3050			if ((OP*)mp->mad_val) {
3051			Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv));
3052			do_op_xmldump(level+1, file, (OP*)mp->mad_val);
3053			Perl_xmldump_indent(aTHX_ level, file, "\n");
3054			}
3055			break;
3056			default:
3057			Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv));
3058			break;
3059			}
3060			mp = mp->mad_next;
3061			}
3062			level--;
3063			Perl_xmldump_indent(aTHX_ level, file, "\n");
3064
3065			SvREFCNT_dec_NN(tmpsv);
3066			}
3067
3068			switch (optype) {
3069			case OP_PUSHRE:
3070			case OP_MATCH:
3071			case OP_QR:
3072			case OP_SUBST:
3073			if (!contents) {
3074			contents = 1;
3075			PerlIO_printf(file, ">\n");
3076			}
3077			do_pmop_xmldump(level, file, cPMOPo);
3078			break;
3079			default:
3080			break;
3081			}
3082
3083			if (o->op_flags & OPf_KIDS) {
3084			OP *kid;
3085			if (!contents) {
3086			contents = 1;
3087			PerlIO_printf(file, ">\n");
3088			}
3089			for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3090			do_op_xmldump(level, file, kid);
3091			}
3092
3093			if (contents)
3094			Perl_xmldump_indent(aTHX_ level-1, file, "\n", OP_NAME(o));
3095			else
3096			PerlIO_printf(file, " />\n");
3097			}
3098
3099			void
3100			Perl_op_xmldump(pTHX_ const OP *o)
3101			{
3102			PERL_ARGS_ASSERT_OP_XMLDUMP;
3103
3104			do_op_xmldump(0, PL_xmlfp, o);
3105			}
3106			#endif
3107
3108			/*
3109			* Local variables:
3110			* c-indentation-style: bsd
3111			* c-basic-offset: 4
3112			* indent-tabs-mode: nil
3113			* End:
3114			*
3115			* ex: set ts=8 sts=4 sw=4 et:
3116			*/