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 / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
s/PERL_COPY_ON_WRITE/PERL_OLD_COPY_ON_WRITE/g
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 2ee5483..ee352b9 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -80,10 +80,10 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
 void
 Perl_dump_sub(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
     if (CvXSUB(GvCV(gv)))
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
            PTR2UV(CvXSUB(GvCV(gv))),
@@ -97,10 +97,10 @@ Perl_dump_sub(pTHX_ const GV *gv)
 void
 Perl_dump_form(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
     if (CvROOT(GvFORM(gv)))
        op_dump(CvROOT(GvFORM(gv)));
     else
@@ -193,7 +193,7 @@ Perl_sv_peek(pTHX_ SV *sv)
                !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
                                  SVp_POK|SVp_NOK)) &&
                SvCUR(sv) == 1 &&
-               SvPVX(sv) && *SvPVX(sv) == '1' &&
+               SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
                SvNVX(sv) == 1.0)
                goto finish;
        }
@@ -297,14 +297,14 @@ Perl_sv_peek(pTHX_ SV *sv)
     }
 
     if (SvPOKp(sv)) {
-       if (!SvPVX(sv))
+       if (!SvPVX_const(sv))
            sv_catpv(t, "(null)");
        else {
            SV *tmp = newSVpvn("", 0);
            sv_catpv(t, "(");
            if (SvOOK(sv))
-               Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
-           Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
+               Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
+           Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
            if (SvUTF8(sv))
                Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
                               sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
@@ -387,7 +387,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
            sv_catpv(tmpsv, ",RETAINT");
        if (pm->op_pmflags & PMf_EVAL)
            sv_catpv(tmpsv, ",EVAL");
-       Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
+       Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
     }
 
@@ -583,7 +583,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            sv_catpv(tmpsv, ",MOD");
        if (o->op_flags & OPf_SPECIAL)
            sv_catpv(tmpsv, ",SPECIAL");
-       Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
+       Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
@@ -753,7 +753,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
        if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
            sv_catpv(tmpsv, ",INTRO");
        if (SvCUR(tmpsv))
-           Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
+           Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
        SvREFCNT_dec(tmpsv);
     }
 
@@ -873,10 +873,10 @@ Perl_gv_dump(pTHX_ GV *gv)
     sv = sv_newmortal();
     PerlIO_printf(Perl_debug_log, "{\n");
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
     if (gv != GvEGV(gv)) {
        gv_efullname3(sv, GvEGV(gv), Nullch);
-       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv));
+       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
     }
     PerlIO_putc(Perl_debug_log, '\n');
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
@@ -890,9 +890,12 @@ Perl_gv_dump(pTHX_ GV *gv)
 static const struct { const char type; const char *name; } magic_names[] = {
        { PERL_MAGIC_sv,             "sv(\\0)" },
        { PERL_MAGIC_arylen,         "arylen(#)" },
+       { PERL_MAGIC_rhash,          "rhash(%)" },
        { PERL_MAGIC_glob,           "glob(*)" },
        { PERL_MAGIC_pos,            "pos(.)" },
+       { PERL_MAGIC_symtab,         "symtab(:)" },
        { PERL_MAGIC_backref,        "backref(<)" },
+       { PERL_MAGIC_arylen_p,       "arylen_p(@)" },
        { PERL_MAGIC_overload,       "overload(A)" },
        { PERL_MAGIC_bm,             "bm(B)" },
        { PERL_MAGIC_regdata,        "regdata(D)" },
@@ -1058,9 +1061,10 @@ Perl_magic_dump(pTHX_ const MAGIC *mg)
 void
 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
 {
+    const char *hvname;
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
-    if (sv && HvNAME(sv))
-       PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv));
+    if (sv && (hvname = HvNAME_get(sv)))
+       PerlIO_printf(file, "\t\"%s\"\n", hvname);
     else
        PerlIO_putc(file, '\n');
 }
@@ -1080,9 +1084,10 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
 {
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
     if (sv && GvNAME(sv)) {
+       const char *hvname;
        PerlIO_printf(file, "\t\"");
-       if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
-           PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
+       if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
+           PerlIO_printf(file, "%s\" :: \"", hvname);
        PerlIO_printf(file, "%s\"\n", GvNAME(sv));
     }
     else
@@ -1195,6 +1200,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (flags & SVpad_TYPED)
                                sv_catpv(d, "TYPED,");
        break;
+    case SVt_PVAV:
+       break;
     }
     /* SVphv_SHAREKEYS is also 0x20000000 */
     if ((type != SVt_PVHV) && SvUTF8(sv))
@@ -1205,7 +1212,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        SvPVX(d)[SvCUR(d)] = '\0';
     }
     sv_catpv(d, ")");
-    s = SvPVX(d);
+    s = SvPVX_const(d);
 
 #ifdef DEBUG_LEAKING_SCALARS
     Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
@@ -1271,9 +1278,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        SvREFCNT_dec(d);
        return;
     }
-    if (type >= SVt_PVIV || type == SVt_IV) {
+    if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV)
+       || type == SVt_IV) {
        if (SvIsUV(sv)
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
                       || SvIsCOW(sv)
 #endif
                                     )
@@ -1282,7 +1290,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
        if (SvOOK(sv))
            PerlIO_printf(file, "  (OFFSET)");
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW_shared_hash(sv))
            PerlIO_printf(file, "  (HASH)");
        else if (SvIsCOW_normal(sv))
@@ -1290,7 +1298,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #endif
        PerlIO_putc(file, '\n');
     }
-    if (type >= SVt_PVNV || type == SVt_NV) {
+    if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV)
+       || type == SVt_NV) {
        STORE_NUMERIC_LOCAL_SET_STANDARD();
        /* %Vg doesn't work? --jhi */
 #ifdef USE_LONG_DOUBLE
@@ -1310,11 +1319,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        return;
     }
     if (type <= SVt_PVLV && type != SVt_PVGV) {
-       if (SvPVX(sv)) {
-           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
+       if (SvPVX_const(sv)) {
+           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
            if (SvOOK(sv))
-               PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
-           PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+               PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
+           PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
            if (SvUTF8(sv)) /* the 8?  \x{....} */
                PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
            PerlIO_printf(file, "\n");
@@ -1341,13 +1350,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv)));
-       flags = AvFLAGS(sv);
-       sv_setpv(d, "");
-       if (flags & AVf_REAL)   sv_catpv(d, ",REAL");
-       if (flags & AVf_REIFY)  sv_catpv(d, ",REIFY");
-       if (flags & AVf_REUSED) sv_catpv(d, ",REUSED");
-       Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n", SvCUR(d) ? SvPVX(d) + 1 : "");
+       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
+       sv_setpvn(d, "", 0);
+       if (AvREAL(sv)) sv_catpv(d, ",REAL");
+       if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
+       Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
+                        SvCUR(d) ? SvPVX_const(d) + 1 : "");
        if (nest < maxnest && av_len((AV*)sv) >= 0) {
            int count;
            for (count = 0; count <=  av_len((AV*)sv) && count < maxnest; count++) {
@@ -1417,13 +1425,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)HvFILL(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER(sv));
-       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv)));
-       if (HvPMROOT(sv))
-           Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv)));
-       if (HvNAME(sv))
-           Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", HvNAME(sv));
-       if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */
+       Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
+       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
+       {
+           MAGIC *mg = mg_find(sv, PERL_MAGIC_symtab);
+           if (mg && mg->mg_obj) {
+               Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
+           }
+       }
+       {
+           const char *hvname = HvNAME_get(sv);
+           if (hvname)
+               Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
+       }
+       if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
            HE *he;
            HV *hv = (HV*)sv;
            int count = maxnest - nest;
@@ -1592,9 +1607,6 @@ Perl_runops_debug(pTHX)
 I32
 Perl_debop(pTHX_ const OP *o)
 {
-    CV *cv;
-    SV *sv;
-
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return 0;
 
@@ -1606,7 +1618,7 @@ Perl_debop(pTHX_ const OP *o)
     case OP_GVSV:
     case OP_GV:
        if (cGVOPo_gv) {
-           sv = NEWSV(0,0);
+           SV *sv = NEWSV(0,0);
            gv_fullname3(sv, cGVOPo_gv, Nullch);
            PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
            SvREFCNT_dec(sv);
@@ -1617,11 +1629,13 @@ Perl_debop(pTHX_ const OP *o)
     case OP_PADSV:
     case OP_PADAV:
     case OP_PADHV:
+       {
        /* print the lexical's name */
-        cv = deb_curcv(cxstack_ix);
+       CV *cv = deb_curcv(cxstack_ix);
+       SV *sv;
         if (cv) {
-            AV *padlist = CvPADLIST(cv);
-            AV *comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
+            AV * const padlist = CvPADLIST(cv);
+            AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
             sv = *av_fetch(comppad, o->op_targ, FALSE);
         } else
             sv = Nullsv;
@@ -1629,6 +1643,7 @@ Perl_debop(pTHX_ const OP *o)
            PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
         else
            PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
+       }
         break;
     default:
        break;
@@ -1685,3 +1700,13 @@ Perl_debprofdump(pTHX)
                                        PL_op_name[i]);
     }
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
Unnamed repository; edit this file 'description' to name the repository.