dump.c

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