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