Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
const U32 flags)
{
- dVAR;
char smallbuf[128];
char *tmpbuf;
const STRLEN tmplen = namelen + 2;
Perl_gv_const_sv(pTHX_ GV *gv)
{
PERL_ARGS_ASSERT_GV_CONST_SV;
+ PERL_UNUSED_CONTEXT;
if (SvTYPE(gv) == SVt_PVGV)
return cv_const_sv(GvCVu(gv));
sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
}
}
- else if ((hek = CvNAME_HEK(cv))) unshare_hek(hek);
+ else if ((hek = CvNAME_HEK(cv))) {
+ unshare_hek(hek);
+ CvNAMED_off(cv);
+ }
SvANY(cv)->xcv_gv_u.xcv_gv = gv;
assert(!CvCVGV_RC(cv));
void
Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flags)
{
- dVAR;
const U32 old_type = SvTYPE(gv);
const bool doproto = old_type > SVt_NULL;
char * const proto = (doproto && SvPOK(gv))
GV *
Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
{
- dVAR;
GV** gvp;
AV* linear_av;
SV** linear_svp;
GV *
Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
{
- dVAR;
const char *nend;
const char *nsplit = NULL;
GV* gv;
GV*
Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
{
- dVAR;
GV* gv;
CV* cv;
HV* varstash;
* use that, but for lack of anything better we will use the sub's
* original package to look up $AUTOLOAD.
*/
- varstash = GvSTASH(CvGV(cv));
+ varstash = CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv));
vargv = *(GV**)hv_fetch(varstash, S_autoload, S_autolen, TRUE);
ENTER;
STATIC HV*
S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags)
{
- dVAR;
HV* stash = gv_stashsv(namesv, 0);
PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
=cut
*/
-HV*
-Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
+PERL_STATIC_INLINE HV*
+S_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
{
char smallbuf[128];
char *tmpbuf;
return stash;
}
+HV*
+Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
+{
+ HV* stash;
+ const HE* const he = (const HE *)hv_common(
+ PL_stashcache, NULL, name, namelen,
+ (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0
+ );
+ if (he) return INT2PTR(HV*,SvIVX(HeVAL(he)));
+ else if (flags & GV_CACHE_ONLY) return NULL;
+
+ stash = S_stashpvn(aTHX_ name, namelen, flags);
+ if (stash && namelen) {
+ SV* const ref = newSViv(PTR2IV(stash));
+ hv_store(PL_stashcache, name,
+ (flags & SVf_UTF8) ? -(I32)namelen : (I32)namelen, ref, 0);
+ }
+ return stash;
+}
+
/*
=for apidoc gv_stashsv
if (!isDIGIT(*end))
return addmg;
}
- paren = strtoul(name, NULL, 10);
+ paren = grok_atou(name, NULL);
goto storeparen;
}
}
Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
const svtype sv_type)
{
- dVAR;
const char *name = nambeg;
GV *gv = NULL;
GV**gvp;
void
Perl_gv_check(pTHX_ HV *stash)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_GV_CHECK;
GV *
Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
{
- dVAR;
PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
assert(!(flags & ~SVf_UTF8));
GP*
Perl_gp_ref(pTHX_ GP *gp)
{
- dVAR;
if (!gp)
return NULL;
gp->gp_refcnt++;
void
Perl_gp_free(pTHX_ GV *gv)
{
- dVAR;
GP* gp;
int attempts = 100;
int
Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
{
- dVAR;
MAGIC* const mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
AMT amt;
const struct mro_meta* stash_meta = HvMROMETA(stash);
numifying instead of C's "+0". */
gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
cv = 0;
- if (gv && (cv = GvCV(gv))) {
+ if (gv && (cv = GvCV(gv)) && CvGV(cv)) {
if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){
const char * const hvname = HvNAME_get(GvSTASH(CvGV(cv)));
if (hvname && HEK_LEN(HvNAME_HEK(GvSTASH(CvGV(cv)))) == 8
CV*
Perl_gv_handler(pTHX_ HV *stash, I32 id)
{
- dVAR;
MAGIC *mg;
AMT *amtp;
U32 newgen;
bool
Perl_try_amagic_un(pTHX_ int method, int flags) {
- dVAR;
dSP;
SV* tmpsv;
SV* const arg = TOPs;
bool
Perl_try_amagic_bin(pTHX_ int method, int flags) {
- dVAR;
dSP;
SV* const left = TOPm1s;
SV* const right = TOPs;