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