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 =head1 Display and Dump functions
  25  */
  26
  27 #include "EXTERN.h"
  28 #define PERL_IN_DUMP_C
  29 #include "perl.h"
  30 #include "regcomp.h"
  31
  32 static const char* const svtypenames[SVt_LAST] = {
  33     "NULL",
  34     "IV",
  35     "NV",
  36     "PV",
  37     "INVLIST",
  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     "IV",
  55     "NV",
  56     "PV",
  57     "INVLST",
  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 #define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
  90                               (len) * (4+UTF8_MAXBYTES) + 1, NULL, \
  91                               PERL_PV_ESCAPE_NONASCII | PERL_PV_ESCAPE_DWIM \
  92                               | ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
  93
  94 /*
  95 =for apidoc pv_escape
  96
  97 Escapes at most the first "count" chars of pv and puts the results into
  98 dsv such that the size of the escaped string will not exceed "max" chars
  99 and will not contain any incomplete escape sequences.
 100
 101 If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
 102 will also be escaped.
 103
 104 Normally the SV will be cleared before the escaped string is prepared,
 105 but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
 106
 107 If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
 108 if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
 109 using C<is_utf8_string()> to determine if it is Unicode.
 110
 111 If PERL_PV_ESCAPE_ALL is set then all input chars will be output
 112 using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
 113 non-ASCII chars will be escaped using this style; otherwise, only chars above
 114 255 will be so escaped; other non printable chars will use octal or
 115 common escaped patterns like C<\n>.
 116 Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
 117 then all chars below 255 will be treated as printable and
 118 will be output as literals.
 119
 120 If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
 121 string will be escaped, regardless of max.  If the output is to be in hex,
 122 then it will be returned as a plain hex
 123 sequence.  Thus the output will either be a single char,
 124 an octal escape sequence, a special escape like C<\n> or a hex value.
 125
 126 If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
 127 not a '\\'.  This is because regexes very often contain backslashed
 128 sequences, whereas '%' is not a particularly common character in patterns.
 129
 130 Returns a pointer to the escaped text as held by dsv.
 131
 132 =cut
 133 */
 134 #define PV_ESCAPE_OCTBUFSIZE 32
 135
 136 char *
 137 Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
 138                 const STRLEN count, const STRLEN max,
 139                 STRLEN * const escaped, const U32 flags )
 140 {
 141     const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
 142     const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
 143     char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
 144     STRLEN wrote = 0;    /* chars written so far */
 145     STRLEN chsize = 0;   /* size of data to be written */
 146     STRLEN readsize = 1; /* size of data just read */
 147     bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
 148     const char *pv  = str;
 149     const char * const end = pv + count; /* end of string */
 150     octbuf[0] = esc;
 151
 152     PERL_ARGS_ASSERT_PV_ESCAPE;
 153
 154     if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
 155             /* This won't alter the UTF-8 flag */
 156             sv_setpvs(dsv, "");
 157     }
 158
 159     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
 160         isuni = 1;
 161
 162     for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
 163         const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
 164         const U8 c = (U8)u & 0xFF;
 165
 166         if ( ( u > 255 )
 167           || (flags & PERL_PV_ESCAPE_ALL)
 168           || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM))))
 169         {
 170             if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
 171                 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
 172                                       "%"UVxf, u);
 173             else
 174                 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
 175                                       ((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
 176                                       ? "%cx%02"UVxf
 177                                       : "%cx{%02"UVxf"}", esc, u);
 178
 179         } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
 180             chsize = 1;
 181         } else {
 182             if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
 183                 chsize = 2;
 184                 switch (c) {
 185
 186                 case '\\' : /* FALLTHROUGH */
 187                 case '%'  : if ( c == esc )  {
 188                                 octbuf[1] = esc;
 189                             } else {
 190                                 chsize = 1;
 191                             }
 192                             break;
 193                 case '\v' : octbuf[1] = 'v';  break;
 194                 case '\t' : octbuf[1] = 't';  break;
 195                 case '\r' : octbuf[1] = 'r';  break;
 196                 case '\n' : octbuf[1] = 'n';  break;
 197                 case '\f' : octbuf[1] = 'f';  break;
 198                 case '"'  :
 199                         if ( dq == '"' )
 200                                 octbuf[1] = '"';
 201                         else
 202                             chsize = 1;
 203                         break;
 204                 default:
 205                      if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
 206                         chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
 207                                       isuni ? "%cx{%02"UVxf"}" : "%cx%02"UVxf,
 208                                       esc, u);
 209                      }
 210                      else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
 211                             chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
 212                                                   "%c%03o", esc, c);
 213                         else
 214                             chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
 215                                                   "%c%o", esc, c);
 216                 }
 217             } else {
 218                 chsize = 1;
 219             }
 220         }
 221         if ( max && (wrote + chsize > max) ) {
 222             break;
 223         } else if (chsize > 1) {
 224             sv_catpvn(dsv, octbuf, chsize);
 225             wrote += chsize;
 226         } else {
 227             /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
 228                can be appended raw to the dsv. If dsv happens to be
 229                UTF-8 then we need catpvf to upgrade them for us.
 230                Or add a new API call sv_catpvc(). Think about that name, and
 231                how to keep it clear that it's unlike the s of catpvs, which is
 232                really an array of octets, not a string.  */
 233             Perl_sv_catpvf( aTHX_ dsv, "%c", c);
 234             wrote++;
 235         }
 236         if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
 237             break;
 238     }
 239     if (escaped != NULL)
 240         *escaped= pv - str;
 241     return SvPVX(dsv);
 242 }
 243 /*
 244 =for apidoc pv_pretty
 245
 246 Converts a string into something presentable, handling escaping via
 247 pv_escape() and supporting quoting and ellipses.
 248
 249 If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
 250 double quoted with any double quotes in the string escaped.  Otherwise
 251 if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
 252 angle brackets.
 253
 254 If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
 255 string were output then an ellipsis C<...> will be appended to the
 256 string.  Note that this happens AFTER it has been quoted.
 257
 258 If start_color is non-null then it will be inserted after the opening
 259 quote (if there is one) but before the escaped text.  If end_color
 260 is non-null then it will be inserted after the escaped text but before
 261 any quotes or ellipses.
 262
 263 Returns a pointer to the prettified text as held by dsv.
 264
 265 =cut
 266 */
 267
 268 char *
 269 Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
 270   const STRLEN max, char const * const start_color, char const * const end_color,
 271   const U32 flags )
 272 {
 273     const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
 274     STRLEN escaped;
 275
 276     PERL_ARGS_ASSERT_PV_PRETTY;
 277
 278     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
 279             /* This won't alter the UTF-8 flag */
 280             sv_setpvs(dsv, "");
 281     }
 282
 283     if ( dq == '"' )
 284         sv_catpvs(dsv, "\"");
 285     else if ( flags & PERL_PV_PRETTY_LTGT )
 286         sv_catpvs(dsv, "<");
 287
 288     if ( start_color != NULL )
 289         sv_catpv(dsv, start_color);
 290
 291     pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
 292
 293     if ( end_color != NULL )
 294         sv_catpv(dsv, end_color);
 295
 296     if ( dq == '"' )
 297         sv_catpvs( dsv, "\"");
 298     else if ( flags & PERL_PV_PRETTY_LTGT )
 299         sv_catpvs(dsv, ">");
 300
 301     if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
 302             sv_catpvs(dsv, "...");
 303
 304     return SvPVX(dsv);
 305 }
 306
 307 /*
 308 =for apidoc pv_display
 309
 310 Similar to
 311
 312   pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
 313
 314 except that an additional "\0" will be appended to the string when
 315 len > cur and pv[cur] is "\0".
 316
 317 Note that the final string may be up to 7 chars longer than pvlim.
 318
 319 =cut
 320 */
 321
 322 char *
 323 Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 324 {
 325     PERL_ARGS_ASSERT_PV_DISPLAY;
 326
 327     pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
 328     if (len > cur && pv[cur] == '\0')
 329             sv_catpvs( dsv, "\\0");
 330     return SvPVX(dsv);
 331 }
 332
 333 char *
 334 Perl_sv_peek(pTHX_ SV *sv)
 335 {
 336     dVAR;
 337     SV * const t = sv_newmortal();
 338     int unref = 0;
 339     U32 type;
 340
 341     sv_setpvs(t, "");
 342   retry:
 343     if (!sv) {
 344         sv_catpv(t, "VOID");
 345         goto finish;
 346     }
 347     else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
 348         /* detect data corruption under memory poisoning */
 349         sv_catpv(t, "WILD");
 350         goto finish;
 351     }
 352     else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
 353         if (sv == &PL_sv_undef) {
 354             sv_catpv(t, "SV_UNDEF");
 355             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
 356                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 357                 SvREADONLY(sv))
 358                 goto finish;
 359         }
 360         else if (sv == &PL_sv_no) {
 361             sv_catpv(t, "SV_NO");
 362             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 363                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 364                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 365                                   SVp_POK|SVp_NOK)) &&
 366                 SvCUR(sv) == 0 &&
 367                 SvNVX(sv) == 0.0)
 368                 goto finish;
 369         }
 370         else if (sv == &PL_sv_yes) {
 371             sv_catpv(t, "SV_YES");
 372             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 373                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 374                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 375                                   SVp_POK|SVp_NOK)) &&
 376                 SvCUR(sv) == 1 &&
 377                 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
 378                 SvNVX(sv) == 1.0)
 379                 goto finish;
 380         }
 381         else {
 382             sv_catpv(t, "SV_PLACEHOLDER");
 383             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
 384                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 385                 SvREADONLY(sv))
 386                 goto finish;
 387         }
 388         sv_catpv(t, ":");
 389     }
 390     else if (SvREFCNT(sv) == 0) {
 391         sv_catpv(t, "(");
 392         unref++;
 393     }
 394     else if (DEBUG_R_TEST_) {
 395         int is_tmp = 0;
 396         SSize_t ix;
 397         /* is this SV on the tmps stack? */
 398         for (ix=PL_tmps_ix; ix>=0; ix--) {
 399             if (PL_tmps_stack[ix] == sv) {
 400                 is_tmp = 1;
 401                 break;
 402             }
 403         }
 404         if (SvREFCNT(sv) > 1)
 405             Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
 406                     is_tmp ? "T" : "");
 407         else if (is_tmp)
 408             sv_catpv(t, "<T>");
 409     }
 410
 411     if (SvROK(sv)) {
 412         sv_catpv(t, "\\");
 413         if (SvCUR(t) + unref > 10) {
 414             SvCUR_set(t, unref + 3);
 415             *SvEND(t) = '\0';
 416             sv_catpv(t, "...");
 417             goto finish;
 418         }
 419         sv = SvRV(sv);
 420         goto retry;
 421     }
 422     type = SvTYPE(sv);
 423     if (type == SVt_PVCV) {
 424         SV * const tmp = newSVpvs_flags("", SVs_TEMP);
 425         GV* gvcv = CvGV(sv);
 426         Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
 427                        ? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
 428                        : "");
 429         goto finish;
 430     } else if (type < SVt_LAST) {
 431         sv_catpv(t, svshorttypenames[type]);
 432
 433         if (type == SVt_NULL)
 434             goto finish;
 435     } else {
 436         sv_catpv(t, "FREED");
 437         goto finish;
 438     }
 439
 440     if (SvPOKp(sv)) {
 441         if (!SvPVX_const(sv))
 442             sv_catpv(t, "(null)");
 443         else {
 444             SV * const tmp = newSVpvs("");
 445             sv_catpv(t, "(");
 446             if (SvOOK(sv)) {
 447                 STRLEN delta;
 448                 SvOOK_offset(sv, delta);
 449                 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
 450             }
 451             Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
 452             if (SvUTF8(sv))
 453                 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
 454                                sv_uni_display(tmp, sv, 6 * SvCUR(sv),
 455                                               UNI_DISPLAY_QQ));
 456             SvREFCNT_dec_NN(tmp);
 457         }
 458     }
 459     else if (SvNOKp(sv)) {
 460         STORE_NUMERIC_LOCAL_SET_STANDARD();
 461         Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
 462         RESTORE_NUMERIC_LOCAL();
 463     }
 464     else if (SvIOKp(sv)) {
 465         if (SvIsUV(sv))
 466             Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
 467         else
 468             Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
 469     }
 470     else
 471         sv_catpv(t, "()");
 472
 473   finish:
 474     while (unref--)
 475         sv_catpv(t, ")");
 476     if (TAINTING_get && sv && SvTAINTED(sv))
 477         sv_catpv(t, " [tainted]");
 478     return SvPV_nolen(t);
 479 }
 480
 481 /*
 482 =head1 Debugging Utilities
 483 */
 484
 485 void
 486 Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 487 {
 488     va_list args;
 489     PERL_ARGS_ASSERT_DUMP_INDENT;
 490     va_start(args, pat);
 491     dump_vindent(level, file, pat, &args);
 492     va_end(args);
 493 }
 494
 495 void
 496 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 497 {
 498     dVAR;
 499     PERL_ARGS_ASSERT_DUMP_VINDENT;
 500     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
 501     PerlIO_vprintf(file, pat, *args);
 502 }
 503
 504 /*
 505 =for apidoc dump_all
 506
 507 Dumps the entire optree of the current program starting at C<PL_main_root> to
 508 C<STDERR>.  Also dumps the optrees for all visible subroutines in
 509 C<PL_defstash>.
 510
 511 =cut
 512 */
 513
 514 void
 515 Perl_dump_all(pTHX)
 516 {
 517     dump_all_perl(FALSE);
 518 }
 519
 520 void
 521 Perl_dump_all_perl(pTHX_ bool justperl)
 522 {
 523
 524     dVAR;
 525     PerlIO_setlinebuf(Perl_debug_log);
 526     if (PL_main_root)
 527         op_dump(PL_main_root);
 528     dump_packsubs_perl(PL_defstash, justperl);
 529 }
 530
 531 /*
 532 =for apidoc dump_packsubs
 533
 534 Dumps the optrees for all visible subroutines in C<stash>.
 535
 536 =cut
 537 */
 538
 539 void
 540 Perl_dump_packsubs(pTHX_ const HV *stash)
 541 {
 542     PERL_ARGS_ASSERT_DUMP_PACKSUBS;
 543     dump_packsubs_perl(stash, FALSE);
 544 }
 545
 546 void
 547 Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
 548 {
 549     dVAR;
 550     I32 i;
 551
 552     PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
 553
 554     if (!HvARRAY(stash))
 555         return;
 556     for (i = 0; i <= (I32) HvMAX(stash); i++) {
 557         const HE *entry;
 558         for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
 559             const GV * const gv = (const GV *)HeVAL(entry);
 560             if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
 561                 continue;
 562             if (GvCVu(gv))
 563                 dump_sub_perl(gv, justperl);
 564             if (GvFORM(gv))
 565                 dump_form(gv);
 566             if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
 567                 const HV * const hv = GvHV(gv);
 568                 if (hv && (hv != PL_defstash))
 569                     dump_packsubs_perl(hv, justperl); /* nested package */
 570             }
 571         }
 572     }
 573 }
 574
 575 void
 576 Perl_dump_sub(pTHX_ const GV *gv)
 577 {
 578     PERL_ARGS_ASSERT_DUMP_SUB;
 579     dump_sub_perl(gv, FALSE);
 580 }
 581
 582 void
 583 Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
 584 {
 585     STRLEN len;
 586     SV * const sv = newSVpvs_flags("", SVs_TEMP);
 587     SV *tmpsv;
 588     const char * name;
 589
 590     PERL_ARGS_ASSERT_DUMP_SUB_PERL;
 591
 592     if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
 593         return;
 594
 595     tmpsv = newSVpvs_flags("", SVs_TEMP);
 596     gv_fullname3(sv, gv, NULL);
 597     name = SvPV_const(sv, len);
 598     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
 599                      generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
 600     if (CvISXSUB(GvCV(gv)))
 601         Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
 602             PTR2UV(CvXSUB(GvCV(gv))),
 603             (int)CvXSUBANY(GvCV(gv)).any_i32);
 604     else if (CvROOT(GvCV(gv)))
 605         op_dump(CvROOT(GvCV(gv)));
 606     else
 607         Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
 608 }
 609
 610 void
 611 Perl_dump_form(pTHX_ const GV *gv)
 612 {
 613     SV * const sv = sv_newmortal();
 614
 615     PERL_ARGS_ASSERT_DUMP_FORM;
 616
 617     gv_fullname3(sv, gv, NULL);
 618     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
 619     if (CvROOT(GvFORM(gv)))
 620         op_dump(CvROOT(GvFORM(gv)));
 621     else
 622         Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
 623 }
 624
 625 void
 626 Perl_dump_eval(pTHX)
 627 {
 628     dVAR;
 629     op_dump(PL_eval_root);
 630 }
 631
 632 void
 633 Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
 634 {
 635     char ch;
 636
 637     PERL_ARGS_ASSERT_DO_PMOP_DUMP;
 638
 639     if (!pm) {
 640         Perl_dump_indent(aTHX_ level, file, "{}\n");
 641         return;
 642     }
 643     Perl_dump_indent(aTHX_ level, file, "{\n");
 644     level++;
 645     if (pm->op_pmflags & PMf_ONCE)
 646         ch = '?';
 647     else
 648         ch = '/';
 649     if (PM_GETRE(pm))
 650         Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
 651              ch, RX_PRECOMP(PM_GETRE(pm)), ch,
 652              (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
 653     else
 654         Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
 655     if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
 656         Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
 657         op_dump(pm->op_pmreplrootu.op_pmreplroot);
 658     }
 659     if (pm->op_code_list) {
 660         if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
 661             Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
 662             do_op_dump(level, file, pm->op_code_list);
 663         }
 664         else
 665             Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
 666                                     PTR2UV(pm->op_code_list));
 667     }
 668     if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
 669         SV * const tmpsv = pm_description(pm);
 670         Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
 671         SvREFCNT_dec_NN(tmpsv);
 672     }
 673
 674     Perl_dump_indent(aTHX_ level-1, file, "}\n");
 675 }
 676
 677 const struct flag_to_name pmflags_flags_names[] = {
 678     {PMf_CONST, ",CONST"},
 679     {PMf_KEEP, ",KEEP"},
 680     {PMf_GLOBAL, ",GLOBAL"},
 681     {PMf_CONTINUE, ",CONTINUE"},
 682     {PMf_RETAINT, ",RETAINT"},
 683     {PMf_EVAL, ",EVAL"},
 684     {PMf_NONDESTRUCT, ",NONDESTRUCT"},
 685     {PMf_HAS_CV, ",HAS_CV"},
 686     {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
 687     {PMf_IS_QR, ",IS_QR"}
 688 };
 689
 690 static SV *
 691 S_pm_description(pTHX_ const PMOP *pm)
 692 {
 693     SV * const desc = newSVpvs("");
 694     const REGEXP * const regex = PM_GETRE(pm);
 695     const U32 pmflags = pm->op_pmflags;
 696
 697     PERL_ARGS_ASSERT_PM_DESCRIPTION;
 698
 699     if (pmflags & PMf_ONCE)
 700         sv_catpv(desc, ",ONCE");
 701 #ifdef USE_ITHREADS
 702     if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
 703         sv_catpv(desc, ":USED");
 704 #else
 705     if (pmflags & PMf_USED)
 706         sv_catpv(desc, ":USED");
 707 #endif
 708
 709     if (regex) {
 710         if (RX_ISTAINTED(regex))
 711             sv_catpv(desc, ",TAINTED");
 712         if (RX_CHECK_SUBSTR(regex)) {
 713             if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
 714                 sv_catpv(desc, ",SCANFIRST");
 715             if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
 716                 sv_catpv(desc, ",ALL");
 717         }
 718         if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
 719             sv_catpv(desc, ",SKIPWHITE");
 720     }
 721
 722     append_flags(desc, pmflags, pmflags_flags_names);
 723     return desc;
 724 }
 725
 726 void
 727 Perl_pmop_dump(pTHX_ PMOP *pm)
 728 {
 729     do_pmop_dump(0, Perl_debug_log, pm);
 730 }
 731
 732 /* Return a unique integer to represent the address of op o.
 733  * If it already exists in PL_op_sequence, just return it;
 734  * otherwise add it.
 735  *  *** Note that this isn't thread-safe */
 736
 737 STATIC UV
 738 S_sequence_num(pTHX_ const OP *o)
 739 {
 740     dVAR;
 741     SV     *op,
 742           **seq;
 743     const char *key;
 744     STRLEN  len;
 745     if (!o)
 746         return 0;
 747     op = newSVuv(PTR2UV(o));
 748     sv_2mortal(op);
 749     key = SvPV_const(op, len);
 750     if (!PL_op_sequence)
 751         PL_op_sequence = newHV();
 752     seq = hv_fetch(PL_op_sequence, key, len, 0);
 753     if (seq)
 754         return SvUV(*seq);
 755     (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
 756     return PL_op_seq;
 757 }
 758
 759 const struct flag_to_name op_flags_names[] = {
 760     {OPf_KIDS, ",KIDS"},
 761     {OPf_PARENS, ",PARENS"},
 762     {OPf_REF, ",REF"},
 763     {OPf_MOD, ",MOD"},
 764     {OPf_STACKED, ",STACKED"},
 765     {OPf_SPECIAL, ",SPECIAL"}
 766 };
 767
 768 const struct flag_to_name op_trans_names[] = {
 769     {OPpTRANS_FROM_UTF, ",FROM_UTF"},
 770     {OPpTRANS_TO_UTF, ",TO_UTF"},
 771     {OPpTRANS_IDENTICAL, ",IDENTICAL"},
 772     {OPpTRANS_SQUASH, ",SQUASH"},
 773     {OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
 774     {OPpTRANS_GROWS, ",GROWS"},
 775     {OPpTRANS_DELETE, ",DELETE"}
 776 };
 777
 778 const struct flag_to_name op_entersub_names[] = {
 779     {OPpENTERSUB_DB, ",DB"},
 780     {OPpENTERSUB_HASTARG, ",HASTARG"},
 781     {OPpENTERSUB_AMPER, ",AMPER"},
 782     {OPpENTERSUB_NOPAREN, ",NOPAREN"},
 783     {OPpENTERSUB_INARGS, ",INARGS"}
 784 };
 785
 786 const struct flag_to_name op_const_names[] = {
 787     {OPpCONST_NOVER, ",NOVER"},
 788     {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
 789     {OPpCONST_STRICT, ",STRICT"},
 790     {OPpCONST_ENTERED, ",ENTERED"},
 791     {OPpCONST_BARE, ",BARE"}
 792 };
 793
 794 const struct flag_to_name op_sort_names[] = {
 795     {OPpSORT_NUMERIC, ",NUMERIC"},
 796     {OPpSORT_INTEGER, ",INTEGER"},
 797     {OPpSORT_REVERSE, ",REVERSE"},
 798     {OPpSORT_INPLACE, ",INPLACE"},
 799     {OPpSORT_DESCEND, ",DESCEND"},
 800     {OPpSORT_QSORT, ",QSORT"},
 801     {OPpSORT_STABLE, ",STABLE"}
 802 };
 803
 804 const struct flag_to_name op_open_names[] = {
 805     {OPpOPEN_IN_RAW, ",IN_RAW"},
 806     {OPpOPEN_IN_CRLF, ",IN_CRLF"},
 807     {OPpOPEN_OUT_RAW, ",OUT_RAW"},
 808     {OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
 809 };
 810
 811 const struct flag_to_name op_sassign_names[] = {
 812     {OPpASSIGN_BACKWARDS, ",BACKWARDS"},
 813     {OPpASSIGN_CV_TO_GV,  ",CV2GV"}
 814 };
 815
 816 const struct flag_to_name op_leave_names[] = {
 817     {OPpREFCOUNTED, ",REFCOUNTED"},
 818     {OPpLVALUE,     ",LVALUE"}
 819 };
 820
 821 #define OP_PRIVATE_ONCE(op, flag, name) \
 822     const struct flag_to_name CAT2(op, _names)[] = {    \
 823         {(flag), (name)} \
 824     }
 825
 826 OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
 827 OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
 828 OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
 829 OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
 830 OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
 831 OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
 832 OP_PRIVATE_ONCE(op_list, OPpLIST_GUESSED, ",GUESSED");
 833 OP_PRIVATE_ONCE(op_delete, OPpSLICE, ",SLICE");
 834 OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
 835 OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
 836 OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
 837 OP_PRIVATE_ONCE(op_dbstate, OPpHUSH_VMSISH, ",HUSH_VMSISH");
 838
 839 struct op_private_by_op {
 840     U16 op_type;
 841     U16 len;
 842     const struct flag_to_name *start;
 843 };
 844
 845 const struct op_private_by_op op_private_names[] = {
 846     {OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
 847     {OP_LEAVE, C_ARRAY_LENGTH(op_leave_names), op_leave_names },
 848     {OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
 849     {OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
 850     {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
 851     {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
 852     {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
 853     {OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
 854     {OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
 855     {OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
 856     {OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
 857     {OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
 858     {OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
 859     {OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
 860     {OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
 861     {OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
 862     {OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
 863     {OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
 864     {OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
 865     {OP_DBSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
 866     {OP_NEXTSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
 867     {OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
 868 };
 869
 870 static bool
 871 S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
 872     const struct op_private_by_op *start = op_private_names;
 873     const struct op_private_by_op *const end = C_ARRAY_END(op_private_names);
 874
 875     /* This is a linear search, but no worse than the code that it replaced.
 876        It's debugging code - size is more important than speed.  */
 877     do {
 878         if (optype == start->op_type) {
 879             S_append_flags(aTHX_ tmpsv, op_private, start->start,
 880                            start->start + start->len);
 881             return TRUE;
 882         }
 883     } while (++start < end);
 884     return FALSE;
 885 }
 886
 887 #define DUMP_OP_FLAGS(o,level,file)                                 \
 888     if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
 889         SV * const tmpsv = newSVpvs("");                                \
 890         switch (o->op_flags & OPf_WANT) {                               \
 891         case OPf_WANT_VOID:                                             \
 892             sv_catpv(tmpsv, ",VOID");                                   \
 893             break;                                                      \
 894         case OPf_WANT_SCALAR:                                           \
 895             sv_catpv(tmpsv, ",SCALAR");                                 \
 896             break;                                                      \
 897         case OPf_WANT_LIST:                                             \
 898             sv_catpv(tmpsv, ",LIST");                                   \
 899             break;                                                      \
 900         default:                                                        \
 901             sv_catpv(tmpsv, ",UNKNOWN");                                \
 902             break;                                                      \
 903         }                                                               \
 904         append_flags(tmpsv, o->op_flags, op_flags_names);               \
 905         if (o->op_slabbed)  sv_catpvs(tmpsv, ",SLABBED");               \
 906         if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");              \
 907         if (o->op_static)   sv_catpvs(tmpsv, ",STATIC");                \
 908         if (o->op_folded)   sv_catpvs(tmpsv, ",FOLDED");                \
 909         Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",           \
 910                          SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");   \
 911     }
 912
 913 #define DUMP_OP_PRIVATE(o,level,file)                                   \
 914     if (o->op_private) {                                                \
 915         U32 optype = o->op_type;                                        \
 916         U32 oppriv = o->op_private;                                     \
 917         SV * const tmpsv = newSVpvs("");                                \
 918         if (PL_opargs[optype] & OA_TARGLEX) {                           \
 919             if (oppriv & OPpTARGET_MY)                                  \
 920                 sv_catpv(tmpsv, ",TARGET_MY");                          \
 921         }                                                               \
 922         else if (optype == OP_ENTERSUB ||                               \
 923                  optype == OP_RV2SV ||                                  \
 924                  optype == OP_GVSV ||                                   \
 925                  optype == OP_RV2AV ||                                  \
 926                  optype == OP_RV2HV ||                                  \
 927                  optype == OP_RV2GV ||                                  \
 928                  optype == OP_AELEM ||                                  \
 929                  optype == OP_HELEM )                                   \
 930         {                                                               \
 931             if (optype == OP_ENTERSUB) {                                \
 932                 append_flags(tmpsv, oppriv, op_entersub_names);         \
 933             }                                                           \
 934             else {                                                      \
 935                 switch (oppriv & OPpDEREF) {                            \
 936                 case OPpDEREF_SV:                                       \
 937                     sv_catpv(tmpsv, ",SV");                             \
 938                     break;                                              \
 939                 case OPpDEREF_AV:                                       \
 940                     sv_catpv(tmpsv, ",AV");                             \
 941                     break;                                              \
 942                 case OPpDEREF_HV:                                       \
 943                     sv_catpv(tmpsv, ",HV");                             \
 944                     break;                                              \
 945                 }                                                       \
 946                 if (oppriv & OPpMAYBE_LVSUB)                            \
 947                     sv_catpv(tmpsv, ",MAYBE_LVSUB");                    \
 948             }                                                           \
 949             if (optype == OP_AELEM || optype == OP_HELEM) {             \
 950                 if (oppriv & OPpLVAL_DEFER)                             \
 951                     sv_catpv(tmpsv, ",LVAL_DEFER");                     \
 952             }                                                           \
 953             else if (optype == OP_RV2HV || optype == OP_PADHV) {        \
 954                 if (oppriv & OPpMAYBE_TRUEBOOL)                         \
 955                     sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL");             \
 956                 if (oppriv & OPpTRUEBOOL)                               \
 957                     sv_catpvs(tmpsv, ",OPpTRUEBOOL");                   \
 958             }                                                           \
 959             else {                                                      \
 960                 if (oppriv & HINT_STRICT_REFS)                          \
 961                     sv_catpv(tmpsv, ",STRICT_REFS");                    \
 962                 if (oppriv & OPpOUR_INTRO)                              \
 963                     sv_catpv(tmpsv, ",OUR_INTRO");                      \
 964             }                                                           \
 965         }                                                               \
 966         else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) {  \
 967         }                                                               \
 968         else if (OP_IS_FILETEST(o->op_type)) {                          \
 969             if (oppriv & OPpFT_ACCESS)                                  \
 970                 sv_catpv(tmpsv, ",FT_ACCESS");                          \
 971             if (oppriv & OPpFT_STACKED)                                 \
 972                 sv_catpv(tmpsv, ",FT_STACKED");                         \
 973             if (oppriv & OPpFT_STACKING)                                \
 974                 sv_catpv(tmpsv, ",FT_STACKING");                        \
 975             if (oppriv & OPpFT_AFTER_t)                                 \
 976                 sv_catpv(tmpsv, ",AFTER_t");                            \
 977         }                                                               \
 978         else if (o->op_type == OP_AASSIGN) {                            \
 979             if (oppriv & OPpASSIGN_COMMON)                              \
 980                 sv_catpvs(tmpsv, ",COMMON");                            \
 981             if (oppriv & OPpMAYBE_LVSUB)                                \
 982                 sv_catpvs(tmpsv, ",MAYBE_LVSUB");                       \
 983         }                                                               \
 984         if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO)            \
 985             sv_catpv(tmpsv, ",INTRO");                                  \
 986         if (o->op_type == OP_PADRANGE)                                  \
 987             Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf,                 \
 988                            (UV)(oppriv & OPpPADRANGE_COUNTMASK));       \
 989         if (  (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV ||      \
 990                o->op_type == OP_PADAV || o->op_type == OP_PADHV ||      \
 991                o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)      \
 992            && oppriv & OPpSLICEWARNING  )                               \
 993             sv_catpvs(tmpsv, ",SLICEWARNING");                          \
 994         if (SvCUR(tmpsv)) {                                             \
 995             Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
 996         } else                                                          \
 997             Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
 998                              (UV)oppriv);                               \
 999     }
1000
1001
1002 void
1003 Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
1004 {
1005     dVAR;
1006     UV      seq;
1007     const OPCODE optype = o->op_type;
1008
1009     PERL_ARGS_ASSERT_DO_OP_DUMP;
1010
1011     Perl_dump_indent(aTHX_ level, file, "{\n");
1012     level++;
1013     seq = sequence_num(o);
1014     if (seq)
1015         PerlIO_printf(file, "%-4"UVuf, seq);
1016     else
1017         PerlIO_printf(file, "????");
1018     PerlIO_printf(file,
1019                   "%*sTYPE = %s  ===> ",
1020                   (int)(PL_dumpindent*level-4), "", OP_NAME(o));
1021     if (o->op_next)
1022         PerlIO_printf(file,
1023                         o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
1024                                 sequence_num(o->op_next));
1025     else
1026         PerlIO_printf(file, "NULL\n");
1027     if (o->op_targ) {
1028         if (optype == OP_NULL) {
1029             Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
1030             if (o->op_targ == OP_NEXTSTATE) {
1031                 if (CopLINE(cCOPo))
1032                     Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1033                                      (UV)CopLINE(cCOPo));
1034         if (CopSTASHPV(cCOPo)) {
1035             SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1036             HV *stash = CopSTASH(cCOPo);
1037             const char * const hvname = HvNAME_get(stash);
1038
1039                     Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1040                            generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
1041        }
1042      if (CopLABEL(cCOPo)) {
1043           SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1044           STRLEN label_len;
1045           U32 label_flags;
1046           const char *label = CopLABEL_len_flags(cCOPo,
1047                                                  &label_len,
1048                                                  &label_flags);
1049                     Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1050                            generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
1051       }
1052
1053             }
1054         }
1055         else
1056             Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
1057     }
1058 #ifdef DUMPADDR
1059     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
1060 #endif
1061
1062     DUMP_OP_FLAGS(o,level,file);
1063     DUMP_OP_PRIVATE(o,level,file);
1064
1065
1066     switch (optype) {
1067     case OP_AELEMFAST:
1068     case OP_GVSV:
1069     case OP_GV:
1070 #ifdef USE_ITHREADS
1071         Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
1072 #else
1073         if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
1074             if (cSVOPo->op_sv) {
1075       STRLEN len;
1076       const char * name;
1077       SV * const tmpsv  = newSVpvs_flags("", SVs_TEMP);
1078       SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
1079                 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
1080       name = SvPV_const(tmpsv, len);
1081                 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
1082                        generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
1083             }
1084             else
1085                 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
1086         }
1087 #endif
1088         break;
1089     case OP_CONST:
1090     case OP_HINTSEVAL:
1091     case OP_METHOD_NAMED:
1092 #ifndef USE_ITHREADS
1093         /* with ITHREADS, consts are stored in the pad, and the right pad
1094          * may not be active here, so skip */
1095         Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
1096 #endif
1097         break;
1098     case OP_NEXTSTATE:
1099     case OP_DBSTATE:
1100         if (CopLINE(cCOPo))
1101             Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1102                              (UV)CopLINE(cCOPo));
1103     if (CopSTASHPV(cCOPo)) {
1104         SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1105         HV *stash = CopSTASH(cCOPo);
1106         const char * const hvname = HvNAME_get(stash);
1107
1108             Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1109                            generic_pv_escape(tmpsv, hvname,
1110                               HvNAMELEN(stash), HvNAMEUTF8(stash)));
1111     }
1112   if (CopLABEL(cCOPo)) {
1113        SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1114        STRLEN label_len;
1115        U32 label_flags;
1116        const char *label = CopLABEL_len_flags(cCOPo,
1117                                                 &label_len, &label_flags);
1118        Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1119                            generic_pv_escape( tmpsv, label, label_len,
1120                                       (label_flags & SVf_UTF8)));
1121    }
1122         break;
1123     case OP_ENTERLOOP:
1124         Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
1125         if (cLOOPo->op_redoop)
1126             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
1127         else
1128             PerlIO_printf(file, "DONE\n");
1129         Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
1130         if (cLOOPo->op_nextop)
1131             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
1132         else
1133             PerlIO_printf(file, "DONE\n");
1134         Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
1135         if (cLOOPo->op_lastop)
1136             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
1137         else
1138             PerlIO_printf(file, "DONE\n");
1139         break;
1140     case OP_COND_EXPR:
1141     case OP_RANGE:
1142     case OP_MAPWHILE:
1143     case OP_GREPWHILE:
1144     case OP_OR:
1145     case OP_AND:
1146         Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
1147         if (cLOGOPo->op_other)
1148             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
1149         else
1150             PerlIO_printf(file, "DONE\n");
1151         break;
1152     case OP_PUSHRE:
1153     case OP_MATCH:
1154     case OP_QR:
1155     case OP_SUBST:
1156         do_pmop_dump(level, file, cPMOPo);
1157         break;
1158     case OP_LEAVE:
1159     case OP_LEAVEEVAL:
1160     case OP_LEAVESUB:
1161     case OP_LEAVESUBLV:
1162     case OP_LEAVEWRITE:
1163     case OP_SCOPE:
1164         if (o->op_private & OPpREFCOUNTED)
1165             Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1166         break;
1167     default:
1168         break;
1169     }
1170     if (o->op_flags & OPf_KIDS) {
1171         OP *kid;
1172         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
1173             do_op_dump(level, file, kid);
1174     }
1175     Perl_dump_indent(aTHX_ level-1, file, "}\n");
1176 }
1177
1178 /*
1179 =for apidoc op_dump
1180
1181 Dumps the optree starting at OP C<o> to C<STDERR>.
1182
1183 =cut
1184 */
1185
1186 void
1187 Perl_op_dump(pTHX_ const OP *o)
1188 {
1189     PERL_ARGS_ASSERT_OP_DUMP;
1190     do_op_dump(0, Perl_debug_log, o);
1191 }
1192
1193 void
1194 Perl_gv_dump(pTHX_ GV *gv)
1195 {
1196     STRLEN len;
1197     const char* name;
1198     SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1199
1200
1201     PERL_ARGS_ASSERT_GV_DUMP;
1202
1203     if (!gv) {
1204         PerlIO_printf(Perl_debug_log, "{}\n");
1205         return;
1206     }
1207     sv = sv_newmortal();
1208     PerlIO_printf(Perl_debug_log, "{\n");
1209     gv_fullname3(sv, gv, NULL);
1210     name = SvPV_const(sv, len);
1211     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1212                      generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1213     if (gv != GvEGV(gv)) {
1214         gv_efullname3(sv, GvEGV(gv), NULL);
1215         name = SvPV_const(sv, len);
1216         Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1217                      generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1218     }
1219     PerlIO_putc(Perl_debug_log, '\n');
1220     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
1221 }
1222
1223
1224 /* map magic types to the symbolic names
1225  * (with the PERL_MAGIC_ prefixed stripped)
1226  */
1227
1228 static const struct { const char type; const char *name; } magic_names[] = {
1229 #include "mg_names.c"
1230         /* this null string terminates the list */
1231         { 0,                         NULL },
1232 };
1233
1234 void
1235 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1236 {
1237     PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1238
1239     for (; mg; mg = mg->mg_moremagic) {
1240         Perl_dump_indent(aTHX_ level, file,
1241                          "  MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
1242         if (mg->mg_virtual) {
1243             const MGVTBL * const v = mg->mg_virtual;
1244             if (v >= PL_magic_vtables
1245                 && v < PL_magic_vtables + magic_vtable_max) {
1246                 const U32 i = v - PL_magic_vtables;
1247                 Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1248             }
1249             else
1250                 Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
1251         }
1252         else
1253             Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0\n");
1254
1255         if (mg->mg_private)
1256             Perl_dump_indent(aTHX_ level, file, "    MG_PRIVATE = %d\n", mg->mg_private);
1257
1258         {
1259             int n;
1260             const char *name = NULL;
1261             for (n = 0; magic_names[n].name; n++) {
1262                 if (mg->mg_type == magic_names[n].type) {
1263                     name = magic_names[n].name;
1264                     break;
1265                 }
1266             }
1267             if (name)
1268                 Perl_dump_indent(aTHX_ level, file,
1269                                 "    MG_TYPE = PERL_MAGIC_%s\n", name);
1270             else
1271                 Perl_dump_indent(aTHX_ level, file,
1272                                 "    MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1273         }
1274
1275         if (mg->mg_flags) {
1276             Perl_dump_indent(aTHX_ level, file, "    MG_FLAGS = 0x%02X\n", mg->mg_flags);
1277             if (mg->mg_type == PERL_MAGIC_envelem &&
1278                 mg->mg_flags & MGf_TAINTEDDIR)
1279                 Perl_dump_indent(aTHX_ level, file, "      TAINTEDDIR\n");
1280             if (mg->mg_type == PERL_MAGIC_regex_global &&
1281                 mg->mg_flags & MGf_MINMATCH)
1282                 Perl_dump_indent(aTHX_ level, file, "      MINMATCH\n");
1283             if (mg->mg_flags & MGf_REFCOUNTED)
1284                 Perl_dump_indent(aTHX_ level, file, "      REFCOUNTED\n");
1285             if (mg->mg_flags & MGf_GSKIP)
1286                 Perl_dump_indent(aTHX_ level, file, "      GSKIP\n");
1287             if (mg->mg_flags & MGf_COPY)
1288                 Perl_dump_indent(aTHX_ level, file, "      COPY\n");
1289             if (mg->mg_flags & MGf_DUP)
1290                 Perl_dump_indent(aTHX_ level, file, "      DUP\n");
1291             if (mg->mg_flags & MGf_LOCAL)
1292                 Perl_dump_indent(aTHX_ level, file, "      LOCAL\n");
1293             if (mg->mg_type == PERL_MAGIC_regex_global &&
1294                 mg->mg_flags & MGf_BYTES)
1295                 Perl_dump_indent(aTHX_ level, file, "      BYTES\n");
1296         }
1297         if (mg->mg_obj) {
1298             Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n",
1299                 PTR2UV(mg->mg_obj));
1300             if (mg->mg_type == PERL_MAGIC_qr) {
1301                 REGEXP* const re = (REGEXP *)mg->mg_obj;
1302                 SV * const dsv = sv_newmortal();
1303                 const char * const s
1304                     = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
1305                     60, NULL, NULL,
1306                     ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
1307                     (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
1308                 );
1309                 Perl_dump_indent(aTHX_ level+1, file, "    PAT = %s\n", s);
1310                 Perl_dump_indent(aTHX_ level+1, file, "    REFCNT = %"IVdf"\n",
1311                         (IV)RX_REFCNT(re));
1312             }
1313             if (mg->mg_flags & MGf_REFCOUNTED)
1314                 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1315         }
1316         if (mg->mg_len)
1317             Perl_dump_indent(aTHX_ level, file, "    MG_LEN = %ld\n", (long)mg->mg_len);
1318         if (mg->mg_ptr) {
1319             Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
1320             if (mg->mg_len >= 0) {
1321                 if (mg->mg_type != PERL_MAGIC_utf8) {
1322                     SV * const sv = newSVpvs("");
1323                     PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1324                     SvREFCNT_dec_NN(sv);
1325                 }
1326             }
1327             else if (mg->mg_len == HEf_SVKEY) {
1328                 PerlIO_puts(file, " => HEf_SVKEY\n");
1329                 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1330                            maxnest, dumpops, pvlim); /* MG is already +1 */
1331                 continue;
1332             }
1333             else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
1334             else
1335                 PerlIO_puts(
1336                   file,
1337                  " ???? - " __FILE__
1338                  " does not know how to handle this MG_LEN"
1339                 );
1340             PerlIO_putc(file, '\n');
1341         }
1342         if (mg->mg_type == PERL_MAGIC_utf8) {
1343             const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
1344             if (cache) {
1345                 IV i;
1346                 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1347                     Perl_dump_indent(aTHX_ level, file,
1348                                      "      %2"IVdf": %"UVuf" -> %"UVuf"\n",
1349                                      i,
1350                                      (UV)cache[i * 2],
1351                                      (UV)cache[i * 2 + 1]);
1352             }
1353         }
1354     }
1355 }
1356
1357 void
1358 Perl_magic_dump(pTHX_ const MAGIC *mg)
1359 {
1360     do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
1361 }
1362
1363 void
1364 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
1365 {
1366     const char *hvname;
1367
1368     PERL_ARGS_ASSERT_DO_HV_DUMP;
1369
1370     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1371     if (sv && (hvname = HvNAME_get(sv)))
1372     {
1373         /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1374            name which quite legally could contain insane things like tabs, newlines, nulls or
1375            other scary crap - this should produce sane results - except maybe for unicode package
1376            names - but we will wait for someone to file a bug on that - demerphq */
1377         SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1378         PerlIO_printf(file, "\t\"%s\"\n",
1379                               generic_pv_escape( tmpsv, hvname,
1380                                    HvNAMELEN(sv), HvNAMEUTF8(sv)));
1381     }
1382     else
1383         PerlIO_putc(file, '\n');
1384 }
1385
1386 void
1387 Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1388 {
1389     PERL_ARGS_ASSERT_DO_GV_DUMP;
1390
1391     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1392     if (sv && GvNAME(sv)) {
1393         SV * const tmpsv = newSVpvs("");
1394         PerlIO_printf(file, "\t\"%s\"\n",
1395                               generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1396     }
1397     else
1398         PerlIO_putc(file, '\n');
1399 }
1400
1401 void
1402 Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1403 {
1404     PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1405
1406     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1407     if (sv && GvNAME(sv)) {
1408        SV *tmp = newSVpvs_flags("", SVs_TEMP);
1409         const char *hvname;
1410         HV * const stash = GvSTASH(sv);
1411         PerlIO_printf(file, "\t");
1412    /* TODO might have an extra \" here */
1413         if (stash && (hvname = HvNAME_get(stash))) {
1414             PerlIO_printf(file, "\"%s\" :: \"",
1415                                   generic_pv_escape(tmp, hvname,
1416                                       HvNAMELEN(stash), HvNAMEUTF8(stash)));
1417         }
1418         PerlIO_printf(file, "%s\"\n",
1419                               generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
1420     }
1421     else
1422         PerlIO_putc(file, '\n');
1423 }
1424
1425 const struct flag_to_name first_sv_flags_names[] = {
1426     {SVs_TEMP, "TEMP,"},
1427     {SVs_OBJECT, "OBJECT,"},
1428     {SVs_GMG, "GMG,"},
1429     {SVs_SMG, "SMG,"},
1430     {SVs_RMG, "RMG,"},
1431     {SVf_IOK, "IOK,"},
1432     {SVf_NOK, "NOK,"},
1433     {SVf_POK, "POK,"}
1434 };
1435
1436 const struct flag_to_name second_sv_flags_names[] = {
1437     {SVf_OOK, "OOK,"},
1438     {SVf_FAKE, "FAKE,"},
1439     {SVf_READONLY, "READONLY,"},
1440     {SVf_IsCOW, "IsCOW,"},
1441     {SVf_BREAK, "BREAK,"},
1442     {SVf_AMAGIC, "OVERLOAD,"},
1443     {SVp_IOK, "pIOK,"},
1444     {SVp_NOK, "pNOK,"},
1445     {SVp_POK, "pPOK,"}
1446 };
1447
1448 const struct flag_to_name cv_flags_names[] = {
1449     {CVf_ANON, "ANON,"},
1450     {CVf_UNIQUE, "UNIQUE,"},
1451     {CVf_CLONE, "CLONE,"},
1452     {CVf_CLONED, "CLONED,"},
1453     {CVf_CONST, "CONST,"},
1454     {CVf_NODEBUG, "NODEBUG,"},
1455     {CVf_LVALUE, "LVALUE,"},
1456     {CVf_METHOD, "METHOD,"},
1457     {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
1458     {CVf_CVGV_RC, "CVGV_RC,"},
1459     {CVf_DYNFILE, "DYNFILE,"},
1460     {CVf_AUTOLOAD, "AUTOLOAD,"},
1461     {CVf_HASEVAL, "HASEVAL"},
1462     {CVf_SLABBED, "SLABBED,"},
1463     {CVf_ISXSUB, "ISXSUB,"}
1464 };
1465
1466 const struct flag_to_name hv_flags_names[] = {
1467     {SVphv_SHAREKEYS, "SHAREKEYS,"},
1468     {SVphv_LAZYDEL, "LAZYDEL,"},
1469     {SVphv_HASKFLAGS, "HASKFLAGS,"},
1470     {SVphv_CLONEABLE, "CLONEABLE,"}
1471 };
1472
1473 const struct flag_to_name gp_flags_names[] = {
1474     {GVf_INTRO, "INTRO,"},
1475     {GVf_MULTI, "MULTI,"},
1476     {GVf_ASSUMECV, "ASSUMECV,"},
1477     {GVf_IN_PAD, "IN_PAD,"}
1478 };
1479
1480 const struct flag_to_name gp_flags_imported_names[] = {
1481     {GVf_IMPORTED_SV, " SV"},
1482     {GVf_IMPORTED_AV, " AV"},
1483     {GVf_IMPORTED_HV, " HV"},
1484     {GVf_IMPORTED_CV, " CV"},
1485 };
1486
1487 /* NOTE: this structure is mostly duplicative of one generated by
1488  * 'make regen' in regnodes.h - perhaps we should somehow integrate
1489  * the two. - Yves */
1490 const struct flag_to_name regexp_extflags_names[] = {
1491     {RXf_PMf_MULTILINE,   "PMf_MULTILINE,"},
1492     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
1493     {RXf_PMf_FOLD,        "PMf_FOLD,"},
1494     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},
1495     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
1496     {RXf_IS_ANCHORED,     "IS_ANCHORED,"},
1497     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
1498     {RXf_EVAL_SEEN,       "EVAL_SEEN,"},
1499     {RXf_CHECK_ALL,       "CHECK_ALL,"},
1500     {RXf_MATCH_UTF8,      "MATCH_UTF8,"},
1501     {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1502     {RXf_USE_INTUIT_ML,   "USE_INTUIT_ML,"},
1503     {RXf_INTUIT_TAIL,     "INTUIT_TAIL,"},
1504     {RXf_SPLIT,           "SPLIT,"},
1505     {RXf_COPY_DONE,       "COPY_DONE,"},
1506     {RXf_TAINTED_SEEN,    "TAINTED_SEEN,"},
1507     {RXf_TAINTED,         "TAINTED,"},
1508     {RXf_START_ONLY,      "START_ONLY,"},
1509     {RXf_SKIPWHITE,       "SKIPWHITE,"},
1510     {RXf_WHITE,           "WHITE,"},
1511     {RXf_NULL,            "NULL,"},
1512 };
1513
1514 /* NOTE: this structure is mostly duplicative of one generated by
1515  * 'make regen' in regnodes.h - perhaps we should somehow integrate
1516  * the two. - Yves */
1517 const struct flag_to_name regexp_core_intflags_names[] = {
1518     {PREGf_SKIP,            "SKIP,"},
1519     {PREGf_IMPLICIT,        "IMPLICIT,"},
1520     {PREGf_NAUGHTY,         "NAUGHTY,"},
1521     {PREGf_VERBARG_SEEN,    "VERBARG_SEEN,"},
1522     {PREGf_CUTGROUP_SEEN,   "CUTGROUP_SEEN,"},
1523     {PREGf_USE_RE_EVAL,     "USE_RE_EVAL,"},
1524     {PREGf_NOSCAN,          "NOSCAN,"},
1525     {PREGf_CANY_SEEN,       "CANY_SEEN,"},
1526     {PREGf_GPOS_SEEN,       "GPOS_SEEN,"},
1527     {PREGf_GPOS_FLOAT,      "GPOS_FLOAT,"},
1528     {PREGf_ANCH_BOL,        "ANCH_BOL,"},
1529     {PREGf_ANCH_MBOL,       "ANCH_MBOL,"},
1530     {PREGf_ANCH_SBOL,       "ANCH_SBOL,"},
1531     {PREGf_ANCH_GPOS,       "ANCH_GPOS,"},
1532 };
1533
1534 void
1535 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1536 {
1537     dVAR;
1538     SV *d;
1539     const char *s;
1540     U32 flags;
1541     U32 type;
1542
1543     PERL_ARGS_ASSERT_DO_SV_DUMP;
1544
1545     if (!sv) {
1546         Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
1547         return;
1548     }
1549
1550     flags = SvFLAGS(sv);
1551     type = SvTYPE(sv);
1552
1553     /* process general SV flags */
1554
1555     d = Perl_newSVpvf(aTHX_
1556                    "(0x%"UVxf") at 0x%"UVxf"\n%*s  REFCNT = %"IVdf"\n%*s  FLAGS = (",
1557                    PTR2UV(SvANY(sv)), PTR2UV(sv),
1558                    (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1559                    (int)(PL_dumpindent*level), "");
1560
1561     if (!((flags & SVpad_NAME) == SVpad_NAME
1562           && (type == SVt_PVMG || type == SVt_PVNV))) {
1563         if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1564             sv_catpv(d, "PADSTALE,");
1565     }
1566     if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
1567         if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1568             sv_catpv(d, "PADTMP,");
1569         if (flags & SVs_PADMY)  sv_catpv(d, "PADMY,");
1570     }
1571     append_flags(d, flags, first_sv_flags_names);
1572     if (flags & SVf_ROK)  {
1573                                 sv_catpv(d, "ROK,");
1574         if (SvWEAKREF(sv))      sv_catpv(d, "WEAKREF,");
1575     }
1576     append_flags(d, flags, second_sv_flags_names);
1577     if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1578                            && type != SVt_PVAV) {
1579         if (SvPCS_IMPORTED(sv))
1580                                 sv_catpv(d, "PCS_IMPORTED,");
1581         else
1582                                 sv_catpv(d, "SCREAM,");
1583     }
1584
1585     /* process type-specific SV flags */
1586
1587     switch (type) {
1588     case SVt_PVCV:
1589     case SVt_PVFM:
1590         append_flags(d, CvFLAGS(sv), cv_flags_names);
1591         break;
1592     case SVt_PVHV:
1593         append_flags(d, flags, hv_flags_names);
1594         break;
1595     case SVt_PVGV:
1596     case SVt_PVLV:
1597         if (isGV_with_GP(sv)) {
1598             append_flags(d, GvFLAGS(sv), gp_flags_names);
1599         }
1600         if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
1601             sv_catpv(d, "IMPORT");
1602             if (GvIMPORTED(sv) == GVf_IMPORTED)
1603                 sv_catpv(d, "ALL,");
1604             else {
1605                 sv_catpv(d, "(");
1606                 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
1607                 sv_catpv(d, " ),");
1608             }
1609         }
1610         /* FALLTHROUGH */
1611     default:
1612     evaled_or_uv:
1613         if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
1614         if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
1615         break;
1616     case SVt_PVMG:
1617         if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
1618         if (SvVALID(sv))        sv_catpv(d, "VALID,");
1619         if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
1620         if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
1621         /* FALLTHROUGH */
1622     case SVt_PVNV:
1623         if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
1624         goto evaled_or_uv;
1625     case SVt_PVAV:
1626         if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
1627         break;
1628     }
1629     /* SVphv_SHAREKEYS is also 0x20000000 */
1630     if ((type != SVt_PVHV) && SvUTF8(sv))
1631         sv_catpv(d, "UTF8");
1632
1633     if (*(SvEND(d) - 1) == ',') {
1634         SvCUR_set(d, SvCUR(d) - 1);
1635         SvPVX(d)[SvCUR(d)] = '\0';
1636     }
1637     sv_catpv(d, ")");
1638     s = SvPVX_const(d);
1639
1640     /* dump initial SV details */
1641
1642 #ifdef DEBUG_LEAKING_SCALARS
1643     Perl_dump_indent(aTHX_ level, file,
1644         "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
1645         sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1646         sv->sv_debug_line,
1647         sv->sv_debug_inpad ? "for" : "by",
1648         sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1649         PTR2UV(sv->sv_debug_parent),
1650         sv->sv_debug_serial
1651     );
1652 #endif
1653     Perl_dump_indent(aTHX_ level, file, "SV = ");
1654
1655     /* Dump SV type */
1656
1657     if (type < SVt_LAST) {
1658         PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1659
1660         if (type ==  SVt_NULL) {
1661             SvREFCNT_dec_NN(d);
1662             return;
1663         }
1664     } else {
1665         PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
1666         SvREFCNT_dec_NN(d);
1667         return;
1668     }
1669
1670     /* Dump general SV fields */
1671
1672     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1673          && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1674          && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
1675         || (type == SVt_IV && !SvROK(sv))) {
1676         if (SvIsUV(sv)
1677 #ifdef PERL_OLD_COPY_ON_WRITE
1678                        || SvIsCOW(sv)
1679 #endif
1680                                      )
1681             Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
1682         else
1683             Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
1684 #ifdef PERL_OLD_COPY_ON_WRITE
1685         if (SvIsCOW_shared_hash(sv))
1686             PerlIO_printf(file, "  (HASH)");
1687         else if (SvIsCOW_normal(sv))
1688             PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1689 #endif
1690         PerlIO_putc(file, '\n');
1691     }
1692
1693     if ((type == SVt_PVNV || type == SVt_PVMG)
1694         && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
1695         Perl_dump_indent(aTHX_ level, file, "  COP_LOW = %"UVuf"\n",
1696                          (UV) COP_SEQ_RANGE_LOW(sv));
1697         Perl_dump_indent(aTHX_ level, file, "  COP_HIGH = %"UVuf"\n",
1698                          (UV) COP_SEQ_RANGE_HIGH(sv));
1699     } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
1700                 && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
1701                 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
1702                || type == SVt_NV) {
1703         STORE_NUMERIC_LOCAL_SET_STANDARD();
1704         /* %Vg doesn't work? --jhi */
1705 #ifdef USE_LONG_DOUBLE
1706         Perl_dump_indent(aTHX_ level, file, "  NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
1707 #else
1708         Perl_dump_indent(aTHX_ level, file, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
1709 #endif
1710         RESTORE_NUMERIC_LOCAL();
1711     }
1712
1713     if (SvROK(sv)) {
1714         Perl_dump_indent(aTHX_ level, file, "  RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
1715         if (nest < maxnest)
1716             do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
1717     }
1718
1719     if (type < SVt_PV) {
1720         SvREFCNT_dec_NN(d);
1721         return;
1722     }
1723
1724     if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1725      || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
1726         const bool re = isREGEXP(sv);
1727         const char * const ptr =
1728             re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1729         if (ptr) {
1730             STRLEN delta;
1731             if (SvOOK(sv)) {
1732                 SvOOK_offset(sv, delta);
1733                 Perl_dump_indent(aTHX_ level, file,"  OFFSET = %"UVuf"\n",
1734                                  (UV) delta);
1735             } else {
1736                 delta = 0;
1737             }
1738             Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(ptr));
1739             if (SvOOK(sv)) {
1740                 PerlIO_printf(file, "( %s . ) ",
1741                               pv_display(d, ptr - delta, delta, 0,
1742                                          pvlim));
1743             }
1744             if (type == SVt_INVLIST) {
1745                 PerlIO_printf(file, "\n");
1746                 /* 4 blanks indents 2 beyond the PV, etc */
1747                 _invlist_dump(file, level, "    ", sv);
1748             }
1749             else {
1750                 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1751                                                      re ? 0 : SvLEN(sv),
1752                                                      pvlim));
1753                 if (SvUTF8(sv)) /* the 6?  \x{....} */
1754                     PerlIO_printf(file, " [UTF8 \"%s\"]",
1755                                          sv_uni_display(d, sv, 6 * SvCUR(sv),
1756                                                         UNI_DISPLAY_QQ));
1757                 PerlIO_printf(file, "\n");
1758             }
1759             Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
1760             if (!re)
1761                 Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n",
1762                                        (IV)SvLEN(sv));
1763 #ifdef PERL_NEW_COPY_ON_WRITE
1764             if (SvIsCOW(sv) && SvLEN(sv))
1765                 Perl_dump_indent(aTHX_ level, file, "  COW_REFCNT = %d\n",
1766                                        CowREFCNT(sv));
1767 #endif
1768         }
1769         else
1770             Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
1771     }
1772
1773     if (type >= SVt_PVMG) {
1774         if (type == SVt_PVMG && SvPAD_OUR(sv)) {
1775             HV * const ost = SvOURSTASH(sv);
1776             if (ost)
1777                 do_hv_dump(level, file, "  OURSTASH", ost);
1778         } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
1779             Perl_dump_indent(aTHX_ level, file, "  MAXNAMED = %"UVuf"\n",
1780                                    (UV)PadnamelistMAXNAMED(sv));
1781         } else {
1782             if (SvMAGIC(sv))
1783                 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
1784         }
1785         if (SvSTASH(sv))
1786             do_hv_dump(level, file, "  STASH", SvSTASH(sv));
1787
1788         if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
1789             Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1790         }
1791     }
1792
1793     /* Dump type-specific SV fields */
1794
1795     switch (type) {
1796     case SVt_PVAV:
1797         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
1798         if (AvARRAY(sv) != AvALLOC(sv)) {
1799             PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1800             Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
1801         }
1802         else
1803             PerlIO_putc(file, '\n');
1804         Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1805         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
1806         /* arylen is stored in magic, and padnamelists use SvMAGIC for
1807            something else. */
1808         if (!AvPAD_NAMELIST(sv))
1809             Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n",
1810                                    SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
1811         sv_setpvs(d, "");
1812         if (AvREAL(sv)) sv_catpv(d, ",REAL");
1813         if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
1814         Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
1815                          SvCUR(d) ? SvPVX_const(d) + 1 : "");
1816         if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
1817             SSize_t count;
1818             for (count = 0; count <=  av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
1819                 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
1820
1821                 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
1822                 if (elt)
1823                     do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1824             }
1825         }
1826         break;
1827     case SVt_PVHV: {
1828         U32 usedkeys;
1829         if (SvOOK(sv)) {
1830             struct xpvhv_aux *const aux = HvAUX(sv);
1831             Perl_dump_indent(aTHX_ level, file, "  AUX_FLAGS = %"UVuf"\n",
1832                              (UV)aux->xhv_aux_flags);
1833         }
1834         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1835         usedkeys = HvUSEDKEYS(sv);
1836         if (HvARRAY(sv) && usedkeys) {
1837             /* Show distribution of HEs in the ARRAY */
1838             int freq[200];
1839 #define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
1840             int i;
1841             int max = 0;
1842             U32 pow2 = 2, keys = usedkeys;
1843             NV theoret, sum = 0;
1844
1845             PerlIO_printf(file, "  (");
1846             Zero(freq, FREQ_MAX + 1, int);
1847             for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
1848                 HE* h;
1849                 int count = 0;
1850                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1851                     count++;
1852                 if (count > FREQ_MAX)
1853                     count = FREQ_MAX;
1854                 freq[count]++;
1855                 if (max < count)
1856                     max = count;
1857             }
1858             for (i = 0; i <= max; i++) {
1859                 if (freq[i]) {
1860                     PerlIO_printf(file, "%d%s:%d", i,
1861                                   (i == FREQ_MAX) ? "+" : "",
1862                                   freq[i]);
1863                     if (i != max)
1864                         PerlIO_printf(file, ", ");
1865                 }
1866             }
1867             PerlIO_putc(file, ')');
1868             /* The "quality" of a hash is defined as the total number of
1869                comparisons needed to access every element once, relative
1870                to the expected number needed for a random hash.
1871
1872                The total number of comparisons is equal to the sum of
1873                the squares of the number of entries in each bucket.
1874                For a random hash of n keys into k buckets, the expected
1875                value is
1876                                 n + n(n-1)/2k
1877             */
1878
1879             for (i = max; i > 0; i--) { /* Precision: count down. */
1880                 sum += freq[i] * i * i;
1881             }
1882             while ((keys = keys >> 1))
1883                 pow2 = pow2 << 1;
1884             theoret = usedkeys;
1885             theoret += theoret * (theoret-1)/pow2;
1886             PerlIO_putc(file, '\n');
1887             Perl_dump_indent(aTHX_ level, file, "  hash quality = %.1"NVff"%%", theoret/sum*100);
1888         }
1889         PerlIO_putc(file, '\n');
1890         Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)usedkeys);
1891         {
1892             STRLEN count = 0;
1893             HE **ents = HvARRAY(sv);
1894
1895             if (ents) {
1896                 HE *const *const last = ents + HvMAX(sv);
1897                 count = last + 1 - ents;
1898
1899                 do {
1900                     if (!*ents)
1901                         --count;
1902                 } while (++ents <= last);
1903             }
1904
1905             if (SvOOK(sv)) {
1906                 struct xpvhv_aux *const aux = HvAUX(sv);
1907                 Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf
1908                                  " (cached = %"UVuf")\n",
1909                                  (UV)count, (UV)aux->xhv_fill_lazy);
1910             } else {
1911                 Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
1912                                  (UV)count);
1913             }
1914         }
1915         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
1916         if (SvOOK(sv)) {
1917             Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1918             Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
1919 #ifdef PERL_HASH_RANDOMIZE_KEYS
1920             Perl_dump_indent(aTHX_ level, file, "  RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1921             if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
1922                 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
1923             }
1924 #endif
1925             PerlIO_putc(file, '\n');
1926         }
1927         {
1928             MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
1929             if (mg && mg->mg_obj) {
1930                 Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1931             }
1932         }
1933         {
1934             const char * const hvname = HvNAME_get(sv);
1935             if (hvname) {
1936           SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1937      Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
1938                                        generic_pv_escape( tmpsv, hvname,
1939                                            HvNAMELEN(sv), HvNAMEUTF8(sv)));
1940         }
1941         }
1942         if (SvOOK(sv)) {
1943             AV * const backrefs
1944                 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
1945             struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
1946             if (HvAUX(sv)->xhv_name_count)
1947                 Perl_dump_indent(aTHX_
1948                  level, file, "  NAMECOUNT = %"IVdf"\n",
1949                  (IV)HvAUX(sv)->xhv_name_count
1950                 );
1951             if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
1952                 const I32 count = HvAUX(sv)->xhv_name_count;
1953                 if (count) {
1954                     SV * const names = newSVpvs_flags("", SVs_TEMP);
1955                     /* The starting point is the first element if count is
1956                        positive and the second element if count is negative. */
1957                     HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1958                         + (count < 0 ? 1 : 0);
1959                     HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1960                         + (count < 0 ? -count : count);
1961                     while (hekp < endp) {
1962                         if (HEK_LEN(*hekp)) {
1963              SV *tmp = newSVpvs_flags("", SVs_TEMP);
1964                             Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
1965                               generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
1966                         } else {
1967                             /* This should never happen. */
1968                             sv_catpvs(names, ", (null)");
1969                         }
1970                         ++hekp;
1971                     }
1972                     Perl_dump_indent(aTHX_
1973                      level, file, "  ENAME = %s\n", SvPV_nolen(names)+2
1974                     );
1975                 }
1976                 else {
1977                     SV * const tmp = newSVpvs_flags("", SVs_TEMP);
1978                     const char *const hvename = HvENAME_get(sv);
1979                     Perl_dump_indent(aTHX_
1980                      level, file, "  ENAME = \"%s\"\n",
1981                      generic_pv_escape(tmp, hvename,
1982                                        HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
1983                 }
1984             }
1985             if (backrefs) {
1986                 Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
1987                                  PTR2UV(backrefs));
1988                 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
1989                            dumpops, pvlim);
1990             }
1991             if (meta) {
1992                 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1993                 Perl_dump_indent(aTHX_ level, file, "  MRO_WHICH = \"%s\" (0x%"UVxf")\n",
1994                                  generic_pv_escape( tmpsv, meta->mro_which->name,
1995                                 meta->mro_which->length,
1996                                 (meta->mro_which->kflags & HVhek_UTF8)),
1997                                  PTR2UV(meta->mro_which));
1998                 Perl_dump_indent(aTHX_ level, file, "  CACHE_GEN = 0x%"UVxf"\n",
1999                                  (UV)meta->cache_gen);
2000                 Perl_dump_indent(aTHX_ level, file, "  PKG_GEN = 0x%"UVxf"\n",
2001                                  (UV)meta->pkg_gen);
2002                 if (meta->mro_linear_all) {
2003                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_ALL = 0x%"UVxf"\n",
2004                                  PTR2UV(meta->mro_linear_all));
2005                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
2006                            dumpops, pvlim);
2007                 }
2008                 if (meta->mro_linear_current) {
2009                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
2010                                  PTR2UV(meta->mro_linear_current));
2011                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
2012                            dumpops, pvlim);
2013                 }
2014                 if (meta->mro_nextmethod) {
2015                     Perl_dump_indent(aTHX_ level, file, "  MRO_NEXTMETHOD = 0x%"UVxf"\n",
2016                                  PTR2UV(meta->mro_nextmethod));
2017                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
2018                            dumpops, pvlim);
2019                 }
2020                 if (meta->isa) {
2021                     Perl_dump_indent(aTHX_ level, file, "  ISA = 0x%"UVxf"\n",
2022                                  PTR2UV(meta->isa));
2023                 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
2024                            dumpops, pvlim);
2025                 }
2026             }
2027         }
2028         if (nest < maxnest) {
2029             HV * const hv = MUTABLE_HV(sv);
2030             STRLEN i;
2031             HE *he;
2032
2033             if (HvARRAY(hv)) {
2034                 int count = maxnest - nest;
2035                 for (i=0; i <= HvMAX(hv); i++) {
2036                     for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
2037                         U32 hash;
2038                         SV * keysv;
2039                         const char * keypv;
2040                         SV * elt;
2041                         STRLEN len;
2042
2043                         if (count-- <= 0) goto DONEHV;
2044
2045                         hash = HeHASH(he);
2046                         keysv = hv_iterkeysv(he);
2047                         keypv = SvPV_const(keysv, len);
2048                         elt = HeVAL(he);
2049
2050                         Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
2051                         if (SvUTF8(keysv))
2052                             PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
2053                         if (HvEITER_get(hv) == he)
2054                             PerlIO_printf(file, "[CURRENT] ");
2055                         PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
2056                         do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
2057                     }
2058                 }
2059               DONEHV:;
2060             }
2061         }
2062         break;
2063     } /* case SVt_PVHV */
2064
2065     case SVt_PVCV:
2066         if (CvAUTOLOAD(sv)) {
2067             SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2068        STRLEN len;
2069             const char *const name =  SvPV_const(sv, len);
2070             Perl_dump_indent(aTHX_ level, file, "  AUTOLOAD = \"%s\"\n",
2071                              generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
2072         }
2073         if (SvPOK(sv)) {
2074        SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2075        const char *const proto = CvPROTO(sv);
2076             Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n",
2077                              generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
2078                                 SvUTF8(sv)));
2079         }
2080         /* FALLTHROUGH */
2081     case SVt_PVFM:
2082         do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
2083         if (!CvISXSUB(sv)) {
2084             if (CvSTART(sv)) {
2085                 Perl_dump_indent(aTHX_ level, file,
2086                                  "  START = 0x%"UVxf" ===> %"IVdf"\n",
2087                                  PTR2UV(CvSTART(sv)),
2088                                  (IV)sequence_num(CvSTART(sv)));
2089             }
2090             Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n",
2091                              PTR2UV(CvROOT(sv)));
2092             if (CvROOT(sv) && dumpops) {
2093                 do_op_dump(level+1, file, CvROOT(sv));
2094             }
2095         } else {
2096             SV * const constant = cv_const_sv((const CV *)sv);
2097
2098             Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
2099
2100             if (constant) {
2101                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
2102                                  " (CONST SV)\n",
2103                                  PTR2UV(CvXSUBANY(sv).any_ptr));
2104                 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2105                            pvlim);
2106             } else {
2107                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
2108                                  (IV)CvXSUBANY(sv).any_i32);
2109             }
2110         }
2111         if (CvNAMED(sv))
2112             Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
2113                                    HEK_KEY(CvNAME_HEK((CV *)sv)));
2114         else do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
2115         Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
2116         Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
2117         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
2118         Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
2119         Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
2120         if (nest < maxnest) {
2121             do_dump_pad(level+1, file, CvPADLIST(sv), 0);
2122         }
2123         {
2124             const CV * const outside = CvOUTSIDE(sv);
2125             Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",
2126                         PTR2UV(outside),
2127                         (!outside ? "null"
2128                          : CvANON(outside) ? "ANON"
2129                          : (outside == PL_main_cv) ? "MAIN"
2130                          : CvUNIQUE(outside) ? "UNIQUE"
2131                          : CvGV(outside) ?
2132                              generic_pv_escape(
2133                                  newSVpvs_flags("", SVs_TEMP),
2134                                  GvNAME(CvGV(outside)),
2135                                  GvNAMELEN(CvGV(outside)),
2136                                  GvNAMEUTF8(CvGV(outside)))
2137                          : "UNDEFINED"));
2138         }
2139         if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
2140             do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
2141         break;
2142
2143     case SVt_PVGV:
2144     case SVt_PVLV:
2145         if (type == SVt_PVLV) {
2146             Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
2147             Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2148             Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2149             Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
2150             Perl_dump_indent(aTHX_ level, file, "  FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
2151             if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2152                 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2153                     dumpops, pvlim);
2154         }
2155         if (isREGEXP(sv)) goto dumpregexp;
2156         if (!isGV_with_GP(sv))
2157             break;
2158        {
2159           SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2160           Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
2161                     generic_pv_escape(tmpsv, GvNAME(sv),
2162                                       GvNAMELEN(sv),
2163                                       GvNAMEUTF8(sv)));
2164        }
2165         Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
2166         do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
2167         Perl_dump_indent(aTHX_ level, file, "  GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
2168         if (!GvGP(sv))
2169             break;
2170         Perl_dump_indent(aTHX_ level, file, "    SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2171         Perl_dump_indent(aTHX_ level, file, "    REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2172         Perl_dump_indent(aTHX_ level, file, "    IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2173         Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%"UVxf"  \n", PTR2UV(GvFORM(sv)));
2174         Perl_dump_indent(aTHX_ level, file, "    AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2175         Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2176         Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2177         Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
2178         Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
2179         Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
2180         Perl_dump_indent(aTHX_ level, file, "    FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
2181         do_gv_dump (level, file, "    EGV", GvEGV(sv));
2182         break;
2183     case SVt_PVIO:
2184         Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2185         Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2186         Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2187         Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)IoLINES(sv));
2188         Perl_dump_indent(aTHX_ level, file, "  PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2189         Perl_dump_indent(aTHX_ level, file, "  PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2190         Perl_dump_indent(aTHX_ level, file, "  LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
2191         if (IoTOP_NAME(sv))
2192             Perl_dump_indent(aTHX_ level, file, "  TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
2193         if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2194             do_gv_dump (level, file, "  TOP_GV", IoTOP_GV(sv));
2195         else {
2196             Perl_dump_indent(aTHX_ level, file, "  TOP_GV = 0x%"UVxf"\n",
2197                              PTR2UV(IoTOP_GV(sv)));
2198             do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2199                         maxnest, dumpops, pvlim);
2200         }
2201         /* Source filters hide things that are not GVs in these three, so let's
2202            be careful out there.  */
2203         if (IoFMT_NAME(sv))
2204             Perl_dump_indent(aTHX_ level, file, "  FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
2205         if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2206             do_gv_dump (level, file, "  FMT_GV", IoFMT_GV(sv));
2207         else {
2208             Perl_dump_indent(aTHX_ level, file, "  FMT_GV = 0x%"UVxf"\n",
2209                              PTR2UV(IoFMT_GV(sv)));
2210             do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2211                         maxnest, dumpops, pvlim);
2212         }
2213         if (IoBOTTOM_NAME(sv))
2214             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
2215         if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2216             do_gv_dump (level, file, "  BOTTOM_GV", IoBOTTOM_GV(sv));
2217         else {
2218             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_GV = 0x%"UVxf"\n",
2219                              PTR2UV(IoBOTTOM_GV(sv)));
2220             do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2221                         maxnest, dumpops, pvlim);
2222         }
2223         if (isPRINT(IoTYPE(sv)))
2224             Perl_dump_indent(aTHX_ level, file, "  TYPE = '%c'\n", IoTYPE(sv));
2225         else
2226             Perl_dump_indent(aTHX_ level, file, "  TYPE = '\\%o'\n", IoTYPE(sv));
2227         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
2228         break;
2229     case SVt_REGEXP:
2230       dumpregexp:
2231         {
2232             struct regexp * const r = ReANY((REGEXP*)sv);
2233
2234 #define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
2235             sv_setpv(d,"");                                 \
2236             append_flags(d, flags, names);     \
2237             if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') {       \
2238                 SvCUR_set(d, SvCUR(d) - 1);                 \
2239                 SvPVX(d)[SvCUR(d)] = '\0';                  \
2240             }                                               \
2241 } STMT_END
2242             SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
2243             Perl_dump_indent(aTHX_ level, file, "  COMPFLAGS = 0x%"UVxf" (%s)\n",
2244                                 (UV)(r->compflags), SvPVX_const(d));
2245
2246             SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
2247             Perl_dump_indent(aTHX_ level, file, "  EXTFLAGS = 0x%"UVxf" (%s)\n",
2248                                 (UV)(r->extflags), SvPVX_const(d));
2249
2250             Perl_dump_indent(aTHX_ level, file, "  ENGINE = 0x%"UVxf" (%s)\n",
2251                                 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2252             if (r->engine == &PL_core_reg_engine) {
2253                 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
2254                 Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf" (%s)\n",
2255                                 (UV)(r->intflags), SvPVX_const(d));
2256             } else {
2257                 Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf"\n",
2258                                 (UV)(r->intflags));
2259             }
2260 #undef SV_SET_STRINGIFY_REGEXP_FLAGS
2261             Perl_dump_indent(aTHX_ level, file, "  NPARENS = %"UVuf"\n",
2262                                 (UV)(r->nparens));
2263             Perl_dump_indent(aTHX_ level, file, "  LASTPAREN = %"UVuf"\n",
2264                                 (UV)(r->lastparen));
2265             Perl_dump_indent(aTHX_ level, file, "  LASTCLOSEPAREN = %"UVuf"\n",
2266                                 (UV)(r->lastcloseparen));
2267             Perl_dump_indent(aTHX_ level, file, "  MINLEN = %"IVdf"\n",
2268                                 (IV)(r->minlen));
2269             Perl_dump_indent(aTHX_ level, file, "  MINLENRET = %"IVdf"\n",
2270                                 (IV)(r->minlenret));
2271             Perl_dump_indent(aTHX_ level, file, "  GOFS = %"UVuf"\n",
2272                                 (UV)(r->gofs));
2273             Perl_dump_indent(aTHX_ level, file, "  PRE_PREFIX = %"UVuf"\n",
2274                                 (UV)(r->pre_prefix));
2275             Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
2276                                 (IV)(r->sublen));
2277             Perl_dump_indent(aTHX_ level, file, "  SUBOFFSET = %"IVdf"\n",
2278                                 (IV)(r->suboffset));
2279             Perl_dump_indent(aTHX_ level, file, "  SUBCOFFSET = %"IVdf"\n",
2280                                 (IV)(r->subcoffset));
2281             if (r->subbeg)
2282                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x%"UVxf" %s\n",
2283                             PTR2UV(r->subbeg),
2284                             pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2285             else
2286                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x0\n");
2287             Perl_dump_indent(aTHX_ level, file, "  MOTHER_RE = 0x%"UVxf"\n",
2288                                 PTR2UV(r->mother_re));
2289             if (nest < maxnest && r->mother_re)
2290                 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2291                            maxnest, dumpops, pvlim);
2292             Perl_dump_indent(aTHX_ level, file, "  PAREN_NAMES = 0x%"UVxf"\n",
2293                                 PTR2UV(r->paren_names));
2294             Perl_dump_indent(aTHX_ level, file, "  SUBSTRS = 0x%"UVxf"\n",
2295                                 PTR2UV(r->substrs));
2296             Perl_dump_indent(aTHX_ level, file, "  PPRIVATE = 0x%"UVxf"\n",
2297                                 PTR2UV(r->pprivate));
2298             Perl_dump_indent(aTHX_ level, file, "  OFFS = 0x%"UVxf"\n",
2299                                 PTR2UV(r->offs));
2300             Perl_dump_indent(aTHX_ level, file, "  QR_ANONCV = 0x%"UVxf"\n",
2301                                 PTR2UV(r->qr_anoncv));
2302 #ifdef PERL_ANY_COW
2303             Perl_dump_indent(aTHX_ level, file, "  SAVED_COPY = 0x%"UVxf"\n",
2304                                 PTR2UV(r->saved_copy));
2305 #endif
2306         }
2307         break;
2308     }
2309     SvREFCNT_dec_NN(d);
2310 }
2311
2312 /*
2313 =for apidoc sv_dump
2314
2315 Dumps the contents of an SV to the C<STDERR> filehandle.
2316
2317 For an example of its output, see L<Devel::Peek>.
2318
2319 =cut
2320 */
2321
2322 void
2323 Perl_sv_dump(pTHX_ SV *sv)
2324 {
2325     dVAR;
2326
2327     PERL_ARGS_ASSERT_SV_DUMP;
2328
2329     if (SvROK(sv))
2330         do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2331     else
2332         do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
2333 }
2334
2335 int
2336 Perl_runops_debug(pTHX)
2337 {
2338     dVAR;
2339     if (!PL_op) {
2340         Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2341         return 0;
2342     }
2343
2344     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
2345     do {
2346 #ifdef PERL_TRACE_OPS
2347         ++PL_op_exec_cnt[PL_op->op_type];
2348 #endif
2349         if (PL_debug) {
2350             if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
2351                 PerlIO_printf(Perl_debug_log,
2352                               "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2353                               PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2354                               PTR2UV(*PL_watchaddr));
2355             if (DEBUG_s_TEST_) {
2356                 if (DEBUG_v_TEST_) {
2357                     PerlIO_printf(Perl_debug_log, "\n");
2358                     deb_stack_all();
2359                 }
2360                 else
2361                     debstack();
2362             }
2363
2364
2365             if (DEBUG_t_TEST_) debop(PL_op);
2366             if (DEBUG_P_TEST_) debprof(PL_op);
2367         }
2368
2369         OP_ENTRY_PROBE(OP_NAME(PL_op));
2370     } while ((PL_op = PL_op->op_ppaddr(aTHX)));
2371     DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
2372     PERL_ASYNC_CHECK();
2373
2374     TAINT_NOT;
2375     return 0;
2376 }
2377
2378 I32
2379 Perl_debop(pTHX_ const OP *o)
2380 {
2381     dVAR;
2382     int count;
2383
2384     PERL_ARGS_ASSERT_DEBOP;
2385
2386     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2387         return 0;
2388
2389     Perl_deb(aTHX_ "%s", OP_NAME(o));
2390     switch (o->op_type) {
2391     case OP_CONST:
2392     case OP_HINTSEVAL:
2393         /* With ITHREADS, consts are stored in the pad, and the right pad
2394          * may not be active here, so check.
2395          * Looks like only during compiling the pads are illegal.
2396          */
2397 #ifdef USE_ITHREADS
2398         if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2399 #endif
2400             PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
2401         break;
2402     case OP_GVSV:
2403     case OP_GV:
2404         if (cGVOPo_gv) {
2405             SV * const sv = newSV(0);
2406             gv_fullname3(sv, cGVOPo_gv, NULL);
2407             PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2408             SvREFCNT_dec_NN(sv);
2409         }
2410         else
2411             PerlIO_printf(Perl_debug_log, "(NULL)");
2412         break;
2413
2414     case OP_PADSV:
2415     case OP_PADAV:
2416     case OP_PADHV:
2417         count = 1;
2418         goto dump_padop;
2419     case OP_PADRANGE:
2420         count = o->op_private & OPpPADRANGE_COUNTMASK;
2421     dump_padop:
2422         /* print the lexical's name */
2423         {
2424             CV * const cv = deb_curcv(cxstack_ix);
2425             SV *sv;
2426             PAD * comppad = NULL;
2427             int i;
2428
2429             if (cv) {
2430                 PADLIST * const padlist = CvPADLIST(cv);
2431                 comppad = *PadlistARRAY(padlist);
2432             }
2433             PerlIO_printf(Perl_debug_log, "(");
2434             for (i = 0; i < count; i++) {
2435                 if (comppad &&
2436                         (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2437                     PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2438                 else
2439                     PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2440                             (UV)o->op_targ+i);
2441                 if (i < count-1)
2442                     PerlIO_printf(Perl_debug_log, ",");
2443             }
2444             PerlIO_printf(Perl_debug_log, ")");
2445         }
2446         break;
2447
2448     default:
2449         break;
2450     }
2451     PerlIO_printf(Perl_debug_log, "\n");
2452     return 0;
2453 }
2454
2455 STATIC CV*
2456 S_deb_curcv(pTHX_ const I32 ix)
2457 {
2458     dVAR;
2459     const PERL_CONTEXT * const cx = &cxstack[ix];
2460     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2461         return cx->blk_sub.cv;
2462     else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2463         return cx->blk_eval.cv;
2464     else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2465         return PL_main_cv;
2466     else if (ix <= 0)
2467         return NULL;
2468     else
2469         return deb_curcv(ix - 1);
2470 }
2471
2472 void
2473 Perl_watch(pTHX_ char **addr)
2474 {
2475     dVAR;
2476
2477     PERL_ARGS_ASSERT_WATCH;
2478
2479     PL_watchaddr = addr;
2480     PL_watchok = *addr;
2481     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2482         PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2483 }
2484
2485 STATIC void
2486 S_debprof(pTHX_ const OP *o)
2487 {
2488     dVAR;
2489
2490     PERL_ARGS_ASSERT_DEBPROF;
2491
2492     if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
2493         return;
2494     if (!PL_profiledata)
2495         Newxz(PL_profiledata, MAXO, U32);
2496     ++PL_profiledata[o->op_type];
2497 }
2498
2499 void
2500 Perl_debprofdump(pTHX)
2501 {
2502     dVAR;
2503     unsigned i;
2504     if (!PL_profiledata)
2505         return;
2506     for (i = 0; i < MAXO; i++) {
2507         if (PL_profiledata[i])
2508             PerlIO_printf(Perl_debug_log,
2509                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
2510                                        PL_op_name[i]);
2511     }
2512 }
2513
2514
2515 /*
2516  * Local variables:
2517  * c-indentation-style: bsd
2518  * c-basic-offset: 4
2519  * indent-tabs-mode: nil
2520  * End:
2521  *
2522  * ex: set ts=8 sts=4 sw=4 et:
2523  */