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