3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
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.
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.'
15 * [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
18 /* This file contains utility routines to dump the contents of SV and OP
19 * structures, as used by command-line options like -Dt and -Dx, and
22 * It also holds the debugging version of the runops function.
24 =head1 Display and Dump functions
28 #define PERL_IN_DUMP_C
32 static const char* const svtypenames[SVt_LAST] = {
52 static const char* const svshorttypenames[SVt_LAST] = {
77 S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
78 const struct flag_to_name *const end)
81 if (flags & start->flag)
82 sv_catpv(sv, start->name);
83 } while (++start < end);
86 #define append_flags(sv, f, flags) \
87 S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
89 #define generic_pv_escape(sv,s,len,utf8) pv_escape( (sv), (s), (len), \
90 (len) * (4+UTF8_MAXBYTES) + 1, NULL, \
91 PERL_PV_ESCAPE_NONASCII | PERL_PV_ESCAPE_DWIM \
92 | ((utf8) ? PERL_PV_ESCAPE_UNI : 0) )
97 Escapes at most the first "count" chars of pv and puts the results into
98 dsv such that the size of the escaped string will not exceed "max" chars
99 and will not contain any incomplete escape sequences.
101 If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
102 will also be escaped.
104 Normally the SV will be cleared before the escaped string is prepared,
105 but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
107 If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
108 if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
109 using C<is_utf8_string()> to determine if it is Unicode.
111 If PERL_PV_ESCAPE_ALL is set then all input chars will be output
112 using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
113 non-ASCII chars will be escaped using this style; otherwise, only chars above
114 255 will be so escaped; other non printable chars will use octal or
115 common escaped patterns like C<\n>.
116 Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
117 then all chars below 255 will be treated as printable and
118 will be output as literals.
120 If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
121 string will be escaped, regardless of max. If the output is to be in hex,
122 then it will be returned as a plain hex
123 sequence. Thus the output will either be a single char,
124 an octal escape sequence, a special escape like C<\n> or a hex value.
126 If PERL_PV_ESCAPE_RE is set then the escape char used will be a '%' and
127 not a '\\'. This is because regexes very often contain backslashed
128 sequences, whereas '%' is not a particularly common character in patterns.
130 Returns a pointer to the escaped text as held by dsv.
134 #define PV_ESCAPE_OCTBUFSIZE 32
137 Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
138 const STRLEN count, const STRLEN max,
139 STRLEN * const escaped, const U32 flags )
141 const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
142 const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
143 char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
144 STRLEN wrote = 0; /* chars written so far */
145 STRLEN chsize = 0; /* size of data to be written */
146 STRLEN readsize = 1; /* size of data just read */
147 bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
148 const char *pv = str;
149 const char * const end = pv + count; /* end of string */
152 PERL_ARGS_ASSERT_PV_ESCAPE;
154 if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
155 /* This won't alter the UTF-8 flag */
159 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
162 for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
163 const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
164 const U8 c = (U8)u & 0xFF;
167 || (flags & PERL_PV_ESCAPE_ALL)
168 || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM))))
170 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
171 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
174 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
175 ((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
177 : "%cx{%02"UVxf"}", esc, u);
179 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
182 if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
186 case '\\' : /* FALLTHROUGH */
187 case '%' : if ( c == esc ) {
193 case '\v' : octbuf[1] = 'v'; break;
194 case '\t' : octbuf[1] = 't'; break;
195 case '\r' : octbuf[1] = 'r'; break;
196 case '\n' : octbuf[1] = 'n'; break;
197 case '\f' : octbuf[1] = 'f'; break;
205 if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) {
206 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
207 isuni ? "%cx{%02"UVxf"}" : "%cx%02"UVxf,
210 else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) )
211 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
214 chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
221 if ( max && (wrote + chsize > max) ) {
223 } else if (chsize > 1) {
224 sv_catpvn(dsv, octbuf, chsize);
227 /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
228 can be appended raw to the dsv. If dsv happens to be
229 UTF-8 then we need catpvf to upgrade them for us.
230 Or add a new API call sv_catpvc(). Think about that name, and
231 how to keep it clear that it's unlike the s of catpvs, which is
232 really an array of octets, not a string. */
233 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
236 if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
244 =for apidoc pv_pretty
246 Converts a string into something presentable, handling escaping via
247 pv_escape() and supporting quoting and ellipses.
249 If the PERL_PV_PRETTY_QUOTE flag is set then the result will be
250 double quoted with any double quotes in the string escaped. Otherwise
251 if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
254 If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in
255 string were output then an ellipsis C<...> will be appended to the
256 string. Note that this happens AFTER it has been quoted.
258 If start_color is non-null then it will be inserted after the opening
259 quote (if there is one) but before the escaped text. If end_color
260 is non-null then it will be inserted after the escaped text but before
261 any quotes or ellipses.
263 Returns a pointer to the prettified text as held by dsv.
269 Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
270 const STRLEN max, char const * const start_color, char const * const end_color,
273 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
276 PERL_ARGS_ASSERT_PV_PRETTY;
278 if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
279 /* This won't alter the UTF-8 flag */
284 sv_catpvs(dsv, "\"");
285 else if ( flags & PERL_PV_PRETTY_LTGT )
288 if ( start_color != NULL )
289 sv_catpv(dsv, start_color);
291 pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
293 if ( end_color != NULL )
294 sv_catpv(dsv, end_color);
297 sv_catpvs( dsv, "\"");
298 else if ( flags & PERL_PV_PRETTY_LTGT )
301 if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
302 sv_catpvs(dsv, "...");
308 =for apidoc pv_display
312 pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE);
314 except that an additional "\0" will be appended to the string when
315 len > cur and pv[cur] is "\0".
317 Note that the final string may be up to 7 chars longer than pvlim.
323 Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
325 PERL_ARGS_ASSERT_PV_DISPLAY;
327 pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
328 if (len > cur && pv[cur] == '\0')
329 sv_catpvs( dsv, "\\0");
334 Perl_sv_peek(pTHX_ SV *sv)
337 SV * const t = sv_newmortal();
347 else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
348 /* detect data corruption under memory poisoning */
352 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
353 if (sv == &PL_sv_undef) {
354 sv_catpv(t, "SV_UNDEF");
355 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
356 SVs_GMG|SVs_SMG|SVs_RMG)) &&
360 else if (sv == &PL_sv_no) {
361 sv_catpv(t, "SV_NO");
362 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
363 SVs_GMG|SVs_SMG|SVs_RMG)) &&
364 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
370 else if (sv == &PL_sv_yes) {
371 sv_catpv(t, "SV_YES");
372 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
373 SVs_GMG|SVs_SMG|SVs_RMG)) &&
374 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
377 SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
382 sv_catpv(t, "SV_PLACEHOLDER");
383 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
384 SVs_GMG|SVs_SMG|SVs_RMG)) &&
390 else if (SvREFCNT(sv) == 0) {
394 else if (DEBUG_R_TEST_) {
397 /* is this SV on the tmps stack? */
398 for (ix=PL_tmps_ix; ix>=0; ix--) {
399 if (PL_tmps_stack[ix] == sv) {
404 if (SvREFCNT(sv) > 1)
405 Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
413 if (SvCUR(t) + unref > 10) {
414 SvCUR_set(t, unref + 3);
423 if (type == SVt_PVCV) {
424 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
426 Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
427 ? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
430 } else if (type < SVt_LAST) {
431 sv_catpv(t, svshorttypenames[type]);
433 if (type == SVt_NULL)
436 sv_catpv(t, "FREED");
441 if (!SvPVX_const(sv))
442 sv_catpv(t, "(null)");
444 SV * const tmp = newSVpvs("");
448 SvOOK_offset(sv, delta);
449 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
451 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
453 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
454 sv_uni_display(tmp, sv, 6 * SvCUR(sv),
456 SvREFCNT_dec_NN(tmp);
459 else if (SvNOKp(sv)) {
460 STORE_NUMERIC_LOCAL_SET_STANDARD();
461 Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
462 RESTORE_NUMERIC_LOCAL();
464 else if (SvIOKp(sv)) {
466 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv));
468 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv));
476 if (TAINTING_get && sv && SvTAINTED(sv))
477 sv_catpv(t, " [tainted]");
478 return SvPV_nolen(t);
482 =head1 Debugging Utilities
486 Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
489 PERL_ARGS_ASSERT_DUMP_INDENT;
491 dump_vindent(level, file, pat, &args);
496 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
499 PERL_ARGS_ASSERT_DUMP_VINDENT;
500 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
501 PerlIO_vprintf(file, pat, *args);
507 Dumps the entire optree of the current program starting at C<PL_main_root> to
508 C<STDERR>. Also dumps the optrees for all visible subroutines in
517 dump_all_perl(FALSE);
521 Perl_dump_all_perl(pTHX_ bool justperl)
525 PerlIO_setlinebuf(Perl_debug_log);
527 op_dump(PL_main_root);
528 dump_packsubs_perl(PL_defstash, justperl);
532 =for apidoc dump_packsubs
534 Dumps the optrees for all visible subroutines in C<stash>.
540 Perl_dump_packsubs(pTHX_ const HV *stash)
542 PERL_ARGS_ASSERT_DUMP_PACKSUBS;
543 dump_packsubs_perl(stash, FALSE);
547 Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
552 PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
556 for (i = 0; i <= (I32) HvMAX(stash); i++) {
558 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
559 const GV * const gv = (const GV *)HeVAL(entry);
560 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
563 dump_sub_perl(gv, justperl);
566 if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
567 const HV * const hv = GvHV(gv);
568 if (hv && (hv != PL_defstash))
569 dump_packsubs_perl(hv, justperl); /* nested package */
576 Perl_dump_sub(pTHX_ const GV *gv)
578 PERL_ARGS_ASSERT_DUMP_SUB;
579 dump_sub_perl(gv, FALSE);
583 Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
586 SV * const sv = newSVpvs_flags("", SVs_TEMP);
590 PERL_ARGS_ASSERT_DUMP_SUB_PERL;
592 if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
595 tmpsv = newSVpvs_flags("", SVs_TEMP);
596 gv_fullname3(sv, gv, NULL);
597 name = SvPV_const(sv, len);
598 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
599 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
600 if (CvISXSUB(GvCV(gv)))
601 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
602 PTR2UV(CvXSUB(GvCV(gv))),
603 (int)CvXSUBANY(GvCV(gv)).any_i32);
604 else if (CvROOT(GvCV(gv)))
605 op_dump(CvROOT(GvCV(gv)));
607 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
611 Perl_dump_form(pTHX_ const GV *gv)
613 SV * const sv = sv_newmortal();
615 PERL_ARGS_ASSERT_DUMP_FORM;
617 gv_fullname3(sv, gv, NULL);
618 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
619 if (CvROOT(GvFORM(gv)))
620 op_dump(CvROOT(GvFORM(gv)));
622 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
629 op_dump(PL_eval_root);
633 Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
637 PERL_ARGS_ASSERT_DO_PMOP_DUMP;
640 Perl_dump_indent(aTHX_ level, file, "{}\n");
643 Perl_dump_indent(aTHX_ level, file, "{\n");
645 if (pm->op_pmflags & PMf_ONCE)
650 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
651 ch, RX_PRECOMP(PM_GETRE(pm)), ch,
652 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
654 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
655 if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
656 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
657 op_dump(pm->op_pmreplrootu.op_pmreplroot);
659 if (pm->op_code_list) {
660 if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
661 Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
662 do_op_dump(level, file, pm->op_code_list);
665 Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
666 PTR2UV(pm->op_code_list));
668 if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
669 SV * const tmpsv = pm_description(pm);
670 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
671 SvREFCNT_dec_NN(tmpsv);
674 Perl_dump_indent(aTHX_ level-1, file, "}\n");
677 const struct flag_to_name pmflags_flags_names[] = {
678 {PMf_CONST, ",CONST"},
680 {PMf_GLOBAL, ",GLOBAL"},
681 {PMf_CONTINUE, ",CONTINUE"},
682 {PMf_RETAINT, ",RETAINT"},
684 {PMf_NONDESTRUCT, ",NONDESTRUCT"},
685 {PMf_HAS_CV, ",HAS_CV"},
686 {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
687 {PMf_IS_QR, ",IS_QR"}
691 S_pm_description(pTHX_ const PMOP *pm)
693 SV * const desc = newSVpvs("");
694 const REGEXP * const regex = PM_GETRE(pm);
695 const U32 pmflags = pm->op_pmflags;
697 PERL_ARGS_ASSERT_PM_DESCRIPTION;
699 if (pmflags & PMf_ONCE)
700 sv_catpv(desc, ",ONCE");
702 if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
703 sv_catpv(desc, ":USED");
705 if (pmflags & PMf_USED)
706 sv_catpv(desc, ":USED");
710 if (RX_ISTAINTED(regex))
711 sv_catpv(desc, ",TAINTED");
712 if (RX_CHECK_SUBSTR(regex)) {
713 if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
714 sv_catpv(desc, ",SCANFIRST");
715 if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
716 sv_catpv(desc, ",ALL");
718 if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
719 sv_catpv(desc, ",SKIPWHITE");
722 append_flags(desc, pmflags, pmflags_flags_names);
727 Perl_pmop_dump(pTHX_ PMOP *pm)
729 do_pmop_dump(0, Perl_debug_log, pm);
732 /* Return a unique integer to represent the address of op o.
733 * If it already exists in PL_op_sequence, just return it;
735 * *** Note that this isn't thread-safe */
738 S_sequence_num(pTHX_ const OP *o)
747 op = newSVuv(PTR2UV(o));
749 key = SvPV_const(op, len);
751 PL_op_sequence = newHV();
752 seq = hv_fetch(PL_op_sequence, key, len, 0);
755 (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0);
759 const struct flag_to_name op_flags_names[] = {
761 {OPf_PARENS, ",PARENS"},
764 {OPf_STACKED, ",STACKED"},
765 {OPf_SPECIAL, ",SPECIAL"}
768 const struct flag_to_name op_trans_names[] = {
769 {OPpTRANS_FROM_UTF, ",FROM_UTF"},
770 {OPpTRANS_TO_UTF, ",TO_UTF"},
771 {OPpTRANS_IDENTICAL, ",IDENTICAL"},
772 {OPpTRANS_SQUASH, ",SQUASH"},
773 {OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
774 {OPpTRANS_GROWS, ",GROWS"},
775 {OPpTRANS_DELETE, ",DELETE"}
778 const struct flag_to_name op_entersub_names[] = {
779 {OPpENTERSUB_DB, ",DB"},
780 {OPpENTERSUB_HASTARG, ",HASTARG"},
781 {OPpENTERSUB_AMPER, ",AMPER"},
782 {OPpENTERSUB_NOPAREN, ",NOPAREN"},
783 {OPpENTERSUB_INARGS, ",INARGS"}
786 const struct flag_to_name op_const_names[] = {
787 {OPpCONST_NOVER, ",NOVER"},
788 {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
789 {OPpCONST_STRICT, ",STRICT"},
790 {OPpCONST_ENTERED, ",ENTERED"},
791 {OPpCONST_BARE, ",BARE"}
794 const struct flag_to_name op_sort_names[] = {
795 {OPpSORT_NUMERIC, ",NUMERIC"},
796 {OPpSORT_INTEGER, ",INTEGER"},
797 {OPpSORT_REVERSE, ",REVERSE"},
798 {OPpSORT_INPLACE, ",INPLACE"},
799 {OPpSORT_DESCEND, ",DESCEND"},
800 {OPpSORT_QSORT, ",QSORT"},
801 {OPpSORT_STABLE, ",STABLE"}
804 const struct flag_to_name op_open_names[] = {
805 {OPpOPEN_IN_RAW, ",IN_RAW"},
806 {OPpOPEN_IN_CRLF, ",IN_CRLF"},
807 {OPpOPEN_OUT_RAW, ",OUT_RAW"},
808 {OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
811 const struct flag_to_name op_sassign_names[] = {
812 {OPpASSIGN_BACKWARDS, ",BACKWARDS"},
813 {OPpASSIGN_CV_TO_GV, ",CV2GV"}
816 const struct flag_to_name op_leave_names[] = {
817 {OPpREFCOUNTED, ",REFCOUNTED"},
818 {OPpLVALUE, ",LVALUE"}
821 #define OP_PRIVATE_ONCE(op, flag, name) \
822 const struct flag_to_name CAT2(op, _names)[] = { \
826 OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
827 OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
828 OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
829 OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
830 OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
831 OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
832 OP_PRIVATE_ONCE(op_list, OPpLIST_GUESSED, ",GUESSED");
833 OP_PRIVATE_ONCE(op_delete, OPpSLICE, ",SLICE");
834 OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
835 OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
836 OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
837 OP_PRIVATE_ONCE(op_dbstate, OPpHUSH_VMSISH, ",HUSH_VMSISH");
839 struct op_private_by_op {
842 const struct flag_to_name *start;
845 const struct op_private_by_op op_private_names[] = {
846 {OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
847 {OP_LEAVE, C_ARRAY_LENGTH(op_leave_names), op_leave_names },
848 {OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
849 {OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
850 {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
851 {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
852 {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
853 {OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
854 {OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
855 {OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
856 {OP_LIST, C_ARRAY_LENGTH(op_list_names), op_list_names },
857 {OP_SASSIGN, C_ARRAY_LENGTH(op_sassign_names), op_sassign_names },
858 {OP_REPEAT, C_ARRAY_LENGTH(op_repeat_names), op_repeat_names },
859 {OP_RV2CV, C_ARRAY_LENGTH(op_rv2cv_names), op_rv2cv_names },
860 {OP_TRANS, C_ARRAY_LENGTH(op_trans_names), op_trans_names },
861 {OP_CONST, C_ARRAY_LENGTH(op_const_names), op_const_names },
862 {OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
863 {OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
864 {OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
865 {OP_DBSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
866 {OP_NEXTSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
867 {OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
871 S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
872 const struct op_private_by_op *start = op_private_names;
873 const struct op_private_by_op *const end = C_ARRAY_END(op_private_names);
875 /* This is a linear search, but no worse than the code that it replaced.
876 It's debugging code - size is more important than speed. */
878 if (optype == start->op_type) {
879 S_append_flags(aTHX_ tmpsv, op_private, start->start,
880 start->start + start->len);
883 } while (++start < end);
887 #define DUMP_OP_FLAGS(o,level,file) \
888 if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
889 SV * const tmpsv = newSVpvs(""); \
890 switch (o->op_flags & OPf_WANT) { \
891 case OPf_WANT_VOID: \
892 sv_catpv(tmpsv, ",VOID"); \
894 case OPf_WANT_SCALAR: \
895 sv_catpv(tmpsv, ",SCALAR"); \
897 case OPf_WANT_LIST: \
898 sv_catpv(tmpsv, ",LIST"); \
901 sv_catpv(tmpsv, ",UNKNOWN"); \
904 append_flags(tmpsv, o->op_flags, op_flags_names); \
905 if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
906 if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
907 if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
908 if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED"); \
909 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
910 SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : ""); \
913 #define DUMP_OP_PRIVATE(o,level,file) \
914 if (o->op_private) { \
915 U32 optype = o->op_type; \
916 U32 oppriv = o->op_private; \
917 SV * const tmpsv = newSVpvs(""); \
918 if (PL_opargs[optype] & OA_TARGLEX) { \
919 if (oppriv & OPpTARGET_MY) \
920 sv_catpv(tmpsv, ",TARGET_MY"); \
922 else if (optype == OP_ENTERSUB || \
923 optype == OP_RV2SV || \
924 optype == OP_GVSV || \
925 optype == OP_RV2AV || \
926 optype == OP_RV2HV || \
927 optype == OP_RV2GV || \
928 optype == OP_AELEM || \
929 optype == OP_HELEM ) \
931 if (optype == OP_ENTERSUB) { \
932 append_flags(tmpsv, oppriv, op_entersub_names); \
935 switch (oppriv & OPpDEREF) { \
937 sv_catpv(tmpsv, ",SV"); \
940 sv_catpv(tmpsv, ",AV"); \
943 sv_catpv(tmpsv, ",HV"); \
946 if (oppriv & OPpMAYBE_LVSUB) \
947 sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
949 if (optype == OP_AELEM || optype == OP_HELEM) { \
950 if (oppriv & OPpLVAL_DEFER) \
951 sv_catpv(tmpsv, ",LVAL_DEFER"); \
953 else if (optype == OP_RV2HV || optype == OP_PADHV) { \
954 if (oppriv & OPpMAYBE_TRUEBOOL) \
955 sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
956 if (oppriv & OPpTRUEBOOL) \
957 sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
960 if (oppriv & HINT_STRICT_REFS) \
961 sv_catpv(tmpsv, ",STRICT_REFS"); \
962 if (oppriv & OPpOUR_INTRO) \
963 sv_catpv(tmpsv, ",OUR_INTRO"); \
966 else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
968 else if (OP_IS_FILETEST(o->op_type)) { \
969 if (oppriv & OPpFT_ACCESS) \
970 sv_catpv(tmpsv, ",FT_ACCESS"); \
971 if (oppriv & OPpFT_STACKED) \
972 sv_catpv(tmpsv, ",FT_STACKED"); \
973 if (oppriv & OPpFT_STACKING) \
974 sv_catpv(tmpsv, ",FT_STACKING"); \
975 if (oppriv & OPpFT_AFTER_t) \
976 sv_catpv(tmpsv, ",AFTER_t"); \
978 else if (o->op_type == OP_AASSIGN) { \
979 if (oppriv & OPpASSIGN_COMMON) \
980 sv_catpvs(tmpsv, ",COMMON"); \
981 if (oppriv & OPpMAYBE_LVSUB) \
982 sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
984 if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
985 sv_catpv(tmpsv, ",INTRO"); \
986 if (o->op_type == OP_PADRANGE) \
987 Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
988 (UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
989 if ( (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV || \
990 o->op_type == OP_PADAV || o->op_type == OP_PADHV || \
991 o->op_type == OP_ASLICE || o->op_type == OP_HSLICE) \
992 && oppriv & OPpSLICEWARNING ) \
993 sv_catpvs(tmpsv, ",SLICEWARNING"); \
994 if (SvCUR(tmpsv)) { \
995 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
997 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
1003 Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
1007 const OPCODE optype = o->op_type;
1009 PERL_ARGS_ASSERT_DO_OP_DUMP;
1011 Perl_dump_indent(aTHX_ level, file, "{\n");
1013 seq = sequence_num(o);
1015 PerlIO_printf(file, "%-4"UVuf, seq);
1017 PerlIO_printf(file, "????");
1019 "%*sTYPE = %s ===> ",
1020 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
1023 o->op_type == OP_NULL ? "(%"UVuf")\n" : "%"UVuf"\n",
1024 sequence_num(o->op_next));
1026 PerlIO_printf(file, "NULL\n");
1028 if (optype == OP_NULL) {
1029 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
1030 if (o->op_targ == OP_NEXTSTATE) {
1032 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1033 (UV)CopLINE(cCOPo));
1034 if (CopSTASHPV(cCOPo)) {
1035 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1036 HV *stash = CopSTASH(cCOPo);
1037 const char * const hvname = HvNAME_get(stash);
1039 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1040 generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
1042 if (CopLABEL(cCOPo)) {
1043 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1046 const char *label = CopLABEL_len_flags(cCOPo,
1049 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1050 generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
1056 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
1059 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
1062 DUMP_OP_FLAGS(o,level,file);
1063 DUMP_OP_PRIVATE(o,level,file);
1071 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
1073 if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
1074 if (cSVOPo->op_sv) {
1077 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1078 SV * const tmpsv2 = newSVpvs_flags("", SVs_TEMP);
1079 gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
1080 name = SvPV_const(tmpsv, len);
1081 Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
1082 generic_pv_escape( tmpsv2, name, len, SvUTF8(tmpsv)));
1085 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
1091 case OP_METHOD_NAMED:
1092 #ifndef USE_ITHREADS
1093 /* with ITHREADS, consts are stored in the pad, and the right pad
1094 * may not be active here, so skip */
1095 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
1101 Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
1102 (UV)CopLINE(cCOPo));
1103 if (CopSTASHPV(cCOPo)) {
1104 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1105 HV *stash = CopSTASH(cCOPo);
1106 const char * const hvname = HvNAME_get(stash);
1108 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
1109 generic_pv_escape(tmpsv, hvname,
1110 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1112 if (CopLABEL(cCOPo)) {
1113 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1116 const char *label = CopLABEL_len_flags(cCOPo,
1117 &label_len, &label_flags);
1118 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
1119 generic_pv_escape( tmpsv, label, label_len,
1120 (label_flags & SVf_UTF8)));
1124 Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
1125 if (cLOOPo->op_redoop)
1126 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_redoop));
1128 PerlIO_printf(file, "DONE\n");
1129 Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
1130 if (cLOOPo->op_nextop)
1131 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_nextop));
1133 PerlIO_printf(file, "DONE\n");
1134 Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
1135 if (cLOOPo->op_lastop)
1136 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOOPo->op_lastop));
1138 PerlIO_printf(file, "DONE\n");
1146 Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
1147 if (cLOGOPo->op_other)
1148 PerlIO_printf(file, "%"UVuf"\n", sequence_num(cLOGOPo->op_other));
1150 PerlIO_printf(file, "DONE\n");
1156 do_pmop_dump(level, file, cPMOPo);
1164 if (o->op_private & OPpREFCOUNTED)
1165 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
1170 if (o->op_flags & OPf_KIDS) {
1172 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
1173 do_op_dump(level, file, kid);
1175 Perl_dump_indent(aTHX_ level-1, file, "}\n");
1181 Dumps the optree starting at OP C<o> to C<STDERR>.
1187 Perl_op_dump(pTHX_ const OP *o)
1189 PERL_ARGS_ASSERT_OP_DUMP;
1190 do_op_dump(0, Perl_debug_log, o);
1194 Perl_gv_dump(pTHX_ GV *gv)
1198 SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
1201 PERL_ARGS_ASSERT_GV_DUMP;
1204 PerlIO_printf(Perl_debug_log, "{}\n");
1207 sv = sv_newmortal();
1208 PerlIO_printf(Perl_debug_log, "{\n");
1209 gv_fullname3(sv, gv, NULL);
1210 name = SvPV_const(sv, len);
1211 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1212 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1213 if (gv != GvEGV(gv)) {
1214 gv_efullname3(sv, GvEGV(gv), NULL);
1215 name = SvPV_const(sv, len);
1216 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1217 generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
1219 PerlIO_putc(Perl_debug_log, '\n');
1220 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
1224 /* map magic types to the symbolic names
1225 * (with the PERL_MAGIC_ prefixed stripped)
1228 static const struct { const char type; const char *name; } magic_names[] = {
1229 #include "mg_names.c"
1230 /* this null string terminates the list */
1235 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1237 PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
1239 for (; mg; mg = mg->mg_moremagic) {
1240 Perl_dump_indent(aTHX_ level, file,
1241 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
1242 if (mg->mg_virtual) {
1243 const MGVTBL * const v = mg->mg_virtual;
1244 if (v >= PL_magic_vtables
1245 && v < PL_magic_vtables + magic_vtable_max) {
1246 const U32 i = v - PL_magic_vtables;
1247 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]);
1250 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
1253 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
1256 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private);
1260 const char *name = NULL;
1261 for (n = 0; magic_names[n].name; n++) {
1262 if (mg->mg_type == magic_names[n].type) {
1263 name = magic_names[n].name;
1268 Perl_dump_indent(aTHX_ level, file,
1269 " MG_TYPE = PERL_MAGIC_%s\n", name);
1271 Perl_dump_indent(aTHX_ level, file,
1272 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
1276 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
1277 if (mg->mg_type == PERL_MAGIC_envelem &&
1278 mg->mg_flags & MGf_TAINTEDDIR)
1279 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
1280 if (mg->mg_type == PERL_MAGIC_regex_global &&
1281 mg->mg_flags & MGf_MINMATCH)
1282 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
1283 if (mg->mg_flags & MGf_REFCOUNTED)
1284 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
1285 if (mg->mg_flags & MGf_GSKIP)
1286 Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
1287 if (mg->mg_flags & MGf_COPY)
1288 Perl_dump_indent(aTHX_ level, file, " COPY\n");
1289 if (mg->mg_flags & MGf_DUP)
1290 Perl_dump_indent(aTHX_ level, file, " DUP\n");
1291 if (mg->mg_flags & MGf_LOCAL)
1292 Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
1293 if (mg->mg_type == PERL_MAGIC_regex_global &&
1294 mg->mg_flags & MGf_BYTES)
1295 Perl_dump_indent(aTHX_ level, file, " BYTES\n");
1298 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
1299 PTR2UV(mg->mg_obj));
1300 if (mg->mg_type == PERL_MAGIC_qr) {
1301 REGEXP* const re = (REGEXP *)mg->mg_obj;
1302 SV * const dsv = sv_newmortal();
1303 const char * const s
1304 = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
1306 ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
1307 (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
1309 Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
1310 Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
1313 if (mg->mg_flags & MGf_REFCOUNTED)
1314 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
1317 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len);
1319 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
1320 if (mg->mg_len >= 0) {
1321 if (mg->mg_type != PERL_MAGIC_utf8) {
1322 SV * const sv = newSVpvs("");
1323 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
1324 SvREFCNT_dec_NN(sv);
1327 else if (mg->mg_len == HEf_SVKEY) {
1328 PerlIO_puts(file, " => HEf_SVKEY\n");
1329 do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
1330 maxnest, dumpops, pvlim); /* MG is already +1 */
1333 else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
1338 " does not know how to handle this MG_LEN"
1340 PerlIO_putc(file, '\n');
1342 if (mg->mg_type == PERL_MAGIC_utf8) {
1343 const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
1346 for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
1347 Perl_dump_indent(aTHX_ level, file,
1348 " %2"IVdf": %"UVuf" -> %"UVuf"\n",
1351 (UV)cache[i * 2 + 1]);
1358 Perl_magic_dump(pTHX_ const MAGIC *mg)
1360 do_magic_dump(0, Perl_debug_log, mg, 0, 0, FALSE, 0);
1364 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
1368 PERL_ARGS_ASSERT_DO_HV_DUMP;
1370 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1371 if (sv && (hvname = HvNAME_get(sv)))
1373 /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
1374 name which quite legally could contain insane things like tabs, newlines, nulls or
1375 other scary crap - this should produce sane results - except maybe for unicode package
1376 names - but we will wait for someone to file a bug on that - demerphq */
1377 SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
1378 PerlIO_printf(file, "\t\"%s\"\n",
1379 generic_pv_escape( tmpsv, hvname,
1380 HvNAMELEN(sv), HvNAMEUTF8(sv)));
1383 PerlIO_putc(file, '\n');
1387 Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1389 PERL_ARGS_ASSERT_DO_GV_DUMP;
1391 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1392 if (sv && GvNAME(sv)) {
1393 SV * const tmpsv = newSVpvs("");
1394 PerlIO_printf(file, "\t\"%s\"\n",
1395 generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
1398 PerlIO_putc(file, '\n');
1402 Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
1404 PERL_ARGS_ASSERT_DO_GVGV_DUMP;
1406 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
1407 if (sv && GvNAME(sv)) {
1408 SV *tmp = newSVpvs_flags("", SVs_TEMP);
1410 HV * const stash = GvSTASH(sv);
1411 PerlIO_printf(file, "\t");
1412 /* TODO might have an extra \" here */
1413 if (stash && (hvname = HvNAME_get(stash))) {
1414 PerlIO_printf(file, "\"%s\" :: \"",
1415 generic_pv_escape(tmp, hvname,
1416 HvNAMELEN(stash), HvNAMEUTF8(stash)));
1418 PerlIO_printf(file, "%s\"\n",
1419 generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
1422 PerlIO_putc(file, '\n');
1425 const struct flag_to_name first_sv_flags_names[] = {
1426 {SVs_TEMP, "TEMP,"},
1427 {SVs_OBJECT, "OBJECT,"},
1436 const struct flag_to_name second_sv_flags_names[] = {
1438 {SVf_FAKE, "FAKE,"},
1439 {SVf_READONLY, "READONLY,"},
1440 {SVf_IsCOW, "IsCOW,"},
1441 {SVf_BREAK, "BREAK,"},
1442 {SVf_AMAGIC, "OVERLOAD,"},
1448 const struct flag_to_name cv_flags_names[] = {
1449 {CVf_ANON, "ANON,"},
1450 {CVf_UNIQUE, "UNIQUE,"},
1451 {CVf_CLONE, "CLONE,"},
1452 {CVf_CLONED, "CLONED,"},
1453 {CVf_CONST, "CONST,"},
1454 {CVf_NODEBUG, "NODEBUG,"},
1455 {CVf_LVALUE, "LVALUE,"},
1456 {CVf_METHOD, "METHOD,"},
1457 {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
1458 {CVf_CVGV_RC, "CVGV_RC,"},
1459 {CVf_DYNFILE, "DYNFILE,"},
1460 {CVf_AUTOLOAD, "AUTOLOAD,"},
1461 {CVf_HASEVAL, "HASEVAL"},
1462 {CVf_SLABBED, "SLABBED,"},
1463 {CVf_ISXSUB, "ISXSUB,"}
1466 const struct flag_to_name hv_flags_names[] = {
1467 {SVphv_SHAREKEYS, "SHAREKEYS,"},
1468 {SVphv_LAZYDEL, "LAZYDEL,"},
1469 {SVphv_HASKFLAGS, "HASKFLAGS,"},
1470 {SVphv_CLONEABLE, "CLONEABLE,"}
1473 const struct flag_to_name gp_flags_names[] = {
1474 {GVf_INTRO, "INTRO,"},
1475 {GVf_MULTI, "MULTI,"},
1476 {GVf_ASSUMECV, "ASSUMECV,"},
1477 {GVf_IN_PAD, "IN_PAD,"}
1480 const struct flag_to_name gp_flags_imported_names[] = {
1481 {GVf_IMPORTED_SV, " SV"},
1482 {GVf_IMPORTED_AV, " AV"},
1483 {GVf_IMPORTED_HV, " HV"},
1484 {GVf_IMPORTED_CV, " CV"},
1487 /* NOTE: this structure is mostly duplicative of one generated by
1488 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1489 * the two. - Yves */
1490 const struct flag_to_name regexp_extflags_names[] = {
1491 {RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
1492 {RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
1493 {RXf_PMf_FOLD, "PMf_FOLD,"},
1494 {RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
1495 {RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
1496 {RXf_IS_ANCHORED, "IS_ANCHORED,"},
1497 {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
1498 {RXf_EVAL_SEEN, "EVAL_SEEN,"},
1499 {RXf_CHECK_ALL, "CHECK_ALL,"},
1500 {RXf_MATCH_UTF8, "MATCH_UTF8,"},
1501 {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
1502 {RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
1503 {RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
1504 {RXf_SPLIT, "SPLIT,"},
1505 {RXf_COPY_DONE, "COPY_DONE,"},
1506 {RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
1507 {RXf_TAINTED, "TAINTED,"},
1508 {RXf_START_ONLY, "START_ONLY,"},
1509 {RXf_SKIPWHITE, "SKIPWHITE,"},
1510 {RXf_WHITE, "WHITE,"},
1511 {RXf_NULL, "NULL,"},
1514 /* NOTE: this structure is mostly duplicative of one generated by
1515 * 'make regen' in regnodes.h - perhaps we should somehow integrate
1516 * the two. - Yves */
1517 const struct flag_to_name regexp_core_intflags_names[] = {
1518 {PREGf_SKIP, "SKIP,"},
1519 {PREGf_IMPLICIT, "IMPLICIT,"},
1520 {PREGf_NAUGHTY, "NAUGHTY,"},
1521 {PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
1522 {PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
1523 {PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
1524 {PREGf_NOSCAN, "NOSCAN,"},
1525 {PREGf_CANY_SEEN, "CANY_SEEN,"},
1526 {PREGf_GPOS_SEEN, "GPOS_SEEN,"},
1527 {PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
1528 {PREGf_ANCH_BOL, "ANCH_BOL,"},
1529 {PREGf_ANCH_MBOL, "ANCH_MBOL,"},
1530 {PREGf_ANCH_SBOL, "ANCH_SBOL,"},
1531 {PREGf_ANCH_GPOS, "ANCH_GPOS,"},
1535 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
1543 PERL_ARGS_ASSERT_DO_SV_DUMP;
1546 Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
1550 flags = SvFLAGS(sv);
1553 /* process general SV flags */
1555 d = Perl_newSVpvf(aTHX_
1556 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
1557 PTR2UV(SvANY(sv)), PTR2UV(sv),
1558 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
1559 (int)(PL_dumpindent*level), "");
1561 if (!((flags & SVpad_NAME) == SVpad_NAME
1562 && (type == SVt_PVMG || type == SVt_PVNV))) {
1563 if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
1564 sv_catpv(d, "PADSTALE,");
1566 if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
1567 if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
1568 sv_catpv(d, "PADTMP,");
1569 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
1571 append_flags(d, flags, first_sv_flags_names);
1572 if (flags & SVf_ROK) {
1573 sv_catpv(d, "ROK,");
1574 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
1576 append_flags(d, flags, second_sv_flags_names);
1577 if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
1578 && type != SVt_PVAV) {
1579 if (SvPCS_IMPORTED(sv))
1580 sv_catpv(d, "PCS_IMPORTED,");
1582 sv_catpv(d, "SCREAM,");
1585 /* process type-specific SV flags */
1590 append_flags(d, CvFLAGS(sv), cv_flags_names);
1593 append_flags(d, flags, hv_flags_names);
1597 if (isGV_with_GP(sv)) {
1598 append_flags(d, GvFLAGS(sv), gp_flags_names);
1600 if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
1601 sv_catpv(d, "IMPORT");
1602 if (GvIMPORTED(sv) == GVf_IMPORTED)
1603 sv_catpv(d, "ALL,");
1606 append_flags(d, GvFLAGS(sv), gp_flags_imported_names);
1613 if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
1614 if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
1617 if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
1618 if (SvVALID(sv)) sv_catpv(d, "VALID,");
1619 if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
1620 if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
1623 if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
1626 if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
1629 /* SVphv_SHAREKEYS is also 0x20000000 */
1630 if ((type != SVt_PVHV) && SvUTF8(sv))
1631 sv_catpv(d, "UTF8");
1633 if (*(SvEND(d) - 1) == ',') {
1634 SvCUR_set(d, SvCUR(d) - 1);
1635 SvPVX(d)[SvCUR(d)] = '\0';
1640 /* dump initial SV details */
1642 #ifdef DEBUG_LEAKING_SCALARS
1643 Perl_dump_indent(aTHX_ level, file,
1644 "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
1645 sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
1647 sv->sv_debug_inpad ? "for" : "by",
1648 sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
1649 PTR2UV(sv->sv_debug_parent),
1653 Perl_dump_indent(aTHX_ level, file, "SV = ");
1657 if (type < SVt_LAST) {
1658 PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
1660 if (type == SVt_NULL) {
1665 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
1670 /* Dump general SV fields */
1672 if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
1673 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
1674 && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
1675 || (type == SVt_IV && !SvROK(sv))) {
1677 #ifdef PERL_OLD_COPY_ON_WRITE
1681 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
1683 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
1684 #ifdef PERL_OLD_COPY_ON_WRITE
1685 if (SvIsCOW_shared_hash(sv))
1686 PerlIO_printf(file, " (HASH)");
1687 else if (SvIsCOW_normal(sv))
1688 PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
1690 PerlIO_putc(file, '\n');
1693 if ((type == SVt_PVNV || type == SVt_PVMG)
1694 && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
1695 Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
1696 (UV) COP_SEQ_RANGE_LOW(sv));
1697 Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
1698 (UV) COP_SEQ_RANGE_HIGH(sv));
1699 } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
1700 && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
1701 && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
1702 || type == SVt_NV) {
1703 STORE_NUMERIC_LOCAL_SET_STANDARD();
1704 /* %Vg doesn't work? --jhi */
1705 #ifdef USE_LONG_DOUBLE
1706 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv));
1708 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
1710 RESTORE_NUMERIC_LOCAL();
1714 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv)));
1716 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim);
1719 if (type < SVt_PV) {
1724 if ((type <= SVt_PVLV && !isGV_with_GP(sv))
1725 || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) {
1726 const bool re = isREGEXP(sv);
1727 const char * const ptr =
1728 re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
1732 SvOOK_offset(sv, delta);
1733 Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
1738 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
1740 PerlIO_printf(file, "( %s . ) ",
1741 pv_display(d, ptr - delta, delta, 0,
1744 if (type == SVt_INVLIST) {
1745 PerlIO_printf(file, "\n");
1746 /* 4 blanks indents 2 beyond the PV, etc */
1747 _invlist_dump(file, level, " ", sv);
1750 PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
1753 if (SvUTF8(sv)) /* the 6? \x{....} */
1754 PerlIO_printf(file, " [UTF8 \"%s\"]",
1755 sv_uni_display(d, sv, 6 * SvCUR(sv),
1757 PerlIO_printf(file, "\n");
1759 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
1761 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
1763 #ifdef PERL_NEW_COPY_ON_WRITE
1764 if (SvIsCOW(sv) && SvLEN(sv))
1765 Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
1770 Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
1773 if (type >= SVt_PVMG) {
1774 if (type == SVt_PVMG && SvPAD_OUR(sv)) {
1775 HV * const ost = SvOURSTASH(sv);
1777 do_hv_dump(level, file, " OURSTASH", ost);
1778 } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
1779 Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
1780 (UV)PadnamelistMAXNAMED(sv));
1783 do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
1786 do_hv_dump(level, file, " STASH", SvSTASH(sv));
1788 if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) {
1789 Perl_dump_indent(aTHX_ level, file, " USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
1793 /* Dump type-specific SV fields */
1797 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
1798 if (AvARRAY(sv) != AvALLOC(sv)) {
1799 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv)));
1800 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
1803 PerlIO_putc(file, '\n');
1804 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
1805 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
1806 /* arylen is stored in magic, and padnamelists use SvMAGIC for
1808 if (!AvPAD_NAMELIST(sv))
1809 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
1810 SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
1812 if (AvREAL(sv)) sv_catpv(d, ",REAL");
1813 if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
1814 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
1815 SvCUR(d) ? SvPVX_const(d) + 1 : "");
1816 if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
1818 for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
1819 SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
1821 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
1823 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
1830 struct xpvhv_aux *const aux = HvAUX(sv);
1831 Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
1832 (UV)aux->xhv_aux_flags);
1834 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
1835 usedkeys = HvUSEDKEYS(sv);
1836 if (HvARRAY(sv) && usedkeys) {
1837 /* Show distribution of HEs in the ARRAY */
1839 #define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
1842 U32 pow2 = 2, keys = usedkeys;
1843 NV theoret, sum = 0;
1845 PerlIO_printf(file, " (");
1846 Zero(freq, FREQ_MAX + 1, int);
1847 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
1850 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
1852 if (count > FREQ_MAX)
1858 for (i = 0; i <= max; i++) {
1860 PerlIO_printf(file, "%d%s:%d", i,
1861 (i == FREQ_MAX) ? "+" : "",
1864 PerlIO_printf(file, ", ");
1867 PerlIO_putc(file, ')');
1868 /* The "quality" of a hash is defined as the total number of
1869 comparisons needed to access every element once, relative
1870 to the expected number needed for a random hash.
1872 The total number of comparisons is equal to the sum of
1873 the squares of the number of entries in each bucket.
1874 For a random hash of n keys into k buckets, the expected
1879 for (i = max; i > 0; i--) { /* Precision: count down. */
1880 sum += freq[i] * i * i;
1882 while ((keys = keys >> 1))
1885 theoret += theoret * (theoret-1)/pow2;
1886 PerlIO_putc(file, '\n');
1887 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
1889 PerlIO_putc(file, '\n');
1890 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
1893 HE **ents = HvARRAY(sv);
1896 HE *const *const last = ents + HvMAX(sv);
1897 count = last + 1 - ents;
1902 } while (++ents <= last);
1906 struct xpvhv_aux *const aux = HvAUX(sv);
1907 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
1908 " (cached = %"UVuf")\n",
1909 (UV)count, (UV)aux->xhv_fill_lazy);
1911 Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
1915 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
1917 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
1918 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
1919 #ifdef PERL_HASH_RANDOMIZE_KEYS
1920 Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
1921 if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
1922 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
1925 PerlIO_putc(file, '\n');
1928 MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
1929 if (mg && mg->mg_obj) {
1930 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
1934 const char * const hvname = HvNAME_get(sv);
1936 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1937 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
1938 generic_pv_escape( tmpsv, hvname,
1939 HvNAMELEN(sv), HvNAMEUTF8(sv)));
1944 = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
1945 struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
1946 if (HvAUX(sv)->xhv_name_count)
1947 Perl_dump_indent(aTHX_
1948 level, file, " NAMECOUNT = %"IVdf"\n",
1949 (IV)HvAUX(sv)->xhv_name_count
1951 if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
1952 const I32 count = HvAUX(sv)->xhv_name_count;
1954 SV * const names = newSVpvs_flags("", SVs_TEMP);
1955 /* The starting point is the first element if count is
1956 positive and the second element if count is negative. */
1957 HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1958 + (count < 0 ? 1 : 0);
1959 HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
1960 + (count < 0 ? -count : count);
1961 while (hekp < endp) {
1962 if (HEK_LEN(*hekp)) {
1963 SV *tmp = newSVpvs_flags("", SVs_TEMP);
1964 Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
1965 generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
1967 /* This should never happen. */
1968 sv_catpvs(names, ", (null)");
1972 Perl_dump_indent(aTHX_
1973 level, file, " ENAME = %s\n", SvPV_nolen(names)+2
1977 SV * const tmp = newSVpvs_flags("", SVs_TEMP);
1978 const char *const hvename = HvENAME_get(sv);
1979 Perl_dump_indent(aTHX_
1980 level, file, " ENAME = \"%s\"\n",
1981 generic_pv_escape(tmp, hvename,
1982 HvENAMELEN_get(sv), HvENAMEUTF8(sv)));
1986 Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
1988 do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
1992 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
1993 Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%"UVxf")\n",
1994 generic_pv_escape( tmpsv, meta->mro_which->name,
1995 meta->mro_which->length,
1996 (meta->mro_which->kflags & HVhek_UTF8)),
1997 PTR2UV(meta->mro_which));
1998 Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n",
1999 (UV)meta->cache_gen);
2000 Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n",
2002 if (meta->mro_linear_all) {
2003 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n",
2004 PTR2UV(meta->mro_linear_all));
2005 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
2008 if (meta->mro_linear_current) {
2009 Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
2010 PTR2UV(meta->mro_linear_current));
2011 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
2014 if (meta->mro_nextmethod) {
2015 Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n",
2016 PTR2UV(meta->mro_nextmethod));
2017 do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
2021 Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n",
2023 do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
2028 if (nest < maxnest) {
2029 HV * const hv = MUTABLE_HV(sv);
2034 int count = maxnest - nest;
2035 for (i=0; i <= HvMAX(hv); i++) {
2036 for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) {
2043 if (count-- <= 0) goto DONEHV;
2046 keysv = hv_iterkeysv(he);
2047 keypv = SvPV_const(keysv, len);
2050 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
2052 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
2053 if (HvEITER_get(hv) == he)
2054 PerlIO_printf(file, "[CURRENT] ");
2055 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
2056 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
2063 } /* case SVt_PVHV */
2066 if (CvAUTOLOAD(sv)) {
2067 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2069 const char *const name = SvPV_const(sv, len);
2070 Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n",
2071 generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
2074 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2075 const char *const proto = CvPROTO(sv);
2076 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
2077 generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
2082 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
2083 if (!CvISXSUB(sv)) {
2085 Perl_dump_indent(aTHX_ level, file,
2086 " START = 0x%"UVxf" ===> %"IVdf"\n",
2087 PTR2UV(CvSTART(sv)),
2088 (IV)sequence_num(CvSTART(sv)));
2090 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n",
2091 PTR2UV(CvROOT(sv)));
2092 if (CvROOT(sv) && dumpops) {
2093 do_op_dump(level+1, file, CvROOT(sv));
2096 SV * const constant = cv_const_sv((const CV *)sv);
2098 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
2101 Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf
2103 PTR2UV(CvXSUBANY(sv).any_ptr));
2104 do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
2107 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n",
2108 (IV)CvXSUBANY(sv).any_i32);
2112 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2113 HEK_KEY(CvNAME_HEK((CV *)sv)));
2114 else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
2115 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
2116 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
2117 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
2118 Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
2119 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
2120 if (nest < maxnest) {
2121 do_dump_pad(level+1, file, CvPADLIST(sv), 0);
2124 const CV * const outside = CvOUTSIDE(sv);
2125 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
2128 : CvANON(outside) ? "ANON"
2129 : (outside == PL_main_cv) ? "MAIN"
2130 : CvUNIQUE(outside) ? "UNIQUE"
2133 newSVpvs_flags("", SVs_TEMP),
2134 GvNAME(CvGV(outside)),
2135 GvNAMELEN(CvGV(outside)),
2136 GvNAMEUTF8(CvGV(outside)))
2139 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
2140 do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
2145 if (type == SVt_PVLV) {
2146 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
2147 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
2148 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
2149 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
2150 Perl_dump_indent(aTHX_ level, file, " FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
2151 if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
2152 do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
2155 if (isREGEXP(sv)) goto dumpregexp;
2156 if (!isGV_with_GP(sv))
2159 SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
2160 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
2161 generic_pv_escape(tmpsv, GvNAME(sv),
2165 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
2166 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
2167 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
2170 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv)));
2171 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv));
2172 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv)));
2173 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv)));
2174 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv)));
2175 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
2176 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
2177 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
2178 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
2179 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
2180 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
2181 do_gv_dump (level, file, " EGV", GvEGV(sv));
2184 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv)));
2185 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv)));
2186 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv)));
2187 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv));
2188 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv));
2189 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv));
2190 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
2192 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
2193 if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
2194 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
2196 Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
2197 PTR2UV(IoTOP_GV(sv)));
2198 do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
2199 maxnest, dumpops, pvlim);
2201 /* Source filters hide things that are not GVs in these three, so let's
2202 be careful out there. */
2204 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
2205 if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
2206 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
2208 Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
2209 PTR2UV(IoFMT_GV(sv)));
2210 do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
2211 maxnest, dumpops, pvlim);
2213 if (IoBOTTOM_NAME(sv))
2214 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
2215 if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
2216 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
2218 Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
2219 PTR2UV(IoBOTTOM_GV(sv)));
2220 do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
2221 maxnest, dumpops, pvlim);
2223 if (isPRINT(IoTYPE(sv)))
2224 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
2226 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv));
2227 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
2232 struct regexp * const r = ReANY((REGEXP*)sv);
2234 #define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
2236 append_flags(d, flags, names); \
2237 if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
2238 SvCUR_set(d, SvCUR(d) - 1); \
2239 SvPVX(d)[SvCUR(d)] = '\0'; \
2242 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
2243 Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
2244 (UV)(r->compflags), SvPVX_const(d));
2246 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
2247 Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
2248 (UV)(r->extflags), SvPVX_const(d));
2250 Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
2251 PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
2252 if (r->engine == &PL_core_reg_engine) {
2253 SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
2254 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
2255 (UV)(r->intflags), SvPVX_const(d));
2257 Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
2260 #undef SV_SET_STRINGIFY_REGEXP_FLAGS
2261 Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
2263 Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
2264 (UV)(r->lastparen));
2265 Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %"UVuf"\n",
2266 (UV)(r->lastcloseparen));
2267 Perl_dump_indent(aTHX_ level, file, " MINLEN = %"IVdf"\n",
2269 Perl_dump_indent(aTHX_ level, file, " MINLENRET = %"IVdf"\n",
2270 (IV)(r->minlenret));
2271 Perl_dump_indent(aTHX_ level, file, " GOFS = %"UVuf"\n",
2273 Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
2274 (UV)(r->pre_prefix));
2275 Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
2277 Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
2278 (IV)(r->suboffset));
2279 Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
2280 (IV)(r->subcoffset));
2282 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
2284 pv_display(d, r->subbeg, r->sublen, 50, pvlim));
2286 Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
2287 Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
2288 PTR2UV(r->mother_re));
2289 if (nest < maxnest && r->mother_re)
2290 do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
2291 maxnest, dumpops, pvlim);
2292 Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
2293 PTR2UV(r->paren_names));
2294 Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
2295 PTR2UV(r->substrs));
2296 Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%"UVxf"\n",
2297 PTR2UV(r->pprivate));
2298 Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
2300 Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
2301 PTR2UV(r->qr_anoncv));
2303 Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
2304 PTR2UV(r->saved_copy));
2315 Dumps the contents of an SV to the C<STDERR> filehandle.
2317 For an example of its output, see L<Devel::Peek>.
2323 Perl_sv_dump(pTHX_ SV *sv)
2327 PERL_ARGS_ASSERT_SV_DUMP;
2330 do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
2332 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
2336 Perl_runops_debug(pTHX)
2340 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2344 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
2346 #ifdef PERL_TRACE_OPS
2347 ++PL_op_exec_cnt[PL_op->op_type];
2350 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
2351 PerlIO_printf(Perl_debug_log,
2352 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
2353 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
2354 PTR2UV(*PL_watchaddr));
2355 if (DEBUG_s_TEST_) {
2356 if (DEBUG_v_TEST_) {
2357 PerlIO_printf(Perl_debug_log, "\n");
2365 if (DEBUG_t_TEST_) debop(PL_op);
2366 if (DEBUG_P_TEST_) debprof(PL_op);
2369 OP_ENTRY_PROBE(OP_NAME(PL_op));
2370 } while ((PL_op = PL_op->op_ppaddr(aTHX)));
2371 DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
2379 Perl_debop(pTHX_ const OP *o)
2384 PERL_ARGS_ASSERT_DEBOP;
2386 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
2389 Perl_deb(aTHX_ "%s", OP_NAME(o));
2390 switch (o->op_type) {
2393 /* With ITHREADS, consts are stored in the pad, and the right pad
2394 * may not be active here, so check.
2395 * Looks like only during compiling the pads are illegal.
2398 if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
2400 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
2405 SV * const sv = newSV(0);
2406 gv_fullname3(sv, cGVOPo_gv, NULL);
2407 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
2408 SvREFCNT_dec_NN(sv);
2411 PerlIO_printf(Perl_debug_log, "(NULL)");
2420 count = o->op_private & OPpPADRANGE_COUNTMASK;
2422 /* print the lexical's name */
2424 CV * const cv = deb_curcv(cxstack_ix);
2426 PAD * comppad = NULL;
2430 PADLIST * const padlist = CvPADLIST(cv);
2431 comppad = *PadlistARRAY(padlist);
2433 PerlIO_printf(Perl_debug_log, "(");
2434 for (i = 0; i < count; i++) {
2436 (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
2437 PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
2439 PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
2442 PerlIO_printf(Perl_debug_log, ",");
2444 PerlIO_printf(Perl_debug_log, ")");
2451 PerlIO_printf(Perl_debug_log, "\n");
2456 S_deb_curcv(pTHX_ const I32 ix)
2459 const PERL_CONTEXT * const cx = &cxstack[ix];
2460 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
2461 return cx->blk_sub.cv;
2462 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2463 return cx->blk_eval.cv;
2464 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
2469 return deb_curcv(ix - 1);
2473 Perl_watch(pTHX_ char **addr)
2477 PERL_ARGS_ASSERT_WATCH;
2479 PL_watchaddr = addr;
2481 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
2482 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
2486 S_debprof(pTHX_ const OP *o)
2490 PERL_ARGS_ASSERT_DEBPROF;
2492 if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
2494 if (!PL_profiledata)
2495 Newxz(PL_profiledata, MAXO, U32);
2496 ++PL_profiledata[o->op_type];
2500 Perl_debprofdump(pTHX)
2504 if (!PL_profiledata)
2506 for (i = 0; i < MAXO; i++) {
2507 if (PL_profiledata[i])
2508 PerlIO_printf(Perl_debug_log,
2509 "%5lu %s\n", (unsigned long)PL_profiledata[i],
2517 * c-indentation-style: bsd
2519 * indent-tabs-mode: nil
2522 * ex: set ts=8 sts=4 sw=4 et: