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