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