This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Don't SEGV when dumping an undefined typeglob. The HEK used to store
[perl5.git] / dump.c
CommitLineData
a0d0e21e 1/* dump.c
a687059c 2 *
4bb101f2 3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
bc641c27 4 * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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/*
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.'"
8d063cd8
LW		 14 */
15
166f8a29 16/* This file contains utility routines to dump the contents of SV and OP
61296642 17 * structures, as used by command-line options like -Dt and -Dx, and
166f8a29
DM		 18 * by Devel::Peek.
19 *
20 * It also holds the debugging version of the runops function.
21 */
22
8d063cd8 23#include "EXTERN.h"
864dbfa3 24#define PERL_IN_DUMP_C
8d063cd8 25#include "perl.h"
f722798b 26#include "regcomp.h"
0bd48802
AL		 27#include "proto.h"
28
8d063cd8 29
5357ca29
NC		 30static const char* const svtypenames[SVt_LAST] = {
31 "NULL",
1cb9cd50 32 "BIND",
5357ca29
NC		 33 "IV",
34 "NV",
35 "RV",
36 "PV",
37 "PVIV",
38 "PVNV",
39 "PVMG",
5357ca29
NC		 40 "PVGV",
41 "PVLV",
42 "PVAV",
43 "PVHV",
44 "PVCV",
45 "PVFM",
46 "PVIO"
47};
48
49
50static const char* const svshorttypenames[SVt_LAST] = {
51 "UNDEF",
1cb9cd50 52 "BIND",
5357ca29
NC		 53 "IV",
54 "NV",
55 "RV",
56 "PV",
57 "PVIV",
58 "PVNV",
59 "PVMG",
5357ca29
NC		 60 "GV",
61 "PVLV",
62 "AV",
63 "HV",
64 "CV",
65 "FM",
66 "IO"
67};
68
27da23d5 69#define Sequence PL_op_sequence
2814eb74 70
3967c732 71void
864dbfa3 72Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
3967c732 73{
3967c732 74 va_list args;
3967c732 75 va_start(args, pat);
c5be433b 76 dump_vindent(level, file, pat, &args);
3967c732
JD		 77 va_end(args);
78}
8adcabd8
LW		 79
80void
c5be433b
GS		 81Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
82{
97aff369 83 dVAR;
c8db6e60 84 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
c5be433b
GS		 85 PerlIO_vprintf(file, pat, *args);
86}
87
88void
864dbfa3 89Perl_dump_all(pTHX)
79072805 90{
97aff369 91 dVAR;
760ac839 92 PerlIO_setlinebuf(Perl_debug_log);
3280af22 93 if (PL_main_root)
3967c732 94 op_dump(PL_main_root);
3280af22 95 dump_packsubs(PL_defstash);
463ee0b2
LW		 96}
97
98void
e1ec3a88 99Perl_dump_packsubs(pTHX_ const HV *stash)
463ee0b2 100{
97aff369 101 dVAR;
a0d0e21e 102 I32 i;
463ee0b2 103
8990e307
LW		 104 if (!HvARRAY(stash))
105 return;
a0d0e21e 106 for (i = 0; i <= (I32) HvMAX(stash); i++) {
e1ec3a88 107 const HE *entry;
4db58590 108 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
e1ec3a88
AL		 109 const GV *gv = (GV*)HeVAL(entry);
110 const HV *hv;
e29cdcb3
GS		 111 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
112 continue;
8ebc5c01 113 if (GvCVu(gv))
463ee0b2 114 dump_sub(gv);
85e6fe83
LW		 115 if (GvFORM(gv))
116 dump_form(gv);
6676db26
AMS		 117 if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
118 && (hv = GvHV(gv)) && hv != PL_defstash)
463ee0b2
LW		 119 dump_packsubs(hv); /* nested package */
120 }
79072805
LW		 121 }
122}
123
124void
e1ec3a88 125Perl_dump_sub(pTHX_ const GV *gv)
a687059c 126{
b464bac0 127 SV * const sv = sv_newmortal();
85e6fe83 128
bd61b366 129 gv_fullname3(sv, gv, NULL);
b15aece3 130 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
aed2304a 131 if (CvISXSUB(GvCV(gv)))
91f3b821
GS		 132 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
133 PTR2UV(CvXSUB(GvCV(gv))),
894356b3 134 (int)CvXSUBANY(GvCV(gv)).any_i32);
85e6fe83 135 else if (CvROOT(GvCV(gv)))
3967c732 136 op_dump(CvROOT(GvCV(gv)));
85e6fe83 137 else
cea2e8a9 138 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
85e6fe83
LW		 139}
140
141void
e1ec3a88 142Perl_dump_form(pTHX_ const GV *gv)
85e6fe83 143{
b464bac0 144 SV * const sv = sv_newmortal();
85e6fe83 145
bd61b366 146 gv_fullname3(sv, gv, NULL);
b15aece3 147 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
85e6fe83 148 if (CvROOT(GvFORM(gv)))
3967c732 149 op_dump(CvROOT(GvFORM(gv)));
85e6fe83 150 else
cea2e8a9 151 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
a687059c
LW		 152}
153
8adcabd8 154void
864dbfa3 155Perl_dump_eval(pTHX)
8d063cd8 156{
97aff369 157 dVAR;
3967c732
JD		 158 op_dump(PL_eval_root);
159}
160
3df15adc
YO		 161
162/*
ddc5bc0f 163=for apidoc Apd|char*|pv_escape|NN SV *dsv|NN const char const *str\
ab3bbdeb
YO		 164 |const STRLEN count|const STRLEN max
165 |STRLEN const *escaped, const U32 flags
3df15adc
YO		 166
167Escapes at most the first "count" chars of pv and puts the results into
ab3bbdeb 168dsv such that the size of the escaped string will not exceed "max" chars
3df15adc
YO		 169and will not contain any incomplete escape sequences.
170
ab3bbdeb
YO		 171If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
172will also be escaped.
3df15adc
YO		 173
174Normally the SV will be cleared before the escaped string is prepared,
ab3bbdeb
YO		 175but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
176
177If PERL_PV_ESCAPE_UNI is set then the input string is treated as unicode,
178if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
179using C<is_utf8_string()> to determine if it is unicode.
180
181If PERL_PV_ESCAPE_ALL is set then all input chars will be output
182using C<\x01F1> style escapes, otherwise only chars above 255 will be
183escaped using this style, other non printable chars will use octal or
184common escaped patterns like C<\n>. If PERL_PV_ESCAPE_NOBACKSLASH
185then all chars below 255 will be treated as printable and
186will be output as literals.
187
188If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
189string will be escaped, regardles of max. If the string is utf8 and
190the chars value is >255 then it will be returned as a plain hex
191sequence. Thus the output will either be a single char,
192an octal escape sequence, a special escape like C<\n> or a 3 or
193more digit hex value.
3df15adc 194
44a2ac75
YO		 195If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
196not a '\\'. This is because regexes very often contain backslashed
197sequences, whereas '%' is not a particularly common character in patterns.
198
ab3bbdeb 199Returns a pointer to the escaped text as held by dsv.
3df15adc
YO		 200
201=cut
202*/
ab3bbdeb 203#define PV_ESCAPE_OCTBUFSIZE 32
ddc5bc0f 204
3967c732 205char *
ddc5bc0f 206Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
ab3bbdeb
YO		 207 const STRLEN count, const STRLEN max,
208 STRLEN * const escaped, const U32 flags )
209{
44a2ac75
YO		 210 char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
211 char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
212 char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
ab3bbdeb
YO		 213 STRLEN wrote = 0; /* chars written so far */
214 STRLEN chsize = 0; /* size of data to be written */
215 STRLEN readsize = 1; /* size of data just read */
216 bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this unicode */
ddc5bc0f
YO		 217 const char *pv = str;
218 const char *end = pv + count; /* end of string */
44a2ac75 219 octbuf[0] = esc;
ab3bbdeb
YO		 220
221 if (!flags & PERL_PV_ESCAPE_NOCLEAR)
3df15adc 222 sv_setpvn(dsv, "", 0);
ab3bbdeb 223
ddc5bc0f 224 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
ab3bbdeb
YO		 225 isuni = 1;
226
227 for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
ddc5bc0f 228 const UV u= (isuni) ? utf8_to_uvchr((U8*)pv, &readsize) : (U8)*pv;
ab3bbdeb
YO		 229 const U8 c = (U8)u & 0xFF;
230
231 if ( ( u > 255 ) || (flags & PERL_PV_ESCAPE_ALL)) {
232 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
233 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
234 "%"UVxf, u);
235 else
236 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 237 "%cx{%"UVxf"}", esc, u);
ab3bbdeb
YO		 238 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
239 chsize = 1;
240 } else {
44a2ac75
YO		 241 if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
242 chsize = 2;
ab3bbdeb 243 switch (c) {
44a2ac75
YO		 244
245 case '\\' : /* fallthrough */
246 case '%' : if ( c == esc ) {
247 octbuf[1] = esc;
248 } else {
249 chsize = 1;
250 }
251 break;
3df15adc
YO		 252 case '\v' : octbuf[1] = 'v'; break;
253 case '\t' : octbuf[1] = 't'; break;
254 case '\r' : octbuf[1] = 'r'; break;
255 case '\n' : octbuf[1] = 'n'; break;
256 case '\f' : octbuf[1] = 'f'; break;
44a2ac75 257 case '"' :
ab3bbdeb 258 if ( dq == '"' )
3df15adc 259 octbuf[1] = '"';
ab3bbdeb
YO		 260 else
261 chsize = 1;
44a2ac75 262 break;
3df15adc 263 default:
ddc5bc0f 264 if ( (pv < end) && isDIGIT((U8)*(pv+readsize)) )
ab3bbdeb 265 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75
YO		 266 "%c%03o", esc, c);
267 else
ab3bbdeb 268 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 269 "%c%o", esc, c);
ab3bbdeb
YO		 270 }
271 } else {
44a2ac75 272 chsize = 1;
ab3bbdeb 273 }
44a2ac75
YO		 274 }
275 if ( max && (wrote + chsize > max) ) {
276 break;
ab3bbdeb 277 } else if (chsize > 1) {
44a2ac75
YO		 278 sv_catpvn(dsv, octbuf, chsize);
279 wrote += chsize;
3df15adc 280 } else {
ab3bbdeb 281 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
3df15adc
YO		 282 wrote++;
283 }
ab3bbdeb
YO		 284 if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
285 break;
3967c732 286 }
ab3bbdeb
YO		 287 if (escaped != NULL)
288 *escaped= pv - str;
289 return SvPVX(dsv);
290}
291/*
ddc5bc0f 292=for apidoc Apd|char *|pv_pretty|NN SV *dsv|NN const char const *str\
ab3bbdeb 293 |const STRLEN count|const STRLEN max\
ddc5bc0f 294 |const char const *start_color| const char const *end_color\
ab3bbdeb
YO		 295 |const U32 flags
296
297Converts a string into something presentable, handling escaping via
298pv_escape() and supporting quoting and elipses.
299
300If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
301double quoted with any double quotes in the string escaped. Otherwise
302if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
303angle brackets.
304
305If the PERL_PV_PRETTY_ELIPSES flag is set and not all characters in
306string were output then an elipses C<...> will be appended to the
307string. Note that this happens AFTER it has been quoted.
308
309If start_color is non-null then it will be inserted after the opening
310quote (if there is one) but before the escaped text. If end_color
311is non-null then it will be inserted after the escaped text but before
312any quotes or elipses.
313
314Returns a pointer to the prettified text as held by dsv.
315
316=cut
317*/
318
319char *
ddc5bc0f
YO		 320Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
321 const STRLEN max, char const * const start_color, char const * const end_color,
ab3bbdeb
YO		 322 const U32 flags )
323{
44a2ac75 324 U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
ab3bbdeb
YO		 325 STRLEN escaped;
326
327 if ( dq == '"' )
328 sv_setpvn(dsv, "\"", 1);
329 else if ( flags & PERL_PV_PRETTY_LTGT )
330 sv_setpvn(dsv, "<", 1);
331 else
332 sv_setpvn(dsv, "", 0);
333
334 if ( start_color != NULL )
00e0e810 335 Perl_sv_catpv( aTHX_ dsv, start_color);
ab3bbdeb
YO		 336
337 pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
338
339 if ( end_color != NULL )
00e0e810 340 Perl_sv_catpv( aTHX_ dsv, end_color);
ab3bbdeb
YO		 341
342 if ( dq == '"' )
3df15adc 343 sv_catpvn( dsv, "\"", 1 );
ab3bbdeb
YO		 344 else if ( flags & PERL_PV_PRETTY_LTGT )
345 sv_catpvn( dsv, ">", 1);
346
347 if ( (flags & PERL_PV_PRETTY_ELIPSES) && ( escaped < count ) )
3df15adc 348 sv_catpvn( dsv, "...", 3 );
ab3bbdeb 349
3df15adc
YO		 350 return SvPVX(dsv);
351}
352
353/*
354=for apidoc pv_display
355
356 char *pv_display(SV *dsv, const char *pv, STRLEN cur, STRLEN len,
357 STRLEN pvlim, U32 flags)
358
359Similar to
3967c732 360
3df15adc
YO		 361 pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
362
363except that an additional "\0" will be appended to the string when
364len > cur and pv[cur] is "\0".
365
366Note that the final string may be up to 7 chars longer than pvlim.
367
368=cut
369*/
370
371char *
372Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
373{
ddc5bc0f 374 pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
3df15adc
YO		 375 if (len > cur && pv[cur] == '\0')
376 sv_catpvn( dsv, "\\0", 2 );
e6abe6d8
JH		 377 return SvPVX(dsv);
378}
379
380char *
864dbfa3 381Perl_sv_peek(pTHX_ SV *sv)
3967c732 382{
27da23d5 383 dVAR;
aec46f14 384 SV * const t = sv_newmortal();
3967c732 385 int unref = 0;
5357ca29 386 U32 type;
3967c732
JD		 387
388 sv_setpvn(t, "", 0);
389 retry:
390 if (!sv) {
391 sv_catpv(t, "VOID");
392 goto finish;
393 }
394 else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
395 sv_catpv(t, "WILD");
396 goto finish;
397 }
7996736c 398 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
3967c732
JD		 399 if (sv == &PL_sv_undef) {
400 sv_catpv(t, "SV_UNDEF");
401 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
402 SVs_GMG|SVs_SMG|SVs_RMG)) &&
403 SvREADONLY(sv))
404 goto finish;
405 }
406 else if (sv == &PL_sv_no) {
407 sv_catpv(t, "SV_NO");
408 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
409 SVs_GMG|SVs_SMG|SVs_RMG)) &&
410 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
411 SVp_POK|SVp_NOK)) &&
412 SvCUR(sv) == 0 &&
413 SvNVX(sv) == 0.0)
414 goto finish;
415 }
7996736c 416 else if (sv == &PL_sv_yes) {
3967c732
JD		 417 sv_catpv(t, "SV_YES");
418 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
419 SVs_GMG|SVs_SMG|SVs_RMG)) &&
420 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
421 SVp_POK|SVp_NOK)) &&
422 SvCUR(sv) == 1 &&
b15aece3 423 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
3967c732
JD		 424 SvNVX(sv) == 1.0)
425 goto finish;
7996736c
MHM		 426 }
427 else {
428 sv_catpv(t, "SV_PLACEHOLDER");
429 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
430 SVs_GMG|SVs_SMG|SVs_RMG)) &&
431 SvREADONLY(sv))
432 goto finish;
3967c732
JD		 433 }
434 sv_catpv(t, ":");
435 }
436 else if (SvREFCNT(sv) == 0) {
437 sv_catpv(t, "(");
438 unref++;
439 }
a3b4c9c6
DM		 440 else if (DEBUG_R_TEST_) {
441 int is_tmp = 0;
442 I32 ix;
443 /* is this SV on the tmps stack? */
444 for (ix=PL_tmps_ix; ix>=0; ix--) {
445 if (PL_tmps_stack[ix] == sv) {
446 is_tmp = 1;
447 break;
448 }
449 }
450 if (SvREFCNT(sv) > 1)
451 Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
452 is_tmp ? "T" : "");
453 else if (is_tmp)
454 sv_catpv(t, "<T>");
04932ac8
DM		 455 }
456
3967c732
JD		 457 if (SvROK(sv)) {
458 sv_catpv(t, "\\");
459 if (SvCUR(t) + unref > 10) {
b162af07 460 SvCUR_set(t, unref + 3);
3967c732
JD		 461 *SvEND(t) = '\0';
462 sv_catpv(t, "...");
463 goto finish;
464 }
465 sv = (SV*)SvRV(sv);
466 goto retry;
467 }
5357ca29
NC		 468 type = SvTYPE(sv);
469 if (type == SVt_PVCV) {
470 Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
3967c732 471 goto finish;
5357ca29
NC		 472 } else if (type < SVt_LAST) {
473 sv_catpv(t, svshorttypenames[type]);
3967c732 474
5357ca29
NC		 475 if (type == SVt_NULL)
476 goto finish;
477 } else {
478 sv_catpv(t, "FREED");
3967c732 479 goto finish;
3967c732
JD		 480 }
481
482 if (SvPOKp(sv)) {
b15aece3 483 if (!SvPVX_const(sv))
3967c732
JD		 484 sv_catpv(t, "(null)");
485 else {
b9ac451d 486 SV * const tmp = newSVpvs("");
3967c732
JD		 487 sv_catpv(t, "(");
488 if (SvOOK(sv))
b15aece3
SP		 489 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
490 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
32639b87 491 if (SvUTF8(sv))
b2ff9928 492 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
c728cb41
JH		 493 sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
494 UNI_DISPLAY_QQ));
3967c732
JD		 495 SvREFCNT_dec(tmp);
496 }
497 }
498 else if (SvNOKp(sv)) {
e54dc35b 499 STORE_NUMERIC_LOCAL_SET_STANDARD();
1779d84d 500 Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
e54dc35b 501 RESTORE_NUMERIC_LOCAL();
3967c732 502 }
57def98f 503 else if (SvIOKp(sv)) {
cf2093f6 504 if (SvIsUV(sv))
57def98f 505 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
cf2093f6 506 else
57def98f 507 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
25da4f38 508 }
3967c732
JD		 509 else
510 sv_catpv(t, "()");
2ef28da1 511
3967c732
JD		 512 finish:
513 if (unref) {
514 while (unref--)
515 sv_catpv(t, ")");
516 }
8b6b16e7 517 return SvPV_nolen(t);
3967c732
JD		 518}
519
520void
6867be6d 521Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
3967c732
JD		 522{
523 char ch;
524
525 if (!pm) {
cea2e8a9 526 Perl_dump_indent(aTHX_ level, file, "{}\n");
3967c732
JD		 527 return;
528 }
cea2e8a9 529 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732
JD		 530 level++;
531 if (pm->op_pmflags & PMf_ONCE)
532 ch = '?';
533 else
534 ch = '/';
aaa362c4 535 if (PM_GETRE(pm))
cea2e8a9 536 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
aaa362c4 537 ch, PM_GETRE(pm)->precomp, ch,
3967c732
JD		 538 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
539 else
cea2e8a9 540 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
3967c732 541 if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
cea2e8a9 542 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
3967c732
JD		 543 op_dump(pm->op_pmreplroot);
544 }
aaa362c4 545 if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
4199688e 546 SV * const tmpsv = pm_description(pm);
b15aece3 547 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
3967c732
JD		 548 SvREFCNT_dec(tmpsv);
549 }
550
cea2e8a9 551 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 552}
553
b9ac451d 554static SV *
4199688e
AL		 555S_pm_description(pTHX_ const PMOP *pm)
556{
557 SV * const desc = newSVpvs("");
558 const REGEXP * regex = PM_GETRE(pm);
559 const U32 pmflags = pm->op_pmflags;
560
561 if (pm->op_pmdynflags & PMdf_USED)
562 sv_catpv(desc, ",USED");
563 if (pm->op_pmdynflags & PMdf_TAINTED)
564 sv_catpv(desc, ",TAINTED");
565
566 if (pmflags & PMf_ONCE)
567 sv_catpv(desc, ",ONCE");
568 if (regex && regex->check_substr) {
bbe252da 569 if (!(regex->extflags & RXf_NOSCAN))
4199688e 570 sv_catpv(desc, ",SCANFIRST");
bbe252da 571 if (regex->extflags & RXf_CHECK_ALL)
4199688e
AL		 572 sv_catpv(desc, ",ALL");
573 }
574 if (pmflags & PMf_SKIPWHITE)
575 sv_catpv(desc, ",SKIPWHITE");
576 if (pmflags & PMf_CONST)
577 sv_catpv(desc, ",CONST");
578 if (pmflags & PMf_KEEP)
579 sv_catpv(desc, ",KEEP");
580 if (pmflags & PMf_GLOBAL)
581 sv_catpv(desc, ",GLOBAL");
582 if (pmflags & PMf_CONTINUE)
583 sv_catpv(desc, ",CONTINUE");
584 if (pmflags & PMf_RETAINT)
585 sv_catpv(desc, ",RETAINT");
586 if (pmflags & PMf_EVAL)
587 sv_catpv(desc, ",EVAL");
588 return desc;
589}
590
3967c732 591void
864dbfa3 592Perl_pmop_dump(pTHX_ PMOP *pm)
3967c732
JD		 593{
594 do_pmop_dump(0, Perl_debug_log, pm);
79072805
LW		 595}
596
2814eb74
PJ		 597/* An op sequencer. We visit the ops in the order they're to execute. */
598
599STATIC void
0bd48802 600S_sequence(pTHX_ register const OP *o)
2814eb74 601{
27da23d5 602 dVAR;
c445ea15 603 const OP *oldop = NULL;
2814eb74 604
2814eb74
PJ		 605 if (!o)
606 return;
607
3b721df9
NC		 608#ifdef PERL_MAD
609 if (o->op_next == 0)
610 return;
611#endif
612
724e67cb
RGS		 613 if (!Sequence)
614 Sequence = newHV();
2814eb74
PJ		 615
616 for (; o; o = o->op_next) {
294b3b39
AL		 617 STRLEN len;
618 SV * const op = newSVuv(PTR2UV(o));
619 const char * const key = SvPV_const(op, len);
620
2814eb74
PJ		 621 if (hv_exists(Sequence, key, len))
622 break;
623
624 switch (o->op_type) {
625 case OP_STUB:
626 if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
27da23d5 627 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
2814eb74
PJ		 628 break;
629 }
630 goto nothin;
631 case OP_NULL:
3b721df9
NC		 632#ifdef PERL_MAD
633 if (o == o->op_next)
634 return;
635#endif
2814eb74
PJ		 636 if (oldop && o->op_next)
637 continue;
638 break;
639 case OP_SCALAR:
640 case OP_LINESEQ:
641 case OP_SCOPE:
642 nothin:
643 if (oldop && o->op_next)
644 continue;
27da23d5 645 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
2814eb74
PJ		 646 break;
647
648 case OP_MAPWHILE:
649 case OP_GREPWHILE:
650 case OP_AND:
651 case OP_OR:
652 case OP_DOR:
653 case OP_ANDASSIGN:
654 case OP_ORASSIGN:
655 case OP_DORASSIGN:
656 case OP_COND_EXPR:
657 case OP_RANGE:
27da23d5 658 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
294b3b39 659 sequence_tail(cLOGOPo->op_other);
2814eb74
PJ		 660 break;
661
662 case OP_ENTERLOOP:
663 case OP_ENTERITER:
27da23d5 664 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
294b3b39
AL		 665 sequence_tail(cLOOPo->op_redoop);
666 sequence_tail(cLOOPo->op_nextop);
667 sequence_tail(cLOOPo->op_lastop);
2814eb74
PJ		 668 break;
669
670 case OP_QR:
671 case OP_MATCH:
672 case OP_SUBST:
27da23d5 673 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
294b3b39 674 sequence_tail(cPMOPo->op_pmreplstart);
2814eb74
PJ		 675 break;
676
677 case OP_HELEM:
678 break;
679
680 default:
27da23d5 681 hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
2814eb74
PJ		 682 break;
683 }
684 oldop = o;
685 }
686}
687
294b3b39
AL		 688static void
689S_sequence_tail(pTHX_ const OP *o)
690{
691 while (o && (o->op_type == OP_NULL))
692 o = o->op_next;
693 sequence(o);
694}
695
2814eb74 696STATIC UV
0bd48802 697S_sequence_num(pTHX_ const OP *o)
2814eb74 698{
27da23d5 699 dVAR;
2814eb74
PJ		 700 SV *op,
701 **seq;
93524f2b 702 const char *key;
2814eb74
PJ		 703 STRLEN len;
704 if (!o) return 0;
c0fd1b42 705 op = newSVuv(PTR2UV(o));
93524f2b 706 key = SvPV_const(op, len);
2814eb74
PJ		 707 seq = hv_fetch(Sequence, key, len, 0);
708 return seq ? SvUV(*seq): 0;
709}
710
79072805 711void
6867be6d 712Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
79072805 713{
27da23d5 714 dVAR;
2814eb74 715 UV seq;
e15d5972
AL		 716 const OPCODE optype = o->op_type;
717
0bd48802 718 sequence(o);
cea2e8a9 719 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732 720 level++;
0bd48802 721 seq = sequence_num(o);
2814eb74 722 if (seq)
f5992bc4 723 PerlIO_printf(file, "%-4"UVuf, seq);
93a17b20 724 else
3967c732 725 PerlIO_printf(file, " ");
c8db6e60
JH		 726 PerlIO_printf(file,
727 "%*sTYPE = %s ===> ",
53e06cf0 728 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
2814eb74 729 if (o->op_next)
f5992bc4 730 PerlIO_printf(file, seq ? "%"UVuf"\n" : "(%"UVuf")\n",
666ea192 731 sequence_num(o->op_next));
79072805 732 else
3967c732 733 PerlIO_printf(file, "DONE\n");
11343788 734 if (o->op_targ) {
e15d5972 735 if (optype == OP_NULL) {
cea2e8a9 736 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
e15d5972 737 if (o->op_targ == OP_NEXTSTATE) {
ae7d165c 738 if (CopLINE(cCOPo))
f5992bc4 739 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 740 (UV)CopLINE(cCOPo));
ae7d165c
PJ		 741 if (CopSTASHPV(cCOPo))
742 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
743 CopSTASHPV(cCOPo));
744 if (cCOPo->cop_label)
745 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
746 cCOPo->cop_label);
747 }
748 }
8990e307 749 else
894356b3 750 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
8990e307 751 }
748a9306 752#ifdef DUMPADDR
57def98f 753 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
79072805 754#endif
7e5d8ed2 755 if (o->op_flags || o->op_latefree || o->op_latefreed || o->op_attached) {
e15d5972 756 SV * const tmpsv = newSVpvs("");
5dc0d613 757 switch (o->op_flags & OPf_WANT) {
54310121 758 case OPf_WANT_VOID:
46fc3d4c 759 sv_catpv(tmpsv, ",VOID");
54310121 760 break;
761 case OPf_WANT_SCALAR:
46fc3d4c 762 sv_catpv(tmpsv, ",SCALAR");
54310121 763 break;
764 case OPf_WANT_LIST:
46fc3d4c 765 sv_catpv(tmpsv, ",LIST");
54310121 766 break;
767 default:
46fc3d4c 768 sv_catpv(tmpsv, ",UNKNOWN");
54310121 769 break;
770 }
11343788 771 if (o->op_flags & OPf_KIDS)
46fc3d4c 772 sv_catpv(tmpsv, ",KIDS");
11343788 773 if (o->op_flags & OPf_PARENS)
46fc3d4c 774 sv_catpv(tmpsv, ",PARENS");
11343788 775 if (o->op_flags & OPf_STACKED)
46fc3d4c 776 sv_catpv(tmpsv, ",STACKED");
11343788 777 if (o->op_flags & OPf_REF)
46fc3d4c 778 sv_catpv(tmpsv, ",REF");
11343788 779 if (o->op_flags & OPf_MOD)
46fc3d4c 780 sv_catpv(tmpsv, ",MOD");
11343788 781 if (o->op_flags & OPf_SPECIAL)
46fc3d4c 782 sv_catpv(tmpsv, ",SPECIAL");
29522234
DM		 783 if (o->op_latefree)
784 sv_catpv(tmpsv, ",LATEFREE");
785 if (o->op_latefreed)
786 sv_catpv(tmpsv, ",LATEFREED");
7e5d8ed2
DM		 787 if (o->op_attached)
788 sv_catpv(tmpsv, ",ATTACHED");
b15aece3 789 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
46fc3d4c 790 SvREFCNT_dec(tmpsv);
79072805 791 }
11343788 792 if (o->op_private) {
e15d5972
AL		 793 SV * const tmpsv = newSVpvs("");
794 if (PL_opargs[optype] & OA_TARGLEX) {
07447971
GS		 795 if (o->op_private & OPpTARGET_MY)
796 sv_catpv(tmpsv, ",TARGET_MY");
797 }
e15d5972
AL		 798 else if (optype == OP_LEAVESUB ||
799 optype == OP_LEAVE ||
800 optype == OP_LEAVESUBLV ||
801 optype == OP_LEAVEWRITE) {
bf91b999
SC		 802 if (o->op_private & OPpREFCOUNTED)
803 sv_catpv(tmpsv, ",REFCOUNTED");
804 }
e15d5972 805 else if (optype == OP_AASSIGN) {
11343788 806 if (o->op_private & OPpASSIGN_COMMON)
46fc3d4c 807 sv_catpv(tmpsv, ",COMMON");
8d063cd8 808 }
e15d5972 809 else if (optype == OP_SASSIGN) {
11343788 810 if (o->op_private & OPpASSIGN_BACKWARDS)
46fc3d4c 811 sv_catpv(tmpsv, ",BACKWARDS");
a0d0e21e 812 }
e15d5972 813 else if (optype == OP_TRANS) {
11343788 814 if (o->op_private & OPpTRANS_SQUASH)
46fc3d4c 815 sv_catpv(tmpsv, ",SQUASH");
11343788 816 if (o->op_private & OPpTRANS_DELETE)
46fc3d4c 817 sv_catpv(tmpsv, ",DELETE");
11343788 818 if (o->op_private & OPpTRANS_COMPLEMENT)
46fc3d4c 819 sv_catpv(tmpsv, ",COMPLEMENT");
bf91b999
SC		 820 if (o->op_private & OPpTRANS_IDENTICAL)
821 sv_catpv(tmpsv, ",IDENTICAL");
822 if (o->op_private & OPpTRANS_GROWS)
823 sv_catpv(tmpsv, ",GROWS");
8d063cd8 824 }
e15d5972 825 else if (optype == OP_REPEAT) {
11343788 826 if (o->op_private & OPpREPEAT_DOLIST)
46fc3d4c 827 sv_catpv(tmpsv, ",DOLIST");
8d063cd8 828 }
e15d5972
AL		 829 else if (optype == OP_ENTERSUB ||
830 optype == OP_RV2SV ||
831 optype == OP_GVSV ||
832 optype == OP_RV2AV ||
833 optype == OP_RV2HV ||
834 optype == OP_RV2GV ||
835 optype == OP_AELEM ||
836 optype == OP_HELEM )
85e6fe83 837 {
e15d5972 838 if (optype == OP_ENTERSUB) {
5dc0d613 839 if (o->op_private & OPpENTERSUB_AMPER)
46fc3d4c 840 sv_catpv(tmpsv, ",AMPER");
5dc0d613 841 if (o->op_private & OPpENTERSUB_DB)
46fc3d4c 842 sv_catpv(tmpsv, ",DB");
d3011074
IZ		 843 if (o->op_private & OPpENTERSUB_HASTARG)
844 sv_catpv(tmpsv, ",HASTARG");
bf91b999
SC		 845 if (o->op_private & OPpENTERSUB_NOPAREN)
846 sv_catpv(tmpsv, ",NOPAREN");
847 if (o->op_private & OPpENTERSUB_INARGS)
848 sv_catpv(tmpsv, ",INARGS");
95f0a2f1
SB		 849 if (o->op_private & OPpENTERSUB_NOMOD)
850 sv_catpv(tmpsv, ",NOMOD");
68dc0745 851 }
bf91b999 852 else {
d3011074 853 switch (o->op_private & OPpDEREF) {
b9ac451d
AL		 854 case OPpDEREF_SV:
855 sv_catpv(tmpsv, ",SV");
856 break;
857 case OPpDEREF_AV:
858 sv_catpv(tmpsv, ",AV");
859 break;
860 case OPpDEREF_HV:
861 sv_catpv(tmpsv, ",HV");
862 break;
863 }
bf91b999
SC		 864 if (o->op_private & OPpMAYBE_LVSUB)
865 sv_catpv(tmpsv, ",MAYBE_LVSUB");
866 }
e15d5972 867 if (optype == OP_AELEM || optype == OP_HELEM) {
5dc0d613 868 if (o->op_private & OPpLVAL_DEFER)
46fc3d4c 869 sv_catpv(tmpsv, ",LVAL_DEFER");
68dc0745 870 }
871 else {
5dc0d613 872 if (o->op_private & HINT_STRICT_REFS)
46fc3d4c 873 sv_catpv(tmpsv, ",STRICT_REFS");
192587c2
GS		 874 if (o->op_private & OPpOUR_INTRO)
875 sv_catpv(tmpsv, ",OUR_INTRO");
68dc0745 876 }
8d063cd8 877 }
e15d5972 878 else if (optype == OP_CONST) {
11343788 879 if (o->op_private & OPpCONST_BARE)
46fc3d4c 880 sv_catpv(tmpsv, ",BARE");
7a52d87a
GS		 881 if (o->op_private & OPpCONST_STRICT)
882 sv_catpv(tmpsv, ",STRICT");
bf91b999
SC		 883 if (o->op_private & OPpCONST_ARYBASE)
884 sv_catpv(tmpsv, ",ARYBASE");
885 if (o->op_private & OPpCONST_WARNING)
886 sv_catpv(tmpsv, ",WARNING");
887 if (o->op_private & OPpCONST_ENTERED)
888 sv_catpv(tmpsv, ",ENTERED");
79072805 889 }
e15d5972 890 else if (optype == OP_FLIP) {
11343788 891 if (o->op_private & OPpFLIP_LINENUM)
46fc3d4c 892 sv_catpv(tmpsv, ",LINENUM");
79072805 893 }
e15d5972 894 else if (optype == OP_FLOP) {
11343788 895 if (o->op_private & OPpFLIP_LINENUM)
46fc3d4c 896 sv_catpv(tmpsv, ",LINENUM");
95f0a2f1 897 }
e15d5972 898 else if (optype == OP_RV2CV) {
cd06dffe
GS		 899 if (o->op_private & OPpLVAL_INTRO)
900 sv_catpv(tmpsv, ",INTRO");
79072805 901 }
e15d5972 902 else if (optype == OP_GV) {
bf91b999
SC		 903 if (o->op_private & OPpEARLY_CV)
904 sv_catpv(tmpsv, ",EARLY_CV");
905 }
e15d5972 906 else if (optype == OP_LIST) {
bf91b999
SC		 907 if (o->op_private & OPpLIST_GUESSED)
908 sv_catpv(tmpsv, ",GUESSED");
909 }
e15d5972 910 else if (optype == OP_DELETE) {
bf91b999
SC		 911 if (o->op_private & OPpSLICE)
912 sv_catpv(tmpsv, ",SLICE");
913 }
e15d5972 914 else if (optype == OP_EXISTS) {
bf91b999
SC		 915 if (o->op_private & OPpEXISTS_SUB)
916 sv_catpv(tmpsv, ",EXISTS_SUB");
917 }
e15d5972 918 else if (optype == OP_SORT) {
bf91b999
SC		 919 if (o->op_private & OPpSORT_NUMERIC)
920 sv_catpv(tmpsv, ",NUMERIC");
921 if (o->op_private & OPpSORT_INTEGER)
922 sv_catpv(tmpsv, ",INTEGER");
923 if (o->op_private & OPpSORT_REVERSE)
924 sv_catpv(tmpsv, ",REVERSE");
925 }
e15d5972 926 else if (optype == OP_OPEN || optype == OP_BACKTICK) {
bf91b999
SC		 927 if (o->op_private & OPpOPEN_IN_RAW)
928 sv_catpv(tmpsv, ",IN_RAW");
929 if (o->op_private & OPpOPEN_IN_CRLF)
930 sv_catpv(tmpsv, ",IN_CRLF");
931 if (o->op_private & OPpOPEN_OUT_RAW)
932 sv_catpv(tmpsv, ",OUT_RAW");
933 if (o->op_private & OPpOPEN_OUT_CRLF)
934 sv_catpv(tmpsv, ",OUT_CRLF");
935 }
e15d5972 936 else if (optype == OP_EXIT) {
bf91b999 937 if (o->op_private & OPpEXIT_VMSISH)
96e176bf
CL		 938 sv_catpv(tmpsv, ",EXIT_VMSISH");
939 if (o->op_private & OPpHUSH_VMSISH)
940 sv_catpv(tmpsv, ",HUSH_VMSISH");
941 }
e15d5972 942 else if (optype == OP_DIE) {
96e176bf
CL		 943 if (o->op_private & OPpHUSH_VMSISH)
944 sv_catpv(tmpsv, ",HUSH_VMSISH");
bf91b999 945 }
e15d5972 946 else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
fbb0b3b3
RGS		 947 if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
948 sv_catpv(tmpsv, ",FT_ACCESS");
949 if (o->op_private & OPpFT_STACKED)
950 sv_catpv(tmpsv, ",FT_STACKED");
1af34c76 951 }
11343788 952 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
46fc3d4c 953 sv_catpv(tmpsv, ",INTRO");
954 if (SvCUR(tmpsv))
b15aece3 955 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
46fc3d4c 956 SvREFCNT_dec(tmpsv);
8d063cd8 957 }
8d063cd8 958
3b721df9
NC		 959#ifdef PERL_MAD
960 if (PL_madskills && o->op_madprop) {
d4c19fe8 961 SV * const tmpsv = newSVpvn("", 0);
3b721df9
NC		 962 MADPROP* mp = o->op_madprop;
963 Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
964 level++;
965 while (mp) {
966 char tmp = mp->mad_key;
967 sv_setpvn(tmpsv,"'",1);
968 if (tmp)
969 sv_catpvn(tmpsv, &tmp, 1);
970 sv_catpv(tmpsv, "'=");
971 switch (mp->mad_type) {
972 case MAD_NULL:
973 sv_catpv(tmpsv, "NULL");
974 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
975 break;
976 case MAD_PV:
977 sv_catpv(tmpsv, "<");
978 sv_catpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen);
979 sv_catpv(tmpsv, ">");
980 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
981 break;
982 case MAD_OP:
983 if ((OP*)mp->mad_val) {
984 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
985 do_op_dump(level, file, (OP*)mp->mad_val);
986 }
987 break;
988 default:
989 sv_catpv(tmpsv, "(UNK)");
990 Perl_dump_indent(aTHX_ level, file, "%s\n", SvPVX(tmpsv));
991 break;
992 }
993 mp = mp->mad_next;
994 }
995 level--;
996 Perl_dump_indent(aTHX_ level, file, "}\n");
997
998 SvREFCNT_dec(tmpsv);
999 }
1000#endif
1001
e15d5972 1002 switch (optype) {
971a9dd3 1003 case OP_AELEMFAST:
93a17b20 1004 case OP_GVSV:
79072805 1005 case OP_GV:
971a9dd3 1006#ifdef USE_ITHREADS
c803eecc 1007 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 1008#else
38c076c7
DM		 1009 if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
1010 if (cSVOPo->op_sv) {
d4c19fe8 1011 SV * const tmpsv = newSV(0);
38c076c7
DM		 1012 ENTER;
1013 SAVEFREESV(tmpsv);
3b721df9
NC		 1014#ifdef PERL_MAD
1015 /* FIXME - it this making unwarranted assumptions about the
1016 UTF-8 cleanliness of the dump file handle? */
1017 SvUTF8_on(tmpsv);
1018#endif
bd61b366 1019 gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, NULL);
8b6b16e7 1020 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
d5263905 1021 SvPV_nolen_const(tmpsv));
38c076c7
DM		 1022 LEAVE;
1023 }
1024 else
1025 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
378cc40b 1026 }
971a9dd3 1027#endif
79072805
LW		 1028 break;
1029 case OP_CONST:
f5d5a27c 1030 case OP_METHOD_NAMED:
b6a15bc5
DM		 1031#ifndef USE_ITHREADS
1032 /* with ITHREADS, consts are stored in the pad, and the right pad
1033 * may not be active here, so skip */
3848b962 1034 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
b6a15bc5 1035#endif
79072805 1036 break;
7399586d 1037 case OP_SETSTATE:
93a17b20
LW		 1038 case OP_NEXTSTATE:
1039 case OP_DBSTATE:
57843af0 1040 if (CopLINE(cCOPo))
f5992bc4 1041 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 1042 (UV)CopLINE(cCOPo));
ed094faf
GS		 1043 if (CopSTASHPV(cCOPo))
1044 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1045 CopSTASHPV(cCOPo));
11343788 1046 if (cCOPo->cop_label)
ed094faf
GS		 1047 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1048 cCOPo->cop_label);
79072805
LW		 1049 break;
1050 case OP_ENTERLOOP:
cea2e8a9 1051 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
11343788 1052 if (cLOOPo->op_redoop)
f5992bc4 1053 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
79072805 1054 else
3967c732 1055 PerlIO_printf(file, "DONE\n");
cea2e8a9 1056 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
11343788 1057 if (cLOOPo->op_nextop)
f5992bc4 1058 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
79072805 1059 else
3967c732 1060 PerlIO_printf(file, "DONE\n");
cea2e8a9 1061 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
11343788 1062 if (cLOOPo->op_lastop)
f5992bc4 1063 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
79072805 1064 else
3967c732 1065 PerlIO_printf(file, "DONE\n");
79072805
LW		 1066 break;
1067 case OP_COND_EXPR:
1a67a97c 1068 case OP_RANGE:
a0d0e21e 1069 case OP_MAPWHILE:
79072805
LW		 1070 case OP_GREPWHILE:
1071 case OP_OR:
1072 case OP_AND:
cea2e8a9 1073 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
11343788 1074 if (cLOGOPo->op_other)
f5992bc4 1075 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
79072805 1076 else
3967c732 1077 PerlIO_printf(file, "DONE\n");
79072805
LW		 1078 break;
1079 case OP_PUSHRE:
1080 case OP_MATCH:
8782bef2 1081 case OP_QR:
79072805 1082 case OP_SUBST:
3967c732 1083 do_pmop_dump(level, file, cPMOPo);
79072805 1084 break;
7934575e
GS		 1085 case OP_LEAVE:
1086 case OP_LEAVEEVAL:
1087 case OP_LEAVESUB:
1088 case OP_LEAVESUBLV:
1089 case OP_LEAVEWRITE:
1090 case OP_SCOPE:
1091 if (o->op_private & OPpREFCOUNTED)
1092 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1093 break;
a0d0e21e
LW		 1094 default:
1095 break;
79072805 1096 }
11343788 1097 if (o->op_flags & OPf_KIDS) {
79072805 1098 OP *kid;
11343788 1099 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
3967c732 1100 do_op_dump(level, file, kid);
8d063cd8 1101 }
cea2e8a9 1102 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD		 1103}
1104
1105void
6867be6d 1106Perl_op_dump(pTHX_ const OP *o)
3967c732
JD		 1107{
1108 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW		 1109}
1110
8adcabd8 1111void
864dbfa3 1112Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1113{
79072805 1114 SV *sv;
378cc40b 1115
79072805 1116 if (!gv) {
760ac839 1117 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW		 1118 return;
1119 }
8990e307 1120 sv = sv_newmortal();
760ac839 1121 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1122 gv_fullname3(sv, gv, NULL);
b15aece3 1123 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
79072805 1124 if (gv != GvEGV(gv)) {
bd61b366 1125 gv_efullname3(sv, GvEGV(gv), NULL);
b15aece3 1126 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
8adcabd8 1127 }
3967c732 1128 PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1129 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW		 1130}
1131
14befaf4 1132
afe38520 1133/* map magic types to the symbolic names
14befaf4
DM		 1134 * (with the PERL_MAGIC_ prefixed stripped)
1135 */
1136
27da23d5 1137static const struct { const char type; const char *name; } magic_names[] = {
516a5887
JH		 1138 { PERL_MAGIC_sv, "sv(\\0)" },
1139 { PERL_MAGIC_arylen, "arylen(#)" },
ca732855 1140 { PERL_MAGIC_rhash, "rhash(%)" },
516a5887 1141 { PERL_MAGIC_pos, "pos(.)" },
8d2f4536 1142 { PERL_MAGIC_symtab, "symtab(:)" },
516a5887 1143 { PERL_MAGIC_backref, "backref(<)" },
a3874608 1144 { PERL_MAGIC_arylen_p, "arylen_p(@)" },
516a5887
JH		 1145 { PERL_MAGIC_overload, "overload(A)" },
1146 { PERL_MAGIC_bm, "bm(B)" },
1147 { PERL_MAGIC_regdata, "regdata(D)" },
1148 { PERL_MAGIC_env, "env(E)" },
b3ca2e83 1149 { PERL_MAGIC_hints, "hints(H)" },
516a5887
JH		 1150 { PERL_MAGIC_isa, "isa(I)" },
1151 { PERL_MAGIC_dbfile, "dbfile(L)" },
afe38520 1152 { PERL_MAGIC_shared, "shared(N)" },
516a5887
JH		 1153 { PERL_MAGIC_tied, "tied(P)" },
1154 { PERL_MAGIC_sig, "sig(S)" },
1155 { PERL_MAGIC_uvar, "uvar(U)" },
1156 { PERL_MAGIC_overload_elem, "overload_elem(a)" },
1157 { PERL_MAGIC_overload_table, "overload_table(c)" },
1158 { PERL_MAGIC_regdatum, "regdatum(d)" },
1159 { PERL_MAGIC_envelem, "envelem(e)" },
1160 { PERL_MAGIC_fm, "fm(f)" },
1161 { PERL_MAGIC_regex_global, "regex_global(g)" },
b3ca2e83 1162 { PERL_MAGIC_hintselem, "hintselem(h)" },
516a5887
JH		 1163 { PERL_MAGIC_isaelem, "isaelem(i)" },
1164 { PERL_MAGIC_nkeys, "nkeys(k)" },
1165 { PERL_MAGIC_dbline, "dbline(l)" },
1166 { PERL_MAGIC_mutex, "mutex(m)" },
afe38520 1167 { PERL_MAGIC_shared_scalar, "shared_scalar(n)" },
516a5887
JH		 1168 { PERL_MAGIC_collxfrm, "collxfrm(o)" },
1169 { PERL_MAGIC_tiedelem, "tiedelem(p)" },
1170 { PERL_MAGIC_tiedscalar, "tiedscalar(q)" },
1171 { PERL_MAGIC_qr, "qr(r)" },
1172 { PERL_MAGIC_sigelem, "sigelem(s)" },
1173 { PERL_MAGIC_taint, "taint(t)" },
afe38520 1174 { PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
516a5887 1175 { PERL_MAGIC_vec, "vec(v)" },
cb50f42d 1176 { PERL_MAGIC_vstring, "vstring(V)" },
7e8c5dac 1177 { PERL_MAGIC_utf8, "utf8(w)" },
516a5887
JH		 1178 { PERL_MAGIC_substr, "substr(x)" },
1179 { PERL_MAGIC_defelem, "defelem(y)" },
1180 { PERL_MAGIC_ext, "ext(~)" },
1181 /* this null string terminates the list */
b9ac451d 1182 { 0, NULL },
14befaf4
DM		 1183};
1184
8adcabd8 1185void
6867be6d 1186Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1187{
3967c732 1188 for (; mg; mg = mg->mg_moremagic) {
b900a521
JH		 1189 Perl_dump_indent(aTHX_ level, file,
1190 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1191 if (mg->mg_virtual) {
bfed75c6 1192 const MGVTBL * const v = mg->mg_virtual;
b9ac451d 1193 const char *s;
3967c732
JD		 1194 if (v == &PL_vtbl_sv) s = "sv";
1195 else if (v == &PL_vtbl_env) s = "env";
1196 else if (v == &PL_vtbl_envelem) s = "envelem";
1197 else if (v == &PL_vtbl_sig) s = "sig";
1198 else if (v == &PL_vtbl_sigelem) s = "sigelem";
1199 else if (v == &PL_vtbl_pack) s = "pack";
1200 else if (v == &PL_vtbl_packelem) s = "packelem";
1201 else if (v == &PL_vtbl_dbline) s = "dbline";
1202 else if (v == &PL_vtbl_isa) s = "isa";
1203 else if (v == &PL_vtbl_arylen) s = "arylen";
3967c732
JD		 1204 else if (v == &PL_vtbl_mglob) s = "mglob";
1205 else if (v == &PL_vtbl_nkeys) s = "nkeys";
1206 else if (v == &PL_vtbl_taint) s = "taint";
1207 else if (v == &PL_vtbl_substr) s = "substr";
1208 else if (v == &PL_vtbl_vec) s = "vec";
1209 else if (v == &PL_vtbl_pos) s = "pos";
1210 else if (v == &PL_vtbl_bm) s = "bm";
1211 else if (v == &PL_vtbl_fm) s = "fm";
1212 else if (v == &PL_vtbl_uvar) s = "uvar";
1213 else if (v == &PL_vtbl_defelem) s = "defelem";
1214#ifdef USE_LOCALE_COLLATE
1215 else if (v == &PL_vtbl_collxfrm) s = "collxfrm";
1216#endif
3967c732
JD		 1217 else if (v == &PL_vtbl_amagic) s = "amagic";
1218 else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
810b8aa5 1219 else if (v == &PL_vtbl_backref) s = "backref";
7e8c5dac 1220 else if (v == &PL_vtbl_utf8) s = "utf8";
83bf042f 1221 else if (v == &PL_vtbl_arylen_p) s = "arylen_p";
b3ca2e83 1222 else if (v == &PL_vtbl_hintselem) s = "hintselem";
b9ac451d 1223 else s = NULL;
3967c732 1224 if (s)
cea2e8a9 1225 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s);
3967c732 1226 else
b900a521 1227 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732
JD		 1228 }
1229 else
cea2e8a9 1230 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1231
3967c732 1232 if (mg->mg_private)
cea2e8a9 1233 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1234
14befaf4
DM		 1235 {
1236 int n;
c445ea15 1237 const char *name = NULL;
27da23d5 1238 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM		 1239 if (mg->mg_type == magic_names[n].type) {
1240 name = magic_names[n].name;
1241 break;
1242 }
1243 }
1244 if (name)
1245 Perl_dump_indent(aTHX_ level, file,
1246 " MG_TYPE = PERL_MAGIC_%s\n", name);
1247 else
1248 Perl_dump_indent(aTHX_ level, file,
1249 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1250 }
3967c732
JD		 1251
1252 if (mg->mg_flags) {
cea2e8a9 1253 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST		 1254 if (mg->mg_type == PERL_MAGIC_envelem &&
1255 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1256 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
3967c732 1257 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1258 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1259 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1260 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
cb50f42d
YST		 1261 if (mg->mg_type == PERL_MAGIC_regex_global &&
1262 mg->mg_flags & MGf_MINMATCH)
cea2e8a9 1263 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732
JD		 1264 }
1265 if (mg->mg_obj) {
b900a521 1266 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
3967c732
JD		 1267 if (mg->mg_flags & MGf_REFCOUNTED)
1268 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1269 }
1270 if (mg->mg_len)
894356b3 1271 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1272 if (mg->mg_ptr) {
b900a521 1273 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1274 if (mg->mg_len >= 0) {
7e8c5dac 1275 if (mg->mg_type != PERL_MAGIC_utf8) {
396482e1 1276 SV *sv = newSVpvs("");
7e8c5dac
HS		 1277 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1278 SvREFCNT_dec(sv);
1279 }
3967c732
JD		 1280 }
1281 else if (mg->mg_len == HEf_SVKEY) {
1282 PerlIO_puts(file, " => HEf_SVKEY\n");
1283 do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1284 continue;
1285 }
1286 else
1287 PerlIO_puts(file, " ???? - please notify IZ");
1288 PerlIO_putc(file, '\n');
1289 }
7e8c5dac
HS		 1290 if (mg->mg_type == PERL_MAGIC_utf8) {
1291 STRLEN *cache = (STRLEN *) mg->mg_ptr;
1292 if (cache) {
1293 IV i;
1294 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1295 Perl_dump_indent(aTHX_ level, file,
1296 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1297 i,
1298 (UV)cache[i * 2],
1299 (UV)cache[i * 2 + 1]);
1300 }
1301 }
378cc40b 1302 }
3967c732
JD		 1303}
1304
1305void
6867be6d 1306Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1307{
b9ac451d 1308 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD		 1309}
1310
1311void
e1ec3a88 1312Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1313{
bfcb3514 1314 const char *hvname;
b900a521 1315 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514
NC		 1316 if (sv && (hvname = HvNAME_get(sv)))
1317 PerlIO_printf(file, "\t\"%s\"\n", hvname);
79072805 1318 else
3967c732
JD		 1319 PerlIO_putc(file, '\n');
1320}
1321
1322void
e1ec3a88 1323Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1324{
b900a521 1325 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732
JD		 1326 if (sv && GvNAME(sv))
1327 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
c90c0ff4 1328 else
3967c732
JD		 1329 PerlIO_putc(file, '\n');
1330}
1331
1332void
e1ec3a88 1333Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1334{
b900a521 1335 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1336 if (sv && GvNAME(sv)) {
bfcb3514 1337 const char *hvname;
3967c732 1338 PerlIO_printf(file, "\t\"");
bfcb3514
NC		 1339 if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
1340 PerlIO_printf(file, "%s\" :: \"", hvname);
3967c732 1341 PerlIO_printf(file, "%s\"\n", GvNAME(sv));
8d063cd8 1342 }
3967c732
JD		 1343 else
1344 PerlIO_putc(file, '\n');
1345}
1346
1347void
864dbfa3 1348Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1349{
97aff369 1350 dVAR;
cea89e20 1351 SV *d;
e1ec3a88 1352 const char *s;
3967c732
JD		 1353 U32 flags;
1354 U32 type;
1355
1356 if (!sv) {
cea2e8a9 1357 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1358 return;
378cc40b 1359 }
2ef28da1 1360
3967c732
JD		 1361 flags = SvFLAGS(sv);
1362 type = SvTYPE(sv);
79072805 1363
cea89e20 1364 d = Perl_newSVpvf(aTHX_
57def98f 1365 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1366 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS		 1367 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1368 (int)(PL_dumpindent*level), "");
8d063cd8 1369
e604303a
NC		 1370 if (!(flags & SVpad_NAME && (type == SVt_PVMG || type == SVt_PVNV))) {
1371 if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
1372 }
1373 if (!(flags & SVpad_NAME && type == SVt_PVMG)) {
1374 if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
1375 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1376 }
3967c732
JD		 1377 if (flags & SVs_TEMP) sv_catpv(d, "TEMP,");
1378 if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,");
1379 if (flags & SVs_GMG) sv_catpv(d, "GMG,");
1380 if (flags & SVs_SMG) sv_catpv(d, "SMG,");
1381 if (flags & SVs_RMG) sv_catpv(d, "RMG,");
4db58590 1382
3967c732
JD		 1383 if (flags & SVf_IOK) sv_catpv(d, "IOK,");
1384 if (flags & SVf_NOK) sv_catpv(d, "NOK,");
1385 if (flags & SVf_POK) sv_catpv(d, "POK,");
810b8aa5
GS		 1386 if (flags & SVf_ROK) {
1387 sv_catpv(d, "ROK,");
1388 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1389 }
3967c732
JD		 1390 if (flags & SVf_OOK) sv_catpv(d, "OOK,");
1391 if (flags & SVf_FAKE) sv_catpv(d, "FAKE,");
1392 if (flags & SVf_READONLY) sv_catpv(d, "READONLY,");
de6bd8a1 1393 if (flags & SVf_BREAK) sv_catpv(d, "BREAK,");
4db58590 1394
dd2eae66 1395 if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,");
3967c732
JD		 1396 if (flags & SVp_IOK) sv_catpv(d, "pIOK,");
1397 if (flags & SVp_NOK) sv_catpv(d, "pNOK,");
1398 if (flags & SVp_POK) sv_catpv(d, "pPOK,");
1ccdb730
NC		 1399 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
1400 if (SvPCS_IMPORTED(sv))
1401 sv_catpv(d, "PCS_IMPORTED,");
1402 else
9660f481 1403 sv_catpv(d, "SCREAM,");
1ccdb730 1404 }
3967c732
JD		 1405
1406 switch (type) {
1407 case SVt_PVCV:
1408 case SVt_PVFM:
1409 if (CvANON(sv)) sv_catpv(d, "ANON,");
1410 if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
1411 if (CvCLONE(sv)) sv_catpv(d, "CLONE,");
1412 if (CvCLONED(sv)) sv_catpv(d, "CLONED,");
de3f1649 1413 if (CvCONST(sv)) sv_catpv(d, "CONST,");
3967c732 1414 if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,");
25da4f38 1415 if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,");
18f7acf9
TJ		 1416 if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,");
1417 if (CvMETHOD(sv)) sv_catpv(d, "METHOD,");
662a8415 1418 if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,");
7dafbf52 1419 if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,");
06492da6 1420 if (CvASSERTION(sv)) sv_catpv(d, "ASSERTION,");
3967c732
JD		 1421 break;
1422 case SVt_PVHV:
1423 if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,");
1424 if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,");
19692e8d 1425 if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,");
afce8e55 1426 if (HvREHASH(sv)) sv_catpv(d, "REHASH,");
9660f481 1427 if (flags & SVphv_CLONEABLE) sv_catpv(d, "CLONEABLE,");
3967c732 1428 break;
926fc7b6
DM		 1429 case SVt_PVGV:
1430 case SVt_PVLV:
1431 if (isGV_with_GP(sv)) {
1432 if (GvINTRO(sv)) sv_catpv(d, "INTRO,");
1433 if (GvMULTI(sv)) sv_catpv(d, "MULTI,");
1434 if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
1435 if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
1436 if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
1437 }
926fc7b6 1438 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD		 1439 sv_catpv(d, "IMPORT");
1440 if (GvIMPORTED(sv) == GVf_IMPORTED)
1441 sv_catpv(d, "ALL,");
1442 else {
1443 sv_catpv(d, "(");
1444 if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV");
1445 if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV");
1446 if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV");
1447 if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV");
1448 sv_catpv(d, " ),");
1449 }
1450 }
cecf5685
NC		 1451 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1452 if (SvVALID(sv)) sv_catpv(d, "VALID,");
addd1794 1453 /* FALL THROUGH */
25da4f38 1454 default:
e604303a 1455 evaled_or_uv:
25da4f38 1456 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1457 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1458 break;
addd1794 1459 case SVt_PVMG:
00b1698f 1460 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1461 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
2e94196c 1462 /* FALL THROUGH */
e604303a
NC		 1463 case SVt_PVNV:
1464 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1465 goto evaled_or_uv;
11ca45c0
NC		 1466 case SVt_PVAV:
1467 break;
3967c732 1468 }
86f0d186
NC		 1469 /* SVphv_SHAREKEYS is also 0x20000000 */
1470 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1471 sv_catpv(d, "UTF8");
3967c732 1472
b162af07
SP		 1473 if (*(SvEND(d) - 1) == ',') {
1474 SvCUR_set(d, SvCUR(d) - 1);
1475 SvPVX(d)[SvCUR(d)] = '\0';
1476 }
3967c732 1477 sv_catpv(d, ")");
b15aece3 1478 s = SvPVX_const(d);
3967c732 1479
fd0854ff
DM		 1480#ifdef DEBUG_LEAKING_SCALARS
1481 Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
1482 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1483 sv->sv_debug_line,
1484 sv->sv_debug_inpad ? "for" : "by",
1485 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1486 sv->sv_debug_cloned ? " (cloned)" : "");
1487#endif
cea2e8a9 1488 Perl_dump_indent(aTHX_ level, file, "SV = ");
5357ca29
NC		 1489 if (type < SVt_LAST) {
1490 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1491
1492 if (type == SVt_NULL) {
1493 SvREFCNT_dec(d);
1494 return;
1495 }
1496 } else {
faccc32b 1497 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
cea89e20 1498 SvREFCNT_dec(d);
3967c732
JD		 1499 return;
1500 }
27bd069f
NC		 1501 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1502 && type != SVt_PVCV && !isGV_with_GP(sv))
1503 || type == SVt_IV) {
765f542d 1504 if (SvIsUV(sv)
f8c7b90f 1505#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1506 || SvIsCOW(sv)
1507#endif
1508 )
57def98f 1509 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1510 else
57def98f 1511 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
3967c732
JD		 1512 if (SvOOK(sv))
1513 PerlIO_printf(file, " (OFFSET)");
f8c7b90f 1514#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC		 1515 if (SvIsCOW_shared_hash(sv))
1516 PerlIO_printf(file, " (HASH)");
1517 else if (SvIsCOW_normal(sv))
1518 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1519#endif
3967c732
JD		 1520 PerlIO_putc(file, '\n');
1521 }
0e4c4423
NC		 1522 if ((type == SVt_PVNV || type == SVt_PVMG) && SvFLAGS(sv) & SVpad_NAME) {
1523 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1524 (UV) COP_SEQ_RANGE_LOW(sv));
1525 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1526 (UV) COP_SEQ_RANGE_HIGH(sv));
1527 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
eff3c707
NC		 1528 && type != SVt_PVCV && type != SVt_PVFM && !isGV_with_GP(sv)
1529 && !SvVALID(sv))
0e4c4423 1530 || type == SVt_NV) {
e54dc35b 1531 STORE_NUMERIC_LOCAL_SET_STANDARD();
57def98f 1532 /* %Vg doesn't work? --jhi */
cf2093f6 1533#ifdef USE_LONG_DOUBLE
2d4389e4 1534 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
cf2093f6 1535#else
cea2e8a9 1536 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
cf2093f6 1537#endif
e54dc35b 1538 RESTORE_NUMERIC_LOCAL();
3967c732
JD		 1539 }
1540 if (SvROK(sv)) {
57def98f 1541 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732
JD		 1542 if (nest < maxnest)
1543 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1544 }
cea89e20
JH		 1545 if (type < SVt_PV) {
1546 SvREFCNT_dec(d);
3967c732 1547 return;
cea89e20 1548 }
f7877b28 1549 if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
b15aece3
SP		 1550 if (SvPVX_const(sv)) {
1551 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
3967c732 1552 if (SvOOK(sv))
b15aece3
SP		 1553 PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
1554 PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
e6abe6d8 1555 if (SvUTF8(sv)) /* the 8? \x{....} */
c728cb41 1556 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
e6abe6d8 1557 PerlIO_printf(file, "\n");
57def98f
JH		 1558 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
1559 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
3967c732
JD		 1560 }
1561 else
cea2e8a9 1562 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732
JD		 1563 }
1564 if (type >= SVt_PVMG) {
0e4c4423 1565 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
38cbaf55
RGS		 1566 HV *ost = SvOURSTASH(sv);
1567 if (ost)
1568 do_hv_dump(level, file, " OURSTASH", ost);
0e4c4423
NC		 1569 } else {
1570 if (SvMAGIC(sv))
1571 do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
1572 }
3967c732
JD		 1573 if (SvSTASH(sv))
1574 do_hv_dump(level, file, " STASH", SvSTASH(sv));
1575 }
1576 switch (type) {
3967c732 1577 case SVt_PVAV:
57def98f 1578 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1579 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f
JH		 1580 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1581 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732
JD		 1582 }
1583 else
1584 PerlIO_putc(file, '\n');
57def98f
JH		 1585 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1586 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
a3874608 1587 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
c69006e4 1588 sv_setpvn(d, "", 0);
11ca45c0
NC		 1589 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1590 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP		 1591 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1592 SvCUR(d) ? SvPVX_const(d) + 1 : "");
3967c732
JD		 1593 if (nest < maxnest && av_len((AV*)sv) >= 0) {
1594 int count;
1595 for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) {
1596 SV** elt = av_fetch((AV*)sv,count,0);
1597
57def98f 1598 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1599 if (elt)
3967c732
JD		 1600 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1601 }
1602 }
1603 break;
1604 case SVt_PVHV:
57def98f 1605 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
3967c732
JD		 1606 if (HvARRAY(sv) && HvKEYS(sv)) {
1607 /* Show distribution of HEs in the ARRAY */
1608 int freq[200];
bb7a0f54 1609#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
3967c732
JD		 1610 int i;
1611 int max = 0;
1612 U32 pow2 = 2, keys = HvKEYS(sv);
65202027 1613 NV theoret, sum = 0;
3967c732
JD		 1614
1615 PerlIO_printf(file, " (");
1616 Zero(freq, FREQ_MAX + 1, int);
eb160463 1617 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL		 1618 HE* h;
1619 int count = 0;
3967c732
JD		 1620 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1621 count++;
1622 if (count > FREQ_MAX)
1623 count = FREQ_MAX;
1624 freq[count]++;
1625 if (max < count)
1626 max = count;
1627 }
1628 for (i = 0; i <= max; i++) {
1629 if (freq[i]) {
1630 PerlIO_printf(file, "%d%s:%d", i,
1631 (i == FREQ_MAX) ? "+" : "",
1632 freq[i]);
1633 if (i != max)
1634 PerlIO_printf(file, ", ");
1635 }
1636 }
1637 PerlIO_putc(file, ')');
b8fa94d8
MG		 1638 /* The "quality" of a hash is defined as the total number of
1639 comparisons needed to access every element once, relative
1640 to the expected number needed for a random hash.
1641
1642 The total number of comparisons is equal to the sum of
e76cd0fa
AMS		 1643 the squares of the number of entries in each bucket.
1644 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG		 1645 value is
1646 n + n(n-1)/2k
1647 */
1648
3967c732
JD		 1649 for (i = max; i > 0; i--) { /* Precision: count down. */
1650 sum += freq[i] * i * i;
1651 }
155aba94 1652 while ((keys = keys >> 1))
3967c732 1653 pow2 = pow2 << 1;
3967c732 1654 theoret = HvKEYS(sv);
b8fa94d8 1655 theoret += theoret * (theoret-1)/pow2;
3967c732 1656 PerlIO_putc(file, '\n');
6b4667fc 1657 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732
JD		 1658 }
1659 PerlIO_putc(file, '\n');
57def98f
JH		 1660 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
1661 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
1662 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
bfcb3514
NC		 1663 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1664 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
8d2f4536 1665 {
b9ac451d 1666 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536
NC		 1667 if (mg && mg->mg_obj) {
1668 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1669 }
1670 }
bfcb3514 1671 {
b9ac451d 1672 const char * const hvname = HvNAME_get(sv);
bfcb3514
NC		 1673 if (hvname)
1674 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
1675 }
86f55936 1676 if (SvOOK(sv)) {
b9ac451d 1677 const AV * const backrefs = *Perl_hv_backreferences_p(aTHX_ (HV*)sv);
86f55936
NC		 1678 if (backrefs) {
1679 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1680 PTR2UV(backrefs));
1681 do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
1682 dumpops, pvlim);
1683 }
1684 }
bfcb3514 1685 if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
3967c732 1686 HE *he;
7a5b473e 1687 HV * const hv = (HV*)sv;
3967c732
JD		 1688 int count = maxnest - nest;
1689
1690 hv_iterinit(hv);
e16e2ff8
NC		 1691 while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
1692 && count--) {
98c991d1 1693 SV *elt, *keysv;
e1ec3a88 1694 const char *keypv;
98c991d1 1695 STRLEN len;
7a5b473e 1696 const U32 hash = HeHASH(he);
3967c732 1697
98c991d1 1698 keysv = hv_iterkeysv(he);
93524f2b 1699 keypv = SvPV_const(keysv, len);
3967c732 1700 elt = hv_iterval(hv, he);
98c991d1
JH		 1701 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1702 if (SvUTF8(keysv))
c728cb41 1703 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
afce8e55
NC		 1704 if (HeKREHASH(he))
1705 PerlIO_printf(file, "[REHASH] ");
98c991d1 1706 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
3967c732
JD		 1707 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1708 }
1709 hv_iterinit(hv); /* Return to status quo */
1710 }
1711 break;
1712 case SVt_PVCV:
cbf82dd0
NC		 1713 if (SvPOK(sv)) {
1714 STRLEN len;
1715 const char *const proto = SvPV_const(sv, len);
1716 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
1717 (int) len, proto);
1718 }
3967c732
JD		 1719 /* FALL THROUGH */
1720 case SVt_PVFM:
1721 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC		 1722 if (!CvISXSUB(sv)) {
1723 if (CvSTART(sv)) {
1724 Perl_dump_indent(aTHX_ level, file,
1725 " START = 0x%"UVxf" ===> %"IVdf"\n",
1726 PTR2UV(CvSTART(sv)),
1727 (IV)sequence_num(CvSTART(sv)));
1728 }
1729 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
1730 PTR2UV(CvROOT(sv)));
1731 if (CvROOT(sv) && dumpops) {
1732 do_op_dump(level+1, file, CvROOT(sv));
1733 }
1734 } else {
b1886099
NC		 1735 SV *constant = cv_const_sv((CV *)sv);
1736
d04ba589 1737 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099
NC		 1738
1739 if (constant) {
1740 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
1741 " (CONST SV)\n",
1742 PTR2UV(CvXSUBANY(sv).any_ptr));
1743 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
1744 pvlim);
1745 } else {
1746 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
1747 (IV)CvXSUBANY(sv).any_i32);
1748 }
1749 }
3967c732 1750 do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 1751 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
57def98f 1752 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 1753 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 1754 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
3967c732 1755 if (type == SVt_PVFM)
57def98f
JH		 1756 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
1757 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4
DM		 1758 if (nest < maxnest) {
1759 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732
JD		 1760 }
1761 {
b9ac451d 1762 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 1763 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 1764 PTR2UV(outside),
cf2093f6
JH		 1765 (!outside ? "null"
1766 : CvANON(outside) ? "ANON"
1767 : (outside == PL_main_cv) ? "MAIN"
1768 : CvUNIQUE(outside) ? "UNIQUE"
1769 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
3967c732
JD		 1770 }
1771 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
1772 do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
1773 break;
926fc7b6
DM		 1774 case SVt_PVGV:
1775 case SVt_PVLV:
b9ac451d
AL		 1776 if (type == SVt_PVLV) {
1777 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
1778 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
1779 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
1780 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
1781 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
1782 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
1783 dumpops, pvlim);
1784 }
eff3c707
NC		 1785 if (SvVALID(sv)) {
1786 Perl_dump_indent(aTHX_ level, file, " FLAGS = %u\n", (U8)BmFLAGS(sv));
1787 Perl_dump_indent(aTHX_ level, file, " RARE = %u\n", (U8)BmRARE(sv));
1ca32a20
JH		 1788 Perl_dump_indent(aTHX_ level, file, " PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
1789 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
eff3c707 1790 }
926fc7b6
DM		 1791 if (!isGV_with_GP(sv))
1792 break;
cea2e8a9 1793 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
57def98f 1794 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 1795 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
57def98f 1796 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c
GS		 1797 if (!GvGP(sv))
1798 break;
57def98f
JH		 1799 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
1800 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
1801 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
1802 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
1803 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
1804 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
1805 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
1806 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 1807 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 1808 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
e39917cc 1809 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
3967c732
JD		 1810 do_gv_dump (level, file, " EGV", GvEGV(sv));
1811 break;
1812 case SVt_PVIO:
57def98f
JH		 1813 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
1814 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
1815 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
1816 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
1817 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
1818 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
1819 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 1820 if (IoTOP_NAME(sv))
cea2e8a9 1821 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC		 1822 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
1823 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
1824 else {
1825 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
1826 PTR2UV(IoTOP_GV(sv)));
1827 do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest,
1828 dumpops, pvlim);
1829 }
1830 /* Source filters hide things that are not GVs in these three, so let's
1831 be careful out there. */
27533608 1832 if (IoFMT_NAME(sv))
cea2e8a9 1833 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC		 1834 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
1835 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
1836 else {
1837 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
1838 PTR2UV(IoFMT_GV(sv)));
1839 do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest,
1840 dumpops, pvlim);
1841 }
27533608 1842 if (IoBOTTOM_NAME(sv))
cea2e8a9 1843 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC		 1844 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
1845 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
1846 else {
1847 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
1848 PTR2UV(IoBOTTOM_GV(sv)));
1849 do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
1850 dumpops, pvlim);
1851 }
57def98f 1852 Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
27533608 1853 if (isPRINT(IoTYPE(sv)))
cea2e8a9 1854 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 1855 else
cea2e8a9 1856 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 1857 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732
JD		 1858 break;
1859 }
cea89e20 1860 SvREFCNT_dec(d);
3967c732
JD		 1861}
1862
1863void
864dbfa3 1864Perl_sv_dump(pTHX_ SV *sv)
3967c732 1865{
97aff369 1866 dVAR;
3967c732 1867 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 1868}
bd16a5f0
IZ		 1869
1870int
1871Perl_runops_debug(pTHX)
1872{
97aff369 1873 dVAR;
bd16a5f0
IZ		 1874 if (!PL_op) {
1875 if (ckWARN_d(WARN_DEBUGGING))
9014280d 1876 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ		 1877 return 0;
1878 }
1879
9f3673fb 1880 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0
IZ		 1881 do {
1882 PERL_ASYNC_CHECK();
1883 if (PL_debug) {
b9ac451d 1884 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0
IZ		 1885 PerlIO_printf(Perl_debug_log,
1886 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
1887 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
1888 PTR2UV(*PL_watchaddr));
d6721266
DM		 1889 if (DEBUG_s_TEST_) {
1890 if (DEBUG_v_TEST_) {
1891 PerlIO_printf(Perl_debug_log, "\n");
1892 deb_stack_all();
1893 }
1894 else
1895 debstack();
1896 }
1897
1898
bd16a5f0
IZ		 1899 if (DEBUG_t_TEST_) debop(PL_op);
1900 if (DEBUG_P_TEST_) debprof(PL_op);
1901 }
1902 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
9f3673fb 1903 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
bd16a5f0
IZ		 1904
1905 TAINT_NOT;
1906 return 0;
1907}
1908
1909I32
6867be6d 1910Perl_debop(pTHX_ const OP *o)
bd16a5f0 1911{
97aff369 1912 dVAR;
1045810a
IZ		 1913 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
1914 return 0;
1915
bd16a5f0
IZ		 1916 Perl_deb(aTHX_ "%s", OP_NAME(o));
1917 switch (o->op_type) {
1918 case OP_CONST:
1919 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
1920 break;
1921 case OP_GVSV:
1922 case OP_GV:
1923 if (cGVOPo_gv) {
b9ac451d 1924 SV * const sv = newSV(0);
3b721df9
NC		 1925#ifdef PERL_MAD
1926 /* FIXME - it this making unwarranted assumptions about the
1927 UTF-8 cleanliness of the dump file handle? */
1928 SvUTF8_on(sv);
1929#endif
bd61b366 1930 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 1931 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
bd16a5f0
IZ		 1932 SvREFCNT_dec(sv);
1933 }
1934 else
1935 PerlIO_printf(Perl_debug_log, "(NULL)");
1936 break;
1937 case OP_PADSV:
1938 case OP_PADAV:
1939 case OP_PADHV:
a3b680e6 1940 {
bd16a5f0 1941 /* print the lexical's name */
b9ac451d 1942 CV * const cv = deb_curcv(cxstack_ix);
a3b680e6 1943 SV *sv;
bd16a5f0 1944 if (cv) {
b9ac451d 1945 AV * const padlist = CvPADLIST(cv);
b464bac0 1946 AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
bd16a5f0
IZ		 1947 sv = *av_fetch(comppad, o->op_targ, FALSE);
1948 } else
a0714e2c 1949 sv = NULL;
bd16a5f0 1950 if (sv)
b9ac451d 1951 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
bd16a5f0 1952 else
b9ac451d 1953 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
a3b680e6 1954 }
bd16a5f0
IZ		 1955 break;
1956 default:
091ab601 1957 break;
bd16a5f0
IZ		 1958 }
1959 PerlIO_printf(Perl_debug_log, "\n");
1960 return 0;
1961}
1962
1963STATIC CV*
1964S_deb_curcv(pTHX_ I32 ix)
1965{
97aff369 1966 dVAR;
b9ac451d 1967 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0
IZ		 1968 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
1969 return cx->blk_sub.cv;
1970 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
1971 return PL_compcv;
1972 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
1973 return PL_main_cv;
1974 else if (ix <= 0)
601f1833 1975 return NULL;
bd16a5f0
IZ		 1976 else
1977 return deb_curcv(ix - 1);
1978}
1979
1980void
1981Perl_watch(pTHX_ char **addr)
1982{
97aff369 1983 dVAR;
bd16a5f0
IZ		 1984 PL_watchaddr = addr;
1985 PL_watchok = *addr;
1986 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
1987 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
1988}
1989
1990STATIC void
e1ec3a88 1991S_debprof(pTHX_ const OP *o)
bd16a5f0 1992{
97aff369 1993 dVAR;
1045810a
IZ		 1994 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
1995 return;
bd16a5f0 1996 if (!PL_profiledata)
a02a5408 1997 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ		 1998 ++PL_profiledata[o->op_type];
1999}
2000
2001void
2002Perl_debprofdump(pTHX)
2003{
97aff369 2004 dVAR;
bd16a5f0
IZ		 2005 unsigned i;
2006 if (!PL_profiledata)
2007 return;
2008 for (i = 0; i < MAXO; i++) {
2009 if (PL_profiledata[i])
2010 PerlIO_printf(Perl_debug_log,
2011 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2012 PL_op_name[i]);
2013 }
2014}
66610fdd 2015
3b721df9
NC		 2016#ifdef PERL_MAD
2017/*
2018 * XML variants of most of the above routines
2019 */
2020
2021STATIC
2022void
2023S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2024{
2025 va_list args;
2026 PerlIO_printf(file, "\n ");
2027 va_start(args, pat);
2028 xmldump_vindent(level, file, pat, &args);
2029 va_end(args);
2030}
2031
2032
2033void
2034Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2035{
2036 va_list args;
2037 va_start(args, pat);
2038 xmldump_vindent(level, file, pat, &args);
2039 va_end(args);
2040}
2041
2042void
2043Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
2044{
2045 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
2046 PerlIO_vprintf(file, pat, *args);
2047}
2048
2049void
2050Perl_xmldump_all(pTHX)
2051{
2052 PerlIO_setlinebuf(PL_xmlfp);
2053 if (PL_main_root)
2054 op_xmldump(PL_main_root);
2055 if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2056 PerlIO_close(PL_xmlfp);
2057 PL_xmlfp = 0;
2058}
2059
2060void
2061Perl_xmldump_packsubs(pTHX_ const HV *stash)
2062{
2063 I32 i;
2064 HE *entry;
2065
2066 if (!HvARRAY(stash))
2067 return;
2068 for (i = 0; i <= (I32) HvMAX(stash); i++) {
2069 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
2070 GV *gv = (GV*)HeVAL(entry);
2071 HV *hv;
2072 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
2073 continue;
2074 if (GvCVu(gv))
2075 xmldump_sub(gv);
2076 if (GvFORM(gv))
2077 xmldump_form(gv);
2078 if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2079 && (hv = GvHV(gv)) && hv != PL_defstash)
2080 xmldump_packsubs(hv); /* nested package */
2081 }
2082 }
2083}
2084
2085void
2086Perl_xmldump_sub(pTHX_ const GV *gv)
2087{
2088 SV *sv = sv_newmortal();
2089
2090 gv_fullname3(sv, gv, Nullch);
2091 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2092 if (CvXSUB(GvCV(gv)))
2093 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2094 PTR2UV(CvXSUB(GvCV(gv))),
2095 (int)CvXSUBANY(GvCV(gv)).any_i32);
2096 else if (CvROOT(GvCV(gv)))
2097 op_xmldump(CvROOT(GvCV(gv)));
2098 else
2099 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2100}
2101
2102void
2103Perl_xmldump_form(pTHX_ const GV *gv)
2104{
2105 SV *sv = sv_newmortal();
2106
2107 gv_fullname3(sv, gv, Nullch);
2108 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2109 if (CvROOT(GvFORM(gv)))
2110 op_xmldump(CvROOT(GvFORM(gv)));
2111 else
2112 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2113}
2114
2115void
2116Perl_xmldump_eval(pTHX)
2117{
2118 op_xmldump(PL_eval_root);
2119}
2120
2121char *
2122Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
2123{
2124 return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2125}
2126
2127char *
2128Perl_sv_catxmlpvn(pTHX_ SV *dsv, char* pv, STRLEN len, int utf8)
2129{
2130 unsigned int c;
2131 char *e = pv + len;
2132 char *start = pv;
2133 STRLEN dsvcur;
2134 STRLEN cl;
2135
2136 sv_catpvn(dsv,"",0);
2137 dsvcur = SvCUR(dsv); /* in case we have to restart */
2138
2139 retry:
2140 while (pv < e) {
2141 if (utf8) {
2142 c = utf8_to_uvchr((U8*)pv, &cl);
2143 if (cl == 0) {
2144 SvCUR(dsv) = dsvcur;
2145 pv = start;
2146 utf8 = 0;
2147 goto retry;
2148 }
2149 }
2150 else
2151 c = (*pv & 255);
2152
2153 switch (c) {
2154 case 0x00:
2155 case 0x01:
2156 case 0x02:
2157 case 0x03:
2158 case 0x04:
2159 case 0x05:
2160 case 0x06:
2161 case 0x07:
2162 case 0x08:
2163 case 0x0b:
2164 case 0x0c:
2165 case 0x0e:
2166 case 0x0f:
2167 case 0x10:
2168 case 0x11:
2169 case 0x12:
2170 case 0x13:
2171 case 0x14:
2172 case 0x15:
2173 case 0x16:
2174 case 0x17:
2175 case 0x18:
2176 case 0x19:
2177 case 0x1a:
2178 case 0x1b:
2179 case 0x1c:
2180 case 0x1d:
2181 case 0x1e:
2182 case 0x1f:
2183 case 0x7f:
2184 case 0x80:
2185 case 0x81:
2186 case 0x82:
2187 case 0x83:
2188 case 0x84:
2189 case 0x86:
2190 case 0x87:
2191 case 0x88:
2192 case 0x89:
2193 case 0x90:
2194 case 0x91:
2195 case 0x92:
2196 case 0x93:
2197 case 0x94:
2198 case 0x95:
2199 case 0x96:
2200 case 0x97:
2201 case 0x98:
2202 case 0x99:
2203 case 0x9a:
2204 case 0x9b:
2205 case 0x9c:
2206 case 0x9d:
2207 case 0x9e:
2208 case 0x9f:
2209 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2210 break;
2211 case '<':
2212 Perl_sv_catpvf(aTHX_ dsv, "&lt;");
2213 break;
2214 case '>':
2215 Perl_sv_catpvf(aTHX_ dsv, "&gt;");
2216 break;
2217 case '&':
2218 Perl_sv_catpvf(aTHX_ dsv, "&amp;");
2219 break;
2220 case '"':
2221 Perl_sv_catpvf(aTHX_ dsv, "&#34;");
2222 break;
2223 default:
2224 if (c < 0xD800) {
2225 if (c < 32 || c > 127) {
2226 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2227 }
2228 else {
2229 Perl_sv_catpvf(aTHX_ dsv, "%c", c);
2230 }
2231 break;
2232 }
2233 if ((c >= 0xD800 && c <= 0xDB7F) ||
2234 (c >= 0xDC00 && c <= 0xDFFF) ||
2235 (c >= 0xFFF0 && c <= 0xFFFF) ||
2236 c > 0x10ffff)
2237 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2238 else
2239 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2240 }
2241
2242 if (utf8)
2243 pv += UTF8SKIP(pv);
2244 else
2245 pv++;
2246 }
2247
2248 return SvPVX(dsv);
2249}
2250
2251char *
2252Perl_sv_xmlpeek(pTHX_ SV *sv)
2253{
2254 SV *t = sv_newmortal();
2255 STRLEN n_a;
2256 int unref = 0;
2257
2258 sv_utf8_upgrade(t);
2259 sv_setpvn(t, "", 0);
2260 /* retry: */
2261 if (!sv) {
2262 sv_catpv(t, "VOID=\"\"");
2263 goto finish;
2264 }
2265 else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
2266 sv_catpv(t, "WILD=\"\"");
2267 goto finish;
2268 }
2269 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
2270 if (sv == &PL_sv_undef) {
2271 sv_catpv(t, "SV_UNDEF=\"1\"");
2272 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2273 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2274 SvREADONLY(sv))
2275 goto finish;
2276 }
2277 else if (sv == &PL_sv_no) {
2278 sv_catpv(t, "SV_NO=\"1\"");
2279 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2280 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2281 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2282 SVp_POK|SVp_NOK)) &&
2283 SvCUR(sv) == 0 &&
2284 SvNVX(sv) == 0.0)
2285 goto finish;
2286 }
2287 else if (sv == &PL_sv_yes) {
2288 sv_catpv(t, "SV_YES=\"1\"");
2289 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2290 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2291 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2292 SVp_POK|SVp_NOK)) &&
2293 SvCUR(sv) == 1 &&
2294 SvPVX(sv) && *SvPVX(sv) == '1' &&
2295 SvNVX(sv) == 1.0)
2296 goto finish;
2297 }
2298 else {
2299 sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2300 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2301 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2302 SvREADONLY(sv))
2303 goto finish;
2304 }
2305 sv_catpv(t, " XXX=\"\" ");
2306 }
2307 else if (SvREFCNT(sv) == 0) {
2308 sv_catpv(t, " refcnt=\"0\"");
2309 unref++;
2310 }
2311 else if (DEBUG_R_TEST_) {
2312 int is_tmp = 0;
2313 I32 ix;
2314 /* is this SV on the tmps stack? */
2315 for (ix=PL_tmps_ix; ix>=0; ix--) {
2316 if (PL_tmps_stack[ix] == sv) {
2317 is_tmp = 1;
2318 break;
2319 }
2320 }
2321 if (SvREFCNT(sv) > 1)
2322 Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2323 is_tmp ? "T" : "");
2324 else if (is_tmp)
2325 sv_catpv(t, " DRT=\"<T>\"");
2326 }
2327
2328 if (SvROK(sv)) {
2329 sv_catpv(t, " ROK=\"\"");
2330 }
2331 switch (SvTYPE(sv)) {
2332 default:
2333 sv_catpv(t, " FREED=\"1\"");
2334 goto finish;
2335
2336 case SVt_NULL:
2337 sv_catpv(t, " UNDEF=\"1\"");
2338 goto finish;
2339 case SVt_IV:
2340 sv_catpv(t, " IV=\"");
2341 break;
2342 case SVt_NV:
2343 sv_catpv(t, " NV=\"");
2344 break;
2345 case SVt_RV:
2346 sv_catpv(t, " RV=\"");
2347 break;
2348 case SVt_PV:
2349 sv_catpv(t, " PV=\"");
2350 break;
2351 case SVt_PVIV:
2352 sv_catpv(t, " PVIV=\"");
2353 break;
2354 case SVt_PVNV:
2355 sv_catpv(t, " PVNV=\"");
2356 break;
2357 case SVt_PVMG:
2358 sv_catpv(t, " PVMG=\"");
2359 break;
2360 case SVt_PVLV:
2361 sv_catpv(t, " PVLV=\"");
2362 break;
2363 case SVt_PVAV:
2364 sv_catpv(t, " AV=\"");
2365 break;
2366 case SVt_PVHV:
2367 sv_catpv(t, " HV=\"");
2368 break;
2369 case SVt_PVCV:
2370 if (CvGV(sv))
2371 Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2372 else
2373 sv_catpv(t, " CV=\"()\"");
2374 goto finish;
2375 case SVt_PVGV:
2376 sv_catpv(t, " GV=\"");
2377 break;
cecf5685
NC		 2378 case SVt_BIND:
2379 sv_catpv(t, " BIND=\"");
3b721df9
NC		 2380 break;
2381 case SVt_PVFM:
2382 sv_catpv(t, " FM=\"");
2383 break;
2384 case SVt_PVIO:
2385 sv_catpv(t, " IO=\"");
2386 break;
2387 }
2388
2389 if (SvPOKp(sv)) {
2390 if (SvPVX(sv)) {
2391 sv_catxmlsv(t, sv);
2392 }
2393 }
2394 else if (SvNOKp(sv)) {
2395 STORE_NUMERIC_LOCAL_SET_STANDARD();
2396 Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2397 RESTORE_NUMERIC_LOCAL();
2398 }
2399 else if (SvIOKp(sv)) {
2400 if (SvIsUV(sv))
2401 Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2402 else
2403 Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2404 }
2405 else
2406 sv_catpv(t, "");
2407 sv_catpv(t, "\"");
2408
2409 finish:
2410 if (unref) {
2411 while (unref--)
2412 sv_catpv(t, ")");
2413 }
2414 return SvPV(t, n_a);
2415}
2416
2417void
2418Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
2419{
2420 if (!pm) {
2421 Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
2422 return;
2423 }
2424 Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
2425 level++;
2426 if (PM_GETRE(pm)) {
2427 char *s = PM_GETRE(pm)->precomp;
29522234 2428 SV *tmpsv = newSVpvn("",0);
3b721df9
NC		 2429 SvUTF8_on(tmpsv);
2430 sv_catxmlpvn(tmpsv, s, strlen(s), 1);
2431 Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2432 SvPVX(tmpsv));
2433 SvREFCNT_dec(tmpsv);
2434 Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2435 (pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2436 }
2437 else
2438 Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
2439 if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
3df43ef7 2440 SV * const tmpsv = pm_description(pm);
3b721df9
NC		 2441 Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2442 SvREFCNT_dec(tmpsv);
2443 }
2444
2445 level--;
2446 if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
2447 Perl_xmldump_indent(aTHX_ level, file, ">\n");
2448 Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
2449 do_op_xmldump(level+2, file, pm->op_pmreplroot);
2450 Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
2451 Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
2452 }
2453 else
2454 Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2455}
2456
2457void
2458Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2459{
2460 do_pmop_xmldump(0, PL_xmlfp, pm);
2461}
2462
2463void
2464Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
2465{
2466 UV seq;
2467 int contents = 0;
2468 if (!o)
2469 return;
2470 sequence(o);
2471 seq = sequence_num(o);
2472 Perl_xmldump_indent(aTHX_ level, file,
2473 "<op_%s seq=\"%"UVuf" -> ",
2474 OP_NAME(o),
2475 seq);
2476 level++;
2477 if (o->op_next)
2478 PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2479 sequence_num(o->op_next));
2480 else
2481 PerlIO_printf(file, "DONE\"");
2482
2483 if (o->op_targ) {
2484 if (o->op_type == OP_NULL)
2485 {
2486 PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2487 if (o->op_targ == OP_NEXTSTATE)
2488 {
2489 if (CopLINE(cCOPo))
f5992bc4 2490 PerlIO_printf(file, " line=\"%"UVuf"\"",
3b721df9
NC		 2491 (UV)CopLINE(cCOPo));
2492 if (CopSTASHPV(cCOPo))
2493 PerlIO_printf(file, " package=\"%s\"",
2494 CopSTASHPV(cCOPo));
2495 if (cCOPo->cop_label)
2496 PerlIO_printf(file, " label=\"%s\"",
2497 cCOPo->cop_label);
2498 }
2499 }
2500 else
2501 PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2502 }
2503#ifdef DUMPADDR
2504 PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2505#endif
2506 if (o->op_flags) {
2507 SV *tmpsv = newSVpvn("", 0);
2508 switch (o->op_flags & OPf_WANT) {
2509 case OPf_WANT_VOID:
2510 sv_catpv(tmpsv, ",VOID");
2511 break;
2512 case OPf_WANT_SCALAR:
2513 sv_catpv(tmpsv, ",SCALAR");
2514 break;
2515 case OPf_WANT_LIST:
2516 sv_catpv(tmpsv, ",LIST");
2517 break;
2518 default:
2519 sv_catpv(tmpsv, ",UNKNOWN");
2520 break;
2521 }
2522 if (o->op_flags & OPf_KIDS)
2523 sv_catpv(tmpsv, ",KIDS");
2524 if (o->op_flags & OPf_PARENS)
2525 sv_catpv(tmpsv, ",PARENS");
2526 if (o->op_flags & OPf_STACKED)
2527 sv_catpv(tmpsv, ",STACKED");
2528 if (o->op_flags & OPf_REF)
2529 sv_catpv(tmpsv, ",REF");
2530 if (o->op_flags & OPf_MOD)
2531 sv_catpv(tmpsv, ",MOD");
2532 if (o->op_flags & OPf_SPECIAL)
2533 sv_catpv(tmpsv, ",SPECIAL");
2534 PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2535 SvREFCNT_dec(tmpsv);
2536 }
2537 if (o->op_private) {
2538 SV *tmpsv = newSVpvn("", 0);
2539 if (PL_opargs[o->op_type] & OA_TARGLEX) {
2540 if (o->op_private & OPpTARGET_MY)
2541 sv_catpv(tmpsv, ",TARGET_MY");
2542 }
2543 else if (o->op_type == OP_LEAVESUB ||
2544 o->op_type == OP_LEAVE ||
2545 o->op_type == OP_LEAVESUBLV ||
2546 o->op_type == OP_LEAVEWRITE) {
2547 if (o->op_private & OPpREFCOUNTED)
2548 sv_catpv(tmpsv, ",REFCOUNTED");
2549 }
2550 else if (o->op_type == OP_AASSIGN) {
2551 if (o->op_private & OPpASSIGN_COMMON)
2552 sv_catpv(tmpsv, ",COMMON");
2553 }
2554 else if (o->op_type == OP_SASSIGN) {
2555 if (o->op_private & OPpASSIGN_BACKWARDS)
2556 sv_catpv(tmpsv, ",BACKWARDS");
2557 }
2558 else if (o->op_type == OP_TRANS) {
2559 if (o->op_private & OPpTRANS_SQUASH)
2560 sv_catpv(tmpsv, ",SQUASH");
2561 if (o->op_private & OPpTRANS_DELETE)
2562 sv_catpv(tmpsv, ",DELETE");
2563 if (o->op_private & OPpTRANS_COMPLEMENT)
2564 sv_catpv(tmpsv, ",COMPLEMENT");
2565 if (o->op_private & OPpTRANS_IDENTICAL)
2566 sv_catpv(tmpsv, ",IDENTICAL");
2567 if (o->op_private & OPpTRANS_GROWS)
2568 sv_catpv(tmpsv, ",GROWS");
2569 }
2570 else if (o->op_type == OP_REPEAT) {
2571 if (o->op_private & OPpREPEAT_DOLIST)
2572 sv_catpv(tmpsv, ",DOLIST");
2573 }
2574 else if (o->op_type == OP_ENTERSUB ||
2575 o->op_type == OP_RV2SV ||
2576 o->op_type == OP_GVSV ||
2577 o->op_type == OP_RV2AV ||
2578 o->op_type == OP_RV2HV ||
2579 o->op_type == OP_RV2GV ||
2580 o->op_type == OP_AELEM ||
2581 o->op_type == OP_HELEM )
2582 {
2583 if (o->op_type == OP_ENTERSUB) {
2584 if (o->op_private & OPpENTERSUB_AMPER)
2585 sv_catpv(tmpsv, ",AMPER");
2586 if (o->op_private & OPpENTERSUB_DB)
2587 sv_catpv(tmpsv, ",DB");
2588 if (o->op_private & OPpENTERSUB_HASTARG)
2589 sv_catpv(tmpsv, ",HASTARG");
2590 if (o->op_private & OPpENTERSUB_NOPAREN)
2591 sv_catpv(tmpsv, ",NOPAREN");
2592 if (o->op_private & OPpENTERSUB_INARGS)
2593 sv_catpv(tmpsv, ",INARGS");
2594 if (o->op_private & OPpENTERSUB_NOMOD)
2595 sv_catpv(tmpsv, ",NOMOD");
2596 }
2597 else {
2598 switch (o->op_private & OPpDEREF) {
2599 case OPpDEREF_SV:
2600 sv_catpv(tmpsv, ",SV");
2601 break;
2602 case OPpDEREF_AV:
2603 sv_catpv(tmpsv, ",AV");
2604 break;
2605 case OPpDEREF_HV:
2606 sv_catpv(tmpsv, ",HV");
2607 break;
2608 }
2609 if (o->op_private & OPpMAYBE_LVSUB)
2610 sv_catpv(tmpsv, ",MAYBE_LVSUB");
2611 }
2612 if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
2613 if (o->op_private & OPpLVAL_DEFER)
2614 sv_catpv(tmpsv, ",LVAL_DEFER");
2615 }
2616 else {
2617 if (o->op_private & HINT_STRICT_REFS)
2618 sv_catpv(tmpsv, ",STRICT_REFS");
2619 if (o->op_private & OPpOUR_INTRO)
2620 sv_catpv(tmpsv, ",OUR_INTRO");
2621 }
2622 }
2623 else if (o->op_type == OP_CONST) {
2624 if (o->op_private & OPpCONST_BARE)
2625 sv_catpv(tmpsv, ",BARE");
2626 if (o->op_private & OPpCONST_STRICT)
2627 sv_catpv(tmpsv, ",STRICT");
2628 if (o->op_private & OPpCONST_ARYBASE)
2629 sv_catpv(tmpsv, ",ARYBASE");
2630 if (o->op_private & OPpCONST_WARNING)
2631 sv_catpv(tmpsv, ",WARNING");
2632 if (o->op_private & OPpCONST_ENTERED)
2633 sv_catpv(tmpsv, ",ENTERED");
2634 }
2635 else if (o->op_type == OP_FLIP) {
2636 if (o->op_private & OPpFLIP_LINENUM)
2637 sv_catpv(tmpsv, ",LINENUM");
2638 }
2639 else if (o->op_type == OP_FLOP) {
2640 if (o->op_private & OPpFLIP_LINENUM)
2641 sv_catpv(tmpsv, ",LINENUM");
2642 }
2643 else if (o->op_type == OP_RV2CV) {
2644 if (o->op_private & OPpLVAL_INTRO)
2645 sv_catpv(tmpsv, ",INTRO");
2646 }
2647 else if (o->op_type == OP_GV) {
2648 if (o->op_private & OPpEARLY_CV)
2649 sv_catpv(tmpsv, ",EARLY_CV");
2650 }
2651 else if (o->op_type == OP_LIST) {
2652 if (o->op_private & OPpLIST_GUESSED)
2653 sv_catpv(tmpsv, ",GUESSED");
2654 }
2655 else if (o->op_type == OP_DELETE) {
2656 if (o->op_private & OPpSLICE)
2657 sv_catpv(tmpsv, ",SLICE");
2658 }
2659 else if (o->op_type == OP_EXISTS) {
2660 if (o->op_private & OPpEXISTS_SUB)
2661 sv_catpv(tmpsv, ",EXISTS_SUB");
2662 }
2663 else if (o->op_type == OP_SORT) {
2664 if (o->op_private & OPpSORT_NUMERIC)
2665 sv_catpv(tmpsv, ",NUMERIC");
2666 if (o->op_private & OPpSORT_INTEGER)
2667 sv_catpv(tmpsv, ",INTEGER");
2668 if (o->op_private & OPpSORT_REVERSE)
2669 sv_catpv(tmpsv, ",REVERSE");
2670 }
3b721df9
NC		 2671 else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
2672 if (o->op_private & OPpOPEN_IN_RAW)
2673 sv_catpv(tmpsv, ",IN_RAW");
2674 if (o->op_private & OPpOPEN_IN_CRLF)
2675 sv_catpv(tmpsv, ",IN_CRLF");
2676 if (o->op_private & OPpOPEN_OUT_RAW)
2677 sv_catpv(tmpsv, ",OUT_RAW");
2678 if (o->op_private & OPpOPEN_OUT_CRLF)
2679 sv_catpv(tmpsv, ",OUT_CRLF");
2680 }
2681 else if (o->op_type == OP_EXIT) {
2682 if (o->op_private & OPpEXIT_VMSISH)
2683 sv_catpv(tmpsv, ",EXIT_VMSISH");
2684 if (o->op_private & OPpHUSH_VMSISH)
2685 sv_catpv(tmpsv, ",HUSH_VMSISH");
2686 }
2687 else if (o->op_type == OP_DIE) {
2688 if (o->op_private & OPpHUSH_VMSISH)
2689 sv_catpv(tmpsv, ",HUSH_VMSISH");
2690 }
2691 else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
2692 if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
2693 sv_catpv(tmpsv, ",FT_ACCESS");
2694 if (o->op_private & OPpFT_STACKED)
2695 sv_catpv(tmpsv, ",FT_STACKED");
2696 }
2697 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
2698 sv_catpv(tmpsv, ",INTRO");
2699 if (SvCUR(tmpsv))
2700 S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
2701 SvREFCNT_dec(tmpsv);
2702 }
2703
2704 switch (o->op_type) {
2705 case OP_AELEMFAST:
2706 if (o->op_flags & OPf_SPECIAL) {
2707 break;
2708 }
2709 case OP_GVSV:
2710 case OP_GV:
2711#ifdef USE_ITHREADS
2712 S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
2713#else
2714 if (cSVOPo->op_sv) {
ef2570c4 2715 SV *tmpsv1 = newSV(0);
29522234 2716 SV *tmpsv2 = newSVpvn("",0);
3b721df9
NC		 2717 char *s;
2718 STRLEN len;
b123ab9d
NC		 2719 SvUTF8_on(tmpsv1);
2720 SvUTF8_on(tmpsv2);
3b721df9
NC		 2721 ENTER;
2722 SAVEFREESV(tmpsv1);
2723 SAVEFREESV(tmpsv2);
2724 gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, Nullch);
2725 s = SvPV(tmpsv1,len);
2726 sv_catxmlpvn(tmpsv2, s, len, 1);
2727 S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
2728 LEAVE;
2729 }
2730 else
2731 S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
2732#endif
2733 break;
2734 case OP_CONST:
2735 case OP_METHOD_NAMED:
2736#ifndef USE_ITHREADS
2737 /* with ITHREADS, consts are stored in the pad, and the right pad
2738 * may not be active here, so skip */
2739 S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
2740#endif
2741 break;
2742 case OP_ANONCODE:
2743 if (!contents) {
2744 contents = 1;
2745 PerlIO_printf(file, ">\n");
2746 }
2747 do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
2748 break;
2749 case OP_SETSTATE:
2750 case OP_NEXTSTATE:
2751 case OP_DBSTATE:
2752 if (CopLINE(cCOPo))
f5992bc4 2753 S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
3b721df9
NC		 2754 (UV)CopLINE(cCOPo));
2755 if (CopSTASHPV(cCOPo))
2756 S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
2757 CopSTASHPV(cCOPo));
2758 if (cCOPo->cop_label)
2759 S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
2760 cCOPo->cop_label);
2761 break;
2762 case OP_ENTERLOOP:
2763 S_xmldump_attr(aTHX_ level, file, "redo=\"");
2764 if (cLOOPo->op_redoop)
2765 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
2766 else
2767 PerlIO_printf(file, "DONE\"");
2768 S_xmldump_attr(aTHX_ level, file, "next=\"");
2769 if (cLOOPo->op_nextop)
2770 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
2771 else
2772 PerlIO_printf(file, "DONE\"");
2773 S_xmldump_attr(aTHX_ level, file, "last=\"");
2774 if (cLOOPo->op_lastop)
2775 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
2776 else
2777 PerlIO_printf(file, "DONE\"");
2778 break;
2779 case OP_COND_EXPR:
2780 case OP_RANGE:
2781 case OP_MAPWHILE:
2782 case OP_GREPWHILE:
2783 case OP_OR:
2784 case OP_AND:
2785 S_xmldump_attr(aTHX_ level, file, "other=\"");
2786 if (cLOGOPo->op_other)
2787 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
2788 else
2789 PerlIO_printf(file, "DONE\"");
2790 break;
2791 case OP_LEAVE:
2792 case OP_LEAVEEVAL:
2793 case OP_LEAVESUB:
2794 case OP_LEAVESUBLV:
2795 case OP_LEAVEWRITE:
2796 case OP_SCOPE:
2797 if (o->op_private & OPpREFCOUNTED)
2798 S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
2799 break;
2800 default:
2801 break;
2802 }
2803
2804 if (PL_madskills && o->op_madprop) {
2805 SV *tmpsv = newSVpvn("", 0);
2806 MADPROP* mp = o->op_madprop;
2807 sv_utf8_upgrade(tmpsv);
2808 if (!contents) {
2809 contents = 1;
2810 PerlIO_printf(file, ">\n");
2811 }
2812 Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
2813 level++;
2814 while (mp) {
2815 char tmp = mp->mad_key;
2816 sv_setpvn(tmpsv,"\"",1);
2817 if (tmp)
2818 sv_catxmlpvn(tmpsv, &tmp, 1, 0);
2819 sv_catpv(tmpsv, "\"");
2820 switch (mp->mad_type) {
2821 case MAD_NULL:
2822 sv_catpv(tmpsv, "NULL");
2823 Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
2824 break;
2825 case MAD_PV:
2826 sv_catpv(tmpsv, " val=\"");
2827 sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
2828 sv_catpv(tmpsv, "\"");
2829 Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
2830 break;
2831 case MAD_SV:
2832 sv_catpv(tmpsv, " val=\"");
2833 sv_catxmlsv(tmpsv, (SV*)mp->mad_val);
2834 sv_catpv(tmpsv, "\"");
2835 Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
2836 break;
2837 case MAD_OP:
2838 if ((OP*)mp->mad_val) {
2839 Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
2840 do_op_xmldump(level+1, file, (OP*)mp->mad_val);
2841 Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
2842 }
2843 break;
2844 default:
2845 Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
2846 break;
2847 }
2848 mp = mp->mad_next;
2849 }
2850 level--;
2851 Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
2852
2853 SvREFCNT_dec(tmpsv);
2854 }
2855
2856 switch (o->op_type) {
2857 case OP_PUSHRE:
2858 case OP_MATCH:
2859 case OP_QR:
2860 case OP_SUBST:
2861 if (!contents) {
2862 contents = 1;
2863 PerlIO_printf(file, ">\n");
2864 }
2865 do_pmop_xmldump(level, file, cPMOPo);
2866 break;
2867 default:
2868 break;
2869 }
2870
2871 if (o->op_flags & OPf_KIDS) {
2872 OP *kid;
2873 if (!contents) {
2874 contents = 1;
2875 PerlIO_printf(file, ">\n");
2876 }
2877 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
2878 do_op_xmldump(level, file, kid);
2879 }
2880
2881 if (contents)
2882 Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
2883 else
2884 PerlIO_printf(file, " />\n");
2885}
2886
2887void
2888Perl_op_xmldump(pTHX_ const OP *o)
2889{
2890 do_op_xmldump(0, PL_xmlfp, o);
2891}
2892#endif
2893
66610fdd
RGS		 2894/*
2895 * Local variables:
2896 * c-indentation-style: bsd
2897 * c-basic-offset: 4
2898 * indent-tabs-mode: t
2899 * End:
2900 *
37442d52
RGS		 2901 * ex: set ts=8 sts=4 sw=4 noet:
2902 */
Unnamed repository; edit this file 'description' to name the repository.