X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=904b3ba323767a47db2787ea318a085c30dde3bb;hb=a6b599c70633c3b011aba1a198149d25707cbc98;hp=9dc7db8a6775ff692e0727e2019a83ca240c6dd6;hpb=724e67cb5119c18364c1131d2478435750263a24;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 9dc7db8..904b3ba 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
 
@@ -126,12 +128,12 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
 	    break;
         }
 	switch (*pv) {
-	case '\t': sv_catpvn(dsv, "\\t", 2);  break;
-	case '\n': sv_catpvn(dsv, "\\n", 2);  break;
-	case '\r': sv_catpvn(dsv, "\\r", 2);  break;
-	case '\f': sv_catpvn(dsv, "\\f", 2);  break;
-	case '"':  sv_catpvn(dsv, "\\\"", 2); break;
-	case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+	case '\t': sv_catpvs(dsv, "\\t");  break;
+	case '\n': sv_catpvs(dsv, "\\n");  break;
+	case '\r': sv_catpvs(dsv, "\\r");  break;
+	case '\f': sv_catpvs(dsv, "\\f");  break;
+	case '"':  sv_catpvs(dsv, "\\\""); break;
+	case '\\': sv_catpvs(dsv, "\\\\"); break;
 	default:
 	    if (isPRINT(*pv))
 		sv_catpvn(dsv, pv, 1);
@@ -141,11 +143,11 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
 		Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
         }
     }
-    sv_catpvn(dsv, "\"", 1);
+    sv_catpvs(dsv, "\"");
     if (truncated)
-	sv_catpvn(dsv, "...", 3);
+	sv_catpvs(dsv, "...");
     if (nul_terminated)
-	sv_catpvn(dsv, "\\0", 2);
+	sv_catpvs(dsv, "\\0");
 
     return SvPVX(dsv);
 }
@@ -299,7 +301,7 @@ Perl_sv_peek(pTHX_ SV *sv)
 	if (!SvPVX_const(sv))
 	    sv_catpv(t, "(null)");
 	else {
-	    SV *tmp = newSVpvn("", 0);
+	    SV *tmp = newSVpvs("");
 	    sv_catpv(t, "(");
 	    if (SvOOK(sv))
 		Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
@@ -359,7 +361,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
 	op_dump(pm->op_pmreplroot);
     }
     if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
-	SV *tmpsv = newSVpvn("", 0);
+	SV *tmpsv = newSVpvs("");
 	if (pm->op_pmdynflags & PMdf_USED)
 	    sv_catpv(tmpsv, ",USED");
 	if (pm->op_pmdynflags & PMdf_TAINTED)
@@ -402,13 +404,13 @@ 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;
     const char *key;
     STRLEN   len;
-    const OP *oldop = 0;
+    const OP *oldop = NULL;
     OP      *l;
 
     if (!o)
@@ -456,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:
@@ -464,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:
@@ -479,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:
@@ -494,7 +496,7 @@ sequence(pTHX_ register const OP *o)
 }
 
 STATIC UV
-sequence_num(pTHX_ const OP *o)
+S_sequence_num(pTHX_ const OP *o)
 {
     dVAR;
     SV     *op,
@@ -513,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
@@ -526,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) {
@@ -553,7 +555,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
     if (o->op_flags) {
-	SV *tmpsv = newSVpvn("", 0);
+	SV *tmpsv = newSVpvs("");
 	switch (o->op_flags & OPf_WANT) {
 	case OPf_WANT_VOID:
 	    sv_catpv(tmpsv, ",VOID");
@@ -584,7 +586,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
-	SV *tmpsv = newSVpvn("", 0);
+	SV *tmpsv = newSVpvs("");
 	if (PL_opargs[o->op_type] & OA_TARGLEX) {
 	    if (o->op_private & OPpTARGET_MY)
 		sv_catpv(tmpsv, ",TARGET_MY");
@@ -800,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;
@@ -822,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;
@@ -939,7 +941,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 			 "  MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
  	if (mg->mg_virtual) {
             const MGVTBL * const v = mg->mg_virtual;
- 	    const char *s = 0;
+ 	    const char *s = NULL;
  	    if      (v == &PL_vtbl_sv)         s = "sv";
             else if (v == &PL_vtbl_env)        s = "env";
             else if (v == &PL_vtbl_envelem)    s = "envelem";
@@ -982,7 +984,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 
 	{
 	    int n;
-	    const char *name = 0;
+	    const char *name = NULL;
 	    for (n = 0; magic_names[n].name; n++) {
 		if (mg->mg_type == magic_names[n].type) {
 		    name = magic_names[n].name;
@@ -1021,7 +1023,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 	    Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
 	    if (mg->mg_len >= 0) {
 		if (mg->mg_type != PERL_MAGIC_utf8) {
-		    SV *sv = newSVpvn("", 0);
+		    SV *sv = newSVpvs("");
 		    PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
 		    SvREFCNT_dec(sv);
 		}
@@ -1379,7 +1381,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	    PerlIO_printf(file, "  (");
 	    Zero(freq, FREQ_MAX + 1, int);
 	    for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
-		HE* h; int count = 0;
+		HE* h;
+		int count = 0;
                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
 		    count++;
 		if (count > FREQ_MAX)
@@ -1436,9 +1439,18 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	    if (hvname)
 		Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
 	}
+	if (SvOOK(sv)) {
+	    AV *backrefs = *Perl_hv_backreferences_p(aTHX_ (HV*)sv);
+	    if (backrefs) {
+		Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
+				 PTR2UV(backrefs));
+		do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
+			   dumpops, pvlim);
+	    }
+	}
 	if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
 	    HE *he;
-	    HV *hv = (HV*)sv;
+	    HV * const hv = (HV*)sv;
 	    int count = maxnest - nest;
 
 	    hv_iterinit(hv);
@@ -1447,7 +1459,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		SV *elt, *keysv;
                 const char *keypv;
 		STRLEN len;
-		U32 hash = HeHASH(he);
+		const U32 hash = HeHASH(he);
 
 		keysv = hv_iterkeysv(he);
 		keypv = SvPV_const(keysv, len);
@@ -1470,12 +1482,26 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     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));
 	Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
-	Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
+	{
+	    SV *constant = cv_const_sv((CV *)sv);
+
+
+	    if (constant) {
+		Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
+				 " (CONST SV)\n",
+				 PTR2UV(CvXSUBANY(sv).any_ptr));
+		do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
+			   pvlim);
+	    } else {
+		Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
+				 (IV)CvXSUBANY(sv).any_i32);
+	    }
+	}
  	do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
 	Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
 	Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));