dump.c

   1 /*    dump.c
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
   4  *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 /*
  12  *  'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
  13  *   it has not been hard for me to read your mind and memory.'
  14  *
  15  *     [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
  16  */
  17
  18 /* This file contains utility routines to dump the contents of SV and OP
  19  * structures, as used by command-line options like -Dt and -Dx, and
  20  * by Devel::Peek.
  21  *
  22  * It also holds the debugging version of the  runops function.
  23
  24 =head1 Display and Dump functions
  25  */
  26
  27 #include "EXTERN.h"
  28 #define PERL_IN_DUMP_C
  29 #include "perl.h"
  30 #include "regcomp.h"
  31
  32 static const char* const svtypenames[SVt_LAST] = {
  33     "NULL",
  34     "IV",
  35     "NV",
  36     "PV",
  37     "INVLIST",
  38     "PVIV",
  39     "PVNV",
  40     "PVMG",
  41     "REGEXP",
  42     "PVGV",
  43     "PVLV",
  44     "PVAV",
  45     "PVHV",
  46     "PVCV",
  47     "PVFM",
  48     "PVIO"
  49 };
  50
  51
  52 static const char* const svshorttypenames[SVt_LAST] = {
  53     "UNDEF",
  54     "IV",
  55     "NV",
  56     "PV",
  57     "INVLST",
  58     "PVIV",
  59     "PVNV",
  60     "PVMG",
  61     "REGEXP",
  62     "GV",
  63     "PVLV",
  64     "AV",
  65     "HV",
  66     "CV",
  67     "FM",
  68     "IO"
  69 };
  70
  71 struct flag_to_name {
  72     U32 flag;
  73     const char *name;
  74 };
  75
  76 static void
  77 S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
  78                const struct flag_to_name *const end)
  79 {
  80     do {
  81         if (flags & start->flag)
  82             sv_catpv(sv, start->name);
  83     } while (++start < end);
  84 }
  85
  86 #define append_flags(sv, f, flags) \
  87     S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
  88
  89 #define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
  90                               (len) * (4+UTF8_MAXBYTES) + 1, NULL, \
  91                               PERL_PV_ESCAPE_NONASCII | PERL_PV_ESCAPE_DWIM \
  92                               | ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
  93
  94 /*
  95 =for apidoc pv_escape
  96
  97 Escapes at most the first "count" chars of pv and puts the results into
  98 dsv such that the size of the escaped string will not exceed "max" chars
  99 and will not contain any incomplete escape sequences.  The number of bytes
 100 escaped will be returned in the STRLEN *escaped parameter if it is not null.
 101 When the 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 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 PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
 109
 110 If PERL_PV_ESCAPE_UNI is set then the input string is treated as UTF-8
 111 if 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 PERL_PV_ESCAPE_ALL is set then all input chars will be output
 115 using C<\x01F1> style escapes, otherwise if 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 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 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 PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
 130 not a '\\'.  This is because regexes very often contain backslashed
 131 sequences, whereas '%' is not a particularly common character in patterns.
 132
 133 Returns a pointer to the escaped text as held by 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 pv_escape() and supporting quoting and ellipses.
 253
 254 If the 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 PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
 257 angle brackets.
 258
 259 If the 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 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 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 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     }
 972
 973     case OP_CONST:
 974     case OP_HINTSEVAL:
 975     case OP_METHOD_NAMED:
 976     case OP_METHOD_SUPER:
 977     case OP_METHOD_REDIR:
 978     case OP_METHOD_REDIR_SUPER:
 979 #ifndef USE_ITHREADS
 980         /* with ITHREADS, consts are stored in the pad, and the right pad
 981          * may not be active here, so skip */
 982         Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));
 983 #endif
 984         break;
 985     case OP_NULL:
 986         if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
 987             break;
 988         /* FALLTHROUGH */
 989     case OP_NEXTSTATE:
 990     case OP_DBSTATE:
 991         if (CopLINE(cCOPo))
 992             Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
 993                              (UV)CopLINE(cCOPo));
 994     if (CopSTASHPV(cCOPo)) {
 995         SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
 996         HV *stash = CopSTASH(cCOPo);
 997         const char * const hvname = HvNAME_get(stash);
 998
 999             Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1000                            generic_pv_escape(tmpsv, hvname,
1001                               HvNAMELEN(stash), HvNAMEUTF8(stash)));
1002     }
1003   if (CopLABEL(cCOPo)) {
1004        SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1005        STRLEN label_len;
1006        U32 label_flags;
1007        const char *label = CopLABEL_len_flags(cCOPo,
1008                                                 &label_len, &label_flags);
1009        Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1010                            generic_pv_escape( tmpsv, label, label_len,
1011                                       (label_flags & SVf_UTF8)));
1012    }
1013         Perl_dump_indent(aTHX_ level, file, "SEQ = %u\n",
1014                          (unsigned int)cCOPo->cop_seq);
1015         break;
1016     case OP_ENTERLOOP:
1017         Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
1018         if (cLOOPo->op_redoop)
1019             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
1020         else
1021             PerlIO_printf(file, "DONE\n");
1022         Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
1023         if (cLOOPo->op_nextop)
1024             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
1025         else
1026             PerlIO_printf(file, "DONE\n");
1027         Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
1028         if (cLOOPo->op_lastop)
1029             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
1030         else
1031             PerlIO_printf(file, "DONE\n");
1032         break;
1033     case OP_COND_EXPR:
1034     case OP_RANGE:
1035     case OP_MAPWHILE:
1036     case OP_GREPWHILE:
1037     case OP_OR:
1038     case OP_AND:
1039         Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
1040         if (cLOGOPo->op_other)
1041             PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
1042         else
1043             PerlIO_printf(file, "DONE\n");
1044         break;
1045     case OP_PUSHRE:
1046     case OP_MATCH:
1047     case OP_QR:
1048     case OP_SUBST:
1049         do_pmop_dump(level, file, cPMOPo);
1050         break;
1051     case OP_LEAVE:
1052     case OP_LEAVEEVAL:
1053     case OP_LEAVESUB:
1054     case OP_LEAVESUBLV:
1055     case OP_LEAVEWRITE:
1056     case OP_SCOPE:
1057         if (o->op_private & OPpREFCOUNTED)
1058             Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1059         break;
1060     default:
1061         break;
1062     }
1063     if (o->op_flags & OPf_KIDS) {
1064         OP *kid;
1065         for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
1066             do_op_dump(level, file, kid);
1067     }
1068     Perl_dump_indent(aTHX_ level-1, file, "}\n");
1069 }
1070
1071 /*
1072 =for apidoc op_dump
1073
1074 Dumps the optree starting at OP C<o> to C<STDERR>.
1075
1076 =cut
1077 */
1078
1079 void
1080 Perl_op_dump(pTHX_ const OP *o)
1081 {
1082     PERL_ARGS_ASSERT_OP_DUMP;
1083     do_op_dump(0, Perl_debug_log, o);
1084 }
1085
1086 void
1087 Perl_gv_dump(pTHX_ GV *gv)
1088 {
1089     STRLEN len;
1090     const char* name;
1091     SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1092
1093     if (!gv) {
1094         PerlIO_printf(Perl_debug_log, "{}\n");
1095         return;
1096     }
1097     sv = sv_newmortal();
1098     PerlIO_printf(Perl_debug_log, "{\n");
1099     gv_fullname3(sv, gv, NULL);
1100     name = SvPV_const(sv, len);
1101     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1102                      generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1103     if (gv != GvEGV(gv)) {
1104         gv_efullname3(sv, GvEGV(gv), NULL);
1105         name = SvPV_const(sv, len);
1106         Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1107                      generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1108     }
1109     PerlIO_putc(Perl_debug_log, '\n');
1110     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
1111 }
1112
1113
1114 /* map magic types to the symbolic names
1115  * (with the PERL_MAGIC_ prefixed stripped)
1116  */
1117
1118 static const struct { const char type; const char *name; } magic_names[] = {
1119 #include "mg_names.c"
1120         /* this null string terminates the list */
1121         { 0,                         NULL },
1122 };
1123
1124 void
1125 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1126 {
1127     PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1128
1129     for (; mg; mg = mg->mg_moremagic) {
1130         Perl_dump_indent(aTHX_ level, file,
1131                          "  MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
1132         if (mg->mg_virtual) {
1133             const MGVTBL * const v = mg->mg_virtual;
1134             if (v >= PL_magic_vtables
1135                 && v < PL_magic_vtables + magic_vtable_max) {
1136                 const U32 i = v - PL_magic_vtables;
1137                 Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1138             }
1139             else
1140                 Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
1141         }
1142         else
1143             Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = 0\n");
1144
1145         if (mg->mg_private)
1146             Perl_dump_indent(aTHX_ level, file, "    MG_PRIVATE = %d\n", mg->mg_private);
1147
1148         {
1149             int n;
1150             const char *name = NULL;
1151             for (n = 0; magic_names[n].name; n++) {
1152                 if (mg->mg_type == magic_names[n].type) {
1153                     name = magic_names[n].name;
1154                     break;
1155                 }
1156             }
1157             if (name)
1158                 Perl_dump_indent(aTHX_ level, file,
1159                                 "    MG_TYPE = PERL_MAGIC_%s\n", name);
1160             else
1161                 Perl_dump_indent(aTHX_ level, file,
1162                                 "    MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1163         }
1164
1165         if (mg->mg_flags) {
1166             Perl_dump_indent(aTHX_ level, file, "    MG_FLAGS = 0x%02X\n", mg->mg_flags);
1167             if (mg->mg_type == PERL_MAGIC_envelem &&
1168                 mg->mg_flags & MGf_TAINTEDDIR)
1169                 Perl_dump_indent(aTHX_ level, file, "      TAINTEDDIR\n");
1170             if (mg->mg_type == PERL_MAGIC_regex_global &&
1171                 mg->mg_flags & MGf_MINMATCH)
1172                 Perl_dump_indent(aTHX_ level, file, "      MINMATCH\n");
1173             if (mg->mg_flags & MGf_REFCOUNTED)
1174                 Perl_dump_indent(aTHX_ level, file, "      REFCOUNTED\n");
1175             if (mg->mg_flags & MGf_GSKIP)
1176                 Perl_dump_indent(aTHX_ level, file, "      GSKIP\n");
1177             if (mg->mg_flags & MGf_COPY)
1178                 Perl_dump_indent(aTHX_ level, file, "      COPY\n");
1179             if (mg->mg_flags & MGf_DUP)
1180                 Perl_dump_indent(aTHX_ level, file, "      DUP\n");
1181             if (mg->mg_flags & MGf_LOCAL)
1182                 Perl_dump_indent(aTHX_ level, file, "      LOCAL\n");
1183             if (mg->mg_type == PERL_MAGIC_regex_global &&
1184                 mg->mg_flags & MGf_BYTES)
1185                 Perl_dump_indent(aTHX_ level, file, "      BYTES\n");
1186         }
1187         if (mg->mg_obj) {
1188             Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n",
1189                 PTR2UV(mg->mg_obj));
1190             if (mg->mg_type == PERL_MAGIC_qr) {
1191                 REGEXP* const re = (REGEXP *)mg->mg_obj;
1192                 SV * const dsv = sv_newmortal();
1193                 const char * const s
1194                     = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
1195                     60, NULL, NULL,
1196                     ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
1197                     (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
1198                 );
1199                 Perl_dump_indent(aTHX_ level+1, file, "    PAT = %s\n", s);
1200                 Perl_dump_indent(aTHX_ level+1, file, "    REFCNT = %"IVdf"\n",
1201                         (IV)RX_REFCNT(re));
1202             }
1203             if (mg->mg_flags & MGf_REFCOUNTED)
1204                 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1205         }
1206         if (mg->mg_len)
1207             Perl_dump_indent(aTHX_ level, file, "    MG_LEN = %ld\n", (long)mg->mg_len);
1208         if (mg->mg_ptr) {
1209             Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
1210             if (mg->mg_len >= 0) {
1211                 if (mg->mg_type != PERL_MAGIC_utf8) {
1212                     SV * const sv = newSVpvs("");
1213                     PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1214                     SvREFCNT_dec_NN(sv);
1215                 }
1216             }
1217             else if (mg->mg_len == HEf_SVKEY) {
1218                 PerlIO_puts(file, " => HEf_SVKEY\n");
1219                 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1220                            maxnest, dumpops, pvlim); /* MG is already +1 */
1221                 continue;
1222             }
1223             else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
1224             else
1225                 PerlIO_puts(
1226                   file,
1227                  " ???? - " __FILE__
1228                  " does not know how to handle this MG_LEN"
1229                 );
1230             PerlIO_putc(file, '\n');
1231         }
1232         if (mg->mg_type == PERL_MAGIC_utf8) {
1233             const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
1234             if (cache) {
1235                 IV i;
1236                 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1237                     Perl_dump_indent(aTHX_ level, file,
1238                                      "      %2"IVdf": %"UVuf" -> %"UVuf"\n",
1239                                      i,
1240                                      (UV)cache[i * 2],
1241                                      (UV)cache[i * 2 + 1]);
1242             }
1243         }
1244     }
1245 }
1246
1247 void
1248 Perl_magic_dump(pTHX_ const MAGIC *mg)
1249 {
1250     do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
1251 }
1252
1253 void
1254 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
1255 {
1256     const char *hvname;
1257
1258     PERL_ARGS_ASSERT_DO_HV_DUMP;
1259
1260     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1261     if (sv && (hvname = HvNAME_get(sv)))
1262     {
1263         /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1264            name which quite legally could contain insane things like tabs, newlines, nulls or
1265            other scary crap - this should produce sane results - except maybe for unicode package
1266            names - but we will wait for someone to file a bug on that - demerphq */
1267         SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1268         PerlIO_printf(file, "\t\"%s\"\n",
1269                               generic_pv_escape( tmpsv, hvname,
1270                                    HvNAMELEN(sv), HvNAMEUTF8(sv)));
1271     }
1272     else
1273         PerlIO_putc(file, '\n');
1274 }
1275
1276 void
1277 Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1278 {
1279     PERL_ARGS_ASSERT_DO_GV_DUMP;
1280
1281     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1282     if (sv && GvNAME(sv)) {
1283         SV * const tmpsv = newSVpvs("");
1284         PerlIO_printf(file, "\t\"%s\"\n",
1285                               generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1286     }
1287     else
1288         PerlIO_putc(file, '\n');
1289 }
1290
1291 void
1292 Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1293 {
1294     PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1295
1296     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1297     if (sv && GvNAME(sv)) {
1298        SV *tmp = newSVpvs_flags("", SVs_TEMP);
1299         const char *hvname;
1300         HV * const stash = GvSTASH(sv);
1301         PerlIO_printf(file, "\t");
1302    /* TODO might have an extra \" here */
1303         if (stash && (hvname = HvNAME_get(stash))) {
1304             PerlIO_printf(file, "\"%s\" :: \"",
1305                                   generic_pv_escape(tmp, hvname,
1306                                       HvNAMELEN(stash), HvNAMEUTF8(stash)));
1307         }
1308         PerlIO_printf(file, "%s\"\n",
1309                               generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
1310     }
1311     else
1312         PerlIO_putc(file, '\n');
1313 }
1314
1315 const struct flag_to_name first_sv_flags_names[] = {
1316     {SVs_TEMP, "TEMP,"},
1317     {SVs_OBJECT, "OBJECT,"},
1318     {SVs_GMG, "GMG,"},
1319     {SVs_SMG, "SMG,"},
1320     {SVs_RMG, "RMG,"},
1321     {SVf_IOK, "IOK,"},
1322     {SVf_NOK, "NOK,"},
1323     {SVf_POK, "POK,"}
1324 };
1325
1326 const struct flag_to_name second_sv_flags_names[] = {
1327     {SVf_OOK, "OOK,"},
1328     {SVf_FAKE, "FAKE,"},
1329     {SVf_READONLY, "READONLY,"},
1330     {SVf_PROTECT, "PROTECT,"},
1331     {SVf_BREAK, "BREAK,"},
1332     {SVp_IOK, "pIOK,"},
1333     {SVp_NOK, "pNOK,"},
1334     {SVp_POK, "pPOK,"}
1335 };
1336
1337 const struct flag_to_name cv_flags_names[] = {
1338     {CVf_ANON, "ANON,"},
1339     {CVf_UNIQUE, "UNIQUE,"},
1340     {CVf_CLONE, "CLONE,"},
1341     {CVf_CLONED, "CLONED,"},
1342     {CVf_CONST, "CONST,"},
1343     {CVf_NODEBUG, "NODEBUG,"},
1344     {CVf_LVALUE, "LVALUE,"},
1345     {CVf_METHOD, "METHOD,"},
1346     {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
1347     {CVf_CVGV_RC, "CVGV_RC,"},
1348     {CVf_DYNFILE, "DYNFILE,"},
1349     {CVf_AUTOLOAD, "AUTOLOAD,"},
1350     {CVf_HASEVAL, "HASEVAL,"},
1351     {CVf_SLABBED, "SLABBED,"},
1352     {CVf_NAMED, "NAMED,"},
1353     {CVf_LEXICAL, "LEXICAL,"},
1354     {CVf_ISXSUB, "ISXSUB,"}
1355 };
1356
1357 const struct flag_to_name hv_flags_names[] = {
1358     {SVphv_SHAREKEYS, "SHAREKEYS,"},
1359     {SVphv_LAZYDEL, "LAZYDEL,"},
1360     {SVphv_HASKFLAGS, "HASKFLAGS,"},
1361     {SVf_AMAGIC, "OVERLOAD,"},
1362     {SVphv_CLONEABLE, "CLONEABLE,"}
1363 };
1364
1365 const struct flag_to_name gp_flags_names[] = {
1366     {GVf_INTRO, "INTRO,"},
1367     {GVf_MULTI, "MULTI,"},
1368     {GVf_ASSUMECV, "ASSUMECV,"},
1369 };
1370
1371 const struct flag_to_name gp_flags_imported_names[] = {
1372     {GVf_IMPORTED_SV, " SV"},
1373     {GVf_IMPORTED_AV, " AV"},
1374     {GVf_IMPORTED_HV, " HV"},
1375     {GVf_IMPORTED_CV, " CV"},
1376 };
1377
1378 /* NOTE: this structure is mostly duplicative of one generated by
1379  * 'make regen' in regnodes.h - perhaps we should somehow integrate
1380  * the two. - Yves */
1381 const struct flag_to_name regexp_extflags_names[] = {
1382     {RXf_PMf_MULTILINE,   "PMf_MULTILINE,"},
1383     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
1384     {RXf_PMf_FOLD,        "PMf_FOLD,"},
1385     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},
1386     {RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
1387     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
1388     {RXf_PMf_NOCAPTURE,   "PMf_NOCAPURE,"},
1389     {RXf_IS_ANCHORED,     "IS_ANCHORED,"},
1390     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
1391     {RXf_EVAL_SEEN,       "EVAL_SEEN,"},
1392     {RXf_CHECK_ALL,       "CHECK_ALL,"},
1393     {RXf_MATCH_UTF8,      "MATCH_UTF8,"},
1394     {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1395     {RXf_USE_INTUIT_ML,   "USE_INTUIT_ML,"},
1396     {RXf_INTUIT_TAIL,     "INTUIT_TAIL,"},
1397     {RXf_SPLIT,           "SPLIT,"},
1398     {RXf_COPY_DONE,       "COPY_DONE,"},
1399     {RXf_TAINTED_SEEN,    "TAINTED_SEEN,"},
1400     {RXf_TAINTED,         "TAINTED,"},
1401     {RXf_START_ONLY,      "START_ONLY,"},
1402     {RXf_SKIPWHITE,       "SKIPWHITE,"},
1403     {RXf_WHITE,           "WHITE,"},
1404     {RXf_NULL,            "NULL,"},
1405 };
1406
1407 /* NOTE: this structure is mostly duplicative of one generated by
1408  * 'make regen' in regnodes.h - perhaps we should somehow integrate
1409  * the two. - Yves */
1410 const struct flag_to_name regexp_core_intflags_names[] = {
1411     {PREGf_SKIP,            "SKIP,"},
1412     {PREGf_IMPLICIT,        "IMPLICIT,"},
1413     {PREGf_NAUGHTY,         "NAUGHTY,"},
1414     {PREGf_VERBARG_SEEN,    "VERBARG_SEEN,"},
1415     {PREGf_CUTGROUP_SEEN,   "CUTGROUP_SEEN,"},
1416     {PREGf_USE_RE_EVAL,     "USE_RE_EVAL,"},
1417     {PREGf_NOSCAN,          "NOSCAN,"},
1418     {PREGf_CANY_SEEN,       "CANY_SEEN,"},
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 void
1427 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1428 {
1429     SV *d;
1430     const char *s;
1431     U32 flags;
1432     U32 type;
1433
1434     PERL_ARGS_ASSERT_DO_SV_DUMP;
1435
1436     if (!sv) {
1437         Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
1438         return;
1439     }
1440
1441     flags = SvFLAGS(sv);
1442     type = SvTYPE(sv);
1443
1444     /* process general SV flags */
1445
1446     d = Perl_newSVpvf(aTHX_
1447                    "(0x%"UVxf") at 0x%"UVxf"\n%*s  REFCNT = %"IVdf"\n%*s  FLAGS = (",
1448                    PTR2UV(SvANY(sv)), PTR2UV(sv),
1449                    (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1450                    (int)(PL_dumpindent*level), "");
1451
1452     if ((flags & SVs_PADSTALE))
1453             sv_catpv(d, "PADSTALE,");
1454     if ((flags & SVs_PADTMP))
1455             sv_catpv(d, "PADTMP,");
1456     append_flags(d, flags, first_sv_flags_names);
1457     if (flags & SVf_ROK)  {
1458                                 sv_catpv(d, "ROK,");
1459         if (SvWEAKREF(sv))      sv_catpv(d, "WEAKREF,");
1460     }
1461     if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
1462     append_flags(d, flags, second_sv_flags_names);
1463     if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1464                            && type != SVt_PVAV) {
1465         if (SvPCS_IMPORTED(sv))
1466                                 sv_catpv(d, "PCS_IMPORTED,");
1467         else
1468                                 sv_catpv(d, "SCREAM,");
1469     }
1470
1471     /* process type-specific SV flags */
1472
1473     switch (type) {
1474     case SVt_PVCV:
1475     case SVt_PVFM:
1476         append_flags(d, CvFLAGS(sv), cv_flags_names);
1477         break;
1478     case SVt_PVHV:
1479         append_flags(d, flags, hv_flags_names);
1480         break;
1481     case SVt_PVGV:
1482     case SVt_PVLV:
1483         if (isGV_with_GP(sv)) {
1484             append_flags(d, GvFLAGS(sv), gp_flags_names);
1485         }
1486         if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
1487             sv_catpv(d, "IMPORT");
1488             if (GvIMPORTED(sv) == GVf_IMPORTED)
1489                 sv_catpv(d, "ALL,");
1490             else {
1491                 sv_catpv(d, "(");
1492                 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
1493                 sv_catpv(d, " ),");
1494             }
1495         }
1496         /* FALLTHROUGH */
1497     default:
1498     evaled_or_uv:
1499         if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
1500         if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
1501         break;
1502     case SVt_PVMG:
1503         if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
1504         if (SvVALID(sv))        sv_catpv(d, "VALID,");
1505         /* FALLTHROUGH */
1506         goto evaled_or_uv;
1507     case SVt_PVAV:
1508         break;
1509     }
1510     /* SVphv_SHAREKEYS is also 0x20000000 */
1511     if ((type != SVt_PVHV) && SvUTF8(sv))
1512         sv_catpv(d, "UTF8");
1513
1514     if (*(SvEND(d) - 1) == ',') {
1515         SvCUR_set(d, SvCUR(d) - 1);
1516         SvPVX(d)[SvCUR(d)] = '\0';
1517     }
1518     sv_catpv(d, ")");
1519     s = SvPVX_const(d);
1520
1521     /* dump initial SV details */
1522
1523 #ifdef DEBUG_LEAKING_SCALARS
1524     Perl_dump_indent(aTHX_ level, file,
1525         "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
1526         sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1527         sv->sv_debug_line,
1528         sv->sv_debug_inpad ? "for" : "by",
1529         sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1530         PTR2UV(sv->sv_debug_parent),
1531         sv->sv_debug_serial
1532     );
1533 #endif
1534     Perl_dump_indent(aTHX_ level, file, "SV = ");
1535
1536     /* Dump SV type */
1537
1538     if (type < SVt_LAST) {
1539         PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1540
1541         if (type ==  SVt_NULL) {
1542             SvREFCNT_dec_NN(d);
1543             return;
1544         }
1545     } else {
1546         PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
1547         SvREFCNT_dec_NN(d);
1548         return;
1549     }
1550
1551     /* Dump general SV fields */
1552
1553     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1554          && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1555          && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
1556         || (type == SVt_IV && !SvROK(sv))) {
1557         if (SvIsUV(sv)
1558 #ifdef PERL_OLD_COPY_ON_WRITE
1559                        || SvIsCOW(sv)
1560 #endif
1561                                      )
1562             Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
1563         else
1564             Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
1565 #ifdef PERL_OLD_COPY_ON_WRITE
1566         if (SvIsCOW_shared_hash(sv))
1567             PerlIO_printf(file, "  (HASH)");
1568         else if (SvIsCOW_normal(sv))
1569             PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1570 #endif
1571         PerlIO_putc(file, '\n');
1572     }
1573
1574     if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
1575                 && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
1576                 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
1577                || type == SVt_NV) {
1578         STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
1579         Perl_dump_indent(aTHX_ level, file, "  NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
1580         RESTORE_LC_NUMERIC_UNDERLYING();
1581     }
1582
1583     if (SvROK(sv)) {
1584         Perl_dump_indent(aTHX_ level, file, "  RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
1585         if (nest < maxnest)
1586             do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
1587     }
1588
1589     if (type < SVt_PV) {
1590         SvREFCNT_dec_NN(d);
1591         return;
1592     }
1593
1594     if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1595      || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
1596         const bool re = isREGEXP(sv);
1597         const char * const ptr =
1598             re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1599         if (ptr) {
1600             STRLEN delta;
1601             if (SvOOK(sv)) {
1602                 SvOOK_offset(sv, delta);
1603                 Perl_dump_indent(aTHX_ level, file,"  OFFSET = %"UVuf"\n",
1604                                  (UV) delta);
1605             } else {
1606                 delta = 0;
1607             }
1608             Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(ptr));
1609             if (SvOOK(sv)) {
1610                 PerlIO_printf(file, "( %s . ) ",
1611                               pv_display(d, ptr - delta, delta, 0,
1612                                          pvlim));
1613             }
1614             if (type == SVt_INVLIST) {
1615                 PerlIO_printf(file, "\n");
1616                 /* 4 blanks indents 2 beyond the PV, etc */
1617                 _invlist_dump(file, level, "    ", sv);
1618             }
1619             else {
1620                 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1621                                                      re ? 0 : SvLEN(sv),
1622                                                      pvlim));
1623                 if (SvUTF8(sv)) /* the 6?  \x{....} */
1624                     PerlIO_printf(file, " [UTF8 \"%s\"]",
1625                                          sv_uni_display(d, sv, 6 * SvCUR(sv),
1626                                                         UNI_DISPLAY_QQ));
1627                 PerlIO_printf(file, "\n");
1628             }
1629             Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
1630             if (!re)
1631                 Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n",
1632                                        (IV)SvLEN(sv));
1633 #ifdef PERL_NEW_COPY_ON_WRITE
1634             if (SvIsCOW(sv) && SvLEN(sv))
1635                 Perl_dump_indent(aTHX_ level, file, "  COW_REFCNT = %d\n",
1636                                        CowREFCNT(sv));
1637 #endif
1638         }
1639         else
1640             Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
1641     }
1642
1643     if (type >= SVt_PVMG) {
1644         if (SvMAGIC(sv))
1645                 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
1646         if (SvSTASH(sv))
1647             do_hv_dump(level, file, "  STASH", SvSTASH(sv));
1648
1649         if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
1650             Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1651         }
1652     }
1653
1654     /* Dump type-specific SV fields */
1655
1656     switch (type) {
1657     case SVt_PVAV:
1658         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
1659         if (AvARRAY(sv) != AvALLOC(sv)) {
1660             PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1661             Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
1662         }
1663         else
1664             PerlIO_putc(file, '\n');
1665         Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1666         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
1667         Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n",
1668                                    SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
1669         sv_setpvs(d, "");
1670         if (AvREAL(sv)) sv_catpv(d, ",REAL");
1671         if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
1672         Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
1673                          SvCUR(d) ? SvPVX_const(d) + 1 : "");
1674         if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
1675             SSize_t count;
1676             for (count = 0; count <=  av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
1677                 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
1678
1679                 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
1680                 if (elt)
1681                     do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1682             }
1683         }
1684         break;
1685     case SVt_PVHV: {
1686         U32 usedkeys;
1687         if (SvOOK(sv)) {
1688             struct xpvhv_aux *const aux = HvAUX(sv);
1689             Perl_dump_indent(aTHX_ level, file, "  AUX_FLAGS = %"UVuf"\n",
1690                              (UV)aux->xhv_aux_flags);
1691         }
1692         Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1693         usedkeys = HvUSEDKEYS(sv);
1694         if (HvARRAY(sv) && usedkeys) {
1695             /* Show distribution of HEs in the ARRAY */
1696             int freq[200];
1697 #define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
1698             int i;
1699             int max = 0;
1700             U32 pow2 = 2, keys = usedkeys;
1701             NV theoret, sum = 0;
1702
1703             PerlIO_printf(file, "  (");
1704             Zero(freq, FREQ_MAX + 1, int);
1705             for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
1706                 HE* h;
1707                 int count = 0;
1708                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1709                     count++;
1710                 if (count > FREQ_MAX)
1711                     count = FREQ_MAX;
1712                 freq[count]++;
1713                 if (max < count)
1714                     max = count;
1715             }
1716             for (i = 0; i <= max; i++) {
1717                 if (freq[i]) {
1718                     PerlIO_printf(file, "%d%s:%d", i,
1719                                   (i == FREQ_MAX) ? "+" : "",
1720                                   freq[i]);
1721                     if (i != max)
1722                         PerlIO_printf(file, ", ");
1723                 }
1724             }
1725             PerlIO_putc(file, ')');
1726             /* The "quality" of a hash is defined as the total number of
1727                comparisons needed to access every element once, relative
1728                to the expected number needed for a random hash.
1729
1730                The total number of comparisons is equal to the sum of
1731                the squares of the number of entries in each bucket.
1732                For a random hash of n keys into k buckets, the expected
1733                value is
1734                                 n + n(n-1)/2k
1735             */
1736
1737             for (i = max; i > 0; i--) { /* Precision: count down. */
1738                 sum += freq[i] * i * i;
1739             }
1740             while ((keys = keys >> 1))
1741                 pow2 = pow2 << 1;
1742             theoret = usedkeys;
1743             theoret += theoret * (theoret-1)/pow2;
1744             PerlIO_putc(file, '\n');
1745             Perl_dump_indent(aTHX_ level, file, "  hash quality = %.1"NVff"%%", theoret/sum*100);
1746         }
1747         PerlIO_putc(file, '\n');
1748         Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)usedkeys);
1749         {
1750             STRLEN count = 0;
1751             HE **ents = HvARRAY(sv);
1752
1753             if (ents) {
1754                 HE *const *const last = ents + HvMAX(sv);
1755                 count = last + 1 - ents;
1756
1757                 do {
1758                     if (!*ents)
1759                         --count;
1760                 } while (++ents <= last);
1761             }
1762
1763             if (SvOOK(sv)) {
1764                 struct xpvhv_aux *const aux = HvAUX(sv);
1765                 Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf
1766                                  " (cached = %"UVuf")\n",
1767                                  (UV)count, (UV)aux->xhv_fill_lazy);
1768             } else {
1769                 Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
1770                                  (UV)count);
1771             }
1772         }
1773         Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
1774         if (SvOOK(sv)) {
1775             Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1776             Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
1777 #ifdef PERL_HASH_RANDOMIZE_KEYS
1778             Perl_dump_indent(aTHX_ level, file, "  RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1779             if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
1780                 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
1781             }
1782 #endif
1783             PerlIO_putc(file, '\n');
1784         }
1785         {
1786             MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
1787             if (mg && mg->mg_obj) {
1788                 Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1789             }
1790         }
1791         {
1792             const char * const hvname = HvNAME_get(sv);
1793             if (hvname) {
1794           SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1795      Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
1796                                        generic_pv_escape( tmpsv, hvname,
1797                                            HvNAMELEN(sv), HvNAMEUTF8(sv)));
1798         }
1799         }
1800         if (SvOOK(sv)) {
1801             AV * const backrefs
1802                 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
1803             struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
1804             if (HvAUX(sv)->xhv_name_count)
1805                 Perl_dump_indent(aTHX_
1806                  level, file, "  NAMECOUNT = %"IVdf"\n",
1807                  (IV)HvAUX(sv)->xhv_name_count
1808                 );
1809             if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
1810                 const I32 count = HvAUX(sv)->xhv_name_count;
1811                 if (count) {
1812                     SV * const names = newSVpvs_flags("", SVs_TEMP);
1813                     /* The starting point is the first element if count is
1814                        positive and the second element if count is negative. */
1815                     HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1816                         + (count < 0 ? 1 : 0);
1817                     HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1818                         + (count < 0 ? -count : count);
1819                     while (hekp < endp) {
1820                         if (HEK_LEN(*hekp)) {
1821              SV *tmp = newSVpvs_flags("", SVs_TEMP);
1822                             Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
1823                               generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
1824                         } else {
1825                             /* This should never happen. */
1826                             sv_catpvs(names, ", (null)");
1827                         }
1828                         ++hekp;
1829                     }
1830                     Perl_dump_indent(aTHX_
1831                      level, file, "  ENAME = %s\n", SvPV_nolen(names)+2
1832                     );
1833                 }
1834                 else {
1835                     SV * const tmp = newSVpvs_flags("", SVs_TEMP);
1836                     const char *const hvename = HvENAME_get(sv);
1837                     Perl_dump_indent(aTHX_
1838                      level, file, "  ENAME = \"%s\"\n",
1839                      generic_pv_escape(tmp, hvename,
1840                                        HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
1841                 }
1842             }
1843             if (backrefs) {
1844                 Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
1845                                  PTR2UV(backrefs));
1846                 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
1847                            dumpops, pvlim);
1848             }
1849             if (meta) {
1850                 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1851                 Perl_dump_indent(aTHX_ level, file, "  MRO_WHICH = \"%s\" (0x%"UVxf")\n",
1852                                  generic_pv_escape( tmpsv, meta->mro_which->name,
1853                                 meta->mro_which->length,
1854                                 (meta->mro_which->kflags & HVhek_UTF8)),
1855                                  PTR2UV(meta->mro_which));
1856                 Perl_dump_indent(aTHX_ level, file, "  CACHE_GEN = 0x%"UVxf"\n",
1857                                  (UV)meta->cache_gen);
1858                 Perl_dump_indent(aTHX_ level, file, "  PKG_GEN = 0x%"UVxf"\n",
1859                                  (UV)meta->pkg_gen);
1860                 if (meta->mro_linear_all) {
1861                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_ALL = 0x%"UVxf"\n",
1862                                  PTR2UV(meta->mro_linear_all));
1863                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1864                            dumpops, pvlim);
1865                 }
1866                 if (meta->mro_linear_current) {
1867                     Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1868                                  PTR2UV(meta->mro_linear_current));
1869                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1870                            dumpops, pvlim);
1871                 }
1872                 if (meta->mro_nextmethod) {
1873                     Perl_dump_indent(aTHX_ level, file, "  MRO_NEXTMETHOD = 0x%"UVxf"\n",
1874                                  PTR2UV(meta->mro_nextmethod));
1875                 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1876                            dumpops, pvlim);
1877                 }
1878                 if (meta->isa) {
1879                     Perl_dump_indent(aTHX_ level, file, "  ISA = 0x%"UVxf"\n",
1880                                  PTR2UV(meta->isa));
1881                 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1882                            dumpops, pvlim);
1883                 }
1884             }
1885         }
1886         if (nest < maxnest) {
1887             HV * const hv = MUTABLE_HV(sv);
1888             STRLEN i;
1889             HE *he;
1890
1891             if (HvARRAY(hv)) {
1892                 int count = maxnest - nest;
1893                 for (i=0; i <= HvMAX(hv); i++) {
1894                     for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1895                         U32 hash;
1896                         SV * keysv;
1897                         const char * keypv;
1898                         SV * elt;
1899                         STRLEN len;
1900
1901                         if (count-- <= 0) goto DONEHV;
1902
1903                         hash = HeHASH(he);
1904                         keysv = hv_iterkeysv(he);
1905                         keypv = SvPV_const(keysv, len);
1906                         elt = HeVAL(he);
1907
1908                         Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1909                         if (SvUTF8(keysv))
1910                             PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
1911                         if (HvEITER_get(hv) == he)
1912                             PerlIO_printf(file, "[CURRENT] ");
1913                         PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1914                         do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1915                     }
1916                 }
1917               DONEHV:;
1918             }
1919         }
1920         break;
1921     } /* case SVt_PVHV */
1922
1923     case SVt_PVCV:
1924         if (CvAUTOLOAD(sv)) {
1925             SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1926        STRLEN len;
1927             const char *const name =  SvPV_const(sv, len);
1928             Perl_dump_indent(aTHX_ level, file, "  AUTOLOAD = \"%s\"\n",
1929                              generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
1930         }
1931         if (SvPOK(sv)) {
1932        SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1933        const char *const proto = CvPROTO(sv);
1934             Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n",
1935                              generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
1936                                 SvUTF8(sv)));
1937         }
1938         /* FALLTHROUGH */
1939     case SVt_PVFM:
1940         do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
1941         if (!CvISXSUB(sv)) {
1942             if (CvSTART(sv)) {
1943                 Perl_dump_indent(aTHX_ level, file,
1944                                  "  START = 0x%"UVxf" ===> %"IVdf"\n",
1945                                  PTR2UV(CvSTART(sv)),
1946                                  (IV)sequence_num(CvSTART(sv)));
1947             }
1948             Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n",
1949                              PTR2UV(CvROOT(sv)));
1950             if (CvROOT(sv) && dumpops) {
1951                 do_op_dump(level+1, file, CvROOT(sv));
1952             }
1953         } else {
1954             SV * const constant = cv_const_sv((const CV *)sv);
1955
1956             Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
1957
1958             if (constant) {
1959                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
1960                                  " (CONST SV)\n",
1961                                  PTR2UV(CvXSUBANY(sv).any_ptr));
1962                 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
1963                            pvlim);
1964             } else {
1965                 Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
1966                                  (IV)CvXSUBANY(sv).any_i32);
1967             }
1968         }
1969         if (CvNAMED(sv))
1970             Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
1971                                    HEK_KEY(CvNAME_HEK((CV *)sv)));
1972         else do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
1973         Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
1974         Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
1975         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
1976         Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
1977         if (!CvISXSUB(sv)) {
1978             Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
1979             if (nest < maxnest) {
1980                 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
1981             }
1982         }
1983         else
1984             Perl_dump_indent(aTHX_ level, file, "  HSCXT = 0x%p\n", CvHSCXT(sv));
1985         {
1986             const CV * const outside = CvOUTSIDE(sv);
1987             Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",
1988                         PTR2UV(outside),
1989                         (!outside ? "null"
1990                          : CvANON(outside) ? "ANON"
1991                          : (outside == PL_main_cv) ? "MAIN"
1992                          : CvUNIQUE(outside) ? "UNIQUE"
1993                          : CvGV(outside) ?
1994                              generic_pv_escape(
1995                                  newSVpvs_flags("", SVs_TEMP),
1996                                  GvNAME(CvGV(outside)),
1997                                  GvNAMELEN(CvGV(outside)),
1998                                  GvNAMEUTF8(CvGV(outside)))
1999                          : "UNDEFINED"));
2000         }
2001         if (CvOUTSIDE(sv)
2002          && (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))))
2003             do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
2004         break;
2005
2006     case SVt_PVGV:
2007     case SVt_PVLV:
2008         if (type == SVt_PVLV) {
2009             Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
2010             Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2011             Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2012             Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
2013             Perl_dump_indent(aTHX_ level, file, "  FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
2014             if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
2015                 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2016                     dumpops, pvlim);
2017         }
2018         if (isREGEXP(sv)) goto dumpregexp;
2019         if (!isGV_with_GP(sv))
2020             break;
2021        {
2022           SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2023           Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
2024                     generic_pv_escape(tmpsv, GvNAME(sv),
2025                                       GvNAMELEN(sv),
2026                                       GvNAMEUTF8(sv)));
2027        }
2028         Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
2029         do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
2030         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
2031         Perl_dump_indent(aTHX_ level, file, "  GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
2032         if (!GvGP(sv))
2033             break;
2034         Perl_dump_indent(aTHX_ level, file, "    SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2035         Perl_dump_indent(aTHX_ level, file, "    REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2036         Perl_dump_indent(aTHX_ level, file, "    IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2037         Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%"UVxf"  \n", PTR2UV(GvFORM(sv)));
2038         Perl_dump_indent(aTHX_ level, file, "    AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2039         Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2040         Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2041         Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
2042         Perl_dump_indent(aTHX_ level, file, "    GPFLAGS = 0x%"UVxf
2043                                             " (%s)\n",
2044                                (UV)GvGPFLAGS(sv),
2045                                GvALIASED_SV(sv) ? "ALIASED_SV" : "");
2046         Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
2047         Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
2048         do_gv_dump (level, file, "    EGV", GvEGV(sv));
2049         break;
2050     case SVt_PVIO:
2051         Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2052         Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2053         Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2054         Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)IoLINES(sv));
2055         Perl_dump_indent(aTHX_ level, file, "  PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2056         Perl_dump_indent(aTHX_ level, file, "  PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2057         Perl_dump_indent(aTHX_ level, file, "  LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
2058         if (IoTOP_NAME(sv))
2059             Perl_dump_indent(aTHX_ level, file, "  TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
2060         if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2061             do_gv_dump (level, file, "  TOP_GV", IoTOP_GV(sv));
2062         else {
2063             Perl_dump_indent(aTHX_ level, file, "  TOP_GV = 0x%"UVxf"\n",
2064                              PTR2UV(IoTOP_GV(sv)));
2065             do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2066                         maxnest, dumpops, pvlim);
2067         }
2068         /* Source filters hide things that are not GVs in these three, so let's
2069            be careful out there.  */
2070         if (IoFMT_NAME(sv))
2071             Perl_dump_indent(aTHX_ level, file, "  FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
2072         if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2073             do_gv_dump (level, file, "  FMT_GV", IoFMT_GV(sv));
2074         else {
2075             Perl_dump_indent(aTHX_ level, file, "  FMT_GV = 0x%"UVxf"\n",
2076                              PTR2UV(IoFMT_GV(sv)));
2077             do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2078                         maxnest, dumpops, pvlim);
2079         }
2080         if (IoBOTTOM_NAME(sv))
2081             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
2082         if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2083             do_gv_dump (level, file, "  BOTTOM_GV", IoBOTTOM_GV(sv));
2084         else {
2085             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_GV = 0x%"UVxf"\n",
2086                              PTR2UV(IoBOTTOM_GV(sv)));
2087             do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2088                         maxnest, dumpops, pvlim);
2089         }
2090         if (isPRINT(IoTYPE(sv)))
2091             Perl_dump_indent(aTHX_ level, file, "  TYPE = '%c'\n", IoTYPE(sv));
2092         else
2093             Perl_dump_indent(aTHX_ level, file, "  TYPE = '\\%o'\n", IoTYPE(sv));
2094         Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
2095         break;
2096     case SVt_REGEXP:
2097       dumpregexp:
2098         {
2099             struct regexp * const r = ReANY((REGEXP*)sv);
2100
2101 #define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
2102             sv_setpv(d,"");                                 \
2103             append_flags(d, flags, names);     \
2104             if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') {       \
2105                 SvCUR_set(d, SvCUR(d) - 1);                 \
2106                 SvPVX(d)[SvCUR(d)] = '\0';                  \
2107             }                                               \
2108 } STMT_END
2109             SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
2110             Perl_dump_indent(aTHX_ level, file, "  COMPFLAGS = 0x%"UVxf" (%s)\n",
2111                                 (UV)(r->compflags), SvPVX_const(d));
2112
2113             SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
2114             Perl_dump_indent(aTHX_ level, file, "  EXTFLAGS = 0x%"UVxf" (%s)\n",
2115                                 (UV)(r->extflags), SvPVX_const(d));
2116
2117             Perl_dump_indent(aTHX_ level, file, "  ENGINE = 0x%"UVxf" (%s)\n",
2118                                 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2119             if (r->engine == &PL_core_reg_engine) {
2120                 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
2121                 Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf" (%s)\n",
2122                                 (UV)(r->intflags), SvPVX_const(d));
2123             } else {
2124                 Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf"\n",
2125                                 (UV)(r->intflags));
2126             }
2127 #undef SV_SET_STRINGIFY_REGEXP_FLAGS
2128             Perl_dump_indent(aTHX_ level, file, "  NPARENS = %"UVuf"\n",
2129                                 (UV)(r->nparens));
2130             Perl_dump_indent(aTHX_ level, file, "  LASTPAREN = %"UVuf"\n",
2131                                 (UV)(r->lastparen));
2132             Perl_dump_indent(aTHX_ level, file, "  LASTCLOSEPAREN = %"UVuf"\n",
2133                                 (UV)(r->lastcloseparen));
2134             Perl_dump_indent(aTHX_ level, file, "  MINLEN = %"IVdf"\n",
2135                                 (IV)(r->minlen));
2136             Perl_dump_indent(aTHX_ level, file, "  MINLENRET = %"IVdf"\n",
2137                                 (IV)(r->minlenret));
2138             Perl_dump_indent(aTHX_ level, file, "  GOFS = %"UVuf"\n",
2139                                 (UV)(r->gofs));
2140             Perl_dump_indent(aTHX_ level, file, "  PRE_PREFIX = %"UVuf"\n",
2141                                 (UV)(r->pre_prefix));
2142             Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
2143                                 (IV)(r->sublen));
2144             Perl_dump_indent(aTHX_ level, file, "  SUBOFFSET = %"IVdf"\n",
2145                                 (IV)(r->suboffset));
2146             Perl_dump_indent(aTHX_ level, file, "  SUBCOFFSET = %"IVdf"\n",
2147                                 (IV)(r->subcoffset));
2148             if (r->subbeg)
2149                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x%"UVxf" %s\n",
2150                             PTR2UV(r->subbeg),
2151                             pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2152             else
2153                 Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x0\n");
2154             Perl_dump_indent(aTHX_ level, file, "  MOTHER_RE = 0x%"UVxf"\n",
2155                                 PTR2UV(r->mother_re));
2156             if (nest < maxnest && r->mother_re)
2157                 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2158                            maxnest, dumpops, pvlim);
2159             Perl_dump_indent(aTHX_ level, file, "  PAREN_NAMES = 0x%"UVxf"\n",
2160                                 PTR2UV(r->paren_names));
2161             Perl_dump_indent(aTHX_ level, file, "  SUBSTRS = 0x%"UVxf"\n",
2162                                 PTR2UV(r->substrs));
2163             Perl_dump_indent(aTHX_ level, file, "  PPRIVATE = 0x%"UVxf"\n",
2164                                 PTR2UV(r->pprivate));
2165             Perl_dump_indent(aTHX_ level, file, "  OFFS = 0x%"UVxf"\n",
2166                                 PTR2UV(r->offs));
2167             Perl_dump_indent(aTHX_ level, file, "  QR_ANONCV = 0x%"UVxf"\n",
2168                                 PTR2UV(r->qr_anoncv));
2169 #ifdef PERL_ANY_COW
2170             Perl_dump_indent(aTHX_ level, file, "  SAVED_COPY = 0x%"UVxf"\n",
2171                                 PTR2UV(r->saved_copy));
2172 #endif
2173         }
2174         break;
2175     }
2176     SvREFCNT_dec_NN(d);
2177 }
2178
2179 /*
2180 =for apidoc sv_dump
2181
2182 Dumps the contents of an SV to the C<STDERR> filehandle.
2183
2184 For an example of its output, see L<Devel::Peek>.
2185
2186 =cut
2187 */
2188
2189 void
2190 Perl_sv_dump(pTHX_ SV *sv)
2191 {
2192     PERL_ARGS_ASSERT_SV_DUMP;
2193
2194     if (SvROK(sv))
2195         do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2196     else
2197         do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
2198 }
2199
2200 int
2201 Perl_runops_debug(pTHX)
2202 {
2203     if (!PL_op) {
2204         Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2205         return 0;
2206     }
2207
2208     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
2209     do {
2210 #ifdef PERL_TRACE_OPS
2211         ++PL_op_exec_cnt[PL_op->op_type];
2212 #endif
2213         if (PL_debug) {
2214             if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
2215                 PerlIO_printf(Perl_debug_log,
2216                               "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2217                               PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2218                               PTR2UV(*PL_watchaddr));
2219             if (DEBUG_s_TEST_) {
2220                 if (DEBUG_v_TEST_) {
2221                     PerlIO_printf(Perl_debug_log, "\n");
2222                     deb_stack_all();
2223                 }
2224                 else
2225                     debstack();
2226             }
2227
2228
2229             if (DEBUG_t_TEST_) debop(PL_op);
2230             if (DEBUG_P_TEST_) debprof(PL_op);
2231         }
2232
2233         OP_ENTRY_PROBE(OP_NAME(PL_op));
2234     } while ((PL_op = PL_op->op_ppaddr(aTHX)));
2235     DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
2236     PERL_ASYNC_CHECK();
2237
2238     TAINT_NOT;
2239     return 0;
2240 }
2241
2242
2243 /* print the names of the n lexical vars starting at pad offset off */
2244
2245 void
2246 S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
2247 {
2248     PADNAME *sv;
2249     CV * const cv = deb_curcv(cxstack_ix);
2250     PADNAMELIST *comppad = NULL;
2251     int i;
2252
2253     if (cv) {
2254         PADLIST * const padlist = CvPADLIST(cv);
2255         comppad = PadlistNAMES(padlist);
2256     }
2257     if (paren)
2258         PerlIO_printf(Perl_debug_log, "(");
2259     for (i = 0; i < n; i++) {
2260         if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
2261             PerlIO_printf(Perl_debug_log, "%"PNf, PNfARG(sv));
2262         else
2263             PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2264                     (UV)(off+i));
2265         if (i < n - 1)
2266             PerlIO_printf(Perl_debug_log, ",");
2267     }
2268     if (paren)
2269         PerlIO_printf(Perl_debug_log, ")");
2270 }
2271
2272
2273 /* append to the out SV, the name of the lexical at offset off in the CV
2274  * cv */
2275
2276 static void
2277 S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
2278         bool paren, bool is_scalar)
2279 {
2280     PADNAME *sv;
2281     PADNAMELIST *namepad = NULL;
2282     int i;
2283
2284     if (cv) {
2285         PADLIST * const padlist = CvPADLIST(cv);
2286         namepad = PadlistNAMES(padlist);
2287     }
2288
2289     if (paren)
2290         sv_catpvs_nomg(out, "(");
2291     for (i = 0; i < n; i++) {
2292         if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
2293         {
2294             STRLEN cur = SvCUR(out);
2295             Perl_sv_catpvf(aTHX_ out, "[%"UTF8f,
2296                                  UTF8fARG(1, PadnameLEN(sv) - 1,
2297                                           PadnamePV(sv) + 1));
2298             if (is_scalar)
2299                 SvPVX(out)[cur] = '$';
2300         }
2301         else
2302             Perl_sv_catpvf(aTHX_ out, "[%"UVuf"]", (UV)(off+i));
2303         if (i < n - 1)
2304             sv_catpvs_nomg(out, ",");
2305     }
2306     if (paren)
2307         sv_catpvs_nomg(out, "(");
2308 }
2309
2310
2311 static void
2312 S_append_gv_name(pTHX_ GV *gv, SV *out)
2313 {
2314     SV *sv;
2315     if (!gv) {
2316         sv_catpvs_nomg(out, "<NULLGV>");
2317         return;
2318     }
2319     sv = newSV(0);
2320     gv_fullname4(sv, gv, NULL, FALSE);
2321     Perl_sv_catpvf(aTHX_ out, "%c%-p", '$', sv);
2322     SvREFCNT_dec_NN(sv);
2323 }
2324
2325 #ifdef USE_ITHREADS
2326 #  define ITEM_SV(item) (comppad ? \
2327     *av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
2328 #else
2329 #  define ITEM_SV(item) UNOP_AUX_item_sv(item)
2330 #endif
2331
2332
2333 /* return a temporary SV containing a stringified representation of
2334  * the op_aux field of a MULTIDEREF op, associated with CV cv
2335  */
2336
2337 SV*
2338 Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
2339 {
2340     UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
2341     UV actions = items->uv;
2342     SV *sv;
2343     bool last = 0;
2344     bool is_hash = FALSE;
2345     int derefs = 0;
2346     SV *out = newSVpvn_flags("",0,SVs_TEMP);
2347 #ifdef USE_ITHREADS
2348     PAD *comppad;
2349
2350     if (cv) {
2351         PADLIST *padlist = CvPADLIST(cv);
2352         comppad = PadlistARRAY(padlist)[1];
2353     }
2354     else
2355         comppad = NULL;
2356 #endif
2357
2358     PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
2359
2360     while (!last) {
2361         switch (actions & MDEREF_ACTION_MASK) {
2362
2363         case MDEREF_reload:
2364             actions = (++items)->uv;
2365             continue;
2366             NOT_REACHED; /* NOTREACHED */
2367
2368         case MDEREF_HV_padhv_helem:
2369             is_hash = TRUE;
2370             /* FALLTHROUGH */
2371         case MDEREF_AV_padav_aelem:
2372             derefs = 1;
2373             S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2374             goto do_elem;
2375             NOT_REACHED; /* NOTREACHED */
2376
2377         case MDEREF_HV_gvhv_helem:
2378             is_hash = TRUE;
2379             /* FALLTHROUGH */
2380         case MDEREF_AV_gvav_aelem:
2381             derefs = 1;
2382             items++;
2383             sv = ITEM_SV(items);
2384             S_append_gv_name(aTHX_ (GV*)sv, out);
2385             goto do_elem;
2386             NOT_REACHED; /* NOTREACHED */
2387
2388         case MDEREF_HV_gvsv_vivify_rv2hv_helem:
2389             is_hash = TRUE;
2390             /* FALLTHROUGH */
2391         case MDEREF_AV_gvsv_vivify_rv2av_aelem:
2392             items++;
2393             sv = ITEM_SV(items);
2394             S_append_gv_name(aTHX_ (GV*)sv, out);
2395             goto do_vivify_rv2xv_elem;
2396             NOT_REACHED; /* NOTREACHED */
2397
2398         case MDEREF_HV_padsv_vivify_rv2hv_helem:
2399             is_hash = TRUE;
2400             /* FALLTHROUGH */
2401         case MDEREF_AV_padsv_vivify_rv2av_aelem:
2402             S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2403             goto do_vivify_rv2xv_elem;
2404             NOT_REACHED; /* NOTREACHED */
2405
2406         case MDEREF_HV_pop_rv2hv_helem:
2407         case MDEREF_HV_vivify_rv2hv_helem:
2408             is_hash = TRUE;
2409             /* FALLTHROUGH */
2410         do_vivify_rv2xv_elem:
2411         case MDEREF_AV_pop_rv2av_aelem:
2412         case MDEREF_AV_vivify_rv2av_aelem:
2413             if (!derefs++)
2414                 sv_catpvs_nomg(out, "->");
2415         do_elem:
2416             if ((actions & MDEREF_INDEX_MASK)== MDEREF_INDEX_none) {
2417                 sv_catpvs_nomg(out, "->");
2418                 last = 1;
2419                 break;
2420             }
2421
2422             sv_catpvn_nomg(out, (is_hash ? "{" : "["), 1);
2423             switch (actions & MDEREF_INDEX_MASK) {
2424             case MDEREF_INDEX_const:
2425                 if (is_hash) {
2426                     items++;
2427                     sv = ITEM_SV(items);
2428                     if (!sv)
2429                         sv_catpvs_nomg(out, "???");
2430                     else {
2431                         STRLEN cur;
2432                         char *s;
2433                         s = SvPV(sv, cur);
2434                         pv_pretty(out, s, cur, 30,
2435                                     NULL, NULL,
2436                                     (PERL_PV_PRETTY_NOCLEAR
2437                                     |PERL_PV_PRETTY_QUOTE
2438                                     |PERL_PV_PRETTY_ELLIPSES));
2439                     }
2440                 }
2441                 else
2442                     Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
2443                 break;
2444             case MDEREF_INDEX_padsv:
2445                 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2446                 break;
2447             case MDEREF_INDEX_gvsv:
2448                 items++;
2449                 sv = ITEM_SV(items);
2450                 S_append_gv_name(aTHX_ (GV*)sv, out);
2451                 break;
2452             }
2453             sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
2454
2455             if (actions & MDEREF_FLAG_last)
2456                 last = 1;
2457             is_hash = FALSE;
2458
2459             break;
2460
2461         default:
2462             PerlIO_printf(Perl_debug_log, "UNKNOWN(%d)",
2463                 (int)(actions & MDEREF_ACTION_MASK));
2464             last = 1;
2465             break;
2466
2467         } /* switch */
2468
2469         actions >>= MDEREF_SHIFT;
2470     } /* while */
2471     return out;
2472 }
2473
2474
2475 I32
2476 Perl_debop(pTHX_ const OP *o)
2477 {
2478     PERL_ARGS_ASSERT_DEBOP;
2479
2480     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2481         return 0;
2482
2483     Perl_deb(aTHX_ "%s", OP_NAME(o));
2484     switch (o->op_type) {
2485     case OP_CONST:
2486     case OP_HINTSEVAL:
2487         /* With ITHREADS, consts are stored in the pad, and the right pad
2488          * may not be active here, so check.
2489          * Looks like only during compiling the pads are illegal.
2490          */
2491 #ifdef USE_ITHREADS
2492         if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2493 #endif
2494             PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
2495         break;
2496     case OP_GVSV:
2497     case OP_GV:
2498         if (cGVOPo_gv && isGV(cGVOPo_gv)) {
2499             SV * const sv = newSV(0);
2500             gv_fullname3(sv, cGVOPo_gv, NULL);
2501             PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2502             SvREFCNT_dec_NN(sv);
2503         }
2504         else if (cGVOPo_gv) {
2505             SV * const sv = newSV(0);
2506             assert(SvROK(cGVOPo_gv));
2507             assert(SvTYPE(SvRV(cGVOPo_gv)) == SVt_PVCV);
2508             PerlIO_printf(Perl_debug_log, "(cv ref: %s)",
2509                     SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv,0)));
2510             SvREFCNT_dec_NN(sv);
2511         }
2512         else
2513             PerlIO_printf(Perl_debug_log, "(NULL)");
2514         break;
2515
2516     case OP_PADSV:
2517     case OP_PADAV:
2518     case OP_PADHV:
2519         S_deb_padvar(aTHX_ o->op_targ, 1, 1);
2520         break;
2521
2522     case OP_PADRANGE:
2523         S_deb_padvar(aTHX_ o->op_targ,
2524                         o->op_private & OPpPADRANGE_COUNTMASK, 1);
2525         break;
2526
2527     case OP_MULTIDEREF:
2528         PerlIO_printf(Perl_debug_log, "(%-p)",
2529             multideref_stringify(o, deb_curcv(cxstack_ix)));
2530         break;
2531
2532     default:
2533         break;
2534     }
2535     PerlIO_printf(Perl_debug_log, "\n");
2536     return 0;
2537 }
2538
2539 STATIC CV*
2540 S_deb_curcv(pTHX_ I32 ix)
2541 {
2542     PERL_SI *si = PL_curstackinfo;
2543     for (; ix >=0; ix--) {
2544         const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
2545
2546         if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2547             return cx->blk_sub.cv;
2548         else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2549             return cx->blk_eval.cv;
2550         else if (ix == 0 && si->si_type == PERLSI_MAIN)
2551             return PL_main_cv;
2552         else if (ix == 0 && CxTYPE(cx) == CXt_NULL
2553                && si->si_type == PERLSI_SORT)
2554         {
2555             /* fake sort sub; use CV of caller */
2556             si = si->si_prev;
2557             ix = si->si_cxix + 1;
2558         }
2559     }
2560     return NULL;
2561 }
2562
2563 void
2564 Perl_watch(pTHX_ char **addr)
2565 {
2566     PERL_ARGS_ASSERT_WATCH;
2567
2568     PL_watchaddr = addr;
2569     PL_watchok = *addr;
2570     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2571         PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2572 }
2573
2574 STATIC void
2575 S_debprof(pTHX_ const OP *o)
2576 {
2577     PERL_ARGS_ASSERT_DEBPROF;
2578
2579     if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
2580         return;
2581     if (!PL_profiledata)
2582         Newxz(PL_profiledata, MAXO, U32);
2583     ++PL_profiledata[o->op_type];
2584 }
2585
2586 void
2587 Perl_debprofdump(pTHX)
2588 {
2589     unsigned i;
2590     if (!PL_profiledata)
2591         return;
2592     for (i = 0; i < MAXO; i++) {
2593         if (PL_profiledata[i])
2594             PerlIO_printf(Perl_debug_log,
2595                           "%5lu %s\n", (unsigned long)PL_profiledata[i],
2596                                        PL_op_name[i]);
2597     }
2598 }
2599
2600
2601 /*
2602  * ex: set ts=8 sts=4 sw=4 et:
2603  */