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