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