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