X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=b63ad5c000ec4bfaa2a0fe0ee134e32e5f65690e;hb=00b1698f76403476df2006ff536ab00ffc650220;hp=cebd7abdc1875b8386f223c61ee6d31142bb0f75;hpb=acde74e1470244c2d6e7d36e1cddcb699d9ab106;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index cebd7ab..b63ad5c 100644
--- a/dump.c
+++ b/dump.c
@@ -41,6 +41,7 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 void
 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 {
+    dVAR;
     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
     PerlIO_vprintf(file, pat, *args);
 }
@@ -48,6 +49,7 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 void
 Perl_dump_all(pTHX)
 {
+    dVAR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
 	op_dump(PL_main_root);
@@ -57,6 +59,7 @@ Perl_dump_all(pTHX)
 void
 Perl_dump_packsubs(pTHX_ const HV *stash)
 {
+    dVAR;
     I32	i;
 
     if (!HvARRAY(stash))
@@ -84,9 +87,9 @@ Perl_dump_sub(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
-    if (CvXSUB(GvCV(gv)))
+    if (CvISXSUB(GvCV(gv)))
 	Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
 	    PTR2UV(CvXSUB(GvCV(gv))),
 	    (int)CvXSUBANY(GvCV(gv)).any_i32);
@@ -101,7 +104,7 @@ Perl_dump_form(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
     if (CvROOT(GvFORM(gv)))
 	op_dump(CvROOT(GvFORM(gv)));
@@ -112,6 +115,7 @@ Perl_dump_form(pTHX_ const GV *gv)
 void
 Perl_dump_eval(pTHX)
 {
+    dVAR;
     op_dump(PL_eval_root);
 }
 
@@ -765,10 +769,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #else
 	if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
 	    if (cSVOPo->op_sv) {
-		SV *tmpsv = NEWSV(0,0);
+		SV *tmpsv = newSV(0);
 		ENTER;
 		SAVEFREESV(tmpsv);
-		gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
+		gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, NULL);
 		Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
 				 SvPV_nolen_const(tmpsv));
 		LEAVE;
@@ -871,10 +875,10 @@ Perl_gv_dump(pTHX_ GV *gv)
     }
     sv = sv_newmortal();
     PerlIO_printf(Perl_debug_log, "{\n");
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
     if (gv != GvEGV(gv)) {
-	gv_efullname3(sv, GvEGV(gv), Nullch);
+	gv_efullname3(sv, GvEGV(gv), NULL);
 	Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
     }
     PerlIO_putc(Perl_debug_log, '\n');
@@ -890,7 +894,6 @@ 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(<)" },
@@ -952,7 +955,6 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
             else if (v == &PL_vtbl_dbline)     s = "dbline";
             else if (v == &PL_vtbl_isa)        s = "isa";
             else if (v == &PL_vtbl_arylen)     s = "arylen";
-            else if (v == &PL_vtbl_glob)       s = "glob";
             else if (v == &PL_vtbl_mglob)      s = "mglob";
             else if (v == &PL_vtbl_nkeys)      s = "nkeys";
             else if (v == &PL_vtbl_taint)      s = "taint";
@@ -1097,6 +1099,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
+    dVAR;
     SV *d;
     const char *s;
     U32 flags;
@@ -1173,7 +1176,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (GvUNIQUE(sv))       sv_catpv(d, "UNIQUE,");
 	if (GvASSUMECV(sv))	sv_catpv(d, "ASSUMECV,");
 	if (GvIN_PAD(sv))       sv_catpv(d, "IN_PAD,");
-	if (flags & SVpad_OUR)	sv_catpv(d, "OUR,");
+	if (SvPAD_OUR(sv))	sv_catpv(d, "OUR,");
+	if (SvPAD_TYPED(sv))	sv_catpv(d, "TYPED,");
 	if (GvIMPORTED(sv)) {
 	    sv_catpv(d, "IMPORT");
 	    if (GvIMPORTED(sv) == GVf_IMPORTED)
@@ -1197,8 +1201,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (SvVALID(sv))	sv_catpv(d, "VALID,");
 	break;
     case SVt_PVMG:
-	if (flags & SVpad_TYPED)
-				sv_catpv(d, "TYPED,");
+	if (SvPAD_TYPED(sv))	sv_catpv(d, "TYPED,");
 	break;
     case SVt_PVAV:
 	break;
@@ -1278,8 +1281,8 @@ 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_PVAV && type != SVt_PVHV)
-	|| type == SVt_IV) {
+    if (type == SVt_IV || (type >= SVt_PVIV && type != SVt_PVAV
+			   && type != SVt_PVHV && type != SVt_PVCV)) {
 	if (SvIsUV(sv)
 #ifdef PERL_OLD_COPY_ON_WRITE
 	               || SvIsCOW(sv)
@@ -1298,7 +1301,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_PVAV && type != SVt_PVHV)
+    if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
+	 && type != SVt_PVCV && type != SVt_PVFM)
 	|| type == SVt_NV) {
 	STORE_NUMERIC_LOCAL_SET_STANDARD();
 	/* %Vg doesn't work? --jhi */
@@ -1318,7 +1322,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	SvREFCNT_dec(d);
 	return;
     }
-    if (type <= SVt_PVLV && type != SVt_PVGV) {
+    if (type <= SVt_PVLV) {
 	if (SvPVX_const(sv)) {
 	    Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
 	    if (SvOOK(sv))
@@ -1481,15 +1485,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	/* 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(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)));
-	{
+	if (!CvISXSUB(sv)) {
+	    if (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));
+	    }
+	} else {
 	    SV *constant = cv_const_sv((CV *)sv);
 
+	    Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
 
 	    if (constant) {
 		Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
@@ -1586,12 +1597,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 void
 Perl_sv_dump(pTHX_ SV *sv)
 {
+    dVAR;
     do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
 }
 
 int
 Perl_runops_debug(pTHX)
 {
+    dVAR;
     if (!PL_op) {
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
@@ -1630,6 +1643,7 @@ Perl_runops_debug(pTHX)
 I32
 Perl_debop(pTHX_ const OP *o)
 {
+    dVAR;
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
 	return 0;
 
@@ -1641,8 +1655,8 @@ Perl_debop(pTHX_ const OP *o)
     case OP_GVSV:
     case OP_GV:
 	if (cGVOPo_gv) {
-	    SV *sv = NEWSV(0,0);
-	    gv_fullname3(sv, cGVOPo_gv, Nullch);
+	    SV *sv = newSV(0);
+	    gv_fullname3(sv, cGVOPo_gv, NULL);
 	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
 	    SvREFCNT_dec(sv);
 	}
@@ -1661,7 +1675,7 @@ Perl_debop(pTHX_ const OP *o)
             AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
             sv = *av_fetch(comppad, o->op_targ, FALSE);
         } else
-            sv = Nullsv;
+            sv = NULL;
         if (sv)
            PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
         else
@@ -1678,6 +1692,7 @@ Perl_debop(pTHX_ const OP *o)
 STATIC CV*
 S_deb_curcv(pTHX_ I32 ix)
 {
+    dVAR;
     const PERL_CONTEXT *cx = &cxstack[ix];
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
         return cx->blk_sub.cv;
@@ -1686,7 +1701,7 @@ S_deb_curcv(pTHX_ I32 ix)
     else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
         return PL_main_cv;
     else if (ix <= 0)
-        return Nullcv;
+        return NULL;
     else
         return deb_curcv(ix - 1);
 }
@@ -1694,6 +1709,7 @@ S_deb_curcv(pTHX_ I32 ix)
 void
 Perl_watch(pTHX_ char **addr)
 {
+    dVAR;
     PL_watchaddr = addr;
     PL_watchok = *addr;
     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
@@ -1703,6 +1719,7 @@ Perl_watch(pTHX_ char **addr)
 STATIC void
 S_debprof(pTHX_ const OP *o)
 {
+    dVAR;
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
 	return;
     if (!PL_profiledata)
@@ -1713,6 +1730,7 @@ S_debprof(pTHX_ const OP *o)
 void
 Perl_debprofdump(pTHX)
 {
+    dVAR;
     unsigned i;
     if (!PL_profiledata)
 	return;