X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=16c7281e9e22f40b0300d39524bd56e84be19f7f;hb=343ef7498d1a8623949697479cbfea3822ffafe9;hp=caf2f8c8770e72c939353fafbec0a6054a6172a4;hpb=a3874608cd3bf4e33ccd66b8bb03b2aeda20af14;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index caf2f8c..16c7281 100644
--- a/dump.c
+++ b/dump.c
@@ -24,6 +24,8 @@
 #define PERL_IN_DUMP_C
 #include "perl.h"
 #include "regcomp.h"
+#include "proto.h"
+
 
 #define Sequence PL_op_sequence
 
@@ -80,7 +82,7 @@ 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_const(sv));
@@ -97,7 +99,7 @@ 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_const(sv));
@@ -154,8 +156,7 @@ char *
 Perl_sv_peek(pTHX_ SV *sv)
 {
     dVAR;
-    SV *t = sv_newmortal();
-    STRLEN n_a;
+    SV * const t = sv_newmortal();
     int unref = 0;
 
     sv_setpvn(t, "", 0);
@@ -331,7 +332,7 @@ Perl_sv_peek(pTHX_ SV *sv)
 	while (unref--)
 	    sv_catpv(t, ")");
     }
-    return SvPV(t, n_a);
+    return SvPV_nolen(t);
 }
 
 void
@@ -403,11 +404,11 @@ Perl_pmop_dump(pTHX_ PMOP *pm)
 /* An op sequencer.  We visit the ops in the order they're to execute. */
 
 STATIC void
-sequence(pTHX_ register const OP *o)
+S_sequence(pTHX_ register const OP *o)
 {
     dVAR;
     SV      *op;
-    char    *key;
+    const char *key;
     STRLEN   len;
     const OP *oldop = 0;
     OP      *l;
@@ -415,14 +416,12 @@ sequence(pTHX_ register const OP *o)
     if (!o)
 	return;
 
-    op = newSVuv(PTR2UV(o));
-    key = SvPV(op, len);
-    if (hv_exists(Sequence, key, len))
-	return;
+    if (!Sequence)
+	Sequence = newHV();
 
     for (; o; o = o->op_next) {
 	op = newSVuv(PTR2UV(o));
-	key = SvPV(op, len);
+	key = SvPV_const(op, len);
 	if (hv_exists(Sequence, key, len))
 	    break;
 
@@ -459,7 +458,7 @@ sequence(pTHX_ register const OP *o)
 	    hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
 	    for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
 		;
-	    sequence(aTHX_ l);
+	    sequence(l);
 	    break;
 
 	case OP_ENTERLOOP:
@@ -467,13 +466,13 @@ sequence(pTHX_ register const OP *o)
 	    hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
 	    for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
 		;
-	    sequence(aTHX_ l);
+	    sequence(l);
 	    for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
 		;
-	    sequence(aTHX_ l);
+	    sequence(l);
 	    for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
 		;
-	    sequence(aTHX_ l);
+	    sequence(l);
 	    break;
 
 	case OP_QR:
@@ -482,7 +481,7 @@ sequence(pTHX_ register const OP *o)
 	    hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
 	    for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
 		;
-	    sequence(aTHX_ l);
+	    sequence(l);
 	    break;
 
 	case OP_HELEM:
@@ -497,16 +496,16 @@ sequence(pTHX_ register const OP *o)
 }
 
 STATIC UV
-sequence_num(pTHX_ const OP *o)
+S_sequence_num(pTHX_ const OP *o)
 {
     dVAR;
     SV     *op,
           **seq;
-    char   *key;
+    const char *key;
     STRLEN  len;
     if (!o) return 0;
     op = newSVuv(PTR2UV(o));
-    key = SvPV(op, len);
+    key = SvPV_const(op, len);
     seq = hv_fetch(Sequence, key, len, 0);
     return seq ? SvUV(*seq): 0;
 }
@@ -516,10 +515,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
     dVAR;
     UV      seq;
-    sequence(aTHX_ o);
+    sequence(o);
     Perl_dump_indent(aTHX_ level, file, "{\n");
     level++;
-    seq = sequence_num(aTHX_ o);
+    seq = sequence_num(o);
     if (seq)
 	PerlIO_printf(file, "%-4"UVf, seq);
     else
@@ -529,7 +528,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 		  (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next)
 	PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
-				sequence_num(aTHX_ o->op_next));
+				sequence_num(o->op_next));
     else
 	PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
@@ -767,11 +766,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
 	    if (cSVOPo->op_sv) {
 		SV *tmpsv = NEWSV(0,0);
-		STRLEN n_a;
 		ENTER;
 		SAVEFREESV(tmpsv);
 		gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-		Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+		Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
+				 SvPV_nolen_const(tmpsv));
 		LEAVE;
 	    }
 	    else
@@ -803,17 +802,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_ENTERLOOP:
 	Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
 	if (cLOOPo->op_redoop)
-	    PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop));
+	    PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_redoop));
 	else
 	    PerlIO_printf(file, "DONE\n");
 	Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
 	if (cLOOPo->op_nextop)
-	    PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop));
+	    PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_nextop));
 	else
 	    PerlIO_printf(file, "DONE\n");
 	Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
 	if (cLOOPo->op_lastop)
-	    PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop));
+	    PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_lastop));
 	else
 	    PerlIO_printf(file, "DONE\n");
 	break;
@@ -825,7 +824,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_AND:
 	Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
 	if (cLOGOPo->op_other)
-	    PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other));
+	    PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOGOPo->op_other));
 	else
 	    PerlIO_printf(file, "DONE\n");
 	break;
@@ -971,6 +970,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 	    else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
 	    else if (v == &PL_vtbl_backref)    s = "backref";
 	    else if (v == &PL_vtbl_utf8)       s = "utf8";
+            else if (v == &PL_vtbl_arylen_p)   s = "arylen_p";
 	    if (s)
 	        Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
 	    else
@@ -1190,7 +1190,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	/* FALL THROUGH */
     default:
 	if (SvEVALED(sv))	sv_catpv(d, "EVALED,");
-	if (SvIsUV(sv))		sv_catpv(d, "IsUV,");
+	if (SvIsUV(sv) && !(flags & SVf_ROK))	sv_catpv(d, "IsUV,");
 	break;
     case SVt_PVBM:
 	if (SvTAIL(sv))		sv_catpv(d, "TAIL,");
@@ -1281,7 +1281,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     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
 	                             )
@@ -1290,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))
@@ -1452,7 +1452,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		U32 hash = HeHASH(he);
 
 		keysv = hv_iterkeysv(he);
-		keypv = SvPV(keysv, len);
+		keypv = SvPV_const(keysv, len);
 		elt = hv_iterval(hv, he);
 		Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
 		if (SvUTF8(keysv))
@@ -1467,12 +1467,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	break;
     case SVt_PVCV:
 	if (SvPOK(sv))
-	    Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV_nolen(sv));
+	    Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV_nolen_const(sv));
 	/* FALL THROUGH */
     case SVt_PVFM:
 	do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
 	if (CvSTART(sv))
-	    Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv)));
+	    Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv)));
 	Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
         if (CvROOT(sv) && dumpops)
 	    do_op_dump(level+1, file, CvROOT(sv));
@@ -1526,7 +1526,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
 	Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
 	Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
-	Perl_dump_indent(aTHX_ level, file, "    GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv));
 	Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
 	Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
 	Perl_dump_indent(aTHX_ level, file, "    FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
@@ -1620,7 +1619,7 @@ Perl_debop(pTHX_ const OP *o)
 	if (cGVOPo_gv) {
 	    SV *sv = NEWSV(0,0);
 	    gv_fullname3(sv, cGVOPo_gv, Nullch);
-	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
+	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
 	    SvREFCNT_dec(sv);
 	}
 	else
@@ -1634,13 +1633,13 @@ Perl_debop(pTHX_ const OP *o)
 	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;
         if (sv)
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
         else
            PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
 	}
@@ -1683,7 +1682,7 @@ S_debprof(pTHX_ const OP *o)
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
 	return;
     if (!PL_profiledata)
-	Newz(000, PL_profiledata, MAXO, U32);
+	Newxz(PL_profiledata, MAXO, U32);
     ++PL_profiledata[o->op_type];
 }