dump.c

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