Skip to content

add compact vararg impl gv_stashsvpvn_cached_p, add gv_stashhek #23041

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

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

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
Original file line number Diff line number Diff line change
@@ -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 \
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For consistency with the other gv_ functions, could the flags argument always be the final argument?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, it's to support the vararg in Perl_gv_stashsvpvn_cached_p?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Right, the machine code level C prototype is non-publically/private internals. arg flags goes on the front to communicate the va_arg details of what comes next. The va_arg is never, ever, supposed to be filled out by hand with fingers. The macros are the only way to call it, and they give protect against all the usual pitfalls..

Flags being first prevents 2-5 "push NULL" CPU ops in all callers/all call sites. Remember about my_perl var that always exists in machine code, >4 args on Win64, and the __regcall ABI expires and now you are using real C stack. On Linux its >6, and the __regcall ABI expires, and then your using C stack. C stack ops atleast for Intel CISC always will take more space vs reg to reg moves, b/c they have to write out a 1 byte U8 or 4 byte U32 offset into the C stack. Arg flags is always const folded to 1/2/4 byte CPU integer literal anyway and 1 cpu code. Multiple NULLs will be multiple cpu ops.

There is a very tiny provision I'm making here, which VA, probably helps with. gv_*fetch*() funcs need/should always return an var length array of HEK *s to the caller, after being given an ascii string. There are many ways to brain storm it; 5 void**s being pushed on C stack, and used as 2-way transport, turn in a const C str, get back 1 HEK * (end user must RC++ it if they want it or are capable of caching it). 5 const char *s interleved with 5 &c_autos/void **s. Also perhaps a NULL pointer terminated var len HEK * list gets passed to gv_*fetch*(). I dont see myself doing anything this fancy any time soon. But the provision is there for futuristic not yet invented string objects/package token objects. RCPV and ref counted HEs are a recent example.

|NN const char *name
Adp |HV * |gv_stashsv |NN SV *sv \
|I32 flags
Xdpx |void |gv_try_downgrade \
@@ -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 \
3 changes: 3 additions & 0 deletions embed.h
View file
Original file line number Diff line number Diff line change
@@ -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)
@@ -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)
@@ -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
111 changes: 100 additions & 11 deletions gv.c
View file
Original file line number Diff line number Diff line change
@@ -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));
}

/*
@@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What optimization is that?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

perl5/hv.c

Line 849 in 49e1c32

for (; entry; entry = HeNEXT(entry)) {

hv_fetchhek() in this fn, would add needless indirection through
wrapper hv_common_key_len() instead of centralized single call sites
to hv_common(). */
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

How's that? It looks like it just calls hv_common to me.

# define hv_fetchhek(hv, hek, lval) \
    ((SV **)                                                            \
     hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek),   \
               (lval)                                                   \
                ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)                  \
                : HV_FETCH_JUST_SV,                                     \
               NULL, HEK_HASH(hek)))

Copy link
Contributor Author

@bulk88 bulk88 Apr 20, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

See link ^^^ hv_fetchhek() is writing checks that dont cash. Patches welcome.

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) {
@@ -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;
22 changes: 22 additions & 0 deletions gv.h
View file
Original file line number Diff line number Diff line change
@@ -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 */

@@ -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)
8 changes: 6 additions & 2 deletions handy.h
View file
Original file line number Diff line number Diff line change
@@ -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))


/*
17 changes: 16 additions & 1 deletion proto.h
View file

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