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
Deprecate /\C/
[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"); \
b5bbe64a
JH		 904 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
905 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : ""); \
75a6ad4a
RU		 906 }
907
b5bbe64a 908#define DUMP_OP_PRIVATE(o,level,file) \
75a6ad4a
RU		 909 if (o->op_private) { \
910 U32 optype = o->op_type; \
911 U32 oppriv = o->op_private; \
17605be7 912 SV * const tmpsv = newSVpvs(""); \
75a6ad4a
RU		 913 if (PL_opargs[optype] & OA_TARGLEX) { \
914 if (oppriv & OPpTARGET_MY) \
915 sv_catpv(tmpsv, ",TARGET_MY"); \
916 } \
917 else if (optype == OP_ENTERSUB || \
918 optype == OP_RV2SV || \
919 optype == OP_GVSV || \
920 optype == OP_RV2AV || \
921 optype == OP_RV2HV || \
922 optype == OP_RV2GV || \
923 optype == OP_AELEM || \
924 optype == OP_HELEM ) \
925 { \
926 if (optype == OP_ENTERSUB) { \
927 append_flags(tmpsv, oppriv, op_entersub_names); \
928 } \
929 else { \
930 switch (oppriv & OPpDEREF) { \
931 case OPpDEREF_SV: \
932 sv_catpv(tmpsv, ",SV"); \
933 break; \
934 case OPpDEREF_AV: \
935 sv_catpv(tmpsv, ",AV"); \
936 break; \
937 case OPpDEREF_HV: \
938 sv_catpv(tmpsv, ",HV"); \
939 break; \
940 } \
941 if (oppriv & OPpMAYBE_LVSUB) \
942 sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
943 } \
944 if (optype == OP_AELEM || optype == OP_HELEM) { \
945 if (oppriv & OPpLVAL_DEFER) \
946 sv_catpv(tmpsv, ",LVAL_DEFER"); \
947 } \
948 else if (optype == OP_RV2HV || optype == OP_PADHV) { \
949 if (oppriv & OPpMAYBE_TRUEBOOL) \
950 sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
951 if (oppriv & OPpTRUEBOOL) \
952 sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
953 } \
954 else { \
955 if (oppriv & HINT_STRICT_REFS) \
956 sv_catpv(tmpsv, ",STRICT_REFS"); \
957 if (oppriv & OPpOUR_INTRO) \
958 sv_catpv(tmpsv, ",OUR_INTRO"); \
959 } \
960 } \
961 else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
962 } \
963 else if (OP_IS_FILETEST(o->op_type)) { \
964 if (oppriv & OPpFT_ACCESS) \
965 sv_catpv(tmpsv, ",FT_ACCESS"); \
966 if (oppriv & OPpFT_STACKED) \
967 sv_catpv(tmpsv, ",FT_STACKED"); \
968 if (oppriv & OPpFT_STACKING) \
969 sv_catpv(tmpsv, ",FT_STACKING"); \
970 if (oppriv & OPpFT_AFTER_t) \
971 sv_catpv(tmpsv, ",AFTER_t"); \
972 } \
631dbaa2
FC		 973 else if (o->op_type == OP_AASSIGN) { \
974 if (oppriv & OPpASSIGN_COMMON) \
975 sv_catpvs(tmpsv, ",COMMON"); \
976 if (oppriv & OPpMAYBE_LVSUB) \
977 sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
978 } \
75a6ad4a
RU		 979 if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
980 sv_catpv(tmpsv, ",INTRO"); \
981 if (o->op_type == OP_PADRANGE) \
982 Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
983 (UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
95a31aad 984 if ( (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV || \
61c85d89 985 o->op_type == OP_PADAV || o->op_type == OP_PADHV || \
2186f873 986 o->op_type == OP_ASLICE || o->op_type == OP_HSLICE) \
95a31aad
FC		 987 && oppriv & OPpSLICEWARNING ) \
988 sv_catpvs(tmpsv, ",SLICEWARNING"); \
75a6ad4a 989 if (SvCUR(tmpsv)) { \
b5bbe64a
JH		 990 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
991 } else \
75a6ad4a
RU		 992 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
993 (UV)oppriv); \
75a6ad4a
RU		 994 }
995
996
79072805 997void
6867be6d 998Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
79072805 999{
2814eb74 1000 UV seq;
e15d5972
AL		 1001 const OPCODE optype = o->op_type;
1002
7918f24d
NC		 1003 PERL_ARGS_ASSERT_DO_OP_DUMP;
1004
cea2e8a9 1005 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732 1006 level++;
0bd48802 1007 seq = sequence_num(o);
2814eb74 1008 if (seq)
f5992bc4 1009 PerlIO_printf(file, "%-4"UVuf, seq);
93a17b20 1010 else
b6f05621 1011 PerlIO_printf(file, "????");
c8db6e60
JH		 1012 PerlIO_printf(file,
1013 "%*sTYPE = %s ===> ",
53e06cf0 1014 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
2814eb74 1015 if (o->op_next)
b6f05621
DM		 1016 PerlIO_printf(file,
1017 o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
666ea192 1018 sequence_num(o->op_next));
79072805 1019 else
e75ab6ad 1020 PerlIO_printf(file, "NULL\n");
11343788 1021 if (o->op_targ) {
e15d5972 1022 if (optype == OP_NULL) {
cea2e8a9 1023 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
e15d5972 1024 if (o->op_targ == OP_NEXTSTATE) {
ae7d165c 1025 if (CopLINE(cCOPo))
f5992bc4 1026 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 1027 (UV)CopLINE(cCOPo));
0eb335df
BF		 1028 if (CopSTASHPV(cCOPo)) {
1029 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1030 HV *stash = CopSTASH(cCOPo);
1031 const char * const hvname = HvNAME_get(stash);
1032
ae7d165c 1033 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
0eb335df
BF		 1034 generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
1035 }
1036 if (CopLABEL(cCOPo)) {
1037 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1038 STRLEN label_len;
1039 U32 label_flags;
1040 const char *label = CopLABEL_len_flags(cCOPo,
1041 &label_len,
1042 &label_flags);
ae7d165c 1043 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
0eb335df
BF		 1044 generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
1045 }
1046
ae7d165c
PJ		 1047 }
1048 }
8990e307 1049 else
894356b3 1050 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
8990e307 1051 }
748a9306 1052#ifdef DUMPADDR
57def98f 1053 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
79072805 1054#endif
a7fd8ef6 1055
b5bbe64a
JH		 1056 DUMP_OP_FLAGS(o,level,file);
1057 DUMP_OP_PRIVATE(o,level,file);
1058
3b721df9 1059
e15d5972 1060 switch (optype) {
971a9dd3 1061 case OP_AELEMFAST:
93a17b20 1062 case OP_GVSV:
79072805 1063 case OP_GV:
971a9dd3 1064#ifdef USE_ITHREADS
c803eecc 1065 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 1066#else
1640e9f0 1067 if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
38c076c7 1068 if (cSVOPo->op_sv) {
0eb335df
BF		 1069 STRLEN len;
1070 const char * name;
1071 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1072 SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
159b6efe 1073 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
0eb335df 1074 name = SvPV_const(tmpsv, len);
8b6b16e7 1075 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
0eb335df 1076 generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
38c076c7
DM		 1077 }
1078 else
1079 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
378cc40b 1080 }
971a9dd3 1081#endif
79072805
LW		 1082 break;
1083 case OP_CONST:
996c9baa 1084 case OP_HINTSEVAL:
f5d5a27c 1085 case OP_METHOD_NAMED:
b6a15bc5
DM		 1086#ifndef USE_ITHREADS
1087 /* with ITHREADS, consts are stored in the pad, and the right pad
1088 * may not be active here, so skip */
3848b962 1089 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
b6a15bc5 1090#endif
79072805 1091 break;
93a17b20
LW		 1092 case OP_NEXTSTATE:
1093 case OP_DBSTATE:
57843af0 1094 if (CopLINE(cCOPo))
f5992bc4 1095 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 1096 (UV)CopLINE(cCOPo));
0eb335df
BF		 1097 if (CopSTASHPV(cCOPo)) {
1098 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1099 HV *stash = CopSTASH(cCOPo);
1100 const char * const hvname = HvNAME_get(stash);
1101
ed094faf 1102 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
0eb335df
BF		 1103 generic_pv_escape(tmpsv, hvname,
1104 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1105 }
1106 if (CopLABEL(cCOPo)) {
1107 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1108 STRLEN label_len;
1109 U32 label_flags;
1110 const char *label = CopLABEL_len_flags(cCOPo,
1111 &label_len, &label_flags);
1112 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1113 generic_pv_escape( tmpsv, label, label_len,
1114 (label_flags & SVf_UTF8)));
1115 }
79072805
LW		 1116 break;
1117 case OP_ENTERLOOP:
cea2e8a9 1118 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
11343788 1119 if (cLOOPo->op_redoop)
f5992bc4 1120 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
79072805 1121 else
3967c732 1122 PerlIO_printf(file, "DONE\n");
cea2e8a9 1123 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
11343788 1124 if (cLOOPo->op_nextop)
f5992bc4 1125 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
79072805 1126 else
3967c732 1127 PerlIO_printf(file, "DONE\n");
cea2e8a9 1128 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
11343788 1129 if (cLOOPo->op_lastop)
f5992bc4 1130 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
79072805 1131 else
3967c732 1132 PerlIO_printf(file, "DONE\n");
79072805
LW		 1133 break;
1134 case OP_COND_EXPR:
1a67a97c 1135 case OP_RANGE:
a0d0e21e 1136 case OP_MAPWHILE:
79072805
LW		 1137 case OP_GREPWHILE:
1138 case OP_OR:
1139 case OP_AND:
cea2e8a9 1140 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
11343788 1141 if (cLOGOPo->op_other)
f5992bc4 1142 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
79072805 1143 else
3967c732 1144 PerlIO_printf(file, "DONE\n");
79072805
LW		 1145 break;
1146 case OP_PUSHRE:
1147 case OP_MATCH:
8782bef2 1148 case OP_QR:
79072805 1149 case OP_SUBST:
3967c732 1150 do_pmop_dump(level, file, cPMOPo);
79072805 1151 break;
7934575e
GS		 1152 case OP_LEAVE:
1153 case OP_LEAVEEVAL:
1154 case OP_LEAVESUB:
1155 case OP_LEAVESUBLV:
1156 case OP_LEAVEWRITE:
1157 case OP_SCOPE:
1158 if (o->op_private & OPpREFCOUNTED)
1159 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1160 break;
a0d0e21e
LW		 1161 default:
1162 break;
79072805 1163 }
11343788 1164 if (o->op_flags & OPf_KIDS) {
79072805 1165 OP *kid;
11343788 1166 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3967c732 1167 do_op_dump(level, file, kid);
8d063cd8 1168 }
cea2e8a9 1169 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 1170}
1171
36b1c95c
MH		 1172/*
1173=for apidoc op_dump
1174
1175Dumps the optree starting at OP C<o> to C<STDERR>.
1176
1177=cut
1178*/
1179
3967c732 1180void
6867be6d 1181Perl_op_dump(pTHX_ const OP *o)
3967c732 1182{
7918f24d 1183 PERL_ARGS_ASSERT_OP_DUMP;
3967c732 1184 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW		 1185}
1186
8adcabd8 1187void
864dbfa3 1188Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1189{
0eb335df
BF		 1190 STRLEN len;
1191 const char* name;
1192 SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1193
378cc40b 1194
7918f24d
NC		 1195 PERL_ARGS_ASSERT_GV_DUMP;
1196
79072805 1197 if (!gv) {
760ac839 1198 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW		 1199 return;
1200 }
8990e307 1201 sv = sv_newmortal();
760ac839 1202 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1203 gv_fullname3(sv, gv, NULL);
0eb335df
BF		 1204 name = SvPV_const(sv, len);
1205 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1206 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
79072805 1207 if (gv != GvEGV(gv)) {
bd61b366 1208 gv_efullname3(sv, GvEGV(gv), NULL);
0eb335df
BF		 1209 name = SvPV_const(sv, len);
1210 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1211 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
8adcabd8 1212 }
3967c732 1213 PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1214 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW		 1215}
1216
14befaf4 1217
afe38520 1218/* map magic types to the symbolic names
14befaf4
DM		 1219 * (with the PERL_MAGIC_ prefixed stripped)
1220 */
1221
27da23d5 1222static const struct { const char type; const char *name; } magic_names[] = {
52f49505 1223#include "mg_names.c"
516a5887 1224 /* this null string terminates the list */
b9ac451d 1225 { 0, NULL },
14befaf4
DM		 1226};
1227
8adcabd8 1228void
6867be6d 1229Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1230{
7918f24d
NC		 1231 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1232
3967c732 1233 for (; mg; mg = mg->mg_moremagic) {
b900a521
JH		 1234 Perl_dump_indent(aTHX_ level, file,
1235 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1236 if (mg->mg_virtual) {
bfed75c6 1237 const MGVTBL * const v = mg->mg_virtual;
2d1f1fe5
NC		 1238 if (v >= PL_magic_vtables
1239 && v < PL_magic_vtables + magic_vtable_max) {
1240 const U32 i = v - PL_magic_vtables;
1241 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1242 }
3967c732 1243 else
b900a521 1244 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732
JD		 1245 }
1246 else
cea2e8a9 1247 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1248
3967c732 1249 if (mg->mg_private)
cea2e8a9 1250 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1251
14befaf4
DM		 1252 {
1253 int n;
c445ea15 1254 const char *name = NULL;
27da23d5 1255 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM		 1256 if (mg->mg_type == magic_names[n].type) {
1257 name = magic_names[n].name;
1258 break;
1259 }
1260 }
1261 if (name)
1262 Perl_dump_indent(aTHX_ level, file,
1263 " MG_TYPE = PERL_MAGIC_%s\n", name);
1264 else
1265 Perl_dump_indent(aTHX_ level, file,
1266 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1267 }
3967c732
JD		 1268
1269 if (mg->mg_flags) {
cea2e8a9 1270 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST		 1271 if (mg->mg_type == PERL_MAGIC_envelem &&
1272 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1273 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
4c02285a
FR		 1274 if (mg->mg_type == PERL_MAGIC_regex_global &&
1275 mg->mg_flags & MGf_MINMATCH)
1276 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1277 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1278 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1279 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1280 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
4c02285a
FR		 1281 if (mg->mg_flags & MGf_COPY)
1282 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1283 if (mg->mg_flags & MGf_DUP)
1284 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1285 if (mg->mg_flags & MGf_LOCAL)
1286 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
25fdce4a
FC		 1287 if (mg->mg_type == PERL_MAGIC_regex_global &&
1288 mg->mg_flags & MGf_BYTES)
1289 Perl_dump_indent(aTHX_ level, file, " BYTES\n");
3967c732
JD		 1290 }
1291 if (mg->mg_obj) {
4c02285a 1292 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
28d8d7f4
YO		 1293 PTR2UV(mg->mg_obj));
1294 if (mg->mg_type == PERL_MAGIC_qr) {
07bc277f 1295 REGEXP* const re = (REGEXP *)mg->mg_obj;
61f9802b 1296 SV * const dsv = sv_newmortal();
866c78d1 1297 const char * const s
4c02285a 1298 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
28d8d7f4 1299 60, NULL, NULL,
95b611b0 1300 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
3c8556c3 1301 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
28d8d7f4 1302 );
6483fb35
RGS		 1303 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1304 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
07bc277f 1305 (IV)RX_REFCNT(re));
28d8d7f4
YO		 1306 }
1307 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732
JD		 1308 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1309 }
1310 if (mg->mg_len)
894356b3 1311 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1312 if (mg->mg_ptr) {
b900a521 1313 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1314 if (mg->mg_len >= 0) {
7e8c5dac 1315 if (mg->mg_type != PERL_MAGIC_utf8) {
17605be7 1316 SV * const sv = newSVpvs("");
7e8c5dac 1317 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
17605be7 1318 SvREFCNT_dec_NN(sv);
7e8c5dac 1319 }
3967c732
JD		 1320 }
1321 else if (mg->mg_len == HEf_SVKEY) {
1322 PerlIO_puts(file, " => HEf_SVKEY\n");
ad64d0ec
NC		 1323 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1324 maxnest, dumpops, pvlim); /* MG is already +1 */
3967c732
JD		 1325 continue;
1326 }
866f9d6c 1327 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
3967c732 1328 else
866f9d6c
FC		 1329 PerlIO_puts(
1330 file,
1331 " ???? - " __FILE__
1332 " does not know how to handle this MG_LEN"
1333 );
3967c732
JD		 1334 PerlIO_putc(file, '\n');
1335 }
7e8c5dac 1336 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1337 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac
HS		 1338 if (cache) {
1339 IV i;
1340 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1341 Perl_dump_indent(aTHX_ level, file,
1342 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1343 i,
1344 (UV)cache[i * 2],
1345 (UV)cache[i * 2 + 1]);
1346 }
1347 }
378cc40b 1348 }
3967c732
JD		 1349}
1350
1351void
6867be6d 1352Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1353{
b9ac451d 1354 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD		 1355}
1356
1357void
e1ec3a88 1358Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1359{
bfcb3514 1360 const char *hvname;
7918f24d
NC		 1361
1362 PERL_ARGS_ASSERT_DO_HV_DUMP;
1363
b900a521 1364 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514 1365 if (sv && (hvname = HvNAME_get(sv)))
d7d51f4b
YO		 1366 {
1367 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1368 name which quite legally could contain insane things like tabs, newlines, nulls or
1369 other scary crap - this should produce sane results - except maybe for unicode package
1370 names - but we will wait for someone to file a bug on that - demerphq */
0eb335df
BF		 1371 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1372 PerlIO_printf(file, "\t\"%s\"\n",
1373 generic_pv_escape( tmpsv, hvname,
1374 HvNAMELEN(sv), HvNAMEUTF8(sv)));
d7d51f4b 1375 }
79072805 1376 else
3967c732
JD		 1377 PerlIO_putc(file, '\n');
1378}
1379
1380void
e1ec3a88 1381Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1382{
7918f24d
NC		 1383 PERL_ARGS_ASSERT_DO_GV_DUMP;
1384
b900a521 1385 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
0eb335df
BF		 1386 if (sv && GvNAME(sv)) {
1387 SV * const tmpsv = newSVpvs("");
1388 PerlIO_printf(file, "\t\"%s\"\n",
1389 generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1390 }
c90c0ff4 1391 else
3967c732
JD		 1392 PerlIO_putc(file, '\n');
1393}
1394
1395void
e1ec3a88 1396Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1397{
7918f24d
NC		 1398 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1399
b900a521 1400 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1401 if (sv && GvNAME(sv)) {
0eb335df 1402 SV *tmp = newSVpvs_flags("", SVs_TEMP);
bfcb3514 1403 const char *hvname;
0eb335df
BF		 1404 HV * const stash = GvSTASH(sv);
1405 PerlIO_printf(file, "\t");
1406 /* TODO might have an extra \" here */
1407 if (stash && (hvname = HvNAME_get(stash))) {
1408 PerlIO_printf(file, "\"%s\" :: \"",
1409 generic_pv_escape(tmp, hvname,
1410 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1411 }
1412 PerlIO_printf(file, "%s\"\n",
1413 generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
8d063cd8 1414 }
3967c732
JD		 1415 else
1416 PerlIO_putc(file, '\n');
1417}
1418
a0c2f4dd
NC		 1419const struct flag_to_name first_sv_flags_names[] = {
1420 {SVs_TEMP, "TEMP,"},
1421 {SVs_OBJECT, "OBJECT,"},
1422 {SVs_GMG, "GMG,"},
1423 {SVs_SMG, "SMG,"},
1424 {SVs_RMG, "RMG,"},
1425 {SVf_IOK, "IOK,"},
1426 {SVf_NOK, "NOK,"},
1427 {SVf_POK, "POK,"}
1428};
1429
1430const struct flag_to_name second_sv_flags_names[] = {
1431 {SVf_OOK, "OOK,"},
1432 {SVf_FAKE, "FAKE,"},
1433 {SVf_READONLY, "READONLY,"},
e3918bb7 1434 {SVf_IsCOW, "IsCOW,"},
a0c2f4dd
NC		 1435 {SVf_BREAK, "BREAK,"},
1436 {SVf_AMAGIC, "OVERLOAD,"},
1437 {SVp_IOK, "pIOK,"},
1438 {SVp_NOK, "pNOK,"},
1439 {SVp_POK, "pPOK,"}
1440};
1441
ae1f06a1
NC		 1442const struct flag_to_name cv_flags_names[] = {
1443 {CVf_ANON, "ANON,"},
1444 {CVf_UNIQUE, "UNIQUE,"},
1445 {CVf_CLONE, "CLONE,"},
1446 {CVf_CLONED, "CLONED,"},
1447 {CVf_CONST, "CONST,"},
1448 {CVf_NODEBUG, "NODEBUG,"},
1449 {CVf_LVALUE, "LVALUE,"},
1450 {CVf_METHOD, "METHOD,"},
cfc1e951 1451 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
31d45e0c 1452 {CVf_CVGV_RC, "CVGV_RC,"},
bad4ae38 1453 {CVf_DYNFILE, "DYNFILE,"},
8fa6a409 1454 {CVf_AUTOLOAD, "AUTOLOAD,"},
55f7f8ab 1455 {CVf_HASEVAL, "HASEVAL"},
bfbc3ad9 1456 {CVf_SLABBED, "SLABBED,"},
31d45e0c 1457 {CVf_ISXSUB, "ISXSUB,"}
ae1f06a1
NC		 1458};
1459
1460const struct flag_to_name hv_flags_names[] = {
1461 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1462 {SVphv_LAZYDEL, "LAZYDEL,"},
1463 {SVphv_HASKFLAGS, "HASKFLAGS,"},
ae1f06a1
NC		 1464 {SVphv_CLONEABLE, "CLONEABLE,"}
1465};
1466
1467const struct flag_to_name gp_flags_names[] = {
1468 {GVf_INTRO, "INTRO,"},
1469 {GVf_MULTI, "MULTI,"},
1470 {GVf_ASSUMECV, "ASSUMECV,"},
1471 {GVf_IN_PAD, "IN_PAD,"}
1472};
1473
1474const struct flag_to_name gp_flags_imported_names[] = {
1475 {GVf_IMPORTED_SV, " SV"},
1476 {GVf_IMPORTED_AV, " AV"},
1477 {GVf_IMPORTED_HV, " HV"},
1478 {GVf_IMPORTED_CV, " CV"},
1479};
1480
0d331aaf
YO		 1481/* NOTE: this structure is mostly duplicative of one generated by
1482 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1483 * the two. - Yves */
e3e400ec 1484const struct flag_to_name regexp_extflags_names[] = {
d63e6659
DM		 1485 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1486 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1487 {RXf_PMf_FOLD, "PMf_FOLD,"},
1488 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1489 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
8e1490ee 1490 {RXf_IS_ANCHORED, "IS_ANCHORED,"},
dbc200c5 1491 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
d63e6659 1492 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
d63e6659
DM		 1493 {RXf_CHECK_ALL, "CHECK_ALL,"},
1494 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1495 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1496 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1497 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
dbc200c5 1498 {RXf_SPLIT, "SPLIT,"},
d63e6659
DM		 1499 {RXf_COPY_DONE, "COPY_DONE,"},
1500 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1501 {RXf_TAINTED, "TAINTED,"},
1502 {RXf_START_ONLY, "START_ONLY,"},
dbc200c5 1503 {RXf_SKIPWHITE, "SKIPWHITE,"},
d63e6659
DM		 1504 {RXf_WHITE, "WHITE,"},
1505 {RXf_NULL, "NULL,"},
1506};
1507
0d331aaf
YO		 1508/* NOTE: this structure is mostly duplicative of one generated by
1509 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1510 * the two. - Yves */
e3e400ec
YO		 1511const struct flag_to_name regexp_core_intflags_names[] = {
1512 {PREGf_SKIP, "SKIP,"},
0d331aaf
YO		 1513 {PREGf_IMPLICIT, "IMPLICIT,"},
1514 {PREGf_NAUGHTY, "NAUGHTY,"},
e3e400ec
YO		 1515 {PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
1516 {PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
0d331aaf 1517 {PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
e3e400ec 1518 {PREGf_NOSCAN, "NOSCAN,"},
0d331aaf 1519 {PREGf_CANY_SEEN, "CANY_SEEN,"},
58430ea8
YO		 1520 {PREGf_GPOS_SEEN, "GPOS_SEEN,"},
1521 {PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
8e1490ee
YO		 1522 {PREGf_ANCH_BOL, "ANCH_BOL,"},
1523 {PREGf_ANCH_MBOL, "ANCH_MBOL,"},
1524 {PREGf_ANCH_SBOL, "ANCH_SBOL,"},
1525 {PREGf_ANCH_GPOS, "ANCH_GPOS,"},
e3e400ec
YO		 1526};
1527
3967c732 1528void
864dbfa3 1529Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1530{
cea89e20 1531 SV *d;
e1ec3a88 1532 const char *s;
3967c732
JD		 1533 U32 flags;
1534 U32 type;
1535
7918f24d
NC		 1536 PERL_ARGS_ASSERT_DO_SV_DUMP;
1537
3967c732 1538 if (!sv) {
cea2e8a9 1539 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1540 return;
378cc40b 1541 }
2ef28da1 1542
3967c732
JD		 1543 flags = SvFLAGS(sv);
1544 type = SvTYPE(sv);
79072805 1545
e0bbf362
DM		 1546 /* process general SV flags */
1547
cea89e20 1548 d = Perl_newSVpvf(aTHX_
57def98f 1549 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1550 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS		 1551 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1552 (int)(PL_dumpindent*level), "");
8d063cd8 1553
1979170b
NC		 1554 if (!((flags & SVpad_NAME) == SVpad_NAME
1555 && (type == SVt_PVMG || type == SVt_PVNV))) {
9a214eec
DM		 1556 if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1557 sv_catpv(d, "PADSTALE,");
e604303a 1558 }
1979170b 1559 if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
9a214eec
DM		 1560 if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1561 sv_catpv(d, "PADTMP,");
e604303a
NC		 1562 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1563 }
a0c2f4dd 1564 append_flags(d, flags, first_sv_flags_names);
810b8aa5
GS		 1565 if (flags & SVf_ROK) {
1566 sv_catpv(d, "ROK,");
1567 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1568 }
a0c2f4dd 1569 append_flags(d, flags, second_sv_flags_names);
7db6405c
FC		 1570 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1571 && type != SVt_PVAV) {
1ccdb730
NC		 1572 if (SvPCS_IMPORTED(sv))
1573 sv_catpv(d, "PCS_IMPORTED,");
1574 else
9660f481 1575 sv_catpv(d, "SCREAM,");
1ccdb730 1576 }
3967c732 1577
e0bbf362
DM		 1578 /* process type-specific SV flags */
1579
3967c732
JD		 1580 switch (type) {
1581 case SVt_PVCV:
1582 case SVt_PVFM:
ae1f06a1 1583 append_flags(d, CvFLAGS(sv), cv_flags_names);
3967c732
JD		 1584 break;
1585 case SVt_PVHV:
ae1f06a1 1586 append_flags(d, flags, hv_flags_names);
3967c732 1587 break;
926fc7b6
DM		 1588 case SVt_PVGV:
1589 case SVt_PVLV:
1590 if (isGV_with_GP(sv)) {
ae1f06a1 1591 append_flags(d, GvFLAGS(sv), gp_flags_names);
926fc7b6 1592 }
926fc7b6 1593 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD		 1594 sv_catpv(d, "IMPORT");
1595 if (GvIMPORTED(sv) == GVf_IMPORTED)
1596 sv_catpv(d, "ALL,");
1597 else {
1598 sv_catpv(d, "(");
ae1f06a1 1599 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
3967c732
JD		 1600 sv_catpv(d, " ),");
1601 }
1602 }
924ba076 1603 /* FALLTHROUGH */
25da4f38 1604 default:
e604303a 1605 evaled_or_uv:
25da4f38 1606 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1607 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1608 break;
addd1794 1609 case SVt_PVMG:
c13a5c80
NC		 1610 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1611 if (SvVALID(sv)) sv_catpv(d, "VALID,");
00b1698f 1612 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1613 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
924ba076 1614 /* FALLTHROUGH */
e604303a
NC		 1615 case SVt_PVNV:
1616 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1617 goto evaled_or_uv;
11ca45c0 1618 case SVt_PVAV:
7db6405c 1619 if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
11ca45c0 1620 break;
3967c732 1621 }
86f0d186
NC		 1622 /* SVphv_SHAREKEYS is also 0x20000000 */
1623 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1624 sv_catpv(d, "UTF8");
3967c732 1625
b162af07
SP		 1626 if (*(SvEND(d) - 1) == ',') {
1627 SvCUR_set(d, SvCUR(d) - 1);
1628 SvPVX(d)[SvCUR(d)] = '\0';
1629 }
3967c732 1630 sv_catpv(d, ")");
b15aece3 1631 s = SvPVX_const(d);
3967c732 1632
e0bbf362
DM		 1633 /* dump initial SV details */
1634
fd0854ff 1635#ifdef DEBUG_LEAKING_SCALARS
cbe56f1d 1636 Perl_dump_indent(aTHX_ level, file,
cd676548 1637 "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
fd0854ff
DM		 1638 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1639 sv->sv_debug_line,
1640 sv->sv_debug_inpad ? "for" : "by",
1641 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
cd676548 1642 PTR2UV(sv->sv_debug_parent),
cbe56f1d
DM		 1643 sv->sv_debug_serial
1644 );
fd0854ff 1645#endif
cea2e8a9 1646 Perl_dump_indent(aTHX_ level, file, "SV = ");
e0bbf362
DM		 1647
1648 /* Dump SV type */
1649
5357ca29
NC		 1650 if (type < SVt_LAST) {
1651 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1652
1653 if (type == SVt_NULL) {
5f954473 1654 SvREFCNT_dec_NN(d);
5357ca29
NC		 1655 return;
1656 }
1657 } else {
faccc32b 1658 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
5f954473 1659 SvREFCNT_dec_NN(d);
3967c732
JD		 1660 return;
1661 }
e0bbf362
DM		 1662
1663 /* Dump general SV fields */
1664
27bd069f 1665 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
0a0c4b76
NC		 1666 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1667 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
4df7f6af 1668 || (type == SVt_IV && !SvROK(sv))) {
765f542d 1669 if (SvIsUV(sv)
f8c7b90f 1670#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1671 || SvIsCOW(sv)
1672#endif
1673 )
57def98f 1674 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1675 else
57def98f 1676 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
f8c7b90f 1677#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1678 if (SvIsCOW_shared_hash(sv))
1679 PerlIO_printf(file, " (HASH)");
1680 else if (SvIsCOW_normal(sv))
1681 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1682#endif
3967c732
JD		 1683 PerlIO_putc(file, '\n');
1684 }
e0bbf362 1685
1979170b
NC		 1686 if ((type == SVt_PVNV || type == SVt_PVMG)
1687 && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
0e4c4423
NC		 1688 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1689 (UV) COP_SEQ_RANGE_LOW(sv));
1690 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1691 (UV) COP_SEQ_RANGE_HIGH(sv));
1692 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
08e44740 1693 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
c0a413d1 1694 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
0e4c4423 1695 || type == SVt_NV) {
e54dc35b 1696 STORE_NUMERIC_LOCAL_SET_STANDARD();
57def98f 1697 /* %Vg doesn't work? --jhi */
cf2093f6 1698#ifdef USE_LONG_DOUBLE
2d4389e4 1699 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
cf2093f6 1700#else
cea2e8a9 1701 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
cf2093f6 1702#endif
e54dc35b 1703 RESTORE_NUMERIC_LOCAL();
3967c732 1704 }
e0bbf362 1705
3967c732 1706 if (SvROK(sv)) {
57def98f 1707 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732
JD		 1708 if (nest < maxnest)
1709 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1710 }
e0bbf362 1711
cea89e20 1712 if (type < SVt_PV) {
5f954473 1713 SvREFCNT_dec_NN(d);
3967c732 1714 return;
cea89e20 1715 }
e0bbf362 1716
5a3c7349
FC		 1717 if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1718 || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
8d919b0a
FC		 1719 const bool re = isREGEXP(sv);
1720 const char * const ptr =
1721 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1722 if (ptr) {
69240efd 1723 STRLEN delta;
7a4bba22 1724 if (SvOOK(sv)) {
69240efd 1725 SvOOK_offset(sv, delta);
7a4bba22 1726 Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
5186cc12 1727 (UV) delta);
69240efd
NC		 1728 } else {
1729 delta = 0;
7a4bba22 1730 }
8d919b0a 1731 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
7a4bba22
NC		 1732 if (SvOOK(sv)) {
1733 PerlIO_printf(file, "( %s . ) ",
8d919b0a 1734 pv_display(d, ptr - delta, delta, 0,
7a4bba22
NC		 1735 pvlim));
1736 }
ad3f05ad
KW		 1737 if (type == SVt_INVLIST) {
1738 PerlIO_printf(file, "\n");
1739 /* 4 blanks indents 2 beyond the PV, etc */
1740 _invlist_dump(file, level, " ", sv);
1741 }
1742 else {
685bfc3c
KW		 1743 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1744 re ? 0 : SvLEN(sv),
1745 pvlim));
1746 if (SvUTF8(sv)) /* the 6? \x{....} */
1747 PerlIO_printf(file, " [UTF8 \"%s\"]",
1748 sv_uni_display(d, sv, 6 * SvCUR(sv),
1749 UNI_DISPLAY_QQ));
1750 PerlIO_printf(file, "\n");
ad3f05ad 1751 }
57def98f 1752 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
8d919b0a
FC		 1753 if (!re)
1754 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1755 (IV)SvLEN(sv));
db2c6cb3
FC		 1756#ifdef PERL_NEW_COPY_ON_WRITE
1757 if (SvIsCOW(sv) && SvLEN(sv))
1758 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1759 CowREFCNT(sv));
1760#endif
3967c732
JD		 1761 }
1762 else
cea2e8a9 1763 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1764 }
e0bbf362 1765
3967c732 1766 if (type >= SVt_PVMG) {
0e4c4423 1767 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
61f9802b 1768 HV * const ost = SvOURSTASH(sv);
38cbaf55
RGS		 1769 if (ost)
1770 do_hv_dump(level, file, " OURSTASH", ost);
7db6405c
FC		 1771 } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
1772 Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
1773 (UV)PadnamelistMAXNAMED(sv));
0e4c4423
NC		 1774 } else {
1775 if (SvMAGIC(sv))
8530ff28 1776 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
0e4c4423 1777 }
3967c732
JD		 1778 if (SvSTASH(sv))
1779 do_hv_dump(level, file, " STASH", SvSTASH(sv));
c13a5c80
NC		 1780
1781 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
c13a5c80
NC		 1782 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1783 }
3967c732 1784 }
e0bbf362
DM		 1785
1786 /* Dump type-specific SV fields */
1787
3967c732 1788 switch (type) {
3967c732 1789 case SVt_PVAV:
57def98f 1790 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1791 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f
JH		 1792 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1793 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732
JD		 1794 }
1795 else
1796 PerlIO_putc(file, '\n');
57def98f
JH		 1797 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1798 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
7db6405c
FC		 1799 /* arylen is stored in magic, and padnamelists use SvMAGIC for
1800 something else. */
1801 if (!AvPAD_NAMELIST(sv))
1802 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
1803 SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
76f68e9b 1804 sv_setpvs(d, "");
11ca45c0
NC		 1805 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1806 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP		 1807 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1808 SvCUR(d) ? SvPVX_const(d) + 1 : "");
b9f2b683 1809 if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
c70927a6 1810 SSize_t count;
b9f2b683 1811 for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
502c6561 1812 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
3967c732 1813
57def98f 1814 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1815 if (elt)
3967c732
JD		 1816 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1817 }
1818 }
1819 break;
5d27ee4a
DD		 1820 case SVt_PVHV: {
1821 U32 usedkeys;
0c22a733
DM		 1822 if (SvOOK(sv)) {
1823 struct xpvhv_aux *const aux = HvAUX(sv);
1824 Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
1825 (UV)aux->xhv_aux_flags);
1826 }
57def98f 1827 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
5d27ee4a
DD		 1828 usedkeys = HvUSEDKEYS(sv);
1829 if (HvARRAY(sv) && usedkeys) {
3967c732
JD		 1830 /* Show distribution of HEs in the ARRAY */
1831 int freq[200];
c3caa5c3 1832#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
3967c732
JD		 1833 int i;
1834 int max = 0;
5d27ee4a 1835 U32 pow2 = 2, keys = usedkeys;
65202027 1836 NV theoret, sum = 0;
3967c732
JD		 1837
1838 PerlIO_printf(file, " (");
1839 Zero(freq, FREQ_MAX + 1, int);
eb160463 1840 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL		 1841 HE* h;
1842 int count = 0;
3967c732
JD		 1843 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1844 count++;
1845 if (count > FREQ_MAX)
1846 count = FREQ_MAX;
1847 freq[count]++;
1848 if (max < count)
1849 max = count;
1850 }
1851 for (i = 0; i <= max; i++) {
1852 if (freq[i]) {
1853 PerlIO_printf(file, "%d%s:%d", i,
1854 (i == FREQ_MAX) ? "+" : "",
1855 freq[i]);
1856 if (i != max)
1857 PerlIO_printf(file, ", ");
1858 }
1859 }
1860 PerlIO_putc(file, ')');
b8fa94d8
MG		 1861 /* The "quality" of a hash is defined as the total number of
1862 comparisons needed to access every element once, relative
1863 to the expected number needed for a random hash.
1864
1865 The total number of comparisons is equal to the sum of
e76cd0fa
AMS		 1866 the squares of the number of entries in each bucket.
1867 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG		 1868 value is
1869 n + n(n-1)/2k
1870 */
1871
3967c732
JD		 1872 for (i = max; i > 0; i--) { /* Precision: count down. */
1873 sum += freq[i] * i * i;
1874 }
155aba94 1875 while ((keys = keys >> 1))
3967c732 1876 pow2 = pow2 << 1;
5d27ee4a 1877 theoret = usedkeys;
b8fa94d8 1878 theoret += theoret * (theoret-1)/pow2;
3967c732 1879 PerlIO_putc(file, '\n');
6b4667fc 1880 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732
JD		 1881 }
1882 PerlIO_putc(file, '\n');
5d27ee4a 1883 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
9faf471a
NC		 1884 {
1885 STRLEN count = 0;
1886 HE **ents = HvARRAY(sv);
1887
1888 if (ents) {
1889 HE *const *const last = ents + HvMAX(sv);
1890 count = last + 1 - ents;
1891
1892 do {
1893 if (!*ents)
1894 --count;
1895 } while (++ents <= last);
1896 }
1897
1898 if (SvOOK(sv)) {
1899 struct xpvhv_aux *const aux = HvAUX(sv);
1900 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1901 " (cached = %"UVuf")\n",
1902 (UV)count, (UV)aux->xhv_fill_lazy);
1903 } else {
1904 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1905 (UV)count);
1906 }
1907 }
57def98f 1908 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
e1a7ec8d
YO		 1909 if (SvOOK(sv)) {
1910 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1911 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
6a5b4183 1912#ifdef PERL_HASH_RANDOMIZE_KEYS
e1a7ec8d
YO		 1913 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1914 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
6a5b4183 1915 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
e1a7ec8d 1916 }
6a5b4183
YO		 1917#endif
1918 PerlIO_putc(file, '\n');
e1a7ec8d 1919 }
8d2f4536 1920 {
b9ac451d 1921 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536
NC		 1922 if (mg && mg->mg_obj) {
1923 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1924 }
1925 }
bfcb3514 1926 {
b9ac451d 1927 const char * const hvname = HvNAME_get(sv);
0eb335df
BF		 1928 if (hvname) {
1929 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1930 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
1931 generic_pv_escape( tmpsv, hvname,
1932 HvNAMELEN(sv), HvNAMEUTF8(sv)));
1933 }
bfcb3514 1934 }
86f55936 1935 if (SvOOK(sv)) {
ad64d0ec 1936 AV * const backrefs
85fbaab2 1937 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
7d88e6c4 1938 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
67e04715
FC		 1939 if (HvAUX(sv)->xhv_name_count)
1940 Perl_dump_indent(aTHX_
7afc2217
FC		 1941 level, file, " NAMECOUNT = %"IVdf"\n",
1942 (IV)HvAUX(sv)->xhv_name_count
67e04715 1943 );
15d9236d 1944 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
ec3405c8
NC		 1945 const I32 count = HvAUX(sv)->xhv_name_count;
1946 if (count) {
1947 SV * const names = newSVpvs_flags("", SVs_TEMP);
1948 /* The starting point is the first element if count is
1949 positive and the second element if count is negative. */
1950 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1951 + (count < 0 ? 1 : 0);
1952 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1953 + (count < 0 ? -count : count);
1954 while (hekp < endp) {
0eb335df
BF		 1955 if (HEK_LEN(*hekp)) {
1956 SV *tmp = newSVpvs_flags("", SVs_TEMP);
1957 Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
1958 generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
ec3405c8
NC		 1959 } else {
1960 /* This should never happen. */
1961 sv_catpvs(names, ", (null)");
67e04715 1962 }
ec3405c8
NC		 1963 ++hekp;
1964 }
67e04715
FC		 1965 Perl_dump_indent(aTHX_
1966 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1967 );
1968 }
0eb335df
BF		 1969 else {
1970 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
1971 const char *const hvename = HvENAME_get(sv);
67e04715 1972 Perl_dump_indent(aTHX_
0eb335df
BF		 1973 level, file, " ENAME = \"%s\"\n",
1974 generic_pv_escape(tmp, hvename,
1975 HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
1976 }
67e04715 1977 }
86f55936
NC		 1978 if (backrefs) {
1979 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1980 PTR2UV(backrefs));
ad64d0ec 1981 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
86f55936
NC		 1982 dumpops, pvlim);
1983 }
7d88e6c4 1984 if (meta) {
0eb335df
BF		 1985 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1986 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
1987 generic_pv_escape( tmpsv, meta->mro_which->name,
1988 meta->mro_which->length,
1989 (meta->mro_which->kflags & HVhek_UTF8)),
7d88e6c4
NC		 1990 PTR2UV(meta->mro_which));
1991 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1992 (UV)meta->cache_gen);
1993 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
1994 (UV)meta->pkg_gen);
1995 if (meta->mro_linear_all) {
1996 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
1997 PTR2UV(meta->mro_linear_all));
1998 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1999 dumpops, pvlim);
2000 }
2001 if (meta->mro_linear_current) {
2002 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
2003 PTR2UV(meta->mro_linear_current));
2004 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
2005 dumpops, pvlim);
2006 }
2007 if (meta->mro_nextmethod) {
2008 Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
2009 PTR2UV(meta->mro_nextmethod));
2010 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
2011 dumpops, pvlim);
2012 }
2013 if (meta->isa) {
2014 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
2015 PTR2UV(meta->isa));
2016 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
2017 dumpops, pvlim);
2018 }
2019 }
86f55936 2020 }
b5698553 2021 if (nest < maxnest) {
cbab3169 2022 HV * const hv = MUTABLE_HV(sv);
b5698553
TH		 2023 STRLEN i;
2024 HE *he;
cbab3169 2025
b5698553
TH		 2026 if (HvARRAY(hv)) {
2027 int count = maxnest - nest;
2028 for (i=0; i <= HvMAX(hv); i++) {
2029 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
2030 U32 hash;
2031 SV * keysv;
2032 const char * keypv;
2033 SV * elt;
7dc86639 2034 STRLEN len;
b5698553
TH		 2035
2036 if (count-- <= 0) goto DONEHV;
2037
2038 hash = HeHASH(he);
2039 keysv = hv_iterkeysv(he);
2040 keypv = SvPV_const(keysv, len);
2041 elt = HeVAL(he);
cbab3169 2042
7dc86639
YO		 2043 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
2044 if (SvUTF8(keysv))
2045 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
b5698553
TH		 2046 if (HvEITER_get(hv) == he)
2047 PerlIO_printf(file, "[CURRENT] ");
7dc86639
YO		 2048 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
2049 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
2050 }
b5698553
TH		 2051 }
2052 DONEHV:;
2053 }
3967c732
JD		 2054 }
2055 break;
5d27ee4a 2056 } /* case SVt_PVHV */
e0bbf362 2057
3967c732 2058 case SVt_PVCV:
8fa6a409 2059 if (CvAUTOLOAD(sv)) {
0eb335df
BF		 2060 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2061 STRLEN len;
8fa6a409 2062 const char *const name = SvPV_const(sv, len);
0eb335df
BF		 2063 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
2064 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
8fa6a409
FC		 2065 }
2066 if (SvPOK(sv)) {
0eb335df
BF		 2067 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2068 const char *const proto = CvPROTO(sv);
2069 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
2070 generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
2071 SvUTF8(sv)));
cbf82dd0 2072 }
924ba076 2073 /* FALLTHROUGH */
3967c732
JD		 2074 case SVt_PVFM:
2075 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC		 2076 if (!CvISXSUB(sv)) {
2077 if (CvSTART(sv)) {
2078 Perl_dump_indent(aTHX_ level, file,
2079 " START = 0x%"UVxf" ===> %"IVdf"\n",
2080 PTR2UV(CvSTART(sv)),
2081 (IV)sequence_num(CvSTART(sv)));
2082 }
2083 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
2084 PTR2UV(CvROOT(sv)));
2085 if (CvROOT(sv) && dumpops) {
2086 do_op_dump(level+1, file, CvROOT(sv));
2087 }
2088 } else {
126f53f3 2089 SV * const constant = cv_const_sv((const CV *)sv);
b1886099 2090
d04ba589 2091 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099
NC		 2092
2093 if (constant) {
2094 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
2095 " (CONST SV)\n",
2096 PTR2UV(CvXSUBANY(sv).any_ptr));
2097 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2098 pvlim);
2099 } else {
2100 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
2101 (IV)CvXSUBANY(sv).any_i32);
2102 }
2103 }
3610c89f
FC		 2104 if (CvNAMED(sv))
2105 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2106 HEK_KEY(CvNAME_HEK((CV *)sv)));
2107 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 2108 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
bb02a38f 2109 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 2110 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 2111 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
57def98f 2112 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4
DM		 2113 if (nest < maxnest) {
2114 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732
JD		 2115 }
2116 {
b9ac451d 2117 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 2118 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 2119 PTR2UV(outside),
cf2093f6
JH		 2120 (!outside ? "null"
2121 : CvANON(outside) ? "ANON"
2122 : (outside == PL_main_cv) ? "MAIN"
2123 : CvUNIQUE(outside) ? "UNIQUE"
b24fda9d
BF		 2124 : CvGV(outside) ?
2125 generic_pv_escape(
2126 newSVpvs_flags("", SVs_TEMP),
2127 GvNAME(CvGV(outside)),
2128 GvNAMELEN(CvGV(outside)),
2129 GvNAMEUTF8(CvGV(outside)))
2130 : "UNDEFINED"));
3967c732
JD		 2131 }
2132 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
ad64d0ec 2133 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
3967c732 2134 break;
e0bbf362 2135
926fc7b6
DM		 2136 case SVt_PVGV:
2137 case SVt_PVLV:
b9ac451d
AL		 2138 if (type == SVt_PVLV) {
2139 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2140 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2141 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2142 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
83f78d1a 2143 Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
b9ac451d
AL		 2144 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2145 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2146 dumpops, pvlim);
2147 }
8d919b0a 2148 if (isREGEXP(sv)) goto dumpregexp;
926fc7b6
DM		 2149 if (!isGV_with_GP(sv))
2150 break;
0eb335df
BF		 2151 {
2152 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2153 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2154 generic_pv_escape(tmpsv, GvNAME(sv),
2155 GvNAMELEN(sv),
2156 GvNAMEUTF8(sv)));
2157 }
57def98f 2158 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 2159 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
57def98f 2160 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c
GS		 2161 if (!GvGP(sv))
2162 break;
57def98f
JH		 2163 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2164 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2165 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2166 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2167 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2168 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2169 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2170 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 2171 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 2172 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
e39917cc 2173 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
3967c732
JD		 2174 do_gv_dump (level, file, " EGV", GvEGV(sv));
2175 break;
2176 case SVt_PVIO:
57def98f
JH		 2177 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2178 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2179 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2180 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2181 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2182 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2183 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 2184 if (IoTOP_NAME(sv))
cea2e8a9 2185 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC		 2186 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2187 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2188 else {
2189 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2190 PTR2UV(IoTOP_GV(sv)));
ad64d0ec
NC		 2191 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2192 maxnest, dumpops, pvlim);
9ba1f565
NC		 2193 }
2194 /* Source filters hide things that are not GVs in these three, so let's
2195 be careful out there. */
27533608 2196 if (IoFMT_NAME(sv))
cea2e8a9 2197 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC		 2198 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2199 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2200 else {
2201 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2202 PTR2UV(IoFMT_GV(sv)));
ad64d0ec
NC		 2203 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2204 maxnest, dumpops, pvlim);
9ba1f565 2205 }
27533608 2206 if (IoBOTTOM_NAME(sv))
cea2e8a9 2207 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC		 2208 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2209 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2210 else {
2211 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2212 PTR2UV(IoBOTTOM_GV(sv)));
ad64d0ec
NC		 2213 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2214 maxnest, dumpops, pvlim);
9ba1f565 2215 }
27533608 2216 if (isPRINT(IoTYPE(sv)))
cea2e8a9 2217 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 2218 else
cea2e8a9 2219 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 2220 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732 2221 break;
206ee256 2222 case SVt_REGEXP:
8d919b0a 2223 dumpregexp:
d63e6659 2224 {
8d919b0a 2225 struct regexp * const r = ReANY((REGEXP*)sv);
e3e400ec
YO		 2226
2227#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
ec16d31f 2228 sv_setpv(d,""); \
e3e400ec 2229 append_flags(d, flags, names); \
ec16d31f
YO		 2230 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2231 SvCUR_set(d, SvCUR(d) - 1); \
2232 SvPVX(d)[SvCUR(d)] = '\0'; \
2233 } \
2234} STMT_END
e3e400ec 2235 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
dbc200c5
YO		 2236 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2237 (UV)(r->compflags), SvPVX_const(d));
2238
e3e400ec 2239 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
d63e6659 2240 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
dbc200c5
YO		 2241 (UV)(r->extflags), SvPVX_const(d));
2242
e3e400ec
YO		 2243 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
2244 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2245 if (r->engine == &PL_core_reg_engine) {
2246 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
2247 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
2248 (UV)(r->intflags), SvPVX_const(d));
2249 } else {
2250 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
d63e6659 2251 (UV)(r->intflags));
e3e400ec
YO		 2252 }
2253#undef SV_SET_STRINGIFY_REGEXP_FLAGS
d63e6659
DM		 2254 Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2255 (UV)(r->nparens));
2256 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2257 (UV)(r->lastparen));
2258 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2259 (UV)(r->lastcloseparen));
2260 Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2261 (IV)(r->minlen));
2262 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2263 (IV)(r->minlenret));
2264 Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2265 (UV)(r->gofs));
2266 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2267 (UV)(r->pre_prefix));
d63e6659
DM		 2268 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2269 (IV)(r->sublen));
6502e081
DM		 2270 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2271 (IV)(r->suboffset));
2272 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2273 (IV)(r->subcoffset));
d63e6659
DM		 2274 if (r->subbeg)
2275 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2276 PTR2UV(r->subbeg),
2277 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2278 else
2279 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
d63e6659
DM		 2280 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2281 PTR2UV(r->mother_re));
01ffd0f1
FC		 2282 if (nest < maxnest && r->mother_re)
2283 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2284 maxnest, dumpops, pvlim);
d63e6659
DM		 2285 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2286 PTR2UV(r->paren_names));
2287 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2288 PTR2UV(r->substrs));
2289 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2290 PTR2UV(r->pprivate));
2291 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2292 PTR2UV(r->offs));
d63c20f2
DM		 2293 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2294 PTR2UV(r->qr_anoncv));
db2c6cb3 2295#ifdef PERL_ANY_COW
d63e6659
DM		 2296 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2297 PTR2UV(r->saved_copy));
2298#endif
2299 }
206ee256 2300 break;
3967c732 2301 }
5f954473 2302 SvREFCNT_dec_NN(d);
3967c732
JD		 2303}
2304
36b1c95c
MH		 2305/*
2306=for apidoc sv_dump
2307
2308Dumps the contents of an SV to the C<STDERR> filehandle.
2309
2310For an example of its output, see L<Devel::Peek>.
2311
2312=cut
2313*/
2314
3967c732 2315void
864dbfa3 2316Perl_sv_dump(pTHX_ SV *sv)
3967c732 2317{
7918f24d
NC		 2318 PERL_ARGS_ASSERT_SV_DUMP;
2319
d1029faa
JP		 2320 if (SvROK(sv))
2321 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2322 else
2323 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 2324}
bd16a5f0
IZ		 2325
2326int
2327Perl_runops_debug(pTHX)
2328{
2329 if (!PL_op) {
9b387841 2330 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ		 2331 return 0;
2332 }
2333
9f3673fb 2334 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 2335 do {
75d476e2
S		 2336#ifdef PERL_TRACE_OPS
2337 ++PL_op_exec_cnt[PL_op->op_type];
2338#endif
bd16a5f0 2339 if (PL_debug) {
b9ac451d 2340 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0
IZ		 2341 PerlIO_printf(Perl_debug_log,
2342 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2343 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2344 PTR2UV(*PL_watchaddr));
d6721266
DM		 2345 if (DEBUG_s_TEST_) {
2346 if (DEBUG_v_TEST_) {
2347 PerlIO_printf(Perl_debug_log, "\n");
2348 deb_stack_all();
2349 }
2350 else
2351 debstack();
2352 }
2353
2354
bd16a5f0
IZ		 2355 if (DEBUG_t_TEST_) debop(PL_op);
2356 if (DEBUG_P_TEST_) debprof(PL_op);
2357 }
fe83c362
SM		 2358
2359 OP_ENTRY_PROBE(OP_NAME(PL_op));
16c91539 2360 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
9f3673fb 2361 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
47c9d59f 2362 PERL_ASYNC_CHECK();
bd16a5f0
IZ		 2363
2364 TAINT_NOT;
2365 return 0;
2366}
2367
2368I32
6867be6d 2369Perl_debop(pTHX_ const OP *o)
bd16a5f0 2370{
81d52ecd 2371 int count;
7918f24d
NC		 2372
2373 PERL_ARGS_ASSERT_DEBOP;
2374
1045810a
IZ		 2375 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2376 return 0;
2377
bd16a5f0
IZ		 2378 Perl_deb(aTHX_ "%s", OP_NAME(o));
2379 switch (o->op_type) {
2380 case OP_CONST:
996c9baa 2381 case OP_HINTSEVAL:
6cefa69e 2382 /* With ITHREADS, consts are stored in the pad, and the right pad
7367e658 2383 * may not be active here, so check.
6cefa69e 2384 * Looks like only during compiling the pads are illegal.
7367e658 2385 */
6cefa69e
RU		 2386#ifdef USE_ITHREADS
2387 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2388#endif
7367e658 2389 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
bd16a5f0
IZ		 2390 break;
2391 case OP_GVSV:
2392 case OP_GV:
2393 if (cGVOPo_gv) {
b9ac451d 2394 SV * const sv = newSV(0);
bd61b366 2395 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 2396 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
5f954473 2397 SvREFCNT_dec_NN(sv);
bd16a5f0
IZ		 2398 }
2399 else
2400 PerlIO_printf(Perl_debug_log, "(NULL)");
2401 break;
a7fd8ef6 2402
bd16a5f0
IZ		 2403 case OP_PADSV:
2404 case OP_PADAV:
2405 case OP_PADHV:
a7fd8ef6
DM		 2406 count = 1;
2407 goto dump_padop;
2408 case OP_PADRANGE:
2409 count = o->op_private & OPpPADRANGE_COUNTMASK;
2410 dump_padop:
bd16a5f0 2411 /* print the lexical's name */
a7fd8ef6
DM		 2412 {
2413 CV * const cv = deb_curcv(cxstack_ix);
2414 SV *sv;
2415 PAD * comppad = NULL;
2416 int i;
2417
2418 if (cv) {
2419 PADLIST * const padlist = CvPADLIST(cv);
2420 comppad = *PadlistARRAY(padlist);
2421 }
2422 PerlIO_printf(Perl_debug_log, "(");
2423 for (i = 0; i < count; i++) {
2424 if (comppad &&
2425 (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2426 PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2427 else
2428 PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2429 (UV)o->op_targ+i);
2430 if (i < count-1)
2431 PerlIO_printf(Perl_debug_log, ",");
2432 }
2433 PerlIO_printf(Perl_debug_log, ")");
2434 }
bd16a5f0 2435 break;
a7fd8ef6 2436
bd16a5f0 2437 default:
091ab601 2438 break;
bd16a5f0
IZ		 2439 }
2440 PerlIO_printf(Perl_debug_log, "\n");
2441 return 0;
2442}
2443
2444STATIC CV*
61f9802b 2445S_deb_curcv(pTHX_ const I32 ix)
bd16a5f0 2446{
b9ac451d 2447 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0
IZ		 2448 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2449 return cx->blk_sub.cv;
2450 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
676a678a 2451 return cx->blk_eval.cv;
bd16a5f0
IZ		 2452 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2453 return PL_main_cv;
2454 else if (ix <= 0)
601f1833 2455 return NULL;
bd16a5f0
IZ		 2456 else
2457 return deb_curcv(ix - 1);
2458}
2459
2460void
2461Perl_watch(pTHX_ char **addr)
2462{
7918f24d
NC		 2463 PERL_ARGS_ASSERT_WATCH;
2464
bd16a5f0
IZ		 2465 PL_watchaddr = addr;
2466 PL_watchok = *addr;
2467 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2468 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2469}
2470
2471STATIC void
e1ec3a88 2472S_debprof(pTHX_ const OP *o)
bd16a5f0 2473{
7918f24d
NC		 2474 PERL_ARGS_ASSERT_DEBPROF;
2475
61f9802b 2476 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2477 return;
bd16a5f0 2478 if (!PL_profiledata)
a02a5408 2479 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ		 2480 ++PL_profiledata[o->op_type];
2481}
2482
2483void
2484Perl_debprofdump(pTHX)
2485{
2486 unsigned i;
2487 if (!PL_profiledata)
2488 return;
2489 for (i = 0; i < MAXO; i++) {
2490 if (PL_profiledata[i])
2491 PerlIO_printf(Perl_debug_log,
2492 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2493 PL_op_name[i]);
2494 }
2495}
66610fdd 2496
3b721df9 2497
66610fdd
RGS		 2498/*
2499 * Local variables:
2500 * c-indentation-style: bsd
2501 * c-basic-offset: 4
14d04a33 2502 * indent-tabs-mode: nil
66610fdd
RGS		 2503 * End:
2504 *
14d04a33 2505 * ex: set ts=8 sts=4 sw=4 et:
37442d52 2506 */
Unnamed repository; edit this file 'description' to name the repository.