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