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
Moving variables to their innermost scope.
[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 96
796b6530
KW		 97Escapes at most the first C<count> chars of C<pv> and puts the results into
98C<dsv> such that the size of the escaped string will not exceed C<max> chars
9a63e366 99and will not contain any incomplete escape sequences. The number of bytes
796b6530
KW		 100escaped will be returned in the C<STRLEN *escaped> parameter if it is not null.
101When the C<dsv> parameter is null no escaping actually occurs, but the number
4420a417 102of bytes that would be escaped were it not null will be calculated.
3df15adc 103
796b6530 104If flags contains C<PERL_PV_ESCAPE_QUOTE> then any double quotes in the string
ab3bbdeb 105will also be escaped.
3df15adc
YO		 106
107Normally the SV will be cleared before the escaped string is prepared,
796b6530 108but when C<PERL_PV_ESCAPE_NOCLEAR> is set this will not occur.
ab3bbdeb 109
796b6530
KW		 110If C<PERL_PV_ESCAPE_UNI> is set then the input string is treated as UTF-8
111if C<PERL_PV_ESCAPE_UNI_DETECT> is set then the input string is scanned
e5860534 112using C<is_utf8_string()> to determine if it is UTF-8.
ab3bbdeb 113
796b6530
KW		 114If C<PERL_PV_ESCAPE_ALL> is set then all input chars will be output
115using C<\x01F1> style escapes, otherwise if C<PERL_PV_ESCAPE_NONASCII> is set, only
951cbe24 116non-ASCII chars will be escaped using this style; otherwise, only chars above
681f01c2 117255 will be so escaped; other non printable chars will use octal or
72d33970 118common escaped patterns like C<\n>.
796b6530 119Otherwise, if C<PERL_PV_ESCAPE_NOBACKSLASH>
681f01c2 120then all chars below 255 will be treated as printable and
ab3bbdeb
YO		 121will be output as literals.
122
796b6530 123If C<PERL_PV_ESCAPE_FIRSTCHAR> is set then only the first char of the
72d33970 124string will be escaped, regardless of max. If the output is to be in hex,
c8536afa 125then it will be returned as a plain hex
72d33970 126sequence. Thus the output will either be a single char,
c8536afa 127an octal escape sequence, a special escape like C<\n> or a hex value.
3df15adc 128
796b6530
KW		 129If C<PERL_PV_ESCAPE_RE> is set then the escape char used will be a C<"%"> and
130not a C<"\\">. This is because regexes very often contain backslashed
131sequences, whereas C<"%"> is not a particularly common character in patterns.
44a2ac75 132
796b6530 133Returns a pointer to the escaped text as held by C<dsv>.
3df15adc
YO		 134
135=cut
136*/
ab3bbdeb 137#define PV_ESCAPE_OCTBUFSIZE 32
ddc5bc0f 138
3967c732 139char *
ddc5bc0f 140Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
ab3bbdeb
YO		 141 const STRLEN count, const STRLEN max,
142 STRLEN * const escaped, const U32 flags )
143{
61f9802b
AL		 144 const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
145 const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
44a2ac75 146 char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
ab3bbdeb
YO		 147 STRLEN wrote = 0; /* chars written so far */
148 STRLEN chsize = 0; /* size of data to be written */
149 STRLEN readsize = 1; /* size of data just read */
e5860534 150 bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this UTF-8 */
ddc5bc0f 151 const char *pv = str;
61f9802b 152 const char * const end = pv + count; /* end of string */
44a2ac75 153 octbuf[0] = esc;
ab3bbdeb 154
7918f24d
NC		 155 PERL_ARGS_ASSERT_PV_ESCAPE;
156
4420a417 157 if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) {
7fddd944 158 /* This won't alter the UTF-8 flag */
ed0faf2e 159 SvPVCLEAR(dsv);
7fddd944 160 }
ab3bbdeb 161
ddc5bc0f 162 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
ab3bbdeb
YO		 163 isuni = 1;
164
165 for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
4b88fb76 166 const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
ab3bbdeb
YO		 167 const U8 c = (U8)u & 0xFF;
168
681f01c2
KW		 169 if ( ( u > 255 )
170 || (flags & PERL_PV_ESCAPE_ALL)
0eb335df 171 || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM))))
681f01c2 172 {
ab3bbdeb
YO		 173 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
174 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
147e3846 175 "%" UVxf, u);
ab3bbdeb
YO		 176 else
177 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
0eb335df 178 ((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
147e3846
KW		 179 ? "%cx%02" UVxf
180 : "%cx{%02" UVxf "}", esc, u);
0eb335df 181
ab3bbdeb
YO		 182 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
183 chsize = 1;
184 } else {
44a2ac75
YO		 185 if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
186 chsize = 2;
ab3bbdeb 187 switch (c) {
44a2ac75 188
924ba076 189 case '\\' : /* FALLTHROUGH */
44a2ac75
YO		 190 case '%' : if ( c == esc ) {
191 octbuf[1] = esc;
192 } else {
193 chsize = 1;
194 }
195 break;
3df15adc
YO		 196 case '\v' : octbuf[1] = 'v'; break;
197 case '\t' : octbuf[1] = 't'; break;
198 case '\r' : octbuf[1] = 'r'; break;
199 case '\n' : octbuf[1] = 'n'; break;
200 case '\f' : octbuf[1] = 'f'; break;
44a2ac75 201 case '"' :
ab3bbdeb 202 if ( dq == '"' )
3df15adc 203 octbuf[1] = '"';
ab3bbdeb
YO		 204 else
205 chsize = 1;
44a2ac75 206 break;
3df15adc 207 default:
6f3289f0 208 if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
0eb335df 209 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
147e3846 210 isuni ? "%cx{%02" UVxf "}" : "%cx%02" UVxf,
0eb335df 211 esc, u);
6f3289f0
DM		 212 }
213 else if ((pv+readsize < end) && isDIGIT((U8)*(pv+readsize)))
214 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 215 "%c%03o", esc, c);
6f3289f0
DM		 216 else
217 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
44a2ac75 218 "%c%o", esc, c);
ab3bbdeb
YO		 219 }
220 } else {
44a2ac75 221 chsize = 1;
ab3bbdeb 222 }
44a2ac75
YO		 223 }
224 if ( max && (wrote + chsize > max) ) {
225 break;
ab3bbdeb 226 } else if (chsize > 1) {
4420a417
YO		 227 if (dsv)
228 sv_catpvn(dsv, octbuf, chsize);
44a2ac75 229 wrote += chsize;
3df15adc 230 } else {
951cbe24
KW		 231 /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
232 can be appended raw to the dsv. If dsv happens to be
7fddd944
NC		 233 UTF-8 then we need catpvf to upgrade them for us.
234 Or add a new API call sv_catpvc(). Think about that name, and
235 how to keep it clear that it's unlike the s of catpvs, which is
951cbe24 236 really an array of octets, not a string. */
4420a417
YO		 237 if (dsv)
238 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
3df15adc
YO		 239 wrote++;
240 }
ab3bbdeb
YO		 241 if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
242 break;
3967c732 243 }
ab3bbdeb
YO		 244 if (escaped != NULL)
245 *escaped= pv - str;
4420a417 246 return dsv ? SvPVX(dsv) : NULL;
ab3bbdeb
YO		 247}
248/*
87cea99e 249=for apidoc pv_pretty
ab3bbdeb
YO		 250
251Converts a string into something presentable, handling escaping via
796b6530 252C<pv_escape()> and supporting quoting and ellipses.
ab3bbdeb 253
796b6530 254If the C<PERL_PV_PRETTY_QUOTE> flag is set then the result will be
72d33970 255double quoted with any double quotes in the string escaped. Otherwise
796b6530 256if the C<PERL_PV_PRETTY_LTGT> flag is set then the result be wrapped in
ab3bbdeb 257angle brackets.
6cba11c8 258
796b6530 259If the C<PERL_PV_PRETTY_ELLIPSES> flag is set and not all characters in
95b611b0 260string were output then an ellipsis C<...> will be appended to the
72d33970 261string. Note that this happens AFTER it has been quoted.
6cba11c8 262
796b6530
KW		 263If C<start_color> is non-null then it will be inserted after the opening
264quote (if there is one) but before the escaped text. If C<end_color>
ab3bbdeb 265is non-null then it will be inserted after the escaped text but before
95b611b0 266any quotes or ellipses.
ab3bbdeb 267
796b6530 268Returns a pointer to the prettified text as held by C<dsv>.
6cba11c8 269
ab3bbdeb
YO		 270=cut
271*/
272
273char *
ddc5bc0f
YO		 274Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
275 const STRLEN max, char const * const start_color, char const * const end_color,
ab3bbdeb
YO		 276 const U32 flags )
277{
3602166e
FC		 278 const U8 *quotes = (U8*)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
279 (flags & PERL_PV_PRETTY_LTGT) ? "<>" : NULL);
ab3bbdeb 280 STRLEN escaped;
4420a417
YO		 281 STRLEN max_adjust= 0;
282 STRLEN orig_cur;
7918f24d
NC		 283
284 PERL_ARGS_ASSERT_PV_PRETTY;
285
881a015e 286 if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
4420a417 287 /* This won't alter the UTF-8 flag */
ed0faf2e 288 SvPVCLEAR(dsv);
881a015e 289 }
4420a417 290 orig_cur= SvCUR(dsv);
881a015e 291
4420a417
YO		 292 if ( quotes )
293 Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[0]);
ab3bbdeb
YO		 294
295 if ( start_color != NULL )
76f68e9b 296 sv_catpv(dsv, start_color);
4420a417
YO		 297
298 if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
299 if (quotes)
300 max_adjust += 2;
301 assert(max > max_adjust);
302 pv_escape( NULL, str, count, max - max_adjust, &escaped, flags );
303 if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
304 max_adjust += 3;
305 assert(max > max_adjust);
306 }
307
308 pv_escape( dsv, str, count, max - max_adjust, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
309
ab3bbdeb 310 if ( end_color != NULL )
76f68e9b 311 sv_catpv(dsv, end_color);
ab3bbdeb 312
4420a417
YO		 313 if ( quotes )
314 Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]);
ab3bbdeb 315
95b611b0 316 if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
76f68e9b 317 sv_catpvs(dsv, "...");
4420a417
YO		 318
319 if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
320 while( SvCUR(dsv) - orig_cur < max )
321 sv_catpvs(dsv," ");
322 }
ab3bbdeb 323
3df15adc
YO		 324 return SvPVX(dsv);
325}
326
327/*
328=for apidoc pv_display
329
3df15adc 330Similar to
3967c732 331
3df15adc
YO		 332 pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
333
334except that an additional "\0" will be appended to the string when
335len > cur and pv[cur] is "\0".
336
337Note that the final string may be up to 7 chars longer than pvlim.
338
339=cut
340*/
341
342char *
343Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
344{
7918f24d
NC		 345 PERL_ARGS_ASSERT_PV_DISPLAY;
346
ddc5bc0f 347 pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
3df15adc 348 if (len > cur && pv[cur] == '\0')
76f68e9b 349 sv_catpvs( dsv, "\\0");
e6abe6d8
JH		 350 return SvPVX(dsv);
351}
352
353char *
864dbfa3 354Perl_sv_peek(pTHX_ SV *sv)
3967c732 355{
27da23d5 356 dVAR;
aec46f14 357 SV * const t = sv_newmortal();
3967c732 358 int unref = 0;
5357ca29 359 U32 type;
3967c732 360
ed0faf2e 361 SvPVCLEAR(t);
3967c732
JD		 362 retry:
363 if (!sv) {
364 sv_catpv(t, "VOID");
365 goto finish;
366 }
8ee91b45
YO		 367 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
368 /* detect data corruption under memory poisoning */
3967c732
JD		 369 sv_catpv(t, "WILD");
370 goto finish;
371 }
7996736c 372 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
3967c732
JD		 373 if (sv == &PL_sv_undef) {
374 sv_catpv(t, "SV_UNDEF");
375 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
376 SVs_GMG|SVs_SMG|SVs_RMG)) &&
377 SvREADONLY(sv))
378 goto finish;
379 }
380 else if (sv == &PL_sv_no) {
381 sv_catpv(t, "SV_NO");
382 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
383 SVs_GMG|SVs_SMG|SVs_RMG)) &&
384 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
385 SVp_POK|SVp_NOK)) &&
386 SvCUR(sv) == 0 &&
659c4b96 387 SvNVX(sv) == 0.0)
3967c732
JD		 388 goto finish;
389 }
7996736c 390 else if (sv == &PL_sv_yes) {
3967c732
JD		 391 sv_catpv(t, "SV_YES");
392 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
393 SVs_GMG|SVs_SMG|SVs_RMG)) &&
394 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
395 SVp_POK|SVp_NOK)) &&
396 SvCUR(sv) == 1 &&
b15aece3 397 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
659c4b96 398 SvNVX(sv) == 1.0)
3967c732 399 goto finish;
7996736c
MHM		 400 }
401 else {
402 sv_catpv(t, "SV_PLACEHOLDER");
403 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
404 SVs_GMG|SVs_SMG|SVs_RMG)) &&
405 SvREADONLY(sv))
406 goto finish;
3967c732
JD		 407 }
408 sv_catpv(t, ":");
409 }
410 else if (SvREFCNT(sv) == 0) {
411 sv_catpv(t, "(");
412 unref++;
413 }
a3b4c9c6
DM		 414 else if (DEBUG_R_TEST_) {
415 int is_tmp = 0;
e8eb279c 416 SSize_t ix;
a3b4c9c6
DM		 417 /* is this SV on the tmps stack? */
418 for (ix=PL_tmps_ix; ix>=0; ix--) {
419 if (PL_tmps_stack[ix] == sv) {
420 is_tmp = 1;
421 break;
422 }
423 }
d5a163ad
DM		 424 if (is_tmp || SvREFCNT(sv) > 1) {
425 Perl_sv_catpvf(aTHX_ t, "<");
426 if (SvREFCNT(sv) > 1)
147e3846 427 Perl_sv_catpvf(aTHX_ t, "%" UVuf, (UV)SvREFCNT(sv));
d5a163ad
DM		 428 if (is_tmp)
429 Perl_sv_catpvf(aTHX_ t, "%s", SvTEMP(t) ? "T" : "t");
430 Perl_sv_catpvf(aTHX_ t, ">");
431 }
04932ac8
DM		 432 }
433
3967c732
JD		 434 if (SvROK(sv)) {
435 sv_catpv(t, "\\");
436 if (SvCUR(t) + unref > 10) {
b162af07 437 SvCUR_set(t, unref + 3);
3967c732
JD		 438 *SvEND(t) = '\0';
439 sv_catpv(t, "...");
440 goto finish;
441 }
ad64d0ec 442 sv = SvRV(sv);
3967c732
JD		 443 goto retry;
444 }
5357ca29
NC		 445 type = SvTYPE(sv);
446 if (type == SVt_PVCV) {
0eb335df
BF		 447 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
448 GV* gvcv = CvGV(sv);
c53e4eb5 449 Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
0eb335df
BF		 450 ? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
451 : "");
3967c732 452 goto finish;
5357ca29
NC		 453 } else if (type < SVt_LAST) {
454 sv_catpv(t, svshorttypenames[type]);
3967c732 455
5357ca29
NC		 456 if (type == SVt_NULL)
457 goto finish;
458 } else {
459 sv_catpv(t, "FREED");
3967c732 460 goto finish;
3967c732
JD		 461 }
462
463 if (SvPOKp(sv)) {
b15aece3 464 if (!SvPVX_const(sv))
3967c732
JD		 465 sv_catpv(t, "(null)");
466 else {
17605be7 467 SV * const tmp = newSVpvs("");
3967c732 468 sv_catpv(t, "(");
5115136b
DM		 469 if (SvOOK(sv)) {
470 STRLEN delta;
471 SvOOK_offset(sv, delta);
472 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
473 }
b15aece3 474 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
32639b87 475 if (SvUTF8(sv))
b2ff9928 476 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
e9569a7a 477 sv_uni_display(tmp, sv, 6 * SvCUR(sv),
c728cb41 478 UNI_DISPLAY_QQ));
17605be7 479 SvREFCNT_dec_NN(tmp);
3967c732
JD		 480 }
481 }
482 else if (SvNOKp(sv)) {
67d796ae 483 STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
147e3846 484 Perl_sv_catpvf(aTHX_ t, "(%" NVgf ")",SvNVX(sv));
67d796ae 485 RESTORE_LC_NUMERIC_UNDERLYING();
3967c732 486 }
57def98f 487 else if (SvIOKp(sv)) {
cf2093f6 488 if (SvIsUV(sv))
147e3846 489 Perl_sv_catpvf(aTHX_ t, "(%" UVuf ")", (UV)SvUVX(sv));
cf2093f6 490 else
147e3846 491 Perl_sv_catpvf(aTHX_ t, "(%" IVdf ")", (IV)SvIVX(sv));
25da4f38 492 }
3967c732
JD		 493 else
494 sv_catpv(t, "()");
2ef28da1 495
3967c732 496 finish:
61f9802b
AL		 497 while (unref--)
498 sv_catpv(t, ")");
9adb2837 499 if (TAINTING_get && sv && SvTAINTED(sv))
59b714e2 500 sv_catpv(t, " [tainted]");
8b6b16e7 501 return SvPV_nolen(t);
3967c732
JD		 502}
503
36b1c95c
MH		 504/*
505=head1 Debugging Utilities
506*/
507
508void
509Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
510{
511 va_list args;
512 PERL_ARGS_ASSERT_DUMP_INDENT;
513 va_start(args, pat);
514 dump_vindent(level, file, pat, &args);
515 va_end(args);
516}
517
518void
519Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
520{
36b1c95c
MH		 521 PERL_ARGS_ASSERT_DUMP_VINDENT;
522 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
523 PerlIO_vprintf(file, pat, *args);
524}
525
cd6e4874
DM		 526
527/* Like Perl_dump_indent(), but specifically for ops: adds a vertical bar
528 * for each indent level as appropriate.
529 *
530 * bar contains bits indicating which indent columns should have a
531 * vertical bar displayed. Bit 0 is the RH-most column. If there are more
532 * levels than bits in bar, then the first few indents are displayed
533 * without a bar.
534 *
535 * The start of a new op is signalled by passing a value for level which
536 * has been negated and offset by 1 (so that level 0 is passed as -1 and
537 * can thus be distinguished from -0); in this case, emit a suitably
538 * indented blank line, then on the next line, display the op's sequence
539 * number, and make the final indent an '+----'.
540 *
541 * e.g.
542 *
543 * | FOO # level = 1, bar = 0b1
544 * | | # level =-2-1, bar = 0b11
545 * 1234 | +---BAR
546 * | BAZ # level = 2, bar = 0b10
547 */
548
549static void
550S_opdump_indent(pTHX_ const OP *o, I32 level, UV bar, PerlIO *file,
551 const char* pat, ...)
552{
553 va_list args;
554 I32 i;
555 bool newop = (level < 0);
556
557 va_start(args, pat);
558
559 /* start displaying a new op? */
560 if (newop) {
561 UV seq = sequence_num(o);
562
563 level = -level - 1;
564
565 /* output preceding blank line */
566 PerlIO_puts(file, " ");
567 for (i = level-1; i >= 0; i--)
568 PerlIO_puts(file, i == 0 || (bar & (1 << i)) ? "| " : " ");
569 PerlIO_puts(file, "\n");
570
571 /* output sequence number */
572 if (seq)
573 PerlIO_printf(file, "%-4" UVuf " ", seq);
574 else
575 PerlIO_puts(file, "???? ");
576
577 }
578 else
579 PerlIO_printf(file, " ");
580
581 for (i = level-1; i >= 0; i--)
582 PerlIO_puts(file,
583 (i == 0 && newop) ? "+--"
584 : (bar & (1 << i)) ? "| "
585 : " ");
586 PerlIO_vprintf(file, pat, args);
587 va_end(args);
588}
589
590
591/* display a link field (e.g. op_next) in the format
592 * ====> sequence_number [opname 0x123456]
593 */
594
595static void
596S_opdump_link(pTHX_ const OP *o, PerlIO *file)
597{
598 PerlIO_puts(file, " ===> ");
599 if (o)
600 PerlIO_printf(file, "%" UVuf " [%s 0x%" UVxf "]\n",
601 sequence_num(o), OP_NAME(o), PTR2UV(o));
602 else
603 PerlIO_puts(file, "[0x0]\n");
604}
605
36b1c95c
MH		 606/*
607=for apidoc dump_all
608
609Dumps the entire optree of the current program starting at C<PL_main_root> to
72d33970
FC		 610C<STDERR>. Also dumps the optrees for all visible subroutines in
611C<PL_defstash>.
36b1c95c
MH		 612
613=cut
614*/
615
616void
617Perl_dump_all(pTHX)
618{
619 dump_all_perl(FALSE);
620}
621
622void
623Perl_dump_all_perl(pTHX_ bool justperl)
624{
36b1c95c
MH		 625 PerlIO_setlinebuf(Perl_debug_log);
626 if (PL_main_root)
627 op_dump(PL_main_root);
628 dump_packsubs_perl(PL_defstash, justperl);
629}
630
631/*
632=for apidoc dump_packsubs
633
634Dumps the optrees for all visible subroutines in C<stash>.
635
636=cut
637*/
638
639void
640Perl_dump_packsubs(pTHX_ const HV *stash)
641{
642 PERL_ARGS_ASSERT_DUMP_PACKSUBS;
643 dump_packsubs_perl(stash, FALSE);
644}
645
646void
647Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
648{
36b1c95c
MH		 649 I32 i;
650
651 PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
652
653 if (!HvARRAY(stash))
654 return;
655 for (i = 0; i <= (I32) HvMAX(stash); i++) {
656 const HE *entry;
657 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
66103581
DM		 658 GV * gv = (GV *)HeVAL(entry);
659 if (SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV)
660 /* unfake a fake GV */
661 (void)CvGV(SvRV(gv));
36b1c95c
MH		 662 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
663 continue;
664 if (GvCVu(gv))
665 dump_sub_perl(gv, justperl);
666 if (GvFORM(gv))
667 dump_form(gv);
668 if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
669 const HV * const hv = GvHV(gv);
670 if (hv && (hv != PL_defstash))
671 dump_packsubs_perl(hv, justperl); /* nested package */
672 }
673 }
674 }
675}
676
677void
678Perl_dump_sub(pTHX_ const GV *gv)
679{
680 PERL_ARGS_ASSERT_DUMP_SUB;
681 dump_sub_perl(gv, FALSE);
682}
683
684void
685Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
686{
27b4ba23 687 CV *cv;
36b1c95c
MH		 688
689 PERL_ARGS_ASSERT_DUMP_SUB_PERL;
690
27b4ba23
Z		 691 cv = isGV_with_GP(gv) ? GvCV(gv) :
692 (assert(SvROK((SV*)gv)), (CV*)SvRV((SV*)gv));
693 if (justperl && (CvISXSUB(cv) || !CvROOT(cv)))
36b1c95c
MH		 694 return;
695
27b4ba23
Z		 696 if (isGV_with_GP(gv)) {
697 SV * const namesv = newSVpvs_flags("", SVs_TEMP);
698 SV *escsv = newSVpvs_flags("", SVs_TEMP);
699 const char *namepv;
700 STRLEN namelen;
701 gv_fullname3(namesv, gv, NULL);
702 namepv = SvPV_const(namesv, namelen);
703 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
704 generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv)));
705 } else {
706 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = ");
707 }
708 if (CvISXSUB(cv))
147e3846 709 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n",
27b4ba23
Z		 710 PTR2UV(CvXSUB(cv)),
711 (int)CvXSUBANY(cv).any_i32);
712 else if (CvROOT(cv))
713 op_dump(CvROOT(cv));
36b1c95c
MH		 714 else
715 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
716}
717
718void
719Perl_dump_form(pTHX_ const GV *gv)
720{
721 SV * const sv = sv_newmortal();
722
723 PERL_ARGS_ASSERT_DUMP_FORM;
724
725 gv_fullname3(sv, gv, NULL);
726 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
727 if (CvROOT(GvFORM(gv)))
728 op_dump(CvROOT(GvFORM(gv)));
729 else
730 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
731}
732
733void
734Perl_dump_eval(pTHX)
735{
36b1c95c
MH		 736 op_dump(PL_eval_root);
737}
738
cd6e4874 739
e18c4116
DM		 740/* returns a temp SV displaying the name of a GV. Handles the case where
741 * a GV is in fact a ref to a CV */
742
743static SV *
744S_gv_display(pTHX_ GV *gv)
745{
abd07ec0 746 SV * const name = newSVpvs_flags("", SVs_TEMP);
e18c4116
DM		 747 if (gv) {
748 SV * const raw = newSVpvs_flags("", SVs_TEMP);
749 STRLEN len;
750 const char * rawpv;
751
752 if (isGV_with_GP(gv))
753 gv_fullname3(raw, gv, NULL);
754 else {
755 assert(SvROK(gv));
756 assert(SvTYPE(SvRV(gv)) == SVt_PVCV);
757 Perl_sv_catpvf(aTHX_ raw, "cv ref: %s",
758 SvPV_nolen_const(cv_name((CV *)SvRV(gv), name, 0)));
759 }
760 rawpv = SvPV_const(raw, len);
761 generic_pv_escape(name, rawpv, len, SvUTF8(raw));
762 }
763 else
764 sv_catpvs(name, "(NULL)");
765
766 return name;
767}
768
769
770
cd6e4874
DM		 771/* forward decl */
772static void
773S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o);
774
775
776static void
777S_do_pmop_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const PMOP *pm)
3967c732 778{
cd6e4874 779 UV kidbar;
7918f24d 780
8efda520 781 if (!pm)
3967c732 782 return;
cd6e4874
DM		 783
784 kidbar = ((bar << 1) | cBOOL(pm->op_flags & OPf_KIDS)) << 1;
785
f0d3f5ac
DM		 786 if (PM_GETRE(pm)) {
787 char ch = (pm->op_pmflags & PMf_ONCE) ? '?' : '/';
cd6e4874 788 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE %c%.*s%c\n",
2e2d70f2 789 ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch);
f0d3f5ac 790 }
3967c732 791 else
cd6e4874
DM		 792 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE (RUNTIME)\n");
793
794 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
795 SV * const tmpsv = pm_description(pm);
796 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMFLAGS = (%s)\n",
797 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
798 SvREFCNT_dec_NN(tmpsv);
799 }
5012eebe
DM		 800
801 if (pm->op_type == OP_SPLIT)
cd6e4874
DM		 802 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file,
803 "TARGOFF/GV = 0x%" UVxf "\n",
804 PTR2UV(pm->op_pmreplrootu.op_pmtargetgv));
5012eebe
DM		 805 else {
806 if (pm->op_pmreplrootu.op_pmreplroot) {
cd6e4874
DM		 807 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_REPL =\n");
808 S_do_op_dump_bar(aTHX_ level + 2,
809 (kidbar|cBOOL(OpHAS_SIBLING(pm->op_pmreplrootu.op_pmreplroot))),
810 file, pm->op_pmreplrootu.op_pmreplroot);
5012eebe 811 }
3967c732 812 }
5012eebe 813
68e2671b 814 if (pm->op_code_list) {
867940b8 815 if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
cd6e4874
DM		 816 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "CODE_LIST =\n");
817 S_do_op_dump_bar(aTHX_ level + 2,
818 (kidbar | cBOOL(OpHAS_SIBLING(pm->op_code_list))),
819 file, pm->op_code_list);
867940b8
DM		 820 }
821 else
cd6e4874
DM		 822 S_opdump_indent(aTHX_ (OP*)pm, level, bar, file,
823 "CODE_LIST = 0x%" UVxf "\n", PTR2UV(pm->op_code_list));
3967c732 824 }
3967c732
JD		 825}
826
cd6e4874
DM		 827
828void
829Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
830{
831 PERL_ARGS_ASSERT_DO_PMOP_DUMP;
832 S_do_pmop_dump_bar(aTHX_ level, 0, file, pm);
833}
834
835
a0c2f4dd
NC		 836const struct flag_to_name pmflags_flags_names[] = {
837 {PMf_CONST, ",CONST"},
838 {PMf_KEEP, ",KEEP"},
839 {PMf_GLOBAL, ",GLOBAL"},
840 {PMf_CONTINUE, ",CONTINUE"},
841 {PMf_RETAINT, ",RETAINT"},
842 {PMf_EVAL, ",EVAL"},
843 {PMf_NONDESTRUCT, ",NONDESTRUCT"},
d63c20f2 844 {PMf_HAS_CV, ",HAS_CV"},
2a92a973
DM		 845 {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
846 {PMf_IS_QR, ",IS_QR"}
a0c2f4dd
NC		 847};
848
b9ac451d 849static SV *
4199688e
AL		 850S_pm_description(pTHX_ const PMOP *pm)
851{
852 SV * const desc = newSVpvs("");
61f9802b 853 const REGEXP * const regex = PM_GETRE(pm);
4199688e
AL		 854 const U32 pmflags = pm->op_pmflags;
855
7918f24d
NC		 856 PERL_ARGS_ASSERT_PM_DESCRIPTION;
857
4199688e
AL		 858 if (pmflags & PMf_ONCE)
859 sv_catpv(desc, ",ONCE");
c737faaf
YO		 860#ifdef USE_ITHREADS
861 if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
862 sv_catpv(desc, ":USED");
863#else
864 if (pmflags & PMf_USED)
865 sv_catpv(desc, ":USED");
866#endif
c737faaf 867
68d4833d 868 if (regex) {
284167a5 869 if (RX_ISTAINTED(regex))
68d4833d 870 sv_catpv(desc, ",TAINTED");
07bc277f 871 if (RX_CHECK_SUBSTR(regex)) {
e3e400ec 872 if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
68d4833d 873 sv_catpv(desc, ",SCANFIRST");
07bc277f 874 if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
68d4833d
AB		 875 sv_catpv(desc, ",ALL");
876 }
dbc200c5
YO		 877 if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
878 sv_catpv(desc, ",SKIPWHITE");
4199688e 879 }
68d4833d 880
a0c2f4dd 881 append_flags(desc, pmflags, pmflags_flags_names);
4199688e
AL		 882 return desc;
883}
884
3967c732 885void
864dbfa3 886Perl_pmop_dump(pTHX_ PMOP *pm)
3967c732
JD		 887{
888 do_pmop_dump(0, Perl_debug_log, pm);
79072805
LW		 889}
890
b6f05621
DM		 891/* Return a unique integer to represent the address of op o.
892 * If it already exists in PL_op_sequence, just return it;
893 * otherwise add it.
894 * *** Note that this isn't thread-safe */
294b3b39 895
2814eb74 896STATIC UV
0bd48802 897S_sequence_num(pTHX_ const OP *o)
2814eb74 898{
27da23d5 899 dVAR;
2814eb74
PJ		 900 SV *op,
901 **seq;
93524f2b 902 const char *key;
2814eb74 903 STRLEN len;
b6f05621
DM		 904 if (!o)
905 return 0;
c0fd1b42 906 op = newSVuv(PTR2UV(o));
b6f05621 907 sv_2mortal(op);
93524f2b 908 key = SvPV_const(op, len);
b6f05621
DM		 909 if (!PL_op_sequence)
910 PL_op_sequence = newHV();
911 seq = hv_fetch(PL_op_sequence, key, len, 0);
912 if (seq)
913 return SvUV(*seq);
914 (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
915 return PL_op_seq;
2814eb74
PJ		 916}
917
f3574cc6
DM		 918
919
920
921
a0c2f4dd
NC		 922const struct flag_to_name op_flags_names[] = {
923 {OPf_KIDS, ",KIDS"},
924 {OPf_PARENS, ",PARENS"},
a0c2f4dd
NC		 925 {OPf_REF, ",REF"},
926 {OPf_MOD, ",MOD"},
65cccc5e 927 {OPf_STACKED, ",STACKED"},
a0c2f4dd
NC		 928 {OPf_SPECIAL, ",SPECIAL"}
929};
930
75a6ad4a 931
cd6e4874
DM		 932/* indexed by enum OPclass */
933const char * op_class_names[] = {
934 "NULL",
935 "OP",
936 "UNOP",
937 "BINOP",
938 "LOGOP",
939 "LISTOP",
940 "PMOP",
941 "SVOP",
942 "PADOP",
943 "PVOP",
944 "LOOP",
945 "COP",
946 "METHOP",
947 "UNOP_AUX",
948};
949
950
951/* dump an op and any children. level indicates the initial indent.
952 * The bits of bar indicate which indents should receive a vertical bar.
953 * For example if level == 5 and bar == 0b01101, then the indent prefix
954 * emitted will be (not including the <>'s):
955 *
956 * < | | | >
957 * 55554444333322221111
958 *
959 * For heavily nested output, the level may exceed the number of bits
960 * in bar; in this case the first few columns in the output will simply
961 * not have a bar, which is harmless.
962 */
963
964static void
965S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
79072805 966{
e15d5972
AL		 967 const OPCODE optype = o->op_type;
968
7918f24d
NC		 969 PERL_ARGS_ASSERT_DO_OP_DUMP;
970
cd6e4874
DM		 971 /* print op header line */
972
973 S_opdump_indent(aTHX_ o, -level-1, bar, file, "%s", OP_NAME(o));
974
975 if (optype == OP_NULL && o->op_targ)
976 PerlIO_printf(file, " (ex-%s)",PL_op_name[o->op_targ]);
977
978 PerlIO_printf(file, " %s(0x%" UVxf ")",
979 op_class_names[op_class(o)], PTR2UV(o));
980 S_opdump_link(aTHX_ o->op_next, file);
981
982 /* print op common fields */
983
984 if (o->op_targ && optype != OP_NULL)
985 S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n",
986 (long)o->op_targ);
a7fd8ef6 987
760f8c06
DM		 988 if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) {
989 SV * const tmpsv = newSVpvs("");
990 switch (o->op_flags & OPf_WANT) {
991 case OPf_WANT_VOID:
992 sv_catpv(tmpsv, ",VOID");
993 break;
994 case OPf_WANT_SCALAR:
995 sv_catpv(tmpsv, ",SCALAR");
996 break;
997 case OPf_WANT_LIST:
998 sv_catpv(tmpsv, ",LIST");
999 break;
1000 default:
1001 sv_catpv(tmpsv, ",UNKNOWN");
1002 break;
1003 }
1004 append_flags(tmpsv, o->op_flags, op_flags_names);
1005 if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED");
1006 if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
1007 if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
1008 if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
87b5a8b9 1009 if (o->op_moresib) sv_catpvs(tmpsv, ",MORESIB");
cd6e4874 1010 S_opdump_indent(aTHX_ o, level, bar, file, "FLAGS = (%s)\n",
760f8c06
DM		 1011 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
1012 }
1013
1014 if (o->op_private) {
f3574cc6
DM		 1015 U16 oppriv = o->op_private;
1016 I16 op_ix = PL_op_private_bitdef_ix[o->op_type];
1017 SV * tmpsv = NULL;
1018
1019 if (op_ix != -1) {
1020 U16 stop = 0;
1021 tmpsv = newSVpvs("");
1022 for (; !stop; op_ix++) {
1023 U16 entry = PL_op_private_bitdefs[op_ix];
1024 U16 bit = (entry >> 2) & 7;
1025 U16 ix = entry >> 5;
1026
1027 stop = (entry & 1);
1028
1029 if (entry & 2) {
1030 /* bitfield */
1031 I16 const *p = &PL_op_private_bitfields[ix];
1032 U16 bitmin = (U16) *p++;
1033 I16 label = *p++;
1034 I16 enum_label;
1035 U16 mask = 0;
1036 U16 i;
1037 U16 val;
1038
1039 for (i = bitmin; i<= bit; i++)
1040 mask |= (1<<i);
1041 bit = bitmin;
1042 val = (oppriv & mask);
1043
1044 if ( label != -1
1045 && PL_op_private_labels[label] == '-'
1046 && PL_op_private_labels[label+1] == '\0'
1047 )
1048 /* display as raw number */
1049 continue;
1050
1051 oppriv -= val;
1052 val >>= bit;
1053 enum_label = -1;
1054 while (*p != -1) {
1055 if (val == *p++) {
1056 enum_label = *p;
1057 break;
1058 }
1059 p++;
1060 }
1061 if (val == 0 && enum_label == -1)
1062 /* don't display anonymous zero values */
1063 continue;
1064
1065 sv_catpv(tmpsv, ",");
1066 if (label != -1) {
1067 sv_catpv(tmpsv, &PL_op_private_labels[label]);
1068 sv_catpv(tmpsv, "=");
1069 }
95268469 1070 if (enum_label == -1)
147e3846 1071 Perl_sv_catpvf(aTHX_ tmpsv, "0x%" UVxf, (UV)val);
95268469
DM		 1072 else
1073 sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
f3574cc6
DM		 1074
1075 }
1076 else {
1077 /* bit flag */
1078 if ( oppriv & (1<<bit)
1079 && !(PL_op_private_labels[ix] == '-'
1080 && PL_op_private_labels[ix+1] == '\0'))
1081 {
1082 oppriv -= (1<<bit);
1083 sv_catpv(tmpsv, ",");
1084 sv_catpv(tmpsv, &PL_op_private_labels[ix]);
1085 }
760f8c06 1086 }
760f8c06 1087 }
f3574cc6
DM		 1088 if (oppriv) {
1089 sv_catpv(tmpsv, ",");
147e3846 1090 Perl_sv_catpvf(aTHX_ tmpsv, "0x%" UVxf, (UV)oppriv);
760f8c06
DM		 1091 }
1092 }
f3574cc6 1093 if (tmpsv && SvCUR(tmpsv)) {
cd6e4874
DM		 1094 S_opdump_indent(aTHX_ o, level, bar, file, "PRIVATE = (%s)\n",
1095 SvPVX_const(tmpsv) + 1);
760f8c06 1096 } else
cd6e4874
DM		 1097 S_opdump_indent(aTHX_ o, level, bar, file,
1098 "PRIVATE = (0x%" UVxf ")\n", (UV)oppriv);
760f8c06
DM		 1099 }
1100
e15d5972 1101 switch (optype) {
971a9dd3 1102 case OP_AELEMFAST:
93a17b20 1103 case OP_GVSV:
79072805 1104 case OP_GV:
971a9dd3 1105#ifdef USE_ITHREADS
cd6e4874
DM		 1106 S_opdump_indent(aTHX_ o, level, bar, file,
1107 "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
971a9dd3 1108#else
e18c4116
DM		 1109 S_opdump_indent(aTHX_ o, level, bar, file,
1110 "GV = %" SVf " (0x%" UVxf ")\n",
1111 SVfARG(S_gv_display(aTHX_ cGVOPo_gv)), PTR2UV(cGVOPo_gv));
971a9dd3 1112#endif
79072805 1113 break;
fedf30e1
DM		 1114
1115 case OP_MULTIDEREF:
1116 {
1117 UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
1118 UV i, count = items[-1].uv;
1119
cd6e4874 1120 S_opdump_indent(aTHX_ o, level, bar, file, "ARGS = \n");
fedf30e1 1121 for (i=0; i < count; i++)
cd6e4874
DM		 1122 S_opdump_indent(aTHX_ o, level+1, (bar << 1), file,
1123 "%" UVuf " => 0x%" UVxf "\n",
fedf30e1 1124 i, items[i].uv);
1e9f2263 1125 break;
fedf30e1
DM		 1126 }
1127
79072805 1128 case OP_CONST:
996c9baa 1129 case OP_HINTSEVAL:
f5d5a27c 1130 case OP_METHOD_NAMED:
7d6c333c 1131 case OP_METHOD_SUPER:
810bd8b7 1132 case OP_METHOD_REDIR:
1133 case OP_METHOD_REDIR_SUPER:
b6a15bc5
DM		 1134#ifndef USE_ITHREADS
1135 /* with ITHREADS, consts are stored in the pad, and the right pad
1136 * may not be active here, so skip */
cd6e4874
DM		 1137 S_opdump_indent(aTHX_ o, level, bar, file, "SV = %s\n",
1138 SvPEEK(cMETHOPx_meth(o)));
b6a15bc5 1139#endif
79072805 1140 break;
5e412b02
FC		 1141 case OP_NULL:
1142 if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
1143 break;
1144 /* FALLTHROUGH */
93a17b20
LW		 1145 case OP_NEXTSTATE:
1146 case OP_DBSTATE:
57843af0 1147 if (CopLINE(cCOPo))
cd6e4874 1148 S_opdump_indent(aTHX_ o, level, bar, file, "LINE = %" UVuf "\n",
9d98dee5 1149 (UV)CopLINE(cCOPo));
5219f5ec
DM		 1150
1151 if (CopSTASHPV(cCOPo)) {
1152 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1153 HV *stash = CopSTASH(cCOPo);
1154 const char * const hvname = HvNAME_get(stash);
1155
1156 S_opdump_indent(aTHX_ o, level, bar, file, "PACKAGE = \"%s\"\n",
1157 generic_pv_escape(tmpsv, hvname,
1158 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1159 }
1160
1161 if (CopLABEL(cCOPo)) {
1162 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1163 STRLEN label_len;
1164 U32 label_flags;
1165 const char *label = CopLABEL_len_flags(cCOPo,
1166 &label_len, &label_flags);
1167 S_opdump_indent(aTHX_ o, level, bar, file, "LABEL = \"%s\"\n",
1168 generic_pv_escape( tmpsv, label, label_len,
1169 (label_flags & SVf_UTF8)));
1170 }
1171
cd6e4874 1172 S_opdump_indent(aTHX_ o, level, bar, file, "SEQ = %u\n",
947a9e0f 1173 (unsigned int)cCOPo->cop_seq);
79072805 1174 break;
cd6e4874
DM		 1175
1176 case OP_ENTERITER:
79072805 1177 case OP_ENTERLOOP:
cd6e4874
DM		 1178 S_opdump_indent(aTHX_ o, level, bar, file, "REDO");
1179 S_opdump_link(aTHX_ cLOOPo->op_redoop, file);
1180 S_opdump_indent(aTHX_ o, level, bar, file, "NEXT");
1181 S_opdump_link(aTHX_ cLOOPo->op_nextop, file);
1182 S_opdump_indent(aTHX_ o, level, bar, file, "LAST");
1183 S_opdump_link(aTHX_ cLOOPo->op_lastop, file);
79072805 1184 break;
cd6e4874
DM		 1185
1186 case OP_REGCOMP:
1187 case OP_SUBSTCONT:
79072805 1188 case OP_COND_EXPR:
1a67a97c 1189 case OP_RANGE:
a0d0e21e 1190 case OP_MAPWHILE:
79072805
LW		 1191 case OP_GREPWHILE:
1192 case OP_OR:
cd6e4874 1193 case OP_DOR:
79072805 1194 case OP_AND:
cd6e4874
DM		 1195 case OP_ORASSIGN:
1196 case OP_DORASSIGN:
1197 case OP_ANDASSIGN:
1198 case OP_ARGDEFELEM:
1199 case OP_ENTERGIVEN:
1200 case OP_ENTERWHEN:
1201 case OP_ENTERTRY:
1202 case OP_ONCE:
1203 S_opdump_indent(aTHX_ o, level, bar, file, "OTHER");
1204 S_opdump_link(aTHX_ cLOGOPo->op_other, file);
79072805 1205 break;
5012eebe 1206 case OP_SPLIT:
79072805 1207 case OP_MATCH:
8782bef2 1208 case OP_QR:
79072805 1209 case OP_SUBST:
cd6e4874 1210 S_do_pmop_dump_bar(aTHX_ level, bar, file, cPMOPo);
79072805 1211 break;
7934575e
GS		 1212 case OP_LEAVE:
1213 case OP_LEAVEEVAL:
1214 case OP_LEAVESUB:
1215 case OP_LEAVESUBLV:
1216 case OP_LEAVEWRITE:
1217 case OP_SCOPE:
1218 if (o->op_private & OPpREFCOUNTED)
cd6e4874
DM		 1219 S_opdump_indent(aTHX_ o, level, bar, file,
1220 "REFCNT = %" UVuf "\n", (UV)o->op_targ);
7934575e 1221 break;
abd07ec0
DM		 1222
1223 case OP_DUMP:
1224 case OP_GOTO:
1225 case OP_NEXT:
1226 case OP_LAST:
1227 case OP_REDO:
1228 if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
1229 break;
1230 /* FALLTHROUGH */
1231 case OP_TRANS:
1232 case OP_TRANSR:
1233 if ( (o->op_type == OP_TRANS || o->op_type == OP_TRANSR)
1234 && (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)))
1235 break;
1236
1237 {
1238 SV * const label = newSVpvs_flags("", SVs_TEMP);
1239 generic_pv_escape(label, cPVOPo->op_pv, strlen(cPVOPo->op_pv), 0);
1240 S_opdump_indent(aTHX_ o, level, bar, file,
1241 "PV = \"%" SVf "\" (0x%" UVxf ")\n",
1242 SVfARG(label), PTR2UV(cPVOPo->op_pv));
1243 }
1244
1245
a0d0e21e
LW		 1246 default:
1247 break;
79072805 1248 }
11343788 1249 if (o->op_flags & OPf_KIDS) {
79072805 1250 OP *kid;
cd6e4874
DM		 1251 level++;
1252 bar <<= 1;
e6dae479 1253 for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
cd6e4874
DM		 1254 S_do_op_dump_bar(aTHX_ level,
1255 (bar | cBOOL(OpHAS_SIBLING(kid))),
1256 file, kid);
8d063cd8 1257 }
3967c732
JD		 1258}
1259
cd6e4874
DM		 1260
1261void
1262Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
1263{
1264 S_do_op_dump_bar(aTHX_ level, 0, file, o);
1265}
1266
1267
36b1c95c
MH		 1268/*
1269=for apidoc op_dump
1270
1271Dumps the optree starting at OP C<o> to C<STDERR>.
1272
1273=cut
1274*/
1275
3967c732 1276void
6867be6d 1277Perl_op_dump(pTHX_ const OP *o)
3967c732 1278{
7918f24d 1279 PERL_ARGS_ASSERT_OP_DUMP;
3967c732 1280 do_op_dump(0, Perl_debug_log, o);
8d063cd8
LW		 1281}
1282
8adcabd8 1283void
864dbfa3 1284Perl_gv_dump(pTHX_ GV *gv)
378cc40b 1285{
0eb335df
BF		 1286 STRLEN len;
1287 const char* name;
1288 SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1289
79072805 1290 if (!gv) {
760ac839 1291 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b
LW		 1292 return;
1293 }
8990e307 1294 sv = sv_newmortal();
760ac839 1295 PerlIO_printf(Perl_debug_log, "{\n");
bd61b366 1296 gv_fullname3(sv, gv, NULL);
0eb335df
BF		 1297 name = SvPV_const(sv, len);
1298 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1299 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
79072805 1300 if (gv != GvEGV(gv)) {
bd61b366 1301 gv_efullname3(sv, GvEGV(gv), NULL);
0eb335df
BF		 1302 name = SvPV_const(sv, len);
1303 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1304 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
8adcabd8 1305 }
38d7fd8b 1306 (void)PerlIO_putc(Perl_debug_log, '\n');
cea2e8a9 1307 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
8d063cd8
LW		 1308}
1309
14befaf4 1310
afe38520 1311/* map magic types to the symbolic names
14befaf4
DM		 1312 * (with the PERL_MAGIC_ prefixed stripped)
1313 */
1314
27da23d5 1315static const struct { const char type; const char *name; } magic_names[] = {
16bc0f48 1316#include "mg_names.inc"
516a5887 1317 /* this null string terminates the list */
b9ac451d 1318 { 0, NULL },
14befaf4
DM		 1319};
1320
8adcabd8 1321void
6867be6d 1322Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
8d063cd8 1323{
7918f24d
NC		 1324 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1325
3967c732 1326 for (; mg; mg = mg->mg_moremagic) {
b900a521 1327 Perl_dump_indent(aTHX_ level, file,
147e3846 1328 " MAGIC = 0x%" UVxf "\n", PTR2UV(mg));
3967c732 1329 if (mg->mg_virtual) {
bfed75c6 1330 const MGVTBL * const v = mg->mg_virtual;
2d1f1fe5
NC		 1331 if (v >= PL_magic_vtables
1332 && v < PL_magic_vtables + magic_vtable_max) {
1333 const U32 i = v - PL_magic_vtables;
1334 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1335 }
3967c732 1336 else
147e3846
KW		 1337 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"
1338 UVxf "\n", PTR2UV(v));
3967c732
JD		 1339 }
1340 else
cea2e8a9 1341 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
8d063cd8 1342
3967c732 1343 if (mg->mg_private)
cea2e8a9 1344 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
3967c732 1345
14befaf4
DM		 1346 {
1347 int n;
c445ea15 1348 const char *name = NULL;
27da23d5 1349 for (n = 0; magic_names[n].name; n++) {
14befaf4
DM		 1350 if (mg->mg_type == magic_names[n].type) {
1351 name = magic_names[n].name;
1352 break;
1353 }
1354 }
1355 if (name)
1356 Perl_dump_indent(aTHX_ level, file,
1357 " MG_TYPE = PERL_MAGIC_%s\n", name);
1358 else
1359 Perl_dump_indent(aTHX_ level, file,
1360 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1361 }
3967c732
JD		 1362
1363 if (mg->mg_flags) {
cea2e8a9 1364 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
cb50f42d
YST		 1365 if (mg->mg_type == PERL_MAGIC_envelem &&
1366 mg->mg_flags & MGf_TAINTEDDIR)
cea2e8a9 1367 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
4c02285a
FR		 1368 if (mg->mg_type == PERL_MAGIC_regex_global &&
1369 mg->mg_flags & MGf_MINMATCH)
1370 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
3967c732 1371 if (mg->mg_flags & MGf_REFCOUNTED)
cea2e8a9 1372 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
3967c732 1373 if (mg->mg_flags & MGf_GSKIP)
cea2e8a9 1374 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
4c02285a
FR		 1375 if (mg->mg_flags & MGf_COPY)
1376 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1377 if (mg->mg_flags & MGf_DUP)
1378 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1379 if (mg->mg_flags & MGf_LOCAL)
1380 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
25fdce4a
FC		 1381 if (mg->mg_type == PERL_MAGIC_regex_global &&
1382 mg->mg_flags & MGf_BYTES)
1383 Perl_dump_indent(aTHX_ level, file, " BYTES\n");
3967c732
JD		 1384 }
1385 if (mg->mg_obj) {
147e3846 1386 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%" UVxf "\n",
28d8d7f4
YO		 1387 PTR2UV(mg->mg_obj));
1388 if (mg->mg_type == PERL_MAGIC_qr) {
07bc277f 1389 REGEXP* const re = (REGEXP *)mg->mg_obj;
61f9802b 1390 SV * const dsv = sv_newmortal();
866c78d1 1391 const char * const s
4c02285a 1392 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
28d8d7f4 1393 60, NULL, NULL,
95b611b0 1394 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
3c8556c3 1395 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
28d8d7f4 1396 );
6483fb35 1397 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
147e3846 1398 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %" IVdf "\n",
07bc277f 1399 (IV)RX_REFCNT(re));
28d8d7f4
YO		 1400 }
1401 if (mg->mg_flags & MGf_REFCOUNTED)
3967c732
JD		 1402 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1403 }
1404 if (mg->mg_len)
894356b3 1405 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
3967c732 1406 if (mg->mg_ptr) {
147e3846 1407 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%" UVxf, PTR2UV(mg->mg_ptr));
3967c732 1408 if (mg->mg_len >= 0) {
7e8c5dac 1409 if (mg->mg_type != PERL_MAGIC_utf8) {
17605be7 1410 SV * const sv = newSVpvs("");
7e8c5dac 1411 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
17605be7 1412 SvREFCNT_dec_NN(sv);
7e8c5dac 1413 }
3967c732
JD		 1414 }
1415 else if (mg->mg_len == HEf_SVKEY) {
1416 PerlIO_puts(file, " => HEf_SVKEY\n");
ad64d0ec
NC		 1417 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1418 maxnest, dumpops, pvlim); /* MG is already +1 */
3967c732
JD		 1419 continue;
1420 }
866f9d6c 1421 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
3967c732 1422 else
866f9d6c
FC		 1423 PerlIO_puts(
1424 file,
1425 " ???? - " __FILE__
1426 " does not know how to handle this MG_LEN"
1427 );
38d7fd8b 1428 (void)PerlIO_putc(file, '\n');
3967c732 1429 }
7e8c5dac 1430 if (mg->mg_type == PERL_MAGIC_utf8) {
61f9802b 1431 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
7e8c5dac
HS		 1432 if (cache) {
1433 IV i;
1434 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1435 Perl_dump_indent(aTHX_ level, file,
147e3846 1436 " %2" IVdf ": %" UVuf " -> %" UVuf "\n",
7e8c5dac
HS		 1437 i,
1438 (UV)cache[i * 2],
1439 (UV)cache[i * 2 + 1]);
1440 }
1441 }
378cc40b 1442 }
3967c732
JD		 1443}
1444
1445void
6867be6d 1446Perl_magic_dump(pTHX_ const MAGIC *mg)
3967c732 1447{
b9ac451d 1448 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
3967c732
JD		 1449}
1450
1451void
e1ec3a88 1452Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
3967c732 1453{
bfcb3514 1454 const char *hvname;
7918f24d
NC		 1455
1456 PERL_ARGS_ASSERT_DO_HV_DUMP;
1457
147e3846 1458 Perl_dump_indent(aTHX_ level, file, "%s = 0x%" UVxf, name, PTR2UV(sv));
bfcb3514 1459 if (sv && (hvname = HvNAME_get(sv)))
d7d51f4b
YO		 1460 {
1461 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1462 name which quite legally could contain insane things like tabs, newlines, nulls or
1463 other scary crap - this should produce sane results - except maybe for unicode package
1464 names - but we will wait for someone to file a bug on that - demerphq */
0eb335df
BF		 1465 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1466 PerlIO_printf(file, "\t\"%s\"\n",
1467 generic_pv_escape( tmpsv, hvname,
1468 HvNAMELEN(sv), HvNAMEUTF8(sv)));
d7d51f4b 1469 }
79072805 1470 else
38d7fd8b 1471 (void)PerlIO_putc(file, '\n');
3967c732
JD		 1472}
1473
1474void
e1ec3a88 1475Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1476{
7918f24d
NC		 1477 PERL_ARGS_ASSERT_DO_GV_DUMP;
1478
147e3846 1479 Perl_dump_indent(aTHX_ level, file, "%s = 0x%" UVxf, name, PTR2UV(sv));
0eb335df
BF		 1480 if (sv && GvNAME(sv)) {
1481 SV * const tmpsv = newSVpvs("");
1482 PerlIO_printf(file, "\t\"%s\"\n",
1483 generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1484 }
c90c0ff4 1485 else
38d7fd8b 1486 (void)PerlIO_putc(file, '\n');
3967c732
JD		 1487}
1488
1489void
e1ec3a88 1490Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
3967c732 1491{
7918f24d
NC		 1492 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1493
147e3846 1494 Perl_dump_indent(aTHX_ level, file, "%s = 0x%" UVxf, name, PTR2UV(sv));
3967c732 1495 if (sv && GvNAME(sv)) {
0eb335df 1496 SV *tmp = newSVpvs_flags("", SVs_TEMP);
bfcb3514 1497 const char *hvname;
0eb335df
BF		 1498 HV * const stash = GvSTASH(sv);
1499 PerlIO_printf(file, "\t");
6f3289f0 1500 /* TODO might have an extra \" here */
0eb335df
BF		 1501 if (stash && (hvname = HvNAME_get(stash))) {
1502 PerlIO_printf(file, "\"%s\" :: \"",
1503 generic_pv_escape(tmp, hvname,
1504 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1505 }
1506 PerlIO_printf(file, "%s\"\n",
1507 generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
8d063cd8 1508 }
3967c732 1509 else
38d7fd8b 1510 (void)PerlIO_putc(file, '\n');
3967c732
JD		 1511}
1512
a0c2f4dd
NC		 1513const struct flag_to_name first_sv_flags_names[] = {
1514 {SVs_TEMP, "TEMP,"},
1515 {SVs_OBJECT, "OBJECT,"},
1516 {SVs_GMG, "GMG,"},
1517 {SVs_SMG, "SMG,"},
1518 {SVs_RMG, "RMG,"},
1519 {SVf_IOK, "IOK,"},
1520 {SVf_NOK, "NOK,"},
1521 {SVf_POK, "POK,"}
1522};
1523
1524const struct flag_to_name second_sv_flags_names[] = {
1525 {SVf_OOK, "OOK,"},
1526 {SVf_FAKE, "FAKE,"},
1527 {SVf_READONLY, "READONLY,"},
fd01b4b7 1528 {SVf_PROTECT, "PROTECT,"},
a0c2f4dd 1529 {SVf_BREAK, "BREAK,"},
a0c2f4dd
NC		 1530 {SVp_IOK, "pIOK,"},
1531 {SVp_NOK, "pNOK,"},
1532 {SVp_POK, "pPOK,"}
1533};
1534
ae1f06a1
NC		 1535const struct flag_to_name cv_flags_names[] = {
1536 {CVf_ANON, "ANON,"},
1537 {CVf_UNIQUE, "UNIQUE,"},
1538 {CVf_CLONE, "CLONE,"},
1539 {CVf_CLONED, "CLONED,"},
1540 {CVf_CONST, "CONST,"},
1541 {CVf_NODEBUG, "NODEBUG,"},
1542 {CVf_LVALUE, "LVALUE,"},
1543 {CVf_METHOD, "METHOD,"},
cfc1e951 1544 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
31d45e0c 1545 {CVf_CVGV_RC, "CVGV_RC,"},
bad4ae38 1546 {CVf_DYNFILE, "DYNFILE,"},
8fa6a409 1547 {CVf_AUTOLOAD, "AUTOLOAD,"},
e4555ecf 1548 {CVf_HASEVAL, "HASEVAL,"},
bfbc3ad9 1549 {CVf_SLABBED, "SLABBED,"},
bf9a4d2d 1550 {CVf_NAMED, "NAMED,"},
82487b59 1551 {CVf_LEXICAL, "LEXICAL,"},
31d45e0c 1552 {CVf_ISXSUB, "ISXSUB,"}
ae1f06a1
NC		 1553};
1554
1555const struct flag_to_name hv_flags_names[] = {
1556 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1557 {SVphv_LAZYDEL, "LAZYDEL,"},
1558 {SVphv_HASKFLAGS, "HASKFLAGS,"},
45eaf8af 1559 {SVf_AMAGIC, "OVERLOAD,"},
ae1f06a1
NC		 1560 {SVphv_CLONEABLE, "CLONEABLE,"}
1561};
1562
1563const struct flag_to_name gp_flags_names[] = {
1564 {GVf_INTRO, "INTRO,"},
1565 {GVf_MULTI, "MULTI,"},
1566 {GVf_ASSUMECV, "ASSUMECV,"},
ae1f06a1
NC		 1567};
1568
1569const struct flag_to_name gp_flags_imported_names[] = {
1570 {GVf_IMPORTED_SV, " SV"},
1571 {GVf_IMPORTED_AV, " AV"},
1572 {GVf_IMPORTED_HV, " HV"},
1573 {GVf_IMPORTED_CV, " CV"},
1574};
1575
0d331aaf
YO		 1576/* NOTE: this structure is mostly duplicative of one generated by
1577 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1578 * the two. - Yves */
e3e400ec 1579const struct flag_to_name regexp_extflags_names[] = {
d63e6659
DM		 1580 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1581 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1582 {RXf_PMf_FOLD, "PMf_FOLD,"},
1583 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
334afb3e 1584 {RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
d63e6659 1585 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
41d7c59e 1586 {RXf_PMf_NOCAPTURE, "PMf_NOCAPURE,"},
8e1490ee 1587 {RXf_IS_ANCHORED, "IS_ANCHORED,"},
dbc200c5 1588 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
d63e6659 1589 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
d63e6659
DM		 1590 {RXf_CHECK_ALL, "CHECK_ALL,"},
1591 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1592 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1593 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1594 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
dbc200c5 1595 {RXf_SPLIT, "SPLIT,"},
d63e6659
DM		 1596 {RXf_COPY_DONE, "COPY_DONE,"},
1597 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1598 {RXf_TAINTED, "TAINTED,"},
1599 {RXf_START_ONLY, "START_ONLY,"},
dbc200c5 1600 {RXf_SKIPWHITE, "SKIPWHITE,"},
d63e6659
DM		 1601 {RXf_WHITE, "WHITE,"},
1602 {RXf_NULL, "NULL,"},
1603};
1604
0d331aaf
YO		 1605/* NOTE: this structure is mostly duplicative of one generated by
1606 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1607 * the two. - Yves */
e3e400ec
YO		 1608const struct flag_to_name regexp_core_intflags_names[] = {
1609 {PREGf_SKIP, "SKIP,"},
0d331aaf
YO		 1610 {PREGf_IMPLICIT, "IMPLICIT,"},
1611 {PREGf_NAUGHTY, "NAUGHTY,"},
e3e400ec
YO		 1612 {PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
1613 {PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
0d331aaf 1614 {PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
e3e400ec 1615 {PREGf_NOSCAN, "NOSCAN,"},
58430ea8
YO		 1616 {PREGf_GPOS_SEEN, "GPOS_SEEN,"},
1617 {PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
8e1490ee
YO		 1618 {PREGf_ANCH_MBOL, "ANCH_MBOL,"},
1619 {PREGf_ANCH_SBOL, "ANCH_SBOL,"},
1620 {PREGf_ANCH_GPOS, "ANCH_GPOS,"},
e3e400ec
YO		 1621};
1622
c24d0595
DM		 1623/* Perl_do_sv_dump():
1624 *
1625 * level: amount to indent the output
1626 * sv: the object to dump
1627 * nest: the current level of recursion
1628 * maxnest: the maximum allowed level of recursion
1629 * dumpops: if true, also dump the ops associated with a CV
1630 * pvlim: limit on the length of any strings that are output
1631 * */
1632
3967c732 1633void
864dbfa3 1634Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
3967c732 1635{
cea89e20 1636 SV *d;
e1ec3a88 1637 const char *s;
3967c732
JD		 1638 U32 flags;
1639 U32 type;
1640
7918f24d
NC		 1641 PERL_ARGS_ASSERT_DO_SV_DUMP;
1642
3967c732 1643 if (!sv) {
cea2e8a9 1644 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
3967c732 1645 return;
378cc40b 1646 }
2ef28da1 1647
3967c732
JD		 1648 flags = SvFLAGS(sv);
1649 type = SvTYPE(sv);
79072805 1650
e0bbf362
DM		 1651 /* process general SV flags */
1652
cea89e20 1653 d = Perl_newSVpvf(aTHX_
147e3846 1654 "(0x%" UVxf ") at 0x%" UVxf "\n%*s REFCNT = %" IVdf "\n%*s FLAGS = (",
56431972 1655 PTR2UV(SvANY(sv)), PTR2UV(sv),
894356b3
GS		 1656 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1657 (int)(PL_dumpindent*level), "");
8d063cd8 1658
0f94cb1f 1659 if ((flags & SVs_PADSTALE))
9a214eec 1660 sv_catpv(d, "PADSTALE,");
0f94cb1f 1661 if ((flags & SVs_PADTMP))
9a214eec 1662 sv_catpv(d, "PADTMP,");
a0c2f4dd 1663 append_flags(d, flags, first_sv_flags_names);
810b8aa5
GS		 1664 if (flags & SVf_ROK) {
1665 sv_catpv(d, "ROK,");
1666 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1667 }
45eaf8af 1668 if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
a0c2f4dd 1669 append_flags(d, flags, second_sv_flags_names);
7db6405c
FC		 1670 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1671 && type != SVt_PVAV) {
1ccdb730
NC		 1672 if (SvPCS_IMPORTED(sv))
1673 sv_catpv(d, "PCS_IMPORTED,");
1674 else
9660f481 1675 sv_catpv(d, "SCREAM,");
1ccdb730 1676 }
3967c732 1677
e0bbf362
DM		 1678 /* process type-specific SV flags */
1679
3967c732
JD		 1680 switch (type) {
1681 case SVt_PVCV:
1682 case SVt_PVFM:
ae1f06a1 1683 append_flags(d, CvFLAGS(sv), cv_flags_names);
3967c732
JD		 1684 break;
1685 case SVt_PVHV:
ae1f06a1 1686 append_flags(d, flags, hv_flags_names);
3967c732 1687 break;
926fc7b6
DM		 1688 case SVt_PVGV:
1689 case SVt_PVLV:
1690 if (isGV_with_GP(sv)) {
ae1f06a1 1691 append_flags(d, GvFLAGS(sv), gp_flags_names);
926fc7b6 1692 }
926fc7b6 1693 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
3967c732
JD		 1694 sv_catpv(d, "IMPORT");
1695 if (GvIMPORTED(sv) == GVf_IMPORTED)
1696 sv_catpv(d, "ALL,");
1697 else {
1698 sv_catpv(d, "(");
ae1f06a1 1699 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
3967c732
JD		 1700 sv_catpv(d, " ),");
1701 }
1702 }
924ba076 1703 /* FALLTHROUGH */
a5c7cb08 1704 case SVt_PVMG:
25da4f38 1705 default:
69c678eb 1706 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
25da4f38 1707 break;
a5c7cb08 1708
11ca45c0
NC		 1709 case SVt_PVAV:
1710 break;
3967c732 1711 }
86f0d186
NC		 1712 /* SVphv_SHAREKEYS is also 0x20000000 */
1713 if ((type != SVt_PVHV) && SvUTF8(sv))
9fe74ede 1714 sv_catpv(d, "UTF8");
3967c732 1715
b162af07
SP		 1716 if (*(SvEND(d) - 1) == ',') {
1717 SvCUR_set(d, SvCUR(d) - 1);
1718 SvPVX(d)[SvCUR(d)] = '\0';
1719 }
3967c732 1720 sv_catpv(d, ")");
b15aece3 1721 s = SvPVX_const(d);
3967c732 1722
e0bbf362
DM		 1723 /* dump initial SV details */
1724
fd0854ff 1725#ifdef DEBUG_LEAKING_SCALARS
cbe56f1d 1726 Perl_dump_indent(aTHX_ level, file,
147e3846 1727 "ALLOCATED at %s:%d %s %s (parent 0x%" UVxf "); serial %" UVuf "\n",
fd0854ff
DM		 1728 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1729 sv->sv_debug_line,
1730 sv->sv_debug_inpad ? "for" : "by",
1731 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
cd676548 1732 PTR2UV(sv->sv_debug_parent),
cbe56f1d
DM		 1733 sv->sv_debug_serial
1734 );
fd0854ff 1735#endif
cea2e8a9 1736 Perl_dump_indent(aTHX_ level, file, "SV = ");
e0bbf362
DM		 1737
1738 /* Dump SV type */
1739
5357ca29
NC		 1740 if (type < SVt_LAST) {
1741 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1742
1743 if (type == SVt_NULL) {
5f954473 1744 SvREFCNT_dec_NN(d);
5357ca29
NC		 1745 return;
1746 }
1747 } else {
147e3846 1748 PerlIO_printf(file, "UNKNOWN(0x%" UVxf ") %s\n", (UV)type, s);
5f954473 1749 SvREFCNT_dec_NN(d);
3967c732
JD		 1750 return;
1751 }
e0bbf362
DM		 1752
1753 /* Dump general SV fields */
1754
27bd069f 1755 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
0a0c4b76
NC		 1756 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1757 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
4df7f6af 1758 || (type == SVt_IV && !SvROK(sv))) {
765f542d 1759 if (SvIsUV(sv)
765f542d 1760 )
147e3846 1761 Perl_dump_indent(aTHX_ level, file, " UV = %" UVuf, (UV)SvUVX(sv));
cf2093f6 1762 else
147e3846 1763 Perl_dump_indent(aTHX_ level, file, " IV = %" IVdf, (IV)SvIVX(sv));
38d7fd8b 1764 (void)PerlIO_putc(file, '\n');
3967c732 1765 }
e0bbf362 1766
0f94cb1f 1767 if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
08e44740 1768 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
c0a413d1 1769 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
0e4c4423 1770 || type == SVt_NV) {
67d796ae 1771 STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
88cb8500 1772 Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
67d796ae 1773 RESTORE_LC_NUMERIC_UNDERLYING();
3967c732 1774 }
e0bbf362 1775
3967c732 1776 if (SvROK(sv)) {
147e3846
KW		 1777 Perl_dump_indent(aTHX_ level, file, " RV = 0x%" UVxf "\n",
1778 PTR2UV(SvRV(sv)));
3967c732
JD		 1779 if (nest < maxnest)
1780 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
3967c732 1781 }
e0bbf362 1782
cea89e20 1783 if (type < SVt_PV) {
5f954473 1784 SvREFCNT_dec_NN(d);
3967c732 1785 return;
cea89e20 1786 }
e0bbf362 1787
5a3c7349
FC		 1788 if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1789 || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
8d919b0a
FC		 1790 const bool re = isREGEXP(sv);
1791 const char * const ptr =
1792 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1793 if (ptr) {
69240efd 1794 STRLEN delta;
7a4bba22 1795 if (SvOOK(sv)) {
69240efd 1796 SvOOK_offset(sv, delta);
147e3846 1797 Perl_dump_indent(aTHX_ level, file," OFFSET = %" UVuf "\n",
5186cc12 1798 (UV) delta);
69240efd
NC		 1799 } else {
1800 delta = 0;
7a4bba22 1801 }
147e3846
KW		 1802 Perl_dump_indent(aTHX_ level, file," PV = 0x%" UVxf " ",
1803 PTR2UV(ptr));
7a4bba22
NC		 1804 if (SvOOK(sv)) {
1805 PerlIO_printf(file, "( %s . ) ",
8d919b0a 1806 pv_display(d, ptr - delta, delta, 0,
7a4bba22
NC		 1807 pvlim));
1808 }
ad3f05ad
KW		 1809 if (type == SVt_INVLIST) {
1810 PerlIO_printf(file, "\n");
1811 /* 4 blanks indents 2 beyond the PV, etc */
1812 _invlist_dump(file, level, " ", sv);
1813 }
1814 else {
685bfc3c
KW		 1815 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1816 re ? 0 : SvLEN(sv),
1817 pvlim));
1818 if (SvUTF8(sv)) /* the 6? \x{....} */
1819 PerlIO_printf(file, " [UTF8 \"%s\"]",
1820 sv_uni_display(d, sv, 6 * SvCUR(sv),
1821 UNI_DISPLAY_QQ));
1822 PerlIO_printf(file, "\n");
ad3f05ad 1823 }
147e3846 1824 Perl_dump_indent(aTHX_ level, file, " CUR = %" IVdf "\n", (IV)SvCUR(sv));
8d919b0a 1825 if (!re)
147e3846 1826 Perl_dump_indent(aTHX_ level, file, " LEN = %" IVdf "\n",
8d919b0a 1827 (IV)SvLEN(sv));
93c10d60 1828#ifdef PERL_COPY_ON_WRITE
db2c6cb3
FC		 1829 if (SvIsCOW(sv) && SvLEN(sv))
1830 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1831 CowREFCNT(sv));
1832#endif
3967c732
JD		 1833 }
1834 else
cea2e8a9 1835 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
3967c732 1836 }
e0bbf362 1837
3967c732 1838 if (type >= SVt_PVMG) {
0f94cb1f 1839 if (SvMAGIC(sv))
8530ff28 1840 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
3967c732
JD		 1841 if (SvSTASH(sv))
1842 do_hv_dump(level, file, " STASH", SvSTASH(sv));
c13a5c80
NC		 1843
1844 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
147e3846
KW		 1845 Perl_dump_indent(aTHX_ level, file, " USEFUL = %" IVdf "\n",
1846 (IV)BmUSEFUL(sv));
c13a5c80 1847 }
3967c732 1848 }
e0bbf362
DM		 1849
1850 /* Dump type-specific SV fields */
1851
3967c732 1852 switch (type) {
3967c732 1853 case SVt_PVAV:
147e3846
KW		 1854 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf,
1855 PTR2UV(AvARRAY(sv)));
3967c732 1856 if (AvARRAY(sv) != AvALLOC(sv)) {
147e3846
KW		 1857 PerlIO_printf(file, " (offset=%" IVdf ")\n",
1858 (IV)(AvARRAY(sv) - AvALLOC(sv)));
1859 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%" UVxf "\n",
1860 PTR2UV(AvALLOC(sv)));
3967c732
JD		 1861 }
1862 else
38d7fd8b 1863 (void)PerlIO_putc(file, '\n');
147e3846
KW		 1864 Perl_dump_indent(aTHX_ level, file, " FILL = %" IVdf "\n",
1865 (IV)AvFILLp(sv));
1866 Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n",
1867 (IV)AvMAX(sv));
ed0faf2e 1868 SvPVCLEAR(d);
11ca45c0
NC		 1869 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1870 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
b15aece3
SP		 1871 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1872 SvCUR(d) ? SvPVX_const(d) + 1 : "");
476fafda 1873 if (nest < maxnest && AvARRAY(MUTABLE_AV(sv))) {
c70927a6 1874 SSize_t count;
476fafda
DM		 1875 SV **svp = AvARRAY(MUTABLE_AV(sv));
1876 for (count = 0;
1877 count <= AvFILLp(MUTABLE_AV(sv)) && count < maxnest;
1878 count++, svp++)
1879 {
1880 SV* const elt = *svp;
147e3846
KW		 1881 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %" IVdf "\n",
1882 (IV)count);
476fafda 1883 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
3967c732
JD		 1884 }
1885 }
1886 break;
5d27ee4a
DD		 1887 case SVt_PVHV: {
1888 U32 usedkeys;
0c22a733
DM		 1889 if (SvOOK(sv)) {
1890 struct xpvhv_aux *const aux = HvAUX(sv);
147e3846 1891 Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %" UVuf "\n",
0c22a733
DM		 1892 (UV)aux->xhv_aux_flags);
1893 }
147e3846 1894 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf, PTR2UV(HvARRAY(sv)));
1186f821 1895 usedkeys = HvUSEDKEYS(MUTABLE_HV(sv));
5d27ee4a 1896 if (HvARRAY(sv) && usedkeys) {
3967c732
JD		 1897 /* Show distribution of HEs in the ARRAY */
1898 int freq[200];
c3caa5c3 1899#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
3967c732
JD		 1900 int i;
1901 int max = 0;
5d27ee4a 1902 U32 pow2 = 2, keys = usedkeys;
65202027 1903 NV theoret, sum = 0;
3967c732
JD		 1904
1905 PerlIO_printf(file, " (");
1906 Zero(freq, FREQ_MAX + 1, int);
eb160463 1907 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
c445ea15
AL		 1908 HE* h;
1909 int count = 0;
3967c732
JD		 1910 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1911 count++;
1912 if (count > FREQ_MAX)
1913 count = FREQ_MAX;
1914 freq[count]++;
1915 if (max < count)
1916 max = count;
1917 }
1918 for (i = 0; i <= max; i++) {
1919 if (freq[i]) {
1920 PerlIO_printf(file, "%d%s:%d", i,
1921 (i == FREQ_MAX) ? "+" : "",
1922 freq[i]);
1923 if (i != max)
1924 PerlIO_printf(file, ", ");
1925 }
1926 }
38d7fd8b 1927 (void)PerlIO_putc(file, ')');
b8fa94d8
MG		 1928 /* The "quality" of a hash is defined as the total number of
1929 comparisons needed to access every element once, relative
1930 to the expected number needed for a random hash.
1931
1932 The total number of comparisons is equal to the sum of
e76cd0fa
AMS		 1933 the squares of the number of entries in each bucket.
1934 For a random hash of n keys into k buckets, the expected
b8fa94d8
MG		 1935 value is
1936 n + n(n-1)/2k
1937 */
1938
3967c732
JD		 1939 for (i = max; i > 0; i--) { /* Precision: count down. */
1940 sum += freq[i] * i * i;
1941 }
155aba94 1942 while ((keys = keys >> 1))
3967c732 1943 pow2 = pow2 << 1;
5d27ee4a 1944 theoret = usedkeys;
b8fa94d8 1945 theoret += theoret * (theoret-1)/pow2;
38d7fd8b 1946 (void)PerlIO_putc(file, '\n');
147e3846
KW		 1947 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"
1948 NVff "%%", theoret/sum*100);
3967c732 1949 }
38d7fd8b 1950 (void)PerlIO_putc(file, '\n');
147e3846
KW		 1951 Perl_dump_indent(aTHX_ level, file, " KEYS = %" IVdf "\n",
1952 (IV)usedkeys);
9faf471a
NC		 1953 {
1954 STRLEN count = 0;
1955 HE **ents = HvARRAY(sv);
1956
1957 if (ents) {
1958 HE *const *const last = ents + HvMAX(sv);
1959 count = last + 1 - ents;
1960
1961 do {
1962 if (!*ents)
1963 --count;
1964 } while (++ents <= last);
1965 }
1966
147e3846 1967 Perl_dump_indent(aTHX_ level, file, " FILL = %" UVuf "\n",
8bf4c401 1968 (UV)count);
9faf471a 1969 }
147e3846
KW		 1970 Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n",
1971 (IV)HvMAX(sv));
e1a7ec8d 1972 if (SvOOK(sv)) {
147e3846
KW		 1973 Perl_dump_indent(aTHX_ level, file, " RITER = %" IVdf "\n",
1974 (IV)HvRITER_get(sv));
1975 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%" UVxf "\n",
1976 PTR2UV(HvEITER_get(sv)));
6a5b4183 1977#ifdef PERL_HASH_RANDOMIZE_KEYS
147e3846
KW		 1978 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%" UVxf,
1979 (UV)HvRAND_get(sv));
e1a7ec8d 1980 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
147e3846
KW		 1981 PerlIO_printf(file, " (LAST = 0x%" UVxf ")",
1982 (UV)HvLASTRAND_get(sv));
e1a7ec8d 1983 }
6a5b4183 1984#endif
38d7fd8b 1985 (void)PerlIO_putc(file, '\n');
e1a7ec8d 1986 }
8d2f4536 1987 {
b9ac451d 1988 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
8d2f4536 1989 if (mg && mg->mg_obj) {
147e3846 1990 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%" UVxf "\n", PTR2UV(mg->mg_obj));
8d2f4536
NC		 1991 }
1992 }
bfcb3514 1993 {
b9ac451d 1994 const char * const hvname = HvNAME_get(sv);
0eb335df 1995 if (hvname) {
6f3289f0
DM		 1996 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1997 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
0eb335df
BF		 1998 generic_pv_escape( tmpsv, hvname,
1999 HvNAMELEN(sv), HvNAMEUTF8(sv)));
2000 }
bfcb3514 2001 }
86f55936 2002 if (SvOOK(sv)) {
ad64d0ec 2003 AV * const backrefs
85fbaab2 2004 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
7d88e6c4 2005 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
67e04715
FC		 2006 if (HvAUX(sv)->xhv_name_count)
2007 Perl_dump_indent(aTHX_
147e3846 2008 level, file, " NAMECOUNT = %" IVdf "\n",
7afc2217 2009 (IV)HvAUX(sv)->xhv_name_count
67e04715 2010 );
15d9236d 2011 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
ec3405c8
NC		 2012 const I32 count = HvAUX(sv)->xhv_name_count;
2013 if (count) {
2014 SV * const names = newSVpvs_flags("", SVs_TEMP);
2015 /* The starting point is the first element if count is
2016 positive and the second element if count is negative. */
2017 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
2018 + (count < 0 ? 1 : 0);
2019 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
2020 + (count < 0 ? -count : count);
2021 while (hekp < endp) {
8e5993c4 2022 if (*hekp) {
6f3289f0 2023 SV *tmp = newSVpvs_flags("", SVs_TEMP);
0eb335df
BF		 2024 Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
2025 generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
ec3405c8
NC		 2026 } else {
2027 /* This should never happen. */
2028 sv_catpvs(names, ", (null)");
67e04715 2029 }
ec3405c8
NC		 2030 ++hekp;
2031 }
67e04715
FC		 2032 Perl_dump_indent(aTHX_
2033 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
2034 );
2035 }
0eb335df
BF		 2036 else {
2037 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
2038 const char *const hvename = HvENAME_get(sv);
67e04715 2039 Perl_dump_indent(aTHX_
0eb335df
BF		 2040 level, file, " ENAME = \"%s\"\n",
2041 generic_pv_escape(tmp, hvename,
2042 HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
2043 }
67e04715 2044 }
86f55936 2045 if (backrefs) {
147e3846 2046 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%" UVxf "\n",
86f55936 2047 PTR2UV(backrefs));
ad64d0ec 2048 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
86f55936
NC		 2049 dumpops, pvlim);
2050 }
7d88e6c4 2051 if (meta) {
0eb335df 2052 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
147e3846
KW		 2053 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"
2054 UVxf ")\n",
0eb335df
BF		 2055 generic_pv_escape( tmpsv, meta->mro_which->name,
2056 meta->mro_which->length,
2057 (meta->mro_which->kflags & HVhek_UTF8)),
7d88e6c4 2058 PTR2UV(meta->mro_which));
147e3846
KW		 2059 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"
2060 UVxf "\n",
7d88e6c4 2061 (UV)meta->cache_gen);
147e3846 2062 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%" UVxf "\n",
7d88e6c4
NC		 2063 (UV)meta->pkg_gen);
2064 if (meta->mro_linear_all) {
147e3846
KW		 2065 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"
2066 UVxf "\n",
7d88e6c4
NC		 2067 PTR2UV(meta->mro_linear_all));
2068 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
2069 dumpops, pvlim);
2070 }
2071 if (meta->mro_linear_current) {
147e3846
KW		 2072 Perl_dump_indent(aTHX_ level, file,
2073 " MRO_LINEAR_CURRENT = 0x%" UVxf "\n",
7d88e6c4
NC		 2074 PTR2UV(meta->mro_linear_current));
2075 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
2076 dumpops, pvlim);
2077 }
2078 if (meta->mro_nextmethod) {
147e3846
KW		 2079 Perl_dump_indent(aTHX_ level, file,
2080 " MRO_NEXTMETHOD = 0x%" UVxf "\n",
7d88e6c4
NC		 2081 PTR2UV(meta->mro_nextmethod));
2082 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
2083 dumpops, pvlim);
2084 }
2085 if (meta->isa) {
147e3846 2086 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%" UVxf "\n",
7d88e6c4
NC		 2087 PTR2UV(meta->isa));
2088 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
2089 dumpops, pvlim);
2090 }
2091 }
86f55936 2092 }
b5698553 2093 if (nest < maxnest) {
cbab3169 2094 HV * const hv = MUTABLE_HV(sv);
b5698553
TH		 2095 STRLEN i;
2096 HE *he;
cbab3169 2097
b5698553
TH		 2098 if (HvARRAY(hv)) {
2099 int count = maxnest - nest;
2100 for (i=0; i <= HvMAX(hv); i++) {
2101 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
2102 U32 hash;
2103 SV * keysv;
2104 const char * keypv;
2105 SV * elt;
7dc86639 2106 STRLEN len;
b5698553
TH		 2107
2108 if (count-- <= 0) goto DONEHV;
2109
2110 hash = HeHASH(he);
2111 keysv = hv_iterkeysv(he);
2112 keypv = SvPV_const(keysv, len);
2113 elt = HeVAL(he);
cbab3169 2114
7dc86639
YO		 2115 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
2116 if (SvUTF8(keysv))
2117 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
b5698553
TH		 2118 if (HvEITER_get(hv) == he)
2119 PerlIO_printf(file, "[CURRENT] ");
147e3846 2120 PerlIO_printf(file, "HASH = 0x%" UVxf "\n", (UV) hash);
7dc86639
YO		 2121 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
2122 }
b5698553
TH		 2123 }
2124 DONEHV:;
2125 }
3967c732
JD		 2126 }
2127 break;
5d27ee4a 2128 } /* case SVt_PVHV */
e0bbf362 2129
3967c732 2130 case SVt_PVCV:
8fa6a409 2131 if (CvAUTOLOAD(sv)) {
0eb335df 2132 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
6f3289f0 2133 STRLEN len;
8fa6a409 2134 const char *const name = SvPV_const(sv, len);
0eb335df
BF		 2135 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
2136 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
8fa6a409
FC		 2137 }
2138 if (SvPOK(sv)) {
6f3289f0
DM		 2139 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2140 const char *const proto = CvPROTO(sv);
0eb335df
BF		 2141 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
2142 generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
2143 SvUTF8(sv)));
cbf82dd0 2144 }
924ba076 2145 /* FALLTHROUGH */
3967c732
JD		 2146 case SVt_PVFM:
2147 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
d04ba589
NC		 2148 if (!CvISXSUB(sv)) {
2149 if (CvSTART(sv)) {
27604593
DM		 2150 if (CvSLABBED(sv))
2151 Perl_dump_indent(aTHX_ level, file,
147e3846 2152 " SLAB = 0x%" UVxf "\n",
27604593
DM		 2153 PTR2UV(CvSTART(sv)));
2154 else
2155 Perl_dump_indent(aTHX_ level, file,
147e3846 2156 " START = 0x%" UVxf " ===> %" IVdf "\n",
d04ba589
NC		 2157 PTR2UV(CvSTART(sv)),
2158 (IV)sequence_num(CvSTART(sv)));
2159 }
147e3846 2160 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%" UVxf "\n",
d04ba589
NC		 2161 PTR2UV(CvROOT(sv)));
2162 if (CvROOT(sv) && dumpops) {
2163 do_op_dump(level+1, file, CvROOT(sv));
2164 }
2165 } else {
126f53f3 2166 SV * const constant = cv_const_sv((const CV *)sv);
b1886099 2167
147e3846 2168 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%" UVxf "\n", PTR2UV(CvXSUB(sv)));
b1886099
NC		 2169
2170 if (constant) {
147e3846 2171 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%" UVxf
b1886099
NC		 2172 " (CONST SV)\n",
2173 PTR2UV(CvXSUBANY(sv).any_ptr));
2174 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2175 pvlim);
2176 } else {
147e3846 2177 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %" IVdf "\n",
b1886099
NC		 2178 (IV)CvXSUBANY(sv).any_i32);
2179 }
2180 }
3610c89f
FC		 2181 if (CvNAMED(sv))
2182 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2183 HEK_KEY(CvNAME_HEK((CV *)sv)));
2184 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
57843af0 2185 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
147e3846
KW		 2186 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"
2187 IVdf "\n", (IV)CvDEPTH(sv));
2188 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n",
2189 (UV)CvFLAGS(sv));
2190 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %" UVuf "\n", (UV)CvOUTSIDE_SEQ(sv));
eacbb379 2191 if (!CvISXSUB(sv)) {
147e3846 2192 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%" UVxf "\n", PTR2UV(CvPADLIST(sv)));
eacbb379
DD		 2193 if (nest < maxnest) {
2194 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
2195 }
3967c732 2196 }
eacbb379 2197 else
db6e00bd 2198 Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv));
3967c732 2199 {
b9ac451d 2200 const CV * const outside = CvOUTSIDE(sv);
147e3846 2201 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%" UVxf " (%s)\n",
57def98f 2202 PTR2UV(outside),
cf2093f6
JH		 2203 (!outside ? "null"
2204 : CvANON(outside) ? "ANON"
2205 : (outside == PL_main_cv) ? "MAIN"
2206 : CvUNIQUE(outside) ? "UNIQUE"
b24fda9d
BF		 2207 : CvGV(outside) ?
2208 generic_pv_escape(
2209 newSVpvs_flags("", SVs_TEMP),
2210 GvNAME(CvGV(outside)),
2211 GvNAMELEN(CvGV(outside)),
2212 GvNAMEUTF8(CvGV(outside)))
2213 : "UNDEFINED"));
3967c732 2214 }
704b97aa
FC		 2215 if (CvOUTSIDE(sv)
2216 && (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))))
ad64d0ec 2217 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
3967c732 2218 break;
e0bbf362 2219
926fc7b6
DM		 2220 case SVt_PVGV:
2221 case SVt_PVLV:
b9ac451d
AL		 2222 if (type == SVt_PVLV) {
2223 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
147e3846
KW		 2224 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %" IVdf "\n", (IV)LvTARGOFF(sv));
2225 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %" IVdf "\n", (IV)LvTARGLEN(sv));
2226 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%" UVxf "\n", PTR2UV(LvTARG(sv)));
2227 Perl_dump_indent(aTHX_ level, file, " FLAGS = %" IVdf "\n", (IV)LvFLAGS(sv));
305b8651 2228 if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
b9ac451d
AL		 2229 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2230 dumpops, pvlim);
2231 }
8d919b0a 2232 if (isREGEXP(sv)) goto dumpregexp;
926fc7b6
DM		 2233 if (!isGV_with_GP(sv))
2234 break;
6f3289f0
DM		 2235 {
2236 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2237 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2238 generic_pv_escape(tmpsv, GvNAME(sv),
2239 GvNAMELEN(sv),
2240 GvNAMEUTF8(sv)));
2241 }
147e3846 2242 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %" IVdf "\n", (IV)GvNAMELEN(sv));
3967c732 2243 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
147e3846
KW		 2244 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)GvFLAGS(sv));
2245 Perl_dump_indent(aTHX_ level, file, " GP = 0x%" UVxf "\n", PTR2UV(GvGP(sv)));
f472eb5c
GS		 2246 if (!GvGP(sv))
2247 break;
147e3846
KW		 2248 Perl_dump_indent(aTHX_ level, file, " SV = 0x%" UVxf "\n", PTR2UV(GvSV(sv)));
2249 Perl_dump_indent(aTHX_ level, file, " REFCNT = %" IVdf "\n", (IV)GvREFCNT(sv));
2250 Perl_dump_indent(aTHX_ level, file, " IO = 0x%" UVxf "\n", PTR2UV(GvIOp(sv)));
2251 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%" UVxf " \n", PTR2UV(GvFORM(sv)));
2252 Perl_dump_indent(aTHX_ level, file, " AV = 0x%" UVxf "\n", PTR2UV(GvAV(sv)));
2253 Perl_dump_indent(aTHX_ level, file, " HV = 0x%" UVxf "\n", PTR2UV(GvHV(sv)));
2254 Perl_dump_indent(aTHX_ level, file, " CV = 0x%" UVxf "\n", PTR2UV(GvCV(sv)));
2255 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%" UVxf "\n", (UV)GvCVGEN(sv));
2256 Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%" UVxf
008009b0
FC		 2257 " (%s)\n",
2258 (UV)GvGPFLAGS(sv),
71afaece 2259 "");
147e3846 2260 Perl_dump_indent(aTHX_ level, file, " LINE = %" IVdf "\n", (IV)GvLINE(sv));
b195d487 2261 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
3967c732
JD		 2262 do_gv_dump (level, file, " EGV", GvEGV(sv));
2263 break;
2264 case SVt_PVIO:
147e3846
KW		 2265 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%" UVxf "\n", PTR2UV(IoIFP(sv)));
2266 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%" UVxf "\n", PTR2UV(IoOFP(sv)));
2267 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%" UVxf "\n", PTR2UV(IoDIRP(sv)));
2268 Perl_dump_indent(aTHX_ level, file, " LINES = %" IVdf "\n", (IV)IoLINES(sv));
2269 Perl_dump_indent(aTHX_ level, file, " PAGE = %" IVdf "\n", (IV)IoPAGE(sv));
2270 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %" IVdf "\n", (IV)IoPAGE_LEN(sv));
2271 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %" IVdf "\n", (IV)IoLINES_LEFT(sv));
27533608 2272 if (IoTOP_NAME(sv))
cea2e8a9 2273 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
9ba1f565
NC		 2274 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2275 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2276 else {
147e3846 2277 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%" UVxf "\n",
9ba1f565 2278 PTR2UV(IoTOP_GV(sv)));
ad64d0ec
NC		 2279 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2280 maxnest, dumpops, pvlim);
9ba1f565
NC		 2281 }
2282 /* Source filters hide things that are not GVs in these three, so let's
2283 be careful out there. */
27533608 2284 if (IoFMT_NAME(sv))
cea2e8a9 2285 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
9ba1f565
NC		 2286 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2287 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2288 else {
147e3846 2289 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%" UVxf "\n",
9ba1f565 2290 PTR2UV(IoFMT_GV(sv)));
ad64d0ec
NC		 2291 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2292 maxnest, dumpops, pvlim);
9ba1f565 2293 }
27533608 2294 if (IoBOTTOM_NAME(sv))
cea2e8a9 2295 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
9ba1f565
NC		 2296 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2297 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2298 else {
147e3846 2299 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%" UVxf "\n",
9ba1f565 2300 PTR2UV(IoBOTTOM_GV(sv)));
ad64d0ec
NC		 2301 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2302 maxnest, dumpops, pvlim);
9ba1f565 2303 }
27533608 2304 if (isPRINT(IoTYPE(sv)))
cea2e8a9 2305 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
27533608 2306 else
cea2e8a9 2307 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
147e3846 2308 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)IoFLAGS(sv));
3967c732 2309 break;
206ee256 2310 case SVt_REGEXP:
8d919b0a 2311 dumpregexp:
d63e6659 2312 {
8d919b0a 2313 struct regexp * const r = ReANY((REGEXP*)sv);
e3e400ec
YO		 2314
2315#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
ec16d31f 2316 sv_setpv(d,""); \
e3e400ec 2317 append_flags(d, flags, names); \
ec16d31f
YO		 2318 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2319 SvCUR_set(d, SvCUR(d) - 1); \
2320 SvPVX(d)[SvCUR(d)] = '\0'; \
2321 } \
2322} STMT_END
e3e400ec 2323 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
147e3846 2324 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%" UVxf " (%s)\n",
dbc200c5
YO		 2325 (UV)(r->compflags), SvPVX_const(d));
2326
e3e400ec 2327 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
147e3846 2328 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%" UVxf " (%s)\n",
dbc200c5
YO		 2329 (UV)(r->extflags), SvPVX_const(d));
2330
147e3846 2331 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%" UVxf " (%s)\n",
e3e400ec
YO		 2332 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2333 if (r->engine == &PL_core_reg_engine) {
2334 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
147e3846 2335 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%" UVxf " (%s)\n",
e3e400ec
YO		 2336 (UV)(r->intflags), SvPVX_const(d));
2337 } else {
147e3846 2338 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%" UVxf "\n",
d63e6659 2339 (UV)(r->intflags));
e3e400ec
YO		 2340 }
2341#undef SV_SET_STRINGIFY_REGEXP_FLAGS
147e3846 2342 Perl_dump_indent(aTHX_ level, file, " NPARENS = %" UVuf "\n",
d63e6659 2343 (UV)(r->nparens));
147e3846 2344 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %" UVuf "\n",
d63e6659 2345 (UV)(r->lastparen));
147e3846 2346 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %" UVuf "\n",
d63e6659 2347 (UV)(r->lastcloseparen));
147e3846 2348 Perl_dump_indent(aTHX_ level, file, " MINLEN = %" IVdf "\n",
d63e6659 2349 (IV)(r->minlen));
147e3846 2350 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %" IVdf "\n",
d63e6659 2351 (IV)(r->minlenret));
147e3846 2352 Perl_dump_indent(aTHX_ level, file, " GOFS = %" UVuf "\n",
d63e6659 2353 (UV)(r->gofs));
147e3846 2354 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %" UVuf "\n",
d63e6659 2355 (UV)(r->pre_prefix));
147e3846 2356 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %" IVdf "\n",
d63e6659 2357 (IV)(r->sublen));
147e3846 2358 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %" IVdf "\n",
6502e081 2359 (IV)(r->suboffset));
147e3846 2360 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %" IVdf "\n",
6502e081 2361 (IV)(r->subcoffset));
d63e6659 2362 if (r->subbeg)
147e3846 2363 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%" UVxf " %s\n",
d63e6659
DM		 2364 PTR2UV(r->subbeg),
2365 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2366 else
2367 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
147e3846 2368 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%" UVxf "\n",
d63e6659 2369 PTR2UV(r->mother_re));
01ffd0f1
FC		 2370 if (nest < maxnest && r->mother_re)
2371 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2372 maxnest, dumpops, pvlim);
147e3846 2373 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%" UVxf "\n",
d63e6659 2374 PTR2UV(r->paren_names));
147e3846 2375 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%" UVxf "\n",
d63e6659 2376 PTR2UV(r->substrs));
147e3846 2377 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%" UVxf "\n",
d63e6659 2378 PTR2UV(r->pprivate));
147e3846 2379 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%" UVxf "\n",
d63e6659 2380 PTR2UV(r->offs));
147e3846 2381 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%" UVxf "\n",
d63c20f2 2382 PTR2UV(r->qr_anoncv));
db2c6cb3 2383#ifdef PERL_ANY_COW
147e3846 2384 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%" UVxf "\n",
d63e6659
DM		 2385 PTR2UV(r->saved_copy));
2386#endif
2387 }
206ee256 2388 break;
3967c732 2389 }
5f954473 2390 SvREFCNT_dec_NN(d);
3967c732
JD		 2391}
2392
36b1c95c
MH		 2393/*
2394=for apidoc sv_dump
2395
2396Dumps the contents of an SV to the C<STDERR> filehandle.
2397
2398For an example of its output, see L<Devel::Peek>.
2399
2400=cut
2401*/
2402
3967c732 2403void
864dbfa3 2404Perl_sv_dump(pTHX_ SV *sv)
3967c732 2405{
769b28f4 2406 if (sv && SvROK(sv))
d1029faa
JP		 2407 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2408 else
2409 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
8d063cd8 2410}
bd16a5f0
IZ		 2411
2412int
2413Perl_runops_debug(pTHX)
2414{
2415 if (!PL_op) {
9b387841 2416 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
bd16a5f0
IZ		 2417 return 0;
2418 }
2419
9f3673fb 2420 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
bd16a5f0 2421 do {
75d476e2
S		 2422#ifdef PERL_TRACE_OPS
2423 ++PL_op_exec_cnt[PL_op->op_type];
2424#endif
bd16a5f0 2425 if (PL_debug) {
991bab54
DM		 2426 ENTER;
2427 SAVETMPS;
b9ac451d 2428 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
bd16a5f0 2429 PerlIO_printf(Perl_debug_log,
147e3846 2430 "WARNING: %" UVxf " changed from %" UVxf " to %" UVxf "\n",
bd16a5f0
IZ		 2431 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2432 PTR2UV(*PL_watchaddr));
d6721266
DM		 2433 if (DEBUG_s_TEST_) {
2434 if (DEBUG_v_TEST_) {
2435 PerlIO_printf(Perl_debug_log, "\n");
2436 deb_stack_all();
2437 }
2438 else
2439 debstack();
2440 }
2441
2442
bd16a5f0
IZ		 2443 if (DEBUG_t_TEST_) debop(PL_op);
2444 if (DEBUG_P_TEST_) debprof(PL_op);
991bab54
DM		 2445 FREETMPS;
2446 LEAVE;
bd16a5f0 2447 }
fe83c362 2448
3f6bd23a 2449 PERL_DTRACE_PROBE_OP(PL_op);
16c91539 2450 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
9f3673fb 2451 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
47c9d59f 2452 PERL_ASYNC_CHECK();
bd16a5f0
IZ		 2453
2454 TAINT_NOT;
2455 return 0;
2456}
2457
f9b02e42
DM		 2458
2459/* print the names of the n lexical vars starting at pad offset off */
2460
f9db5646 2461STATIC void
f9b02e42
DM		 2462S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
2463{
2464 PADNAME *sv;
2465 CV * const cv = deb_curcv(cxstack_ix);
2466 PADNAMELIST *comppad = NULL;
2467 int i;
2468
2469 if (cv) {
2470 PADLIST * const padlist = CvPADLIST(cv);
2471 comppad = PadlistNAMES(padlist);
2472 }
2473 if (paren)
2474 PerlIO_printf(Perl_debug_log, "(");
2475 for (i = 0; i < n; i++) {
2476 if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
147e3846 2477 PerlIO_printf(Perl_debug_log, "%" PNf, PNfARG(sv));
f9b02e42 2478 else
147e3846 2479 PerlIO_printf(Perl_debug_log, "[%" UVuf "]",
f9b02e42
DM		 2480 (UV)(off+i));
2481 if (i < n - 1)
2482 PerlIO_printf(Perl_debug_log, ",");
2483 }
2484 if (paren)
2485 PerlIO_printf(Perl_debug_log, ")");
2486}
2487
2488
fedf30e1
DM		 2489/* append to the out SV, the name of the lexical at offset off in the CV
2490 * cv */
2491
ec48399d 2492static void
fedf30e1
DM		 2493S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
2494 bool paren, bool is_scalar)
2495{
2496 PADNAME *sv;
2497 PADNAMELIST *namepad = NULL;
2498 int i;
2499
2500 if (cv) {
2501 PADLIST * const padlist = CvPADLIST(cv);
2502 namepad = PadlistNAMES(padlist);
2503 }
2504
2505 if (paren)
2506 sv_catpvs_nomg(out, "(");
2507 for (i = 0; i < n; i++) {
2508 if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
2509 {
2510 STRLEN cur = SvCUR(out);
147e3846 2511 Perl_sv_catpvf(aTHX_ out, "[%" UTF8f,
26334c4d
FC		 2512 UTF8fARG(1, PadnameLEN(sv) - 1,
2513 PadnamePV(sv) + 1));
fedf30e1
DM		 2514 if (is_scalar)
2515 SvPVX(out)[cur] = '$';
2516 }
2517 else
147e3846 2518 Perl_sv_catpvf(aTHX_ out, "[%" UVuf "]", (UV)(off+i));
fedf30e1
DM		 2519 if (i < n - 1)
2520 sv_catpvs_nomg(out, ",");
2521 }
2522 if (paren)
2523 sv_catpvs_nomg(out, "(");
2524}
2525
2526
ec48399d 2527static void
8bbe2fa8 2528S_append_gv_name(pTHX_ GV *gv, SV *out)
fedf30e1
DM		 2529{
2530 SV *sv;
2531 if (!gv) {
2532 sv_catpvs_nomg(out, "<NULLGV>");
2533 return;
2534 }
2535 sv = newSV(0);
2536 gv_fullname4(sv, gv, NULL, FALSE);
147e3846 2537 Perl_sv_catpvf(aTHX_ out, "$%" SVf, SVfARG(sv));
fedf30e1
DM		 2538 SvREFCNT_dec_NN(sv);
2539}
2540
2541#ifdef USE_ITHREADS
dc3c1c70
DM		 2542# define ITEM_SV(item) (comppad ? \
2543 *av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
fedf30e1
DM		 2544#else
2545# define ITEM_SV(item) UNOP_AUX_item_sv(item)
2546#endif
2547
2548
2549/* return a temporary SV containing a stringified representation of
48ee9c0e 2550 * the op_aux field of a MULTIDEREF op, associated with CV cv
fedf30e1
DM		 2551 */
2552
2553SV*
48ee9c0e 2554Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
fedf30e1
DM		 2555{
2556 UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
2557 UV actions = items->uv;
2558 SV *sv;
2559 bool last = 0;
2560 bool is_hash = FALSE;
2561 int derefs = 0;
ff94d24c 2562 SV *out = newSVpvn_flags("",0,SVs_TEMP);
fedf30e1 2563#ifdef USE_ITHREADS
dc3c1c70
DM		 2564 PAD *comppad;
2565
2566 if (cv) {
2567 PADLIST *padlist = CvPADLIST(cv);
2568 comppad = PadlistARRAY(padlist)[1];
2569 }
2570 else
2571 comppad = NULL;
fedf30e1
DM		 2572#endif
2573
48ee9c0e 2574 PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
fedf30e1
DM		 2575
2576 while (!last) {
2577 switch (actions & MDEREF_ACTION_MASK) {
2578
2579 case MDEREF_reload:
2580 actions = (++items)->uv;
2581 continue;
2b5060ae 2582 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM		 2583
2584 case MDEREF_HV_padhv_helem:
2585 is_hash = TRUE;
2b5060ae 2586 /* FALLTHROUGH */
fedf30e1
DM		 2587 case MDEREF_AV_padav_aelem:
2588 derefs = 1;
2589 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2590 goto do_elem;
2b5060ae 2591 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM		 2592
2593 case MDEREF_HV_gvhv_helem:
2594 is_hash = TRUE;
2b5060ae 2595 /* FALLTHROUGH */
fedf30e1
DM		 2596 case MDEREF_AV_gvav_aelem:
2597 derefs = 1;
dc3c1c70
DM		 2598 items++;
2599 sv = ITEM_SV(items);
8bbe2fa8 2600 S_append_gv_name(aTHX_ (GV*)sv, out);
fedf30e1 2601 goto do_elem;
2b5060ae 2602 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM		 2603
2604 case MDEREF_HV_gvsv_vivify_rv2hv_helem:
2605 is_hash = TRUE;
2b5060ae 2606 /* FALLTHROUGH */
fedf30e1 2607 case MDEREF_AV_gvsv_vivify_rv2av_aelem:
dc3c1c70
DM		 2608 items++;
2609 sv = ITEM_SV(items);
8bbe2fa8 2610 S_append_gv_name(aTHX_ (GV*)sv, out);
fedf30e1 2611 goto do_vivify_rv2xv_elem;
2b5060ae 2612 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM		 2613
2614 case MDEREF_HV_padsv_vivify_rv2hv_helem:
2615 is_hash = TRUE;
2b5060ae 2616 /* FALLTHROUGH */
fedf30e1
DM		 2617 case MDEREF_AV_padsv_vivify_rv2av_aelem:
2618 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2619 goto do_vivify_rv2xv_elem;
2b5060ae 2620 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM		 2621
2622 case MDEREF_HV_pop_rv2hv_helem:
2623 case MDEREF_HV_vivify_rv2hv_helem:
2624 is_hash = TRUE;
2b5060ae 2625 /* FALLTHROUGH */
fedf30e1
DM		 2626 do_vivify_rv2xv_elem:
2627 case MDEREF_AV_pop_rv2av_aelem:
2628 case MDEREF_AV_vivify_rv2av_aelem:
2629 if (!derefs++)
2630 sv_catpvs_nomg(out, "->");
2631 do_elem:
2632 if ((actions & MDEREF_INDEX_MASK)== MDEREF_INDEX_none) {
2633 sv_catpvs_nomg(out, "->");
2634 last = 1;
2635 break;
2636 }
2637
2638 sv_catpvn_nomg(out, (is_hash ? "{" : "["), 1);
2639 switch (actions & MDEREF_INDEX_MASK) {
2640 case MDEREF_INDEX_const:
2641 if (is_hash) {
dc3c1c70
DM		 2642 items++;
2643 sv = ITEM_SV(items);
2644 if (!sv)
2645 sv_catpvs_nomg(out, "???");
2646 else {
2647 STRLEN cur;
2648 char *s;
2649 s = SvPV(sv, cur);
2650 pv_pretty(out, s, cur, 30,
2651 NULL, NULL,
2652 (PERL_PV_PRETTY_NOCLEAR
2653 |PERL_PV_PRETTY_QUOTE
2654 |PERL_PV_PRETTY_ELLIPSES));
2655 }
fedf30e1
DM		 2656 }
2657 else
147e3846 2658 Perl_sv_catpvf(aTHX_ out, "%" IVdf, (++items)->iv);
fedf30e1
DM		 2659 break;
2660 case MDEREF_INDEX_padsv:
2661 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
2662 break;
2663 case MDEREF_INDEX_gvsv:
dc3c1c70
DM		 2664 items++;
2665 sv = ITEM_SV(items);
8bbe2fa8 2666 S_append_gv_name(aTHX_ (GV*)sv, out);
fedf30e1
DM		 2667 break;
2668 }
2669 sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
2670
2671 if (actions & MDEREF_FLAG_last)
2672 last = 1;
2673 is_hash = FALSE;
2674
2675 break;
2676
2677 default:
2678 PerlIO_printf(Perl_debug_log, "UNKNOWN(%d)",
2679 (int)(actions & MDEREF_ACTION_MASK));
2680 last = 1;
2681 break;
2682
2683 } /* switch */
2684
2685 actions >>= MDEREF_SHIFT;
2686 } /* while */
2687 return out;
2688}
2689
2690
bd16a5f0 2691I32
6867be6d 2692Perl_debop(pTHX_ const OP *o)
bd16a5f0 2693{
7918f24d
NC		 2694 PERL_ARGS_ASSERT_DEBOP;
2695
1045810a
IZ		 2696 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2697 return 0;
2698
bd16a5f0
IZ		 2699 Perl_deb(aTHX_ "%s", OP_NAME(o));
2700 switch (o->op_type) {
2701 case OP_CONST:
996c9baa 2702 case OP_HINTSEVAL:
6cefa69e 2703 /* With ITHREADS, consts are stored in the pad, and the right pad
7367e658 2704 * may not be active here, so check.
6cefa69e 2705 * Looks like only during compiling the pads are illegal.
7367e658 2706 */
6cefa69e
RU		 2707#ifdef USE_ITHREADS
2708 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2709#endif
7367e658 2710 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
bd16a5f0
IZ		 2711 break;
2712 case OP_GVSV:
2713 case OP_GV:
e18c4116
DM		 2714 PerlIO_printf(Perl_debug_log, "(%" SVf ")",
2715 SVfARG(S_gv_display(aTHX_ cGVOPo_gv)));
bd16a5f0 2716 break;
a7fd8ef6 2717
bd16a5f0
IZ		 2718 case OP_PADSV:
2719 case OP_PADAV:
2720 case OP_PADHV:
4fa06845 2721 case OP_ARGELEM:
f9b02e42
DM		 2722 S_deb_padvar(aTHX_ o->op_targ, 1, 1);
2723 break;
fedf30e1 2724
a7fd8ef6 2725 case OP_PADRANGE:
f9b02e42
DM		 2726 S_deb_padvar(aTHX_ o->op_targ,
2727 o->op_private & OPpPADRANGE_COUNTMASK, 1);
bd16a5f0 2728 break;
a7fd8ef6 2729
fedf30e1 2730 case OP_MULTIDEREF:
147e3846 2731 PerlIO_printf(Perl_debug_log, "(%" SVf ")",
ac892e4a 2732 SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
fedf30e1
DM		 2733 break;
2734
bd16a5f0 2735 default:
091ab601 2736 break;
bd16a5f0
IZ		 2737 }
2738 PerlIO_printf(Perl_debug_log, "\n");
2739 return 0;
2740}
2741
1e85b658
DM		 2742
2743/*
2744=for apidoc op_class
2745
2746Given an op, determine what type of struct it has been allocated as.
2747Returns one of the OPclass enums, such as OPclass_LISTOP.
2748
2749=cut
2750*/
2751
2752
2753OPclass
2754Perl_op_class(pTHX_ const OP *o)
2755{
2756 bool custom = 0;
2757
2758 if (!o)
2759 return OPclass_NULL;
2760
2761 if (o->op_type == 0) {
2762 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
2763 return OPclass_COP;
2764 return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP;
2765 }
2766
2767 if (o->op_type == OP_SASSIGN)
2768 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPclass_UNOP : OPclass_BINOP);
2769
2770 if (o->op_type == OP_AELEMFAST) {
2771#ifdef USE_ITHREADS
2772 return OPclass_PADOP;
2773#else
2774 return OPclass_SVOP;
2775#endif
2776 }
2777
2778#ifdef USE_ITHREADS
2779 if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
2780 o->op_type == OP_RCATLINE)
2781 return OPclass_PADOP;
2782#endif
2783
2784 if (o->op_type == OP_CUSTOM)
2785 custom = 1;
2786
2787 switch (OP_CLASS(o)) {
2788 case OA_BASEOP:
2789 return OPclass_BASEOP;
2790
2791 case OA_UNOP:
2792 return OPclass_UNOP;
2793
2794 case OA_BINOP:
2795 return OPclass_BINOP;
2796
2797 case OA_LOGOP:
2798 return OPclass_LOGOP;
2799
2800 case OA_LISTOP:
2801 return OPclass_LISTOP;
2802
2803 case OA_PMOP:
2804 return OPclass_PMOP;
2805
2806 case OA_SVOP:
2807 return OPclass_SVOP;
2808
2809 case OA_PADOP:
2810 return OPclass_PADOP;
2811
2812 case OA_PVOP_OR_SVOP:
2813 /*
2814 * Character translations (tr///) are usually a PVOP, keeping a
2815 * pointer to a table of shorts used to look up translations.
2816 * Under utf8, however, a simple table isn't practical; instead,
2817 * the OP is an SVOP (or, under threads, a PADOP),
2818 * and the SV is a reference to a swash
2819 * (i.e., an RV pointing to an HV).
2820 */
2821 return (!custom &&
2822 (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
2823 )
2824#if defined(USE_ITHREADS)
2825 ? OPclass_PADOP : OPclass_PVOP;
2826#else
2827 ? OPclass_SVOP : OPclass_PVOP;
2828#endif
2829
2830 case OA_LOOP:
2831 return OPclass_LOOP;
2832
2833 case OA_COP:
2834 return OPclass_COP;
2835
2836 case OA_BASEOP_OR_UNOP:
2837 /*
2838 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
2839 * whether parens were seen. perly.y uses OPf_SPECIAL to
2840 * signal whether a BASEOP had empty parens or none.
2841 * Some other UNOPs are created later, though, so the best
2842 * test is OPf_KIDS, which is set in newUNOP.
2843 */
2844 return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP;
2845
2846 case OA_FILESTATOP:
2847 /*
2848 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
2849 * the OPf_REF flag to distinguish between OP types instead of the
2850 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
2851 * return OPclass_UNOP so that walkoptree can find our children. If
2852 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
2853 * (no argument to the operator) it's an OP; with OPf_REF set it's
2854 * an SVOP (and op_sv is the GV for the filehandle argument).
2855 */
2856 return ((o->op_flags & OPf_KIDS) ? OPclass_UNOP :
2857#ifdef USE_ITHREADS
2858 (o->op_flags & OPf_REF) ? OPclass_PADOP : OPclass_BASEOP);
2859#else
2860 (o->op_flags & OPf_REF) ? OPclass_SVOP : OPclass_BASEOP);
2861#endif
2862 case OA_LOOPEXOP:
2863 /*
2864 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
2865 * label was omitted (in which case it's a BASEOP) or else a term was
2866 * seen. In this last case, all except goto are definitely PVOP but
2867 * goto is either a PVOP (with an ordinary constant label), an UNOP
2868 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
2869 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
2870 * get set.
2871 */
2872 if (o->op_flags & OPf_STACKED)
2873 return OPclass_UNOP;
2874 else if (o->op_flags & OPf_SPECIAL)
2875 return OPclass_BASEOP;
2876 else
2877 return OPclass_PVOP;
2878 case OA_METHOP:
2879 return OPclass_METHOP;
2880 case OA_UNOP_AUX:
2881 return OPclass_UNOP_AUX;
2882 }
2883 Perl_warn(aTHX_ "Can't determine class of operator %s, assuming BASEOP\n",
2884 OP_NAME(o));
2885 return OPclass_BASEOP;
2886}
2887
2888
2889
bd16a5f0 2890STATIC CV*
dc6240c9 2891S_deb_curcv(pTHX_ I32 ix)
bd16a5f0 2892{
dc6240c9
DM		 2893 PERL_SI *si = PL_curstackinfo;
2894 for (; ix >=0; ix--) {
2895 const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
2896
2897 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2898 return cx->blk_sub.cv;
2899 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2900 return cx->blk_eval.cv;
2901 else if (ix == 0 && si->si_type == PERLSI_MAIN)
2902 return PL_main_cv;
2903 else if (ix == 0 && CxTYPE(cx) == CXt_NULL
2904 && si->si_type == PERLSI_SORT)
2905 {
2906 /* fake sort sub; use CV of caller */
2907 si = si->si_prev;
2908 ix = si->si_cxix + 1;
2909 }
2910 }
2911 return NULL;
bd16a5f0
IZ		 2912}
2913
2914void
2915Perl_watch(pTHX_ char **addr)
2916{
7918f24d
NC		 2917 PERL_ARGS_ASSERT_WATCH;
2918
bd16a5f0
IZ		 2919 PL_watchaddr = addr;
2920 PL_watchok = *addr;
147e3846 2921 PerlIO_printf(Perl_debug_log, "WATCHING, %" UVxf " is currently %" UVxf "\n",
bd16a5f0
IZ		 2922 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2923}
2924
2925STATIC void
e1ec3a88 2926S_debprof(pTHX_ const OP *o)
bd16a5f0 2927{
7918f24d
NC		 2928 PERL_ARGS_ASSERT_DEBPROF;
2929
61f9802b 2930 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
1045810a 2931 return;
bd16a5f0 2932 if (!PL_profiledata)
a02a5408 2933 Newxz(PL_profiledata, MAXO, U32);
bd16a5f0
IZ		 2934 ++PL_profiledata[o->op_type];
2935}
2936
2937void
2938Perl_debprofdump(pTHX)
2939{
2940 unsigned i;
2941 if (!PL_profiledata)
2942 return;
2943 for (i = 0; i < MAXO; i++) {
2944 if (PL_profiledata[i])
2945 PerlIO_printf(Perl_debug_log,
2946 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2947 PL_op_name[i]);
2948 }
2949}
66610fdd 2950
3b721df9 2951
66610fdd 2952/*
14d04a33 2953 * ex: set ts=8 sts=4 sw=4 et:
37442d52 2954 */
Unnamed repository; edit this file 'description' to name the repository.