dump.c

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