utf8.c: Add comment

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index f7a6380..3e1b011 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -156,7 +156,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
 
     if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) {
            /* This won't alter the UTF-8 flag */
-           sv_setpvs(dsv, "");
+            SvPVCLEAR(dsv);
     }
     
     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
@@ -285,7 +285,7 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
    
     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
         /* This won't alter the UTF-8 flag */
-        sv_setpvs(dsv, "");
+        SvPVCLEAR(dsv);
     }
     orig_cur= SvCUR(dsv);
 
@@ -358,7 +358,7 @@ Perl_sv_peek(pTHX_ SV *sv)
     int unref = 0;
     U32 type;
 
-    sv_setpvs(t, "");
+    SvPVCLEAR(t);
   retry:
     if (!sv) {
        sv_catpv(t, "VOID");
@@ -421,11 +421,14 @@ Perl_sv_peek(pTHX_ SV *sv)
                break;
            }
        }
-       if (SvREFCNT(sv) > 1)
-           Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
-                   is_tmp ? "T" : "");
-       else if (is_tmp)
-           sv_catpv(t, "<T>");
+       if (is_tmp || SvREFCNT(sv) > 1) {
+            Perl_sv_catpvf(aTHX_ t, "<");
+            if (SvREFCNT(sv) > 1)
+                Perl_sv_catpvf(aTHX_ t, "%"UVuf, (UV)SvREFCNT(sv));
+            if (is_tmp)
+                Perl_sv_catpvf(aTHX_ t, "%s", SvTEMP(t) ? "T" : "t");
+            Perl_sv_catpvf(aTHX_ t, ">");
+        }
     }
 
     if (SvROK(sv)) {
@@ -670,10 +673,17 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
             (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
     else
        Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
-    if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
-       Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
-       op_dump(pm->op_pmreplrootu.op_pmreplroot);
+
+    if (pm->op_type == OP_SPLIT)
+        Perl_dump_indent(aTHX_ level, file, "TARGOFF/GV = 0x%"UVxf"\n",
+                PTR2UV(pm->op_pmreplrootu.op_pmtargetgv));
+    else {
+        if (pm->op_pmreplrootu.op_pmreplroot) {
+            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");
@@ -968,6 +978,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
         for (i=0; i < count;  i++)
             Perl_dump_indent(aTHX_ level+1, file, "%"UVuf" => 0x%"UVxf"\n",
                                     i, items[i].uv);
+       break;
     }
 
     case OP_CONST:
@@ -1042,7 +1053,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
        else
            PerlIO_printf(file, "DONE\n");
        break;
-    case OP_PUSHRE:
+    case OP_SPLIT:
     case OP_MATCH:
     case OP_QR:
     case OP_SUBST:
@@ -1422,6 +1433,16 @@ const struct flag_to_name regexp_core_intflags_names[] = {
     {PREGf_ANCH_GPOS,       "ANCH_GPOS,"},
 };
 
+/* Perl_do_sv_dump():
+ *
+ * level:   amount to indent the output
+ * sv:      the object to dump
+ * nest:    the current level of recursion
+ * maxnest: the maximum allowed level of recursion
+ * dumpops: if true, also dump the ops associated with a CV
+ * pvlim:   limit on the length of any strings that are output
+ * */
+
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
@@ -1656,19 +1677,21 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
        Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n",
                                   SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
-       sv_setpvs(d, "");
+        SvPVCLEAR(d);
        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_tindex(MUTABLE_AV(sv)) >= 0) {
+       if (nest < maxnest && AvARRAY(MUTABLE_AV(sv))) {
            SSize_t count;
-           for (count = 0; count <=  av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
-               SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
-
+            SV **svp = AvARRAY(MUTABLE_AV(sv));
+           for (count = 0;
+                 count <= AvFILLp(MUTABLE_AV(sv)) && count < maxnest;
+                 count++, svp++)
+            {
+               SV* const elt = *svp;
                Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
-               if (elt)
-                   do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
+                do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
            }
        }
        break;
@@ -1750,15 +1773,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                 } while (++ents <= last);
             }
 
-            if (SvOOK(sv)) {
-                struct xpvhv_aux *const aux = HvAUX(sv);
-                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf
-                                 " (cached = %"UVuf")\n",
-                                 (UV)count, (UV)aux->xhv_fill_lazy);
-            } else {
-                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
-                                 (UV)count);
-            }
+            Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
+                             (UV)count);
         }
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
         if (SvOOK(sv)) {
@@ -1807,7 +1823,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                    HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
                        + (count < 0 ? -count : count);
                    while (hekp < endp) {
-                       if (HEK_LEN(*hekp)) {
+                       if (*hekp) {
              SV *tmp = newSVpvs_flags("", SVs_TEMP);
                            Perl_sv_catpvf(aTHX_ names, ", \"%s\"",
                               generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp)));
@@ -1930,7 +1946,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
        if (!CvISXSUB(sv)) {
            if (CvSTART(sv)) {
-               Perl_dump_indent(aTHX_ level, file,
+                if (CvSLABBED(sv))
+                    Perl_dump_indent(aTHX_ level, file,
+                                "  SLAB = 0x%"UVxf"\n",
+                                PTR2UV(CvSTART(sv)));
+                else
+                    Perl_dump_indent(aTHX_ level, file,
                                 "  START = 0x%"UVxf" ===> %"IVdf"\n",
                                 PTR2UV(CvSTART(sv)),
                                 (IV)sequence_num(CvSTART(sv)));
@@ -2201,6 +2222,8 @@ Perl_runops_debug(pTHX)
         ++PL_op_exec_cnt[PL_op->op_type];
 #endif
        if (PL_debug) {
+            ENTER;
+            SAVETMPS;
            if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
                PerlIO_printf(Perl_debug_log,
                              "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
@@ -2218,9 +2241,11 @@ Perl_runops_debug(pTHX)
 
            if (DEBUG_t_TEST_) debop(PL_op);
            if (DEBUG_P_TEST_) debprof(PL_op);
+            FREETMPS;
+            LEAVE;
        }
 
-        OP_ENTRY_PROBE(OP_NAME(PL_op));
+        PERL_DTRACE_PROBE_OP(PL_op);
     } while ((PL_op = PL_op->op_ppaddr(aTHX)));
     DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
     PERL_ASYNC_CHECK();
@@ -2506,6 +2531,7 @@ Perl_debop(pTHX_ const OP *o)
     case OP_PADSV:
     case OP_PADAV:
     case OP_PADHV:
+    case OP_ARGELEM:
         S_deb_padvar(aTHX_ o->op_targ, 1, 1);
         break;