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