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
perldelta for #27010
[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.
23 */
24
8d063cd8 25#include "EXTERN.h"
864dbfa3 26#define PERL_IN_DUMP_C
8d063cd8 27#include "perl.h"
f722798b 28#include "regcomp.h"
0bd48802 29
49cf1d66 30
5357ca29
NC		 31static const char* const svtypenames[SVt_LAST] = {
32 "NULL",
49cf1d66 33 "DUMMY",
5357ca29 34 "IV",
b53eecb4 35 "NV",
5357ca29
NC		 36 "PV",
37 "PVIV",
38 "PVNV",
39 "PVMG",
5c35adbb 40 "REGEXP",
5357ca29
NC		 41 "PVGV",
42 "PVLV",
43 "PVAV",
44 "PVHV",
45 "PVCV",
46 "PVFM",
47 "PVIO"
48};
49
50
51static const char* const svshorttypenames[SVt_LAST] = {
52 "UNDEF",
49cf1d66 53 "DUMMY",
5357ca29 54 "IV",
b53eecb4 55 "NV",
5357ca29
NC		 56 "PV",
57 "PVIV",
58 "PVNV",
59 "PVMG",
5c35adbb 60 "REGEXP",
5357ca29
NC		 61 "GV",
62 "PVLV",
63 "AV",
64 "HV",
65 "CV",
66 "FM",
67 "IO"
68};
69
a0c2f4dd
NC		 70struct flag_to_name {
71 U32 flag;
72 const char *name;
73};
74
75static void
76S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
77 const struct flag_to_name *const end)
78{
79 do {
80 if (flags & start->flag)
81 sv_catpv(sv, start->name);
82 } while (++start < end);
83}
84
85#define append_flags(sv, f, flags) \
cd431fde 86 S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
a0c2f4dd 87
17605be7
DM		 88
89
3967c732 90void
864dbfa3 91Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
3967c732 92{
3967c732 93 va_list args;
7918f24d 94 PERL_ARGS_ASSERT_DUMP_INDENT;
3967c732 95 va_start(args, pat);
c5be433b 96 dump_vindent(level, file, pat, &args);
3967c732
JD		 97 va_end(args);
98}
8adcabd8
LW		 99
100void
c5be433b
GS		 101Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
102{
97aff369 103 dVAR;
7918f24d 104 PERL_ARGS_ASSERT_DUMP_VINDENT;
c8db6e60 105 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
c5be433b
GS		 106 PerlIO_vprintf(file, pat, *args);
107}
108
109void
864dbfa3 110Perl_dump_all(pTHX)
79072805 111{
712a6fe4 112 dump_all_perl(FALSE);
f0e3f042
CS		 113}
114
115void
116Perl_dump_all_perl(pTHX_ bool justperl)
117{
118
97aff369 119 dVAR;
760ac839 120 PerlIO_setlinebuf(Perl_debug_log);
3280af22 121 if (PL_main_root)
3967c732 122 op_dump(PL_main_root);
f0e3f042 123 dump_packsubs_perl(PL_defstash, justperl);
463ee0b2
LW		 124}
125
126void
e1ec3a88 127Perl_dump_packsubs(pTHX_ const HV *stash)
463ee0b2 128{
28eb953d 129 PERL_ARGS_ASSERT_DUMP_PACKSUBS;
f0e3f042
CS		 130 dump_packsubs_perl(stash, FALSE);
131}
132
133void
134Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
135{
97aff369 136 dVAR;
a0d0e21e 137 I32 i;
463ee0b2 138
28eb953d 139 PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
7918f24d 140
8990e307
LW		 141 if (!HvARRAY(stash))
142 return;
a0d0e21e 143 for (i = 0; i <= (I32) HvMAX(stash); i++) {
e1ec3a88 144 const HE *entry;
4db58590 145 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
159b6efe 146 const GV * const gv = (const GV *)HeVAL(entry);
e29cdcb3
GS		 147 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
148 continue;
8ebc5c01 149 if (GvCVu(gv))
f0e3f042 150 dump_sub_perl(gv, justperl);
85e6fe83
LW		 151 if (GvFORM(gv))
152 dump_form(gv);
61f9802b
AL		 153 if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
154 const HV * const hv = GvHV(gv);
155 if (hv && (hv != PL_defstash))
f0e3f042 156 dump_packsubs_perl(hv, justperl); /* nested package */
61f9802b 157 }
463ee0b2 158 }
79072805
LW		 159 }
160}
161
162void
e1ec3a88 163Perl_dump_sub(pTHX_ const GV *gv)
a687059c 164{
28eb953d 165 PERL_ARGS_ASSERT_DUMP_SUB;
f0e3f042
CS		 166 dump_sub_perl(gv, FALSE);
167}
168
169void
170Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
171{
172 SV * sv;
85e6fe83 173
28eb953d 174 PERL_ARGS_ASSERT_DUMP_SUB_PERL;
7918f24d 175
f0e3f042
CS		 176 if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
177 return;
178
179 sv = sv_newmortal();
bd61b366 180 gv_fullname3(sv, gv, NULL);
b15aece3 181 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
aed2304a 182 if (CvISXSUB(GvCV(gv)))
91f3b821
GS		 183 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
184 PTR2UV(CvXSUB(GvCV(gv))),
894356b3 185 (int)CvXSUBANY(GvCV(gv)).any_i32);
85e6fe83 186 else if (CvROOT(GvCV(gv)))
3967c732 187 op_dump(CvROOT(GvCV(gv)));
85e6fe83 188 else
cea2e8a9 189 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
85e6fe83
LW		 190}
191
192void
e1ec3a88 193Perl_dump_form(pTHX_ const GV *gv)
85e6fe83 194{
b464bac0 195 SV * const sv = sv_newmortal();
85e6fe83 196
7918f24d
NC		 197 PERL_ARGS_ASSERT_DUMP_FORM;
198
bd61b366 199 gv_fullname3(sv, gv, NULL);
b15aece3 200 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
85e6fe83 201 if (CvROOT(GvFORM(gv)))
3967c732 202 op_dump(CvROOT(GvFORM(gv)));
85e6fe83 203 else
cea2e8a9 204 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
a687059c
LW		 205}
206
8adcabd8 207void
864dbfa3 208Perl_dump_eval(pTHX)
8d063cd8 209{
97aff369 210 dVAR;
3967c732
JD		 211 op_dump(PL_eval_root);
212}
213
3df15adc
YO		 214
215/*
87cea99e 216=for apidoc pv_escape
3df15adc
YO		 217
218Escapes at most the first "count" chars of pv and puts the results into
ab3bbdeb 219dsv such that the size of the escaped string will not exceed "max" chars
3df15adc
YO		 220and will not contain any incomplete escape sequences.
221
ab3bbdeb
YO		 222If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
223will also be escaped.
3df15adc
YO		 224
225Normally the SV will be cleared before the escaped string is prepared,
ab3bbdeb
YO		 226but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
227
38a44b82 228If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
ab3bbdeb 229if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
38a44b82 230using C<is_utf8_string()> to determine if it is Unicode.
ab3bbdeb
YO		 231
232If PERL_PV_ESCAPE_ALL is set then all input chars will be output
681f01c2
KW		 233using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
234chars above 127 will be escaped using this style; otherwise, only chars above
235255 will be so escaped; other non printable chars will use octal or
236common escaped patterns like C<\n>. Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
237then all chars below 255 will be treated as printable and
ab3bbdeb
YO		 238will be output as literals.
239
240If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
c8536afa
KW		 241string will be escaped, regardless of max. If the output is to be in hex,
242then it will be returned as a plain hex
243sequence. Thus the output will either be a single char,
244an octal escape sequence, a special escape like C<\n> or a hex value.
3df15adc 245
44a2ac75
YO		 246If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
247not a '\\'. This is because regexes very often contain backslashed
248sequences, whereas '%' is not a particularly common character in patterns.
249
ab3bbdeb 250Returns a pointer to the escaped text as held by dsv.
3df15adc
YO		 251
252=cut
253*/
ab3bbdeb 254#define PV_ESCAPE_OCTBUFSIZE 32
ddc5bc0f 255
3967c732 256char *
ddc5bc0f 257Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
ab3bbdeb
YO		 258 const STRLEN count, const STRLEN max,
259 STRLEN * const escaped, const U32 flags )
260{
61f9802b
AL		 261 const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
262 const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
44a2ac75 263 char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
ab3bbdeb
YO		 264 STRLEN wrote = 0; /* chars written so far */
265 STRLEN chsize = 0; /* size of data to be written */
266 STRLEN readsize = 1; /* size of data just read */
38a44b82 267 bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
ddc5bc0f 268 const char *pv = str;
61f9802b 269 const char * const end = pv + count; /* end of string */
44a2ac75 270 octbuf[0] = esc;
ab3bbdeb 271
7918f24d
NC		 272 PERL_ARGS_ASSERT_PV_ESCAPE;
273
9ed8b5e5 274 if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
7fddd944 275 /* This won't alter the UTF-8 flag */
76f68e9b 276 sv_setpvs(dsv, "");
7fddd944 277 }
ab3bbdeb 278
ddc5bc0f 279 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
ab3bbdeb
YO		 280 isuni = 1;
281
282 for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
4b88fb76 283 const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
ab3bbdeb
YO		 284 const U8 c = (U8)u & 0xFF;
285
681f01c2
KW		 286 if ( ( u > 255 )
287 || (flags & PERL_PV_ESCAPE_ALL)
288 || (( u > 127 ) && (flags & PERL_PV_ESCAPE_NONASCII)))
289 {
ab3bbdeb
YO		 290 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
291 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
292 "%"UVxf, u);
293 else
294 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 295 "%cx{%"UVxf"}", esc, u);
ab3bbdeb
YO		 296 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
297 chsize = 1;
298 } else {
44a2ac75
YO		 299 if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
300 chsize = 2;
ab3bbdeb 301 switch (c) {
44a2ac75
YO		 302
303 case '\\' : /* fallthrough */
304 case '%' : if ( c == esc ) {
305 octbuf[1] = esc;
306 } else {
307 chsize = 1;
308 }
309 break;
3df15adc
YO		 310 case '\v' : octbuf[1] = 'v'; break;
311 case '\t' : octbuf[1] = 't'; break;
312 case '\r' : octbuf[1] = 'r'; break;
313 case '\n' : octbuf[1] = 'n'; break;
314 case '\f' : octbuf[1] = 'f'; break;
44a2ac75 315 case '"' :
ab3bbdeb 316 if ( dq == '"' )
3df15adc 317 octbuf[1] = '"';
ab3bbdeb
YO		 318 else
319 chsize = 1;
44a2ac75 320 break;
3df15adc 321 default:
bbae360a 322 if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
ab3bbdeb 323 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75
YO		 324 "%c%03o", esc, c);
325 else
ab3bbdeb 326 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 327 "%c%o", esc, c);
ab3bbdeb
YO		 328 }
329 } else {
44a2ac75 330 chsize = 1;
ab3bbdeb 331 }
44a2ac75
YO		 332 }
333 if ( max && (wrote + chsize > max) ) {
334 break;
ab3bbdeb 335 } else if (chsize > 1) {
44a2ac75
YO		 336 sv_catpvn(dsv, octbuf, chsize);
337 wrote += chsize;
3df15adc 338 } else {
7fddd944
NC		 339 /* If PERL_PV_ESCAPE_NOBACKSLASH is set then bytes in the range
340 128-255 can be appended raw to the dsv. If dsv happens to be
341 UTF-8 then we need catpvf to upgrade them for us.
342 Or add a new API call sv_catpvc(). Think about that name, and
343 how to keep it clear that it's unlike the s of catpvs, which is
344 really an array octets, not a string. */
345 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
3df15adc
YO		 346 wrote++;
347 }
ab3bbdeb
YO		 348 if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
349 break;
3967c732 350 }
ab3bbdeb
YO		 351 if (escaped != NULL)
352 *escaped= pv - str;
353 return SvPVX(dsv);
354}
355/*
87cea99e 356=for apidoc pv_pretty
ab3bbdeb
YO		 357
358Converts a string into something presentable, handling escaping via
95b611b0 359pv_escape() and supporting quoting and ellipses.
ab3bbdeb
YO		 360
361If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
362double quoted with any double quotes in the string escaped. Otherwise
363if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
364angle brackets.
6cba11c8 365
95b611b0
RGS		 366If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
367string were output then an ellipsis C<...> will be appended to the
ab3bbdeb 368string. Note that this happens AFTER it has been quoted.
6cba11c8 369
ab3bbdeb
YO		 370If start_color is non-null then it will be inserted after the opening
371quote (if there is one) but before the escaped text. If end_color
372is non-null then it will be inserted after the escaped text but before
95b611b0 373any quotes or ellipses.
ab3bbdeb
YO		 374
375Returns a pointer to the prettified text as held by dsv.
6cba11c8 376
ab3bbdeb
YO		 377=cut
378*/
379
380char *
ddc5bc0f
YO		 381Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
382 const STRLEN max, char const * const start_color, char const * const end_color,
ab3bbdeb
YO		 383 const U32 flags )
384{
61f9802b 385 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
ab3bbdeb 386 STRLEN escaped;
7918f24d
NC		 387
388 PERL_ARGS_ASSERT_PV_PRETTY;
389
881a015e
NC		 390 if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
391 /* This won't alter the UTF-8 flag */
76f68e9b 392 sv_setpvs(dsv, "");
881a015e
NC		 393 }
394
ab3bbdeb 395 if ( dq == '"' )
76f68e9b 396 sv_catpvs(dsv, "\"");
ab3bbdeb 397 else if ( flags & PERL_PV_PRETTY_LTGT )
76f68e9b 398 sv_catpvs(dsv, "<");
ab3bbdeb
YO		 399
400 if ( start_color != NULL )
76f68e9b 401 sv_catpv(dsv, start_color);
ab3bbdeb
YO		 402
403 pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
404
405 if ( end_color != NULL )
76f68e9b 406 sv_catpv(dsv, end_color);
ab3bbdeb
YO		 407
408 if ( dq == '"' )
76f68e9b 409 sv_catpvs( dsv, "\"");
ab3bbdeb 410 else if ( flags & PERL_PV_PRETTY_LTGT )
76f68e9b 411 sv_catpvs(dsv, ">");
ab3bbdeb 412
95b611b0 413 if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
76f68e9b 414 sv_catpvs(dsv, "...");
ab3bbdeb 415
3df15adc
YO		 416 return SvPVX(dsv);
417}
418
419/*
420=for apidoc pv_display
421
3df15adc 422Similar to
3967c732 423
3df15adc
YO		 424 pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
425
426except that an additional "\0" will be appended to the string when
427len > cur and pv[cur] is "\0".
428
429Note that the final string may be up to 7 chars longer than pvlim.
430
431=cut
432*/
433
434char *
435Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
436{
7918f24d
NC		 437 PERL_ARGS_ASSERT_PV_DISPLAY;
438
ddc5bc0f 439 pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
3df15adc 440 if (len > cur && pv[cur] == '\0')
76f68e9b 441 sv_catpvs( dsv, "\\0");
e6abe6d8
JH		 442 return SvPVX(dsv);
443}
444
445char *
864dbfa3 446Perl_sv_peek(pTHX_ SV *sv)
3967c732 447{
27da23d5 448 dVAR;
aec46f14 449 SV * const t = sv_newmortal();
3967c732 450 int unref = 0;
5357ca29 451 U32 type;
3967c732 452
76f68e9b 453 sv_setpvs(t, "");
3967c732
JD		 454 retry:
455 if (!sv) {
456 sv_catpv(t, "VOID");
457 goto finish;
458 }
8ee91b45
YO		 459 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
460 /* detect data corruption under memory poisoning */
3967c732
JD		 461 sv_catpv(t, "WILD");
462 goto finish;
463 }
7996736c 464 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
3967c732
JD		 465 if (sv == &PL_sv_undef) {
466 sv_catpv(t, "SV_UNDEF");
467 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
468 SVs_GMG|SVs_SMG|SVs_RMG)) &&
469 SvREADONLY(sv))
470 goto finish;
471 }
472 else if (sv == &PL_sv_no) {
473 sv_catpv(t, "SV_NO");
474 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
475 SVs_GMG|SVs_SMG|SVs_RMG)) &&
476 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
477 SVp_POK|SVp_NOK)) &&
478 SvCUR(sv) == 0 &&
479 SvNVX(sv) == 0.0)
480 goto finish;
481 }
7996736c 482 else if (sv == &PL_sv_yes) {
3967c732
JD		 483 sv_catpv(t, "SV_YES");
484 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
485 SVs_GMG|SVs_SMG|SVs_RMG)) &&
486 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
487 SVp_POK|SVp_NOK)) &&
488 SvCUR(sv) == 1 &&
b15aece3 489 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
3967c732
JD		 490 SvNVX(sv) == 1.0)
491 goto finish;
7996736c
MHM		 492 }
493 else {
494 sv_catpv(t, "SV_PLACEHOLDER");
495 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
496 SVs_GMG|SVs_SMG|SVs_RMG)) &&
497 SvREADONLY(sv))
498 goto finish;
3967c732
JD		 499 }
500 sv_catpv(t, ":");
501 }
502 else if (SvREFCNT(sv) == 0) {
503 sv_catpv(t, "(");
504 unref++;
505 }
a3b4c9c6
DM		 506 else if (DEBUG_R_TEST_) {
507 int is_tmp = 0;
508 I32 ix;
509 /* is this SV on the tmps stack? */
510 for (ix=PL_tmps_ix; ix>=0; ix--) {
511 if (PL_tmps_stack[ix] == sv) {
512 is_tmp = 1;
513 break;
514 }
515 }
516 if (SvREFCNT(sv) > 1)
517 Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
518 is_tmp ? "T" : "");
519 else if (is_tmp)
520 sv_catpv(t, "<T>");
04932ac8
DM		 521 }
522
3967c732
JD		 523 if (SvROK(sv)) {
524 sv_catpv(t, "\\");
525 if (SvCUR(t) + unref > 10) {
b162af07 526 SvCUR_set(t, unref + 3);
3967c732
JD		 527 *SvEND(t) = '\0';
528 sv_catpv(t, "...");
529 goto finish;
530 }
ad64d0ec 531 sv = SvRV(sv);
3967c732
JD		 532 goto retry;
533 }
5357ca29
NC		 534 type = SvTYPE(sv);
535 if (type == SVt_PVCV) {
17605be7 536 Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
3967c732 537 goto finish;
5357ca29
NC		 538 } else if (type < SVt_LAST) {
539 sv_catpv(t, svshorttypenames[type]);
3967c732 540
5357ca29
NC		 541 if (type == SVt_NULL)
542 goto finish;
543 } else {
544 sv_catpv(t, "FREED");
3967c732 545 goto finish;
3967c732
JD		 546 }
547
548 if (SvPOKp(sv)) {
b15aece3 549 if (!SvPVX_const(sv))
3967c732
JD		 550 sv_catpv(t, "(null)");
551 else {
17605be7 552 SV * const tmp = newSVpvs("");
3967c732 553 sv_catpv(t, "(");
5115136b
DM		 554 if (SvOOK(sv)) {
555 STRLEN delta;
556 SvOOK_offset(sv, delta);
557 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
558 }
b15aece3 559 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
32639b87 560 if (SvUTF8(sv))
b2ff9928 561 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
e9569a7a 562 sv_uni_display(tmp, sv, 6 * SvCUR(sv),
c728cb41 563 UNI_DISPLAY_QQ));
17605be7 564 SvREFCNT_dec_NN(tmp);
3967c732
JD		 565 }
566 }
567 else if (SvNOKp(sv)) {
e54dc35b 568 STORE_NUMERIC_LOCAL_SET_STANDARD();
1779d84d 569 Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
e54dc35b 570 RESTORE_NUMERIC_LOCAL();
3967c732 571 }
57def98f 572 else if (SvIOKp(sv)) {
cf2093f6 573 if (SvIsUV(sv))
57def98f 574 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
cf2093f6 575 else
57def98f 576 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
25da4f38 577 }
3967c732
JD		 578 else
579 sv_catpv(t, "()");
2ef28da1 580
3967c732 581 finish:
61f9802b
AL		 582 while (unref--)
583 sv_catpv(t, ")");
284167a5 584 if (TAINTING_get && SvTAINTED(sv))
59b714e2 585 sv_catpv(t, " [tainted]");
8b6b16e7 586 return SvPV_nolen(t);
3967c732
JD		 587}
588
589void
6867be6d 590Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
3967c732
JD		 591{
592 char ch;
593
7918f24d
NC		 594 PERL_ARGS_ASSERT_DO_PMOP_DUMP;
595
3967c732 596 if (!pm) {
cea2e8a9 597 Perl_dump_indent(aTHX_ level, file, "{}\n");
3967c732
JD		 598 return;
599 }
cea2e8a9 600 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732
JD		 601 level++;
602 if (pm->op_pmflags & PMf_ONCE)
603 ch = '?';
604 else
605 ch = '/';
aaa362c4 606 if (PM_GETRE(pm))
cea2e8a9 607 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
220fc49f 608 ch, RX_PRECOMP(PM_GETRE(pm)), ch,
3967c732
JD		 609 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
610 else
cea2e8a9 611 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
20e98b0f 612 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
cea2e8a9 613 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
20e98b0f 614 op_dump(pm->op_pmreplrootu.op_pmreplroot);
3967c732 615 }
68e2671b 616 if (pm->op_code_list) {
867940b8
DM		 617 if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
618 Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
619 do_op_dump(level, file, pm->op_code_list);
620 }
621 else
622 Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
623 PTR2UV(pm->op_code_list));
68e2671b 624 }
07bc277f 625 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
4199688e 626 SV * const tmpsv = pm_description(pm);
b15aece3 627 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
5f954473 628 SvREFCNT_dec_NN(tmpsv);
3967c732
JD		 629 }
630
cea2e8a9 631 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 632}
633
a0c2f4dd
NC		 634const struct flag_to_name pmflags_flags_names[] = {
635 {PMf_CONST, ",CONST"},
636 {PMf_KEEP, ",KEEP"},
637 {PMf_GLOBAL, ",GLOBAL"},
638 {PMf_CONTINUE, ",CONTINUE"},
639 {PMf_RETAINT, ",RETAINT"},
640 {PMf_EVAL, ",EVAL"},
641 {PMf_NONDESTRUCT, ",NONDESTRUCT"},
d63c20f2 642 {PMf_HAS_CV, ",HAS_CV"},
2a92a973
DM		 643 {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
644 {PMf_IS_QR, ",IS_QR"}
a0c2f4dd
NC		 645};
646
b9ac451d 647static SV *
4199688e
AL		 648S_pm_description(pTHX_ const PMOP *pm)
649{
650 SV * const desc = newSVpvs("");
61f9802b 651 const REGEXP * const regex = PM_GETRE(pm);
4199688e
AL		 652 const U32 pmflags = pm->op_pmflags;
653
7918f24d
NC		 654 PERL_ARGS_ASSERT_PM_DESCRIPTION;
655
4199688e
AL		 656 if (pmflags & PMf_ONCE)
657 sv_catpv(desc, ",ONCE");
c737faaf
YO		 658#ifdef USE_ITHREADS
659 if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
660 sv_catpv(desc, ":USED");
661#else
662 if (pmflags & PMf_USED)
663 sv_catpv(desc, ":USED");
664#endif
c737faaf 665
68d4833d 666 if (regex) {
284167a5 667 if (RX_ISTAINTED(regex))
68d4833d 668 sv_catpv(desc, ",TAINTED");
07bc277f
NC		 669 if (RX_CHECK_SUBSTR(regex)) {
670 if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
68d4833d 671 sv_catpv(desc, ",SCANFIRST");
07bc277f 672 if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
68d4833d
AB		 673 sv_catpv(desc, ",ALL");
674 }
dbc200c5
YO		 675 if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
676 sv_catpv(desc, ",SKIPWHITE");
4199688e 677 }
68d4833d 678
a0c2f4dd 679 append_flags(desc, pmflags, pmflags_flags_names);
4199688e
AL		 680 return desc;
681}
682
3967c732 683void
864dbfa3 684Perl_pmop_dump(pTHX_ PMOP *pm)
3967c732
JD		 685{
686 do_pmop_dump(0, Perl_debug_log, pm);
79072805
LW		 687}
688
b6f05621
DM		 689/* Return a unique integer to represent the address of op o.
690 * If it already exists in PL_op_sequence, just return it;
691 * otherwise add it.
692 * *** Note that this isn't thread-safe */
294b3b39 693
2814eb74 694STATIC UV
0bd48802 695S_sequence_num(pTHX_ const OP *o)
2814eb74 696{
27da23d5 697 dVAR;
2814eb74
PJ		 698 SV *op,
699 **seq;
93524f2b 700 const char *key;
2814eb74 701 STRLEN len;
b6f05621
DM		 702 if (!o)
703 return 0;
c0fd1b42 704 op = newSVuv(PTR2UV(o));
b6f05621 705 sv_2mortal(op);
93524f2b 706 key = SvPV_const(op, len);
b6f05621
DM		 707 if (!PL_op_sequence)
708 PL_op_sequence = newHV();
709 seq = hv_fetch(PL_op_sequence, key, len, 0);
710 if (seq)
711 return SvUV(*seq);
712 (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
713 return PL_op_seq;
2814eb74
PJ		 714}
715
a0c2f4dd
NC		 716const struct flag_to_name op_flags_names[] = {
717 {OPf_KIDS, ",KIDS"},
718 {OPf_PARENS, ",PARENS"},
a0c2f4dd
NC		 719 {OPf_REF, ",REF"},
720 {OPf_MOD, ",MOD"},
65cccc5e 721 {OPf_STACKED, ",STACKED"},
a0c2f4dd
NC		 722 {OPf_SPECIAL, ",SPECIAL"}
723};
724
ea9ad1f2 725const struct flag_to_name op_trans_names[] = {
65cccc5e
VP		 726 {OPpTRANS_FROM_UTF, ",FROM_UTF"},
727 {OPpTRANS_TO_UTF, ",TO_UTF"},
728 {OPpTRANS_IDENTICAL, ",IDENTICAL"},
ea9ad1f2 729 {OPpTRANS_SQUASH, ",SQUASH"},
ea9ad1f2 730 {OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
65cccc5e
VP		 731 {OPpTRANS_GROWS, ",GROWS"},
732 {OPpTRANS_DELETE, ",DELETE"}
ea9ad1f2
NC		 733};
734
735const struct flag_to_name op_entersub_names[] = {
ea9ad1f2
NC		 736 {OPpENTERSUB_DB, ",DB"},
737 {OPpENTERSUB_HASTARG, ",HASTARG"},
65cccc5e 738 {OPpENTERSUB_AMPER, ",AMPER"},
ea9ad1f2 739 {OPpENTERSUB_NOPAREN, ",NOPAREN"},
65cccc5e 740 {OPpENTERSUB_INARGS, ",INARGS"}
ea9ad1f2
NC		 741};
742
743const struct flag_to_name op_const_names[] = {
65cccc5e
VP		 744 {OPpCONST_NOVER, ",NOVER"},
745 {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
ea9ad1f2 746 {OPpCONST_STRICT, ",STRICT"},
65cccc5e 747 {OPpCONST_ENTERED, ",ENTERED"},
cc2ebcd7 748 {OPpCONST_FOLDED, ",FOLDED"},
63e0918d 749 {OPpCONST_BARE, ",BARE"}
ea9ad1f2
NC		 750};
751
752const struct flag_to_name op_sort_names[] = {
753 {OPpSORT_NUMERIC, ",NUMERIC"},
754 {OPpSORT_INTEGER, ",INTEGER"},
65cccc5e
VP		 755 {OPpSORT_REVERSE, ",REVERSE"},
756 {OPpSORT_INPLACE, ",INPLACE"},
757 {OPpSORT_DESCEND, ",DESCEND"},
758 {OPpSORT_QSORT, ",QSORT"},
759 {OPpSORT_STABLE, ",STABLE"}
ea9ad1f2
NC		 760};
761
762const struct flag_to_name op_open_names[] = {
763 {OPpOPEN_IN_RAW, ",IN_RAW"},
764 {OPpOPEN_IN_CRLF, ",IN_CRLF"},
765 {OPpOPEN_OUT_RAW, ",OUT_RAW"},
766 {OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
767};
768
261c990e
NC		 769const struct flag_to_name op_exit_names[] = {
770 {OPpEXIT_VMSISH, ",EXIT_VMSISH"},
771 {OPpHUSH_VMSISH, ",HUSH_VMSISH"}
772};
773
75a6ad4a
RU		 774const struct flag_to_name op_sassign_names[] = {
775 {OPpASSIGN_BACKWARDS, ",BACKWARDS"},
776 {OPpASSIGN_CV_TO_GV, ",CV2GV"}
777};
778
261c990e
NC		 779#define OP_PRIVATE_ONCE(op, flag, name) \
780 const struct flag_to_name CAT2(op, _names)[] = { \
781 {(flag), (name)} \
f58883a1 782 }
261c990e 783
261c990e 784OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
261c990e 785OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
65cccc5e 786OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
261c990e
NC		 787OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
788OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
789OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
790OP_PRIVATE_ONCE(op_list, OPpLIST_GUESSED, ",GUESSED");
791OP_PRIVATE_ONCE(op_delete, OPpSLICE, ",SLICE");
792OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
793OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
60041a09 794OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
261c990e 795
1fe3abee
NC		 796struct op_private_by_op {
797 U16 op_type;
798 U16 len;
799 const struct flag_to_name *start;
800};
801
802const struct op_private_by_op op_private_names[] = {
261c990e
NC		 803 {OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
804 {OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
805 {OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
806 {OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
261c990e
NC		 807 {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
808 {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
809 {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
810 {OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
811 {OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
812 {OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
813 {OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
814 {OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
815 {OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
816 {OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
817 {OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
1fe3abee
NC		 818 {OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
819 {OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
820 {OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
821 {OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
60041a09 822 {OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
1fe3abee
NC		 823 {OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
824};
825
826static bool
827S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
828 const struct op_private_by_op *start = op_private_names;
829 const struct op_private_by_op *const end
830 = op_private_names + C_ARRAY_LENGTH(op_private_names);
831
832 /* This is a linear search, but no worse than the code that it replaced.
833 It's debugging code - size is more important than speed. */
834 do {
835 if (optype == start->op_type) {
836 S_append_flags(aTHX_ tmpsv, op_private, start->start,
837 start->start + start->len);
838 return TRUE;
839 }
840 } while (++start < end);
841 return FALSE;
842}
843
75a6ad4a
RU		 844#define DUMP_OP_FLAGS(o,xml,level,file) \
845 if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
17605be7 846 SV * const tmpsv = newSVpvs(""); \
75a6ad4a
RU		 847 switch (o->op_flags & OPf_WANT) { \
848 case OPf_WANT_VOID: \
849 sv_catpv(tmpsv, ",VOID"); \
850 break; \
851 case OPf_WANT_SCALAR: \
852 sv_catpv(tmpsv, ",SCALAR"); \
853 break; \
854 case OPf_WANT_LIST: \
855 sv_catpv(tmpsv, ",LIST"); \
856 break; \
857 default: \
858 sv_catpv(tmpsv, ",UNKNOWN"); \
859 break; \
860 } \
861 append_flags(tmpsv, o->op_flags, op_flags_names); \
862 if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
863 if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
864 if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
865 if (!xml) \
866 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
867 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
868 else \
869 PerlIO_printf(file, " flags=\"%s\"", \
870 SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
5f954473 871 SvREFCNT_dec_NN(tmpsv); \
75a6ad4a
RU		 872 }
873
874#if !defined(PERL_MAD)
09c75956
FC		 875# define xmldump_attr1(level, file, pat, arg)
876#else
877# define xmldump_attr1(level, file, pat, arg) \
878 S_xmldump_attr(aTHX_ level, file, pat, arg)
75a6ad4a
RU		 879#endif
880
881#define DUMP_OP_PRIVATE(o,xml,level,file) \
882 if (o->op_private) { \
883 U32 optype = o->op_type; \
884 U32 oppriv = o->op_private; \
17605be7 885 SV * const tmpsv = newSVpvs(""); \
75a6ad4a
RU		 886 if (PL_opargs[optype] & OA_TARGLEX) { \
887 if (oppriv & OPpTARGET_MY) \
888 sv_catpv(tmpsv, ",TARGET_MY"); \
889 } \
890 else if (optype == OP_ENTERSUB || \
891 optype == OP_RV2SV || \
892 optype == OP_GVSV || \
893 optype == OP_RV2AV || \
894 optype == OP_RV2HV || \
895 optype == OP_RV2GV || \
896 optype == OP_AELEM || \
897 optype == OP_HELEM ) \
898 { \
899 if (optype == OP_ENTERSUB) { \
900 append_flags(tmpsv, oppriv, op_entersub_names); \
901 } \
902 else { \
903 switch (oppriv & OPpDEREF) { \
904 case OPpDEREF_SV: \
905 sv_catpv(tmpsv, ",SV"); \
906 break; \
907 case OPpDEREF_AV: \
908 sv_catpv(tmpsv, ",AV"); \
909 break; \
910 case OPpDEREF_HV: \
911 sv_catpv(tmpsv, ",HV"); \
912 break; \
913 } \
914 if (oppriv & OPpMAYBE_LVSUB) \
915 sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
916 } \
917 if (optype == OP_AELEM || optype == OP_HELEM) { \
918 if (oppriv & OPpLVAL_DEFER) \
919 sv_catpv(tmpsv, ",LVAL_DEFER"); \
920 } \
921 else if (optype == OP_RV2HV || optype == OP_PADHV) { \
922 if (oppriv & OPpMAYBE_TRUEBOOL) \
923 sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
924 if (oppriv & OPpTRUEBOOL) \
925 sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
926 } \
927 else { \
928 if (oppriv & HINT_STRICT_REFS) \
929 sv_catpv(tmpsv, ",STRICT_REFS"); \
930 if (oppriv & OPpOUR_INTRO) \
931 sv_catpv(tmpsv, ",OUR_INTRO"); \
932 } \
933 } \
934 else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
935 } \
936 else if (OP_IS_FILETEST(o->op_type)) { \
937 if (oppriv & OPpFT_ACCESS) \
938 sv_catpv(tmpsv, ",FT_ACCESS"); \
939 if (oppriv & OPpFT_STACKED) \
940 sv_catpv(tmpsv, ",FT_STACKED"); \
941 if (oppriv & OPpFT_STACKING) \
942 sv_catpv(tmpsv, ",FT_STACKING"); \
943 if (oppriv & OPpFT_AFTER_t) \
944 sv_catpv(tmpsv, ",AFTER_t"); \
945 } \
631dbaa2
FC		 946 else if (o->op_type == OP_AASSIGN) { \
947 if (oppriv & OPpASSIGN_COMMON) \
948 sv_catpvs(tmpsv, ",COMMON"); \
949 if (oppriv & OPpMAYBE_LVSUB) \
950 sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
951 } \
75a6ad4a
RU		 952 if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
953 sv_catpv(tmpsv, ",INTRO"); \
954 if (o->op_type == OP_PADRANGE) \
955 Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
956 (UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
957 if (SvCUR(tmpsv)) { \
958 if (xml) \
09c75956 959 xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
75a6ad4a
RU		 960 else \
961 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
962 } else if (!xml) \
963 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
964 (UV)oppriv); \
5f954473 965 SvREFCNT_dec_NN(tmpsv); \
75a6ad4a
RU		 966 }
967
968
79072805 969void
6867be6d 970Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
79072805 971{
27da23d5 972 dVAR;
2814eb74 973 UV seq;
e15d5972
AL		 974 const OPCODE optype = o->op_type;
975
7918f24d
NC		 976 PERL_ARGS_ASSERT_DO_OP_DUMP;
977
cea2e8a9 978 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732 979 level++;
0bd48802 980 seq = sequence_num(o);
2814eb74 981 if (seq)
f5992bc4 982 PerlIO_printf(file, "%-4"UVuf, seq);
93a17b20 983 else
b6f05621 984 PerlIO_printf(file, "????");
c8db6e60
JH		 985 PerlIO_printf(file,
986 "%*sTYPE = %s ===> ",
53e06cf0 987 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
2814eb74 988 if (o->op_next)
b6f05621
DM		 989 PerlIO_printf(file,
990 o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
666ea192 991 sequence_num(o->op_next));
79072805 992 else
e75ab6ad 993 PerlIO_printf(file, "NULL\n");
11343788 994 if (o->op_targ) {
e15d5972 995 if (optype == OP_NULL) {
cea2e8a9 996 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
e15d5972 997 if (o->op_targ == OP_NEXTSTATE) {
ae7d165c 998 if (CopLINE(cCOPo))
f5992bc4 999 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 1000 (UV)CopLINE(cCOPo));
ae7d165c
PJ		 1001 if (CopSTASHPV(cCOPo))
1002 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1003 CopSTASHPV(cCOPo));
4b65a919 1004 if (CopLABEL(cCOPo))
ae7d165c 1005 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
4b65a919 1006 CopLABEL(cCOPo));
ae7d165c
PJ		 1007 }
1008 }
8990e307 1009 else
894356b3 1010 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
8990e307 1011 }
748a9306 1012#ifdef DUMPADDR
57def98f 1013 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
79072805 1014#endif
a7fd8ef6 1015
75a6ad4a
RU		 1016 DUMP_OP_FLAGS(o,0,level,file);
1017 DUMP_OP_PRIVATE(o,0,level,file);
8d063cd8 1018
3b721df9
NC		 1019#ifdef PERL_MAD
1020 if (PL_madskills && o->op_madprop) {
17605be7 1021 SV * const tmpsv = newSVpvs("");
3b721df9
NC		 1022 MADPROP* mp = o->op_madprop;
1023 Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
1024 level++;
1025 while (mp) {
61f9802b 1026 const char tmp = mp->mad_key;
76f68e9b 1027 sv_setpvs(tmpsv,"'");
3b721df9
NC		 1028 if (tmp)
1029 sv_catpvn(tmpsv, &tmp, 1);
1030 sv_catpv(tmpsv, "'=");
1031 switch (mp->mad_type) {
1032 case MAD_NULL:
1033 sv_catpv(tmpsv, "NULL");
1034 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1035 break;
1036 case MAD_PV:
1037 sv_catpv(tmpsv, "<");
1038 sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
1039 sv_catpv(tmpsv, ">");
1040 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1041 break;
1042 case MAD_OP:
1043 if ((OP*)mp->mad_val) {
1044 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1045 do_op_dump(level, file, (OP*)mp->mad_val);
1046 }
1047 break;
1048 default:
1049 sv_catpv(tmpsv, "(UNK)");
1050 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1051 break;
1052 }
1053 mp = mp->mad_next;
1054 }
1055 level--;
1056 Perl_dump_indent(aTHX_ level, file, "}\n");
1057
5f954473 1058 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 1059 }
1060#endif
1061
e15d5972 1062 switch (optype) {
971a9dd3 1063 case OP_AELEMFAST:
93a17b20 1064 case OP_GVSV:
79072805 1065 case OP_GV:
971a9dd3 1066#ifdef USE_ITHREADS
c803eecc 1067 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 1068#else
1640e9f0 1069 if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
38c076c7 1070 if (cSVOPo->op_sv) {
d4c19fe8 1071 SV * const tmpsv = newSV(0);
38c076c7
DM		 1072 ENTER;
1073 SAVEFREESV(tmpsv);
3b721df9 1074#ifdef PERL_MAD
84021b46 1075 /* FIXME - is this making unwarranted assumptions about the
3b721df9
NC		 1076 UTF-8 cleanliness of the dump file handle? */
1077 SvUTF8_on(tmpsv);
1078#endif
159b6efe 1079 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
8b6b16e7 1080 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
17605be7 1081 SvPV_nolen_const(tmpsv));
38c076c7
DM		 1082 LEAVE;
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));
ed094faf
GS		 1103 if (CopSTASHPV(cCOPo))
1104 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1105 CopSTASHPV(cCOPo));
4b65a919 1106 if (CopLABEL(cCOPo))
ed094faf 1107 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
4b65a919 1108 CopLABEL(cCOPo));
79072805
LW		 1109 break;
1110 case OP_ENTERLOOP:
cea2e8a9 1111 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
11343788 1112 if (cLOOPo->op_redoop)
f5992bc4 1113 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
79072805 1114 else
3967c732 1115 PerlIO_printf(file, "DONE\n");
cea2e8a9 1116 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
11343788 1117 if (cLOOPo->op_nextop)
f5992bc4 1118 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
79072805 1119 else
3967c732 1120 PerlIO_printf(file, "DONE\n");
cea2e8a9 1121 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
11343788 1122 if (cLOOPo->op_lastop)
f5992bc4 1123 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
79072805 1124 else
3967c732 1125 PerlIO_printf(file, "DONE\n");
79072805
LW		 1126 break;
1127 case OP_COND_EXPR:
1a67a97c 1128 case OP_RANGE:
a0d0e21e 1129 case OP_MAPWHILE:
79072805
LW		 1130 case OP_GREPWHILE:
1131 case OP_OR:
1132 case OP_AND:
cea2e8a9 1133 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
11343788 1134 if (cLOGOPo->op_other)
f5992bc4 1135 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
79072805 1136 else
3967c732 1137 PerlIO_printf(file, "DONE\n");
79072805
LW		 1138 break;
1139 case OP_PUSHRE:
1140 case OP_MATCH:
8782bef2 1141 case OP_QR:
79072805 1142 case OP_SUBST:
3967c732 1143 do_pmop_dump(level, file, cPMOPo);
79072805 1144 break;
7934575e
GS		 1145 case OP_LEAVE:
1146 case OP_LEAVEEVAL:
1147 case OP_LEAVESUB:
1148 case OP_LEAVESUBLV:
1149 case OP_LEAVEWRITE:
1150 case OP_SCOPE:
1151 if (o->op_private & OPpREFCOUNTED)
1152 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1153 break;
a0d0e21e
LW		 1154 default:
1155 break;
79072805 1156 }
11343788 1157 if (o->op_flags & OPf_KIDS) {
79072805 1158 OP *kid;
11343788 1159 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3967c732 1160 do_op_dump(level, file, kid);
8d063cd8 1161 }
cea2e8a9 1162 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 1163}
1164
1165void
6867be6d 1166Perl_op_dump(pTHX_ const OP *o)
3967c732 1167{
7918f24d 1168 PERL_ARGS_ASSERT_OP_DUMP;
3967c732 1169 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW		 1170}
1171
8adcabd8 1172void
864dbfa3 1173Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1174{
17605be7 1175 SV *sv;
378cc40b 1176
7918f24d
NC		 1177 PERL_ARGS_ASSERT_GV_DUMP;
1178
79072805 1179 if (!gv) {
760ac839 1180 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW		 1181 return;
1182 }
8990e307 1183 sv = sv_newmortal();
760ac839 1184 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1185 gv_fullname3(sv, gv, NULL);
17605be7 1186 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
79072805 1187 if (gv != GvEGV(gv)) {
bd61b366 1188 gv_efullname3(sv, GvEGV(gv), NULL);
17605be7 1189 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
8adcabd8 1190 }
3967c732 1191 PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1192 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW		 1193}
1194
14befaf4 1195
afe38520 1196/* map magic types to the symbolic names
14befaf4
DM		 1197 * (with the PERL_MAGIC_ prefixed stripped)
1198 */
1199
27da23d5 1200static const struct { const char type; const char *name; } magic_names[] = {
52f49505 1201#include "mg_names.c"
516a5887 1202 /* this null string terminates the list */
b9ac451d 1203 { 0, NULL },
14befaf4
DM		 1204};
1205
8adcabd8 1206void
6867be6d 1207Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1208{
7918f24d
NC		 1209 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1210
3967c732 1211 for (; mg; mg = mg->mg_moremagic) {
b900a521
JH		 1212 Perl_dump_indent(aTHX_ level, file,
1213 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1214 if (mg->mg_virtual) {
bfed75c6 1215 const MGVTBL * const v = mg->mg_virtual;
2d1f1fe5
NC		 1216 if (v >= PL_magic_vtables
1217 && v < PL_magic_vtables + magic_vtable_max) {
1218 const U32 i = v - PL_magic_vtables;
1219 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1220 }
3967c732 1221 else
b900a521 1222 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732
JD		 1223 }
1224 else
cea2e8a9 1225 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1226
3967c732 1227 if (mg->mg_private)
cea2e8a9 1228 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1229
14befaf4
DM		 1230 {
1231 int n;
c445ea15 1232 const char *name = NULL;
27da23d5 1233 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM		 1234 if (mg->mg_type == magic_names[n].type) {
1235 name = magic_names[n].name;
1236 break;
1237 }
1238 }
1239 if (name)
1240 Perl_dump_indent(aTHX_ level, file,
1241 " MG_TYPE = PERL_MAGIC_%s\n", name);
1242 else
1243 Perl_dump_indent(aTHX_ level, file,
1244 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1245 }
3967c732
JD		 1246
1247 if (mg->mg_flags) {
cea2e8a9 1248 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST		 1249 if (mg->mg_type == PERL_MAGIC_envelem &&
1250 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1251 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
4c02285a
FR		 1252 if (mg->mg_type == PERL_MAGIC_regex_global &&
1253 mg->mg_flags & MGf_MINMATCH)
1254 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1255 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1256 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1257 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1258 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
4c02285a
FR		 1259 if (mg->mg_flags & MGf_COPY)
1260 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1261 if (mg->mg_flags & MGf_DUP)
1262 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1263 if (mg->mg_flags & MGf_LOCAL)
1264 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
3967c732
JD		 1265 }
1266 if (mg->mg_obj) {
4c02285a 1267 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
28d8d7f4
YO		 1268 PTR2UV(mg->mg_obj));
1269 if (mg->mg_type == PERL_MAGIC_qr) {
07bc277f 1270 REGEXP* const re = (REGEXP *)mg->mg_obj;
61f9802b 1271 SV * const dsv = sv_newmortal();
866c78d1 1272 const char * const s
4c02285a 1273 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
28d8d7f4 1274 60, NULL, NULL,
95b611b0 1275 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
3c8556c3 1276 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
28d8d7f4 1277 );
6483fb35
RGS		 1278 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1279 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
07bc277f 1280 (IV)RX_REFCNT(re));
28d8d7f4
YO		 1281 }
1282 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732
JD		 1283 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1284 }
1285 if (mg->mg_len)
894356b3 1286 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1287 if (mg->mg_ptr) {
b900a521 1288 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1289 if (mg->mg_len >= 0) {
7e8c5dac 1290 if (mg->mg_type != PERL_MAGIC_utf8) {
17605be7 1291 SV * const sv = newSVpvs("");
7e8c5dac 1292 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
17605be7 1293 SvREFCNT_dec_NN(sv);
7e8c5dac 1294 }
3967c732
JD		 1295 }
1296 else if (mg->mg_len == HEf_SVKEY) {
1297 PerlIO_puts(file, " => HEf_SVKEY\n");
ad64d0ec
NC		 1298 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1299 maxnest, dumpops, pvlim); /* MG is already +1 */
3967c732
JD		 1300 continue;
1301 }
866f9d6c 1302 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
3967c732 1303 else
866f9d6c
FC		 1304 PerlIO_puts(
1305 file,
1306 " ???? - " __FILE__
1307 " does not know how to handle this MG_LEN"
1308 );
3967c732
JD		 1309 PerlIO_putc(file, '\n');
1310 }
7e8c5dac 1311 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1312 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac
HS		 1313 if (cache) {
1314 IV i;
1315 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1316 Perl_dump_indent(aTHX_ level, file,
1317 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1318 i,
1319 (UV)cache[i * 2],
1320 (UV)cache[i * 2 + 1]);
1321 }
1322 }
378cc40b 1323 }
3967c732
JD		 1324}
1325
1326void
6867be6d 1327Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1328{
b9ac451d 1329 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD		 1330}
1331
1332void
e1ec3a88 1333Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1334{
bfcb3514 1335 const char *hvname;
7918f24d
NC		 1336
1337 PERL_ARGS_ASSERT_DO_HV_DUMP;
1338
b900a521 1339 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514 1340 if (sv && (hvname = HvNAME_get(sv)))
d7d51f4b
YO		 1341 {
1342 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1343 name which quite legally could contain insane things like tabs, newlines, nulls or
1344 other scary crap - this should produce sane results - except maybe for unicode package
1345 names - but we will wait for someone to file a bug on that - demerphq */
17605be7 1346 SV * const tmpsv = newSVpvs("");
d7d51f4b
YO		 1347 PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
1348 }
79072805 1349 else
3967c732
JD		 1350 PerlIO_putc(file, '\n');
1351}
1352
1353void
e1ec3a88 1354Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1355{
7918f24d
NC		 1356 PERL_ARGS_ASSERT_DO_GV_DUMP;
1357
b900a521 1358 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732
JD		 1359 if (sv && GvNAME(sv))
1360 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
c90c0ff4 1361 else
3967c732
JD		 1362 PerlIO_putc(file, '\n');
1363}
1364
1365void
e1ec3a88 1366Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1367{
7918f24d
NC		 1368 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1369
b900a521 1370 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1371 if (sv && GvNAME(sv)) {
bfcb3514 1372 const char *hvname;
17605be7
DM		 1373 PerlIO_printf(file, "\t\"");
1374 if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
1375 PerlIO_printf(file, "%s\" :: \"", hvname);
1376 PerlIO_printf(file, "%s\"\n", GvNAME(sv));
8d063cd8 1377 }
3967c732
JD		 1378 else
1379 PerlIO_putc(file, '\n');
1380}
1381
a0c2f4dd
NC		 1382const struct flag_to_name first_sv_flags_names[] = {
1383 {SVs_TEMP, "TEMP,"},
1384 {SVs_OBJECT, "OBJECT,"},
1385 {SVs_GMG, "GMG,"},
1386 {SVs_SMG, "SMG,"},
1387 {SVs_RMG, "RMG,"},
1388 {SVf_IOK, "IOK,"},
1389 {SVf_NOK, "NOK,"},
1390 {SVf_POK, "POK,"}
1391};
1392
1393const struct flag_to_name second_sv_flags_names[] = {
1394 {SVf_OOK, "OOK,"},
1395 {SVf_FAKE, "FAKE,"},
1396 {SVf_READONLY, "READONLY,"},
e3918bb7 1397 {SVf_IsCOW, "IsCOW,"},
a0c2f4dd
NC		 1398 {SVf_BREAK, "BREAK,"},
1399 {SVf_AMAGIC, "OVERLOAD,"},
1400 {SVp_IOK, "pIOK,"},
1401 {SVp_NOK, "pNOK,"},
1402 {SVp_POK, "pPOK,"}
1403};
1404
ae1f06a1
NC		 1405const struct flag_to_name cv_flags_names[] = {
1406 {CVf_ANON, "ANON,"},
1407 {CVf_UNIQUE, "UNIQUE,"},
1408 {CVf_CLONE, "CLONE,"},
1409 {CVf_CLONED, "CLONED,"},
1410 {CVf_CONST, "CONST,"},
1411 {CVf_NODEBUG, "NODEBUG,"},
1412 {CVf_LVALUE, "LVALUE,"},
1413 {CVf_METHOD, "METHOD,"},
cfc1e951 1414 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
31d45e0c 1415 {CVf_CVGV_RC, "CVGV_RC,"},
bad4ae38 1416 {CVf_DYNFILE, "DYNFILE,"},
8fa6a409 1417 {CVf_AUTOLOAD, "AUTOLOAD,"},
55f7f8ab 1418 {CVf_HASEVAL, "HASEVAL"},
bfbc3ad9 1419 {CVf_SLABBED, "SLABBED,"},
31d45e0c 1420 {CVf_ISXSUB, "ISXSUB,"}
ae1f06a1
NC		 1421};
1422
1423const struct flag_to_name hv_flags_names[] = {
1424 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1425 {SVphv_LAZYDEL, "LAZYDEL,"},
1426 {SVphv_HASKFLAGS, "HASKFLAGS,"},
ae1f06a1
NC		 1427 {SVphv_CLONEABLE, "CLONEABLE,"}
1428};
1429
1430const struct flag_to_name gp_flags_names[] = {
1431 {GVf_INTRO, "INTRO,"},
1432 {GVf_MULTI, "MULTI,"},
1433 {GVf_ASSUMECV, "ASSUMECV,"},
1434 {GVf_IN_PAD, "IN_PAD,"}
1435};
1436
1437const struct flag_to_name gp_flags_imported_names[] = {
1438 {GVf_IMPORTED_SV, " SV"},
1439 {GVf_IMPORTED_AV, " AV"},
1440 {GVf_IMPORTED_HV, " HV"},
1441 {GVf_IMPORTED_CV, " CV"},
1442};
1443
d63e6659
DM		 1444const struct flag_to_name regexp_flags_names[] = {
1445 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1446 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1447 {RXf_PMf_FOLD, "PMf_FOLD,"},
1448 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1449 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
1450 {RXf_ANCH_BOL, "ANCH_BOL,"},
1451 {RXf_ANCH_MBOL, "ANCH_MBOL,"},
1452 {RXf_ANCH_SBOL, "ANCH_SBOL,"},
1453 {RXf_ANCH_GPOS, "ANCH_GPOS,"},
1454 {RXf_GPOS_SEEN, "GPOS_SEEN,"},
1455 {RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
dbc200c5 1456 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
d63e6659
DM		 1457 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
1458 {RXf_CANY_SEEN, "CANY_SEEN,"},
1459 {RXf_NOSCAN, "NOSCAN,"},
1460 {RXf_CHECK_ALL, "CHECK_ALL,"},
1461 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1462 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1463 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1464 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
dbc200c5 1465 {RXf_SPLIT, "SPLIT,"},
d63e6659
DM		 1466 {RXf_COPY_DONE, "COPY_DONE,"},
1467 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1468 {RXf_TAINTED, "TAINTED,"},
1469 {RXf_START_ONLY, "START_ONLY,"},
dbc200c5 1470 {RXf_SKIPWHITE, "SKIPWHITE,"},
d63e6659
DM		 1471 {RXf_WHITE, "WHITE,"},
1472 {RXf_NULL, "NULL,"},
1473};
1474
3967c732 1475void
864dbfa3 1476Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1477{
97aff369 1478 dVAR;
cea89e20 1479 SV *d;
e1ec3a88 1480 const char *s;
3967c732
JD		 1481 U32 flags;
1482 U32 type;
1483
7918f24d
NC		 1484 PERL_ARGS_ASSERT_DO_SV_DUMP;
1485
3967c732 1486 if (!sv) {
cea2e8a9 1487 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1488 return;
378cc40b 1489 }
2ef28da1 1490
3967c732
JD		 1491 flags = SvFLAGS(sv);
1492 type = SvTYPE(sv);
79072805 1493
e0bbf362
DM		 1494 /* process general SV flags */
1495
cea89e20 1496 d = Perl_newSVpvf(aTHX_
57def98f 1497 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1498 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS		 1499 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1500 (int)(PL_dumpindent*level), "");
8d063cd8 1501
1979170b
NC		 1502 if (!((flags & SVpad_NAME) == SVpad_NAME
1503 && (type == SVt_PVMG || type == SVt_PVNV))) {
9a214eec
DM		 1504 if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1505 sv_catpv(d, "PADSTALE,");
e604303a 1506 }
1979170b 1507 if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
9a214eec
DM		 1508 if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1509 sv_catpv(d, "PADTMP,");
e604303a
NC		 1510 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1511 }
a0c2f4dd 1512 append_flags(d, flags, first_sv_flags_names);
810b8aa5
GS		 1513 if (flags & SVf_ROK) {
1514 sv_catpv(d, "ROK,");
1515 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1516 }
a0c2f4dd 1517 append_flags(d, flags, second_sv_flags_names);
1ccdb730
NC		 1518 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
1519 if (SvPCS_IMPORTED(sv))
1520 sv_catpv(d, "PCS_IMPORTED,");
1521 else
9660f481 1522 sv_catpv(d, "SCREAM,");
1ccdb730 1523 }
3967c732 1524
e0bbf362
DM		 1525 /* process type-specific SV flags */
1526
3967c732
JD		 1527 switch (type) {
1528 case SVt_PVCV:
1529 case SVt_PVFM:
ae1f06a1 1530 append_flags(d, CvFLAGS(sv), cv_flags_names);
3967c732
JD		 1531 break;
1532 case SVt_PVHV:
ae1f06a1 1533 append_flags(d, flags, hv_flags_names);
3967c732 1534 break;
926fc7b6
DM		 1535 case SVt_PVGV:
1536 case SVt_PVLV:
1537 if (isGV_with_GP(sv)) {
ae1f06a1 1538 append_flags(d, GvFLAGS(sv), gp_flags_names);
926fc7b6 1539 }
926fc7b6 1540 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD		 1541 sv_catpv(d, "IMPORT");
1542 if (GvIMPORTED(sv) == GVf_IMPORTED)
1543 sv_catpv(d, "ALL,");
1544 else {
1545 sv_catpv(d, "(");
ae1f06a1 1546 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
3967c732
JD		 1547 sv_catpv(d, " ),");
1548 }
1549 }
addd1794 1550 /* FALL THROUGH */
25da4f38 1551 default:
e604303a 1552 evaled_or_uv:
25da4f38 1553 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1554 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1555 break;
addd1794 1556 case SVt_PVMG:
c13a5c80
NC		 1557 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1558 if (SvVALID(sv)) sv_catpv(d, "VALID,");
00b1698f 1559 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1560 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
2e94196c 1561 /* FALL THROUGH */
e604303a
NC		 1562 case SVt_PVNV:
1563 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1564 goto evaled_or_uv;
11ca45c0
NC		 1565 case SVt_PVAV:
1566 break;
3967c732 1567 }
86f0d186
NC		 1568 /* SVphv_SHAREKEYS is also 0x20000000 */
1569 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1570 sv_catpv(d, "UTF8");
3967c732 1571
b162af07
SP		 1572 if (*(SvEND(d) - 1) == ',') {
1573 SvCUR_set(d, SvCUR(d) - 1);
1574 SvPVX(d)[SvCUR(d)] = '\0';
1575 }
3967c732 1576 sv_catpv(d, ")");
b15aece3 1577 s = SvPVX_const(d);
3967c732 1578
e0bbf362
DM		 1579 /* dump initial SV details */
1580
fd0854ff 1581#ifdef DEBUG_LEAKING_SCALARS
cbe56f1d 1582 Perl_dump_indent(aTHX_ level, file,
cd676548 1583 "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
fd0854ff
DM		 1584 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1585 sv->sv_debug_line,
1586 sv->sv_debug_inpad ? "for" : "by",
1587 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
cd676548 1588 PTR2UV(sv->sv_debug_parent),
cbe56f1d
DM		 1589 sv->sv_debug_serial
1590 );
fd0854ff 1591#endif
cea2e8a9 1592 Perl_dump_indent(aTHX_ level, file, "SV = ");
e0bbf362
DM		 1593
1594 /* Dump SV type */
1595
5357ca29
NC		 1596 if (type < SVt_LAST) {
1597 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1598
1599 if (type == SVt_NULL) {
5f954473 1600 SvREFCNT_dec_NN(d);
5357ca29
NC		 1601 return;
1602 }
1603 } else {
faccc32b 1604 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
5f954473 1605 SvREFCNT_dec_NN(d);
3967c732
JD		 1606 return;
1607 }
e0bbf362
DM		 1608
1609 /* Dump general SV fields */
1610
27bd069f 1611 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
0a0c4b76
NC		 1612 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1613 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
4df7f6af 1614 || (type == SVt_IV && !SvROK(sv))) {
765f542d 1615 if (SvIsUV(sv)
f8c7b90f 1616#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1617 || SvIsCOW(sv)
1618#endif
1619 )
57def98f 1620 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1621 else
57def98f 1622 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
f8c7b90f 1623#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1624 if (SvIsCOW_shared_hash(sv))
1625 PerlIO_printf(file, " (HASH)");
1626 else if (SvIsCOW_normal(sv))
1627 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1628#endif
3967c732
JD		 1629 PerlIO_putc(file, '\n');
1630 }
e0bbf362 1631
1979170b
NC		 1632 if ((type == SVt_PVNV || type == SVt_PVMG)
1633 && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
0e4c4423
NC		 1634 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1635 (UV) COP_SEQ_RANGE_LOW(sv));
1636 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1637 (UV) COP_SEQ_RANGE_HIGH(sv));
1638 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
08e44740 1639 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
c0a413d1 1640 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
0e4c4423 1641 || type == SVt_NV) {
e54dc35b 1642 STORE_NUMERIC_LOCAL_SET_STANDARD();
57def98f 1643 /* %Vg doesn't work? --jhi */
cf2093f6 1644#ifdef USE_LONG_DOUBLE
2d4389e4 1645 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
cf2093f6 1646#else
cea2e8a9 1647 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
cf2093f6 1648#endif
e54dc35b 1649 RESTORE_NUMERIC_LOCAL();
3967c732 1650 }
e0bbf362 1651
3967c732 1652 if (SvROK(sv)) {
57def98f 1653 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732
JD		 1654 if (nest < maxnest)
1655 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1656 }
e0bbf362 1657
cea89e20 1658 if (type < SVt_PV) {
5f954473 1659 SvREFCNT_dec_NN(d);
3967c732 1660 return;
cea89e20 1661 }
e0bbf362 1662
5a3c7349
FC		 1663 if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1664 || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
8d919b0a
FC		 1665 const bool re = isREGEXP(sv);
1666 const char * const ptr =
1667 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1668 if (ptr) {
69240efd 1669 STRLEN delta;
7a4bba22 1670 if (SvOOK(sv)) {
69240efd 1671 SvOOK_offset(sv, delta);
7a4bba22 1672 Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
5186cc12 1673 (UV) delta);
69240efd
NC		 1674 } else {
1675 delta = 0;
7a4bba22 1676 }
8d919b0a 1677 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
7a4bba22
NC		 1678 if (SvOOK(sv)) {
1679 PerlIO_printf(file, "( %s . ) ",
8d919b0a 1680 pv_display(d, ptr - delta, delta, 0,
7a4bba22
NC		 1681 pvlim));
1682 }
8d919b0a
FC		 1683 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1684 re ? 0 : SvLEN(sv),
1685 pvlim));
e9569a7a
GG		 1686 if (SvUTF8(sv)) /* the 6? \x{....} */
1687 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
e6abe6d8 1688 PerlIO_printf(file, "\n");
57def98f 1689 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
8d919b0a
FC		 1690 if (!re)
1691 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1692 (IV)SvLEN(sv));
db2c6cb3
FC		 1693#ifdef PERL_NEW_COPY_ON_WRITE
1694 if (SvIsCOW(sv) && SvLEN(sv))
1695 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1696 CowREFCNT(sv));
1697#endif
3967c732
JD		 1698 }
1699 else
cea2e8a9 1700 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1701 }
e0bbf362 1702
3967c732 1703 if (type >= SVt_PVMG) {
0e4c4423 1704 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
61f9802b 1705 HV * const ost = SvOURSTASH(sv);
38cbaf55
RGS		 1706 if (ost)
1707 do_hv_dump(level, file, " OURSTASH", ost);
0e4c4423
NC		 1708 } else {
1709 if (SvMAGIC(sv))
8530ff28 1710 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
0e4c4423 1711 }
3967c732
JD		 1712 if (SvSTASH(sv))
1713 do_hv_dump(level, file, " STASH", SvSTASH(sv));
c13a5c80
NC		 1714
1715 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
c13a5c80
NC		 1716 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1717 }
3967c732 1718 }
e0bbf362
DM		 1719
1720 /* Dump type-specific SV fields */
1721
3967c732 1722 switch (type) {
3967c732 1723 case SVt_PVAV:
57def98f 1724 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1725 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f
JH		 1726 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1727 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732
JD		 1728 }
1729 else
1730 PerlIO_putc(file, '\n');
57def98f
JH		 1731 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1732 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
a3874608 1733 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
76f68e9b 1734 sv_setpvs(d, "");
11ca45c0
NC		 1735 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1736 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP		 1737 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1738 SvCUR(d) ? SvPVX_const(d) + 1 : "");
502c6561 1739 if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
3967c732 1740 int count;
502c6561
NC		 1741 for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
1742 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
3967c732 1743
57def98f 1744 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1745 if (elt)
3967c732
JD		 1746 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1747 }
1748 }
1749 break;
1750 case SVt_PVHV:
57def98f 1751 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1b95d04f 1752 if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
3967c732
JD		 1753 /* Show distribution of HEs in the ARRAY */
1754 int freq[200];
bb7a0f54 1755#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
3967c732
JD		 1756 int i;
1757 int max = 0;
1b95d04f 1758 U32 pow2 = 2, keys = HvUSEDKEYS(sv);
65202027 1759 NV theoret, sum = 0;
3967c732
JD		 1760
1761 PerlIO_printf(file, " (");
1762 Zero(freq, FREQ_MAX + 1, int);
eb160463 1763 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL		 1764 HE* h;
1765 int count = 0;
3967c732
JD		 1766 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1767 count++;
1768 if (count > FREQ_MAX)
1769 count = FREQ_MAX;
1770 freq[count]++;
1771 if (max < count)
1772 max = count;
1773 }
1774 for (i = 0; i <= max; i++) {
1775 if (freq[i]) {
1776 PerlIO_printf(file, "%d%s:%d", i,
1777 (i == FREQ_MAX) ? "+" : "",
1778 freq[i]);
1779 if (i != max)
1780 PerlIO_printf(file, ", ");
1781 }
1782 }
1783 PerlIO_putc(file, ')');
b8fa94d8
MG		 1784 /* The "quality" of a hash is defined as the total number of
1785 comparisons needed to access every element once, relative
1786 to the expected number needed for a random hash.
1787
1788 The total number of comparisons is equal to the sum of
e76cd0fa
AMS		 1789 the squares of the number of entries in each bucket.
1790 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG		 1791 value is
1792 n + n(n-1)/2k
1793 */
1794
3967c732
JD		 1795 for (i = max; i > 0; i--) { /* Precision: count down. */
1796 sum += freq[i] * i * i;
1797 }
155aba94 1798 while ((keys = keys >> 1))
3967c732 1799 pow2 = pow2 << 1;
1b95d04f 1800 theoret = HvUSEDKEYS(sv);
b8fa94d8 1801 theoret += theoret * (theoret-1)/pow2;
3967c732 1802 PerlIO_putc(file, '\n');
6b4667fc 1803 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732
JD		 1804 }
1805 PerlIO_putc(file, '\n');
1b95d04f 1806 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
9faf471a
NC		 1807 {
1808 STRLEN count = 0;
1809 HE **ents = HvARRAY(sv);
1810
1811 if (ents) {
1812 HE *const *const last = ents + HvMAX(sv);
1813 count = last + 1 - ents;
1814
1815 do {
1816 if (!*ents)
1817 --count;
1818 } while (++ents <= last);
1819 }
1820
1821 if (SvOOK(sv)) {
1822 struct xpvhv_aux *const aux = HvAUX(sv);
1823 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1824 " (cached = %"UVuf")\n",
1825 (UV)count, (UV)aux->xhv_fill_lazy);
1826 } else {
1827 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1828 (UV)count);
1829 }
1830 }
57def98f 1831 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
e1a7ec8d
YO		 1832 if (SvOOK(sv)) {
1833 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1834 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
6a5b4183 1835#ifdef PERL_HASH_RANDOMIZE_KEYS
e1a7ec8d
YO		 1836 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1837 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
6a5b4183 1838 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
e1a7ec8d 1839 }
6a5b4183
YO		 1840#endif
1841 PerlIO_putc(file, '\n');
e1a7ec8d 1842 }
8d2f4536 1843 {
b9ac451d 1844 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536
NC		 1845 if (mg && mg->mg_obj) {
1846 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1847 }
1848 }
bfcb3514 1849 {
b9ac451d 1850 const char * const hvname = HvNAME_get(sv);
17605be7
DM		 1851 if (hvname)
1852 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
bfcb3514 1853 }
86f55936 1854 if (SvOOK(sv)) {
ad64d0ec 1855 AV * const backrefs
85fbaab2 1856 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
7d88e6c4 1857 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
67e04715
FC		 1858 if (HvAUX(sv)->xhv_name_count)
1859 Perl_dump_indent(aTHX_
7afc2217
FC		 1860 level, file, " NAMECOUNT = %"IVdf"\n",
1861 (IV)HvAUX(sv)->xhv_name_count
67e04715 1862 );
15d9236d 1863 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
ec3405c8
NC		 1864 const I32 count = HvAUX(sv)->xhv_name_count;
1865 if (count) {
1866 SV * const names = newSVpvs_flags("", SVs_TEMP);
1867 /* The starting point is the first element if count is
1868 positive and the second element if count is negative. */
1869 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1870 + (count < 0 ? 1 : 0);
1871 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1872 + (count < 0 ? -count : count);
1873 while (hekp < endp) {
17605be7
DM		 1874 if (*hekp) {
1875 sv_catpvs(names, ", \"");
1876 sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp));
1877 sv_catpvs(names, "\"");
ec3405c8
NC		 1878 } else {
1879 /* This should never happen. */
1880 sv_catpvs(names, ", (null)");
67e04715 1881 }
ec3405c8
NC		 1882 ++hekp;
1883 }
67e04715
FC		 1884 Perl_dump_indent(aTHX_
1885 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1886 );
1887 }
17605be7 1888 else
67e04715 1889 Perl_dump_indent(aTHX_
17605be7
DM		 1890 level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
1891 );
67e04715 1892 }
86f55936
NC		 1893 if (backrefs) {
1894 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1895 PTR2UV(backrefs));
ad64d0ec 1896 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
86f55936
NC		 1897 dumpops, pvlim);
1898 }
7d88e6c4
NC		 1899 if (meta) {
1900 /* FIXME - mro_algs kflags can signal a UTF-8 name. */
1901 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
1902 (int)meta->mro_which->length,
1903 meta->mro_which->name,
1904 PTR2UV(meta->mro_which));
1905 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1906 (UV)meta->cache_gen);
1907 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
1908 (UV)meta->pkg_gen);
1909 if (meta->mro_linear_all) {
1910 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
1911 PTR2UV(meta->mro_linear_all));
1912 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1913 dumpops, pvlim);
1914 }
1915 if (meta->mro_linear_current) {
1916 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1917 PTR2UV(meta->mro_linear_current));
1918 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1919 dumpops, pvlim);
1920 }
1921 if (meta->mro_nextmethod) {
1922 Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
1923 PTR2UV(meta->mro_nextmethod));
1924 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1925 dumpops, pvlim);
1926 }
1927 if (meta->isa) {
1928 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
1929 PTR2UV(meta->isa));
1930 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1931 dumpops, pvlim);
1932 }
1933 }
86f55936 1934 }
b5698553 1935 if (nest < maxnest) {
cbab3169 1936 HV * const hv = MUTABLE_HV(sv);
b5698553
TH		 1937 STRLEN i;
1938 HE *he;
cbab3169 1939
b5698553
TH		 1940 if (HvARRAY(hv)) {
1941 int count = maxnest - nest;
1942 for (i=0; i <= HvMAX(hv); i++) {
1943 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1944 U32 hash;
1945 SV * keysv;
1946 const char * keypv;
1947 SV * elt;
7dc86639 1948 STRLEN len;
b5698553
TH		 1949
1950 if (count-- <= 0) goto DONEHV;
1951
1952 hash = HeHASH(he);
1953 keysv = hv_iterkeysv(he);
1954 keypv = SvPV_const(keysv, len);
1955 elt = HeVAL(he);
cbab3169 1956
7dc86639
YO		 1957 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1958 if (SvUTF8(keysv))
1959 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
b5698553
TH		 1960 if (HvEITER_get(hv) == he)
1961 PerlIO_printf(file, "[CURRENT] ");
7dc86639
YO		 1962 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1963 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1964 }
b5698553
TH		 1965 }
1966 DONEHV:;
1967 }
3967c732
JD		 1968 }
1969 break;
e0bbf362 1970
3967c732 1971 case SVt_PVCV:
8fa6a409 1972 if (CvAUTOLOAD(sv)) {
cbf82dd0 1973 STRLEN len;
8fa6a409
FC		 1974 const char *const name = SvPV_const(sv, len);
1975 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%.*s\"\n",
1976 (int) len, name);
1977 }
1978 if (SvPOK(sv)) {
cbf82dd0 1979 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
8fa6a409 1980 (int) CvPROTOLEN(sv), CvPROTO(sv));
cbf82dd0 1981 }
3967c732
JD		 1982 /* FALL THROUGH */
1983 case SVt_PVFM:
1984 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC		 1985 if (!CvISXSUB(sv)) {
1986 if (CvSTART(sv)) {
1987 Perl_dump_indent(aTHX_ level, file,
1988 " START = 0x%"UVxf" ===> %"IVdf"\n",
1989 PTR2UV(CvSTART(sv)),
1990 (IV)sequence_num(CvSTART(sv)));
1991 }
1992 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
1993 PTR2UV(CvROOT(sv)));
1994 if (CvROOT(sv) && dumpops) {
1995 do_op_dump(level+1, file, CvROOT(sv));
1996 }
1997 } else {
126f53f3 1998 SV * const constant = cv_const_sv((const CV *)sv);
b1886099 1999
d04ba589 2000 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099
NC		 2001
2002 if (constant) {
2003 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
2004 " (CONST SV)\n",
2005 PTR2UV(CvXSUBANY(sv).any_ptr));
2006 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2007 pvlim);
2008 } else {
2009 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
2010 (IV)CvXSUBANY(sv).any_i32);
2011 }
2012 }
3610c89f
FC		 2013 if (CvNAMED(sv))
2014 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2015 HEK_KEY(CvNAME_HEK((CV *)sv)));
2016 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 2017 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
bb02a38f 2018 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 2019 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 2020 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
57def98f 2021 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4
DM		 2022 if (nest < maxnest) {
2023 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732
JD		 2024 }
2025 {
b9ac451d 2026 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 2027 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 2028 PTR2UV(outside),
cf2093f6
JH		 2029 (!outside ? "null"
2030 : CvANON(outside) ? "ANON"
2031 : (outside == PL_main_cv) ? "MAIN"
2032 : CvUNIQUE(outside) ? "UNIQUE"
2033 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
3967c732
JD		 2034 }
2035 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
ad64d0ec 2036 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
3967c732 2037 break;
e0bbf362 2038
926fc7b6
DM		 2039 case SVt_PVGV:
2040 case SVt_PVLV:
b9ac451d
AL		 2041 if (type == SVt_PVLV) {
2042 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2043 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2044 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2045 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
83f78d1a 2046 Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
b9ac451d
AL		 2047 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2048 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2049 dumpops, pvlim);
2050 }
8d919b0a 2051 if (isREGEXP(sv)) goto dumpregexp;
926fc7b6
DM		 2052 if (!isGV_with_GP(sv))
2053 break;
cea2e8a9 2054 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
57def98f 2055 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 2056 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
57def98f 2057 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c
GS		 2058 if (!GvGP(sv))
2059 break;
57def98f
JH		 2060 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2061 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2062 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2063 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2064 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2065 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2066 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2067 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 2068 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 2069 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
e39917cc 2070 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
3967c732
JD		 2071 do_gv_dump (level, file, " EGV", GvEGV(sv));
2072 break;
2073 case SVt_PVIO:
57def98f
JH		 2074 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2075 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2076 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2077 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2078 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2079 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2080 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 2081 if (IoTOP_NAME(sv))
cea2e8a9 2082 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC		 2083 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2084 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2085 else {
2086 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2087 PTR2UV(IoTOP_GV(sv)));
ad64d0ec
NC		 2088 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2089 maxnest, dumpops, pvlim);
9ba1f565
NC		 2090 }
2091 /* Source filters hide things that are not GVs in these three, so let's
2092 be careful out there. */
27533608 2093 if (IoFMT_NAME(sv))
cea2e8a9 2094 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC		 2095 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2096 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2097 else {
2098 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2099 PTR2UV(IoFMT_GV(sv)));
ad64d0ec
NC		 2100 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2101 maxnest, dumpops, pvlim);
9ba1f565 2102 }
27533608 2103 if (IoBOTTOM_NAME(sv))
cea2e8a9 2104 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC		 2105 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2106 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2107 else {
2108 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2109 PTR2UV(IoBOTTOM_GV(sv)));
ad64d0ec
NC		 2110 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2111 maxnest, dumpops, pvlim);
9ba1f565 2112 }
27533608 2113 if (isPRINT(IoTYPE(sv)))
cea2e8a9 2114 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 2115 else
cea2e8a9 2116 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 2117 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732 2118 break;
206ee256 2119 case SVt_REGEXP:
8d919b0a 2120 dumpregexp:
d63e6659 2121 {
8d919b0a 2122 struct regexp * const r = ReANY((REGEXP*)sv);
ec16d31f
YO		 2123#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
2124 sv_setpv(d,""); \
2125 append_flags(d, flags, regexp_flags_names); \
2126 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2127 SvCUR_set(d, SvCUR(d) - 1); \
2128 SvPVX(d)[SvCUR(d)] = '\0'; \
2129 } \
2130} STMT_END
2131 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
dbc200c5
YO		 2132 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2133 (UV)(r->compflags), SvPVX_const(d));
2134
ec16d31f 2135 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
d63e6659 2136 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
dbc200c5 2137 (UV)(r->extflags), SvPVX_const(d));
ec16d31f 2138#undef SV_SET_STRINGIFY_REGEXP_FLAGS
dbc200c5 2139
d63e6659
DM		 2140 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
2141 (UV)(r->intflags));
2142 Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2143 (UV)(r->nparens));
2144 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2145 (UV)(r->lastparen));
2146 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2147 (UV)(r->lastcloseparen));
2148 Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2149 (IV)(r->minlen));
2150 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2151 (IV)(r->minlenret));
2152 Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2153 (UV)(r->gofs));
2154 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2155 (UV)(r->pre_prefix));
d63e6659
DM		 2156 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2157 (IV)(r->sublen));
6502e081
DM		 2158 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2159 (IV)(r->suboffset));
2160 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2161 (IV)(r->subcoffset));
d63e6659
DM		 2162 if (r->subbeg)
2163 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2164 PTR2UV(r->subbeg),
2165 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2166 else
2167 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
2168 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
2169 PTR2UV(r->engine));
2170 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2171 PTR2UV(r->mother_re));
2172 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2173 PTR2UV(r->paren_names));
2174 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2175 PTR2UV(r->substrs));
2176 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2177 PTR2UV(r->pprivate));
2178 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2179 PTR2UV(r->offs));
d63c20f2
DM		 2180 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2181 PTR2UV(r->qr_anoncv));
db2c6cb3 2182#ifdef PERL_ANY_COW
d63e6659
DM		 2183 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2184 PTR2UV(r->saved_copy));
2185#endif
2186 }
206ee256 2187 break;
3967c732 2188 }
5f954473 2189 SvREFCNT_dec_NN(d);
3967c732
JD		 2190}
2191
2192void
864dbfa3 2193Perl_sv_dump(pTHX_ SV *sv)
3967c732 2194{
97aff369 2195 dVAR;
7918f24d
NC		 2196
2197 PERL_ARGS_ASSERT_SV_DUMP;
2198
d1029faa
JP		 2199 if (SvROK(sv))
2200 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2201 else
2202 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 2203}
bd16a5f0
IZ		 2204
2205int
2206Perl_runops_debug(pTHX)
2207{
97aff369 2208 dVAR;
bd16a5f0 2209 if (!PL_op) {
9b387841 2210 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ		 2211 return 0;
2212 }
2213
9f3673fb 2214 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 2215 do {
75d476e2
S		 2216#ifdef PERL_TRACE_OPS
2217 ++PL_op_exec_cnt[PL_op->op_type];
2218#endif
bd16a5f0 2219 if (PL_debug) {
b9ac451d 2220 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0
IZ		 2221 PerlIO_printf(Perl_debug_log,
2222 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2223 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2224 PTR2UV(*PL_watchaddr));
d6721266
DM		 2225 if (DEBUG_s_TEST_) {
2226 if (DEBUG_v_TEST_) {
2227 PerlIO_printf(Perl_debug_log, "\n");
2228 deb_stack_all();
2229 }
2230 else
2231 debstack();
2232 }
2233
2234
bd16a5f0
IZ		 2235 if (DEBUG_t_TEST_) debop(PL_op);
2236 if (DEBUG_P_TEST_) debprof(PL_op);
2237 }
fe83c362
SM		 2238
2239 OP_ENTRY_PROBE(OP_NAME(PL_op));
16c91539 2240 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
9f3673fb 2241 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
47c9d59f 2242 PERL_ASYNC_CHECK();
bd16a5f0
IZ		 2243
2244 TAINT_NOT;
2245 return 0;
2246}
2247
2248I32
6867be6d 2249Perl_debop(pTHX_ const OP *o)
bd16a5f0 2250{
97aff369 2251 dVAR;
7918f24d
NC		 2252
2253 PERL_ARGS_ASSERT_DEBOP;
2254
1045810a
IZ		 2255 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2256 return 0;
2257
bd16a5f0
IZ		 2258 Perl_deb(aTHX_ "%s", OP_NAME(o));
2259 switch (o->op_type) {
2260 case OP_CONST:
996c9baa 2261 case OP_HINTSEVAL:
6cefa69e 2262 /* With ITHREADS, consts are stored in the pad, and the right pad
7367e658 2263 * may not be active here, so check.
6cefa69e 2264 * Looks like only during compiling the pads are illegal.
7367e658 2265 */
6cefa69e
RU		 2266#ifdef USE_ITHREADS
2267 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2268#endif
7367e658 2269 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
bd16a5f0
IZ		 2270 break;
2271 case OP_GVSV:
2272 case OP_GV:
2273 if (cGVOPo_gv) {
b9ac451d 2274 SV * const sv = newSV(0);
3b721df9 2275#ifdef PERL_MAD
84021b46 2276 /* FIXME - is this making unwarranted assumptions about the
3b721df9
NC		 2277 UTF-8 cleanliness of the dump file handle? */
2278 SvUTF8_on(sv);
2279#endif
bd61b366 2280 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 2281 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
5f954473 2282 SvREFCNT_dec_NN(sv);
bd16a5f0
IZ		 2283 }
2284 else
2285 PerlIO_printf(Perl_debug_log, "(NULL)");
2286 break;
a7fd8ef6
DM		 2287
2288 {
2289 int count;
2290
bd16a5f0
IZ		 2291 case OP_PADSV:
2292 case OP_PADAV:
2293 case OP_PADHV:
a7fd8ef6
DM		 2294 count = 1;
2295 goto dump_padop;
2296 case OP_PADRANGE:
2297 count = o->op_private & OPpPADRANGE_COUNTMASK;
2298 dump_padop:
bd16a5f0 2299 /* print the lexical's name */
a7fd8ef6
DM		 2300 {
2301 CV * const cv = deb_curcv(cxstack_ix);
2302 SV *sv;
2303 PAD * comppad = NULL;
2304 int i;
2305
2306 if (cv) {
2307 PADLIST * const padlist = CvPADLIST(cv);
2308 comppad = *PadlistARRAY(padlist);
2309 }
2310 PerlIO_printf(Perl_debug_log, "(");
2311 for (i = 0; i < count; i++) {
2312 if (comppad &&
2313 (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2314 PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2315 else
2316 PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2317 (UV)o->op_targ+i);
2318 if (i < count-1)
2319 PerlIO_printf(Perl_debug_log, ",");
2320 }
2321 PerlIO_printf(Perl_debug_log, ")");
2322 }
bd16a5f0 2323 break;
a7fd8ef6
DM		 2324 }
2325
bd16a5f0 2326 default:
091ab601 2327 break;
bd16a5f0
IZ		 2328 }
2329 PerlIO_printf(Perl_debug_log, "\n");
2330 return 0;
2331}
2332
2333STATIC CV*
61f9802b 2334S_deb_curcv(pTHX_ const I32 ix)
bd16a5f0 2335{
97aff369 2336 dVAR;
b9ac451d 2337 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0
IZ		 2338 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2339 return cx->blk_sub.cv;
2340 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
676a678a 2341 return cx->blk_eval.cv;
bd16a5f0
IZ		 2342 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2343 return PL_main_cv;
2344 else if (ix <= 0)
601f1833 2345 return NULL;
bd16a5f0
IZ		 2346 else
2347 return deb_curcv(ix - 1);
2348}
2349
2350void
2351Perl_watch(pTHX_ char **addr)
2352{
97aff369 2353 dVAR;
7918f24d
NC		 2354
2355 PERL_ARGS_ASSERT_WATCH;
2356
bd16a5f0
IZ		 2357 PL_watchaddr = addr;
2358 PL_watchok = *addr;
2359 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2360 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2361}
2362
2363STATIC void
e1ec3a88 2364S_debprof(pTHX_ const OP *o)
bd16a5f0 2365{
97aff369 2366 dVAR;
7918f24d
NC		 2367
2368 PERL_ARGS_ASSERT_DEBPROF;
2369
61f9802b 2370 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2371 return;
bd16a5f0 2372 if (!PL_profiledata)
a02a5408 2373 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ		 2374 ++PL_profiledata[o->op_type];
2375}
2376
2377void
2378Perl_debprofdump(pTHX)
2379{
97aff369 2380 dVAR;
bd16a5f0
IZ		 2381 unsigned i;
2382 if (!PL_profiledata)
2383 return;
2384 for (i = 0; i < MAXO; i++) {
2385 if (PL_profiledata[i])
2386 PerlIO_printf(Perl_debug_log,
2387 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2388 PL_op_name[i]);
2389 }
2390}
66610fdd 2391
3b721df9
NC		 2392#ifdef PERL_MAD
2393/*
2394 * XML variants of most of the above routines
2395 */
2396
4136a0f7 2397STATIC void
3b721df9
NC		 2398S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2399{
2400 va_list args;
7918f24d
NC		 2401
2402 PERL_ARGS_ASSERT_XMLDUMP_ATTR;
2403
3b721df9
NC		 2404 PerlIO_printf(file, "\n ");
2405 va_start(args, pat);
2406 xmldump_vindent(level, file, pat, &args);
2407 va_end(args);
2408}
2409
2410
2411void
2412Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2413{
2414 va_list args;
7918f24d 2415 PERL_ARGS_ASSERT_XMLDUMP_INDENT;
3b721df9
NC		 2416 va_start(args, pat);
2417 xmldump_vindent(level, file, pat, &args);
2418 va_end(args);
2419}
2420
2421void
2422Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
2423{
7918f24d
NC		 2424 PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
2425
3b721df9
NC		 2426 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
2427 PerlIO_vprintf(file, pat, *args);
2428}
2429
2430void
2431Perl_xmldump_all(pTHX)
2432{
f0e3f042
CS		 2433 xmldump_all_perl(FALSE);
2434}
2435
2436void
0190d5ef 2437Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
f0e3f042 2438{
3b721df9
NC		 2439 PerlIO_setlinebuf(PL_xmlfp);
2440 if (PL_main_root)
2441 op_xmldump(PL_main_root);
0190d5ef
CS		 2442 /* someday we might call this, when it outputs XML: */
2443 /* xmldump_packsubs_perl(PL_defstash, justperl); */
3b721df9
NC		 2444 if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2445 PerlIO_close(PL_xmlfp);
2446 PL_xmlfp = 0;
2447}
2448
2449void
2450Perl_xmldump_packsubs(pTHX_ const HV *stash)
2451{
28eb953d 2452 PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
3ab0c9fa
NC		 2453 xmldump_packsubs_perl(stash, FALSE);
2454}
2455
2456void
2457Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
2458{
3b721df9
NC		 2459 I32 i;
2460 HE *entry;
2461
28eb953d 2462 PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
7918f24d 2463
3b721df9
NC		 2464 if (!HvARRAY(stash))
2465 return;
2466 for (i = 0; i <= (I32) HvMAX(stash); i++) {
2467 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
159b6efe 2468 GV *gv = MUTABLE_GV(HeVAL(entry));
3b721df9
NC		 2469 HV *hv;
2470 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
2471 continue;
2472 if (GvCVu(gv))
3ab0c9fa 2473 xmldump_sub_perl(gv, justperl);
3b721df9
NC		 2474 if (GvFORM(gv))
2475 xmldump_form(gv);
2476 if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2477 && (hv = GvHV(gv)) && hv != PL_defstash)
3ab0c9fa 2478 xmldump_packsubs_perl(hv, justperl); /* nested package */
3b721df9
NC		 2479 }
2480 }
2481}
2482
2483void
2484Perl_xmldump_sub(pTHX_ const GV *gv)
2485{
28eb953d 2486 PERL_ARGS_ASSERT_XMLDUMP_SUB;
f0e3f042
CS		 2487 xmldump_sub_perl(gv, FALSE);
2488}
2489
2490void
2491Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
2492{
2493 SV * sv;
3b721df9 2494
28eb953d 2495 PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
7918f24d 2496
f0e3f042
CS		 2497 if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
2498 return;
2499
2500 sv = sv_newmortal();
1a9a51d4 2501 gv_fullname3(sv, gv, NULL);
3b721df9
NC		 2502 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2503 if (CvXSUB(GvCV(gv)))
2504 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2505 PTR2UV(CvXSUB(GvCV(gv))),
2506 (int)CvXSUBANY(GvCV(gv)).any_i32);
2507 else if (CvROOT(GvCV(gv)))
2508 op_xmldump(CvROOT(GvCV(gv)));
2509 else
2510 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2511}
2512
2513void
2514Perl_xmldump_form(pTHX_ const GV *gv)
2515{
61f9802b 2516 SV * const sv = sv_newmortal();
3b721df9 2517
7918f24d
NC		 2518 PERL_ARGS_ASSERT_XMLDUMP_FORM;
2519
1a9a51d4 2520 gv_fullname3(sv, gv, NULL);
3b721df9
NC		 2521 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2522 if (CvROOT(GvFORM(gv)))
2523 op_xmldump(CvROOT(GvFORM(gv)));
2524 else
2525 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2526}
2527
2528void
2529Perl_xmldump_eval(pTHX)
2530{
2531 op_xmldump(PL_eval_root);
2532}
2533
2534char *
2535Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
2536{
7918f24d 2537 PERL_ARGS_ASSERT_SV_CATXMLSV;
3b721df9
NC		 2538 return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2539}
2540
2541char *
9dcc53ea
Z		 2542Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
2543{
2544 PERL_ARGS_ASSERT_SV_CATXMLPV;
2545 return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
2546}
2547
2548char *
20f84293 2549Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
3b721df9
NC		 2550{
2551 unsigned int c;
61f9802b 2552 const char * const e = pv + len;
20f84293 2553 const char * const start = pv;
3b721df9
NC		 2554 STRLEN dsvcur;
2555 STRLEN cl;
2556
7918f24d
NC		 2557 PERL_ARGS_ASSERT_SV_CATXMLPVN;
2558
76f68e9b 2559 sv_catpvs(dsv,"");
3b721df9
NC		 2560 dsvcur = SvCUR(dsv); /* in case we have to restart */
2561
2562 retry:
2563 while (pv < e) {
2564 if (utf8) {
4b88fb76 2565 c = utf8_to_uvchr_buf((U8*)pv, (U8*)e, &cl);
3b721df9
NC		 2566 if (cl == 0) {
2567 SvCUR(dsv) = dsvcur;
2568 pv = start;
2569 utf8 = 0;
2570 goto retry;
2571 }
2572 }
2573 else
2574 c = (*pv & 255);
2575
2576 switch (c) {
2577 case 0x00:
2578 case 0x01:
2579 case 0x02:
2580 case 0x03:
2581 case 0x04:
2582 case 0x05:
2583 case 0x06:
2584 case 0x07:
2585 case 0x08:
2586 case 0x0b:
2587 case 0x0c:
2588 case 0x0e:
2589 case 0x0f:
2590 case 0x10:
2591 case 0x11:
2592 case 0x12:
2593 case 0x13:
2594 case 0x14:
2595 case 0x15:
2596 case 0x16:
2597 case 0x17:
2598 case 0x18:
2599 case 0x19:
2600 case 0x1a:
2601 case 0x1b:
2602 case 0x1c:
2603 case 0x1d:
2604 case 0x1e:
2605 case 0x1f:
2606 case 0x7f:
2607 case 0x80:
2608 case 0x81:
2609 case 0x82:
2610 case 0x83:
2611 case 0x84:
2612 case 0x86:
2613 case 0x87:
2614 case 0x88:
2615 case 0x89:
2616 case 0x90:
2617 case 0x91:
2618 case 0x92:
2619 case 0x93:
2620 case 0x94:
2621 case 0x95:
2622 case 0x96:
2623 case 0x97:
2624 case 0x98:
2625 case 0x99:
2626 case 0x9a:
2627 case 0x9b:
2628 case 0x9c:
2629 case 0x9d:
2630 case 0x9e:
2631 case 0x9f:
2632 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2633 break;
2634 case '<':
f3a2811a 2635 sv_catpvs(dsv, "&lt;");
3b721df9
NC		 2636 break;
2637 case '>':
f3a2811a 2638 sv_catpvs(dsv, "&gt;");
3b721df9
NC		 2639 break;
2640 case '&':
f3a2811a 2641 sv_catpvs(dsv, "&amp;");
3b721df9
NC		 2642 break;
2643 case '"':
49de0815 2644 sv_catpvs(dsv, "&#34;");
3b721df9
NC		 2645 break;
2646 default:
2647 if (c < 0xD800) {
2648 if (c < 32 || c > 127) {
2649 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2650 }
2651 else {
5e7aa789
NC		 2652 const char string = (char) c;
2653 sv_catpvn(dsv, &string, 1);
3b721df9
NC		 2654 }
2655 break;
2656 }
2657 if ((c >= 0xD800 && c <= 0xDB7F) ||
2658 (c >= 0xDC00 && c <= 0xDFFF) ||
2659 (c >= 0xFFF0 && c <= 0xFFFF) ||
2660 c > 0x10ffff)
2661 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2662 else
2663 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2664 }
2665
2666 if (utf8)
2667 pv += UTF8SKIP(pv);
2668 else
2669 pv++;
2670 }
2671
2672 return SvPVX(dsv);
2673}
2674
2675char *
2676Perl_sv_xmlpeek(pTHX_ SV *sv)
2677{
61f9802b 2678 SV * const t = sv_newmortal();
3b721df9
NC		 2679 STRLEN n_a;
2680 int unref = 0;
2681
7918f24d
NC		 2682 PERL_ARGS_ASSERT_SV_XMLPEEK;
2683
3b721df9 2684 sv_utf8_upgrade(t);
76f68e9b 2685 sv_setpvs(t, "");
3b721df9
NC		 2686 /* retry: */
2687 if (!sv) {
2688 sv_catpv(t, "VOID=\"\"");
2689 goto finish;
2690 }
299ef33b 2691 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
3b721df9
NC		 2692 sv_catpv(t, "WILD=\"\"");
2693 goto finish;
2694 }
2695 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
2696 if (sv == &PL_sv_undef) {
2697 sv_catpv(t, "SV_UNDEF=\"1\"");
2698 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2699 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2700 SvREADONLY(sv))
2701 goto finish;
2702 }
2703 else if (sv == &PL_sv_no) {
2704 sv_catpv(t, "SV_NO=\"1\"");
2705 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2706 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2707 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2708 SVp_POK|SVp_NOK)) &&
2709 SvCUR(sv) == 0 &&
2710 SvNVX(sv) == 0.0)
2711 goto finish;
2712 }
2713 else if (sv == &PL_sv_yes) {
2714 sv_catpv(t, "SV_YES=\"1\"");
2715 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2716 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2717 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2718 SVp_POK|SVp_NOK)) &&
2719 SvCUR(sv) == 1 &&
2720 SvPVX(sv) && *SvPVX(sv) == '1' &&
2721 SvNVX(sv) == 1.0)
2722 goto finish;
2723 }
2724 else {
2725 sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2726 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2727 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2728 SvREADONLY(sv))
2729 goto finish;
2730 }
2731 sv_catpv(t, " XXX=\"\" ");
2732 }
2733 else if (SvREFCNT(sv) == 0) {
2734 sv_catpv(t, " refcnt=\"0\"");
2735 unref++;
2736 }
2737 else if (DEBUG_R_TEST_) {
2738 int is_tmp = 0;
2739 I32 ix;
2740 /* is this SV on the tmps stack? */
2741 for (ix=PL_tmps_ix; ix>=0; ix--) {
2742 if (PL_tmps_stack[ix] == sv) {
2743 is_tmp = 1;
2744 break;
2745 }
2746 }
2747 if (SvREFCNT(sv) > 1)
2748 Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2749 is_tmp ? "T" : "");
2750 else if (is_tmp)
2751 sv_catpv(t, " DRT=\"<T>\"");
2752 }
2753
2754 if (SvROK(sv)) {
2755 sv_catpv(t, " ROK=\"\"");
2756 }
2757 switch (SvTYPE(sv)) {
2758 default:
2759 sv_catpv(t, " FREED=\"1\"");
2760 goto finish;
2761
2762 case SVt_NULL:
2763 sv_catpv(t, " UNDEF=\"1\"");
2764 goto finish;
2765 case SVt_IV:
2766 sv_catpv(t, " IV=\"");
2767 break;
2768 case SVt_NV:
2769 sv_catpv(t, " NV=\"");
2770 break;
3b721df9
NC		 2771 case SVt_PV:
2772 sv_catpv(t, " PV=\"");
2773 break;
2774 case SVt_PVIV:
2775 sv_catpv(t, " PVIV=\"");
2776 break;
2777 case SVt_PVNV:
2778 sv_catpv(t, " PVNV=\"");
2779 break;
2780 case SVt_PVMG:
2781 sv_catpv(t, " PVMG=\"");
2782 break;
2783 case SVt_PVLV:
2784 sv_catpv(t, " PVLV=\"");
2785 break;
2786 case SVt_PVAV:
2787 sv_catpv(t, " AV=\"");
2788 break;
2789 case SVt_PVHV:
2790 sv_catpv(t, " HV=\"");
2791 break;
2792 case SVt_PVCV:
2793 if (CvGV(sv))
2794 Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2795 else
2796 sv_catpv(t, " CV=\"()\"");
2797 goto finish;
2798 case SVt_PVGV:
2799 sv_catpv(t, " GV=\"");
2800 break;
49cf1d66 2801 case SVt_DUMMY:
a9032aa0 2802 sv_catpv(t, " DUMMY=\"");
3b721df9 2803 break;
d914baab 2804 case SVt_REGEXP:
8619e557 2805 sv_catpv(t, " REGEXP=\"");
4df7f6af 2806 break;
3b721df9
NC		 2807 case SVt_PVFM:
2808 sv_catpv(t, " FM=\"");
2809 break;
2810 case SVt_PVIO:
2811 sv_catpv(t, " IO=\"");
2812 break;
2813 }
2814
2815 if (SvPOKp(sv)) {
2816 if (SvPVX(sv)) {
2817 sv_catxmlsv(t, sv);
2818 }
2819 }
2820 else if (SvNOKp(sv)) {
2821 STORE_NUMERIC_LOCAL_SET_STANDARD();
2822 Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2823 RESTORE_NUMERIC_LOCAL();
2824 }
2825 else if (SvIOKp(sv)) {
2826 if (SvIsUV(sv))
2827 Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2828 else
2829 Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2830 }
2831 else
2832 sv_catpv(t, "");
2833 sv_catpv(t, "\"");
2834
2835 finish:
61f9802b
AL		 2836 while (unref--)
2837 sv_catpv(t, ")");
3b721df9
NC		 2838 return SvPV(t, n_a);
2839}
2840
2841void
2842Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
2843{
7918f24d
NC		 2844 PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
2845
3b721df9
NC		 2846 if (!pm) {
2847 Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
2848 return;
2849 }
2850 Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
2851 level++;
2852 if (PM_GETRE(pm)) {
d914baab 2853 REGEXP *const r = PM_GETRE(pm);
643e696a 2854 SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
ad64d0ec 2855 sv_catxmlsv(tmpsv, MUTABLE_SV(r));
3b721df9
NC		 2856 Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2857 SvPVX(tmpsv));
5f954473 2858 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 2859 Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2860 (pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2861 }
2862 else
2863 Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
d914baab 2864 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
3df43ef7 2865 SV * const tmpsv = pm_description(pm);
3b721df9 2866 Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
5f954473 2867 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 2868 }
2869
2870 level--;
20e98b0f 2871 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
3b721df9
NC		 2872 Perl_xmldump_indent(aTHX_ level, file, ">\n");
2873 Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
20e98b0f 2874 do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
3b721df9
NC		 2875 Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
2876 Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
2877 }
2878 else
2879 Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2880}
2881
2882void
2883Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2884{
2885 do_pmop_xmldump(0, PL_xmlfp, pm);
2886}
2887
2888void
2889Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
2890{
2891 UV seq;
2892 int contents = 0;
75a6ad4a 2893 const OPCODE optype = o->op_type;
7918f24d
NC		 2894
2895 PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
2896
3b721df9
NC		 2897 if (!o)
2898 return;
3b721df9
NC		 2899 seq = sequence_num(o);
2900 Perl_xmldump_indent(aTHX_ level, file,
2901 "<op_%s seq=\"%"UVuf" -> ",
2902 OP_NAME(o),
2903 seq);
2904 level++;
2905 if (o->op_next)
2906 PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2907 sequence_num(o->op_next));
2908 else
2909 PerlIO_printf(file, "DONE\"");
2910
2911 if (o->op_targ) {
75a6ad4a 2912 if (optype == OP_NULL)
3b721df9
NC		 2913 {
2914 PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2915 if (o->op_targ == OP_NEXTSTATE)
2916 {
2917 if (CopLINE(cCOPo))
f5992bc4 2918 PerlIO_printf(file, " line=\"%"UVuf"\"",
3b721df9
NC		 2919 (UV)CopLINE(cCOPo));
2920 if (CopSTASHPV(cCOPo))
2921 PerlIO_printf(file, " package=\"%s\"",
2922 CopSTASHPV(cCOPo));
4b65a919 2923 if (CopLABEL(cCOPo))
3b721df9 2924 PerlIO_printf(file, " label=\"%s\"",
4b65a919 2925 CopLABEL(cCOPo));
3b721df9
NC		 2926 }
2927 }
2928 else
2929 PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2930 }
2931#ifdef DUMPADDR
2932 PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2933#endif
3b721df9 2934
75a6ad4a
RU		 2935 DUMP_OP_FLAGS(o,1,0,file);
2936 DUMP_OP_PRIVATE(o,1,0,file);
2937
2938 switch (optype) {
3b721df9
NC		 2939 case OP_AELEMFAST:
2940 if (o->op_flags & OPf_SPECIAL) {
2941 break;
2942 }
2943 case OP_GVSV:
2944 case OP_GV:
2945#ifdef USE_ITHREADS
2946 S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
2947#else
2948 if (cSVOPo->op_sv) {
d914baab
NC		 2949 SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
2950 SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
3b721df9
NC		 2951 char *s;
2952 STRLEN len;
2953 ENTER;
2954 SAVEFREESV(tmpsv1);
2955 SAVEFREESV(tmpsv2);
159b6efe 2956 gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
3b721df9
NC		 2957 s = SvPV(tmpsv1,len);
2958 sv_catxmlpvn(tmpsv2, s, len, 1);
2959 S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
2960 LEAVE;
2961 }
2962 else
2963 S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
2964#endif
2965 break;
2966 case OP_CONST:
996c9baa 2967 case OP_HINTSEVAL:
3b721df9
NC		 2968 case OP_METHOD_NAMED:
2969#ifndef USE_ITHREADS
2970 /* with ITHREADS, consts are stored in the pad, and the right pad
2971 * may not be active here, so skip */
2972 S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
2973#endif
2974 break;
2975 case OP_ANONCODE:
2976 if (!contents) {
2977 contents = 1;
2978 PerlIO_printf(file, ">\n");
2979 }
2980 do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
2981 break;
3b721df9
NC		 2982 case OP_NEXTSTATE:
2983 case OP_DBSTATE:
2984 if (CopLINE(cCOPo))
f5992bc4 2985 S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
3b721df9
NC		 2986 (UV)CopLINE(cCOPo));
2987 if (CopSTASHPV(cCOPo))
2988 S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
2989 CopSTASHPV(cCOPo));
4b65a919 2990 if (CopLABEL(cCOPo))
3b721df9 2991 S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
4b65a919 2992 CopLABEL(cCOPo));
3b721df9
NC		 2993 break;
2994 case OP_ENTERLOOP:
2995 S_xmldump_attr(aTHX_ level, file, "redo=\"");
2996 if (cLOOPo->op_redoop)
2997 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
2998 else
2999 PerlIO_printf(file, "DONE\"");
3000 S_xmldump_attr(aTHX_ level, file, "next=\"");
3001 if (cLOOPo->op_nextop)
3002 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
3003 else
3004 PerlIO_printf(file, "DONE\"");
3005 S_xmldump_attr(aTHX_ level, file, "last=\"");
3006 if (cLOOPo->op_lastop)
3007 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
3008 else
3009 PerlIO_printf(file, "DONE\"");
3010 break;
3011 case OP_COND_EXPR:
3012 case OP_RANGE:
3013 case OP_MAPWHILE:
3014 case OP_GREPWHILE:
3015 case OP_OR:
3016 case OP_AND:
3017 S_xmldump_attr(aTHX_ level, file, "other=\"");
3018 if (cLOGOPo->op_other)
3019 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
3020 else
3021 PerlIO_printf(file, "DONE\"");
3022 break;
3023 case OP_LEAVE:
3024 case OP_LEAVEEVAL:
3025 case OP_LEAVESUB:
3026 case OP_LEAVESUBLV:
3027 case OP_LEAVEWRITE:
3028 case OP_SCOPE:
3029 if (o->op_private & OPpREFCOUNTED)
3030 S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
3031 break;
3032 default:
3033 break;
3034 }
3035
3036 if (PL_madskills && o->op_madprop) {
fb2b694a 3037 char prevkey = '\0';
d914baab 3038 SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
20f84293 3039 const MADPROP* mp = o->op_madprop;
61f9802b 3040
3b721df9
NC		 3041 if (!contents) {
3042 contents = 1;
3043 PerlIO_printf(file, ">\n");
3044 }
3045 Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
3046 level++;
3047 while (mp) {
3048 char tmp = mp->mad_key;
76f68e9b 3049 sv_setpvs(tmpsv,"\"");
3b721df9
NC		 3050 if (tmp)
3051 sv_catxmlpvn(tmpsv, &tmp, 1, 0);
fb2b694a
GG		 3052 if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
3053 sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
3054 else
3055 prevkey = tmp;
3b721df9
NC		 3056 sv_catpv(tmpsv, "\"");
3057 switch (mp->mad_type) {
3058 case MAD_NULL:
3059 sv_catpv(tmpsv, "NULL");
3060 Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
3061 break;
3062 case MAD_PV:
3063 sv_catpv(tmpsv, " val=\"");
3064 sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
3065 sv_catpv(tmpsv, "\"");
3066 Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
3067 break;
3068 case MAD_SV:
3069 sv_catpv(tmpsv, " val=\"");
ad64d0ec 3070 sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
3b721df9
NC		 3071 sv_catpv(tmpsv, "\"");
3072 Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
3073 break;
3074 case MAD_OP:
3075 if ((OP*)mp->mad_val) {
3076 Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
3077 do_op_xmldump(level+1, file, (OP*)mp->mad_val);
3078 Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
3079 }
3080 break;
3081 default:
3082 Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
3083 break;
3084 }
3085 mp = mp->mad_next;
3086 }
3087 level--;
3088 Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
3089
5f954473 3090 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 3091 }
3092
75a6ad4a 3093 switch (optype) {
3b721df9
NC		 3094 case OP_PUSHRE:
3095 case OP_MATCH:
3096 case OP_QR:
3097 case OP_SUBST:
3098 if (!contents) {
3099 contents = 1;
3100 PerlIO_printf(file, ">\n");
3101 }
3102 do_pmop_xmldump(level, file, cPMOPo);
3103 break;
3104 default:
3105 break;
3106 }
3107
3108 if (o->op_flags & OPf_KIDS) {
3109 OP *kid;
3110 if (!contents) {
3111 contents = 1;
3112 PerlIO_printf(file, ">\n");
3113 }
3114 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3115 do_op_xmldump(level, file, kid);
3116 }
3117
3118 if (contents)
3119 Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
3120 else
3121 PerlIO_printf(file, " />\n");
3122}
3123
3124void
3125Perl_op_xmldump(pTHX_ const OP *o)
3126{
7918f24d
NC		 3127 PERL_ARGS_ASSERT_OP_XMLDUMP;
3128
3b721df9
NC		 3129 do_op_xmldump(0, PL_xmlfp, o);
3130}
3131#endif
3132
66610fdd
RGS		 3133/*
3134 * Local variables:
3135 * c-indentation-style: bsd
3136 * c-basic-offset: 4
14d04a33 3137 * indent-tabs-mode: nil
66610fdd
RGS		 3138 * End:
3139 *
14d04a33 3140 * ex: set ts=8 sts=4 sw=4 et:
37442d52 3141 */
Unnamed repository; edit this file 'description' to name the repository.