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