projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Less sed'ing in Cygwin Makefile.SHs
[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
178If PERL_PV_ESCAPE_UNI is set then the input string is treated as unicode,
179if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
180using C<is_utf8_string()> to determine if it is unicode.
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 */
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
299pv_escape() and supporting quoting and elipses.
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
306If the PERL_PV_PRETTY_ELIPSES flag is set and not all characters in
307string were output then an elipses C<...> will be appended to the
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
313any quotes or elipses.
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
348 if ( (flags & PERL_PV_PRETTY_ELIPSES) && ( 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\"]",
c728cb41 494 sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
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) {
27da23d5 634 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;
27da23d5 652 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:
27da23d5 665 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:
27da23d5 671 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:
27da23d5 678 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:
27da23d5 688 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)" },
1173 { PERL_MAGIC_mutex, "mutex(m)" },
afe38520 1174 { PERL_MAGIC_shared_scalar, "shared_scalar(n)" },
516a5887 1175 { PERL_MAGIC_collxfrm, "collxfrm(o)" },
1176 { PERL_MAGIC_tiedelem, "tiedelem(p)" },
1177 { PERL_MAGIC_tiedscalar, "tiedscalar(q)" },
1178 { PERL_MAGIC_qr, "qr(r)" },
1179 { PERL_MAGIC_sigelem, "sigelem(s)" },
1180 { PERL_MAGIC_taint, "taint(t)" },
afe38520 1181 { PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
516a5887 1182 { PERL_MAGIC_vec, "vec(v)" },
cb50f42d 1183 { PERL_MAGIC_vstring, "vstring(V)" },
7e8c5dac 1184 { PERL_MAGIC_utf8, "utf8(w)" },
516a5887 1185 { PERL_MAGIC_substr, "substr(x)" },
1186 { PERL_MAGIC_defelem, "defelem(y)" },
1187 { PERL_MAGIC_ext, "ext(~)" },
1188 /* this null string terminates the list */
b9ac451d 1189 { 0, NULL },
14befaf4 1190};
1191
8adcabd8 1192void
6867be6d 1193Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1194{
3967c732 1195 for (; mg; mg = mg->mg_moremagic) {
b900a521 1196 Perl_dump_indent(aTHX_ level, file,
1197 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1198 if (mg->mg_virtual) {
bfed75c6 1199 const MGVTBL * const v = mg->mg_virtual;
b9ac451d 1200 const char *s;
3967c732 1201 if (v == &PL_vtbl_sv) s = "sv";
1202 else if (v == &PL_vtbl_env) s = "env";
1203 else if (v == &PL_vtbl_envelem) s = "envelem";
1204 else if (v == &PL_vtbl_sig) s = "sig";
1205 else if (v == &PL_vtbl_sigelem) s = "sigelem";
1206 else if (v == &PL_vtbl_pack) s = "pack";
1207 else if (v == &PL_vtbl_packelem) s = "packelem";
1208 else if (v == &PL_vtbl_dbline) s = "dbline";
1209 else if (v == &PL_vtbl_isa) s = "isa";
1210 else if (v == &PL_vtbl_arylen) s = "arylen";
3967c732 1211 else if (v == &PL_vtbl_mglob) s = "mglob";
1212 else if (v == &PL_vtbl_nkeys) s = "nkeys";
1213 else if (v == &PL_vtbl_taint) s = "taint";
1214 else if (v == &PL_vtbl_substr) s = "substr";
1215 else if (v == &PL_vtbl_vec) s = "vec";
1216 else if (v == &PL_vtbl_pos) s = "pos";
1217 else if (v == &PL_vtbl_bm) s = "bm";
1218 else if (v == &PL_vtbl_fm) s = "fm";
1219 else if (v == &PL_vtbl_uvar) s = "uvar";
1220 else if (v == &PL_vtbl_defelem) s = "defelem";
1221#ifdef USE_LOCALE_COLLATE
1222 else if (v == &PL_vtbl_collxfrm) s = "collxfrm";
1223#endif
3967c732 1224 else if (v == &PL_vtbl_amagic) s = "amagic";
1225 else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
810b8aa5 1226 else if (v == &PL_vtbl_backref) s = "backref";
7e8c5dac 1227 else if (v == &PL_vtbl_utf8) s = "utf8";
83bf042f 1228 else if (v == &PL_vtbl_arylen_p) s = "arylen_p";
b3ca2e83 1229 else if (v == &PL_vtbl_hintselem) s = "hintselem";
b9ac451d 1230 else s = NULL;
3967c732 1231 if (s)
cea2e8a9 1232 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s);
3967c732 1233 else
b900a521 1234 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732 1235 }
1236 else
cea2e8a9 1237 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1238
3967c732 1239 if (mg->mg_private)
cea2e8a9 1240 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1241
14befaf4 1242 {
1243 int n;
c445ea15 1244 const char *name = NULL;
27da23d5 1245 for (n = 0; magic_names[n].name; n++) {
14befaf4 1246 if (mg->mg_type == magic_names[n].type) {
1247 name = magic_names[n].name;
1248 break;
1249 }
1250 }
1251 if (name)
1252 Perl_dump_indent(aTHX_ level, file,
1253 " MG_TYPE = PERL_MAGIC_%s\n", name);
1254 else
1255 Perl_dump_indent(aTHX_ level, file,
1256 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1257 }
3967c732 1258
1259 if (mg->mg_flags) {
cea2e8a9 1260 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d 1261 if (mg->mg_type == PERL_MAGIC_envelem &&
1262 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1263 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
3967c732 1264 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1265 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1266 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1267 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
cb50f42d 1268 if (mg->mg_type == PERL_MAGIC_regex_global &&
1269 mg->mg_flags & MGf_MINMATCH)
cea2e8a9 1270 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1271 }
1272 if (mg->mg_obj) {
28d8d7f4 1273 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
1274 PTR2UV(mg->mg_obj));
1275 if (mg->mg_type == PERL_MAGIC_qr) {
61f9802b 1276 const regexp * const re = (regexp *)mg->mg_obj;
1277 SV * const dsv = sv_newmortal();
28d8d7f4 1278 const char * const s = pv_pretty(dsv, re->wrapped, re->wraplen,
1279 60, NULL, NULL,
1280 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELIPSES |
1281 ((re->extflags & RXf_UTF8) ? PERL_PV_ESCAPE_UNI : 0))
1282 );
6483fb35 1283 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1284 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
1285 (IV)re->refcnt);
28d8d7f4 1286 }
1287 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732 1288 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1289 }
1290 if (mg->mg_len)
894356b3 1291 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1292 if (mg->mg_ptr) {
b900a521 1293 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1294 if (mg->mg_len >= 0) {
7e8c5dac 1295 if (mg->mg_type != PERL_MAGIC_utf8) {
61f9802b 1296 SV * const sv = newSVpvs("");
7e8c5dac 1297 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1298 SvREFCNT_dec(sv);
1299 }
3967c732 1300 }
1301 else if (mg->mg_len == HEf_SVKEY) {
1302 PerlIO_puts(file, " => HEf_SVKEY\n");
1303 do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1304 continue;
1305 }
1306 else
1307 PerlIO_puts(file, " ???? - please notify IZ");
1308 PerlIO_putc(file, '\n');
1309 }
7e8c5dac 1310 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1311 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac 1312 if (cache) {
1313 IV i;
1314 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1315 Perl_dump_indent(aTHX_ level, file,
1316 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1317 i,
1318 (UV)cache[i * 2],
1319 (UV)cache[i * 2 + 1]);
1320 }
1321 }
378cc40b 1322 }
3967c732 1323}
1324
1325void
6867be6d 1326Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1327{
b9ac451d 1328 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732 1329}
1330
1331void
e1ec3a88 1332Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1333{
bfcb3514 1334 const char *hvname;
b900a521 1335 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514 1336 if (sv && (hvname = HvNAME_get(sv)))
1337 PerlIO_printf(file, "\t\"%s\"\n", hvname);
79072805 1338 else
3967c732 1339 PerlIO_putc(file, '\n');
1340}
1341
1342void
e1ec3a88 1343Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1344{
b900a521 1345 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1346 if (sv && GvNAME(sv))
1347 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
c90c0ff4 1348 else
3967c732 1349 PerlIO_putc(file, '\n');
1350}
1351
1352void
e1ec3a88 1353Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1354{
b900a521 1355 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1356 if (sv && GvNAME(sv)) {
bfcb3514 1357 const char *hvname;
3967c732 1358 PerlIO_printf(file, "\t\"");
bfcb3514 1359 if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
1360 PerlIO_printf(file, "%s\" :: \"", hvname);
3967c732 1361 PerlIO_printf(file, "%s\"\n", GvNAME(sv));
8d063cd8 1362 }
3967c732 1363 else
1364 PerlIO_putc(file, '\n');
1365}
1366
1367void
864dbfa3 1368Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1369{
97aff369 1370 dVAR;
cea89e20 1371 SV *d;
e1ec3a88 1372 const char *s;
3967c732 1373 U32 flags;
1374 U32 type;
1375
1376 if (!sv) {
cea2e8a9 1377 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1378 return;
378cc40b 1379 }
2ef28da1 1380
3967c732 1381 flags = SvFLAGS(sv);
1382 type = SvTYPE(sv);
79072805 1383
cea89e20 1384 d = Perl_newSVpvf(aTHX_
57def98f 1385 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1386 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3 1387 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1388 (int)(PL_dumpindent*level), "");
8d063cd8 1389
e604303a 1390 if (!(flags & SVpad_NAME && (type == SVt_PVMG || type == SVt_PVNV))) {
1391 if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
1392 }
1393 if (!(flags & SVpad_NAME && type == SVt_PVMG)) {
1394 if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
1395 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1396 }
3967c732 1397 if (flags & SVs_TEMP) sv_catpv(d, "TEMP,");
1398 if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,");
1399 if (flags & SVs_GMG) sv_catpv(d, "GMG,");
1400 if (flags & SVs_SMG) sv_catpv(d, "SMG,");
1401 if (flags & SVs_RMG) sv_catpv(d, "RMG,");
4db58590 1402
3967c732 1403 if (flags & SVf_IOK) sv_catpv(d, "IOK,");
1404 if (flags & SVf_NOK) sv_catpv(d, "NOK,");
1405 if (flags & SVf_POK) sv_catpv(d, "POK,");
810b8aa5 1406 if (flags & SVf_ROK) {
1407 sv_catpv(d, "ROK,");
1408 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1409 }
3967c732 1410 if (flags & SVf_OOK) sv_catpv(d, "OOK,");
1411 if (flags & SVf_FAKE) sv_catpv(d, "FAKE,");
1412 if (flags & SVf_READONLY) sv_catpv(d, "READONLY,");
de6bd8a1 1413 if (flags & SVf_BREAK) sv_catpv(d, "BREAK,");
4db58590 1414
dd2eae66 1415 if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,");
3967c732 1416 if (flags & SVp_IOK) sv_catpv(d, "pIOK,");
1417 if (flags & SVp_NOK) sv_catpv(d, "pNOK,");
1418 if (flags & SVp_POK) sv_catpv(d, "pPOK,");
1ccdb730 1419 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
1420 if (SvPCS_IMPORTED(sv))
1421 sv_catpv(d, "PCS_IMPORTED,");
1422 else
9660f481 1423 sv_catpv(d, "SCREAM,");
1ccdb730 1424 }
3967c732 1425
1426 switch (type) {
1427 case SVt_PVCV:
1428 case SVt_PVFM:
1429 if (CvANON(sv)) sv_catpv(d, "ANON,");
1430 if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
1431 if (CvCLONE(sv)) sv_catpv(d, "CLONE,");
1432 if (CvCLONED(sv)) sv_catpv(d, "CLONED,");
de3f1649 1433 if (CvCONST(sv)) sv_catpv(d, "CONST,");
3967c732 1434 if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,");
25da4f38 1435 if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,");
18f7acf9 1436 if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,");
1437 if (CvMETHOD(sv)) sv_catpv(d, "METHOD,");
662a8415 1438 if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,");
7dafbf52 1439 if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,");
3967c732 1440 break;
1441 case SVt_PVHV:
1442 if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,");
1443 if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,");
19692e8d 1444 if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,");
afce8e55 1445 if (HvREHASH(sv)) sv_catpv(d, "REHASH,");
9660f481 1446 if (flags & SVphv_CLONEABLE) sv_catpv(d, "CLONEABLE,");
3967c732 1447 break;
926fc7b6 1448 case SVt_PVGV:
1449 case SVt_PVLV:
1450 if (isGV_with_GP(sv)) {
1451 if (GvINTRO(sv)) sv_catpv(d, "INTRO,");
1452 if (GvMULTI(sv)) sv_catpv(d, "MULTI,");
1453 if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
1454 if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
1455 if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
1456 }
926fc7b6 1457 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732 1458 sv_catpv(d, "IMPORT");
1459 if (GvIMPORTED(sv) == GVf_IMPORTED)
1460 sv_catpv(d, "ALL,");
1461 else {
1462 sv_catpv(d, "(");
1463 if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV");
1464 if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV");
1465 if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV");
1466 if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV");
1467 sv_catpv(d, " ),");
1468 }
1469 }
cecf5685 1470 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1471 if (SvVALID(sv)) sv_catpv(d, "VALID,");
addd1794 1472 /* FALL THROUGH */
25da4f38 1473 default:
e604303a 1474 evaled_or_uv:
25da4f38 1475 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1476 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1477 break;
addd1794 1478 case SVt_PVMG:
00b1698f 1479 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1480 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
2e94196c 1481 /* FALL THROUGH */
e604303a 1482 case SVt_PVNV:
1483 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1484 goto evaled_or_uv;
11ca45c0 1485 case SVt_PVAV:
1486 break;
3967c732 1487 }
86f0d186 1488 /* SVphv_SHAREKEYS is also 0x20000000 */
1489 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1490 sv_catpv(d, "UTF8");
3967c732 1491
b162af07 1492 if (*(SvEND(d) - 1) == ',') {
1493 SvCUR_set(d, SvCUR(d) - 1);
1494 SvPVX(d)[SvCUR(d)] = '\0';
1495 }
3967c732 1496 sv_catpv(d, ")");
b15aece3 1497 s = SvPVX_const(d);
3967c732 1498
fd0854ff 1499#ifdef DEBUG_LEAKING_SCALARS
1500 Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
1501 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1502 sv->sv_debug_line,
1503 sv->sv_debug_inpad ? "for" : "by",
1504 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1505 sv->sv_debug_cloned ? " (cloned)" : "");
1506#endif
cea2e8a9 1507 Perl_dump_indent(aTHX_ level, file, "SV = ");
5357ca29 1508 if (type < SVt_LAST) {
1509 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1510
1511 if (type == SVt_NULL) {
1512 SvREFCNT_dec(d);
1513 return;
1514 }
1515 } else {
faccc32b 1516 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
cea89e20 1517 SvREFCNT_dec(d);
3967c732 1518 return;
1519 }
27bd069f 1520 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1521 && type != SVt_PVCV && !isGV_with_GP(sv))
1522 || type == SVt_IV) {
765f542d 1523 if (SvIsUV(sv)
f8c7b90f 1524#ifdef PERL_OLD_COPY_ON_WRITE
765f542d 1525 || SvIsCOW(sv)
1526#endif
1527 )
57def98f 1528 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1529 else
57def98f 1530 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
3967c732 1531 if (SvOOK(sv))
1532 PerlIO_printf(file, " (OFFSET)");
f8c7b90f 1533#ifdef PERL_OLD_COPY_ON_WRITE
765f542d 1534 if (SvIsCOW_shared_hash(sv))
1535 PerlIO_printf(file, " (HASH)");
1536 else if (SvIsCOW_normal(sv))
1537 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1538#endif
3967c732 1539 PerlIO_putc(file, '\n');
1540 }
0e4c4423 1541 if ((type == SVt_PVNV || type == SVt_PVMG) && SvFLAGS(sv) & SVpad_NAME) {
1542 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1543 (UV) COP_SEQ_RANGE_LOW(sv));
1544 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1545 (UV) COP_SEQ_RANGE_HIGH(sv));
1546 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
eff3c707 1547 && type != SVt_PVCV && type != SVt_PVFM && !isGV_with_GP(sv)
1548 && !SvVALID(sv))
0e4c4423 1549 || type == SVt_NV) {
e54dc35b 1550 STORE_NUMERIC_LOCAL_SET_STANDARD();
57def98f 1551 /* %Vg doesn't work? --jhi */
cf2093f6 1552#ifdef USE_LONG_DOUBLE
2d4389e4 1553 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
cf2093f6 1554#else
cea2e8a9 1555 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
cf2093f6 1556#endif
e54dc35b 1557 RESTORE_NUMERIC_LOCAL();
3967c732 1558 }
1559 if (SvROK(sv)) {
57def98f 1560 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732 1561 if (nest < maxnest)
1562 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1563 }
cea89e20 1564 if (type < SVt_PV) {
1565 SvREFCNT_dec(d);
3967c732 1566 return;
cea89e20 1567 }
f7877b28 1568 if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
b15aece3 1569 if (SvPVX_const(sv)) {
1570 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
3967c732 1571 if (SvOOK(sv))
b15aece3 1572 PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
1573 PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
e6abe6d8 1574 if (SvUTF8(sv)) /* the 8? \x{....} */
c728cb41 1575 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
e6abe6d8 1576 PerlIO_printf(file, "\n");
57def98f 1577 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
1578 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
3967c732 1579 }
1580 else
cea2e8a9 1581 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1582 }
1583 if (type >= SVt_PVMG) {
0e4c4423 1584 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
61f9802b 1585 HV * const ost = SvOURSTASH(sv);
38cbaf55 1586 if (ost)
1587 do_hv_dump(level, file, " OURSTASH", ost);
0e4c4423 1588 } else {
1589 if (SvMAGIC(sv))
1590 do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
1591 }
3967c732 1592 if (SvSTASH(sv))
1593 do_hv_dump(level, file, " STASH", SvSTASH(sv));
1594 }
1595 switch (type) {
3967c732 1596 case SVt_PVAV:
57def98f 1597 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1598 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f 1599 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1600 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732 1601 }
1602 else
1603 PerlIO_putc(file, '\n');
57def98f 1604 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1605 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
a3874608 1606 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
c69006e4 1607 sv_setpvn(d, "", 0);
11ca45c0 1608 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1609 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3 1610 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1611 SvCUR(d) ? SvPVX_const(d) + 1 : "");
3967c732 1612 if (nest < maxnest && av_len((AV*)sv) >= 0) {
1613 int count;
1614 for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) {
61f9802b 1615 SV** const elt = av_fetch((AV*)sv,count,0);
3967c732 1616
57def98f 1617 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1618 if (elt)
3967c732 1619 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1620 }
1621 }
1622 break;
1623 case SVt_PVHV:
57def98f 1624 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
3967c732 1625 if (HvARRAY(sv) && HvKEYS(sv)) {
1626 /* Show distribution of HEs in the ARRAY */
1627 int freq[200];
bb7a0f54 1628#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
3967c732 1629 int i;
1630 int max = 0;
1631 U32 pow2 = 2, keys = HvKEYS(sv);
65202027 1632 NV theoret, sum = 0;
3967c732 1633
1634 PerlIO_printf(file, " (");
1635 Zero(freq, FREQ_MAX + 1, int);
eb160463 1636 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15 1637 HE* h;
1638 int count = 0;
3967c732 1639 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1640 count++;
1641 if (count > FREQ_MAX)
1642 count = FREQ_MAX;
1643 freq[count]++;
1644 if (max < count)
1645 max = count;
1646 }
1647 for (i = 0; i <= max; i++) {
1648 if (freq[i]) {
1649 PerlIO_printf(file, "%d%s:%d", i,
1650 (i == FREQ_MAX) ? "+" : "",
1651 freq[i]);
1652 if (i != max)
1653 PerlIO_printf(file, ", ");
1654 }
1655 }
1656 PerlIO_putc(file, ')');
b8fa94d8 1657 /* The "quality" of a hash is defined as the total number of
1658 comparisons needed to access every element once, relative
1659 to the expected number needed for a random hash.
1660
1661 The total number of comparisons is equal to the sum of
e76cd0fa 1662 the squares of the number of entries in each bucket.
1663 For a random hash of n keys into k buckets, the expected
b8fa94d8 1664 value is
1665 n + n(n-1)/2k
1666 */
1667
3967c732 1668 for (i = max; i > 0; i--) { /* Precision: count down. */
1669 sum += freq[i] * i * i;
1670 }
155aba94 1671 while ((keys = keys >> 1))
3967c732 1672 pow2 = pow2 << 1;
3967c732 1673 theoret = HvKEYS(sv);
b8fa94d8 1674 theoret += theoret * (theoret-1)/pow2;
3967c732 1675 PerlIO_putc(file, '\n');
6b4667fc 1676 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732 1677 }
1678 PerlIO_putc(file, '\n');
57def98f 1679 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
1680 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
1681 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
bfcb3514 1682 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1683 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
8d2f4536 1684 {
b9ac451d 1685 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536 1686 if (mg && mg->mg_obj) {
1687 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1688 }
1689 }
bfcb3514 1690 {
b9ac451d 1691 const char * const hvname = HvNAME_get(sv);
bfcb3514 1692 if (hvname)
1693 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
1694 }
86f55936 1695 if (SvOOK(sv)) {
b9ac451d 1696 const AV * const backrefs = *Perl_hv_backreferences_p(aTHX_ (HV*)sv);
86f55936 1697 if (backrefs) {
1698 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1699 PTR2UV(backrefs));
1700 do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
1701 dumpops, pvlim);
1702 }
1703 }
bfcb3514 1704 if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
3967c732 1705 HE *he;
7a5b473e 1706 HV * const hv = (HV*)sv;
3967c732 1707 int count = maxnest - nest;
1708
1709 hv_iterinit(hv);
e16e2ff8 1710 while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
1711 && count--) {
98c991d1 1712 STRLEN len;
7a5b473e 1713 const U32 hash = HeHASH(he);
61f9802b 1714 SV * const keysv = hv_iterkeysv(he);
1715 const char * const keypv = SvPV_const(keysv, len);
1716 SV * const elt = hv_iterval(hv, he);
3967c732 1717
98c991d1 1718 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1719 if (SvUTF8(keysv))
c728cb41 1720 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
afce8e55 1721 if (HeKREHASH(he))
1722 PerlIO_printf(file, "[REHASH] ");
98c991d1 1723 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
3967c732 1724 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1725 }
1726 hv_iterinit(hv); /* Return to status quo */
1727 }
1728 break;
1729 case SVt_PVCV:
cbf82dd0 1730 if (SvPOK(sv)) {
1731 STRLEN len;
1732 const char *const proto = SvPV_const(sv, len);
1733 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
1734 (int) len, proto);
1735 }
3967c732 1736 /* FALL THROUGH */
1737 case SVt_PVFM:
1738 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589 1739 if (!CvISXSUB(sv)) {
1740 if (CvSTART(sv)) {
1741 Perl_dump_indent(aTHX_ level, file,
1742 " START = 0x%"UVxf" ===> %"IVdf"\n",
1743 PTR2UV(CvSTART(sv)),
1744 (IV)sequence_num(CvSTART(sv)));
1745 }
1746 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
1747 PTR2UV(CvROOT(sv)));
1748 if (CvROOT(sv) && dumpops) {
1749 do_op_dump(level+1, file, CvROOT(sv));
1750 }
1751 } else {
61f9802b 1752 SV * const constant = cv_const_sv((CV *)sv);
b1886099 1753
d04ba589 1754 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099 1755
1756 if (constant) {
1757 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
1758 " (CONST SV)\n",
1759 PTR2UV(CvXSUBANY(sv).any_ptr));
1760 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
1761 pvlim);
1762 } else {
1763 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
1764 (IV)CvXSUBANY(sv).any_i32);
1765 }
1766 }
3967c732 1767 do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 1768 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
57def98f 1769 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 1770 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 1771 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
3967c732 1772 if (type == SVt_PVFM)
57def98f 1773 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
1774 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4 1775 if (nest < maxnest) {
1776 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732 1777 }
1778 {
b9ac451d 1779 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 1780 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 1781 PTR2UV(outside),
cf2093f6 1782 (!outside ? "null"
1783 : CvANON(outside) ? "ANON"
1784 : (outside == PL_main_cv) ? "MAIN"
1785 : CvUNIQUE(outside) ? "UNIQUE"
1786 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
3967c732 1787 }
1788 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
1789 do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
1790 break;
926fc7b6 1791 case SVt_PVGV:
1792 case SVt_PVLV:
b9ac451d 1793 if (type == SVt_PVLV) {
1794 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
1795 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
1796 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
1797 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
1798 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
1799 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
1800 dumpops, pvlim);
1801 }
eff3c707 1802 if (SvVALID(sv)) {
1803 Perl_dump_indent(aTHX_ level, file, " FLAGS = %u\n", (U8)BmFLAGS(sv));
1804 Perl_dump_indent(aTHX_ level, file, " RARE = %u\n", (U8)BmRARE(sv));
1ca32a20 1805 Perl_dump_indent(aTHX_ level, file, " PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
1806 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
eff3c707 1807 }
926fc7b6 1808 if (!isGV_with_GP(sv))
1809 break;
cea2e8a9 1810 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
57def98f 1811 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 1812 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
57def98f 1813 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c 1814 if (!GvGP(sv))
1815 break;
57def98f 1816 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
1817 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
1818 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
1819 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
1820 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
1821 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
1822 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
1823 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 1824 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 1825 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
e39917cc 1826 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
3967c732 1827 do_gv_dump (level, file, " EGV", GvEGV(sv));
1828 break;
1829 case SVt_PVIO:
57def98f 1830 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
1831 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
1832 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
1833 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
1834 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
1835 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
1836 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 1837 if (IoTOP_NAME(sv))
cea2e8a9 1838 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565 1839 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
1840 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
1841 else {
1842 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
1843 PTR2UV(IoTOP_GV(sv)));
1844 do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest,
1845 dumpops, pvlim);
1846 }
1847 /* Source filters hide things that are not GVs in these three, so let's
1848 be careful out there. */
27533608 1849 if (IoFMT_NAME(sv))
cea2e8a9 1850 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565 1851 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
1852 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
1853 else {
1854 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
1855 PTR2UV(IoFMT_GV(sv)));
1856 do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest,
1857 dumpops, pvlim);
1858 }
27533608 1859 if (IoBOTTOM_NAME(sv))
cea2e8a9 1860 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565 1861 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
1862 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
1863 else {
1864 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
1865 PTR2UV(IoBOTTOM_GV(sv)));
1866 do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
1867 dumpops, pvlim);
1868 }
57def98f 1869 Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
27533608 1870 if (isPRINT(IoTYPE(sv)))
cea2e8a9 1871 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 1872 else
cea2e8a9 1873 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 1874 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732 1875 break;
1876 }
cea89e20 1877 SvREFCNT_dec(d);
3967c732 1878}
1879
1880void
864dbfa3 1881Perl_sv_dump(pTHX_ SV *sv)
3967c732 1882{
97aff369 1883 dVAR;
3967c732 1884 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 1885}
bd16a5f0 1886
1887int
1888Perl_runops_debug(pTHX)
1889{
97aff369 1890 dVAR;
bd16a5f0 1891 if (!PL_op) {
1892 if (ckWARN_d(WARN_DEBUGGING))
9014280d 1893 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0 1894 return 0;
1895 }
1896
9f3673fb 1897 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 1898 do {
1899 PERL_ASYNC_CHECK();
1900 if (PL_debug) {
b9ac451d 1901 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0 1902 PerlIO_printf(Perl_debug_log,
1903 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
1904 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
1905 PTR2UV(*PL_watchaddr));
d6721266 1906 if (DEBUG_s_TEST_) {
1907 if (DEBUG_v_TEST_) {
1908 PerlIO_printf(Perl_debug_log, "\n");
1909 deb_stack_all();
1910 }
1911 else
1912 debstack();
1913 }
1914
1915
bd16a5f0 1916 if (DEBUG_t_TEST_) debop(PL_op);
1917 if (DEBUG_P_TEST_) debprof(PL_op);
1918 }
1919 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
9f3673fb 1920 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
bd16a5f0 1921
1922 TAINT_NOT;
1923 return 0;
1924}
1925
1926I32
6867be6d 1927Perl_debop(pTHX_ const OP *o)
bd16a5f0 1928{
97aff369 1929 dVAR;
1045810a 1930 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
1931 return 0;
1932
bd16a5f0 1933 Perl_deb(aTHX_ "%s", OP_NAME(o));
1934 switch (o->op_type) {
1935 case OP_CONST:
1936 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
1937 break;
1938 case OP_GVSV:
1939 case OP_GV:
1940 if (cGVOPo_gv) {
b9ac451d 1941 SV * const sv = newSV(0);
3b721df9 1942#ifdef PERL_MAD
84021b46 1943 /* FIXME - is this making unwarranted assumptions about the
3b721df9 1944 UTF-8 cleanliness of the dump file handle? */
1945 SvUTF8_on(sv);
1946#endif
bd61b366 1947 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 1948 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
bd16a5f0 1949 SvREFCNT_dec(sv);
1950 }
1951 else
1952 PerlIO_printf(Perl_debug_log, "(NULL)");
1953 break;
1954 case OP_PADSV:
1955 case OP_PADAV:
1956 case OP_PADHV:
a3b680e6 1957 {
bd16a5f0 1958 /* print the lexical's name */
b9ac451d 1959 CV * const cv = deb_curcv(cxstack_ix);
a3b680e6 1960 SV *sv;
bd16a5f0 1961 if (cv) {
b9ac451d 1962 AV * const padlist = CvPADLIST(cv);
b464bac0 1963 AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
bd16a5f0 1964 sv = *av_fetch(comppad, o->op_targ, FALSE);
1965 } else
a0714e2c 1966 sv = NULL;
bd16a5f0 1967 if (sv)
b9ac451d 1968 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
bd16a5f0 1969 else
b9ac451d 1970 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
a3b680e6 1971 }
bd16a5f0 1972 break;
1973 default:
091ab601 1974 break;
bd16a5f0 1975 }
1976 PerlIO_printf(Perl_debug_log, "\n");
1977 return 0;
1978}
1979
1980STATIC CV*
61f9802b 1981S_deb_curcv(pTHX_ const I32 ix)
bd16a5f0 1982{
97aff369 1983 dVAR;
b9ac451d 1984 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0 1985 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
1986 return cx->blk_sub.cv;
1987 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
1988 return PL_compcv;
1989 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
1990 return PL_main_cv;
1991 else if (ix <= 0)
601f1833 1992 return NULL;
bd16a5f0 1993 else
1994 return deb_curcv(ix - 1);
1995}
1996
1997void
1998Perl_watch(pTHX_ char **addr)
1999{
97aff369 2000 dVAR;
bd16a5f0 2001 PL_watchaddr = addr;
2002 PL_watchok = *addr;
2003 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2004 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2005}
2006
2007STATIC void
e1ec3a88 2008S_debprof(pTHX_ const OP *o)
bd16a5f0 2009{
97aff369 2010 dVAR;
61f9802b 2011 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2012 return;
bd16a5f0 2013 if (!PL_profiledata)
a02a5408 2014 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0 2015 ++PL_profiledata[o->op_type];
2016}
2017
2018void
2019Perl_debprofdump(pTHX)
2020{
97aff369 2021 dVAR;
bd16a5f0 2022 unsigned i;
2023 if (!PL_profiledata)
2024 return;
2025 for (i = 0; i < MAXO; i++) {
2026 if (PL_profiledata[i])
2027 PerlIO_printf(Perl_debug_log,
2028 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2029 PL_op_name[i]);
2030 }
2031}
66610fdd 2032
3b721df9 2033#ifdef PERL_MAD
2034/*
2035 * XML variants of most of the above routines
2036 */
2037
4136a0f7 2038STATIC void
3b721df9 2039S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2040{
2041 va_list args;
2042 PerlIO_printf(file, "\n ");
2043 va_start(args, pat);
2044 xmldump_vindent(level, file, pat, &args);
2045 va_end(args);
2046}
2047
2048
2049void
2050Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
2051{
2052 va_list args;
2053 va_start(args, pat);
2054 xmldump_vindent(level, file, pat, &args);
2055 va_end(args);
2056}
2057
2058void
2059Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
2060{
2061 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
2062 PerlIO_vprintf(file, pat, *args);
2063}
2064
2065void
2066Perl_xmldump_all(pTHX)
2067{
2068 PerlIO_setlinebuf(PL_xmlfp);
2069 if (PL_main_root)
2070 op_xmldump(PL_main_root);
2071 if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
2072 PerlIO_close(PL_xmlfp);
2073 PL_xmlfp = 0;
2074}
2075
2076void
2077Perl_xmldump_packsubs(pTHX_ const HV *stash)
2078{
2079 I32 i;
2080 HE *entry;
2081
2082 if (!HvARRAY(stash))
2083 return;
2084 for (i = 0; i <= (I32) HvMAX(stash); i++) {
2085 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
2086 GV *gv = (GV*)HeVAL(entry);
2087 HV *hv;
2088 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
2089 continue;
2090 if (GvCVu(gv))
2091 xmldump_sub(gv);
2092 if (GvFORM(gv))
2093 xmldump_form(gv);
2094 if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
2095 && (hv = GvHV(gv)) && hv != PL_defstash)
2096 xmldump_packsubs(hv); /* nested package */
2097 }
2098 }
2099}
2100
2101void
2102Perl_xmldump_sub(pTHX_ const GV *gv)
2103{
61f9802b 2104 SV * const sv = sv_newmortal();
3b721df9 2105
2106 gv_fullname3(sv, gv, Nullch);
2107 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
2108 if (CvXSUB(GvCV(gv)))
2109 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
2110 PTR2UV(CvXSUB(GvCV(gv))),
2111 (int)CvXSUBANY(GvCV(gv)).any_i32);
2112 else if (CvROOT(GvCV(gv)))
2113 op_xmldump(CvROOT(GvCV(gv)));
2114 else
2115 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2116}
2117
2118void
2119Perl_xmldump_form(pTHX_ const GV *gv)
2120{
61f9802b 2121 SV * const sv = sv_newmortal();
3b721df9 2122
2123 gv_fullname3(sv, gv, Nullch);
2124 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
2125 if (CvROOT(GvFORM(gv)))
2126 op_xmldump(CvROOT(GvFORM(gv)));
2127 else
2128 Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "<undef>\n");
2129}
2130
2131void
2132Perl_xmldump_eval(pTHX)
2133{
2134 op_xmldump(PL_eval_root);
2135}
2136
2137char *
2138Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
2139{
2140 return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
2141}
2142
2143char *
20f84293 2144Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
3b721df9 2145{
2146 unsigned int c;
61f9802b 2147 const char * const e = pv + len;
20f84293 2148 const char * const start = pv;
3b721df9 2149 STRLEN dsvcur;
2150 STRLEN cl;
2151
2152 sv_catpvn(dsv,"",0);
2153 dsvcur = SvCUR(dsv); /* in case we have to restart */
2154
2155 retry:
2156 while (pv < e) {
2157 if (utf8) {
2158 c = utf8_to_uvchr((U8*)pv, &cl);
2159 if (cl == 0) {
2160 SvCUR(dsv) = dsvcur;
2161 pv = start;
2162 utf8 = 0;
2163 goto retry;
2164 }
2165 }
2166 else
2167 c = (*pv & 255);
2168
2169 switch (c) {
2170 case 0x00:
2171 case 0x01:
2172 case 0x02:
2173 case 0x03:
2174 case 0x04:
2175 case 0x05:
2176 case 0x06:
2177 case 0x07:
2178 case 0x08:
2179 case 0x0b:
2180 case 0x0c:
2181 case 0x0e:
2182 case 0x0f:
2183 case 0x10:
2184 case 0x11:
2185 case 0x12:
2186 case 0x13:
2187 case 0x14:
2188 case 0x15:
2189 case 0x16:
2190 case 0x17:
2191 case 0x18:
2192 case 0x19:
2193 case 0x1a:
2194 case 0x1b:
2195 case 0x1c:
2196 case 0x1d:
2197 case 0x1e:
2198 case 0x1f:
2199 case 0x7f:
2200 case 0x80:
2201 case 0x81:
2202 case 0x82:
2203 case 0x83:
2204 case 0x84:
2205 case 0x86:
2206 case 0x87:
2207 case 0x88:
2208 case 0x89:
2209 case 0x90:
2210 case 0x91:
2211 case 0x92:
2212 case 0x93:
2213 case 0x94:
2214 case 0x95:
2215 case 0x96:
2216 case 0x97:
2217 case 0x98:
2218 case 0x99:
2219 case 0x9a:
2220 case 0x9b:
2221 case 0x9c:
2222 case 0x9d:
2223 case 0x9e:
2224 case 0x9f:
2225 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2226 break;
2227 case '<':
2228 Perl_sv_catpvf(aTHX_ dsv, "&lt;");
2229 break;
2230 case '>':
2231 Perl_sv_catpvf(aTHX_ dsv, "&gt;");
2232 break;
2233 case '&':
2234 Perl_sv_catpvf(aTHX_ dsv, "&amp;");
2235 break;
2236 case '"':
2237 Perl_sv_catpvf(aTHX_ dsv, "&#34;");
2238 break;
2239 default:
2240 if (c < 0xD800) {
2241 if (c < 32 || c > 127) {
2242 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2243 }
2244 else {
2245 Perl_sv_catpvf(aTHX_ dsv, "%c", c);
2246 }
2247 break;
2248 }
2249 if ((c >= 0xD800 && c <= 0xDB7F) ||
2250 (c >= 0xDC00 && c <= 0xDFFF) ||
2251 (c >= 0xFFF0 && c <= 0xFFFF) ||
2252 c > 0x10ffff)
2253 Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
2254 else
2255 Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
2256 }
2257
2258 if (utf8)
2259 pv += UTF8SKIP(pv);
2260 else
2261 pv++;
2262 }
2263
2264 return SvPVX(dsv);
2265}
2266
2267char *
2268Perl_sv_xmlpeek(pTHX_ SV *sv)
2269{
61f9802b 2270 SV * const t = sv_newmortal();
3b721df9 2271 STRLEN n_a;
2272 int unref = 0;
2273
2274 sv_utf8_upgrade(t);
2275 sv_setpvn(t, "", 0);
2276 /* retry: */
2277 if (!sv) {
2278 sv_catpv(t, "VOID=\"\"");
2279 goto finish;
2280 }
2281 else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
2282 sv_catpv(t, "WILD=\"\"");
2283 goto finish;
2284 }
2285 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
2286 if (sv == &PL_sv_undef) {
2287 sv_catpv(t, "SV_UNDEF=\"1\"");
2288 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2289 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2290 SvREADONLY(sv))
2291 goto finish;
2292 }
2293 else if (sv == &PL_sv_no) {
2294 sv_catpv(t, "SV_NO=\"1\"");
2295 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2296 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2297 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2298 SVp_POK|SVp_NOK)) &&
2299 SvCUR(sv) == 0 &&
2300 SvNVX(sv) == 0.0)
2301 goto finish;
2302 }
2303 else if (sv == &PL_sv_yes) {
2304 sv_catpv(t, "SV_YES=\"1\"");
2305 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
2306 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2307 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
2308 SVp_POK|SVp_NOK)) &&
2309 SvCUR(sv) == 1 &&
2310 SvPVX(sv) && *SvPVX(sv) == '1' &&
2311 SvNVX(sv) == 1.0)
2312 goto finish;
2313 }
2314 else {
2315 sv_catpv(t, "SV_PLACEHOLDER=\"1\"");
2316 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
2317 SVs_GMG|SVs_SMG|SVs_RMG)) &&
2318 SvREADONLY(sv))
2319 goto finish;
2320 }
2321 sv_catpv(t, " XXX=\"\" ");
2322 }
2323 else if (SvREFCNT(sv) == 0) {
2324 sv_catpv(t, " refcnt=\"0\"");
2325 unref++;
2326 }
2327 else if (DEBUG_R_TEST_) {
2328 int is_tmp = 0;
2329 I32 ix;
2330 /* is this SV on the tmps stack? */
2331 for (ix=PL_tmps_ix; ix>=0; ix--) {
2332 if (PL_tmps_stack[ix] == sv) {
2333 is_tmp = 1;
2334 break;
2335 }
2336 }
2337 if (SvREFCNT(sv) > 1)
2338 Perl_sv_catpvf(aTHX_ t, " DRT=\"<%"UVuf"%s>\"", (UV)SvREFCNT(sv),
2339 is_tmp ? "T" : "");
2340 else if (is_tmp)
2341 sv_catpv(t, " DRT=\"<T>\"");
2342 }
2343
2344 if (SvROK(sv)) {
2345 sv_catpv(t, " ROK=\"\"");
2346 }
2347 switch (SvTYPE(sv)) {
2348 default:
2349 sv_catpv(t, " FREED=\"1\"");
2350 goto finish;
2351
2352 case SVt_NULL:
2353 sv_catpv(t, " UNDEF=\"1\"");
2354 goto finish;
2355 case SVt_IV:
2356 sv_catpv(t, " IV=\"");
2357 break;
2358 case SVt_NV:
2359 sv_catpv(t, " NV=\"");
2360 break;
2361 case SVt_RV:
2362 sv_catpv(t, " RV=\"");
2363 break;
2364 case SVt_PV:
2365 sv_catpv(t, " PV=\"");
2366 break;
2367 case SVt_PVIV:
2368 sv_catpv(t, " PVIV=\"");
2369 break;
2370 case SVt_PVNV:
2371 sv_catpv(t, " PVNV=\"");
2372 break;
2373 case SVt_PVMG:
2374 sv_catpv(t, " PVMG=\"");
2375 break;
2376 case SVt_PVLV:
2377 sv_catpv(t, " PVLV=\"");
2378 break;
2379 case SVt_PVAV:
2380 sv_catpv(t, " AV=\"");
2381 break;
2382 case SVt_PVHV:
2383 sv_catpv(t, " HV=\"");
2384 break;
2385 case SVt_PVCV:
2386 if (CvGV(sv))
2387 Perl_sv_catpvf(aTHX_ t, " CV=\"(%s)\"", GvNAME(CvGV(sv)));
2388 else
2389 sv_catpv(t, " CV=\"()\"");
2390 goto finish;
2391 case SVt_PVGV:
2392 sv_catpv(t, " GV=\"");
2393 break;
cecf5685 2394 case SVt_BIND:
2395 sv_catpv(t, " BIND=\"");
3b721df9 2396 break;
2397 case SVt_PVFM:
2398 sv_catpv(t, " FM=\"");
2399 break;
2400 case SVt_PVIO:
2401 sv_catpv(t, " IO=\"");
2402 break;
2403 }
2404
2405 if (SvPOKp(sv)) {
2406 if (SvPVX(sv)) {
2407 sv_catxmlsv(t, sv);
2408 }
2409 }
2410 else if (SvNOKp(sv)) {
2411 STORE_NUMERIC_LOCAL_SET_STANDARD();
2412 Perl_sv_catpvf(aTHX_ t, "%"NVgf"",SvNVX(sv));
2413 RESTORE_NUMERIC_LOCAL();
2414 }
2415 else if (SvIOKp(sv)) {
2416 if (SvIsUV(sv))
2417 Perl_sv_catpvf(aTHX_ t, "%"UVuf"", (UV)SvUVX(sv));
2418 else
2419 Perl_sv_catpvf(aTHX_ t, "%"IVdf"", (IV)SvIVX(sv));
2420 }
2421 else
2422 sv_catpv(t, "");
2423 sv_catpv(t, "\"");
2424
2425 finish:
61f9802b 2426 while (unref--)
2427 sv_catpv(t, ")");
3b721df9 2428 return SvPV(t, n_a);
2429}
2430
2431void
2432Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
2433{
2434 if (!pm) {
2435 Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
2436 return;
2437 }
2438 Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
2439 level++;
2440 if (PM_GETRE(pm)) {
61f9802b 2441 const char * const s = PM_GETRE(pm)->precomp;
2442 SV * const tmpsv = newSVpvn("",0);
3b721df9 2443 SvUTF8_on(tmpsv);
2444 sv_catxmlpvn(tmpsv, s, strlen(s), 1);
2445 Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
2446 SvPVX(tmpsv));
2447 SvREFCNT_dec(tmpsv);
2448 Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
2449 (pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
2450 }
2451 else
2452 Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
2453 if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
3df43ef7 2454 SV * const tmpsv = pm_description(pm);
3b721df9 2455 Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2456 SvREFCNT_dec(tmpsv);
2457 }
2458
2459 level--;
20e98b0f 2460 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
3b721df9 2461 Perl_xmldump_indent(aTHX_ level, file, ">\n");
2462 Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
20e98b0f 2463 do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
3b721df9 2464 Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
2465 Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
2466 }
2467 else
2468 Perl_xmldump_indent(aTHX_ level, file, "/>\n");
2469}
2470
2471void
2472Perl_pmop_xmldump(pTHX_ const PMOP *pm)
2473{
2474 do_pmop_xmldump(0, PL_xmlfp, pm);
2475}
2476
2477void
2478Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
2479{
2480 UV seq;
2481 int contents = 0;
2482 if (!o)
2483 return;
2484 sequence(o);
2485 seq = sequence_num(o);
2486 Perl_xmldump_indent(aTHX_ level, file,
2487 "<op_%s seq=\"%"UVuf" -> ",
2488 OP_NAME(o),
2489 seq);
2490 level++;
2491 if (o->op_next)
2492 PerlIO_printf(file, seq ? "%"UVuf"\"" : "(%"UVuf")\"",
2493 sequence_num(o->op_next));
2494 else
2495 PerlIO_printf(file, "DONE\"");
2496
2497 if (o->op_targ) {
2498 if (o->op_type == OP_NULL)
2499 {
2500 PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
2501 if (o->op_targ == OP_NEXTSTATE)
2502 {
2503 if (CopLINE(cCOPo))
f5992bc4 2504 PerlIO_printf(file, " line=\"%"UVuf"\"",
3b721df9 2505 (UV)CopLINE(cCOPo));
2506 if (CopSTASHPV(cCOPo))
2507 PerlIO_printf(file, " package=\"%s\"",
2508 CopSTASHPV(cCOPo));
2509 if (cCOPo->cop_label)
2510 PerlIO_printf(file, " label=\"%s\"",
2511 cCOPo->cop_label);
2512 }
2513 }
2514 else
2515 PerlIO_printf(file, " targ=\"%ld\"", (long)o->op_targ);
2516 }
2517#ifdef DUMPADDR
2518 PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
2519#endif
2520 if (o->op_flags) {
61f9802b 2521 SV * const tmpsv = newSVpvn("", 0);
3b721df9 2522 switch (o->op_flags & OPf_WANT) {
2523 case OPf_WANT_VOID:
2524 sv_catpv(tmpsv, ",VOID");
2525 break;
2526 case OPf_WANT_SCALAR:
2527 sv_catpv(tmpsv, ",SCALAR");
2528 break;
2529 case OPf_WANT_LIST:
2530 sv_catpv(tmpsv, ",LIST");
2531 break;
2532 default:
2533 sv_catpv(tmpsv, ",UNKNOWN");
2534 break;
2535 }
2536 if (o->op_flags & OPf_KIDS)
2537 sv_catpv(tmpsv, ",KIDS");
2538 if (o->op_flags & OPf_PARENS)
2539 sv_catpv(tmpsv, ",PARENS");
2540 if (o->op_flags & OPf_STACKED)
2541 sv_catpv(tmpsv, ",STACKED");
2542 if (o->op_flags & OPf_REF)
2543 sv_catpv(tmpsv, ",REF");
2544 if (o->op_flags & OPf_MOD)
2545 sv_catpv(tmpsv, ",MOD");
2546 if (o->op_flags & OPf_SPECIAL)
2547 sv_catpv(tmpsv, ",SPECIAL");
2548 PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
2549 SvREFCNT_dec(tmpsv);
2550 }
2551 if (o->op_private) {
61f9802b 2552 SV * const tmpsv = newSVpvn("", 0);
3b721df9 2553 if (PL_opargs[o->op_type] & OA_TARGLEX) {
2554 if (o->op_private & OPpTARGET_MY)
2555 sv_catpv(tmpsv, ",TARGET_MY");
2556 }
2557 else if (o->op_type == OP_LEAVESUB ||
2558 o->op_type == OP_LEAVE ||
2559 o->op_type == OP_LEAVESUBLV ||
2560 o->op_type == OP_LEAVEWRITE) {
2561 if (o->op_private & OPpREFCOUNTED)
2562 sv_catpv(tmpsv, ",REFCOUNTED");
2563 }
2564 else if (o->op_type == OP_AASSIGN) {
2565 if (o->op_private & OPpASSIGN_COMMON)
2566 sv_catpv(tmpsv, ",COMMON");
2567 }
2568 else if (o->op_type == OP_SASSIGN) {
2569 if (o->op_private & OPpASSIGN_BACKWARDS)
2570 sv_catpv(tmpsv, ",BACKWARDS");
2571 }
2572 else if (o->op_type == OP_TRANS) {
2573 if (o->op_private & OPpTRANS_SQUASH)
2574 sv_catpv(tmpsv, ",SQUASH");
2575 if (o->op_private & OPpTRANS_DELETE)
2576 sv_catpv(tmpsv, ",DELETE");
2577 if (o->op_private & OPpTRANS_COMPLEMENT)
2578 sv_catpv(tmpsv, ",COMPLEMENT");
2579 if (o->op_private & OPpTRANS_IDENTICAL)
2580 sv_catpv(tmpsv, ",IDENTICAL");
2581 if (o->op_private & OPpTRANS_GROWS)
2582 sv_catpv(tmpsv, ",GROWS");
2583 }
2584 else if (o->op_type == OP_REPEAT) {
2585 if (o->op_private & OPpREPEAT_DOLIST)
2586 sv_catpv(tmpsv, ",DOLIST");
2587 }
2588 else if (o->op_type == OP_ENTERSUB ||
2589 o->op_type == OP_RV2SV ||
2590 o->op_type == OP_GVSV ||
2591 o->op_type == OP_RV2AV ||
2592 o->op_type == OP_RV2HV ||
2593 o->op_type == OP_RV2GV ||
2594 o->op_type == OP_AELEM ||
2595 o->op_type == OP_HELEM )
2596 {
2597 if (o->op_type == OP_ENTERSUB) {
2598 if (o->op_private & OPpENTERSUB_AMPER)
2599 sv_catpv(tmpsv, ",AMPER");
2600 if (o->op_private & OPpENTERSUB_DB)
2601 sv_catpv(tmpsv, ",DB");
2602 if (o->op_private & OPpENTERSUB_HASTARG)
2603 sv_catpv(tmpsv, ",HASTARG");
2604 if (o->op_private & OPpENTERSUB_NOPAREN)
2605 sv_catpv(tmpsv, ",NOPAREN");
2606 if (o->op_private & OPpENTERSUB_INARGS)
2607 sv_catpv(tmpsv, ",INARGS");
2608 if (o->op_private & OPpENTERSUB_NOMOD)
2609 sv_catpv(tmpsv, ",NOMOD");
2610 }
2611 else {
2612 switch (o->op_private & OPpDEREF) {
2613 case OPpDEREF_SV:
2614 sv_catpv(tmpsv, ",SV");
2615 break;
2616 case OPpDEREF_AV:
2617 sv_catpv(tmpsv, ",AV");
2618 break;
2619 case OPpDEREF_HV:
2620 sv_catpv(tmpsv, ",HV");
2621 break;
2622 }
2623 if (o->op_private & OPpMAYBE_LVSUB)
2624 sv_catpv(tmpsv, ",MAYBE_LVSUB");
2625 }
2626 if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
2627 if (o->op_private & OPpLVAL_DEFER)
2628 sv_catpv(tmpsv, ",LVAL_DEFER");
2629 }
2630 else {
2631 if (o->op_private & HINT_STRICT_REFS)
2632 sv_catpv(tmpsv, ",STRICT_REFS");
2633 if (o->op_private & OPpOUR_INTRO)
2634 sv_catpv(tmpsv, ",OUR_INTRO");
2635 }
2636 }
2637 else if (o->op_type == OP_CONST) {
2638 if (o->op_private & OPpCONST_BARE)
2639 sv_catpv(tmpsv, ",BARE");
2640 if (o->op_private & OPpCONST_STRICT)
2641 sv_catpv(tmpsv, ",STRICT");
2642 if (o->op_private & OPpCONST_ARYBASE)
2643 sv_catpv(tmpsv, ",ARYBASE");
2644 if (o->op_private & OPpCONST_WARNING)
2645 sv_catpv(tmpsv, ",WARNING");
2646 if (o->op_private & OPpCONST_ENTERED)
2647 sv_catpv(tmpsv, ",ENTERED");
2648 }
2649 else if (o->op_type == OP_FLIP) {
2650 if (o->op_private & OPpFLIP_LINENUM)
2651 sv_catpv(tmpsv, ",LINENUM");
2652 }
2653 else if (o->op_type == OP_FLOP) {
2654 if (o->op_private & OPpFLIP_LINENUM)
2655 sv_catpv(tmpsv, ",LINENUM");
2656 }
2657 else if (o->op_type == OP_RV2CV) {
2658 if (o->op_private & OPpLVAL_INTRO)
2659 sv_catpv(tmpsv, ",INTRO");
2660 }
2661 else if (o->op_type == OP_GV) {
2662 if (o->op_private & OPpEARLY_CV)
2663 sv_catpv(tmpsv, ",EARLY_CV");
2664 }
2665 else if (o->op_type == OP_LIST) {
2666 if (o->op_private & OPpLIST_GUESSED)
2667 sv_catpv(tmpsv, ",GUESSED");
2668 }
2669 else if (o->op_type == OP_DELETE) {
2670 if (o->op_private & OPpSLICE)
2671 sv_catpv(tmpsv, ",SLICE");
2672 }
2673 else if (o->op_type == OP_EXISTS) {
2674 if (o->op_private & OPpEXISTS_SUB)
2675 sv_catpv(tmpsv, ",EXISTS_SUB");
2676 }
2677 else if (o->op_type == OP_SORT) {
2678 if (o->op_private & OPpSORT_NUMERIC)
2679 sv_catpv(tmpsv, ",NUMERIC");
2680 if (o->op_private & OPpSORT_INTEGER)
2681 sv_catpv(tmpsv, ",INTEGER");
2682 if (o->op_private & OPpSORT_REVERSE)
2683 sv_catpv(tmpsv, ",REVERSE");
2684 }
3b721df9 2685 else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
2686 if (o->op_private & OPpOPEN_IN_RAW)
2687 sv_catpv(tmpsv, ",IN_RAW");
2688 if (o->op_private & OPpOPEN_IN_CRLF)
2689 sv_catpv(tmpsv, ",IN_CRLF");
2690 if (o->op_private & OPpOPEN_OUT_RAW)
2691 sv_catpv(tmpsv, ",OUT_RAW");
2692 if (o->op_private & OPpOPEN_OUT_CRLF)
2693 sv_catpv(tmpsv, ",OUT_CRLF");
2694 }
2695 else if (o->op_type == OP_EXIT) {
2696 if (o->op_private & OPpEXIT_VMSISH)
2697 sv_catpv(tmpsv, ",EXIT_VMSISH");
2698 if (o->op_private & OPpHUSH_VMSISH)
2699 sv_catpv(tmpsv, ",HUSH_VMSISH");
2700 }
2701 else if (o->op_type == OP_DIE) {
2702 if (o->op_private & OPpHUSH_VMSISH)
2703 sv_catpv(tmpsv, ",HUSH_VMSISH");
2704 }
2705 else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
2706 if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
2707 sv_catpv(tmpsv, ",FT_ACCESS");
2708 if (o->op_private & OPpFT_STACKED)
2709 sv_catpv(tmpsv, ",FT_STACKED");
2710 }
2711 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
2712 sv_catpv(tmpsv, ",INTRO");
2713 if (SvCUR(tmpsv))
2714 S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
2715 SvREFCNT_dec(tmpsv);
2716 }
2717
2718 switch (o->op_type) {
2719 case OP_AELEMFAST:
2720 if (o->op_flags & OPf_SPECIAL) {
2721 break;
2722 }
2723 case OP_GVSV:
2724 case OP_GV:
2725#ifdef USE_ITHREADS
2726 S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
2727#else
2728 if (cSVOPo->op_sv) {
61f9802b 2729 SV * const tmpsv1 = newSV(0);
2730 SV * const tmpsv2 = newSVpvn("",0);
3b721df9 2731 char *s;
2732 STRLEN len;
b123ab9d 2733 SvUTF8_on(tmpsv1);
2734 SvUTF8_on(tmpsv2);
3b721df9 2735 ENTER;
2736 SAVEFREESV(tmpsv1);
2737 SAVEFREESV(tmpsv2);
2738 gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, Nullch);
2739 s = SvPV(tmpsv1,len);
2740 sv_catxmlpvn(tmpsv2, s, len, 1);
2741 S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
2742 LEAVE;
2743 }
2744 else
2745 S_xmldump_attr(aTHX_ level, file, "gv=\"NULL\"");
2746#endif
2747 break;
2748 case OP_CONST:
2749 case OP_METHOD_NAMED:
2750#ifndef USE_ITHREADS
2751 /* with ITHREADS, consts are stored in the pad, and the right pad
2752 * may not be active here, so skip */
2753 S_xmldump_attr(aTHX_ level, file, "%s", sv_xmlpeek(cSVOPo_sv));
2754#endif
2755 break;
2756 case OP_ANONCODE:
2757 if (!contents) {
2758 contents = 1;
2759 PerlIO_printf(file, ">\n");
2760 }
2761 do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
2762 break;
2763 case OP_SETSTATE:
2764 case OP_NEXTSTATE:
2765 case OP_DBSTATE:
2766 if (CopLINE(cCOPo))
f5992bc4 2767 S_xmldump_attr(aTHX_ level, file, "line=\"%"UVuf"\"",
3b721df9 2768 (UV)CopLINE(cCOPo));
2769 if (CopSTASHPV(cCOPo))
2770 S_xmldump_attr(aTHX_ level, file, "package=\"%s\"",
2771 CopSTASHPV(cCOPo));
2772 if (cCOPo->cop_label)
2773 S_xmldump_attr(aTHX_ level, file, "label=\"%s\"",
2774 cCOPo->cop_label);
2775 break;
2776 case OP_ENTERLOOP:
2777 S_xmldump_attr(aTHX_ level, file, "redo=\"");
2778 if (cLOOPo->op_redoop)
2779 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_redoop));
2780 else
2781 PerlIO_printf(file, "DONE\"");
2782 S_xmldump_attr(aTHX_ level, file, "next=\"");
2783 if (cLOOPo->op_nextop)
2784 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_nextop));
2785 else
2786 PerlIO_printf(file, "DONE\"");
2787 S_xmldump_attr(aTHX_ level, file, "last=\"");
2788 if (cLOOPo->op_lastop)
2789 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOOPo->op_lastop));
2790 else
2791 PerlIO_printf(file, "DONE\"");
2792 break;
2793 case OP_COND_EXPR:
2794 case OP_RANGE:
2795 case OP_MAPWHILE:
2796 case OP_GREPWHILE:
2797 case OP_OR:
2798 case OP_AND:
2799 S_xmldump_attr(aTHX_ level, file, "other=\"");
2800 if (cLOGOPo->op_other)
2801 PerlIO_printf(file, "%"UVuf"\"", sequence_num(cLOGOPo->op_other));
2802 else
2803 PerlIO_printf(file, "DONE\"");
2804 break;
2805 case OP_LEAVE:
2806 case OP_LEAVEEVAL:
2807 case OP_LEAVESUB:
2808 case OP_LEAVESUBLV:
2809 case OP_LEAVEWRITE:
2810 case OP_SCOPE:
2811 if (o->op_private & OPpREFCOUNTED)
2812 S_xmldump_attr(aTHX_ level, file, "refcnt=\"%"UVuf"\"", (UV)o->op_targ);
2813 break;
2814 default:
2815 break;
2816 }
2817
2818 if (PL_madskills && o->op_madprop) {
fb2b694a 2819 char prevkey = '\0';
61f9802b 2820 SV * const tmpsv = newSVpvn("", 0);
20f84293 2821 const MADPROP* mp = o->op_madprop;
61f9802b 2822
3b721df9 2823 sv_utf8_upgrade(tmpsv);
2824 if (!contents) {
2825 contents = 1;
2826 PerlIO_printf(file, ">\n");
2827 }
2828 Perl_xmldump_indent(aTHX_ level, file, "<madprops>\n");
2829 level++;
2830 while (mp) {
2831 char tmp = mp->mad_key;
2832 sv_setpvn(tmpsv,"\"",1);
2833 if (tmp)
2834 sv_catxmlpvn(tmpsv, &tmp, 1, 0);
fb2b694a 2835 if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
2836 sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
2837 else
2838 prevkey = tmp;
3b721df9 2839 sv_catpv(tmpsv, "\"");
2840 switch (mp->mad_type) {
2841 case MAD_NULL:
2842 sv_catpv(tmpsv, "NULL");
2843 Perl_xmldump_indent(aTHX_ level, file, "<mad_null key=%s/>\n", SvPVX(tmpsv));
2844 break;
2845 case MAD_PV:
2846 sv_catpv(tmpsv, " val=\"");
2847 sv_catxmlpvn(tmpsv, (char*)mp->mad_val, mp->mad_vlen,1);
2848 sv_catpv(tmpsv, "\"");
2849 Perl_xmldump_indent(aTHX_ level, file, "<mad_pv key=%s/>\n", SvPVX(tmpsv));
2850 break;
2851 case MAD_SV:
2852 sv_catpv(tmpsv, " val=\"");
2853 sv_catxmlsv(tmpsv, (SV*)mp->mad_val);
2854 sv_catpv(tmpsv, "\"");
2855 Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
2856 break;
2857 case MAD_OP:
2858 if ((OP*)mp->mad_val) {
2859 Perl_xmldump_indent(aTHX_ level, file, "<mad_op key=%s>\n", SvPVX(tmpsv));
2860 do_op_xmldump(level+1, file, (OP*)mp->mad_val);
2861 Perl_xmldump_indent(aTHX_ level, file, "</mad_op>\n");
2862 }
2863 break;
2864 default:
2865 Perl_xmldump_indent(aTHX_ level, file, "<mad_unk key=%s/>\n", SvPVX(tmpsv));
2866 break;
2867 }
2868 mp = mp->mad_next;
2869 }
2870 level--;
2871 Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
2872
2873 SvREFCNT_dec(tmpsv);
2874 }
2875
2876 switch (o->op_type) {
2877 case OP_PUSHRE:
2878 case OP_MATCH:
2879 case OP_QR:
2880 case OP_SUBST:
2881 if (!contents) {
2882 contents = 1;
2883 PerlIO_printf(file, ">\n");
2884 }
2885 do_pmop_xmldump(level, file, cPMOPo);
2886 break;
2887 default:
2888 break;
2889 }
2890
2891 if (o->op_flags & OPf_KIDS) {
2892 OP *kid;
2893 if (!contents) {
2894 contents = 1;
2895 PerlIO_printf(file, ">\n");
2896 }
2897 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
2898 do_op_xmldump(level, file, kid);
2899 }
2900
2901 if (contents)
2902 Perl_xmldump_indent(aTHX_ level-1, file, "</op_%s>\n", OP_NAME(o));
2903 else
2904 PerlIO_printf(file, " />\n");
2905}
2906
2907void
2908Perl_op_xmldump(pTHX_ const OP *o)
2909{
2910 do_op_xmldump(0, PL_xmlfp, o);
2911}
2912#endif
2913
66610fdd 2914/*
2915 * Local variables:
2916 * c-indentation-style: bsd
2917 * c-basic-offset: 4
2918 * indent-tabs-mode: t
2919 * End:
2920 *
37442d52 2921 * ex: set ts=8 sts=4 sw=4 noet:
2922 */
Unnamed repository; edit this file to name it for gitweb.