dump.c

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