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_ISXSUB, "ISXSUB,"}
1370 };
1371
1372 const struct flag_to_name hv_flags_names[] = {
1373     {SVphv_SHAREKEYS, "SHAREKEYS,"},
1374     {SVphv_LAZYDEL, "LAZYDEL,"},
1375     {SVphv_HASKFLAGS, "HASKFLAGS,"},
1376     {SVphv_REHASH, "REHASH,"},
1377     {SVphv_CLONEABLE, "CLONEABLE,"}
1378 };
1379
1380 const struct flag_to_name gp_flags_names[] = {
1381     {GVf_INTRO, "INTRO,"},
1382     {GVf_MULTI, "MULTI,"},
1383     {GVf_ASSUMECV, "ASSUMECV,"},
1384     {GVf_IN_PAD, "IN_PAD,"}
1385 };
1386
1387 const struct flag_to_name gp_flags_imported_names[] = {
1388     {GVf_IMPORTED_SV, " SV"},
1389     {GVf_IMPORTED_AV, " AV"},
1390     {GVf_IMPORTED_HV, " HV"},
1391     {GVf_IMPORTED_CV, " CV"},
1392 };
1393
1394 const struct flag_to_name regexp_flags_names[] = {
1395     {RXf_PMf_MULTILINE,   "PMf_MULTILINE,"},
1396     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
1397     {RXf_PMf_FOLD,        "PMf_FOLD,"},
1398     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},
1399     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
1400     {RXf_ANCH_BOL,        "ANCH_BOL,"},
1401     {RXf_ANCH_MBOL,       "ANCH_MBOL,"},
1402     {RXf_ANCH_SBOL,       "ANCH_SBOL,"},
1403     {RXf_ANCH_GPOS,       "ANCH_GPOS,"},
1404     {RXf_GPOS_SEEN,       "GPOS_SEEN,"},
1405     {RXf_GPOS_FLOAT,      "GPOS_FLOAT,"},
1406     {RXf_LOOKBEHIND_SEEN, "LOOKBEHIND_SEEN,"},
1407     {RXf_EVAL_SEEN,       "EVAL_SEEN,"},
1408     {RXf_CANY_SEEN,       "CANY_SEEN,"},
1409     {RXf_NOSCAN,          "NOSCAN,"},
1410     {RXf_CHECK_ALL,       "CHECK_ALL,"},
1411     {RXf_MATCH_UTF8,      "MATCH_UTF8,"},
1412     {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1413     {RXf_USE_INTUIT_ML,   "USE_INTUIT_ML,"},
1414     {RXf_INTUIT_TAIL,     "INTUIT_TAIL,"},
1415     {RXf_SPLIT,           "SPLIT,"},
1416     {RXf_COPY_DONE,       "COPY_DONE,"},
1417     {RXf_TAINTED_SEEN,    "TAINTED_SEEN,"},
1418     {RXf_TAINTED,         "TAINTED,"},
1419     {RXf_START_ONLY,      "START_ONLY,"},
1420     {RXf_SKIPWHITE,       "SKIPWHITE,"},
1421     {RXf_WHITE,           "WHITE,"},
1422     {RXf_NULL,            "NULL,"},
1423 };
1424
1425 void
1426 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1427 {
1428     dVAR;
1429     SV *d;
1430     const char *s;
1431     U32 flags;
1432     U32 type;
1433
1434     PERL_ARGS_ASSERT_DO_SV_DUMP;
1435
1436     if (!sv) {
1437         Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
1438         return;
1439     }
1440
1441     flags = SvFLAGS(sv);
1442     type = SvTYPE(sv);
1443
1444     /* process general SV flags */
1445
1446     d = Perl_newSVpvf(aTHX_
1447                    "(0x%"UVxf") at 0x%"UVxf"\n%*s  REFCNT = %"IVdf"\n%*s  FLAGS = (",
1448                    PTR2UV(SvANY(sv)), PTR2UV(sv),
1449                    (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1450                    (int)(PL_dumpindent*level), "");
1451
1452     if (!((flags & SVpad_NAME) == SVpad_NAME
1453           && (type == SVt_PVMG || type == SVt_PVNV))) {
1454         if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1455             sv_catpv(d, "PADSTALE,");
1456     }
1457     if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
1458         if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1459             sv_catpv(d, "PADTMP,");
1460         if (flags & SVs_PADMY)  sv_catpv(d, "PADMY,");
1461     }
1462     append_flags(d, flags, first_sv_flags_names);
1463     if (flags & SVf_ROK)  {
1464                                 sv_catpv(d, "ROK,");
1465         if (SvWEAKREF(sv))      sv_catpv(d, "WEAKREF,");
1466     }
1467     append_flags(d, flags, second_sv_flags_names);
1468     if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
1469         if (SvPCS_IMPORTED(sv))
1470                                 sv_catpv(d, "PCS_IMPORTED,");
1471         else
1472                                 sv_catpv(d, "SCREAM,");
1473     }
1474
1475     /* process type-specific SV flags */
1476
1477     switch (type) {
1478     case SVt_PVCV:
1479     case SVt_PVFM:
1480         append_flags(d, CvFLAGS(sv), cv_flags_names);
1481         break;
1482     case SVt_PVHV:
1483         append_flags(d, flags, hv_flags_names);
1484         break;
1485     case SVt_PVGV:
1486     case SVt_PVLV:
1487         if (isGV_with_GP(sv)) {
1488             append_flags(d, GvFLAGS(sv), gp_flags_names);
1489         }
1490         if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
1491             sv_catpv(d, "IMPORT");
1492             if (GvIMPORTED(sv) == GVf_IMPORTED)
1493                 sv_catpv(d, "ALL,");
1494             else {
1495                 sv_catpv(d, "(");
1496                 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
1497                 sv_catpv(d, " ),");
1498             }
1499         }
1500         /* FALL THROUGH */
1501     default:
1502     evaled_or_uv:
1503         if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
1504         if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
1505         break;
1506     case SVt_PVMG:
1507         if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
1508         if (SvVALID(sv))        sv_catpv(d, "VALID,");
1509         if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
1510         if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
1511         /* FALL THROUGH */
1512     case SVt_PVNV:
1513         if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
1514         goto evaled_or_uv;
1515     case SVt_PVAV:
1516         break;
1517     }
1518     /* SVphv_SHAREKEYS is also 0x20000000 */
1519     if ((type != SVt_PVHV) && SvUTF8(sv))
1520         sv_catpv(d, "UTF8");
1521
1522     if (*(SvEND(d) - 1) == ',') {
1523         SvCUR_set(d, SvCUR(d) - 1);
1524         SvPVX(d)[SvCUR(d)] = '\0';
1525     }
1526     sv_catpv(d, ")");
1527     s = SvPVX_const(d);
1528
1529     /* dump initial SV details */
1530
1531 #ifdef DEBUG_LEAKING_SCALARS
1532     Perl_dump_indent(aTHX_ level, file,
1533         "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
1534         sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1535         sv->sv_debug_line,
1536         sv->sv_debug_inpad ? "for" : "by",
1537         sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1538         PTR2UV(sv->sv_debug_parent),
1539         sv->sv_debug_serial
1540     );
1541 #endif
1542     Perl_dump_indent(aTHX_ level, file, "SV = ");
1543
1544     /* Dump SV type */
1545
1546     if (type < SVt_LAST) {
1547         PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1548
1549         if (type ==  SVt_NULL) {
1550             SvREFCNT_dec(d);
1551             return;
1552         }
1553     } else {
1554         PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
1555         SvREFCNT_dec(d);
1556         return;
1557     }
1558
1559     /* Dump general SV fields */
1560
1561     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1562          && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1563          && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
1564         || (type == SVt_IV && !SvROK(sv))) {
1565         if (SvIsUV(sv)
1566 #ifdef PERL_OLD_COPY_ON_WRITE
1567                        || SvIsCOW(sv)
1568 #endif
1569                                      )
1570             Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
1571         else
1572             Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
1573 #ifdef PERL_OLD_COPY_ON_WRITE
1574         if (SvIsCOW_shared_hash(sv))
1575             PerlIO_printf(file, "  (HASH)");
1576         else if (SvIsCOW_normal(sv))
1577             PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1578 #endif
1579         PerlIO_putc(file, '\n');
1580     }
1581
1582     if ((type == SVt_PVNV || type == SVt_PVMG)
1583         && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
1584         Perl_dump_indent(aTHX_ level, file, "  COP_LOW = %"UVuf"\n",
1585                          (UV) COP_SEQ_RANGE_LOW(sv));
1586         Perl_dump_indent(aTHX_ level, file, "  COP_HIGH = %"UVuf"\n",
1587                          (UV) COP_SEQ_RANGE_HIGH(sv));
1588     } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
1589                 && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
1590                 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
1591                || type == SVt_NV) {
1592         STORE_NUMERIC_LOCAL_SET_STANDARD();
1593         /* %Vg doesn't work? --jhi */
1594 #ifdef USE_LONG_DOUBLE
1595         Perl_dump_indent(aTHX_ level, file, "  NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
1596 #else
1597         Perl_dump_indent(aTHX_ level, file, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
1598 #endif
1599         RESTORE_NUMERIC_LOCAL();
1600     }
1601
1602     if (SvROK(sv)) {
1603         Perl_dump_indent(aTHX_ level, file, "  RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
1604         if (nest < maxnest)
1605             do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
1606     }
1607
1608     if (type < SVt_PV) {
1609         SvREFCNT_dec(d);
1610         return;
1611     }
1612
1613     if ((type <= SVt_PVLV && !isGV_with_GP(sv)) || type == SVt_PVFM) {
1614         if (SvPVX_const(sv)) {
1615             STRLEN delta;
1616             if (SvOOK(sv)) {
1617                 SvOOK_offset(sv, delta);
1618                 Perl_dump_indent(aTHX_ level, file,"  OFFSET = %"UVuf"\n",
1619                                  (UV) delta);
1620             } else {
1621                 delta = 0;
1622             }
1623             Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
1624             if (SvOOK(sv)) {
1625                 PerlIO_printf(file, "( %s . ) ",
1626                               pv_display(d, SvPVX_const(sv) - delta, delta, 0,
1627                                          pvlim));
1628             }
1629             PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
1630             if (SvUTF8(sv)) /* the 6?  \x{....} */
1631                 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
1632             PerlIO_printf(file, "\n");
1633             Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
1634             Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n", (IV)SvLEN(sv));
1635         }
1636         else
1637             Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
1638     }
1639
1640     if (type >= SVt_PVMG) {
1641         if (type == SVt_PVMG && SvPAD_OUR(sv)) {
1642             HV * const ost = SvOURSTASH(sv);
1643             if (ost)
1644                 do_hv_dump(level, file, "  OURSTASH", ost);
1645         } else {
1646             if (SvMAGIC(sv))
1647                 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
1648         }
1649         if (SvSTASH(sv))
1650             do_hv_dump(level, file, "  STASH", SvSTASH(sv));
1651
1652         if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
1653             Perl_dump_indent(aTHX_ level, file, "  RARE = %u\n", (U8)BmRARE(sv));
1654             Perl_dump_indent(aTHX_ level, file, "  PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
1655             Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1656         }
1657     }
1658
1659     /* Dump type-specific SV fields */
1660
1661     switch (type) {
1662     case SVt_PVAV:
1663         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
1664         if (AvARRAY(sv) != AvALLOC(sv)) {
1665             PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1666             Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
1667         }
1668         else
1669             PerlIO_putc(file, '\n');
1670         Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1671         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
1672         Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
1673         sv_setpvs(d, "");
1674         if (AvREAL(sv)) sv_catpv(d, ",REAL");
1675         if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
1676         Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
1677                          SvCUR(d) ? SvPVX_const(d) + 1 : "");
1678         if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
1679             int count;
1680             for (count = 0; count <=  av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
1681                 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
1682
1683                 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
1684                 if (elt)
1685                     do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1686             }
1687         }
1688         break;
1689     case SVt_PVHV:
1690         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1691         if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
1692             /* Show distribution of HEs in the ARRAY */
1693             int freq[200];
1694 #define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
1695             int i;
1696             int max = 0;
1697             U32 pow2 = 2, keys = HvUSEDKEYS(sv);
1698             NV theoret, sum = 0;
1699
1700             PerlIO_printf(file, "  (");
1701             Zero(freq, FREQ_MAX + 1, int);
1702             for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
1703                 HE* h;
1704                 int count = 0;
1705                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1706                     count++;
1707                 if (count > FREQ_MAX)
1708                     count = FREQ_MAX;
1709                 freq[count]++;
1710                 if (max < count)
1711                     max = count;
1712             }
1713             for (i = 0; i <= max; i++) {
1714                 if (freq[i]) {
1715                     PerlIO_printf(file, "%d%s:%d", i,
1716                                   (i == FREQ_MAX) ? "+" : "",
1717                                   freq[i]);
1718                     if (i != max)
1719                         PerlIO_printf(file, ", ");
1720                 }
1721             }
1722             PerlIO_putc(file, ')');
1723             /* The "quality" of a hash is defined as the total number of
1724                comparisons needed to access every element once, relative
1725                to the expected number needed for a random hash.
1726
1727                The total number of comparisons is equal to the sum of
1728                the squares of the number of entries in each bucket.
1729                For a random hash of n keys into k buckets, the expected
1730                value is
1731                                 n + n(n-1)/2k
1732             */
1733
1734             for (i = max; i > 0; i--) { /* Precision: count down. */
1735                 sum += freq[i] * i * i;
1736             }
1737             while ((keys = keys >> 1))
1738                 pow2 = pow2 << 1;
1739             theoret = HvUSEDKEYS(sv);
1740             theoret += theoret * (theoret-1)/pow2;
1741             PerlIO_putc(file, '\n');
1742             Perl_dump_indent(aTHX_ level, file, "  hash quality = %.1"NVff"%%", theoret/sum*100);
1743         }
1744         PerlIO_putc(file, '\n');
1745         Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
1746         Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)HvFILL(sv));
1747         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
1748         Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1749         Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
1750         {
1751             MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
1752             if (mg && mg->mg_obj) {
1753                 Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1754             }
1755         }
1756         {
1757             const char * const hvname = HvNAME_get(sv);
1758             if (hvname)
1759                 Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
1760         }
1761         if (SvOOK(sv)) {
1762             AV * const backrefs
1763                 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
1764             struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
1765             if (HvAUX(sv)->xhv_name_count)
1766                 Perl_dump_indent(aTHX_
1767                  level, file, "  NAMECOUNT = %"IVdf"\n",
1768                  (IV)HvAUX(sv)->xhv_name_count
1769                 );
1770             if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
1771                 const I32 count = HvAUX(sv)->xhv_name_count;
1772                 if (count) {
1773                     SV * const names = newSVpvs_flags("", SVs_TEMP);
1774                     /* The starting point is the first element if count is
1775                        positive and the second element if count is negative. */
1776                     HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1777                         + (count < 0 ? 1 : 0);
1778                     HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1779                         + (count < 0 ? -count : count);
1780                     while (hekp < endp) {
1781                         if (*hekp) {
1782                             sv_catpvs(names, ", \"");
1783                             sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp));
1784                             sv_catpvs(names, "\"");
1785                         } else {
1786                             /* This should never happen. */
1787                             sv_catpvs(names, ", (null)");
1788                         }
1789                         ++hekp;
1790                     }
1791                     Perl_dump_indent(aTHX_
1792                      level, file, "  ENAME = %s\n", SvPV_nolen(names)+2
1793                     );
1794                 }
1795                 else
1796                     Perl_dump_indent(aTHX_
1797                      level, file, "  ENAME = \"%s\"\n", HvENAME_get(sv)
1798                     );
1799             }
1800             if (backrefs) {
1801                 Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
1802                                  PTR2UV(backrefs));
1803                 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
1804                            dumpops, pvlim);
1805             }
1806             if (meta) {
1807                 /* FIXME - mro_algs kflags can signal a UTF-8 name.  */
1808                 Perl_dump_indent(aTHX_ level, file, "  MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
1809                                  (int)meta->mro_which->length,
1810                                  meta->mro_which->name,
1811                                  PTR2UV(meta->mro_which));
1812                 Perl_dump_indent(aTHX_ level, file, "  CACHE_GEN = 0x%"UVxf"\n",
1813                                  (UV)meta->cache_gen);
1814                 Perl_dump_indent(aTHX_ level, file, "  PKG_GEN = 0x%"UVxf"\n",
1815                                  (UV)meta->pkg_gen);
1816                 if (meta->mro_linear_all) {
1817                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_ALL = 0x%"UVxf"\n",
1818                                  PTR2UV(meta->mro_linear_all));
1819                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1820                            dumpops, pvlim);
1821                 }
1822                 if (meta->mro_linear_current) {
1823                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1824                                  PTR2UV(meta->mro_linear_current));
1825                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1826                            dumpops, pvlim);
1827                 }
1828                 if (meta->mro_nextmethod) {
1829                     Perl_dump_indent(aTHX_ level, file, "  MRO_NEXTMETHOD = 0x%"UVxf"\n",
1830                                  PTR2UV(meta->mro_nextmethod));
1831                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1832                            dumpops, pvlim);
1833                 }
1834                 if (meta->isa) {
1835                     Perl_dump_indent(aTHX_ level, file, "  ISA = 0x%"UVxf"\n",
1836                                  PTR2UV(meta->isa));
1837                 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1838                            dumpops, pvlim);
1839                 }
1840             }
1841         }
1842         if (nest < maxnest) {
1843             HV * const hv = MUTABLE_HV(sv);
1844             STRLEN i;
1845             HE *he;
1846
1847             if (HvARRAY(hv)) {
1848                 int count = maxnest - nest;
1849                 for (i=0; i <= HvMAX(hv); i++) {
1850                     for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1851                         U32 hash;
1852                         SV * keysv;
1853                         const char * keypv;
1854                         SV * elt;
1855                 STRLEN len;
1856
1857                         if (count-- <= 0) goto DONEHV;
1858
1859                         hash = HeHASH(he);
1860                         keysv = hv_iterkeysv(he);
1861                         keypv = SvPV_const(keysv, len);
1862                         elt = HeVAL(he);
1863
1864                 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1865                 if (SvUTF8(keysv))
1866                     PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
1867                         if (HvEITER_get(hv) == he)
1868                             PerlIO_printf(file, "[CURRENT] ");
1869                 if (HeKREHASH(he))
1870                     PerlIO_printf(file, "[REHASH] ");
1871                         PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1872                 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1873             }
1874                 }
1875               DONEHV:;
1876             }
1877         }
1878         break;
1879
1880     case SVt_PVCV:
1881         if (CvAUTOLOAD(sv)) {
1882             STRLEN len;
1883             const char *const name =  SvPV_const(sv, len);
1884             Perl_dump_indent(aTHX_ level, file, "  AUTOLOAD = \"%.*s\"\n",
1885                              (int) len, name);
1886         }
1887         if (SvPOK(sv)) {
1888             Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%.*s\"\n",
1889                              (int) CvPROTOLEN(sv), CvPROTO(sv));
1890         }
1891         /* FALL THROUGH */
1892     case SVt_PVFM:
1893         do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
1894         if (!CvISXSUB(sv)) {
1895             if (CvSTART(sv)) {
1896                 Perl_dump_indent(aTHX_ level, file,
1897                                  "  START = 0x%"UVxf" ===> %"IVdf"\n",
1898                                  PTR2UV(CvSTART(sv)),
1899                                  (IV)sequence_num(CvSTART(sv)));
1900             }
1901             Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n",
1902                              PTR2UV(CvROOT(sv)));
1903             if (CvROOT(sv) && dumpops) {
1904                 do_op_dump(level+1, file, CvROOT(sv));
1905             }
1906         } else {
1907             SV * const constant = cv_const_sv((const CV *)sv);
1908
1909             Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
1910
1911             if (constant) {
1912                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
1913                                  " (CONST SV)\n",
1914                                  PTR2UV(CvXSUBANY(sv).any_ptr));
1915                 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
1916                            pvlim);
1917             } else {
1918                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
1919                                  (IV)CvXSUBANY(sv).any_i32);
1920             }
1921         }
1922         do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
1923         Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
1924         if (type == SVt_PVCV)
1925             Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
1926         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
1927         Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
1928         if (type == SVt_PVFM)
1929             Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)FmLINES(sv));
1930         Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
1931         if (nest < maxnest) {
1932             do_dump_pad(level+1, file, CvPADLIST(sv), 0);
1933         }
1934         {
1935             const CV * const outside = CvOUTSIDE(sv);
1936             Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",
1937                         PTR2UV(outside),
1938                         (!outside ? "null"
1939                          : CvANON(outside) ? "ANON"
1940                          : (outside == PL_main_cv) ? "MAIN"
1941                          : CvUNIQUE(outside) ? "UNIQUE"
1942                          : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1943         }
1944         if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
1945             do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
1946         break;
1947
1948     case SVt_PVGV:
1949     case SVt_PVLV:
1950         if (type == SVt_PVLV) {
1951             Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
1952             Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
1953             Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
1954             Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
1955             Perl_dump_indent(aTHX_ level, file, "  FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
1956             if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
1957                 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
1958                     dumpops, pvlim);
1959         }
1960         if (!isGV_with_GP(sv))
1961             break;
1962         Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
1963         Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
1964         do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
1965         Perl_dump_indent(aTHX_ level, file, "  GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
1966         if (!GvGP(sv))
1967             break;
1968         Perl_dump_indent(aTHX_ level, file, "    SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
1969         Perl_dump_indent(aTHX_ level, file, "    REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
1970         Perl_dump_indent(aTHX_ level, file, "    IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
1971         Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%"UVxf"  \n", PTR2UV(GvFORM(sv)));
1972         Perl_dump_indent(aTHX_ level, file, "    AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
1973         Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
1974         Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
1975         Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
1976         Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
1977         Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
1978         Perl_dump_indent(aTHX_ level, file, "    FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
1979         do_gv_dump (level, file, "    EGV", GvEGV(sv));
1980         break;
1981     case SVt_PVIO:
1982         Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
1983         Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
1984         Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
1985         Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)IoLINES(sv));
1986         Perl_dump_indent(aTHX_ level, file, "  PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
1987         Perl_dump_indent(aTHX_ level, file, "  PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
1988         Perl_dump_indent(aTHX_ level, file, "  LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
1989         if (IoTOP_NAME(sv))
1990             Perl_dump_indent(aTHX_ level, file, "  TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
1991         if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
1992             do_gv_dump (level, file, "  TOP_GV", IoTOP_GV(sv));
1993         else {
1994             Perl_dump_indent(aTHX_ level, file, "  TOP_GV = 0x%"UVxf"\n",
1995                              PTR2UV(IoTOP_GV(sv)));
1996             do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
1997                         maxnest, dumpops, pvlim);
1998         }
1999         /* Source filters hide things that are not GVs in these three, so let's
2000            be careful out there.  */
2001         if (IoFMT_NAME(sv))
2002             Perl_dump_indent(aTHX_ level, file, "  FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
2003         if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2004             do_gv_dump (level, file, "  FMT_GV", IoFMT_GV(sv));
2005         else {
2006             Perl_dump_indent(aTHX_ level, file, "  FMT_GV = 0x%"UVxf"\n",
2007                              PTR2UV(IoFMT_GV(sv)));
2008             do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2009                         maxnest, dumpops, pvlim);
2010         }
2011         if (IoBOTTOM_NAME(sv))
2012             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
2013         if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2014             do_gv_dump (level, file, "  BOTTOM_GV", IoBOTTOM_GV(sv));
2015         else {
2016             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_GV = 0x%"UVxf"\n",
2017                              PTR2UV(IoBOTTOM_GV(sv)));
2018             do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2019                         maxnest, dumpops, pvlim);
2020         }
2021         if (isPRINT(IoTYPE(sv)))
2022             Perl_dump_indent(aTHX_ level, file, "  TYPE = '%c'\n", IoTYPE(sv));
2023         else
2024             Perl_dump_indent(aTHX_ level, file, "  TYPE = '\\%o'\n", IoTYPE(sv));
2025         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
2026         break;
2027     case SVt_REGEXP:
2028         {
2029             struct regexp * const r = (struct regexp *)SvANY(sv);
2030             flags = RX_EXTFLAGS((REGEXP*)sv);
2031             sv_setpv(d,"");
2032             append_flags(d, flags, regexp_flags_names);
2033             if (*(SvEND(d) - 1) == ',') {
2034                 SvCUR_set(d, SvCUR(d) - 1);
2035                 SvPVX(d)[SvCUR(d)] = '\0';
2036             }
2037             Perl_dump_indent(aTHX_ level, file, "  EXTFLAGS = 0x%"UVxf" (%s)\n",
2038                                 (UV)flags, SvPVX_const(d));
2039             Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf"\n",
2040                                 (UV)(r->intflags));
2041             Perl_dump_indent(aTHX_ level, file, "  NPARENS = %"UVuf"\n",
2042                                 (UV)(r->nparens));
2043             Perl_dump_indent(aTHX_ level, file, "  LASTPAREN = %"UVuf"\n",
2044                                 (UV)(r->lastparen));
2045             Perl_dump_indent(aTHX_ level, file, "  LASTCLOSEPAREN = %"UVuf"\n",
2046                                 (UV)(r->lastcloseparen));
2047             Perl_dump_indent(aTHX_ level, file, "  MINLEN = %"IVdf"\n",
2048                                 (IV)(r->minlen));
2049             Perl_dump_indent(aTHX_ level, file, "  MINLENRET = %"IVdf"\n",
2050                                 (IV)(r->minlenret));
2051             Perl_dump_indent(aTHX_ level, file, "  GOFS = %"UVuf"\n",
2052                                 (UV)(r->gofs));
2053             Perl_dump_indent(aTHX_ level, file, "  PRE_PREFIX = %"UVuf"\n",
2054                                 (UV)(r->pre_prefix));
2055             Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
2056                                 (IV)(r->sublen));
2057             if (r->subbeg)
2058                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x%"UVxf" %s\n",
2059                             PTR2UV(r->subbeg),
2060                             pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2061             else
2062                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x0\n");
2063             Perl_dump_indent(aTHX_ level, file, "  ENGINE = 0x%"UVxf"\n",
2064                                 PTR2UV(r->engine));
2065             Perl_dump_indent(aTHX_ level, file, "  MOTHER_RE = 0x%"UVxf"\n",
2066                                 PTR2UV(r->mother_re));
2067             Perl_dump_indent(aTHX_ level, file, "  PAREN_NAMES = 0x%"UVxf"\n",
2068                                 PTR2UV(r->paren_names));
2069             Perl_dump_indent(aTHX_ level, file, "  SUBSTRS = 0x%"UVxf"\n",
2070                                 PTR2UV(r->substrs));
2071             Perl_dump_indent(aTHX_ level, file, "  PPRIVATE = 0x%"UVxf"\n",
2072                                 PTR2UV(r->pprivate));
2073             Perl_dump_indent(aTHX_ level, file, "  OFFS = 0x%"UVxf"\n",
2074                                 PTR2UV(r->offs));
2075             Perl_dump_indent(aTHX_ level, file, "  QR_ANONCV = 0x%"UVxf"\n",
2076                                 PTR2UV(r->qr_anoncv));
2077 #ifdef PERL_OLD_COPY_ON_WRITE
2078             Perl_dump_indent(aTHX_ level, file, "  SAVED_COPY = 0x%"UVxf"\n",
2079                                 PTR2UV(r->saved_copy));
2080 #endif
2081         }
2082         break;
2083     }
2084     SvREFCNT_dec(d);
2085 }
2086
2087 void
2088 Perl_sv_dump(pTHX_ SV *sv)
2089 {
2090     dVAR;
2091
2092     PERL_ARGS_ASSERT_SV_DUMP;
2093
2094     if (SvROK(sv))
2095         do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2096     else
2097         do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
2098 }
2099
2100 int
2101 Perl_runops_debug(pTHX)
2102 {
2103     dVAR;
2104     if (!PL_op) {
2105         Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2106         return 0;
2107     }
2108
2109     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
2110     do {
2111         if (PL_debug) {
2112             if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
2113                 PerlIO_printf(Perl_debug_log,
2114                               "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2115                               PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2116                               PTR2UV(*PL_watchaddr));
2117             if (DEBUG_s_TEST_) {
2118                 if (DEBUG_v_TEST_) {
2119                     PerlIO_printf(Perl_debug_log, "\n");
2120                     deb_stack_all();
2121                 }
2122                 else
2123                     debstack();
2124             }
2125
2126
2127             if (DEBUG_t_TEST_) debop(PL_op);
2128             if (DEBUG_P_TEST_) debprof(PL_op);
2129         }
2130     } while ((PL_op = PL_op->op_ppaddr(aTHX)));
2131     DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
2132
2133     TAINT_NOT;
2134     return 0;
2135 }
2136
2137 I32
2138 Perl_debop(pTHX_ const OP *o)
2139 {
2140     dVAR;
2141
2142     PERL_ARGS_ASSERT_DEBOP;
2143
2144     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2145         return 0;
2146
2147     Perl_deb(aTHX_ "%s", OP_NAME(o));
2148     switch (o->op_type) {
2149     case OP_CONST:
2150     case OP_HINTSEVAL:
2151         /* With ITHREADS, consts are stored in the pad, and the right pad
2152          * may not be active here, so check.
2153          * Looks like only during compiling the pads are illegal.
2154          */
2155 #ifdef USE_ITHREADS
2156         if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2157 #endif
2158             PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
2159         break;
2160     case OP_GVSV:
2161     case OP_GV:
2162         if (cGVOPo_gv) {
2163             SV * const sv = newSV(0);
2164 #ifdef PERL_MAD
2165             /* FIXME - is this making unwarranted assumptions about the
2166                UTF-8 cleanliness of the dump file handle?  */
2167             SvUTF8_on(sv);
2168 #endif
2169             gv_fullname3(sv, cGVOPo_gv, NULL);
2170             PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2171             SvREFCNT_dec(sv);
2172         }
2173         else
2174             PerlIO_printf(Perl_debug_log, "(NULL)");
2175         break;
2176     case OP_PADSV:
2177     case OP_PADAV:
2178     case OP_PADHV:
2179         {
2180         /* print the lexical's name */
2181         CV * const cv = deb_curcv(cxstack_ix);
2182         SV *sv;
2183         if (cv) {
2184             AV * const padlist = CvPADLIST(cv);
2185             AV * const comppad = MUTABLE_AV(*av_fetch(padlist, 0, FALSE));
2186             sv = *av_fetch(comppad, o->op_targ, FALSE);
2187         } else
2188             sv = NULL;
2189         if (sv)
2190             PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2191         else
2192             PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
2193         }
2194         break;
2195     default:
2196         break;
2197     }
2198     PerlIO_printf(Perl_debug_log, "\n");
2199     return 0;
2200 }
2201
2202 STATIC CV*
2203 S_deb_curcv(pTHX_ const I32 ix)
2204 {
2205     dVAR;
2206     const PERL_CONTEXT * const cx = &cxstack[ix];
2207     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2208         return cx->blk_sub.cv;
2209     else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2210         return cx->blk_eval.cv;
2211     else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2212         return PL_main_cv;
2213     else if (ix <= 0)
2214         return NULL;
2215     else
2216         return deb_curcv(ix - 1);
2217 }
2218
2219 void
2220 Perl_watch(pTHX_ char **addr)
2221 {
2222     dVAR;
2223
2224     PERL_ARGS_ASSERT_WATCH;
2225
2226     PL_watchaddr = addr;
2227     PL_watchok = *addr;
2228     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2229         PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2230 }
2231
2232 STATIC void
2233 S_debprof(pTHX_ const OP *o)
2234 {
2235     dVAR;
2236
2237     PERL_ARGS_ASSERT_DEBPROF;
2238
2239     if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
2240         return;
2241     if (!PL_profiledata)
2242         Newxz(PL_profiledata, MAXO, U32);
2243     ++PL_profiledata[o->op_type];
2244 }
2245
2246 void
2247 Perl_debprofdump(pTHX)
2248 {
2249     dVAR;
2250     unsigned i;
2251     if (!PL_profiledata)
2252         return;
2253     for (i = 0; i < MAXO; i++) {
2254         if (PL_profiledata[i])
2255             PerlIO_printf(Perl_debug_log,
2256                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
2257                                        PL_op_name[i]);
2258     }
2259 }
2260
2261 #ifdef PERL_MAD
2262 /*
2263  *    XML variants of most of the above routines
2264  */
2265
2266 STATIC void
2267 S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2268 {
2269     va_list args;
2270
2271     PERL_ARGS_ASSERT_XMLDUMP_ATTR;
2272
2273     PerlIO_printf(file, "\n    ");
2274     va_start(args, pat);
2275     xmldump_vindent(level, file, pat, &args);
2276     va_end(args);
2277 }
2278
2279
2280 void
2281 Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2282 {
2283     va_list args;
2284     PERL_ARGS_ASSERT_XMLDUMP_INDENT;
2285     va_start(args, pat);
2286     xmldump_vindent(level, file, pat, &args);
2287     va_end(args);
2288 }
2289
2290 void
2291 Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
2292 {
2293     PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
2294
2295     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
2296     PerlIO_vprintf(file, pat, *args);
2297 }
2298
2299 void
2300 Perl_xmldump_all(pTHX)
2301 {
2302     xmldump_all_perl(FALSE);
2303 }
2304
2305 void
2306 Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
2307 {
2308     PerlIO_setlinebuf(PL_xmlfp);
2309     if (PL_main_root)
2310         op_xmldump(PL_main_root);
2311     /* someday we might call this, when it outputs XML: */
2312     /* xmldump_packsubs_perl(PL_defstash, justperl); */
2313     if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2314         PerlIO_close(PL_xmlfp);
2315     PL_xmlfp = 0;
2316 }
2317
2318 void
2319 Perl_xmldump_packsubs(pTHX_ const HV *stash)
2320 {
2321     PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
2322     xmldump_packsubs_perl(stash, FALSE);
2323 }
2324
2325 void
2326 Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
2327 {
2328     I32 i;
2329     HE  *entry;
2330
2331     PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
2332
2333     if (!HvARRAY(stash))
2334         return;
2335     for (i = 0; i <= (I32) HvMAX(stash); i++) {
2336         for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
2337             GV *gv = MUTABLE_GV(HeVAL(entry));
2338             HV *hv;
2339             if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
2340                 continue;
2341             if (GvCVu(gv))
2342                 xmldump_sub_perl(gv, justperl);
2343             if (GvFORM(gv))
2344                 xmldump_form(gv);
2345             if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2346                 && (hv = GvHV(gv)) && hv != PL_defstash)
2347                 xmldump_packsubs_perl(hv, justperl);    /* nested package */
2348         }
2349     }
2350 }
2351
2352 void
2353 Perl_xmldump_sub(pTHX_ const GV *gv)
2354 {
2355     PERL_ARGS_ASSERT_XMLDUMP_SUB;
2356     xmldump_sub_perl(gv, FALSE);
2357 }
2358
2359 void
2360 Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
2361 {
2362     SV * sv;
2363
2364     PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
2365
2366     if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
2367         return;
2368
2369     sv = sv_newmortal();
2370     gv_fullname3(sv, gv, NULL);
2371     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2372     if (CvXSUB(GvCV(gv)))
2373         Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2374             PTR2UV(CvXSUB(GvCV(gv))),
2375             (int)CvXSUBANY(GvCV(gv)).any_i32);
2376     else if (CvROOT(GvCV(gv)))
2377         op_xmldump(CvROOT(GvCV(gv)));
2378     else
2379         Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2380 }
2381
2382 void
2383 Perl_xmldump_form(pTHX_ const GV *gv)
2384 {
2385     SV * const sv = sv_newmortal();
2386
2387     PERL_ARGS_ASSERT_XMLDUMP_FORM;
2388
2389     gv_fullname3(sv, gv, NULL);
2390     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2391     if (CvROOT(GvFORM(gv)))
2392         op_xmldump(CvROOT(GvFORM(gv)));
2393     else
2394         Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2395 }
2396
2397 void
2398 Perl_xmldump_eval(pTHX)
2399 {
2400     op_xmldump(PL_eval_root);
2401 }
2402
2403 char *
2404 Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
2405 {
2406     PERL_ARGS_ASSERT_SV_CATXMLSV;
2407     return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2408 }
2409
2410 char *
2411 Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
2412 {
2413     PERL_ARGS_ASSERT_SV_CATXMLPV;
2414     return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
2415 }
2416
2417 char *
2418 Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
2419 {
2420     unsigned int c;
2421     const char * const e = pv + len;
2422     const char * const start = pv;
2423     STRLEN dsvcur;
2424     STRLEN cl;
2425
2426     PERL_ARGS_ASSERT_SV_CATXMLPVN;
2427
2428     sv_catpvs(dsv,"");
2429     dsvcur = SvCUR(dsv);        /* in case we have to restart */
2430
2431   retry:
2432     while (pv < e) {
2433         if (utf8) {
2434             c = utf8_to_uvchr_buf((U8*)pv, (U8*)e, &cl);
2435             if (cl == 0) {
2436                 SvCUR(dsv) = dsvcur;
2437                 pv = start;
2438                 utf8 = 0;
2439                 goto retry;
2440             }
2441         }
2442         else
2443             c = (*pv & 255);
2444
2445         switch (c) {
2446         case 0x00:
2447         case 0x01:
2448         case 0x02:
2449         case 0x03:
2450         case 0x04:
2451         case 0x05:
2452         case 0x06:
2453         case 0x07:
2454         case 0x08:
2455         case 0x0b:
2456         case 0x0c:
2457         case 0x0e:
2458         case 0x0f:
2459         case 0x10:
2460         case 0x11:
2461         case 0x12:
2462         case 0x13:
2463         case 0x14:
2464         case 0x15:
2465         case 0x16:
2466         case 0x17:
2467         case 0x18:
2468         case 0x19:
2469         case 0x1a:
2470         case 0x1b:
2471         case 0x1c:
2472         case 0x1d:
2473         case 0x1e:
2474         case 0x1f:
2475         case 0x7f:
2476         case 0x80:
2477         case 0x81:
2478         case 0x82:
2479         case 0x83:
2480         case 0x84:
2481         case 0x86:
2482         case 0x87:
2483         case 0x88:
2484         case 0x89:
2485         case 0x90:
2486         case 0x91:
2487         case 0x92:
2488         case 0x93:
2489         case 0x94:
2490         case 0x95:
2491         case 0x96:
2492         case 0x97:
2493         case 0x98:
2494         case 0x99:
2495         case 0x9a:
2496         case 0x9b:
2497         case 0x9c:
2498         case 0x9d:
2499         case 0x9e:
2500         case 0x9f:
2501             Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2502             break;
2503         case '<':
2504             sv_catpvs(dsv, "&lt;");
2505             break;
2506         case '>':
2507             sv_catpvs(dsv, "&gt;");
2508             break;
2509         case '&':
2510             sv_catpvs(dsv, "&amp;");
2511             break;
2512         case '"':
2513             sv_catpvs(dsv, "&#34;");
2514             break;
2515         default:
2516             if (c < 0xD800) {
2517                 if (c < 32 || c > 127) {
2518                     Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2519                 }
2520                 else {
2521                     const char string = (char) c;
2522                     sv_catpvn(dsv, &string, 1);
2523                 }
2524                 break;
2525             }
2526             if ((c >= 0xD800 && c <= 0xDB7F) ||
2527                 (c >= 0xDC00 && c <= 0xDFFF) ||
2528                 (c >= 0xFFF0 && c <= 0xFFFF) ||
2529                  c > 0x10ffff)
2530                 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2531             else
2532                 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2533         }
2534
2535         if (utf8)
2536             pv += UTF8SKIP(pv);
2537         else
2538             pv++;
2539     }
2540
2541     return SvPVX(dsv);
2542 }
2543
2544 char *
2545 Perl_sv_xmlpeek(pTHX_ SV *sv)
2546 {
2547     SV * const t = sv_newmortal();
2548     STRLEN n_a;
2549     int unref = 0;
2550
2551     PERL_ARGS_ASSERT_SV_XMLPEEK;
2552
2553     sv_utf8_upgrade(t);
2554     sv_setpvs(t, "");
2555     /* retry: */
2556     if (!sv) {
2557         sv_catpv(t, "VOID=\"\"");
2558         goto finish;
2559     }
2560     else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') {
2561         sv_catpv(t, "WILD=\"\"");
2562         goto finish;
2563     }
2564     else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
2565         if (sv == &PL_sv_undef) {
2566             sv_catpv(t, "SV_UNDEF=\"1\"");
2567             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2568                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
2569                 SvREADONLY(sv))
2570                 goto finish;
2571         }
2572         else if (sv == &PL_sv_no) {
2573             sv_catpv(t, "SV_NO=\"1\"");
2574             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2575                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
2576                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2577                                   SVp_POK|SVp_NOK)) &&
2578                 SvCUR(sv) == 0 &&
2579                 SvNVX(sv) == 0.0)
2580                 goto finish;
2581         }
2582         else if (sv == &PL_sv_yes) {
2583             sv_catpv(t, "SV_YES=\"1\"");
2584             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2585                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
2586                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2587                                   SVp_POK|SVp_NOK)) &&
2588                 SvCUR(sv) == 1 &&
2589                 SvPVX(sv) && *SvPVX(sv) == '1' &&
2590                 SvNVX(sv) == 1.0)
2591                 goto finish;
2592         }
2593         else {
2594             sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2595             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2596                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
2597                 SvREADONLY(sv))
2598                 goto finish;
2599         }
2600         sv_catpv(t, " XXX=\"\" ");
2601     }
2602     else if (SvREFCNT(sv) == 0) {
2603         sv_catpv(t, " refcnt=\"0\"");
2604         unref++;
2605     }
2606     else if (DEBUG_R_TEST_) {
2607         int is_tmp = 0;
2608         I32 ix;
2609         /* is this SV on the tmps stack? */
2610         for (ix=PL_tmps_ix; ix>=0; ix--) {
2611             if (PL_tmps_stack[ix] == sv) {
2612                 is_tmp = 1;
2613                 break;
2614             }
2615         }
2616         if (SvREFCNT(sv) > 1)
2617             Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2618                     is_tmp ? "T" : "");
2619         else if (is_tmp)
2620             sv_catpv(t, " DRT=\"<T>\"");
2621     }
2622
2623     if (SvROK(sv)) {
2624         sv_catpv(t, " ROK=\"\"");
2625     }
2626     switch (SvTYPE(sv)) {
2627     default:
2628         sv_catpv(t, " FREED=\"1\"");
2629         goto finish;
2630
2631     case SVt_NULL:
2632         sv_catpv(t, " UNDEF=\"1\"");
2633         goto finish;
2634     case SVt_IV:
2635         sv_catpv(t, " IV=\"");
2636         break;
2637     case SVt_NV:
2638         sv_catpv(t, " NV=\"");
2639         break;
2640     case SVt_PV:
2641         sv_catpv(t, " PV=\"");
2642         break;
2643     case SVt_PVIV:
2644         sv_catpv(t, " PVIV=\"");
2645         break;
2646     case SVt_PVNV:
2647         sv_catpv(t, " PVNV=\"");
2648         break;
2649     case SVt_PVMG:
2650         sv_catpv(t, " PVMG=\"");
2651         break;
2652     case SVt_PVLV:
2653         sv_catpv(t, " PVLV=\"");
2654         break;
2655     case SVt_PVAV:
2656         sv_catpv(t, " AV=\"");
2657         break;
2658     case SVt_PVHV:
2659         sv_catpv(t, " HV=\"");
2660         break;
2661     case SVt_PVCV:
2662         if (CvGV(sv))
2663             Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2664         else
2665             sv_catpv(t, " CV=\"()\"");
2666         goto finish;
2667     case SVt_PVGV:
2668         sv_catpv(t, " GV=\"");
2669         break;
2670     case SVt_BIND:
2671         sv_catpv(t, " BIND=\"");
2672         break;
2673     case SVt_REGEXP:
2674         sv_catpv(t, " REGEXP=\"");
2675         break;
2676     case SVt_PVFM:
2677         sv_catpv(t, " FM=\"");
2678         break;
2679     case SVt_PVIO:
2680         sv_catpv(t, " IO=\"");
2681         break;
2682     }
2683
2684     if (SvPOKp(sv)) {
2685         if (SvPVX(sv)) {
2686             sv_catxmlsv(t, sv);
2687         }
2688     }
2689     else if (SvNOKp(sv)) {
2690         STORE_NUMERIC_LOCAL_SET_STANDARD();
2691         Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2692         RESTORE_NUMERIC_LOCAL();
2693     }
2694     else if (SvIOKp(sv)) {
2695         if (SvIsUV(sv))
2696             Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2697         else
2698             Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2699     }
2700     else
2701         sv_catpv(t, "");
2702     sv_catpv(t, "\"");
2703
2704   finish:
2705     while (unref--)
2706         sv_catpv(t, ")");
2707     return SvPV(t, n_a);
2708 }
2709
2710 void
2711 Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
2712 {
2713     PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
2714
2715     if (!pm) {
2716         Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
2717         return;
2718     }
2719     Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
2720     level++;
2721     if (PM_GETRE(pm)) {
2722         REGEXP *const r = PM_GETRE(pm);
2723         SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
2724         sv_catxmlsv(tmpsv, MUTABLE_SV(r));
2725         Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2726              SvPVX(tmpsv));
2727         SvREFCNT_dec(tmpsv);
2728         Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2729              (pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2730     }
2731     else
2732         Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
2733     if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
2734         SV * const tmpsv = pm_description(pm);
2735         Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2736         SvREFCNT_dec(tmpsv);
2737     }
2738
2739     level--;
2740     if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
2741         Perl_xmldump_indent(aTHX_ level, file, ">\n");
2742         Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
2743         do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
2744         Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
2745         Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
2746     }
2747     else
2748         Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2749 }
2750
2751 void
2752 Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2753 {
2754     do_pmop_xmldump(0, PL_xmlfp, pm);
2755 }
2756
2757 void
2758 Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
2759 {
2760     UV      seq;
2761     int     contents = 0;
2762
2763     PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
2764
2765     if (!o)
2766         return;
2767     seq = sequence_num(o);
2768     Perl_xmldump_indent(aTHX_ level, file,
2769         "<op_%s seq=\"%"UVuf" -> ",
2770              OP_NAME(o),
2771                       seq);
2772     level++;
2773     if (o->op_next)
2774         PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2775                       sequence_num(o->op_next));
2776     else
2777         PerlIO_printf(file, "DONE\"");
2778
2779     if (o->op_targ) {
2780         if (o->op_type == OP_NULL)
2781         {
2782             PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2783             if (o->op_targ == OP_NEXTSTATE)
2784             {
2785                 if (CopLINE(cCOPo))
2786                     PerlIO_printf(file, " line=\"%"UVuf"\"",
2787                                      (UV)CopLINE(cCOPo));
2788                 if (CopSTASHPV(cCOPo))
2789                     PerlIO_printf(file, " package=\"%s\"",
2790                                      CopSTASHPV(cCOPo));
2791                 if (CopLABEL(cCOPo))
2792                     PerlIO_printf(file, " label=\"%s\"",
2793                                      CopLABEL(cCOPo));
2794             }
2795         }
2796         else
2797             PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2798     }
2799 #ifdef DUMPADDR
2800     PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2801 #endif
2802     if (o->op_flags) {
2803         SV * const tmpsv = newSVpvs("");
2804         switch (o->op_flags & OPf_WANT) {
2805         case OPf_WANT_VOID:
2806             sv_catpv(tmpsv, ",VOID");
2807             break;
2808         case OPf_WANT_SCALAR:
2809             sv_catpv(tmpsv, ",SCALAR");
2810             break;
2811         case OPf_WANT_LIST:
2812             sv_catpv(tmpsv, ",LIST");
2813             break;
2814         default:
2815             sv_catpv(tmpsv, ",UNKNOWN");
2816             break;
2817         }
2818         if (o->op_flags & OPf_KIDS)
2819             sv_catpv(tmpsv, ",KIDS");
2820         if (o->op_flags & OPf_PARENS)
2821             sv_catpv(tmpsv, ",PARENS");
2822         if (o->op_flags & OPf_STACKED)
2823             sv_catpv(tmpsv, ",STACKED");
2824         if (o->op_flags & OPf_REF)
2825             sv_catpv(tmpsv, ",REF");
2826         if (o->op_flags & OPf_MOD)
2827             sv_catpv(tmpsv, ",MOD");
2828         if (o->op_flags & OPf_SPECIAL)
2829             sv_catpv(tmpsv, ",SPECIAL");
2830         PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2831         SvREFCNT_dec(tmpsv);
2832     }
2833     if (o->op_private) {
2834         SV * const tmpsv = newSVpvs("");
2835         if (PL_opargs[o->op_type] & OA_TARGLEX) {
2836             if (o->op_private & OPpTARGET_MY)
2837                 sv_catpv(tmpsv, ",TARGET_MY");
2838         }
2839         else if (o->op_type == OP_LEAVESUB ||
2840                  o->op_type == OP_LEAVE ||
2841                  o->op_type == OP_LEAVESUBLV ||
2842                  o->op_type == OP_LEAVEWRITE) {
2843             if (o->op_private & OPpREFCOUNTED)
2844                 sv_catpv(tmpsv, ",REFCOUNTED");
2845         }
2846         else if (o->op_type == OP_AASSIGN) {
2847             if (o->op_private & OPpASSIGN_COMMON)
2848                 sv_catpv(tmpsv, ",COMMON");
2849         }
2850         else if (o->op_type == OP_SASSIGN) {
2851             if (o->op_private & OPpASSIGN_BACKWARDS)
2852                 sv_catpv(tmpsv, ",BACKWARDS");
2853         }
2854         else if (o->op_type == OP_TRANS) {
2855             if (o->op_private & OPpTRANS_SQUASH)
2856                 sv_catpv(tmpsv, ",SQUASH");
2857             if (o->op_private & OPpTRANS_DELETE)
2858                 sv_catpv(tmpsv, ",DELETE");
2859             if (o->op_private & OPpTRANS_COMPLEMENT)
2860                 sv_catpv(tmpsv, ",COMPLEMENT");
2861             if (o->op_private & OPpTRANS_IDENTICAL)
2862                 sv_catpv(tmpsv, ",IDENTICAL");
2863             if (o->op_private & OPpTRANS_GROWS)
2864                 sv_catpv(tmpsv, ",GROWS");
2865         }
2866         else if (o->op_type == OP_REPEAT) {
2867             if (o->op_private & OPpREPEAT_DOLIST)
2868                 sv_catpv(tmpsv, ",DOLIST");
2869         }
2870         else if (o->op_type == OP_ENTERSUB ||
2871                  o->op_type == OP_RV2SV ||
2872                  o->op_type == OP_GVSV ||
2873                  o->op_type == OP_RV2AV ||
2874                  o->op_type == OP_RV2HV ||
2875                  o->op_type == OP_RV2GV ||
2876                  o->op_type == OP_AELEM ||
2877                  o->op_type == OP_HELEM )
2878         {
2879             if (o->op_type == OP_ENTERSUB) {
2880                 if (o->op_private & OPpENTERSUB_AMPER)
2881                     sv_catpv(tmpsv, ",AMPER");
2882                 if (o->op_private & OPpENTERSUB_DB)
2883                     sv_catpv(tmpsv, ",DB");
2884                 if (o->op_private & OPpENTERSUB_HASTARG)
2885                     sv_catpv(tmpsv, ",HASTARG");
2886                 if (o->op_private & OPpENTERSUB_NOPAREN)
2887                     sv_catpv(tmpsv, ",NOPAREN");
2888                 if (o->op_private & OPpENTERSUB_INARGS)
2889                     sv_catpv(tmpsv, ",INARGS");
2890             }
2891             else {
2892                 switch (o->op_private & OPpDEREF) {
2893             case OPpDEREF_SV:
2894                 sv_catpv(tmpsv, ",SV");
2895                 break;
2896             case OPpDEREF_AV:
2897                 sv_catpv(tmpsv, ",AV");
2898                 break;
2899             case OPpDEREF_HV:
2900                 sv_catpv(tmpsv, ",HV");
2901                 break;
2902             }
2903                 if (o->op_private & OPpMAYBE_LVSUB)
2904                     sv_catpv(tmpsv, ",MAYBE_LVSUB");
2905             }
2906             if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
2907                 if (o->op_private & OPpLVAL_DEFER)
2908                     sv_catpv(tmpsv, ",LVAL_DEFER");
2909             }
2910             else {
2911                 if (o->op_private & HINT_STRICT_REFS)
2912                     sv_catpv(tmpsv, ",STRICT_REFS");
2913                 if (o->op_private & OPpOUR_INTRO)
2914                     sv_catpv(tmpsv, ",OUR_INTRO");
2915             }
2916         }
2917         else if (o->op_type == OP_CONST) {
2918             if (o->op_private & OPpCONST_BARE)
2919                 sv_catpv(tmpsv, ",BARE");
2920             if (o->op_private & OPpCONST_STRICT)
2921                 sv_catpv(tmpsv, ",STRICT");
2922             if (o->op_private & OPpCONST_ENTERED)
2923                 sv_catpv(tmpsv, ",ENTERED");
2924         }
2925         else if (o->op_type == OP_FLIP) {
2926             if (o->op_private & OPpFLIP_LINENUM)
2927                 sv_catpv(tmpsv, ",LINENUM");
2928         }
2929         else if (o->op_type == OP_FLOP) {
2930             if (o->op_private & OPpFLIP_LINENUM)
2931                 sv_catpv(tmpsv, ",LINENUM");
2932         }
2933         else if (o->op_type == OP_RV2CV) {
2934             if (o->op_private & OPpLVAL_INTRO)
2935                 sv_catpv(tmpsv, ",INTRO");
2936         }
2937         else if (o->op_type == OP_GV) {
2938             if (o->op_private & OPpEARLY_CV)
2939                 sv_catpv(tmpsv, ",EARLY_CV");
2940         }
2941         else if (o->op_type == OP_LIST) {
2942             if (o->op_private & OPpLIST_GUESSED)
2943                 sv_catpv(tmpsv, ",GUESSED");
2944         }
2945         else if (o->op_type == OP_DELETE) {
2946             if (o->op_private & OPpSLICE)
2947                 sv_catpv(tmpsv, ",SLICE");
2948         }
2949         else if (o->op_type == OP_EXISTS) {
2950             if (o->op_private & OPpEXISTS_SUB)
2951                 sv_catpv(tmpsv, ",EXISTS_SUB");
2952         }
2953         else if (o->op_type == OP_SORT) {
2954             if (o->op_private & OPpSORT_NUMERIC)
2955                 sv_catpv(tmpsv, ",NUMERIC");
2956             if (o->op_private & OPpSORT_INTEGER)
2957                 sv_catpv(tmpsv, ",INTEGER");
2958             if (o->op_private & OPpSORT_REVERSE)
2959                 sv_catpv(tmpsv, ",REVERSE");
2960         }
2961         else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
2962             if (o->op_private & OPpOPEN_IN_RAW)
2963                 sv_catpv(tmpsv, ",IN_RAW");
2964             if (o->op_private & OPpOPEN_IN_CRLF)
2965                 sv_catpv(tmpsv, ",IN_CRLF");
2966             if (o->op_private & OPpOPEN_OUT_RAW)
2967                 sv_catpv(tmpsv, ",OUT_RAW");
2968             if (o->op_private & OPpOPEN_OUT_CRLF)
2969                 sv_catpv(tmpsv, ",OUT_CRLF");
2970         }
2971         else if (o->op_type == OP_EXIT) {
2972             if (o->op_private & OPpEXIT_VMSISH)
2973                 sv_catpv(tmpsv, ",EXIT_VMSISH");
2974             if (o->op_private & OPpHUSH_VMSISH)
2975                 sv_catpv(tmpsv, ",HUSH_VMSISH");
2976         }
2977         else if (o->op_type == OP_DIE) {
2978             if (o->op_private & OPpHUSH_VMSISH)
2979                 sv_catpv(tmpsv, ",HUSH_VMSISH");
2980         }
2981         else if (PL_check[o->op_type] != Perl_ck_ftst) {
2982             if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
2983                 sv_catpv(tmpsv, ",FT_ACCESS");
2984             if (o->op_private & OPpFT_STACKED)
2985                 sv_catpv(tmpsv, ",FT_STACKED");
2986         }
2987         if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
2988             sv_catpv(tmpsv, ",INTRO");
2989         if (SvCUR(tmpsv))
2990             S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
2991         SvREFCNT_dec(tmpsv);
2992     }
2993
2994     switch (o->op_type) {
2995     case OP_AELEMFAST:
2996         if (o->op_flags & OPf_SPECIAL) {
2997             break;
2998         }
2999     case OP_GVSV:
3000     case OP_GV:
3001 #ifdef USE_ITHREADS
3002         S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
3003 #else
3004         if (cSVOPo->op_sv) {
3005             SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
3006             SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
3007             char *s;
3008             STRLEN len;
3009             ENTER;
3010             SAVEFREESV(tmpsv1);
3011             SAVEFREESV(tmpsv2);
3012             gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
3013             s = SvPV(tmpsv1,len);
3014             sv_catxmlpvn(tmpsv2, s, len, 1);
3015             S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
3016             LEAVE;
3017         }
3018         else
3019             S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
3020 #endif
3021         break;
3022     case OP_CONST:
3023     case OP_HINTSEVAL:
3024     case OP_METHOD_NAMED:
3025 #ifndef USE_ITHREADS
3026         /* with ITHREADS, consts are stored in the pad, and the right pad
3027          * may not be active here, so skip */
3028         S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
3029 #endif
3030         break;
3031     case OP_ANONCODE:
3032         if (!contents) {
3033             contents = 1;
3034             PerlIO_printf(file, ">\n");
3035         }
3036         do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
3037         break;
3038     case OP_NEXTSTATE:
3039     case OP_DBSTATE:
3040         if (CopLINE(cCOPo))
3041             S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
3042                              (UV)CopLINE(cCOPo));
3043         if (CopSTASHPV(cCOPo))
3044             S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
3045                              CopSTASHPV(cCOPo));
3046         if (CopLABEL(cCOPo))
3047             S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
3048                              CopLABEL(cCOPo));
3049         break;
3050     case OP_ENTERLOOP:
3051         S_xmldump_attr(aTHX_ level, file, "redo=\"");
3052         if (cLOOPo->op_redoop)
3053             PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
3054         else
3055             PerlIO_printf(file, "DONE\"");
3056         S_xmldump_attr(aTHX_ level, file, "next=\"");
3057         if (cLOOPo->op_nextop)
3058             PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
3059         else
3060             PerlIO_printf(file, "DONE\"");
3061         S_xmldump_attr(aTHX_ level, file, "last=\"");
3062         if (cLOOPo->op_lastop)
3063             PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
3064         else
3065             PerlIO_printf(file, "DONE\"");
3066         break;
3067     case OP_COND_EXPR:
3068     case OP_RANGE:
3069     case OP_MAPWHILE:
3070     case OP_GREPWHILE:
3071     case OP_OR:
3072     case OP_AND:
3073         S_xmldump_attr(aTHX_ level, file, "other=\"");
3074         if (cLOGOPo->op_other)
3075             PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
3076         else
3077             PerlIO_printf(file, "DONE\"");
3078         break;
3079     case OP_LEAVE:
3080     case OP_LEAVEEVAL:
3081     case OP_LEAVESUB:
3082     case OP_LEAVESUBLV:
3083     case OP_LEAVEWRITE:
3084     case OP_SCOPE:
3085         if (o->op_private & OPpREFCOUNTED)
3086             S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
3087         break;
3088     default:
3089         break;
3090     }
3091
3092     if (PL_madskills && o->op_madprop) {
3093         char prevkey = '\0';
3094         SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
3095         const MADPROP* mp = o->op_madprop;
3096
3097         if (!contents) {
3098             contents = 1;
3099             PerlIO_printf(file, ">\n");
3100         }
3101         Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
3102         level++;
3103         while (mp) {
3104             char tmp = mp->mad_key;
3105             sv_setpvs(tmpsv,"\"");
3106             if (tmp)
3107                 sv_catxmlpvn(tmpsv, &tmp, 1, 0);
3108             if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
3109                 sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
3110             else
3111                 prevkey = tmp;
3112             sv_catpv(tmpsv, "\"");
3113             switch (mp->mad_type) {
3114             case MAD_NULL:
3115                 sv_catpv(tmpsv, "NULL");
3116                 Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
3117                 break;
3118             case MAD_PV:
3119                 sv_catpv(tmpsv, " val=\"");
3120                 sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
3121                 sv_catpv(tmpsv, "\"");
3122                 Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
3123                 break;
3124             case MAD_SV:
3125                 sv_catpv(tmpsv, " val=\"");
3126                 sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
3127                 sv_catpv(tmpsv, "\"");
3128                 Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
3129                 break;
3130             case MAD_OP:
3131                 if ((OP*)mp->mad_val) {
3132                     Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
3133                     do_op_xmldump(level+1, file, (OP*)mp->mad_val);
3134                     Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
3135                 }
3136                 break;
3137             default:
3138                 Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
3139                 break;
3140             }
3141             mp = mp->mad_next;
3142         }
3143         level--;
3144         Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
3145
3146         SvREFCNT_dec(tmpsv);
3147     }
3148
3149     switch (o->op_type) {
3150     case OP_PUSHRE:
3151     case OP_MATCH:
3152     case OP_QR:
3153     case OP_SUBST:
3154         if (!contents) {
3155             contents = 1;
3156             PerlIO_printf(file, ">\n");
3157         }
3158         do_pmop_xmldump(level, file, cPMOPo);
3159         break;
3160     default:
3161         break;
3162     }
3163
3164     if (o->op_flags & OPf_KIDS) {
3165         OP *kid;
3166         if (!contents) {
3167             contents = 1;
3168             PerlIO_printf(file, ">\n");
3169         }
3170         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3171             do_op_xmldump(level, file, kid);
3172     }
3173
3174     if (contents)
3175         Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
3176     else
3177         PerlIO_printf(file, " />\n");
3178 }
3179
3180 void
3181 Perl_op_xmldump(pTHX_ const OP *o)
3182 {
3183     PERL_ARGS_ASSERT_OP_XMLDUMP;
3184
3185     do_op_xmldump(0, PL_xmlfp, o);
3186 }
3187 #endif
3188
3189 /*
3190  * Local variables:
3191  * c-indentation-style: bsd
3192  * c-basic-offset: 4
3193  * indent-tabs-mode: nil
3194  * End:
3195  *
3196  * ex: set ts=8 sts=4 sw=4 et:
3197  */