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

... / ...

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