dump.c

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