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