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