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