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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 */