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
[perl #89940] File::Spec->tmpdir and env changes
[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
8d063cd8 30
5357ca29
NC		 31static const char* const svtypenames[SVt_LAST] = {
32 "NULL",
a9032aa0 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",
a9032aa0 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");
794
1fe3abee
NC		 795struct op_private_by_op {
796 U16 op_type;
797 U16 len;
798 const struct flag_to_name *start;
799};
800
801const struct op_private_by_op op_private_names[] = {
261c990e
NC		 802 {OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
803 {OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
804 {OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
805 {OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
261c990e
NC		 806 {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
807 {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
808 {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
809 {OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
810 {OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
811 {OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
812 {OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
813 {OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
814 {OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
815 {OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
816 {OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
1fe3abee
NC		 817 {OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
818 {OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
819 {OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
820 {OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
821 {OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
822};
823
824static bool
825S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
826 const struct op_private_by_op *start = op_private_names;
827 const struct op_private_by_op *const end
828 = op_private_names + C_ARRAY_LENGTH(op_private_names);
829
830 /* This is a linear search, but no worse than the code that it replaced.
831 It's debugging code - size is more important than speed. */
832 do {
833 if (optype == start->op_type) {
834 S_append_flags(aTHX_ tmpsv, op_private, start->start,
835 start->start + start->len);
836 return TRUE;
837 }
838 } while (++start < end);
839 return FALSE;
840}
841
75a6ad4a
RU		 842#define DUMP_OP_FLAGS(o,xml,level,file) \
843 if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
17605be7 844 SV * const tmpsv = newSVpvs(""); \
75a6ad4a
RU		 845 switch (o->op_flags & OPf_WANT) { \
846 case OPf_WANT_VOID: \
847 sv_catpv(tmpsv, ",VOID"); \
848 break; \
849 case OPf_WANT_SCALAR: \
850 sv_catpv(tmpsv, ",SCALAR"); \
851 break; \
852 case OPf_WANT_LIST: \
853 sv_catpv(tmpsv, ",LIST"); \
854 break; \
855 default: \
856 sv_catpv(tmpsv, ",UNKNOWN"); \
857 break; \
858 } \
859 append_flags(tmpsv, o->op_flags, op_flags_names); \
860 if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
861 if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
862 if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
863 if (!xml) \
864 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
865 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
866 else \
867 PerlIO_printf(file, " flags=\"%s\"", \
868 SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
5f954473 869 SvREFCNT_dec_NN(tmpsv); \
75a6ad4a
RU		 870 }
871
872#if !defined(PERL_MAD)
09c75956
FC		 873# define xmldump_attr1(level, file, pat, arg)
874#else
875# define xmldump_attr1(level, file, pat, arg) \
876 S_xmldump_attr(aTHX_ level, file, pat, arg)
75a6ad4a
RU		 877#endif
878
879#define DUMP_OP_PRIVATE(o,xml,level,file) \
880 if (o->op_private) { \
881 U32 optype = o->op_type; \
882 U32 oppriv = o->op_private; \
17605be7 883 SV * const tmpsv = newSVpvs(""); \
75a6ad4a
RU		 884 if (PL_opargs[optype] & OA_TARGLEX) { \
885 if (oppriv & OPpTARGET_MY) \
886 sv_catpv(tmpsv, ",TARGET_MY"); \
887 } \
888 else if (optype == OP_ENTERSUB || \
889 optype == OP_RV2SV || \
890 optype == OP_GVSV || \
891 optype == OP_RV2AV || \
892 optype == OP_RV2HV || \
893 optype == OP_RV2GV || \
894 optype == OP_AELEM || \
895 optype == OP_HELEM ) \
896 { \
897 if (optype == OP_ENTERSUB) { \
898 append_flags(tmpsv, oppriv, op_entersub_names); \
899 } \
900 else { \
901 switch (oppriv & OPpDEREF) { \
902 case OPpDEREF_SV: \
903 sv_catpv(tmpsv, ",SV"); \
904 break; \
905 case OPpDEREF_AV: \
906 sv_catpv(tmpsv, ",AV"); \
907 break; \
908 case OPpDEREF_HV: \
909 sv_catpv(tmpsv, ",HV"); \
910 break; \
911 } \
912 if (oppriv & OPpMAYBE_LVSUB) \
913 sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
914 } \
915 if (optype == OP_AELEM || optype == OP_HELEM) { \
916 if (oppriv & OPpLVAL_DEFER) \
917 sv_catpv(tmpsv, ",LVAL_DEFER"); \
918 } \
919 else if (optype == OP_RV2HV || optype == OP_PADHV) { \
920 if (oppriv & OPpMAYBE_TRUEBOOL) \
921 sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
922 if (oppriv & OPpTRUEBOOL) \
923 sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
924 } \
925 else { \
926 if (oppriv & HINT_STRICT_REFS) \
927 sv_catpv(tmpsv, ",STRICT_REFS"); \
928 if (oppriv & OPpOUR_INTRO) \
929 sv_catpv(tmpsv, ",OUR_INTRO"); \
930 } \
931 } \
932 else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
933 } \
934 else if (OP_IS_FILETEST(o->op_type)) { \
935 if (oppriv & OPpFT_ACCESS) \
936 sv_catpv(tmpsv, ",FT_ACCESS"); \
937 if (oppriv & OPpFT_STACKED) \
938 sv_catpv(tmpsv, ",FT_STACKED"); \
939 if (oppriv & OPpFT_STACKING) \
940 sv_catpv(tmpsv, ",FT_STACKING"); \
941 if (oppriv & OPpFT_AFTER_t) \
942 sv_catpv(tmpsv, ",AFTER_t"); \
943 } \
631dbaa2
FC		 944 else if (o->op_type == OP_AASSIGN) { \
945 if (oppriv & OPpASSIGN_COMMON) \
946 sv_catpvs(tmpsv, ",COMMON"); \
947 if (oppriv & OPpMAYBE_LVSUB) \
948 sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
949 } \
75a6ad4a
RU		 950 if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
951 sv_catpv(tmpsv, ",INTRO"); \
952 if (o->op_type == OP_PADRANGE) \
953 Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
954 (UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
955 if (SvCUR(tmpsv)) { \
956 if (xml) \
09c75956 957 xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
75a6ad4a
RU		 958 else \
959 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
960 } else if (!xml) \
961 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
962 (UV)oppriv); \
5f954473 963 SvREFCNT_dec_NN(tmpsv); \
75a6ad4a
RU		 964 }
965
966
79072805 967void
6867be6d 968Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
79072805 969{
27da23d5 970 dVAR;
2814eb74 971 UV seq;
e15d5972
AL		 972 const OPCODE optype = o->op_type;
973
7918f24d
NC		 974 PERL_ARGS_ASSERT_DO_OP_DUMP;
975
cea2e8a9 976 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732 977 level++;
0bd48802 978 seq = sequence_num(o);
2814eb74 979 if (seq)
f5992bc4 980 PerlIO_printf(file, "%-4"UVuf, seq);
93a17b20 981 else
b6f05621 982 PerlIO_printf(file, "????");
c8db6e60
JH		 983 PerlIO_printf(file,
984 "%*sTYPE = %s ===> ",
53e06cf0 985 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
2814eb74 986 if (o->op_next)
b6f05621
DM		 987 PerlIO_printf(file,
988 o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
666ea192 989 sequence_num(o->op_next));
79072805 990 else
e75ab6ad 991 PerlIO_printf(file, "NULL\n");
11343788 992 if (o->op_targ) {
e15d5972 993 if (optype == OP_NULL) {
cea2e8a9 994 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
e15d5972 995 if (o->op_targ == OP_NEXTSTATE) {
ae7d165c 996 if (CopLINE(cCOPo))
f5992bc4 997 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 998 (UV)CopLINE(cCOPo));
ae7d165c
PJ		 999 if (CopSTASHPV(cCOPo))
1000 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1001 CopSTASHPV(cCOPo));
4b65a919 1002 if (CopLABEL(cCOPo))
ae7d165c 1003 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
4b65a919 1004 CopLABEL(cCOPo));
ae7d165c
PJ		 1005 }
1006 }
8990e307 1007 else
894356b3 1008 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
8990e307 1009 }
748a9306 1010#ifdef DUMPADDR
57def98f 1011 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
79072805 1012#endif
a7fd8ef6 1013
75a6ad4a
RU		 1014 DUMP_OP_FLAGS(o,0,level,file);
1015 DUMP_OP_PRIVATE(o,0,level,file);
8d063cd8 1016
3b721df9
NC		 1017#ifdef PERL_MAD
1018 if (PL_madskills && o->op_madprop) {
17605be7 1019 SV * const tmpsv = newSVpvs("");
3b721df9
NC		 1020 MADPROP* mp = o->op_madprop;
1021 Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
1022 level++;
1023 while (mp) {
61f9802b 1024 const char tmp = mp->mad_key;
76f68e9b 1025 sv_setpvs(tmpsv,"'");
3b721df9
NC		 1026 if (tmp)
1027 sv_catpvn(tmpsv, &tmp, 1);
1028 sv_catpv(tmpsv, "'=");
1029 switch (mp->mad_type) {
1030 case MAD_NULL:
1031 sv_catpv(tmpsv, "NULL");
1032 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1033 break;
1034 case MAD_PV:
1035 sv_catpv(tmpsv, "<");
1036 sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
1037 sv_catpv(tmpsv, ">");
1038 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1039 break;
1040 case MAD_OP:
1041 if ((OP*)mp->mad_val) {
1042 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1043 do_op_dump(level, file, (OP*)mp->mad_val);
1044 }
1045 break;
1046 default:
1047 sv_catpv(tmpsv, "(UNK)");
1048 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
1049 break;
1050 }
1051 mp = mp->mad_next;
1052 }
1053 level--;
1054 Perl_dump_indent(aTHX_ level, file, "}\n");
1055
5f954473 1056 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 1057 }
1058#endif
1059
e15d5972 1060 switch (optype) {
971a9dd3 1061 case OP_AELEMFAST:
93a17b20 1062 case OP_GVSV:
79072805 1063 case OP_GV:
971a9dd3 1064#ifdef USE_ITHREADS
c803eecc 1065 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 1066#else
1640e9f0 1067 if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
38c076c7 1068 if (cSVOPo->op_sv) {
d4c19fe8 1069 SV * const tmpsv = newSV(0);
38c076c7
DM		 1070 ENTER;
1071 SAVEFREESV(tmpsv);
3b721df9 1072#ifdef PERL_MAD
84021b46 1073 /* FIXME - is this making unwarranted assumptions about the
3b721df9
NC		 1074 UTF-8 cleanliness of the dump file handle? */
1075 SvUTF8_on(tmpsv);
1076#endif
159b6efe 1077 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
8b6b16e7 1078 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
17605be7 1079 SvPV_nolen_const(tmpsv));
38c076c7
DM		 1080 LEAVE;
1081 }
1082 else
1083 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
378cc40b 1084 }
971a9dd3 1085#endif
79072805
LW		 1086 break;
1087 case OP_CONST:
996c9baa 1088 case OP_HINTSEVAL:
f5d5a27c 1089 case OP_METHOD_NAMED:
b6a15bc5
DM		 1090#ifndef USE_ITHREADS
1091 /* with ITHREADS, consts are stored in the pad, and the right pad
1092 * may not be active here, so skip */
3848b962 1093 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
b6a15bc5 1094#endif
79072805 1095 break;
93a17b20
LW		 1096 case OP_NEXTSTATE:
1097 case OP_DBSTATE:
57843af0 1098 if (CopLINE(cCOPo))
f5992bc4 1099 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 1100 (UV)CopLINE(cCOPo));
ed094faf
GS		 1101 if (CopSTASHPV(cCOPo))
1102 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1103 CopSTASHPV(cCOPo));
4b65a919 1104 if (CopLABEL(cCOPo))
ed094faf 1105 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
4b65a919 1106 CopLABEL(cCOPo));
79072805
LW		 1107 break;
1108 case OP_ENTERLOOP:
cea2e8a9 1109 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
11343788 1110 if (cLOOPo->op_redoop)
f5992bc4 1111 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
79072805 1112 else
3967c732 1113 PerlIO_printf(file, "DONE\n");
cea2e8a9 1114 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
11343788 1115 if (cLOOPo->op_nextop)
f5992bc4 1116 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
79072805 1117 else
3967c732 1118 PerlIO_printf(file, "DONE\n");
cea2e8a9 1119 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
11343788 1120 if (cLOOPo->op_lastop)
f5992bc4 1121 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
79072805 1122 else
3967c732 1123 PerlIO_printf(file, "DONE\n");
79072805
LW		 1124 break;
1125 case OP_COND_EXPR:
1a67a97c 1126 case OP_RANGE:
a0d0e21e 1127 case OP_MAPWHILE:
79072805
LW		 1128 case OP_GREPWHILE:
1129 case OP_OR:
1130 case OP_AND:
cea2e8a9 1131 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
11343788 1132 if (cLOGOPo->op_other)
f5992bc4 1133 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
79072805 1134 else
3967c732 1135 PerlIO_printf(file, "DONE\n");
79072805
LW		 1136 break;
1137 case OP_PUSHRE:
1138 case OP_MATCH:
8782bef2 1139 case OP_QR:
79072805 1140 case OP_SUBST:
3967c732 1141 do_pmop_dump(level, file, cPMOPo);
79072805 1142 break;
7934575e
GS		 1143 case OP_LEAVE:
1144 case OP_LEAVEEVAL:
1145 case OP_LEAVESUB:
1146 case OP_LEAVESUBLV:
1147 case OP_LEAVEWRITE:
1148 case OP_SCOPE:
1149 if (o->op_private & OPpREFCOUNTED)
1150 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1151 break;
a0d0e21e
LW		 1152 default:
1153 break;
79072805 1154 }
11343788 1155 if (o->op_flags & OPf_KIDS) {
79072805 1156 OP *kid;
11343788 1157 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3967c732 1158 do_op_dump(level, file, kid);
8d063cd8 1159 }
cea2e8a9 1160 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 1161}
1162
1163void
6867be6d 1164Perl_op_dump(pTHX_ const OP *o)
3967c732 1165{
7918f24d 1166 PERL_ARGS_ASSERT_OP_DUMP;
3967c732 1167 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW		 1168}
1169
8adcabd8 1170void
864dbfa3 1171Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1172{
17605be7 1173 SV *sv;
378cc40b 1174
7918f24d
NC		 1175 PERL_ARGS_ASSERT_GV_DUMP;
1176
79072805 1177 if (!gv) {
760ac839 1178 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW		 1179 return;
1180 }
8990e307 1181 sv = sv_newmortal();
760ac839 1182 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1183 gv_fullname3(sv, gv, NULL);
17605be7 1184 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
79072805 1185 if (gv != GvEGV(gv)) {
bd61b366 1186 gv_efullname3(sv, GvEGV(gv), NULL);
17605be7 1187 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
8adcabd8 1188 }
3967c732 1189 PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1190 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW		 1191}
1192
14befaf4 1193
afe38520 1194/* map magic types to the symbolic names
14befaf4
DM		 1195 * (with the PERL_MAGIC_ prefixed stripped)
1196 */
1197
27da23d5 1198static const struct { const char type; const char *name; } magic_names[] = {
52f49505 1199#include "mg_names.c"
516a5887 1200 /* this null string terminates the list */
b9ac451d 1201 { 0, NULL },
14befaf4
DM		 1202};
1203
8adcabd8 1204void
6867be6d 1205Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1206{
7918f24d
NC		 1207 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1208
3967c732 1209 for (; mg; mg = mg->mg_moremagic) {
b900a521
JH		 1210 Perl_dump_indent(aTHX_ level, file,
1211 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1212 if (mg->mg_virtual) {
bfed75c6 1213 const MGVTBL * const v = mg->mg_virtual;
2d1f1fe5
NC		 1214 if (v >= PL_magic_vtables
1215 && v < PL_magic_vtables + magic_vtable_max) {
1216 const U32 i = v - PL_magic_vtables;
1217 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1218 }
3967c732 1219 else
b900a521 1220 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732
JD		 1221 }
1222 else
cea2e8a9 1223 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1224
3967c732 1225 if (mg->mg_private)
cea2e8a9 1226 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1227
14befaf4
DM		 1228 {
1229 int n;
c445ea15 1230 const char *name = NULL;
27da23d5 1231 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM		 1232 if (mg->mg_type == magic_names[n].type) {
1233 name = magic_names[n].name;
1234 break;
1235 }
1236 }
1237 if (name)
1238 Perl_dump_indent(aTHX_ level, file,
1239 " MG_TYPE = PERL_MAGIC_%s\n", name);
1240 else
1241 Perl_dump_indent(aTHX_ level, file,
1242 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1243 }
3967c732
JD		 1244
1245 if (mg->mg_flags) {
cea2e8a9 1246 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST		 1247 if (mg->mg_type == PERL_MAGIC_envelem &&
1248 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1249 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
4c02285a
FR		 1250 if (mg->mg_type == PERL_MAGIC_regex_global &&
1251 mg->mg_flags & MGf_MINMATCH)
1252 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1253 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1254 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1255 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1256 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
4c02285a
FR		 1257 if (mg->mg_flags & MGf_COPY)
1258 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1259 if (mg->mg_flags & MGf_DUP)
1260 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1261 if (mg->mg_flags & MGf_LOCAL)
1262 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
3967c732
JD		 1263 }
1264 if (mg->mg_obj) {
4c02285a 1265 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
28d8d7f4
YO		 1266 PTR2UV(mg->mg_obj));
1267 if (mg->mg_type == PERL_MAGIC_qr) {
07bc277f 1268 REGEXP* const re = (REGEXP *)mg->mg_obj;
61f9802b 1269 SV * const dsv = sv_newmortal();
866c78d1 1270 const char * const s
4c02285a 1271 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
28d8d7f4 1272 60, NULL, NULL,
95b611b0 1273 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
3c8556c3 1274 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
28d8d7f4 1275 );
6483fb35
RGS		 1276 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1277 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
07bc277f 1278 (IV)RX_REFCNT(re));
28d8d7f4
YO		 1279 }
1280 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732
JD		 1281 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1282 }
1283 if (mg->mg_len)
894356b3 1284 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1285 if (mg->mg_ptr) {
b900a521 1286 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1287 if (mg->mg_len >= 0) {
7e8c5dac 1288 if (mg->mg_type != PERL_MAGIC_utf8) {
17605be7 1289 SV * const sv = newSVpvs("");
7e8c5dac 1290 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
17605be7 1291 SvREFCNT_dec_NN(sv);
7e8c5dac 1292 }
3967c732
JD		 1293 }
1294 else if (mg->mg_len == HEf_SVKEY) {
1295 PerlIO_puts(file, " => HEf_SVKEY\n");
ad64d0ec
NC		 1296 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1297 maxnest, dumpops, pvlim); /* MG is already +1 */
3967c732
JD		 1298 continue;
1299 }
866f9d6c 1300 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
3967c732 1301 else
866f9d6c
FC		 1302 PerlIO_puts(
1303 file,
1304 " ???? - " __FILE__
1305 " does not know how to handle this MG_LEN"
1306 );
3967c732
JD		 1307 PerlIO_putc(file, '\n');
1308 }
7e8c5dac 1309 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1310 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac
HS		 1311 if (cache) {
1312 IV i;
1313 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1314 Perl_dump_indent(aTHX_ level, file,
1315 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1316 i,
1317 (UV)cache[i * 2],
1318 (UV)cache[i * 2 + 1]);
1319 }
1320 }
378cc40b 1321 }
3967c732
JD		 1322}
1323
1324void
6867be6d 1325Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1326{
b9ac451d 1327 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD		 1328}
1329
1330void
e1ec3a88 1331Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1332{
bfcb3514 1333 const char *hvname;
7918f24d
NC		 1334
1335 PERL_ARGS_ASSERT_DO_HV_DUMP;
1336
b900a521 1337 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514 1338 if (sv && (hvname = HvNAME_get(sv)))
d7d51f4b
YO		 1339 {
1340 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1341 name which quite legally could contain insane things like tabs, newlines, nulls or
1342 other scary crap - this should produce sane results - except maybe for unicode package
1343 names - but we will wait for someone to file a bug on that - demerphq */
17605be7 1344 SV * const tmpsv = newSVpvs("");
d7d51f4b
YO		 1345 PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
1346 }
79072805 1347 else
3967c732
JD		 1348 PerlIO_putc(file, '\n');
1349}
1350
1351void
e1ec3a88 1352Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1353{
7918f24d
NC		 1354 PERL_ARGS_ASSERT_DO_GV_DUMP;
1355
b900a521 1356 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732
JD		 1357 if (sv && GvNAME(sv))
1358 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
c90c0ff4 1359 else
3967c732
JD		 1360 PerlIO_putc(file, '\n');
1361}
1362
1363void
e1ec3a88 1364Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1365{
7918f24d
NC		 1366 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1367
b900a521 1368 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1369 if (sv && GvNAME(sv)) {
bfcb3514 1370 const char *hvname;
17605be7
DM		 1371 PerlIO_printf(file, "\t\"");
1372 if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
1373 PerlIO_printf(file, "%s\" :: \"", hvname);
1374 PerlIO_printf(file, "%s\"\n", GvNAME(sv));
8d063cd8 1375 }
3967c732
JD		 1376 else
1377 PerlIO_putc(file, '\n');
1378}
1379
a0c2f4dd
NC		 1380const struct flag_to_name first_sv_flags_names[] = {
1381 {SVs_TEMP, "TEMP,"},
1382 {SVs_OBJECT, "OBJECT,"},
1383 {SVs_GMG, "GMG,"},
1384 {SVs_SMG, "SMG,"},
1385 {SVs_RMG, "RMG,"},
1386 {SVf_IOK, "IOK,"},
1387 {SVf_NOK, "NOK,"},
1388 {SVf_POK, "POK,"}
1389};
1390
1391const struct flag_to_name second_sv_flags_names[] = {
1392 {SVf_OOK, "OOK,"},
1393 {SVf_FAKE, "FAKE,"},
1394 {SVf_READONLY, "READONLY,"},
e3918bb7 1395 {SVf_IsCOW, "IsCOW,"},
a0c2f4dd
NC		 1396 {SVf_BREAK, "BREAK,"},
1397 {SVf_AMAGIC, "OVERLOAD,"},
1398 {SVp_IOK, "pIOK,"},
1399 {SVp_NOK, "pNOK,"},
1400 {SVp_POK, "pPOK,"}
1401};
1402
ae1f06a1
NC		 1403const struct flag_to_name cv_flags_names[] = {
1404 {CVf_ANON, "ANON,"},
1405 {CVf_UNIQUE, "UNIQUE,"},
1406 {CVf_CLONE, "CLONE,"},
1407 {CVf_CLONED, "CLONED,"},
1408 {CVf_CONST, "CONST,"},
1409 {CVf_NODEBUG, "NODEBUG,"},
1410 {CVf_LVALUE, "LVALUE,"},
1411 {CVf_METHOD, "METHOD,"},
cfc1e951 1412 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
31d45e0c 1413 {CVf_CVGV_RC, "CVGV_RC,"},
bad4ae38 1414 {CVf_DYNFILE, "DYNFILE,"},
8fa6a409 1415 {CVf_AUTOLOAD, "AUTOLOAD,"},
55f7f8ab 1416 {CVf_HASEVAL, "HASEVAL"},
bfbc3ad9 1417 {CVf_SLABBED, "SLABBED,"},
31d45e0c 1418 {CVf_ISXSUB, "ISXSUB,"}
ae1f06a1
NC		 1419};
1420
1421const struct flag_to_name hv_flags_names[] = {
1422 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1423 {SVphv_LAZYDEL, "LAZYDEL,"},
1424 {SVphv_HASKFLAGS, "HASKFLAGS,"},
ae1f06a1
NC		 1425 {SVphv_CLONEABLE, "CLONEABLE,"}
1426};
1427
1428const struct flag_to_name gp_flags_names[] = {
1429 {GVf_INTRO, "INTRO,"},
1430 {GVf_MULTI, "MULTI,"},
1431 {GVf_ASSUMECV, "ASSUMECV,"},
1432 {GVf_IN_PAD, "IN_PAD,"}
1433};
1434
1435const struct flag_to_name gp_flags_imported_names[] = {
1436 {GVf_IMPORTED_SV, " SV"},
1437 {GVf_IMPORTED_AV, " AV"},
1438 {GVf_IMPORTED_HV, " HV"},
1439 {GVf_IMPORTED_CV, " CV"},
1440};
1441
d63e6659
DM		 1442const struct flag_to_name regexp_flags_names[] = {
1443 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1444 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1445 {RXf_PMf_FOLD, "PMf_FOLD,"},
1446 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1447 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
1448 {RXf_ANCH_BOL, "ANCH_BOL,"},
1449 {RXf_ANCH_MBOL, "ANCH_MBOL,"},
1450 {RXf_ANCH_SBOL, "ANCH_SBOL,"},
1451 {RXf_ANCH_GPOS, "ANCH_GPOS,"},
1452 {RXf_GPOS_SEEN, "GPOS_SEEN,"},
1453 {RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
dbc200c5 1454 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
d63e6659
DM		 1455 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
1456 {RXf_CANY_SEEN, "CANY_SEEN,"},
1457 {RXf_NOSCAN, "NOSCAN,"},
1458 {RXf_CHECK_ALL, "CHECK_ALL,"},
1459 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1460 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1461 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1462 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
dbc200c5 1463 {RXf_SPLIT, "SPLIT,"},
d63e6659
DM		 1464 {RXf_COPY_DONE, "COPY_DONE,"},
1465 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1466 {RXf_TAINTED, "TAINTED,"},
1467 {RXf_START_ONLY, "START_ONLY,"},
dbc200c5 1468 {RXf_SKIPWHITE, "SKIPWHITE,"},
d63e6659
DM		 1469 {RXf_WHITE, "WHITE,"},
1470 {RXf_NULL, "NULL,"},
1471};
1472
3967c732 1473void
864dbfa3 1474Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1475{
97aff369 1476 dVAR;
cea89e20 1477 SV *d;
e1ec3a88 1478 const char *s;
3967c732
JD		 1479 U32 flags;
1480 U32 type;
1481
7918f24d
NC		 1482 PERL_ARGS_ASSERT_DO_SV_DUMP;
1483
3967c732 1484 if (!sv) {
cea2e8a9 1485 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1486 return;
378cc40b 1487 }
2ef28da1 1488
3967c732
JD		 1489 flags = SvFLAGS(sv);
1490 type = SvTYPE(sv);
79072805 1491
e0bbf362
DM		 1492 /* process general SV flags */
1493
cea89e20 1494 d = Perl_newSVpvf(aTHX_
57def98f 1495 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1496 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS		 1497 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1498 (int)(PL_dumpindent*level), "");
8d063cd8 1499
1979170b
NC		 1500 if (!((flags & SVpad_NAME) == SVpad_NAME
1501 && (type == SVt_PVMG || type == SVt_PVNV))) {
9a214eec
DM		 1502 if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1503 sv_catpv(d, "PADSTALE,");
e604303a 1504 }
1979170b 1505 if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
9a214eec
DM		 1506 if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1507 sv_catpv(d, "PADTMP,");
e604303a
NC		 1508 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1509 }
a0c2f4dd 1510 append_flags(d, flags, first_sv_flags_names);
810b8aa5
GS		 1511 if (flags & SVf_ROK) {
1512 sv_catpv(d, "ROK,");
1513 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1514 }
a0c2f4dd 1515 append_flags(d, flags, second_sv_flags_names);
1ccdb730
NC		 1516 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
1517 if (SvPCS_IMPORTED(sv))
1518 sv_catpv(d, "PCS_IMPORTED,");
1519 else
9660f481 1520 sv_catpv(d, "SCREAM,");
1ccdb730 1521 }
3967c732 1522
e0bbf362
DM		 1523 /* process type-specific SV flags */
1524
3967c732
JD		 1525 switch (type) {
1526 case SVt_PVCV:
1527 case SVt_PVFM:
ae1f06a1 1528 append_flags(d, CvFLAGS(sv), cv_flags_names);
3967c732
JD		 1529 break;
1530 case SVt_PVHV:
ae1f06a1 1531 append_flags(d, flags, hv_flags_names);
3967c732 1532 break;
926fc7b6
DM		 1533 case SVt_PVGV:
1534 case SVt_PVLV:
1535 if (isGV_with_GP(sv)) {
ae1f06a1 1536 append_flags(d, GvFLAGS(sv), gp_flags_names);
926fc7b6 1537 }
926fc7b6 1538 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD		 1539 sv_catpv(d, "IMPORT");
1540 if (GvIMPORTED(sv) == GVf_IMPORTED)
1541 sv_catpv(d, "ALL,");
1542 else {
1543 sv_catpv(d, "(");
ae1f06a1 1544 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
3967c732
JD		 1545 sv_catpv(d, " ),");
1546 }
1547 }
addd1794 1548 /* FALL THROUGH */
25da4f38 1549 default:
e604303a 1550 evaled_or_uv:
25da4f38 1551 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1552 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1553 break;
addd1794 1554 case SVt_PVMG:
c13a5c80
NC		 1555 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1556 if (SvVALID(sv)) sv_catpv(d, "VALID,");
00b1698f 1557 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1558 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
2e94196c 1559 /* FALL THROUGH */
e604303a
NC		 1560 case SVt_PVNV:
1561 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1562 goto evaled_or_uv;
11ca45c0
NC		 1563 case SVt_PVAV:
1564 break;
3967c732 1565 }
86f0d186
NC		 1566 /* SVphv_SHAREKEYS is also 0x20000000 */
1567 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1568 sv_catpv(d, "UTF8");
3967c732 1569
b162af07
SP		 1570 if (*(SvEND(d) - 1) == ',') {
1571 SvCUR_set(d, SvCUR(d) - 1);
1572 SvPVX(d)[SvCUR(d)] = '\0';
1573 }
3967c732 1574 sv_catpv(d, ")");
b15aece3 1575 s = SvPVX_const(d);
3967c732 1576
e0bbf362
DM		 1577 /* dump initial SV details */
1578
fd0854ff 1579#ifdef DEBUG_LEAKING_SCALARS
cbe56f1d 1580 Perl_dump_indent(aTHX_ level, file,
cd676548 1581 "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
fd0854ff
DM		 1582 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1583 sv->sv_debug_line,
1584 sv->sv_debug_inpad ? "for" : "by",
1585 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
cd676548 1586 PTR2UV(sv->sv_debug_parent),
cbe56f1d
DM		 1587 sv->sv_debug_serial
1588 );
fd0854ff 1589#endif
cea2e8a9 1590 Perl_dump_indent(aTHX_ level, file, "SV = ");
e0bbf362
DM		 1591
1592 /* Dump SV type */
1593
5357ca29
NC		 1594 if (type < SVt_LAST) {
1595 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1596
1597 if (type == SVt_NULL) {
5f954473 1598 SvREFCNT_dec_NN(d);
5357ca29
NC		 1599 return;
1600 }
1601 } else {
faccc32b 1602 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
5f954473 1603 SvREFCNT_dec_NN(d);
3967c732
JD		 1604 return;
1605 }
e0bbf362
DM		 1606
1607 /* Dump general SV fields */
1608
27bd069f 1609 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
0a0c4b76
NC		 1610 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1611 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
4df7f6af 1612 || (type == SVt_IV && !SvROK(sv))) {
765f542d 1613 if (SvIsUV(sv)
f8c7b90f 1614#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1615 || SvIsCOW(sv)
1616#endif
1617 )
57def98f 1618 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1619 else
57def98f 1620 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
f8c7b90f 1621#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1622 if (SvIsCOW_shared_hash(sv))
1623 PerlIO_printf(file, " (HASH)");
1624 else if (SvIsCOW_normal(sv))
1625 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1626#endif
3967c732
JD		 1627 PerlIO_putc(file, '\n');
1628 }
e0bbf362 1629
1979170b
NC		 1630 if ((type == SVt_PVNV || type == SVt_PVMG)
1631 && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
0e4c4423
NC		 1632 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1633 (UV) COP_SEQ_RANGE_LOW(sv));
1634 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1635 (UV) COP_SEQ_RANGE_HIGH(sv));
1636 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
08e44740 1637 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
c0a413d1 1638 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
0e4c4423 1639 || type == SVt_NV) {
e54dc35b 1640 STORE_NUMERIC_LOCAL_SET_STANDARD();
57def98f 1641 /* %Vg doesn't work? --jhi */
cf2093f6 1642#ifdef USE_LONG_DOUBLE
2d4389e4 1643 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
cf2093f6 1644#else
cea2e8a9 1645 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
cf2093f6 1646#endif
e54dc35b 1647 RESTORE_NUMERIC_LOCAL();
3967c732 1648 }
e0bbf362 1649
3967c732 1650 if (SvROK(sv)) {
57def98f 1651 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732
JD		 1652 if (nest < maxnest)
1653 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1654 }
e0bbf362 1655
cea89e20 1656 if (type < SVt_PV) {
5f954473 1657 SvREFCNT_dec_NN(d);
3967c732 1658 return;
cea89e20 1659 }
e0bbf362 1660
dea823b3 1661 if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
8d919b0a
FC		 1662 const bool re = isREGEXP(sv);
1663 const char * const ptr =
1664 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1665 if (ptr) {
69240efd 1666 STRLEN delta;
7a4bba22 1667 if (SvOOK(sv)) {
69240efd 1668 SvOOK_offset(sv, delta);
7a4bba22 1669 Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
5186cc12 1670 (UV) delta);
69240efd
NC		 1671 } else {
1672 delta = 0;
7a4bba22 1673 }
8d919b0a 1674 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
7a4bba22
NC		 1675 if (SvOOK(sv)) {
1676 PerlIO_printf(file, "( %s . ) ",
8d919b0a 1677 pv_display(d, ptr - delta, delta, 0,
7a4bba22
NC		 1678 pvlim));
1679 }
8d919b0a
FC		 1680 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1681 re ? 0 : SvLEN(sv),
1682 pvlim));
e9569a7a
GG		 1683 if (SvUTF8(sv)) /* the 6? \x{....} */
1684 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
e6abe6d8 1685 PerlIO_printf(file, "\n");
57def98f 1686 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
8d919b0a
FC		 1687 if (!re)
1688 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1689 (IV)SvLEN(sv));
db2c6cb3
FC		 1690#ifdef PERL_NEW_COPY_ON_WRITE
1691 if (SvIsCOW(sv) && SvLEN(sv))
1692 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1693 CowREFCNT(sv));
1694#endif
3967c732
JD		 1695 }
1696 else
cea2e8a9 1697 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1698 }
e0bbf362 1699
3967c732 1700 if (type >= SVt_PVMG) {
0e4c4423 1701 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
61f9802b 1702 HV * const ost = SvOURSTASH(sv);
38cbaf55
RGS		 1703 if (ost)
1704 do_hv_dump(level, file, " OURSTASH", ost);
0e4c4423
NC		 1705 } else {
1706 if (SvMAGIC(sv))
8530ff28 1707 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
0e4c4423 1708 }
3967c732
JD		 1709 if (SvSTASH(sv))
1710 do_hv_dump(level, file, " STASH", SvSTASH(sv));
c13a5c80
NC		 1711
1712 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
1713 Perl_dump_indent(aTHX_ level, file, " RARE = %u\n", (U8)BmRARE(sv));
1714 Perl_dump_indent(aTHX_ level, file, " PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
1715 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1716 }
3967c732 1717 }
e0bbf362
DM		 1718
1719 /* Dump type-specific SV fields */
1720
3967c732 1721 switch (type) {
3967c732 1722 case SVt_PVAV:
57def98f 1723 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1724 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f
JH		 1725 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1726 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732
JD		 1727 }
1728 else
1729 PerlIO_putc(file, '\n');
57def98f
JH		 1730 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1731 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
a3874608 1732 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
76f68e9b 1733 sv_setpvs(d, "");
11ca45c0
NC		 1734 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1735 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP		 1736 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1737 SvCUR(d) ? SvPVX_const(d) + 1 : "");
502c6561 1738 if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
3967c732 1739 int count;
502c6561
NC		 1740 for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
1741 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
3967c732 1742
57def98f 1743 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1744 if (elt)
3967c732
JD		 1745 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1746 }
1747 }
1748 break;
1749 case SVt_PVHV:
57def98f 1750 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1b95d04f 1751 if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
3967c732
JD		 1752 /* Show distribution of HEs in the ARRAY */
1753 int freq[200];
bb7a0f54 1754#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
3967c732
JD		 1755 int i;
1756 int max = 0;
1b95d04f 1757 U32 pow2 = 2, keys = HvUSEDKEYS(sv);
65202027 1758 NV theoret, sum = 0;
3967c732
JD		 1759
1760 PerlIO_printf(file, " (");
1761 Zero(freq, FREQ_MAX + 1, int);
eb160463 1762 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL		 1763 HE* h;
1764 int count = 0;
3967c732
JD		 1765 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1766 count++;
1767 if (count > FREQ_MAX)
1768 count = FREQ_MAX;
1769 freq[count]++;
1770 if (max < count)
1771 max = count;
1772 }
1773 for (i = 0; i <= max; i++) {
1774 if (freq[i]) {
1775 PerlIO_printf(file, "%d%s:%d", i,
1776 (i == FREQ_MAX) ? "+" : "",
1777 freq[i]);
1778 if (i != max)
1779 PerlIO_printf(file, ", ");
1780 }
1781 }
1782 PerlIO_putc(file, ')');
b8fa94d8
MG		 1783 /* The "quality" of a hash is defined as the total number of
1784 comparisons needed to access every element once, relative
1785 to the expected number needed for a random hash.
1786
1787 The total number of comparisons is equal to the sum of
e76cd0fa
AMS		 1788 the squares of the number of entries in each bucket.
1789 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG		 1790 value is
1791 n + n(n-1)/2k
1792 */
1793
3967c732
JD		 1794 for (i = max; i > 0; i--) { /* Precision: count down. */
1795 sum += freq[i] * i * i;
1796 }
155aba94 1797 while ((keys = keys >> 1))
3967c732 1798 pow2 = pow2 << 1;
1b95d04f 1799 theoret = HvUSEDKEYS(sv);
b8fa94d8 1800 theoret += theoret * (theoret-1)/pow2;
3967c732 1801 PerlIO_putc(file, '\n');
6b4667fc 1802 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732
JD		 1803 }
1804 PerlIO_putc(file, '\n');
1b95d04f 1805 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
9faf471a
NC		 1806 {
1807 STRLEN count = 0;
1808 HE **ents = HvARRAY(sv);
1809
1810 if (ents) {
1811 HE *const *const last = ents + HvMAX(sv);
1812 count = last + 1 - ents;
1813
1814 do {
1815 if (!*ents)
1816 --count;
1817 } while (++ents <= last);
1818 }
1819
1820 if (SvOOK(sv)) {
1821 struct xpvhv_aux *const aux = HvAUX(sv);
1822 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1823 " (cached = %"UVuf")\n",
1824 (UV)count, (UV)aux->xhv_fill_lazy);
1825 } else {
1826 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1827 (UV)count);
1828 }
1829 }
57def98f 1830 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
e1a7ec8d
YO		 1831 if (SvOOK(sv)) {
1832 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1833 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
6a5b4183 1834#ifdef PERL_HASH_RANDOMIZE_KEYS
e1a7ec8d
YO		 1835 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1836 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
6a5b4183 1837 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
e1a7ec8d 1838 }
6a5b4183
YO		 1839#endif
1840 PerlIO_putc(file, '\n');
e1a7ec8d 1841 }
8d2f4536 1842 {
b9ac451d 1843 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536
NC		 1844 if (mg && mg->mg_obj) {
1845 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1846 }
1847 }
bfcb3514 1848 {
b9ac451d 1849 const char * const hvname = HvNAME_get(sv);
17605be7
DM		 1850 if (hvname)
1851 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
bfcb3514 1852 }
86f55936 1853 if (SvOOK(sv)) {
ad64d0ec 1854 AV * const backrefs
85fbaab2 1855 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
7d88e6c4 1856 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
67e04715
FC		 1857 if (HvAUX(sv)->xhv_name_count)
1858 Perl_dump_indent(aTHX_
7afc2217
FC		 1859 level, file, " NAMECOUNT = %"IVdf"\n",
1860 (IV)HvAUX(sv)->xhv_name_count
67e04715 1861 );
15d9236d 1862 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
ec3405c8
NC		 1863 const I32 count = HvAUX(sv)->xhv_name_count;
1864 if (count) {
1865 SV * const names = newSVpvs_flags("", SVs_TEMP);
1866 /* The starting point is the first element if count is
1867 positive and the second element if count is negative. */
1868 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1869 + (count < 0 ? 1 : 0);
1870 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1871 + (count < 0 ? -count : count);
1872 while (hekp < endp) {
17605be7
DM		 1873 if (*hekp) {
1874 sv_catpvs(names, ", \"");
1875 sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp));
1876 sv_catpvs(names, "\"");
ec3405c8
NC		 1877 } else {
1878 /* This should never happen. */
1879 sv_catpvs(names, ", (null)");
67e04715 1880 }
ec3405c8
NC		 1881 ++hekp;
1882 }
67e04715
FC		 1883 Perl_dump_indent(aTHX_
1884 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1885 );
1886 }
17605be7 1887 else
67e04715 1888 Perl_dump_indent(aTHX_
17605be7
DM		 1889 level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
1890 );
67e04715 1891 }
86f55936
NC		 1892 if (backrefs) {
1893 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1894 PTR2UV(backrefs));
ad64d0ec 1895 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
86f55936
NC		 1896 dumpops, pvlim);
1897 }
7d88e6c4
NC		 1898 if (meta) {
1899 /* FIXME - mro_algs kflags can signal a UTF-8 name. */
1900 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
1901 (int)meta->mro_which->length,
1902 meta->mro_which->name,
1903 PTR2UV(meta->mro_which));
1904 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1905 (UV)meta->cache_gen);
1906 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
1907 (UV)meta->pkg_gen);
1908 if (meta->mro_linear_all) {
1909 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
1910 PTR2UV(meta->mro_linear_all));
1911 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1912 dumpops, pvlim);
1913 }
1914 if (meta->mro_linear_current) {
1915 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1916 PTR2UV(meta->mro_linear_current));
1917 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1918 dumpops, pvlim);
1919 }
1920 if (meta->mro_nextmethod) {
1921 Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
1922 PTR2UV(meta->mro_nextmethod));
1923 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1924 dumpops, pvlim);
1925 }
1926 if (meta->isa) {
1927 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
1928 PTR2UV(meta->isa));
1929 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1930 dumpops, pvlim);
1931 }
1932 }
86f55936 1933 }
b5698553 1934 if (nest < maxnest) {
cbab3169 1935 HV * const hv = MUTABLE_HV(sv);
b5698553
TH		 1936 STRLEN i;
1937 HE *he;
cbab3169 1938
b5698553
TH		 1939 if (HvARRAY(hv)) {
1940 int count = maxnest - nest;
1941 for (i=0; i <= HvMAX(hv); i++) {
1942 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1943 U32 hash;
1944 SV * keysv;
1945 const char * keypv;
1946 SV * elt;
7dc86639 1947 STRLEN len;
b5698553
TH		 1948
1949 if (count-- <= 0) goto DONEHV;
1950
1951 hash = HeHASH(he);
1952 keysv = hv_iterkeysv(he);
1953 keypv = SvPV_const(keysv, len);
1954 elt = HeVAL(he);
cbab3169 1955
7dc86639
YO		 1956 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1957 if (SvUTF8(keysv))
1958 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
b5698553
TH		 1959 if (HvEITER_get(hv) == he)
1960 PerlIO_printf(file, "[CURRENT] ");
7dc86639
YO		 1961 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1962 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1963 }
b5698553
TH		 1964 }
1965 DONEHV:;
1966 }
3967c732
JD		 1967 }
1968 break;
e0bbf362 1969
3967c732 1970 case SVt_PVCV:
8fa6a409 1971 if (CvAUTOLOAD(sv)) {
cbf82dd0 1972 STRLEN len;
8fa6a409
FC		 1973 const char *const name = SvPV_const(sv, len);
1974 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%.*s\"\n",
1975 (int) len, name);
1976 }
1977 if (SvPOK(sv)) {
cbf82dd0 1978 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
8fa6a409 1979 (int) CvPROTOLEN(sv), CvPROTO(sv));
cbf82dd0 1980 }
3967c732
JD		 1981 /* FALL THROUGH */
1982 case SVt_PVFM:
1983 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC		 1984 if (!CvISXSUB(sv)) {
1985 if (CvSTART(sv)) {
1986 Perl_dump_indent(aTHX_ level, file,
1987 " START = 0x%"UVxf" ===> %"IVdf"\n",
1988 PTR2UV(CvSTART(sv)),
1989 (IV)sequence_num(CvSTART(sv)));
1990 }
1991 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
1992 PTR2UV(CvROOT(sv)));
1993 if (CvROOT(sv) && dumpops) {
1994 do_op_dump(level+1, file, CvROOT(sv));
1995 }
1996 } else {
126f53f3 1997 SV * const constant = cv_const_sv((const CV *)sv);
b1886099 1998
d04ba589 1999 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099
NC		 2000
2001 if (constant) {
2002 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
2003 " (CONST SV)\n",
2004 PTR2UV(CvXSUBANY(sv).any_ptr));
2005 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2006 pvlim);
2007 } else {
2008 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
2009 (IV)CvXSUBANY(sv).any_i32);
2010 }
2011 }
3610c89f
FC		 2012 if (CvNAMED(sv))
2013 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2014 HEK_KEY(CvNAME_HEK((CV *)sv)));
2015 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 2016 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
bb02a38f 2017 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 2018 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 2019 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
57def98f 2020 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4
DM		 2021 if (nest < maxnest) {
2022 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732
JD		 2023 }
2024 {
b9ac451d 2025 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 2026 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 2027 PTR2UV(outside),
cf2093f6
JH		 2028 (!outside ? "null"
2029 : CvANON(outside) ? "ANON"
2030 : (outside == PL_main_cv) ? "MAIN"
2031 : CvUNIQUE(outside) ? "UNIQUE"
2032 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
3967c732
JD		 2033 }
2034 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
ad64d0ec 2035 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
3967c732 2036 break;
e0bbf362 2037
926fc7b6
DM		 2038 case SVt_PVGV:
2039 case SVt_PVLV:
b9ac451d
AL		 2040 if (type == SVt_PVLV) {
2041 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2042 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2043 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2044 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
83f78d1a 2045 Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
b9ac451d
AL		 2046 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2047 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2048 dumpops, pvlim);
2049 }
8d919b0a 2050 if (isREGEXP(sv)) goto dumpregexp;
926fc7b6
DM		 2051 if (!isGV_with_GP(sv))
2052 break;
cea2e8a9 2053 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
57def98f 2054 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 2055 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
57def98f 2056 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c
GS		 2057 if (!GvGP(sv))
2058 break;
57def98f
JH		 2059 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2060 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2061 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2062 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2063 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2064 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2065 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2066 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 2067 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 2068 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
e39917cc 2069 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
3967c732
JD		 2070 do_gv_dump (level, file, " EGV", GvEGV(sv));
2071 break;
2072 case SVt_PVIO:
57def98f
JH		 2073 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2074 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2075 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2076 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2077 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2078 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2079 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 2080 if (IoTOP_NAME(sv))
cea2e8a9 2081 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC		 2082 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2083 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2084 else {
2085 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2086 PTR2UV(IoTOP_GV(sv)));
ad64d0ec
NC		 2087 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2088 maxnest, dumpops, pvlim);
9ba1f565
NC		 2089 }
2090 /* Source filters hide things that are not GVs in these three, so let's
2091 be careful out there. */
27533608 2092 if (IoFMT_NAME(sv))
cea2e8a9 2093 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC		 2094 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2095 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2096 else {
2097 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2098 PTR2UV(IoFMT_GV(sv)));
ad64d0ec
NC		 2099 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2100 maxnest, dumpops, pvlim);
9ba1f565 2101 }
27533608 2102 if (IoBOTTOM_NAME(sv))
cea2e8a9 2103 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC		 2104 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2105 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2106 else {
2107 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2108 PTR2UV(IoBOTTOM_GV(sv)));
ad64d0ec
NC		 2109 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2110 maxnest, dumpops, pvlim);
9ba1f565 2111 }
27533608 2112 if (isPRINT(IoTYPE(sv)))
cea2e8a9 2113 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 2114 else
cea2e8a9 2115 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 2116 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732 2117 break;
206ee256 2118 case SVt_REGEXP:
8d919b0a 2119 dumpregexp:
d63e6659 2120 {
8d919b0a 2121 struct regexp * const r = ReANY((REGEXP*)sv);
ec16d31f
YO		 2122#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
2123 sv_setpv(d,""); \
2124 append_flags(d, flags, regexp_flags_names); \
2125 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2126 SvCUR_set(d, SvCUR(d) - 1); \
2127 SvPVX(d)[SvCUR(d)] = '\0'; \
2128 } \
2129} STMT_END
2130 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
dbc200c5
YO		 2131 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2132 (UV)(r->compflags), SvPVX_const(d));
2133
ec16d31f 2134 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
d63e6659 2135 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
dbc200c5 2136 (UV)(r->extflags), SvPVX_const(d));
ec16d31f 2137#undef SV_SET_STRINGIFY_REGEXP_FLAGS
dbc200c5 2138
d63e6659
DM		 2139 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
2140 (UV)(r->intflags));
2141 Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2142 (UV)(r->nparens));
2143 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2144 (UV)(r->lastparen));
2145 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2146 (UV)(r->lastcloseparen));
2147 Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2148 (IV)(r->minlen));
2149 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2150 (IV)(r->minlenret));
2151 Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2152 (UV)(r->gofs));
2153 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2154 (UV)(r->pre_prefix));
d63e6659
DM		 2155 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2156 (IV)(r->sublen));
6502e081
DM		 2157 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2158 (IV)(r->suboffset));
2159 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2160 (IV)(r->subcoffset));
d63e6659
DM		 2161 if (r->subbeg)
2162 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2163 PTR2UV(r->subbeg),
2164 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2165 else
2166 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
2167 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
2168 PTR2UV(r->engine));
2169 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2170 PTR2UV(r->mother_re));
2171 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2172 PTR2UV(r->paren_names));
2173 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2174 PTR2UV(r->substrs));
2175 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2176 PTR2UV(r->pprivate));
2177 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2178 PTR2UV(r->offs));
d63c20f2
DM		 2179 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2180 PTR2UV(r->qr_anoncv));
db2c6cb3 2181#ifdef PERL_ANY_COW
d63e6659
DM		 2182 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2183 PTR2UV(r->saved_copy));
2184#endif
2185 }
206ee256 2186 break;
3967c732 2187 }
5f954473 2188 SvREFCNT_dec_NN(d);
3967c732
JD		 2189}
2190
2191void
864dbfa3 2192Perl_sv_dump(pTHX_ SV *sv)
3967c732 2193{
97aff369 2194 dVAR;
7918f24d
NC		 2195
2196 PERL_ARGS_ASSERT_SV_DUMP;
2197
d1029faa
JP		 2198 if (SvROK(sv))
2199 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2200 else
2201 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 2202}
bd16a5f0
IZ		 2203
2204int
2205Perl_runops_debug(pTHX)
2206{
97aff369 2207 dVAR;
bd16a5f0 2208 if (!PL_op) {
9b387841 2209 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ		 2210 return 0;
2211 }
2212
9f3673fb 2213 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 2214 do {
bd16a5f0 2215 if (PL_debug) {
b9ac451d 2216 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0
IZ		 2217 PerlIO_printf(Perl_debug_log,
2218 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2219 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2220 PTR2UV(*PL_watchaddr));
d6721266
DM		 2221 if (DEBUG_s_TEST_) {
2222 if (DEBUG_v_TEST_) {
2223 PerlIO_printf(Perl_debug_log, "\n");
2224 deb_stack_all();
2225 }
2226 else
2227 debstack();
2228 }
2229
2230
bd16a5f0
IZ		 2231 if (DEBUG_t_TEST_) debop(PL_op);
2232 if (DEBUG_P_TEST_) debprof(PL_op);
2233 }
fe83c362
SM		 2234
2235 OP_ENTRY_PROBE(OP_NAME(PL_op));
16c91539 2236 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
9f3673fb 2237 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
47c9d59f 2238 PERL_ASYNC_CHECK();
bd16a5f0
IZ		 2239
2240 TAINT_NOT;
2241 return 0;
2242}
2243
2244I32
6867be6d 2245Perl_debop(pTHX_ const OP *o)
bd16a5f0 2246{
97aff369 2247 dVAR;
7918f24d
NC		 2248
2249 PERL_ARGS_ASSERT_DEBOP;
2250
1045810a
IZ		 2251 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2252 return 0;
2253
bd16a5f0
IZ		 2254 Perl_deb(aTHX_ "%s", OP_NAME(o));
2255 switch (o->op_type) {
2256 case OP_CONST:
996c9baa 2257 case OP_HINTSEVAL:
6cefa69e 2258 /* With ITHREADS, consts are stored in the pad, and the right pad
7367e658 2259 * may not be active here, so check.
6cefa69e 2260 * Looks like only during compiling the pads are illegal.
7367e658 2261 */
6cefa69e
RU		 2262#ifdef USE_ITHREADS
2263 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2264#endif
7367e658 2265 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
bd16a5f0
IZ		 2266 break;
2267 case OP_GVSV:
2268 case OP_GV:
2269 if (cGVOPo_gv) {
b9ac451d 2270 SV * const sv = newSV(0);
3b721df9 2271#ifdef PERL_MAD
84021b46 2272 /* FIXME - is this making unwarranted assumptions about the
3b721df9
NC		 2273 UTF-8 cleanliness of the dump file handle? */
2274 SvUTF8_on(sv);
2275#endif
bd61b366 2276 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 2277 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
5f954473 2278 SvREFCNT_dec_NN(sv);
bd16a5f0
IZ		 2279 }
2280 else
2281 PerlIO_printf(Perl_debug_log, "(NULL)");
2282 break;
a7fd8ef6
DM		 2283
2284 {
2285 int count;
2286
bd16a5f0
IZ		 2287 case OP_PADSV:
2288 case OP_PADAV:
2289 case OP_PADHV:
a7fd8ef6
DM		 2290 count = 1;
2291 goto dump_padop;
2292 case OP_PADRANGE:
2293 count = o->op_private & OPpPADRANGE_COUNTMASK;
2294 dump_padop:
bd16a5f0 2295 /* print the lexical's name */
a7fd8ef6
DM		 2296 {
2297 CV * const cv = deb_curcv(cxstack_ix);
2298 SV *sv;
2299 PAD * comppad = NULL;
2300 int i;
2301
2302 if (cv) {
2303 PADLIST * const padlist = CvPADLIST(cv);
2304 comppad = *PadlistARRAY(padlist);
2305 }
2306 PerlIO_printf(Perl_debug_log, "(");
2307 for (i = 0; i < count; i++) {
2308 if (comppad &&
2309 (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2310 PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2311 else
2312 PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2313 (UV)o->op_targ+i);
2314 if (i < count-1)
2315 PerlIO_printf(Perl_debug_log, ",");
2316 }
2317 PerlIO_printf(Perl_debug_log, ")");
2318 }
bd16a5f0 2319 break;
a7fd8ef6
DM		 2320 }
2321
bd16a5f0 2322 default:
091ab601 2323 break;
bd16a5f0
IZ		 2324 }
2325 PerlIO_printf(Perl_debug_log, "\n");
2326 return 0;
2327}
2328
2329STATIC CV*
61f9802b 2330S_deb_curcv(pTHX_ const I32 ix)
bd16a5f0 2331{
97aff369 2332 dVAR;
b9ac451d 2333 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0
IZ		 2334 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2335 return cx->blk_sub.cv;
2336 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
676a678a 2337 return cx->blk_eval.cv;
bd16a5f0
IZ		 2338 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2339 return PL_main_cv;
2340 else if (ix <= 0)
601f1833 2341 return NULL;
bd16a5f0
IZ		 2342 else
2343 return deb_curcv(ix - 1);
2344}
2345
2346void
2347Perl_watch(pTHX_ char **addr)
2348{
97aff369 2349 dVAR;
7918f24d
NC		 2350
2351 PERL_ARGS_ASSERT_WATCH;
2352
bd16a5f0
IZ		 2353 PL_watchaddr = addr;
2354 PL_watchok = *addr;
2355 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2356 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2357}
2358
2359STATIC void
e1ec3a88 2360S_debprof(pTHX_ const OP *o)
bd16a5f0 2361{
97aff369 2362 dVAR;
7918f24d
NC		 2363
2364 PERL_ARGS_ASSERT_DEBPROF;
2365
61f9802b 2366 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2367 return;
bd16a5f0 2368 if (!PL_profiledata)
a02a5408 2369 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ		 2370 ++PL_profiledata[o->op_type];
2371}
2372
2373void
2374Perl_debprofdump(pTHX)
2375{
97aff369 2376 dVAR;
bd16a5f0
IZ		 2377 unsigned i;
2378 if (!PL_profiledata)
2379 return;
2380 for (i = 0; i < MAXO; i++) {
2381 if (PL_profiledata[i])
2382 PerlIO_printf(Perl_debug_log,
2383 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2384 PL_op_name[i]);
2385 }
2386}
66610fdd 2387
3b721df9
NC		 2388#ifdef PERL_MAD
2389/*
2390 * XML variants of most of the above routines
2391 */
2392
4136a0f7 2393STATIC void
3b721df9
NC		 2394S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2395{
2396 va_list args;
7918f24d
NC		 2397
2398 PERL_ARGS_ASSERT_XMLDUMP_ATTR;
2399
3b721df9
NC		 2400 PerlIO_printf(file, "\n ");
2401 va_start(args, pat);
2402 xmldump_vindent(level, file, pat, &args);
2403 va_end(args);
2404}
2405
2406
2407void
2408Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2409{
2410 va_list args;
7918f24d 2411 PERL_ARGS_ASSERT_XMLDUMP_INDENT;
3b721df9
NC		 2412 va_start(args, pat);
2413 xmldump_vindent(level, file, pat, &args);
2414 va_end(args);
2415}
2416
2417void
2418Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
2419{
7918f24d
NC		 2420 PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
2421
3b721df9
NC		 2422 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
2423 PerlIO_vprintf(file, pat, *args);
2424}
2425
2426void
2427Perl_xmldump_all(pTHX)
2428{
f0e3f042
CS		 2429 xmldump_all_perl(FALSE);
2430}
2431
2432void
0190d5ef 2433Perl_xmldump_all_perl(pTHX_ bool justperl PERL_UNUSED_DECL)
f0e3f042 2434{
3b721df9
NC		 2435 PerlIO_setlinebuf(PL_xmlfp);
2436 if (PL_main_root)
2437 op_xmldump(PL_main_root);
0190d5ef
CS		 2438 /* someday we might call this, when it outputs XML: */
2439 /* xmldump_packsubs_perl(PL_defstash, justperl); */
3b721df9
NC		 2440 if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2441 PerlIO_close(PL_xmlfp);
2442 PL_xmlfp = 0;
2443}
2444
2445void
2446Perl_xmldump_packsubs(pTHX_ const HV *stash)
2447{
28eb953d 2448 PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
3ab0c9fa
NC		 2449 xmldump_packsubs_perl(stash, FALSE);
2450}
2451
2452void
2453Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
2454{
3b721df9
NC		 2455 I32 i;
2456 HE *entry;
2457
28eb953d 2458 PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
7918f24d 2459
3b721df9
NC		 2460 if (!HvARRAY(stash))
2461 return;
2462 for (i = 0; i <= (I32) HvMAX(stash); i++) {
2463 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
159b6efe 2464 GV *gv = MUTABLE_GV(HeVAL(entry));
3b721df9
NC		 2465 HV *hv;
2466 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
2467 continue;
2468 if (GvCVu(gv))
3ab0c9fa 2469 xmldump_sub_perl(gv, justperl);
3b721df9
NC		 2470 if (GvFORM(gv))
2471 xmldump_form(gv);
2472 if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2473 && (hv = GvHV(gv)) && hv != PL_defstash)
3ab0c9fa 2474 xmldump_packsubs_perl(hv, justperl); /* nested package */
3b721df9
NC		 2475 }
2476 }
2477}
2478
2479void
2480Perl_xmldump_sub(pTHX_ const GV *gv)
2481{
28eb953d 2482 PERL_ARGS_ASSERT_XMLDUMP_SUB;
f0e3f042
CS		 2483 xmldump_sub_perl(gv, FALSE);
2484}
2485
2486void
2487Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
2488{
2489 SV * sv;
3b721df9 2490
28eb953d 2491 PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
7918f24d 2492
f0e3f042
CS		 2493 if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
2494 return;
2495
2496 sv = sv_newmortal();
1a9a51d4 2497 gv_fullname3(sv, gv, NULL);
3b721df9
NC		 2498 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2499 if (CvXSUB(GvCV(gv)))
2500 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2501 PTR2UV(CvXSUB(GvCV(gv))),
2502 (int)CvXSUBANY(GvCV(gv)).any_i32);
2503 else if (CvROOT(GvCV(gv)))
2504 op_xmldump(CvROOT(GvCV(gv)));
2505 else
2506 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2507}
2508
2509void
2510Perl_xmldump_form(pTHX_ const GV *gv)
2511{
61f9802b 2512 SV * const sv = sv_newmortal();
3b721df9 2513
7918f24d
NC		 2514 PERL_ARGS_ASSERT_XMLDUMP_FORM;
2515
1a9a51d4 2516 gv_fullname3(sv, gv, NULL);
3b721df9
NC		 2517 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2518 if (CvROOT(GvFORM(gv)))
2519 op_xmldump(CvROOT(GvFORM(gv)));
2520 else
2521 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2522}
2523
2524void
2525Perl_xmldump_eval(pTHX)
2526{
2527 op_xmldump(PL_eval_root);
2528}
2529
2530char *
2531Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
2532{
7918f24d 2533 PERL_ARGS_ASSERT_SV_CATXMLSV;
3b721df9
NC		 2534 return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2535}
2536
2537char *
9dcc53ea
Z		 2538Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
2539{
2540 PERL_ARGS_ASSERT_SV_CATXMLPV;
2541 return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
2542}
2543
2544char *
20f84293 2545Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
3b721df9
NC		 2546{
2547 unsigned int c;
61f9802b 2548 const char * const e = pv + len;
20f84293 2549 const char * const start = pv;
3b721df9
NC		 2550 STRLEN dsvcur;
2551 STRLEN cl;
2552
7918f24d
NC		 2553 PERL_ARGS_ASSERT_SV_CATXMLPVN;
2554
76f68e9b 2555 sv_catpvs(dsv,"");
3b721df9
NC		 2556 dsvcur = SvCUR(dsv); /* in case we have to restart */
2557
2558 retry:
2559 while (pv < e) {
2560 if (utf8) {
4b88fb76 2561 c = utf8_to_uvchr_buf((U8*)pv, (U8*)e, &cl);
3b721df9
NC		 2562 if (cl == 0) {
2563 SvCUR(dsv) = dsvcur;
2564 pv = start;
2565 utf8 = 0;
2566 goto retry;
2567 }
2568 }
2569 else
2570 c = (*pv & 255);
2571
2572 switch (c) {
2573 case 0x00:
2574 case 0x01:
2575 case 0x02:
2576 case 0x03:
2577 case 0x04:
2578 case 0x05:
2579 case 0x06:
2580 case 0x07:
2581 case 0x08:
2582 case 0x0b:
2583 case 0x0c:
2584 case 0x0e:
2585 case 0x0f:
2586 case 0x10:
2587 case 0x11:
2588 case 0x12:
2589 case 0x13:
2590 case 0x14:
2591 case 0x15:
2592 case 0x16:
2593 case 0x17:
2594 case 0x18:
2595 case 0x19:
2596 case 0x1a:
2597 case 0x1b:
2598 case 0x1c:
2599 case 0x1d:
2600 case 0x1e:
2601 case 0x1f:
2602 case 0x7f:
2603 case 0x80:
2604 case 0x81:
2605 case 0x82:
2606 case 0x83:
2607 case 0x84:
2608 case 0x86:
2609 case 0x87:
2610 case 0x88:
2611 case 0x89:
2612 case 0x90:
2613 case 0x91:
2614 case 0x92:
2615 case 0x93:
2616 case 0x94:
2617 case 0x95:
2618 case 0x96:
2619 case 0x97:
2620 case 0x98:
2621 case 0x99:
2622 case 0x9a:
2623 case 0x9b:
2624 case 0x9c:
2625 case 0x9d:
2626 case 0x9e:
2627 case 0x9f:
2628 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2629 break;
2630 case '<':
f3a2811a 2631 sv_catpvs(dsv, "&lt;");
3b721df9
NC		 2632 break;
2633 case '>':
f3a2811a 2634 sv_catpvs(dsv, "&gt;");
3b721df9
NC		 2635 break;
2636 case '&':
f3a2811a 2637 sv_catpvs(dsv, "&amp;");
3b721df9
NC		 2638 break;
2639 case '"':
49de0815 2640 sv_catpvs(dsv, "&#34;");
3b721df9
NC		 2641 break;
2642 default:
2643 if (c < 0xD800) {
2644 if (c < 32 || c > 127) {
2645 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2646 }
2647 else {
5e7aa789
NC		 2648 const char string = (char) c;
2649 sv_catpvn(dsv, &string, 1);
3b721df9
NC		 2650 }
2651 break;
2652 }
2653 if ((c >= 0xD800 && c <= 0xDB7F) ||
2654 (c >= 0xDC00 && c <= 0xDFFF) ||
2655 (c >= 0xFFF0 && c <= 0xFFFF) ||
2656 c > 0x10ffff)
2657 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2658 else
2659 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2660 }
2661
2662 if (utf8)
2663 pv += UTF8SKIP(pv);
2664 else
2665 pv++;
2666 }
2667
2668 return SvPVX(dsv);
2669}
2670
2671char *
2672Perl_sv_xmlpeek(pTHX_ SV *sv)
2673{
61f9802b 2674 SV * const t = sv_newmortal();
3b721df9
NC		 2675 STRLEN n_a;
2676 int unref = 0;
2677
7918f24d
NC		 2678 PERL_ARGS_ASSERT_SV_XMLPEEK;
2679
3b721df9 2680 sv_utf8_upgrade(t);
76f68e9b 2681 sv_setpvs(t, "");
3b721df9
NC		 2682 /* retry: */
2683 if (!sv) {
2684 sv_catpv(t, "VOID=\"\"");
2685 goto finish;
2686 }
299ef33b 2687 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
3b721df9
NC		 2688 sv_catpv(t, "WILD=\"\"");
2689 goto finish;
2690 }
2691 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
2692 if (sv == &PL_sv_undef) {
2693 sv_catpv(t, "SV_UNDEF=\"1\"");
2694 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2695 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2696 SvREADONLY(sv))
2697 goto finish;
2698 }
2699 else if (sv == &PL_sv_no) {
2700 sv_catpv(t, "SV_NO=\"1\"");
2701 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2702 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2703 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2704 SVp_POK|SVp_NOK)) &&
2705 SvCUR(sv) == 0 &&
2706 SvNVX(sv) == 0.0)
2707 goto finish;
2708 }
2709 else if (sv == &PL_sv_yes) {
2710 sv_catpv(t, "SV_YES=\"1\"");
2711 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2712 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2713 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2714 SVp_POK|SVp_NOK)) &&
2715 SvCUR(sv) == 1 &&
2716 SvPVX(sv) && *SvPVX(sv) == '1' &&
2717 SvNVX(sv) == 1.0)
2718 goto finish;
2719 }
2720 else {
2721 sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2722 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2723 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2724 SvREADONLY(sv))
2725 goto finish;
2726 }
2727 sv_catpv(t, " XXX=\"\" ");
2728 }
2729 else if (SvREFCNT(sv) == 0) {
2730 sv_catpv(t, " refcnt=\"0\"");
2731 unref++;
2732 }
2733 else if (DEBUG_R_TEST_) {
2734 int is_tmp = 0;
2735 I32 ix;
2736 /* is this SV on the tmps stack? */
2737 for (ix=PL_tmps_ix; ix>=0; ix--) {
2738 if (PL_tmps_stack[ix] == sv) {
2739 is_tmp = 1;
2740 break;
2741 }
2742 }
2743 if (SvREFCNT(sv) > 1)
2744 Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2745 is_tmp ? "T" : "");
2746 else if (is_tmp)
2747 sv_catpv(t, " DRT=\"<T>\"");
2748 }
2749
2750 if (SvROK(sv)) {
2751 sv_catpv(t, " ROK=\"\"");
2752 }
2753 switch (SvTYPE(sv)) {
2754 default:
2755 sv_catpv(t, " FREED=\"1\"");
2756 goto finish;
2757
2758 case SVt_NULL:
2759 sv_catpv(t, " UNDEF=\"1\"");
2760 goto finish;
2761 case SVt_IV:
2762 sv_catpv(t, " IV=\"");
2763 break;
2764 case SVt_NV:
2765 sv_catpv(t, " NV=\"");
2766 break;
3b721df9
NC		 2767 case SVt_PV:
2768 sv_catpv(t, " PV=\"");
2769 break;
2770 case SVt_PVIV:
2771 sv_catpv(t, " PVIV=\"");
2772 break;
2773 case SVt_PVNV:
2774 sv_catpv(t, " PVNV=\"");
2775 break;
2776 case SVt_PVMG:
2777 sv_catpv(t, " PVMG=\"");
2778 break;
2779 case SVt_PVLV:
2780 sv_catpv(t, " PVLV=\"");
2781 break;
2782 case SVt_PVAV:
2783 sv_catpv(t, " AV=\"");
2784 break;
2785 case SVt_PVHV:
2786 sv_catpv(t, " HV=\"");
2787 break;
2788 case SVt_PVCV:
2789 if (CvGV(sv))
2790 Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2791 else
2792 sv_catpv(t, " CV=\"()\"");
2793 goto finish;
2794 case SVt_PVGV:
2795 sv_catpv(t, " GV=\"");
2796 break;
a9032aa0
KW		 2797 case SVt_DUMMY:
2798 sv_catpv(t, " DUMMY=\"");
3b721df9 2799 break;
d914baab 2800 case SVt_REGEXP:
8619e557 2801 sv_catpv(t, " REGEXP=\"");
4df7f6af 2802 break;
3b721df9
NC		 2803 case SVt_PVFM:
2804 sv_catpv(t, " FM=\"");
2805 break;
2806 case SVt_PVIO:
2807 sv_catpv(t, " IO=\"");
2808 break;
2809 }
2810
2811 if (SvPOKp(sv)) {
2812 if (SvPVX(sv)) {
2813 sv_catxmlsv(t, sv);
2814 }
2815 }
2816 else if (SvNOKp(sv)) {
2817 STORE_NUMERIC_LOCAL_SET_STANDARD();
2818 Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2819 RESTORE_NUMERIC_LOCAL();
2820 }
2821 else if (SvIOKp(sv)) {
2822 if (SvIsUV(sv))
2823 Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2824 else
2825 Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2826 }
2827 else
2828 sv_catpv(t, "");
2829 sv_catpv(t, "\"");
2830
2831 finish:
61f9802b
AL		 2832 while (unref--)
2833 sv_catpv(t, ")");
3b721df9
NC		 2834 return SvPV(t, n_a);
2835}
2836
2837void
2838Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
2839{
7918f24d
NC		 2840 PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
2841
3b721df9
NC		 2842 if (!pm) {
2843 Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
2844 return;
2845 }
2846 Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
2847 level++;
2848 if (PM_GETRE(pm)) {
d914baab 2849 REGEXP *const r = PM_GETRE(pm);
643e696a 2850 SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
ad64d0ec 2851 sv_catxmlsv(tmpsv, MUTABLE_SV(r));
3b721df9
NC		 2852 Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2853 SvPVX(tmpsv));
5f954473 2854 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 2855 Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2856 (pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2857 }
2858 else
2859 Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
d914baab 2860 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
3df43ef7 2861 SV * const tmpsv = pm_description(pm);
3b721df9 2862 Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
5f954473 2863 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 2864 }
2865
2866 level--;
20e98b0f 2867 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
3b721df9
NC		 2868 Perl_xmldump_indent(aTHX_ level, file, ">\n");
2869 Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
20e98b0f 2870 do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
3b721df9
NC		 2871 Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
2872 Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
2873 }
2874 else
2875 Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2876}
2877
2878void
2879Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2880{
2881 do_pmop_xmldump(0, PL_xmlfp, pm);
2882}
2883
2884void
2885Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
2886{
2887 UV seq;
2888 int contents = 0;
75a6ad4a 2889 const OPCODE optype = o->op_type;
7918f24d
NC		 2890
2891 PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
2892
3b721df9
NC		 2893 if (!o)
2894 return;
3b721df9
NC		 2895 seq = sequence_num(o);
2896 Perl_xmldump_indent(aTHX_ level, file,
2897 "<op_%s seq=\"%"UVuf" -> ",
2898 OP_NAME(o),
2899 seq);
2900 level++;
2901 if (o->op_next)
2902 PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2903 sequence_num(o->op_next));
2904 else
2905 PerlIO_printf(file, "DONE\"");
2906
2907 if (o->op_targ) {
75a6ad4a 2908 if (optype == OP_NULL)
3b721df9
NC		 2909 {
2910 PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2911 if (o->op_targ == OP_NEXTSTATE)
2912 {
2913 if (CopLINE(cCOPo))
f5992bc4 2914 PerlIO_printf(file, " line=\"%"UVuf"\"",
3b721df9
NC		 2915 (UV)CopLINE(cCOPo));
2916 if (CopSTASHPV(cCOPo))
2917 PerlIO_printf(file, " package=\"%s\"",
2918 CopSTASHPV(cCOPo));
4b65a919 2919 if (CopLABEL(cCOPo))
3b721df9 2920 PerlIO_printf(file, " label=\"%s\"",
4b65a919 2921 CopLABEL(cCOPo));
3b721df9
NC		 2922 }
2923 }
2924 else
2925 PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2926 }
2927#ifdef DUMPADDR
2928 PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2929#endif
3b721df9 2930
75a6ad4a
RU		 2931 DUMP_OP_FLAGS(o,1,0,file);
2932 DUMP_OP_PRIVATE(o,1,0,file);
2933
2934 switch (optype) {
3b721df9
NC		 2935 case OP_AELEMFAST:
2936 if (o->op_flags & OPf_SPECIAL) {
2937 break;
2938 }
2939 case OP_GVSV:
2940 case OP_GV:
2941#ifdef USE_ITHREADS
2942 S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
2943#else
2944 if (cSVOPo->op_sv) {
d914baab
NC		 2945 SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
2946 SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
3b721df9
NC		 2947 char *s;
2948 STRLEN len;
2949 ENTER;
2950 SAVEFREESV(tmpsv1);
2951 SAVEFREESV(tmpsv2);
159b6efe 2952 gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
3b721df9
NC		 2953 s = SvPV(tmpsv1,len);
2954 sv_catxmlpvn(tmpsv2, s, len, 1);
2955 S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
2956 LEAVE;
2957 }
2958 else
2959 S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
2960#endif
2961 break;
2962 case OP_CONST:
996c9baa 2963 case OP_HINTSEVAL:
3b721df9
NC		 2964 case OP_METHOD_NAMED:
2965#ifndef USE_ITHREADS
2966 /* with ITHREADS, consts are stored in the pad, and the right pad
2967 * may not be active here, so skip */
2968 S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
2969#endif
2970 break;
2971 case OP_ANONCODE:
2972 if (!contents) {
2973 contents = 1;
2974 PerlIO_printf(file, ">\n");
2975 }
2976 do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
2977 break;
3b721df9
NC		 2978 case OP_NEXTSTATE:
2979 case OP_DBSTATE:
2980 if (CopLINE(cCOPo))
f5992bc4 2981 S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
3b721df9
NC		 2982 (UV)CopLINE(cCOPo));
2983 if (CopSTASHPV(cCOPo))
2984 S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
2985 CopSTASHPV(cCOPo));
4b65a919 2986 if (CopLABEL(cCOPo))
3b721df9 2987 S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
4b65a919 2988 CopLABEL(cCOPo));
3b721df9
NC		 2989 break;
2990 case OP_ENTERLOOP:
2991 S_xmldump_attr(aTHX_ level, file, "redo=\"");
2992 if (cLOOPo->op_redoop)
2993 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
2994 else
2995 PerlIO_printf(file, "DONE\"");
2996 S_xmldump_attr(aTHX_ level, file, "next=\"");
2997 if (cLOOPo->op_nextop)
2998 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
2999 else
3000 PerlIO_printf(file, "DONE\"");
3001 S_xmldump_attr(aTHX_ level, file, "last=\"");
3002 if (cLOOPo->op_lastop)
3003 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
3004 else
3005 PerlIO_printf(file, "DONE\"");
3006 break;
3007 case OP_COND_EXPR:
3008 case OP_RANGE:
3009 case OP_MAPWHILE:
3010 case OP_GREPWHILE:
3011 case OP_OR:
3012 case OP_AND:
3013 S_xmldump_attr(aTHX_ level, file, "other=\"");
3014 if (cLOGOPo->op_other)
3015 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
3016 else
3017 PerlIO_printf(file, "DONE\"");
3018 break;
3019 case OP_LEAVE:
3020 case OP_LEAVEEVAL:
3021 case OP_LEAVESUB:
3022 case OP_LEAVESUBLV:
3023 case OP_LEAVEWRITE:
3024 case OP_SCOPE:
3025 if (o->op_private & OPpREFCOUNTED)
3026 S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
3027 break;
3028 default:
3029 break;
3030 }
3031
3032 if (PL_madskills && o->op_madprop) {
fb2b694a 3033 char prevkey = '\0';
d914baab 3034 SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
20f84293 3035 const MADPROP* mp = o->op_madprop;
61f9802b 3036
3b721df9
NC		 3037 if (!contents) {
3038 contents = 1;
3039 PerlIO_printf(file, ">\n");
3040 }
3041 Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
3042 level++;
3043 while (mp) {
3044 char tmp = mp->mad_key;
76f68e9b 3045 sv_setpvs(tmpsv,"\"");
3b721df9
NC		 3046 if (tmp)
3047 sv_catxmlpvn(tmpsv, &tmp, 1, 0);
fb2b694a
GG		 3048 if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
3049 sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
3050 else
3051 prevkey = tmp;
3b721df9
NC		 3052 sv_catpv(tmpsv, "\"");
3053 switch (mp->mad_type) {
3054 case MAD_NULL:
3055 sv_catpv(tmpsv, "NULL");
3056 Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
3057 break;
3058 case MAD_PV:
3059 sv_catpv(tmpsv, " val=\"");
3060 sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
3061 sv_catpv(tmpsv, "\"");
3062 Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
3063 break;
3064 case MAD_SV:
3065 sv_catpv(tmpsv, " val=\"");
ad64d0ec 3066 sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
3b721df9
NC		 3067 sv_catpv(tmpsv, "\"");
3068 Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
3069 break;
3070 case MAD_OP:
3071 if ((OP*)mp->mad_val) {
3072 Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
3073 do_op_xmldump(level+1, file, (OP*)mp->mad_val);
3074 Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
3075 }
3076 break;
3077 default:
3078 Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
3079 break;
3080 }
3081 mp = mp->mad_next;
3082 }
3083 level--;
3084 Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
3085
5f954473 3086 SvREFCNT_dec_NN(tmpsv);
3b721df9
NC		 3087 }
3088
75a6ad4a 3089 switch (optype) {
3b721df9
NC		 3090 case OP_PUSHRE:
3091 case OP_MATCH:
3092 case OP_QR:
3093 case OP_SUBST:
3094 if (!contents) {
3095 contents = 1;
3096 PerlIO_printf(file, ">\n");
3097 }
3098 do_pmop_xmldump(level, file, cPMOPo);
3099 break;
3100 default:
3101 break;
3102 }
3103
3104 if (o->op_flags & OPf_KIDS) {
3105 OP *kid;
3106 if (!contents) {
3107 contents = 1;
3108 PerlIO_printf(file, ">\n");
3109 }
3110 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3111 do_op_xmldump(level, file, kid);
3112 }
3113
3114 if (contents)
3115 Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
3116 else
3117 PerlIO_printf(file, " />\n");
3118}
3119
3120void
3121Perl_op_xmldump(pTHX_ const OP *o)
3122{
7918f24d
NC		 3123 PERL_ARGS_ASSERT_OP_XMLDUMP;
3124
3b721df9
NC		 3125 do_op_xmldump(0, PL_xmlfp, o);
3126}
3127#endif
3128
66610fdd
RGS		 3129/*
3130 * Local variables:
3131 * c-indentation-style: bsd
3132 * c-basic-offset: 4
14d04a33 3133 * indent-tabs-mode: nil
66610fdd
RGS		 3134 * End:
3135 *
14d04a33 3136 * ex: set ts=8 sts=4 sw=4 et:
37442d52 3137 */
Unnamed repository; edit this file 'description' to name the repository.