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