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