This will allow named lexical subs to exist independent of GVs.
#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
#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)
#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
#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)
Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
{
GV * const oldgv = CvGV(cv);
+ HEK *hek;
PERL_ARGS_ASSERT_CVGV_SET;
if (oldgv == 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)
#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");
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));
{
/* 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:
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;
}
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));
}
}
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)
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; \