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