From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 20 Feb 2006 13:42:47 +0000 (+0000)
Subject: xcv_root and xcv_xsub can also be merged into a union, providing a new
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d04ba5897acce6425e3b231fbf36336ea42f8165;p=p5sagit%2Fp5-mst-13.2.git

xcv_root and xcv_xsub can also be merged into a union, providing a new
flag is added to denote whether the PVCV is perl or XSUB.

p4raw-id: //depot/perl@27244
---

diff --git a/cv.h b/cv.h
index d082146..9e1dce0 100644
--- a/cv.h
+++ b/cv.h
@@ -27,8 +27,10 @@ struct xpvcv {
 	OP *	xcv_start;
 	ANY	xcv_xsubany;
     }		xcv_start_u;
-    OP *	xcv_root;
-    void	(*xcv_xsub) (pTHX_ CV*);
+    union {
+	OP *	xcv_root;
+	void	(*xcv_xsub) (pTHX_ CV*);
+    }		xcv_root_u;
     GV *	xcv_gv;
     char *	xcv_file;
     long	xcv_depth;	/* >= 2 indicates recursive call */
@@ -58,8 +60,8 @@ Returns the stash of the CV.
 
 #define CvSTASH(sv)	((XPVCV*)SvANY(sv))->xcv_stash
 #define CvSTART(sv)	((XPVCV*)SvANY(sv))->xcv_start_u.xcv_start
-#define CvROOT(sv)	((XPVCV*)SvANY(sv))->xcv_root
-#define CvXSUB(sv)	((XPVCV*)SvANY(sv))->xcv_xsub
+#define CvROOT(sv)	((XPVCV*)SvANY(sv))->xcv_root_u.xcv_root
+#define CvXSUB(sv)	((XPVCV*)SvANY(sv))->xcv_root_u.xcv_xsub
 #define CvXSUBANY(sv)	((XPVCV*)SvANY(sv))->xcv_start_u.xcv_xsubany
 #define CvGV(sv)	((XPVCV*)SvANY(sv))->xcv_gv
 #define CvFILE(sv)	((XPVCV*)SvANY(sv))->xcv_file
@@ -92,6 +94,7 @@ Returns the stash of the CV.
 				   (esp. useful for special XSUBs) */
 #define CVf_CONST	0x0400  /* inlinable sub */
 #define CVf_OLDSTYLE	0x0800
+#define CVf_ISXSUB	0x1000	/* CV is an XSUB, not pure perl.  */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ASSERTION)
@@ -155,7 +158,10 @@ Returns the stash of the CV.
 #define CvWEAKOUTSIDE_on(cv)	(CvFLAGS(cv) |= CVf_WEAKOUTSIDE)
 #define CvWEAKOUTSIDE_off(cv)	(CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE)
 
-#define CvISXSUB(cv)		(CvXSUB(cv) ? TRUE : FALSE)
+#define CvISXSUB(cv)		(CvFLAGS(cv) & CVf_ISXSUB)
+#define CvISXSUB_on(cv)		(CvFLAGS(cv) |= CVf_ISXSUB)
+#define CvISXSUB_off(cv)	(CvFLAGS(cv) &= ~CVf_ISXSUB)
+
 /*
 =head1 CV reference counts and CvOUTSIDE
 
diff --git a/dump.c b/dump.c
index 419a546..64d7765 100644
--- a/dump.c
+++ b/dump.c
@@ -1486,15 +1486,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 (!CvISXSUB(sv) && 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 (!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
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 8271d04..bfccf7d 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1644,6 +1644,10 @@ CvSTART(cv)
 B::OP
 CvROOT(cv)
 	B::CV	cv
+    CODE:
+	RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
+    OUTPUT:
+	RETVAL
 
 B::GV
 CvGV(cv)
@@ -1673,7 +1677,7 @@ void
 CvXSUB(cv)
 	B::CV	cv
     CODE:
-	ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
+	ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
 
 
 void
diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 6984571..dcd3e10 100644
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -32,9 +32,13 @@ sub do_test {
 	    # handle DEBUG_LEAKING_SCALARS prefix
 	    $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
 
-	    $pattern =~ s/^ *\$XSUBANY *\n/
-		($] < 5.009) ? "    XSUBANY = 0\n" : '';
+	    $pattern =~ s/^ *\$XSUB *\n/
+		($] < 5.009) ? "    XSUB = 0\n    XSUBANY = 0\n" : '';
 	    /mge;
+	    $pattern =~ s/^ *\$ROOT *\n/
+		($] < 5.009) ? "    ROOT = 0x0\n" : '';
+	    /mge;
+
 
 
 	    print $pattern, "\n" if $DEBUG;
@@ -220,8 +224,7 @@ do_test(13,
     COMP_STASH = $ADDR\\t"main"
     START = $ADDR ===> \\d+
     ROOT = $ADDR
-    XSUB = 0x0
-    $XSUBANY
+    $XSUB
     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
     FILE = ".*\\b(?i:peek\\.t)"
     DEPTH = 0
@@ -247,8 +250,7 @@ do_test(14,
     COMP_STASH = $ADDR\\t"main"
     START = $ADDR ===> \\d+
     ROOT = $ADDR
-    XSUB = 0x0
-    $XSUBANY
+    $XSUB
     GVGV::GV = $ADDR\\t"main" :: "do_test"
     FILE = ".*\\b(?i:peek\\.t)"
     DEPTH = 1
@@ -493,7 +495,7 @@ do_test(23,
     NV = 0
     PROTOTYPE = ""
     COMP_STASH = 0x0
-    ROOT = 0x0
+    $ROOT
     XSUB = $ADDR
     XSUBANY = $ADDR \\(CONST SV\\)
     SV = PV\\($ADDR\\) at $ADDR
@@ -507,7 +509,7 @@ do_test(23,
     DEPTH = 0
 (?:    MUTEXP = $ADDR
     OWNER = $ADDR
-)?    FLAGS = 0x400
+)?    FLAGS = 0x1400
     OUTSIDE_SEQ = 0
     PADLIST = 0x0
     OUTSIDE = 0x0 \\(null\\)');	
diff --git a/op.c b/op.c
index cb507ba..85e8852 100644
--- a/op.c
+++ b/op.c
@@ -4295,7 +4295,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
 	CvCONST_off(cv);
     }
-    if (CvXSUB(cv)) {
+    if (CvISXSUB(cv) && CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
     /* delete all flags except WEAKOUTSIDE */
@@ -4586,6 +4586,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    CvXSUBANY(cv).any_ptr = const_sv;
 	    CvXSUB(cv) = const_sv_xsub;
 	    CvCONST_on(cv);
+	    CvISXSUB_on(cv);
 	}
 	else {
 	    GvCV(gv) = NULL;
@@ -4916,6 +4917,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
     (void)gv_fetchfile(filename);
     CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
 				   an external constant string */
+    CvISXSUB_on(cv);
     CvXSUB(cv) = subaddr;
 
     if (name) {
diff --git a/sv.c b/sv.c
index 75ba895..7619c7d 100644
--- a/sv.c
+++ b/sv.c
@@ -9824,7 +9824,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 		/* NOTE: not refcounted */
 		CvSTASH(dstr)	= hv_dup(CvSTASH(dstr), param);
 		OP_REFCNT_LOCK;
-		CvROOT(dstr)	= OpREFCNT_inc(CvROOT(dstr));
+		if (!CvISXSUB(dstr))
+		    CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr));
 		OP_REFCNT_UNLOCK;
 		if (CvCONST(dstr)) {
 		    CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(dstr)) ?
diff --git a/sv.h b/sv.h
index e85fd7a..a3f28db 100644
--- a/sv.h
+++ b/sv.h
@@ -434,8 +434,10 @@ struct xpvfm {
 	OP *	xcv_start;
 	ANY	xcv_xsubany;
     }		xcv_start_u;
-    OP *	xcv_root;
-    void      (*xcv_xsub)(pTHX_ CV*);
+    union {
+	OP *	xcv_root;
+	void	(*xcv_xsub) (pTHX_ CV*);
+    }		xcv_root_u;
     GV *	xcv_gv;
     char *	xcv_file;
     long	xcv_depth;	/* >= 2 indicates recursive call */
@@ -460,10 +462,14 @@ typedef struct {
     HV*		xmg_stash;	/* class package */
 
     HV *	xcv_stash;
-    OP *	xcv_start;
-    OP *	xcv_root;
-    void      (*xcv_xsub)(pTHX_ CV*);
-    ANY		xcv_xsubany;
+    union {
+	OP *	xcv_start;
+	ANY	xcv_xsubany;
+    }		xcv_start_u;
+    union {
+	OP *	xcv_root;
+	void	(*xcv_xsub) (pTHX_ CV*);
+    }		xcv_root_u;
     GV *	xcv_gv;
     char *	xcv_file;
     long	xcv_depth;	/* >= 2 indicates recursive call */