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