Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add compact vararg impl gv_stashsvpvn_cached_p, add gv_stashhek #23041

Open
wants to merge 1 commit into
base: blead
Choose a base branch
from
+155 −14
Open

add compact vararg impl gv_stashsvpvn_cached_p, add gv_stashhek #23041

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1468,11 +1468,15 @@ ep |GV * |gv_override |NN const char * const name \
|const STRLEN len
p |void |gv_setref |NN SV * const dsv \
|NN SV * const ssv
Ap |HV * |gv_stashhek |NN HEK *hek \
|I32 flags
Adp |HV * |gv_stashpv |NN const char *name \
|I32 flags
Adp |HV * |gv_stashpvn |NN const char *name \
|U32 namelen \
|I32 flags
Xp |HV * |gv_stashpvs_p |I32 flags \
|NN const char *name
Adp |HV * |gv_stashsv |NN SV *sv \
|I32 flags
Xdpx |void |gv_try_downgrade \
Expand Down Expand Up @@ -4510,6 +4514,10 @@ EGdp |HV * |gv_stashsvpvn_cached \
|const char *name \
|U32 namelen \
|I32 flags
EFXp |HV * |gv_stashsvpvn_cached_p \
|I32 flags \
|NN void *namevp \
|...
#endif
#if defined(PERL_IN_HV_C)
Sx |void |clear_placeholders \
Expand Down
3 changes: 3 additions & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -294,6 +294,7 @@
# define gv_init_pvn(a,b,c,d,e) Perl_gv_init_pvn(aTHX_ a,b,c,d,e)
# define gv_init_sv(a,b,c,d) Perl_gv_init_sv(aTHX_ a,b,c,d)
# define gv_name_set(a,b,c,d) Perl_gv_name_set(aTHX_ a,b,c,d)
# define gv_stashhek(a,b) Perl_gv_stashhek(aTHX_ a,b)
# define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b)
# define gv_stashpvn(a,b,c) Perl_gv_stashpvn(aTHX_ a,b,c)
# define gv_stashsv(a,b) Perl_gv_stashsv(aTHX_ a,b)
Expand Down Expand Up @@ -1072,6 +1073,7 @@
# define get_opargs() Perl_get_opargs(aTHX)
# define gv_override(a,b) Perl_gv_override(aTHX_ a,b)
# define gv_setref(a,b) Perl_gv_setref(aTHX_ a,b)
# define gv_stashpvs_p(a,b) Perl_gv_stashpvs_p(aTHX_ a,b)
# define gv_try_downgrade(a) Perl_gv_try_downgrade(aTHX_ a)
# define hv_ename_add(a,b,c,d) Perl_hv_ename_add(aTHX_ a,b,c,d)
# define hv_ename_delete(a,b,c,d) Perl_hv_ename_delete(aTHX_ a,b,c,d)
Expand Down Expand Up @@ -1937,6 +1939,7 @@
# endif
# if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C)
# define gv_stashsvpvn_cached(a,b,c,d) Perl_gv_stashsvpvn_cached(aTHX_ a,b,c,d)
# define gv_stashsvpvn_cached_p(a,...) Perl_gv_stashsvpvn_cached_p(aTHX_ a,__VA_ARGS__)
# endif
# if defined(PERL_IN_OP_C) || defined(PERL_IN_REGCOMP_ANY)
# define get_invlist_iter_addr S_get_invlist_iter_addr
Expand Down
111 changes: 100 additions & 11 deletions gv.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1621,7 +1621,8 @@ HV*
Perl_gv_stashpv(pTHX_ const char *name, I32 create)
{
PERL_ARGS_ASSERT_GV_STASHPV;
return gv_stashpvn(name, strlen(name), create);
return Perl_gv_stashsvpvn_cached_p(aTHX_ create | GVCf_ISPV | GVCf_HASVA_LEN,
(void*)name, strlen(name));
}

/*
Expand Down Expand Up @@ -1696,15 +1697,73 @@ reasons.

HV*
Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
{
PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED;
if(namesv)
return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISSV, (void*)namesv);
else
return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV | GVCf_HASVA_LEN,
(void*)name, namelen);
}

/* Not public API, "..." takes exactly 1 optional arg, "U32 namelen" for the
public facing _pvn() variant. All other varieties, pv() pvs() sv() hek()
do not use the optional 3rd arg.*/
HV*
Perl_gv_stashsvpvn_cached_p(pTHX_ I32 flags, void * namevp, ...)
{
HV* stash;
HE* he;
SV* namesv;
const char* name;
va_list args;
U32 namelen;
U32 hash;

PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED;
PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED_P;
va_start(args, namevp);
if(GV_CACHE_ISRC(flags)) {
if(GV_CACHE_ISHEK(flags)) {
HEK* hek = (HEK*)namevp;
I32 hek_len = HEK_LEN(hek);
if(hek_len == HEf_SVKEY) {
namesv = *(SV**)HEK_KEY(hek);
namevp = (void*)namesv;
goto have_sv;
}
namesv = NULL;
name = HEK_KEY(hek);
namelen = hek_len;
flags = (flags & ~SVf_UTF8) | (HEK_UTF8(hek) ? SVf_UTF8 : 0);
/* hv_fetchhek() isn't used here. Its a macro and doesn't currently
do the optimisation you think it is supposed to do. Using macro
hv_fetchhek() in this fn, would add needless indirection through
wrapper hv_common_key_len() instead of centralized single call sites
to hv_common(). */
hash = HEK_HASH(hek);
}
else {
have_sv:
assert(GV_CACHE_ISSV(flags));
namesv = (SV*)namevp;
name = NULL;
namelen = 0;
flags = (flags & ~SVf_UTF8) | SvUTF8(namesv);
hash = 0;
}
}
else {
assert(GV_CACHE_ISPV(flags));
namesv = NULL;
name = (const char *)namevp;
namelen = GV_CACHE_HASVA_LEN(flags)
? va_arg(args, U32) : GV_CACHE_GET_INL_LEN(flags);
hash = 0;
}

he = (HE *)hv_common(
PL_stashcache, namesv, name, namelen,
(flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0
(flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, hash
);

if (he) {
Expand All @@ -1713,44 +1772,74 @@ Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 f
assert(SvIOK(sv));
hv = INT2PTR(HV*, SvIVX(sv));
assert(SvTYPE(hv) == SVt_PVHV);
return hv;
stash = hv;
goto end;
}
else if (flags & GV_CACHE_ONLY) {
stash = NULL;
goto end;
}
else if (flags & GV_CACHE_ONLY) return NULL;

if (namesv) {
if (SvOK(namesv)) { /* prevent double uninit warning */
STRLEN len;
name = SvPV_const(namesv, len);
namelen = len;
flags |= SvUTF8(namesv);
flags = (flags & ~SVf_UTF8) | SvUTF8(namesv);
} else {
name = ""; namelen = 0;
namesv = NULL; flags = flags & ~SVf_UTF8;
}
}
} /* Turn off bits specific to our call conv so GV_NOADD_MASK works.
Some of our call conv bits are shared with other features from
other front end gv_*() funcs. */
flags &= ~GV_CACHE_VA_ARGS_MASK;
stash = gv_stashpvn_internal(name, namelen, flags);

if (stash && namelen) {
SV* const ref = newSViv(PTR2IV(stash));
(void)hv_store(PL_stashcache, name,
(flags & SVf_UTF8) ? -(I32)namelen : (I32)namelen, ref, 0);
hv_common( PL_stashcache, namesv, name, namelen,
(flags & SVf_UTF8) ? HVhek_UTF8 : 0, HV_FETCH_ISSTORE, ref, hash
);
}

end:
va_end(args);
return stash;
}

HV*
Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
{
PERL_ARGS_ASSERT_GV_STASHPVN;
return gv_stashsvpvn_cached(NULL, name, namelen, flags);
return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV | GVCf_HASVA_LEN,
(void*)name, namelen);
}

HV*
Perl_gv_stashpvs_p(pTHX_ I32 flags, const char *name)
{
PERL_ARGS_ASSERT_GV_STASHPVS_P;
return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV, (void*)name);
}


HV*
Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
{
PERL_ARGS_ASSERT_GV_STASHSV;
return gv_stashsvpvn_cached(sv, NULL, 0, flags);
return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISSV, (void*)sv);
}

HV*
Perl_gv_stashhek(pTHX_ HEK *hek, I32 flags)
{
PERL_ARGS_ASSERT_GV_STASHHEK;
return Perl_gv_stashsvpvn_cached_p(aTHX_
flags | GVCf_ISHEK,
(void*)hek);
}

GV *
Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 flags, const svtype sv_type) {
PERL_ARGS_ASSERT_GV_FETCHPV;
Expand Down
22 changes: 22 additions & 0 deletions gv.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,6 +272,27 @@ Return the CV from the GV.
#define GV_ADDMG 0x400 /* add if magical */
#define GV_NO_SVGMAGIC 0x800 /* Skip get-magic on an SV argument;
used only by gv_fetchsv(_nomg) */
#define GVCf_ISRC 0x2000
#define GVCf_ISSV GVCf_ISRC
#define GVCf_ISPV 0x0
#define GVCf_ISHEKORPVN 0x4000
#define GVCf_ISHEK (GVCf_ISHEKORPVN|GVCf_ISRC)
#define GVCf_HASVA_LEN GVCf_ISHEKORPVN

#define GV_CACHE_ISPV(_f) (((_f) & GVCf_ISRC)==0)
#define GV_CACHE_HASVA_LEN(_f) (((_f)&(GVCf_ISHEKORPVN|GVCf_ISRC)) == (GVCf_ISHEKORPVN))
#define GV_CACHE_ISRC(_f) ((_f)&GVCf_ISRC) //0x2000 //sv #50 pv[|n|s] #184
#define GV_CACHE_ISSV(_f) (((_f)&(GVCf_ISHEKORPVN|GVCf_ISRC)) == GVCf_ISRC) //0x2000 //sv #50 pv[|n|s] #184
/* core .xs's sv 9, pvn 15, pv 47, pvs 4
core .c's sv 19, pvn 14, pv 3, pvs 4 */
#define GV_CACHE_ISHEK(_f) (((_f)&GVCf_ISHEK) == GVCf_ISHEK)
#define GV_CACHE_INL_LEN_MASK 0x00FF0000
#define GV_CACHE_INL_LEN_MAX 0xFF
#define GV_CACHE_GET_INL_LEN(_f) ((U8)((_f)>>16))
#define GV_CACHE_FITS_INL_LEN(_f) ((_f) <= GV_CACHE_INL_LEN_MAX)
#define GV_CACHE_PACK_INL_LEN(_f) ((U32)(((U32)((U8)(_f))) << 16))
#define GV_CACHE_VA_ARGS_MASK (GVCf_ISRC|GVCf_ISHEKORPVN|GV_CACHE_INL_LEN_MASK)

#define GV_CACHE_ONLY 0x1000 /* return stash only if found in cache;
used only in flags parameter to gv_stash* family */

Expand All @@ -287,6 +308,7 @@ Return the CV from the GV.
as a flag to various gv_* functions, so ensure it lies
outside this range.
*/
#define GV_UTF8fprvt SVf_UTF8 /* 0x20000000 */ /* SvPV is UTF-8 encoded */

#define GV_NOADD_MASK \
(SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG|GV_NO_SVGMAGIC)
Expand Down
8 changes: 6 additions & 2 deletions handy.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -455,8 +455,12 @@ Perl_xxx(aTHX_ ...) form for any API calls where it's used.
=for apidoc_defn Am|HV*|gv_stashpvs|"name"|I32 create
=cut
*/
#define gv_stashpvs(str, create) \
Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create)

#define gv_stashpvs(str, create) Perl_gv_stashpvs_p(aTHX_ \
((create) | ( GV_CACHE_FITS_INL_LEN(sizeof(str)-1) \
? GV_CACHE_PACK_INL_LEN(sizeof(str)-1) \
: (Perl_croak_nocontext("panic: gv_stashpvs overflow"), \
GV_CACHE_INL_LEN_MAX))), ASSERT_IS_LITERAL(str))


/*
Expand Down
17 changes: 16 additions & 1 deletion proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.