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