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