This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove GVf_IN_PAD
[perl5.git] / dump.c
CommitLineData
a0d0e21e 1/* dump.c
a687059c 2 *
1129b882
NC
3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
a687059c 5 *
6e21c824
LW
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8d063cd8 8 *
a0d0e21e
LW
9 */
10
11/*
4ac71550
TC
12 * 'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
13 * it has not been hard for me to read your mind and memory.'
14 *
15 * [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
8d063cd8
LW
16 */
17
166f8a29 18/* This file contains utility routines to dump the contents of SV and OP
61296642 19 * structures, as used by command-line options like -Dt and -Dx, and
166f8a29
DM
20 * by Devel::Peek.
21 *
22 * It also holds the debugging version of the runops function.
dcccc8ff
KW
23
24=head1 Display and Dump functions
166f8a29
DM
25 */
26
8d063cd8 27#include "EXTERN.h"
864dbfa3 28#define PERL_IN_DUMP_C
8d063cd8 29#include "perl.h"
f722798b 30#include "regcomp.h"
0bd48802 31
5357ca29
NC
32static const char* const svtypenames[SVt_LAST] = {
33 "NULL",
34 "IV",
b53eecb4 35 "NV",
5357ca29 36 "PV",
e94d9b54 37 "INVLIST",
5357ca29
NC
38 "PVIV",
39 "PVNV",
40 "PVMG",
5c35adbb 41 "REGEXP",
5357ca29
NC
42 "PVGV",
43 "PVLV",
44 "PVAV",
45 "PVHV",
46 "PVCV",
47 "PVFM",
48 "PVIO"
49};
50
51
52static const char* const svshorttypenames[SVt_LAST] = {
53 "UNDEF",
54 "IV",
b53eecb4 55 "NV",
5357ca29 56 "PV",
e94d9b54 57 "INVLST",
5357ca29
NC
58 "PVIV",
59 "PVNV",
60 "PVMG",
5c35adbb 61 "REGEXP",
5357ca29
NC
62 "GV",
63 "PVLV",
64 "AV",
65 "HV",
66 "CV",
67 "FM",
68 "IO"
69};
70
a0c2f4dd
NC
71struct flag_to_name {
72 U32 flag;
73 const char *name;
74};
75
76static void
77S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
78 const struct flag_to_name *const end)
79{
80 do {
81 if (flags & start->flag)
82 sv_catpv(sv, start->name);
83 } while (++start < end);
84}
85
86#define append_flags(sv, f, flags) \
cd431fde 87 S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
a0c2f4dd 88
0eb335df
BF
89#define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
90 (len) * (4+UTF8_MAXBYTES) + 1, NULL, \
91 PERL_PV_ESCAPE_NONASCII | PERL_PV_ESCAPE_DWIM \
92 | ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
93
3df15adc 94/*
87cea99e 95=for apidoc pv_escape
3df15adc
YO
96
97Escapes at most the first "count" chars of pv and puts the results into
ab3bbdeb 98dsv such that the size of the escaped string will not exceed "max" chars
3df15adc
YO
99and will not contain any incomplete escape sequences.
100
ab3bbdeb
YO
101If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
102will also be escaped.
3df15adc
YO
103
104Normally the SV will be cleared before the escaped string is prepared,
ab3bbdeb
YO
105but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
106
38a44b82 107If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
ab3bbdeb 108if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
38a44b82 109using C<is_utf8_string()> to determine if it is Unicode.
ab3bbdeb
YO
110
111If PERL_PV_ESCAPE_ALL is set then all input chars will be output
681f01c2 112using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
951cbe24 113non-ASCII chars will be escaped using this style; otherwise, only chars above
681f01c2 114255 will be so escaped; other non printable chars will use octal or
72d33970
FC
115common escaped patterns like C<\n>.
116Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
681f01c2 117then all chars below 255 will be treated as printable and
ab3bbdeb
YO
118will be output as literals.
119
120If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
72d33970 121string will be escaped, regardless of max. If the output is to be in hex,
c8536afa 122then it will be returned as a plain hex
72d33970 123sequence. Thus the output will either be a single char,
c8536afa 124an octal escape sequence, a special escape like C<\n> or a hex value.
3df15adc 125
44a2ac75 126If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
72d33970 127not a '\\'. This is because regexes very often contain backslashed
44a2ac75
YO
128sequences, whereas '%' is not a particularly common character in patterns.
129
ab3bbdeb 130Returns a pointer to the escaped text as held by dsv.
3df15adc
YO
131
132=cut
133*/
ab3bbdeb 134#define PV_ESCAPE_OCTBUFSIZE 32
ddc5bc0f 135
3967c732 136char *
ddc5bc0f 137Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
ab3bbdeb
YO
138 const STRLEN count, const STRLEN max,
139 STRLEN * const escaped, const U32 flags )
140{
61f9802b
AL
141 const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
142 const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
44a2ac75 143 char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
ab3bbdeb
YO
144 STRLEN wrote = 0; /* chars written so far */
145 STRLEN chsize = 0; /* size of data to be written */
146 STRLEN readsize = 1; /* size of data just read */
38a44b82 147 bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
ddc5bc0f 148 const char *pv = str;
61f9802b 149 const char * const end = pv + count; /* end of string */
44a2ac75 150 octbuf[0] = esc;
ab3bbdeb 151
7918f24d
NC
152 PERL_ARGS_ASSERT_PV_ESCAPE;
153
9ed8b5e5 154 if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
7fddd944 155 /* This won't alter the UTF-8 flag */
76f68e9b 156 sv_setpvs(dsv, "");
7fddd944 157 }
ab3bbdeb 158
ddc5bc0f 159 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
ab3bbdeb
YO
160 isuni = 1;
161
162 for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
4b88fb76 163 const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
ab3bbdeb
YO
164 const U8 c = (U8)u & 0xFF;
165
681f01c2
KW
166 if ( ( u > 255 )
167 || (flags & PERL_PV_ESCAPE_ALL)
0eb335df 168 || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM))))
681f01c2 169 {
ab3bbdeb
YO
170 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
171 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
172 "%"UVxf, u);
173 else
174 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
0eb335df
BF
175 ((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
176 ? "%cx%02"UVxf
177 : "%cx{%02"UVxf"}", esc, u);
178
ab3bbdeb
YO
179 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
180 chsize = 1;
181 } else {
44a2ac75
YO
182 if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
183 chsize = 2;
ab3bbdeb 184 switch (c) {
44a2ac75 185
924ba076 186 case '\\' : /* FALLTHROUGH */
44a2ac75
YO
187 case '%' : if ( c == esc ) {
188 octbuf[1] = esc;
189 } else {
190 chsize = 1;
191 }
192 break;
3df15adc
YO
193 case '\v' : octbuf[1] = 'v'; break;
194 case '\t' : octbuf[1] = 't'; break;
195 case '\r' : octbuf[1] = 'r'; break;
196 case '\n' : octbuf[1] = 'n'; break;
197 case '\f' : octbuf[1] = 'f'; break;
44a2ac75 198 case '"' :
ab3bbdeb 199 if ( dq == '"' )
3df15adc 200 octbuf[1] = '"';
ab3bbdeb
YO
201 else
202 chsize = 1;
44a2ac75 203 break;
3df15adc 204 default:
0eb335df
BF
205 if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
206 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
207 isuni ? "%cx{%02"UVxf"}" : "%cx%02"UVxf,
208 esc, u);
209 }
210 else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
ab3bbdeb 211 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75
YO
212 "%c%03o", esc, c);
213 else
ab3bbdeb 214 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 215 "%c%o", esc, c);
ab3bbdeb
YO
216 }
217 } else {
44a2ac75 218 chsize = 1;
ab3bbdeb 219 }
44a2ac75
YO
220 }
221 if ( max && (wrote + chsize > max) ) {
222 break;
ab3bbdeb 223 } else if (chsize > 1) {
44a2ac75
YO
224 sv_catpvn(dsv, octbuf, chsize);
225 wrote += chsize;
3df15adc 226 } else {
951cbe24
KW
227 /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
228 can be appended raw to the dsv. If dsv happens to be
7fddd944
NC
229 UTF-8 then we need catpvf to upgrade them for us.
230 Or add a new API call sv_catpvc(). Think about that name, and
231 how to keep it clear that it's unlike the s of catpvs, which is
951cbe24 232 really an array of octets, not a string. */
7fddd944 233 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
3df15adc
YO
234 wrote++;
235 }
ab3bbdeb
YO
236 if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
237 break;
3967c732 238 }
ab3bbdeb
YO
239 if (escaped != NULL)
240 *escaped= pv - str;
241 return SvPVX(dsv);
242}
243/*
87cea99e 244=for apidoc pv_pretty
ab3bbdeb
YO
245
246Converts a string into something presentable, handling escaping via
95b611b0 247pv_escape() and supporting quoting and ellipses.
ab3bbdeb
YO
248
249If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
72d33970 250double quoted with any double quotes in the string escaped. Otherwise
ab3bbdeb
YO
251if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
252angle brackets.
6cba11c8 253
95b611b0
RGS
254If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
255string were output then an ellipsis C<...> will be appended to the
72d33970 256string. Note that this happens AFTER it has been quoted.
6cba11c8 257
ab3bbdeb 258If start_color is non-null then it will be inserted after the opening
72d33970 259quote (if there is one) but before the escaped text. If end_color
ab3bbdeb 260is non-null then it will be inserted after the escaped text but before
95b611b0 261any quotes or ellipses.
ab3bbdeb
YO
262
263Returns a pointer to the prettified text as held by dsv.
6cba11c8 264
ab3bbdeb
YO
265=cut
266*/
267
268char *
ddc5bc0f
YO
269Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
270 const STRLEN max, char const * const start_color, char const * const end_color,
ab3bbdeb
YO
271 const U32 flags )
272{
61f9802b 273 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
ab3bbdeb 274 STRLEN escaped;
7918f24d
NC
275
276 PERL_ARGS_ASSERT_PV_PRETTY;
277
881a015e
NC
278 if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
279 /* This won't alter the UTF-8 flag */
76f68e9b 280 sv_setpvs(dsv, "");
881a015e
NC
281 }
282
ab3bbdeb 283 if ( dq == '"' )
76f68e9b 284 sv_catpvs(dsv, "\"");
ab3bbdeb 285 else if ( flags & PERL_PV_PRETTY_LTGT )
76f68e9b 286 sv_catpvs(dsv, "<");
ab3bbdeb
YO
287
288 if ( start_color != NULL )
76f68e9b 289 sv_catpv(dsv, start_color);
ab3bbdeb
YO
290
291 pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
292
293 if ( end_color != NULL )
76f68e9b 294 sv_catpv(dsv, end_color);
ab3bbdeb
YO
295
296 if ( dq == '"' )
76f68e9b 297 sv_catpvs( dsv, "\"");
ab3bbdeb 298 else if ( flags & PERL_PV_PRETTY_LTGT )
76f68e9b 299 sv_catpvs(dsv, ">");
ab3bbdeb 300
95b611b0 301 if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
76f68e9b 302 sv_catpvs(dsv, "...");
ab3bbdeb 303
3df15adc
YO
304 return SvPVX(dsv);
305}
306
307/*
308=for apidoc pv_display
309
3df15adc 310Similar to
3967c732 311
3df15adc
YO
312 pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
313
314except that an additional "\0" will be appended to the string when
315len > cur and pv[cur] is "\0".
316
317Note that the final string may be up to 7 chars longer than pvlim.
318
319=cut
320*/
321
322char *
323Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
324{
7918f24d
NC
325 PERL_ARGS_ASSERT_PV_DISPLAY;
326
ddc5bc0f 327 pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
3df15adc 328 if (len > cur && pv[cur] == '\0')
76f68e9b 329 sv_catpvs( dsv, "\\0");
e6abe6d8
JH
330 return SvPVX(dsv);
331}
332
333char *
864dbfa3 334Perl_sv_peek(pTHX_ SV *sv)
3967c732 335{
27da23d5 336 dVAR;
aec46f14 337 SV * const t = sv_newmortal();
3967c732 338 int unref = 0;
5357ca29 339 U32 type;
3967c732 340
76f68e9b 341 sv_setpvs(t, "");
3967c732
JD
342 retry:
343 if (!sv) {
344 sv_catpv(t, "VOID");
345 goto finish;
346 }
8ee91b45
YO
347 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
348 /* detect data corruption under memory poisoning */
3967c732
JD
349 sv_catpv(t, "WILD");
350 goto finish;
351 }
7996736c 352 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
3967c732
JD
353 if (sv == &PL_sv_undef) {
354 sv_catpv(t, "SV_UNDEF");
355 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
356 SVs_GMG|SVs_SMG|SVs_RMG)) &&
357 SvREADONLY(sv))
358 goto finish;
359 }
360 else if (sv == &PL_sv_no) {
361 sv_catpv(t, "SV_NO");
362 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
363 SVs_GMG|SVs_SMG|SVs_RMG)) &&
364 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
365 SVp_POK|SVp_NOK)) &&
366 SvCUR(sv) == 0 &&
659c4b96 367 SvNVX(sv) == 0.0)
3967c732
JD
368 goto finish;
369 }
7996736c 370 else if (sv == &PL_sv_yes) {
3967c732
JD
371 sv_catpv(t, "SV_YES");
372 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
373 SVs_GMG|SVs_SMG|SVs_RMG)) &&
374 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
375 SVp_POK|SVp_NOK)) &&
376 SvCUR(sv) == 1 &&
b15aece3 377 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
659c4b96 378 SvNVX(sv) == 1.0)
3967c732 379 goto finish;
7996736c
MHM
380 }
381 else {
382 sv_catpv(t, "SV_PLACEHOLDER");
383 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
384 SVs_GMG|SVs_SMG|SVs_RMG)) &&
385 SvREADONLY(sv))
386 goto finish;
3967c732
JD
387 }
388 sv_catpv(t, ":");
389 }
390 else if (SvREFCNT(sv) == 0) {
391 sv_catpv(t, "(");
392 unref++;
393 }
a3b4c9c6
DM
394 else if (DEBUG_R_TEST_) {
395 int is_tmp = 0;
e8eb279c 396 SSize_t ix;
a3b4c9c6
DM
397 /* is this SV on the tmps stack? */
398 for (ix=PL_tmps_ix; ix>=0; ix--) {
399 if (PL_tmps_stack[ix] == sv) {
400 is_tmp = 1;
401 break;
402 }
403 }
404 if (SvREFCNT(sv) > 1)
405 Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
406 is_tmp ? "T" : "");
407 else if (is_tmp)
408 sv_catpv(t, "<T>");
04932ac8
DM
409 }
410
3967c732
JD
411 if (SvROK(sv)) {
412 sv_catpv(t, "\\");
413 if (SvCUR(t) + unref > 10) {
b162af07 414 SvCUR_set(t, unref + 3);
3967c732
JD
415 *SvEND(t) = '\0';
416 sv_catpv(t, "...");
417 goto finish;
418 }
ad64d0ec 419 sv = SvRV(sv);
3967c732
JD
420 goto retry;
421 }
5357ca29
NC
422 type = SvTYPE(sv);
423 if (type == SVt_PVCV) {
0eb335df
BF
424 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
425 GV* gvcv = CvGV(sv);
c53e4eb5 426 Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
0eb335df
BF
427 ? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
428 : "");
3967c732 429 goto finish;
5357ca29
NC
430 } else if (type < SVt_LAST) {
431 sv_catpv(t, svshorttypenames[type]);
3967c732 432
5357ca29
NC
433 if (type == SVt_NULL)
434 goto finish;
435 } else {
436 sv_catpv(t, "FREED");
3967c732 437 goto finish;
3967c732
JD
438 }
439
440 if (SvPOKp(sv)) {
b15aece3 441 if (!SvPVX_const(sv))
3967c732
JD
442 sv_catpv(t, "(null)");
443 else {
17605be7 444 SV * const tmp = newSVpvs("");
3967c732 445 sv_catpv(t, "(");
5115136b
DM
446 if (SvOOK(sv)) {
447 STRLEN delta;
448 SvOOK_offset(sv, delta);
449 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
450 }
b15aece3 451 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
32639b87 452 if (SvUTF8(sv))
b2ff9928 453 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
e9569a7a 454 sv_uni_display(tmp, sv, 6 * SvCUR(sv),
c728cb41 455 UNI_DISPLAY_QQ));
17605be7 456 SvREFCNT_dec_NN(tmp);
3967c732
JD
457 }
458 }
459 else if (SvNOKp(sv)) {
e54dc35b 460 STORE_NUMERIC_LOCAL_SET_STANDARD();
1779d84d 461 Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
e54dc35b 462 RESTORE_NUMERIC_LOCAL();
3967c732 463 }
57def98f 464 else if (SvIOKp(sv)) {
cf2093f6 465 if (SvIsUV(sv))
57def98f 466 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
cf2093f6 467 else
57def98f 468 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
25da4f38 469 }
3967c732
JD
470 else
471 sv_catpv(t, "()");
2ef28da1 472
3967c732 473 finish:
61f9802b
AL
474 while (unref--)
475 sv_catpv(t, ")");
9adb2837 476 if (TAINTING_get && sv && SvTAINTED(sv))
59b714e2 477 sv_catpv(t, " [tainted]");
8b6b16e7 478 return SvPV_nolen(t);
3967c732
JD
479}
480
36b1c95c
MH
481/*
482=head1 Debugging Utilities
483*/
484
485void
486Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
487{
488 va_list args;
489 PERL_ARGS_ASSERT_DUMP_INDENT;
490 va_start(args, pat);
491 dump_vindent(level, file, pat, &args);
492 va_end(args);
493}
494
495void
496Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
497{
36b1c95c
MH
498 PERL_ARGS_ASSERT_DUMP_VINDENT;
499 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
500 PerlIO_vprintf(file, pat, *args);
501}
502
503/*
504=for apidoc dump_all
505
506Dumps the entire optree of the current program starting at C<PL_main_root> to
72d33970
FC
507C<STDERR>. Also dumps the optrees for all visible subroutines in
508C<PL_defstash>.
36b1c95c
MH
509
510=cut
511*/
512
513void
514Perl_dump_all(pTHX)
515{
516 dump_all_perl(FALSE);
517}
518
519void
520Perl_dump_all_perl(pTHX_ bool justperl)
521{
36b1c95c
MH
522 PerlIO_setlinebuf(Perl_debug_log);
523 if (PL_main_root)
524 op_dump(PL_main_root);
525 dump_packsubs_perl(PL_defstash, justperl);
526}
527
528/*
529=for apidoc dump_packsubs
530
531Dumps the optrees for all visible subroutines in C<stash>.
532
533=cut
534*/
535
536void
537Perl_dump_packsubs(pTHX_ const HV *stash)
538{
539 PERL_ARGS_ASSERT_DUMP_PACKSUBS;
540 dump_packsubs_perl(stash, FALSE);
541}
542
543void
544Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
545{
36b1c95c
MH
546 I32 i;
547
548 PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
549
550 if (!HvARRAY(stash))
551 return;
552 for (i = 0; i <= (I32) HvMAX(stash); i++) {
553 const HE *entry;
554 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
555 const GV * const gv = (const GV *)HeVAL(entry);
556 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
557 continue;
558 if (GvCVu(gv))
559 dump_sub_perl(gv, justperl);
560 if (GvFORM(gv))
561 dump_form(gv);
562 if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
563 const HV * const hv = GvHV(gv);
564 if (hv && (hv != PL_defstash))
565 dump_packsubs_perl(hv, justperl); /* nested package */
566 }
567 }
568 }
569}
570
571void
572Perl_dump_sub(pTHX_ const GV *gv)
573{
574 PERL_ARGS_ASSERT_DUMP_SUB;
575 dump_sub_perl(gv, FALSE);
576}
577
578void
579Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
580{
0eb335df
BF
581 STRLEN len;
582 SV * const sv = newSVpvs_flags("", SVs_TEMP);
583 SV *tmpsv;
584 const char * name;
36b1c95c
MH
585
586 PERL_ARGS_ASSERT_DUMP_SUB_PERL;
587
588 if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
589 return;
590
0eb335df 591 tmpsv = newSVpvs_flags("", SVs_TEMP);
36b1c95c 592 gv_fullname3(sv, gv, NULL);
0eb335df
BF
593 name = SvPV_const(sv, len);
594 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
595 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
36b1c95c
MH
596 if (CvISXSUB(GvCV(gv)))
597 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
598 PTR2UV(CvXSUB(GvCV(gv))),
599 (int)CvXSUBANY(GvCV(gv)).any_i32);
600 else if (CvROOT(GvCV(gv)))
601 op_dump(CvROOT(GvCV(gv)));
602 else
603 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
604}
605
606void
607Perl_dump_form(pTHX_ const GV *gv)
608{
609 SV * const sv = sv_newmortal();
610
611 PERL_ARGS_ASSERT_DUMP_FORM;
612
613 gv_fullname3(sv, gv, NULL);
614 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
615 if (CvROOT(GvFORM(gv)))
616 op_dump(CvROOT(GvFORM(gv)));
617 else
618 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
619}
620
621void
622Perl_dump_eval(pTHX)
623{
36b1c95c
MH
624 op_dump(PL_eval_root);
625}
626
3967c732 627void
6867be6d 628Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
3967c732
JD
629{
630 char ch;
631
7918f24d
NC
632 PERL_ARGS_ASSERT_DO_PMOP_DUMP;
633
3967c732 634 if (!pm) {
cea2e8a9 635 Perl_dump_indent(aTHX_ level, file, "{}\n");
3967c732
JD
636 return;
637 }
cea2e8a9 638 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732
JD
639 level++;
640 if (pm->op_pmflags & PMf_ONCE)
641 ch = '?';
642 else
643 ch = '/';
aaa362c4 644 if (PM_GETRE(pm))
cea2e8a9 645 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
220fc49f 646 ch, RX_PRECOMP(PM_GETRE(pm)), ch,
3967c732
JD
647 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
648 else
cea2e8a9 649 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
20e98b0f 650 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
cea2e8a9 651 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
20e98b0f 652 op_dump(pm->op_pmreplrootu.op_pmreplroot);
3967c732 653 }
68e2671b 654 if (pm->op_code_list) {
867940b8
DM
655 if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
656 Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
657 do_op_dump(level, file, pm->op_code_list);
658 }
659 else
660 Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
661 PTR2UV(pm->op_code_list));
68e2671b 662 }
07bc277f 663 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
4199688e 664 SV * const tmpsv = pm_description(pm);
b15aece3 665 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
5f954473 666 SvREFCNT_dec_NN(tmpsv);
3967c732
JD
667 }
668
cea2e8a9 669 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD
670}
671
a0c2f4dd
NC
672const struct flag_to_name pmflags_flags_names[] = {
673 {PMf_CONST, ",CONST"},
674 {PMf_KEEP, ",KEEP"},
675 {PMf_GLOBAL, ",GLOBAL"},
676 {PMf_CONTINUE, ",CONTINUE"},
677 {PMf_RETAINT, ",RETAINT"},
678 {PMf_EVAL, ",EVAL"},
679 {PMf_NONDESTRUCT, ",NONDESTRUCT"},
d63c20f2 680 {PMf_HAS_CV, ",HAS_CV"},
2a92a973
DM
681 {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
682 {PMf_IS_QR, ",IS_QR"}
a0c2f4dd
NC
683};
684
b9ac451d 685static SV *
4199688e
AL
686S_pm_description(pTHX_ const PMOP *pm)
687{
688 SV * const desc = newSVpvs("");
61f9802b 689 const REGEXP * const regex = PM_GETRE(pm);
4199688e
AL
690 const U32 pmflags = pm->op_pmflags;
691
7918f24d
NC
692 PERL_ARGS_ASSERT_PM_DESCRIPTION;
693
4199688e
AL
694 if (pmflags & PMf_ONCE)
695 sv_catpv(desc, ",ONCE");
c737faaf
YO
696#ifdef USE_ITHREADS
697 if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
698 sv_catpv(desc, ":USED");
699#else
700 if (pmflags & PMf_USED)
701 sv_catpv(desc, ":USED");
702#endif
c737faaf 703
68d4833d 704 if (regex) {
284167a5 705 if (RX_ISTAINTED(regex))
68d4833d 706 sv_catpv(desc, ",TAINTED");
07bc277f 707 if (RX_CHECK_SUBSTR(regex)) {
e3e400ec 708 if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
68d4833d 709 sv_catpv(desc, ",SCANFIRST");
07bc277f 710 if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
68d4833d
AB
711 sv_catpv(desc, ",ALL");
712 }
dbc200c5
YO
713 if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
714 sv_catpv(desc, ",SKIPWHITE");
4199688e 715 }
68d4833d 716
a0c2f4dd 717 append_flags(desc, pmflags, pmflags_flags_names);
4199688e
AL
718 return desc;
719}
720
3967c732 721void
864dbfa3 722Perl_pmop_dump(pTHX_ PMOP *pm)
3967c732
JD
723{
724 do_pmop_dump(0, Perl_debug_log, pm);
79072805
LW
725}
726
b6f05621
DM
727/* Return a unique integer to represent the address of op o.
728 * If it already exists in PL_op_sequence, just return it;
729 * otherwise add it.
730 * *** Note that this isn't thread-safe */
294b3b39 731
2814eb74 732STATIC UV
0bd48802 733S_sequence_num(pTHX_ const OP *o)
2814eb74 734{
27da23d5 735 dVAR;
2814eb74
PJ
736 SV *op,
737 **seq;
93524f2b 738 const char *key;
2814eb74 739 STRLEN len;
b6f05621
DM
740 if (!o)
741 return 0;
c0fd1b42 742 op = newSVuv(PTR2UV(o));
b6f05621 743 sv_2mortal(op);
93524f2b 744 key = SvPV_const(op, len);
b6f05621
DM
745 if (!PL_op_sequence)
746 PL_op_sequence = newHV();
747 seq = hv_fetch(PL_op_sequence, key, len, 0);
748 if (seq)
749 return SvUV(*seq);
750 (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
751 return PL_op_seq;
2814eb74
PJ
752}
753
f3574cc6
DM
754
755
756
757
a0c2f4dd
NC
758const struct flag_to_name op_flags_names[] = {
759 {OPf_KIDS, ",KIDS"},
760 {OPf_PARENS, ",PARENS"},
a0c2f4dd
NC
761 {OPf_REF, ",REF"},
762 {OPf_MOD, ",MOD"},
65cccc5e 763 {OPf_STACKED, ",STACKED"},
a0c2f4dd
NC
764 {OPf_SPECIAL, ",SPECIAL"}
765};
766
75a6ad4a 767
79072805 768void
6867be6d 769Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
79072805 770{
2814eb74 771 UV seq;
e15d5972
AL
772 const OPCODE optype = o->op_type;
773
7918f24d
NC
774 PERL_ARGS_ASSERT_DO_OP_DUMP;
775
cea2e8a9 776 Perl_dump_indent(aTHX_ level, file, "{\n");
3967c732 777 level++;
0bd48802 778 seq = sequence_num(o);
2814eb74 779 if (seq)
f5992bc4 780 PerlIO_printf(file, "%-4"UVuf, seq);
93a17b20 781 else
b6f05621 782 PerlIO_printf(file, "????");
c8db6e60
JH
783 PerlIO_printf(file,
784 "%*sTYPE = %s ===> ",
53e06cf0 785 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
2814eb74 786 if (o->op_next)
b6f05621
DM
787 PerlIO_printf(file,
788 o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
666ea192 789 sequence_num(o->op_next));
79072805 790 else
e75ab6ad 791 PerlIO_printf(file, "NULL\n");
11343788 792 if (o->op_targ) {
e15d5972 793 if (optype == OP_NULL) {
cea2e8a9 794 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
e15d5972 795 if (o->op_targ == OP_NEXTSTATE) {
ae7d165c 796 if (CopLINE(cCOPo))
f5992bc4 797 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 798 (UV)CopLINE(cCOPo));
0eb335df
BF
799 if (CopSTASHPV(cCOPo)) {
800 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
801 HV *stash = CopSTASH(cCOPo);
802 const char * const hvname = HvNAME_get(stash);
803
ae7d165c 804 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
0eb335df
BF
805 generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
806 }
807 if (CopLABEL(cCOPo)) {
808 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
809 STRLEN label_len;
810 U32 label_flags;
811 const char *label = CopLABEL_len_flags(cCOPo,
812 &label_len,
813 &label_flags);
ae7d165c 814 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
0eb335df
BF
815 generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
816 }
817
ae7d165c
PJ
818 }
819 }
8990e307 820 else
894356b3 821 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
8990e307 822 }
748a9306 823#ifdef DUMPADDR
57def98f 824 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
79072805 825#endif
a7fd8ef6 826
760f8c06
DM
827 if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) {
828 SV * const tmpsv = newSVpvs("");
829 switch (o->op_flags & OPf_WANT) {
830 case OPf_WANT_VOID:
831 sv_catpv(tmpsv, ",VOID");
832 break;
833 case OPf_WANT_SCALAR:
834 sv_catpv(tmpsv, ",SCALAR");
835 break;
836 case OPf_WANT_LIST:
837 sv_catpv(tmpsv, ",LIST");
838 break;
839 default:
840 sv_catpv(tmpsv, ",UNKNOWN");
841 break;
842 }
843 append_flags(tmpsv, o->op_flags, op_flags_names);
844 if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED");
845 if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
846 if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
847 if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
848 if (o->op_lastsib) sv_catpvs(tmpsv, ",LASTSIB");
849 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
850 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
851 }
852
853 if (o->op_private) {
f3574cc6
DM
854 U16 oppriv = o->op_private;
855 I16 op_ix = PL_op_private_bitdef_ix[o->op_type];
856 SV * tmpsv = NULL;
857
858 if (op_ix != -1) {
859 U16 stop = 0;
860 tmpsv = newSVpvs("");
861 for (; !stop; op_ix++) {
862 U16 entry = PL_op_private_bitdefs[op_ix];
863 U16 bit = (entry >> 2) & 7;
864 U16 ix = entry >> 5;
865
866 stop = (entry & 1);
867
868 if (entry & 2) {
869 /* bitfield */
870 I16 const *p = &PL_op_private_bitfields[ix];
871 U16 bitmin = (U16) *p++;
872 I16 label = *p++;
873 I16 enum_label;
874 U16 mask = 0;
875 U16 i;
876 U16 val;
877
878 for (i = bitmin; i<= bit; i++)
879 mask |= (1<<i);
880 bit = bitmin;
881 val = (oppriv & mask);
882
883 if ( label != -1
884 && PL_op_private_labels[label] == '-'
885 && PL_op_private_labels[label+1] == '\0'
886 )
887 /* display as raw number */
888 continue;
889
890 oppriv -= val;
891 val >>= bit;
892 enum_label = -1;
893 while (*p != -1) {
894 if (val == *p++) {
895 enum_label = *p;
896 break;
897 }
898 p++;
899 }
900 if (val == 0 && enum_label == -1)
901 /* don't display anonymous zero values */
902 continue;
903
904 sv_catpv(tmpsv, ",");
905 if (label != -1) {
906 sv_catpv(tmpsv, &PL_op_private_labels[label]);
907 sv_catpv(tmpsv, "=");
908 }
909 sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
910
911 }
912 else {
913 /* bit flag */
914 if ( oppriv & (1<<bit)
915 && !(PL_op_private_labels[ix] == '-'
916 && PL_op_private_labels[ix+1] == '\0'))
917 {
918 oppriv -= (1<<bit);
919 sv_catpv(tmpsv, ",");
920 sv_catpv(tmpsv, &PL_op_private_labels[ix]);
921 }
760f8c06 922 }
760f8c06 923 }
f3574cc6
DM
924 if (oppriv) {
925 sv_catpv(tmpsv, ",");
926 Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)oppriv);
760f8c06
DM
927 }
928 }
f3574cc6 929 if (tmpsv && SvCUR(tmpsv)) {
760f8c06
DM
930 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
931 } else
932 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
933 (UV)oppriv);
934 }
935
e15d5972 936 switch (optype) {
971a9dd3 937 case OP_AELEMFAST:
93a17b20 938 case OP_GVSV:
79072805 939 case OP_GV:
971a9dd3 940#ifdef USE_ITHREADS
c803eecc 941 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 942#else
1640e9f0 943 if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
38c076c7 944 if (cSVOPo->op_sv) {
0eb335df
BF
945 STRLEN len;
946 const char * name;
947 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
948 SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
159b6efe 949 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
0eb335df 950 name = SvPV_const(tmpsv, len);
8b6b16e7 951 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
0eb335df 952 generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
38c076c7
DM
953 }
954 else
955 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
378cc40b 956 }
971a9dd3 957#endif
79072805
LW
958 break;
959 case OP_CONST:
996c9baa 960 case OP_HINTSEVAL:
f5d5a27c 961 case OP_METHOD_NAMED:
b6a15bc5
DM
962#ifndef USE_ITHREADS
963 /* with ITHREADS, consts are stored in the pad, and the right pad
964 * may not be active here, so skip */
3848b962 965 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
b6a15bc5 966#endif
79072805 967 break;
93a17b20
LW
968 case OP_NEXTSTATE:
969 case OP_DBSTATE:
57843af0 970 if (CopLINE(cCOPo))
f5992bc4 971 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
9d98dee5 972 (UV)CopLINE(cCOPo));
0eb335df
BF
973 if (CopSTASHPV(cCOPo)) {
974 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
975 HV *stash = CopSTASH(cCOPo);
976 const char * const hvname = HvNAME_get(stash);
977
ed094faf 978 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
0eb335df
BF
979 generic_pv_escape(tmpsv, hvname,
980 HvNAMELEN(stash), HvNAMEUTF8(stash)));
981 }
982 if (CopLABEL(cCOPo)) {
983 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
984 STRLEN label_len;
985 U32 label_flags;
986 const char *label = CopLABEL_len_flags(cCOPo,
987 &label_len, &label_flags);
988 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
989 generic_pv_escape( tmpsv, label, label_len,
990 (label_flags & SVf_UTF8)));
991 }
79072805
LW
992 break;
993 case OP_ENTERLOOP:
cea2e8a9 994 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
11343788 995 if (cLOOPo->op_redoop)
f5992bc4 996 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
79072805 997 else
3967c732 998 PerlIO_printf(file, "DONE\n");
cea2e8a9 999 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
11343788 1000 if (cLOOPo->op_nextop)
f5992bc4 1001 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
79072805 1002 else
3967c732 1003 PerlIO_printf(file, "DONE\n");
cea2e8a9 1004 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
11343788 1005 if (cLOOPo->op_lastop)
f5992bc4 1006 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
79072805 1007 else
3967c732 1008 PerlIO_printf(file, "DONE\n");
79072805
LW
1009 break;
1010 case OP_COND_EXPR:
1a67a97c 1011 case OP_RANGE:
a0d0e21e 1012 case OP_MAPWHILE:
79072805
LW
1013 case OP_GREPWHILE:
1014 case OP_OR:
1015 case OP_AND:
cea2e8a9 1016 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
11343788 1017 if (cLOGOPo->op_other)
f5992bc4 1018 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
79072805 1019 else
3967c732 1020 PerlIO_printf(file, "DONE\n");
79072805
LW
1021 break;
1022 case OP_PUSHRE:
1023 case OP_MATCH:
8782bef2 1024 case OP_QR:
79072805 1025 case OP_SUBST:
3967c732 1026 do_pmop_dump(level, file, cPMOPo);
79072805 1027 break;
7934575e
GS
1028 case OP_LEAVE:
1029 case OP_LEAVEEVAL:
1030 case OP_LEAVESUB:
1031 case OP_LEAVESUBLV:
1032 case OP_LEAVEWRITE:
1033 case OP_SCOPE:
1034 if (o->op_private & OPpREFCOUNTED)
1035 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1036 break;
a0d0e21e
LW
1037 default:
1038 break;
79072805 1039 }
11343788 1040 if (o->op_flags & OPf_KIDS) {
79072805 1041 OP *kid;
1ed44841 1042 for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
3967c732 1043 do_op_dump(level, file, kid);
8d063cd8 1044 }
cea2e8a9 1045 Perl_dump_indent(aTHX_ level-1, file, "}\n");
3967c732
JD
1046}
1047
36b1c95c
MH
1048/*
1049=for apidoc op_dump
1050
1051Dumps the optree starting at OP C<o> to C<STDERR>.
1052
1053=cut
1054*/
1055
3967c732 1056void
6867be6d 1057Perl_op_dump(pTHX_ const OP *o)
3967c732 1058{
7918f24d 1059 PERL_ARGS_ASSERT_OP_DUMP;
3967c732 1060 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW
1061}
1062
8adcabd8 1063void
864dbfa3 1064Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1065{
0eb335df
BF
1066 STRLEN len;
1067 const char* name;
1068 SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1069
378cc40b 1070
7918f24d
NC
1071 PERL_ARGS_ASSERT_GV_DUMP;
1072
79072805 1073 if (!gv) {
760ac839 1074 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW
1075 return;
1076 }
8990e307 1077 sv = sv_newmortal();
760ac839 1078 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1079 gv_fullname3(sv, gv, NULL);
0eb335df
BF
1080 name = SvPV_const(sv, len);
1081 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1082 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
79072805 1083 if (gv != GvEGV(gv)) {
bd61b366 1084 gv_efullname3(sv, GvEGV(gv), NULL);
0eb335df
BF
1085 name = SvPV_const(sv, len);
1086 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1087 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
8adcabd8 1088 }
3967c732 1089 PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1090 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW
1091}
1092
14befaf4 1093
afe38520 1094/* map magic types to the symbolic names
14befaf4
DM
1095 * (with the PERL_MAGIC_ prefixed stripped)
1096 */
1097
27da23d5 1098static const struct { const char type; const char *name; } magic_names[] = {
52f49505 1099#include "mg_names.c"
516a5887 1100 /* this null string terminates the list */
b9ac451d 1101 { 0, NULL },
14befaf4
DM
1102};
1103
8adcabd8 1104void
6867be6d 1105Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1106{
7918f24d
NC
1107 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1108
3967c732 1109 for (; mg; mg = mg->mg_moremagic) {
b900a521
JH
1110 Perl_dump_indent(aTHX_ level, file,
1111 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
3967c732 1112 if (mg->mg_virtual) {
bfed75c6 1113 const MGVTBL * const v = mg->mg_virtual;
2d1f1fe5
NC
1114 if (v >= PL_magic_vtables
1115 && v < PL_magic_vtables + magic_vtable_max) {
1116 const U32 i = v - PL_magic_vtables;
1117 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1118 }
3967c732 1119 else
b900a521 1120 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
3967c732
JD
1121 }
1122 else
cea2e8a9 1123 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1124
3967c732 1125 if (mg->mg_private)
cea2e8a9 1126 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1127
14befaf4
DM
1128 {
1129 int n;
c445ea15 1130 const char *name = NULL;
27da23d5 1131 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM
1132 if (mg->mg_type == magic_names[n].type) {
1133 name = magic_names[n].name;
1134 break;
1135 }
1136 }
1137 if (name)
1138 Perl_dump_indent(aTHX_ level, file,
1139 " MG_TYPE = PERL_MAGIC_%s\n", name);
1140 else
1141 Perl_dump_indent(aTHX_ level, file,
1142 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1143 }
3967c732
JD
1144
1145 if (mg->mg_flags) {
cea2e8a9 1146 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST
1147 if (mg->mg_type == PERL_MAGIC_envelem &&
1148 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1149 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
4c02285a
FR
1150 if (mg->mg_type == PERL_MAGIC_regex_global &&
1151 mg->mg_flags & MGf_MINMATCH)
1152 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1153 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1154 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1155 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1156 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
4c02285a
FR
1157 if (mg->mg_flags & MGf_COPY)
1158 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1159 if (mg->mg_flags & MGf_DUP)
1160 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1161 if (mg->mg_flags & MGf_LOCAL)
1162 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
25fdce4a
FC
1163 if (mg->mg_type == PERL_MAGIC_regex_global &&
1164 mg->mg_flags & MGf_BYTES)
1165 Perl_dump_indent(aTHX_ level, file, " BYTES\n");
3967c732
JD
1166 }
1167 if (mg->mg_obj) {
4c02285a 1168 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
28d8d7f4
YO
1169 PTR2UV(mg->mg_obj));
1170 if (mg->mg_type == PERL_MAGIC_qr) {
07bc277f 1171 REGEXP* const re = (REGEXP *)mg->mg_obj;
61f9802b 1172 SV * const dsv = sv_newmortal();
866c78d1 1173 const char * const s
4c02285a 1174 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
28d8d7f4 1175 60, NULL, NULL,
95b611b0 1176 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
3c8556c3 1177 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
28d8d7f4 1178 );
6483fb35
RGS
1179 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1180 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
07bc277f 1181 (IV)RX_REFCNT(re));
28d8d7f4
YO
1182 }
1183 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732
JD
1184 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1185 }
1186 if (mg->mg_len)
894356b3 1187 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1188 if (mg->mg_ptr) {
b900a521 1189 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
3967c732 1190 if (mg->mg_len >= 0) {
7e8c5dac 1191 if (mg->mg_type != PERL_MAGIC_utf8) {
17605be7 1192 SV * const sv = newSVpvs("");
7e8c5dac 1193 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
17605be7 1194 SvREFCNT_dec_NN(sv);
7e8c5dac 1195 }
3967c732
JD
1196 }
1197 else if (mg->mg_len == HEf_SVKEY) {
1198 PerlIO_puts(file, " => HEf_SVKEY\n");
ad64d0ec
NC
1199 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1200 maxnest, dumpops, pvlim); /* MG is already +1 */
3967c732
JD
1201 continue;
1202 }
866f9d6c 1203 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
3967c732 1204 else
866f9d6c
FC
1205 PerlIO_puts(
1206 file,
1207 " ???? - " __FILE__
1208 " does not know how to handle this MG_LEN"
1209 );
3967c732
JD
1210 PerlIO_putc(file, '\n');
1211 }
7e8c5dac 1212 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1213 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac
HS
1214 if (cache) {
1215 IV i;
1216 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1217 Perl_dump_indent(aTHX_ level, file,
1218 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1219 i,
1220 (UV)cache[i * 2],
1221 (UV)cache[i * 2 + 1]);
1222 }
1223 }
378cc40b 1224 }
3967c732
JD
1225}
1226
1227void
6867be6d 1228Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1229{
b9ac451d 1230 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD
1231}
1232
1233void
e1ec3a88 1234Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1235{
bfcb3514 1236 const char *hvname;
7918f24d
NC
1237
1238 PERL_ARGS_ASSERT_DO_HV_DUMP;
1239
b900a521 1240 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
bfcb3514 1241 if (sv && (hvname = HvNAME_get(sv)))
d7d51f4b
YO
1242 {
1243 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1244 name which quite legally could contain insane things like tabs, newlines, nulls or
1245 other scary crap - this should produce sane results - except maybe for unicode package
1246 names - but we will wait for someone to file a bug on that - demerphq */
0eb335df
BF
1247 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1248 PerlIO_printf(file, "\t\"%s\"\n",
1249 generic_pv_escape( tmpsv, hvname,
1250 HvNAMELEN(sv), HvNAMEUTF8(sv)));
d7d51f4b 1251 }
79072805 1252 else
3967c732
JD
1253 PerlIO_putc(file, '\n');
1254}
1255
1256void
e1ec3a88 1257Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1258{
7918f24d
NC
1259 PERL_ARGS_ASSERT_DO_GV_DUMP;
1260
b900a521 1261 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
0eb335df
BF
1262 if (sv && GvNAME(sv)) {
1263 SV * const tmpsv = newSVpvs("");
1264 PerlIO_printf(file, "\t\"%s\"\n",
1265 generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1266 }
c90c0ff4 1267 else
3967c732
JD
1268 PerlIO_putc(file, '\n');
1269}
1270
1271void
e1ec3a88 1272Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1273{
7918f24d
NC
1274 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1275
b900a521 1276 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
3967c732 1277 if (sv && GvNAME(sv)) {
0eb335df 1278 SV *tmp = newSVpvs_flags("", SVs_TEMP);
bfcb3514 1279 const char *hvname;
0eb335df
BF
1280 HV * const stash = GvSTASH(sv);
1281 PerlIO_printf(file, "\t");
1282 /* TODO might have an extra \" here */
1283 if (stash && (hvname = HvNAME_get(stash))) {
1284 PerlIO_printf(file, "\"%s\" :: \"",
1285 generic_pv_escape(tmp, hvname,
1286 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1287 }
1288 PerlIO_printf(file, "%s\"\n",
1289 generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
8d063cd8 1290 }
3967c732
JD
1291 else
1292 PerlIO_putc(file, '\n');
1293}
1294
a0c2f4dd
NC
1295const struct flag_to_name first_sv_flags_names[] = {
1296 {SVs_TEMP, "TEMP,"},
1297 {SVs_OBJECT, "OBJECT,"},
1298 {SVs_GMG, "GMG,"},
1299 {SVs_SMG, "SMG,"},
1300 {SVs_RMG, "RMG,"},
1301 {SVf_IOK, "IOK,"},
1302 {SVf_NOK, "NOK,"},
1303 {SVf_POK, "POK,"}
1304};
1305
1306const struct flag_to_name second_sv_flags_names[] = {
1307 {SVf_OOK, "OOK,"},
1308 {SVf_FAKE, "FAKE,"},
1309 {SVf_READONLY, "READONLY,"},
e3918bb7 1310 {SVf_IsCOW, "IsCOW,"},
a0c2f4dd
NC
1311 {SVf_BREAK, "BREAK,"},
1312 {SVf_AMAGIC, "OVERLOAD,"},
1313 {SVp_IOK, "pIOK,"},
1314 {SVp_NOK, "pNOK,"},
1315 {SVp_POK, "pPOK,"}
1316};
1317
ae1f06a1
NC
1318const struct flag_to_name cv_flags_names[] = {
1319 {CVf_ANON, "ANON,"},
1320 {CVf_UNIQUE, "UNIQUE,"},
1321 {CVf_CLONE, "CLONE,"},
1322 {CVf_CLONED, "CLONED,"},
1323 {CVf_CONST, "CONST,"},
1324 {CVf_NODEBUG, "NODEBUG,"},
1325 {CVf_LVALUE, "LVALUE,"},
1326 {CVf_METHOD, "METHOD,"},
cfc1e951 1327 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
31d45e0c 1328 {CVf_CVGV_RC, "CVGV_RC,"},
bad4ae38 1329 {CVf_DYNFILE, "DYNFILE,"},
8fa6a409 1330 {CVf_AUTOLOAD, "AUTOLOAD,"},
e4555ecf 1331 {CVf_HASEVAL, "HASEVAL,"},
bfbc3ad9 1332 {CVf_SLABBED, "SLABBED,"},
bf9a4d2d 1333 {CVf_NAMED, "NAMED,"},
82487b59 1334 {CVf_LEXICAL, "LEXICAL,"},
31d45e0c 1335 {CVf_ISXSUB, "ISXSUB,"}
ae1f06a1
NC
1336};
1337
1338const struct flag_to_name hv_flags_names[] = {
1339 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1340 {SVphv_LAZYDEL, "LAZYDEL,"},
1341 {SVphv_HASKFLAGS, "HASKFLAGS,"},
ae1f06a1
NC
1342 {SVphv_CLONEABLE, "CLONEABLE,"}
1343};
1344
1345const struct flag_to_name gp_flags_names[] = {
1346 {GVf_INTRO, "INTRO,"},
1347 {GVf_MULTI, "MULTI,"},
1348 {GVf_ASSUMECV, "ASSUMECV,"},
ae1f06a1
NC
1349};
1350
1351const struct flag_to_name gp_flags_imported_names[] = {
1352 {GVf_IMPORTED_SV, " SV"},
1353 {GVf_IMPORTED_AV, " AV"},
1354 {GVf_IMPORTED_HV, " HV"},
1355 {GVf_IMPORTED_CV, " CV"},
1356};
1357
0d331aaf
YO
1358/* NOTE: this structure is mostly duplicative of one generated by
1359 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1360 * the two. - Yves */
e3e400ec 1361const struct flag_to_name regexp_extflags_names[] = {
d63e6659
DM
1362 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1363 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1364 {RXf_PMf_FOLD, "PMf_FOLD,"},
1365 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1366 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
8e1490ee 1367 {RXf_IS_ANCHORED, "IS_ANCHORED,"},
dbc200c5 1368 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
d63e6659 1369 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
d63e6659
DM
1370 {RXf_CHECK_ALL, "CHECK_ALL,"},
1371 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1372 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1373 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1374 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
dbc200c5 1375 {RXf_SPLIT, "SPLIT,"},
d63e6659
DM
1376 {RXf_COPY_DONE, "COPY_DONE,"},
1377 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1378 {RXf_TAINTED, "TAINTED,"},
1379 {RXf_START_ONLY, "START_ONLY,"},
dbc200c5 1380 {RXf_SKIPWHITE, "SKIPWHITE,"},
d63e6659
DM
1381 {RXf_WHITE, "WHITE,"},
1382 {RXf_NULL, "NULL,"},
1383};
1384
0d331aaf
YO
1385/* NOTE: this structure is mostly duplicative of one generated by
1386 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1387 * the two. - Yves */
e3e400ec
YO
1388const struct flag_to_name regexp_core_intflags_names[] = {
1389 {PREGf_SKIP, "SKIP,"},
0d331aaf
YO
1390 {PREGf_IMPLICIT, "IMPLICIT,"},
1391 {PREGf_NAUGHTY, "NAUGHTY,"},
e3e400ec
YO
1392 {PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
1393 {PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
0d331aaf 1394 {PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
e3e400ec 1395 {PREGf_NOSCAN, "NOSCAN,"},
0d331aaf 1396 {PREGf_CANY_SEEN, "CANY_SEEN,"},
58430ea8
YO
1397 {PREGf_GPOS_SEEN, "GPOS_SEEN,"},
1398 {PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
8e1490ee
YO
1399 {PREGf_ANCH_MBOL, "ANCH_MBOL,"},
1400 {PREGf_ANCH_SBOL, "ANCH_SBOL,"},
1401 {PREGf_ANCH_GPOS, "ANCH_GPOS,"},
e3e400ec
YO
1402};
1403
3967c732 1404void
864dbfa3 1405Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1406{
cea89e20 1407 SV *d;
e1ec3a88 1408 const char *s;
3967c732
JD
1409 U32 flags;
1410 U32 type;
1411
7918f24d
NC
1412 PERL_ARGS_ASSERT_DO_SV_DUMP;
1413
3967c732 1414 if (!sv) {
cea2e8a9 1415 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1416 return;
378cc40b 1417 }
2ef28da1 1418
3967c732
JD
1419 flags = SvFLAGS(sv);
1420 type = SvTYPE(sv);
79072805 1421
e0bbf362
DM
1422 /* process general SV flags */
1423
cea89e20 1424 d = Perl_newSVpvf(aTHX_
57def98f 1425 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
56431972 1426 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS
1427 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1428 (int)(PL_dumpindent*level), "");
8d063cd8 1429
1979170b
NC
1430 if (!((flags & SVpad_NAME) == SVpad_NAME
1431 && (type == SVt_PVMG || type == SVt_PVNV))) {
9a214eec
DM
1432 if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1433 sv_catpv(d, "PADSTALE,");
e604303a 1434 }
1979170b 1435 if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
9a214eec
DM
1436 if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1437 sv_catpv(d, "PADTMP,");
e604303a
NC
1438 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1439 }
a0c2f4dd 1440 append_flags(d, flags, first_sv_flags_names);
810b8aa5
GS
1441 if (flags & SVf_ROK) {
1442 sv_catpv(d, "ROK,");
1443 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1444 }
a0c2f4dd 1445 append_flags(d, flags, second_sv_flags_names);
7db6405c
FC
1446 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1447 && type != SVt_PVAV) {
1ccdb730
NC
1448 if (SvPCS_IMPORTED(sv))
1449 sv_catpv(d, "PCS_IMPORTED,");
1450 else
9660f481 1451 sv_catpv(d, "SCREAM,");
1ccdb730 1452 }
3967c732 1453
e0bbf362
DM
1454 /* process type-specific SV flags */
1455
3967c732
JD
1456 switch (type) {
1457 case SVt_PVCV:
1458 case SVt_PVFM:
ae1f06a1 1459 append_flags(d, CvFLAGS(sv), cv_flags_names);
3967c732
JD
1460 break;
1461 case SVt_PVHV:
ae1f06a1 1462 append_flags(d, flags, hv_flags_names);
3967c732 1463 break;
926fc7b6
DM
1464 case SVt_PVGV:
1465 case SVt_PVLV:
1466 if (isGV_with_GP(sv)) {
ae1f06a1 1467 append_flags(d, GvFLAGS(sv), gp_flags_names);
926fc7b6 1468 }
926fc7b6 1469 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD
1470 sv_catpv(d, "IMPORT");
1471 if (GvIMPORTED(sv) == GVf_IMPORTED)
1472 sv_catpv(d, "ALL,");
1473 else {
1474 sv_catpv(d, "(");
ae1f06a1 1475 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
3967c732
JD
1476 sv_catpv(d, " ),");
1477 }
1478 }
924ba076 1479 /* FALLTHROUGH */
25da4f38 1480 default:
e604303a 1481 evaled_or_uv:
25da4f38 1482 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
69c678eb 1483 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1484 break;
addd1794 1485 case SVt_PVMG:
c13a5c80
NC
1486 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1487 if (SvVALID(sv)) sv_catpv(d, "VALID,");
00b1698f 1488 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
e604303a 1489 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
924ba076 1490 /* FALLTHROUGH */
e604303a
NC
1491 case SVt_PVNV:
1492 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1493 goto evaled_or_uv;
11ca45c0 1494 case SVt_PVAV:
7db6405c 1495 if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
11ca45c0 1496 break;
3967c732 1497 }
86f0d186
NC
1498 /* SVphv_SHAREKEYS is also 0x20000000 */
1499 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1500 sv_catpv(d, "UTF8");
3967c732 1501
b162af07
SP
1502 if (*(SvEND(d) - 1) == ',') {
1503 SvCUR_set(d, SvCUR(d) - 1);
1504 SvPVX(d)[SvCUR(d)] = '\0';
1505 }
3967c732 1506 sv_catpv(d, ")");
b15aece3 1507 s = SvPVX_const(d);
3967c732 1508
e0bbf362
DM
1509 /* dump initial SV details */
1510
fd0854ff 1511#ifdef DEBUG_LEAKING_SCALARS
cbe56f1d 1512 Perl_dump_indent(aTHX_ level, file,
cd676548 1513 "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
fd0854ff
DM
1514 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1515 sv->sv_debug_line,
1516 sv->sv_debug_inpad ? "for" : "by",
1517 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
cd676548 1518 PTR2UV(sv->sv_debug_parent),
cbe56f1d
DM
1519 sv->sv_debug_serial
1520 );
fd0854ff 1521#endif
cea2e8a9 1522 Perl_dump_indent(aTHX_ level, file, "SV = ");
e0bbf362
DM
1523
1524 /* Dump SV type */
1525
5357ca29
NC
1526 if (type < SVt_LAST) {
1527 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1528
1529 if (type == SVt_NULL) {
5f954473 1530 SvREFCNT_dec_NN(d);
5357ca29
NC
1531 return;
1532 }
1533 } else {
faccc32b 1534 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
5f954473 1535 SvREFCNT_dec_NN(d);
3967c732
JD
1536 return;
1537 }
e0bbf362
DM
1538
1539 /* Dump general SV fields */
1540
27bd069f 1541 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
0a0c4b76
NC
1542 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1543 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
4df7f6af 1544 || (type == SVt_IV && !SvROK(sv))) {
765f542d 1545 if (SvIsUV(sv)
f8c7b90f 1546#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC
1547 || SvIsCOW(sv)
1548#endif
1549 )
57def98f 1550 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
cf2093f6 1551 else
57def98f 1552 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
f8c7b90f 1553#ifdef PERL_OLD_COPY_ON_WRITE
765f542d
NC
1554 if (SvIsCOW_shared_hash(sv))
1555 PerlIO_printf(file, " (HASH)");
1556 else if (SvIsCOW_normal(sv))
1557 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1558#endif
3967c732
JD
1559 PerlIO_putc(file, '\n');
1560 }
e0bbf362 1561
1979170b
NC
1562 if ((type == SVt_PVNV || type == SVt_PVMG)
1563 && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
0e4c4423
NC
1564 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1565 (UV) COP_SEQ_RANGE_LOW(sv));
1566 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1567 (UV) COP_SEQ_RANGE_HIGH(sv));
1568 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
08e44740 1569 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
c0a413d1 1570 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
0e4c4423 1571 || type == SVt_NV) {
e54dc35b 1572 STORE_NUMERIC_LOCAL_SET_STANDARD();
88cb8500 1573 Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
e54dc35b 1574 RESTORE_NUMERIC_LOCAL();
3967c732 1575 }
e0bbf362 1576
3967c732 1577 if (SvROK(sv)) {
57def98f 1578 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
3967c732
JD
1579 if (nest < maxnest)
1580 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1581 }
e0bbf362 1582
cea89e20 1583 if (type < SVt_PV) {
5f954473 1584 SvREFCNT_dec_NN(d);
3967c732 1585 return;
cea89e20 1586 }
e0bbf362 1587
5a3c7349
FC
1588 if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1589 || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
8d919b0a
FC
1590 const bool re = isREGEXP(sv);
1591 const char * const ptr =
1592 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1593 if (ptr) {
69240efd 1594 STRLEN delta;
7a4bba22 1595 if (SvOOK(sv)) {
69240efd 1596 SvOOK_offset(sv, delta);
7a4bba22 1597 Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
5186cc12 1598 (UV) delta);
69240efd
NC
1599 } else {
1600 delta = 0;
7a4bba22 1601 }
8d919b0a 1602 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
7a4bba22
NC
1603 if (SvOOK(sv)) {
1604 PerlIO_printf(file, "( %s . ) ",
8d919b0a 1605 pv_display(d, ptr - delta, delta, 0,
7a4bba22
NC
1606 pvlim));
1607 }
ad3f05ad
KW
1608 if (type == SVt_INVLIST) {
1609 PerlIO_printf(file, "\n");
1610 /* 4 blanks indents 2 beyond the PV, etc */
1611 _invlist_dump(file, level, " ", sv);
1612 }
1613 else {
685bfc3c
KW
1614 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1615 re ? 0 : SvLEN(sv),
1616 pvlim));
1617 if (SvUTF8(sv)) /* the 6? \x{....} */
1618 PerlIO_printf(file, " [UTF8 \"%s\"]",
1619 sv_uni_display(d, sv, 6 * SvCUR(sv),
1620 UNI_DISPLAY_QQ));
1621 PerlIO_printf(file, "\n");
ad3f05ad 1622 }
57def98f 1623 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
8d919b0a
FC
1624 if (!re)
1625 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1626 (IV)SvLEN(sv));
db2c6cb3
FC
1627#ifdef PERL_NEW_COPY_ON_WRITE
1628 if (SvIsCOW(sv) && SvLEN(sv))
1629 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1630 CowREFCNT(sv));
1631#endif
3967c732
JD
1632 }
1633 else
cea2e8a9 1634 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1635 }
e0bbf362 1636
3967c732 1637 if (type >= SVt_PVMG) {
0e4c4423 1638 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
61f9802b 1639 HV * const ost = SvOURSTASH(sv);
38cbaf55
RGS
1640 if (ost)
1641 do_hv_dump(level, file, " OURSTASH", ost);
7db6405c
FC
1642 } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
1643 Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
1644 (UV)PadnamelistMAXNAMED(sv));
0e4c4423
NC
1645 } else {
1646 if (SvMAGIC(sv))
8530ff28 1647 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
0e4c4423 1648 }
3967c732
JD
1649 if (SvSTASH(sv))
1650 do_hv_dump(level, file, " STASH", SvSTASH(sv));
c13a5c80
NC
1651
1652 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
c13a5c80
NC
1653 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1654 }
3967c732 1655 }
e0bbf362
DM
1656
1657 /* Dump type-specific SV fields */
1658
3967c732 1659 switch (type) {
3967c732 1660 case SVt_PVAV:
57def98f 1661 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
3967c732 1662 if (AvARRAY(sv) != AvALLOC(sv)) {
57def98f
JH
1663 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1664 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
3967c732
JD
1665 }
1666 else
1667 PerlIO_putc(file, '\n');
57def98f
JH
1668 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1669 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
7db6405c
FC
1670 /* arylen is stored in magic, and padnamelists use SvMAGIC for
1671 something else. */
1672 if (!AvPAD_NAMELIST(sv))
1673 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
1674 SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
76f68e9b 1675 sv_setpvs(d, "");
11ca45c0
NC
1676 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1677 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP
1678 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1679 SvCUR(d) ? SvPVX_const(d) + 1 : "");
b9f2b683 1680 if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
c70927a6 1681 SSize_t count;
b9f2b683 1682 for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
502c6561 1683 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
3967c732 1684
57def98f 1685 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
2ef28da1 1686 if (elt)
3967c732
JD
1687 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1688 }
1689 }
1690 break;
5d27ee4a
DD
1691 case SVt_PVHV: {
1692 U32 usedkeys;
0c22a733
DM
1693 if (SvOOK(sv)) {
1694 struct xpvhv_aux *const aux = HvAUX(sv);
1695 Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
1696 (UV)aux->xhv_aux_flags);
1697 }
57def98f 1698 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
5d27ee4a
DD
1699 usedkeys = HvUSEDKEYS(sv);
1700 if (HvARRAY(sv) && usedkeys) {
3967c732
JD
1701 /* Show distribution of HEs in the ARRAY */
1702 int freq[200];
c3caa5c3 1703#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
3967c732
JD
1704 int i;
1705 int max = 0;
5d27ee4a 1706 U32 pow2 = 2, keys = usedkeys;
65202027 1707 NV theoret, sum = 0;
3967c732
JD
1708
1709 PerlIO_printf(file, " (");
1710 Zero(freq, FREQ_MAX + 1, int);
eb160463 1711 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL
1712 HE* h;
1713 int count = 0;
3967c732
JD
1714 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1715 count++;
1716 if (count > FREQ_MAX)
1717 count = FREQ_MAX;
1718 freq[count]++;
1719 if (max < count)
1720 max = count;
1721 }
1722 for (i = 0; i <= max; i++) {
1723 if (freq[i]) {
1724 PerlIO_printf(file, "%d%s:%d", i,
1725 (i == FREQ_MAX) ? "+" : "",
1726 freq[i]);
1727 if (i != max)
1728 PerlIO_printf(file, ", ");
1729 }
1730 }
1731 PerlIO_putc(file, ')');
b8fa94d8
MG
1732 /* The "quality" of a hash is defined as the total number of
1733 comparisons needed to access every element once, relative
1734 to the expected number needed for a random hash.
1735
1736 The total number of comparisons is equal to the sum of
e76cd0fa
AMS
1737 the squares of the number of entries in each bucket.
1738 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG
1739 value is
1740 n + n(n-1)/2k
1741 */
1742
3967c732
JD
1743 for (i = max; i > 0; i--) { /* Precision: count down. */
1744 sum += freq[i] * i * i;
1745 }
155aba94 1746 while ((keys = keys >> 1))
3967c732 1747 pow2 = pow2 << 1;
5d27ee4a 1748 theoret = usedkeys;
b8fa94d8 1749 theoret += theoret * (theoret-1)/pow2;
3967c732 1750 PerlIO_putc(file, '\n');
6b4667fc 1751 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
3967c732
JD
1752 }
1753 PerlIO_putc(file, '\n');
5d27ee4a 1754 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
9faf471a
NC
1755 {
1756 STRLEN count = 0;
1757 HE **ents = HvARRAY(sv);
1758
1759 if (ents) {
1760 HE *const *const last = ents + HvMAX(sv);
1761 count = last + 1 - ents;
1762
1763 do {
1764 if (!*ents)
1765 --count;
1766 } while (++ents <= last);
1767 }
1768
1769 if (SvOOK(sv)) {
1770 struct xpvhv_aux *const aux = HvAUX(sv);
1771 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1772 " (cached = %"UVuf")\n",
1773 (UV)count, (UV)aux->xhv_fill_lazy);
1774 } else {
1775 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1776 (UV)count);
1777 }
1778 }
57def98f 1779 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
e1a7ec8d
YO
1780 if (SvOOK(sv)) {
1781 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1782 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
6a5b4183 1783#ifdef PERL_HASH_RANDOMIZE_KEYS
e1a7ec8d
YO
1784 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1785 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
6a5b4183 1786 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
e1a7ec8d 1787 }
6a5b4183
YO
1788#endif
1789 PerlIO_putc(file, '\n');
e1a7ec8d 1790 }
8d2f4536 1791 {
b9ac451d 1792 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536
NC
1793 if (mg && mg->mg_obj) {
1794 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1795 }
1796 }
bfcb3514 1797 {
b9ac451d 1798 const char * const hvname = HvNAME_get(sv);
0eb335df
BF
1799 if (hvname) {
1800 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1801 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
1802 generic_pv_escape( tmpsv, hvname,
1803 HvNAMELEN(sv), HvNAMEUTF8(sv)));
1804 }
bfcb3514 1805 }
86f55936 1806 if (SvOOK(sv)) {
ad64d0ec 1807 AV * const backrefs
85fbaab2 1808 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
7d88e6c4 1809 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
67e04715
FC
1810 if (HvAUX(sv)->xhv_name_count)
1811 Perl_dump_indent(aTHX_
7afc2217
FC
1812 level, file, " NAMECOUNT = %"IVdf"\n",
1813 (IV)HvAUX(sv)->xhv_name_count
67e04715 1814 );
15d9236d 1815 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
ec3405c8
NC
1816 const I32 count = HvAUX(sv)->xhv_name_count;
1817 if (count) {
1818 SV * const names = newSVpvs_flags("", SVs_TEMP);
1819 /* The starting point is the first element if count is
1820 positive and the second element if count is negative. */
1821 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1822 + (count < 0 ? 1 : 0);
1823 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1824 + (count < 0 ? -count : count);
1825 while (hekp < endp) {
0eb335df
BF
1826 if (HEK_LEN(*hekp)) {
1827 SV *tmp = newSVpvs_flags("", SVs_TEMP);
1828 Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
1829 generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
ec3405c8
NC
1830 } else {
1831 /* This should never happen. */
1832 sv_catpvs(names, ", (null)");
67e04715 1833 }
ec3405c8
NC
1834 ++hekp;
1835 }
67e04715
FC
1836 Perl_dump_indent(aTHX_
1837 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1838 );
1839 }
0eb335df
BF
1840 else {
1841 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
1842 const char *const hvename = HvENAME_get(sv);
67e04715 1843 Perl_dump_indent(aTHX_
0eb335df
BF
1844 level, file, " ENAME = \"%s\"\n",
1845 generic_pv_escape(tmp, hvename,
1846 HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
1847 }
67e04715 1848 }
86f55936
NC
1849 if (backrefs) {
1850 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1851 PTR2UV(backrefs));
ad64d0ec 1852 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
86f55936
NC
1853 dumpops, pvlim);
1854 }
7d88e6c4 1855 if (meta) {
0eb335df
BF
1856 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1857 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
1858 generic_pv_escape( tmpsv, meta->mro_which->name,
1859 meta->mro_which->length,
1860 (meta->mro_which->kflags & HVhek_UTF8)),
7d88e6c4
NC
1861 PTR2UV(meta->mro_which));
1862 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1863 (UV)meta->cache_gen);
1864 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
1865 (UV)meta->pkg_gen);
1866 if (meta->mro_linear_all) {
1867 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
1868 PTR2UV(meta->mro_linear_all));
1869 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
1870 dumpops, pvlim);
1871 }
1872 if (meta->mro_linear_current) {
1873 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
1874 PTR2UV(meta->mro_linear_current));
1875 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
1876 dumpops, pvlim);
1877 }
1878 if (meta->mro_nextmethod) {
1879 Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
1880 PTR2UV(meta->mro_nextmethod));
1881 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
1882 dumpops, pvlim);
1883 }
1884 if (meta->isa) {
1885 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
1886 PTR2UV(meta->isa));
1887 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
1888 dumpops, pvlim);
1889 }
1890 }
86f55936 1891 }
b5698553 1892 if (nest < maxnest) {
cbab3169 1893 HV * const hv = MUTABLE_HV(sv);
b5698553
TH
1894 STRLEN i;
1895 HE *he;
cbab3169 1896
b5698553
TH
1897 if (HvARRAY(hv)) {
1898 int count = maxnest - nest;
1899 for (i=0; i <= HvMAX(hv); i++) {
1900 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
1901 U32 hash;
1902 SV * keysv;
1903 const char * keypv;
1904 SV * elt;
7dc86639 1905 STRLEN len;
b5698553
TH
1906
1907 if (count-- <= 0) goto DONEHV;
1908
1909 hash = HeHASH(he);
1910 keysv = hv_iterkeysv(he);
1911 keypv = SvPV_const(keysv, len);
1912 elt = HeVAL(he);
cbab3169 1913
7dc86639
YO
1914 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
1915 if (SvUTF8(keysv))
1916 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
b5698553
TH
1917 if (HvEITER_get(hv) == he)
1918 PerlIO_printf(file, "[CURRENT] ");
7dc86639
YO
1919 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
1920 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
1921 }
b5698553
TH
1922 }
1923 DONEHV:;
1924 }
3967c732
JD
1925 }
1926 break;
5d27ee4a 1927 } /* case SVt_PVHV */
e0bbf362 1928
3967c732 1929 case SVt_PVCV:
8fa6a409 1930 if (CvAUTOLOAD(sv)) {
0eb335df
BF
1931 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1932 STRLEN len;
8fa6a409 1933 const char *const name = SvPV_const(sv, len);
0eb335df
BF
1934 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
1935 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
8fa6a409
FC
1936 }
1937 if (SvPOK(sv)) {
0eb335df
BF
1938 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1939 const char *const proto = CvPROTO(sv);
1940 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
1941 generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
1942 SvUTF8(sv)));
cbf82dd0 1943 }
924ba076 1944 /* FALLTHROUGH */
3967c732
JD
1945 case SVt_PVFM:
1946 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC
1947 if (!CvISXSUB(sv)) {
1948 if (CvSTART(sv)) {
1949 Perl_dump_indent(aTHX_ level, file,
1950 " START = 0x%"UVxf" ===> %"IVdf"\n",
1951 PTR2UV(CvSTART(sv)),
1952 (IV)sequence_num(CvSTART(sv)));
1953 }
1954 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
1955 PTR2UV(CvROOT(sv)));
1956 if (CvROOT(sv) && dumpops) {
1957 do_op_dump(level+1, file, CvROOT(sv));
1958 }
1959 } else {
126f53f3 1960 SV * const constant = cv_const_sv((const CV *)sv);
b1886099 1961
d04ba589 1962 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
b1886099
NC
1963
1964 if (constant) {
1965 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
1966 " (CONST SV)\n",
1967 PTR2UV(CvXSUBANY(sv).any_ptr));
1968 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
1969 pvlim);
1970 } else {
1971 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
1972 (IV)CvXSUBANY(sv).any_i32);
1973 }
1974 }
3610c89f
FC
1975 if (CvNAMED(sv))
1976 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
1977 HEK_KEY(CvNAME_HEK((CV *)sv)));
1978 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 1979 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
bb02a38f 1980 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
894356b3 1981 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
a3985cdc 1982 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
57def98f 1983 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
dd2155a4
DM
1984 if (nest < maxnest) {
1985 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
3967c732
JD
1986 }
1987 {
b9ac451d 1988 const CV * const outside = CvOUTSIDE(sv);
2ef28da1 1989 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
57def98f 1990 PTR2UV(outside),
cf2093f6
JH
1991 (!outside ? "null"
1992 : CvANON(outside) ? "ANON"
1993 : (outside == PL_main_cv) ? "MAIN"
1994 : CvUNIQUE(outside) ? "UNIQUE"
b24fda9d
BF
1995 : CvGV(outside) ?
1996 generic_pv_escape(
1997 newSVpvs_flags("", SVs_TEMP),
1998 GvNAME(CvGV(outside)),
1999 GvNAMELEN(CvGV(outside)),
2000 GvNAMEUTF8(CvGV(outside)))
2001 : "UNDEFINED"));
3967c732
JD
2002 }
2003 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
ad64d0ec 2004 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
3967c732 2005 break;
e0bbf362 2006
926fc7b6
DM
2007 case SVt_PVGV:
2008 case SVt_PVLV:
b9ac451d
AL
2009 if (type == SVt_PVLV) {
2010 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2011 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2012 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2013 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
83f78d1a 2014 Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
305b8651 2015 if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
b9ac451d
AL
2016 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2017 dumpops, pvlim);
2018 }
8d919b0a 2019 if (isREGEXP(sv)) goto dumpregexp;
926fc7b6
DM
2020 if (!isGV_with_GP(sv))
2021 break;
0eb335df
BF
2022 {
2023 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2024 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2025 generic_pv_escape(tmpsv, GvNAME(sv),
2026 GvNAMELEN(sv),
2027 GvNAMEUTF8(sv)));
2028 }
57def98f 2029 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
3967c732 2030 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
be108a01 2031 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
57def98f 2032 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
f472eb5c
GS
2033 if (!GvGP(sv))
2034 break;
57def98f
JH
2035 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2036 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2037 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2038 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2039 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2040 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2041 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2042 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
57def98f 2043 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
b195d487 2044 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
3967c732
JD
2045 do_gv_dump (level, file, " EGV", GvEGV(sv));
2046 break;
2047 case SVt_PVIO:
57def98f
JH
2048 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2049 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2050 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2051 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2052 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2053 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2054 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
27533608 2055 if (IoTOP_NAME(sv))
cea2e8a9 2056 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC
2057 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2058 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2059 else {
2060 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2061 PTR2UV(IoTOP_GV(sv)));
ad64d0ec
NC
2062 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2063 maxnest, dumpops, pvlim);
9ba1f565
NC
2064 }
2065 /* Source filters hide things that are not GVs in these three, so let's
2066 be careful out there. */
27533608 2067 if (IoFMT_NAME(sv))
cea2e8a9 2068 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC
2069 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2070 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2071 else {
2072 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2073 PTR2UV(IoFMT_GV(sv)));
ad64d0ec
NC
2074 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2075 maxnest, dumpops, pvlim);
9ba1f565 2076 }
27533608 2077 if (IoBOTTOM_NAME(sv))
cea2e8a9 2078 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC
2079 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2080 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2081 else {
2082 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2083 PTR2UV(IoBOTTOM_GV(sv)));
ad64d0ec
NC
2084 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2085 maxnest, dumpops, pvlim);
9ba1f565 2086 }
27533608 2087 if (isPRINT(IoTYPE(sv)))
cea2e8a9 2088 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 2089 else
cea2e8a9 2090 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
57def98f 2091 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
3967c732 2092 break;
206ee256 2093 case SVt_REGEXP:
8d919b0a 2094 dumpregexp:
d63e6659 2095 {
8d919b0a 2096 struct regexp * const r = ReANY((REGEXP*)sv);
e3e400ec
YO
2097
2098#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
ec16d31f 2099 sv_setpv(d,""); \
e3e400ec 2100 append_flags(d, flags, names); \
ec16d31f
YO
2101 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2102 SvCUR_set(d, SvCUR(d) - 1); \
2103 SvPVX(d)[SvCUR(d)] = '\0'; \
2104 } \
2105} STMT_END
e3e400ec 2106 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
dbc200c5
YO
2107 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2108 (UV)(r->compflags), SvPVX_const(d));
2109
e3e400ec 2110 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
d63e6659 2111 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
dbc200c5
YO
2112 (UV)(r->extflags), SvPVX_const(d));
2113
e3e400ec
YO
2114 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
2115 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2116 if (r->engine == &PL_core_reg_engine) {
2117 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
2118 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
2119 (UV)(r->intflags), SvPVX_const(d));
2120 } else {
2121 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
d63e6659 2122 (UV)(r->intflags));
e3e400ec
YO
2123 }
2124#undef SV_SET_STRINGIFY_REGEXP_FLAGS
d63e6659
DM
2125 Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2126 (UV)(r->nparens));
2127 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2128 (UV)(r->lastparen));
2129 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2130 (UV)(r->lastcloseparen));
2131 Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2132 (IV)(r->minlen));
2133 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2134 (IV)(r->minlenret));
2135 Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2136 (UV)(r->gofs));
2137 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2138 (UV)(r->pre_prefix));
d63e6659
DM
2139 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2140 (IV)(r->sublen));
6502e081
DM
2141 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2142 (IV)(r->suboffset));
2143 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2144 (IV)(r->subcoffset));
d63e6659
DM
2145 if (r->subbeg)
2146 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2147 PTR2UV(r->subbeg),
2148 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2149 else
2150 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
d63e6659
DM
2151 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2152 PTR2UV(r->mother_re));
01ffd0f1
FC
2153 if (nest < maxnest && r->mother_re)
2154 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2155 maxnest, dumpops, pvlim);
d63e6659
DM
2156 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2157 PTR2UV(r->paren_names));
2158 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2159 PTR2UV(r->substrs));
2160 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2161 PTR2UV(r->pprivate));
2162 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2163 PTR2UV(r->offs));
d63c20f2
DM
2164 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2165 PTR2UV(r->qr_anoncv));
db2c6cb3 2166#ifdef PERL_ANY_COW
d63e6659
DM
2167 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2168 PTR2UV(r->saved_copy));
2169#endif
2170 }
206ee256 2171 break;
3967c732 2172 }
5f954473 2173 SvREFCNT_dec_NN(d);
3967c732
JD
2174}
2175
36b1c95c
MH
2176/*
2177=for apidoc sv_dump
2178
2179Dumps the contents of an SV to the C<STDERR> filehandle.
2180
2181For an example of its output, see L<Devel::Peek>.
2182
2183=cut
2184*/
2185
3967c732 2186void
864dbfa3 2187Perl_sv_dump(pTHX_ SV *sv)
3967c732 2188{
7918f24d
NC
2189 PERL_ARGS_ASSERT_SV_DUMP;
2190
d1029faa
JP
2191 if (SvROK(sv))
2192 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2193 else
2194 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 2195}
bd16a5f0
IZ
2196
2197int
2198Perl_runops_debug(pTHX)
2199{
2200 if (!PL_op) {
9b387841 2201 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ
2202 return 0;
2203 }
2204
9f3673fb 2205 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 2206 do {
75d476e2
SM
2207#ifdef PERL_TRACE_OPS
2208 ++PL_op_exec_cnt[PL_op->op_type];
2209#endif
bd16a5f0 2210 if (PL_debug) {
b9ac451d 2211 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0
IZ
2212 PerlIO_printf(Perl_debug_log,
2213 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2214 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2215 PTR2UV(*PL_watchaddr));
d6721266
DM
2216 if (DEBUG_s_TEST_) {
2217 if (DEBUG_v_TEST_) {
2218 PerlIO_printf(Perl_debug_log, "\n");
2219 deb_stack_all();
2220 }
2221 else
2222 debstack();
2223 }
2224
2225
bd16a5f0
IZ
2226 if (DEBUG_t_TEST_) debop(PL_op);
2227 if (DEBUG_P_TEST_) debprof(PL_op);
2228 }
fe83c362
SM
2229
2230 OP_ENTRY_PROBE(OP_NAME(PL_op));
16c91539 2231 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
9f3673fb 2232 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
47c9d59f 2233 PERL_ASYNC_CHECK();
bd16a5f0
IZ
2234
2235 TAINT_NOT;
2236 return 0;
2237}
2238
2239I32
6867be6d 2240Perl_debop(pTHX_ const OP *o)
bd16a5f0 2241{
81d52ecd 2242 int count;
7918f24d
NC
2243
2244 PERL_ARGS_ASSERT_DEBOP;
2245
1045810a
IZ
2246 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2247 return 0;
2248
bd16a5f0
IZ
2249 Perl_deb(aTHX_ "%s", OP_NAME(o));
2250 switch (o->op_type) {
2251 case OP_CONST:
996c9baa 2252 case OP_HINTSEVAL:
6cefa69e 2253 /* With ITHREADS, consts are stored in the pad, and the right pad
7367e658 2254 * may not be active here, so check.
6cefa69e 2255 * Looks like only during compiling the pads are illegal.
7367e658 2256 */
6cefa69e
RU
2257#ifdef USE_ITHREADS
2258 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2259#endif
7367e658 2260 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
bd16a5f0
IZ
2261 break;
2262 case OP_GVSV:
2263 case OP_GV:
2264 if (cGVOPo_gv) {
b9ac451d 2265 SV * const sv = newSV(0);
bd61b366 2266 gv_fullname3(sv, cGVOPo_gv, NULL);
93524f2b 2267 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
5f954473 2268 SvREFCNT_dec_NN(sv);
bd16a5f0
IZ
2269 }
2270 else
2271 PerlIO_printf(Perl_debug_log, "(NULL)");
2272 break;
a7fd8ef6 2273
bd16a5f0
IZ
2274 case OP_PADSV:
2275 case OP_PADAV:
2276 case OP_PADHV:
a7fd8ef6
DM
2277 count = 1;
2278 goto dump_padop;
2279 case OP_PADRANGE:
2280 count = o->op_private & OPpPADRANGE_COUNTMASK;
2281 dump_padop:
bd16a5f0 2282 /* print the lexical's name */
a7fd8ef6
DM
2283 {
2284 CV * const cv = deb_curcv(cxstack_ix);
2285 SV *sv;
2286 PAD * comppad = NULL;
2287 int i;
2288
2289 if (cv) {
2290 PADLIST * const padlist = CvPADLIST(cv);
2291 comppad = *PadlistARRAY(padlist);
2292 }
2293 PerlIO_printf(Perl_debug_log, "(");
2294 for (i = 0; i < count; i++) {
2295 if (comppad &&
2296 (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2297 PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2298 else
2299 PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2300 (UV)o->op_targ+i);
2301 if (i < count-1)
2302 PerlIO_printf(Perl_debug_log, ",");
2303 }
2304 PerlIO_printf(Perl_debug_log, ")");
2305 }
bd16a5f0 2306 break;
a7fd8ef6 2307
bd16a5f0 2308 default:
091ab601 2309 break;
bd16a5f0
IZ
2310 }
2311 PerlIO_printf(Perl_debug_log, "\n");
2312 return 0;
2313}
2314
2315STATIC CV*
61f9802b 2316S_deb_curcv(pTHX_ const I32 ix)
bd16a5f0 2317{
b9ac451d 2318 const PERL_CONTEXT * const cx = &cxstack[ix];
bd16a5f0
IZ
2319 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2320 return cx->blk_sub.cv;
2321 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
676a678a 2322 return cx->blk_eval.cv;
bd16a5f0
IZ
2323 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2324 return PL_main_cv;
2325 else if (ix <= 0)
601f1833 2326 return NULL;
bd16a5f0
IZ
2327 else
2328 return deb_curcv(ix - 1);
2329}
2330
2331void
2332Perl_watch(pTHX_ char **addr)
2333{
7918f24d
NC
2334 PERL_ARGS_ASSERT_WATCH;
2335
bd16a5f0
IZ
2336 PL_watchaddr = addr;
2337 PL_watchok = *addr;
2338 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2339 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2340}
2341
2342STATIC void
e1ec3a88 2343S_debprof(pTHX_ const OP *o)
bd16a5f0 2344{
7918f24d
NC
2345 PERL_ARGS_ASSERT_DEBPROF;
2346
61f9802b 2347 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2348 return;
bd16a5f0 2349 if (!PL_profiledata)
a02a5408 2350 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ
2351 ++PL_profiledata[o->op_type];
2352}
2353
2354void
2355Perl_debprofdump(pTHX)
2356{
2357 unsigned i;
2358 if (!PL_profiledata)
2359 return;
2360 for (i = 0; i < MAXO; i++) {
2361 if (PL_profiledata[i])
2362 PerlIO_printf(Perl_debug_log,
2363 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2364 PL_op_name[i]);
2365 }
2366}
66610fdd 2367
3b721df9 2368
66610fdd
RGS
2369/*
2370 * Local variables:
2371 * c-indentation-style: bsd
2372 * c-basic-offset: 4
14d04a33 2373 * indent-tabs-mode: nil
66610fdd
RGS
2374 * End:
2375 *
14d04a33 2376 * ex: set ts=8 sts=4 sw=4 et:
37442d52 2377 */