Allow CVs to point to HEKs rather than GVs

This will allow named lexical subs to exist independent of GVs.

diff --git a/cv.h b/cv.h
index 960ae1d..3d44a73 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -49,7 +49,7 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CvROOT(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root
 #define CvXSUB(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub
 #define CvXSUBANY(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany
-#define CvGV(sv)       (0+((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv)
+#define CvGV(sv)       S_CvGV((CV *)(sv))
 #define CvGV_set(cv,gv)        Perl_cvgv_set(aTHX_ cv, gv)
 #define CvFILE(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file
 #ifdef USE_ITHREADS
@@ -103,6 +103,7 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CVf_DYNFILE    0x1000  /* The filename isn't static  */
 #define CVf_AUTOLOAD   0x2000  /* SvPVX contains AUTOLOADed sub name  */
 #define CVf_HASEVAL    0x4000  /* contains string eval  */
+#define CVf_NAMED      0x8000  /* Has a name HEK */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS      (CVf_METHOD|CVf_LVALUE)
@@ -180,9 +181,28 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CvHASEVAL_on(cv)       (CvFLAGS(cv) |= CVf_HASEVAL)
 #define CvHASEVAL_off(cv)      (CvFLAGS(cv) &= ~CVf_HASEVAL)
 
+#define CvNAMED(cv)            (CvFLAGS(cv) & CVf_NAMED)
+#define CvNAMED_on(cv)         (CvFLAGS(cv) |= CVf_NAMED)
+#define CvNAMED_off(cv)                (CvFLAGS(cv) &= ~CVf_NAMED)
+
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME    0x01    /* The filename isn't static  */
 
+PERL_STATIC_INLINE GV *
+S_CvGV(CV *sv)
+{
+    return CvNAMED(sv)
+       ? 0
+       : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
+}
+PERL_STATIC_INLINE HEK *
+CvNAME_HEK(CV *sv)
+{
+    return CvNAMED(sv)
+       ? ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_hek
+       : 0;
+}
+
 /*
 =head1 CV reference counts and CvOUTSIDE
 

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 69c4aae..ad839b5 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1452,7 +1452,11 @@ MODULE = B       PACKAGE = B::IV
 #define PVAV_max_ix    sv_SSize_tp | offsetof(struct xpvav, xav_max)
 
 #define PVCV_stash_ix  sv_SVp | offsetof(struct xpvcv, xcv_stash) 
-#define PVCV_gv_ix     sv_SVp | offsetof(struct xpvcv, xcv_gv)
+#if PERL_VERSION > 17 || (PERL_VERSION == 17 && PERL_SUBVERSION >= 3)
+# define PVCV_gv_ix    sv_SVp | offsetof(struct xpvcv, xcv_gv_u.xcv_gv)
+#else
+# define PVCV_gv_ix    sv_SVp | offsetof(struct xpvcv, xcv_gv)
+#endif
 #define PVCV_file_ix   sv_char_pp | offsetof(struct xpvcv, xcv_file)
 #define PVCV_outside_ix        sv_SVp | offsetof(struct xpvcv, xcv_outside)
 #define PVCV_outside_seq_ix sv_U32p | offsetof(struct xpvcv, xcv_outside_seq)

diff --git a/gv.c b/gv.c
index e64c8f2..01ed1f5 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -207,6 +207,7 @@ void
 Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 {
     GV * const oldgv = CvGV(cv);
+    HEK *hek;
     PERL_ARGS_ASSERT_CVGV_SET;
 
     if (oldgv == gv)
@@ -221,8 +222,9 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
            sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
        }
     }
+    else if ((hek = CvNAME_HEK(cv))) unshare_hek(hek);
 
-    SvANY(cv)->xcv_gv = gv;
+    SvANY(cv)->xcv_gv_u.xcv_gv = gv;
     assert(!CvCVGV_RC(cv));
 
     if (!gv)

diff --git a/pad.c b/pad.c
index 711fd21..68058be 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -381,7 +381,8 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
-    CvGV_set(cv, NULL);
+    if (CvNAMED(cv)) unshare_hek(CvNAME_HEK(cv));
+    else            CvGV_set(cv, NULL);
 
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
@@ -1989,7 +1990,9 @@ Perl_cv_clone(pTHX_ CV *proto)
 
     CvFILE(cv)         = CvDYNFILE(proto) ? savepv(CvFILE(proto))
                                           : CvFILE(proto);
-    CvGV_set(cv,CvGV(proto));
+    if (CvNAMED(proto))
+        SvANY(cv)->xcv_gv_u.xcv_hek = share_hek_hek(CvNAME_HEK(proto));
+    else CvGV_set(cv,CvGV(proto));
     CvSTASH_set(cv, CvSTASH(proto));
     OP_REFCNT_LOCK;
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));

diff --git a/pp.c b/pp.c
index 00b28ae..a14b62b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -935,8 +935,14 @@ PP(pp_undef)
        {
            /* let user-undef'd sub keep its identity */
            GV* const gv = CvGV((const CV *)sv);
+           HEK * const hek = CvNAME_HEK((CV *)sv);
+           if (hek) share_hek_hek(hek);
            cv_undef(MUTABLE_CV(sv));
-           CvGV_set(MUTABLE_CV(sv), gv);
+           if (gv) CvGV_set(MUTABLE_CV(sv), gv);
+           else if (hek) {
+               SvANY((CV *)sv)->xcv_gv_u.xcv_hek = hek;
+               CvNAMED_on(sv);
+           }
        }
        break;
     case SVt_PVGV:

diff --git a/sv.c b/sv.c
index 63523dd..2312a36 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5906,10 +5906,11 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
     assert(GvGP(gv));
     assert(!CvANON(cv));
     assert(CvGV(cv) == gv);
+    assert(!CvNAMED(cv));
 
     /* will the CV shortly be freed by gp_free() ? */
     if (GvCV(gv) == cv && GvGP(gv)->gp_refcnt < 2 && SvREFCNT(cv) < 2) {
-       SvANY(cv)->xcv_gv = NULL;
+       SvANY(cv)->xcv_gv_u.xcv_gv = NULL;
        return;
     }
 
@@ -5923,7 +5924,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
 
     CvANON_on(cv);
     CvCVGV_RC_on(cv);
-    SvANY(cv)->xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
+    SvANY(cv)->xcv_gv_u.xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
 }
 
 
@@ -12159,9 +12160,13 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                }
                assert(!CvSLABBED(dstr));
                if (CvDYNFILE(dstr)) CvFILE(dstr) = SAVEPV(CvFILE(dstr));
+               if (CvNAMED(dstr))
+                   SvANY((CV *)dstr)->xcv_gv_u.xcv_hek =
+                       share_hek_hek(CvNAME_HEK((CV *)sstr));
                /* don't dup if copying back - CvGV isn't refcounted, so the
                 * duped GV may never be freed. A bit of a hack! DAPM */
-               SvANY(MUTABLE_CV(dstr))->xcv_gv =
+               else
+                 SvANY(MUTABLE_CV(dstr))->xcv_gv_u.xcv_gv =
                    CvCVGV_RC(dstr)
                    ? gv_dup_inc(CvGV(sstr), param)
                    : (param->flags & CLONEf_JOIN_IN)

diff --git a/sv.h b/sv.h
index ebbc27a..18d3015 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -459,7 +459,10 @@ typedef U16 cv_flags_t;
        OP *    xcv_root;                                                       \
        void    (*xcv_xsub) (pTHX_ CV*);                                        \
     }          xcv_root_u;                                                     \
-    GV *       xcv_gv;                                                         \
+    union {                                                            \
+       GV *    xcv_gv;                                                 \
+       HEK *   xcv_hek;                                                \
+    }          xcv_gv_u;                                               \
     char *     xcv_file;                                                       \
     PADLIST *  xcv_padlist;                                                    \
     CV *       xcv_outside;                                                    \