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