This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dump.c: Dump CVf_SLABBED
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index d1803cd..b5240fb 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -281,7 +281,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
         isuni = 1;
     
     for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
-        const UV u= (isuni) ? utf8_to_uvchr((U8*)pv, &readsize) : (U8)*pv;            
+        const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
         const U8 c = (U8)u & 0xFF;
         
         if ( ( u > 255 )
@@ -613,6 +613,15 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
        Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
        op_dump(pm->op_pmreplrootu.op_pmreplroot);
     }
+    if (pm->op_code_list) {
+       if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
+           Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
+           do_op_dump(level, file, pm->op_code_list);
+       }
+       else
+           Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
+                                   PTR2UV(pm->op_code_list));
+    }
     if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
        SV * const tmpsv = pm_description(pm);
        Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
@@ -630,6 +639,9 @@ const struct flag_to_name pmflags_flags_names[] = {
     {PMf_RETAINT, ",RETAINT"},
     {PMf_EVAL, ",EVAL"},
     {PMf_NONDESTRUCT, ",NONDESTRUCT"},
+    {PMf_HAS_CV, ",HAS_CV"},
+    {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
+    {PMf_IS_QR, ",IS_QR"}
 };
 
 static SV *
@@ -733,8 +745,7 @@ const struct flag_to_name op_const_names[] = {
     {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
     {OPpCONST_STRICT, ",STRICT"},
     {OPpCONST_ENTERED, ",ENTERED"},
-    {OPpCONST_BARE, ",BARE"},
-    {OPpCONST_WARNING, ",WARNING"}
+    {OPpCONST_BARE, ",BARE"}
 };
 
 const struct flag_to_name op_sort_names[] = {
@@ -1355,6 +1366,8 @@ const struct flag_to_name cv_flags_names[] = {
     {CVf_CVGV_RC, "CVGV_RC,"},
     {CVf_DYNFILE, "DYNFILE,"},
     {CVf_AUTOLOAD, "AUTOLOAD,"},
+    {CVf_HASEVAL, "HASEVAL"},
+    {CVf_SLABBED, "SLABBED,"},
     {CVf_ISXSUB, "ISXSUB,"}
 };
 
@@ -1941,6 +1954,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
            Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
            Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
+           Perl_dump_indent(aTHX_ level, file, "  FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
            if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
                do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
                    dumpops, pvlim);
@@ -2040,8 +2054,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                (UV)(r->gofs));
            Perl_dump_indent(aTHX_ level, file, "  PRE_PREFIX = %"UVuf"\n",
                                (UV)(r->pre_prefix));
-           Perl_dump_indent(aTHX_ level, file, "  SEEN_EVALS = %"UVuf"\n",
-                               (UV)(r->seen_evals));
            Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
                                (IV)(r->sublen));
            if (r->subbeg)
@@ -2062,6 +2074,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                PTR2UV(r->pprivate));
            Perl_dump_indent(aTHX_ level, file, "  OFFS = 0x%"UVxf"\n",
                                PTR2UV(r->offs));
+           Perl_dump_indent(aTHX_ level, file, "  QR_ANONCV = 0x%"UVxf"\n",
+                               PTR2UV(r->qr_anoncv));
 #ifdef PERL_OLD_COPY_ON_WRITE
            Perl_dump_indent(aTHX_ level, file, "  SAVED_COPY = 0x%"UVxf"\n",
                                PTR2UV(r->saved_copy));
@@ -2195,7 +2209,7 @@ S_deb_curcv(pTHX_ const I32 ix)
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
         return cx->blk_sub.cv;
     else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
-        return PL_compcv;
+        return cx->blk_eval.cv;
     else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
         return PL_main_cv;
     else if (ix <= 0)
@@ -2419,7 +2433,7 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
   retry:
     while (pv < e) {
        if (utf8) {
-           c = utf8_to_uvchr((U8*)pv, &cl);
+           c = utf8_to_uvchr_buf((U8*)pv, (U8*)e, &cl);
            if (cl == 0) {
                SvCUR(dsv) = dsvcur;
                pv = start;
@@ -2907,8 +2921,6 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
                sv_catpv(tmpsv, ",BARE");
            if (o->op_private & OPpCONST_STRICT)
                sv_catpv(tmpsv, ",STRICT");
-           if (o->op_private & OPpCONST_WARNING)
-               sv_catpv(tmpsv, ",WARNING");
            if (o->op_private & OPpCONST_ENTERED)
                sv_catpv(tmpsv, ",ENTERED");
        }
@@ -3180,8 +3192,8 @@ Perl_op_xmldump(pTHX_ const OP *o)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */