Skip to content

Commit

Permalink
Eval param to SvPV-foo exactly once
Browse files Browse the repository at this point in the history 
This changes all the API macros that retrieve a PV into a call to an
inline function so as to evaluate the parameter just once.
  • Loading branch information
@khwilliamson
khwilliamson committed Jun 29, 2022
1 parent 59ead93 commit 1ef9039
Show file tree
Hide file tree
Showing 5 changed files with 209 additions and 119 deletions.
2 changes: 2 additions & 0 deletions embed.fnc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1909,7 +1909,9 @@ Apd |STRLEN |sv_pos_b2u_flags|NN SV *const sv|STRLEN const offset \
|U32 flags
CpMdb |char* |sv_pvn_force |NN SV* sv|NULLOK STRLEN* lp
Cpd |char* |sv_pvutf8n_force|NN SV *const sv|NULLOK STRLEN *const lp
Ip |char* |sv_pvutf8n_force_wrapper|NN SV *const sv|NULLOK STRLEN *const lp|const U32 dummy
Cpd |char* |sv_pvbyten_force|NN SV *const sv|NULLOK STRLEN *const lp
Ip |char* |sv_pvbyten_force_wrapper|NN SV *const sv|NULLOK STRLEN *const lp|const U32 dummy
Apd |char* |sv_recode_to_utf8 |NN SV* sv|NN SV *encoding
Apd |bool |sv_cat_decode |NN SV* dsv|NN SV *encoding|NN SV *ssv|NN int *offset \
|NN char* tstr|int tlen
Expand Down
2 changes: 2 additions & 0 deletions embed.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1439,6 +1439,8 @@
#define sv_clean_objs() Perl_sv_clean_objs(aTHX)
#define sv_del_backref(a,b) Perl_sv_del_backref(aTHX_ a,b)
#define sv_free_arenas() Perl_sv_free_arenas(aTHX)
#define sv_pvbyten_force_wrapper(a,b,c) Perl_sv_pvbyten_force_wrapper(aTHX_ a,b,c)
#define sv_pvutf8n_force_wrapper(a,b,c) Perl_sv_pvutf8n_force_wrapper(aTHX_ a,b,c)
#define sv_resetpvn(a,b,c) Perl_sv_resetpvn(aTHX_ a,b,c)
#define sv_sethek(a,b) Perl_sv_sethek(aTHX_ a,b)
#ifndef MULTIPLICITY
Expand Down
14 changes: 14 additions & 0 deletions proto.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4042,6 +4042,13 @@ PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv)
PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV *const sv, STRLEN *const lp);
#define PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE \
assert(sv)
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_FORCE_INLINE char* Perl_sv_pvbyten_force_wrapper(pTHX_ SV *const sv, STRLEN *const lp, const U32 dummy)
__attribute__always_inline__;
#define PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE_WRAPPER \
assert(sv)
#endif

#ifndef NO_MATHOMS
PERL_CALLCONV char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp);
#define PERL_ARGS_ASSERT_SV_PVN_FORCE \
Expand All @@ -4060,6 +4067,13 @@ PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv)
PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV *const sv, STRLEN *const lp);
#define PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE \
assert(sv)
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_FORCE_INLINE char* Perl_sv_pvutf8n_force_wrapper(pTHX_ SV *const sv, STRLEN *const lp, const U32 dummy)
__attribute__always_inline__;
#define PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE_WRAPPER \
assert(sv)
#endif

PERL_CALLCONV char* Perl_sv_recode_to_utf8(pTHX_ SV* sv, SV *encoding);
#define PERL_ARGS_ASSERT_SV_RECODE_TO_UTF8 \
assert(sv); assert(encoding)
Expand Down
231 changes: 112 additions & 119 deletions sv.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1768,7 +1768,7 @@ only once; use the more efficient C<SvPVbyte_force> otherwise.
=for apidoc_item | char*|SvPVx_nolen |SV* sv
=for apidoc_item |const char*|SvPVx_nolen_const |SV* sv
All these return a pointer to the string in C<sv>, or a stringified form of
These each return a pointer to the string in C<sv>, or a stringified form of
C<sv> if it does not contain a string. The SV may cache the stringified
version becoming C<SvPOK>.
Expand Down Expand Up @@ -1814,10 +1814,8 @@ the string (unless you cast away const yourself).
The other forms return a mutable pointer so that the string is modifiable by
the caller; this is emphasized for the ones with C<mutable> in their names.
The forms whose name ends in C<x> are the same as the corresponding form
without the C<x>, but the C<x> form is guaranteed to evaluate C<sv> exactly
once, with a slight loss of efficiency. Use this if C<sv> is an expression
with side effects.
As of 5.38, all forms are guaranteed to evaluate C<sv> exactly once. For
earlier Perls, use a form whose name ends with C<x> for single evaluation.
C<SvPVutf8> is like C<SvPV>, but converts C<sv> to UTF-8 first if not already
UTF-8. Similiarly, the other forms with C<utf8> in their names correspond to
Expand Down Expand Up @@ -1872,9 +1870,26 @@ scalar.
=cut
*/

#define SvPV(sv, len) SvPV_flags(sv, len, SV_GMAGIC)
#define SvPV_const(sv, len) SvPV_flags_const(sv, len, SV_GMAGIC)
#define SvPV_mutable(sv, len) SvPV_flags_mutable(sv, len, SV_GMAGIC)
/* To pass the action to the functions called by the following macros */
typedef enum {
SvPVutf8_type_,
SvPVbyte_type_,
SvPVnormal_type_,
SvPVforce_type_,
SvPVutf8_pure_type_,
SvPVbyte_pure_type_
} PL_SvPVtype;

START_EXTERN_C

/* When this code was written, embed.fnc could not handle function pointer
* parameters; perhaps it still can't */
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE char*
Perl_SvPV_helper(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags, const PL_SvPVtype type, char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32), const bool or_null, const U32 return_flags);
#endif

END_EXTERN_C

/* This test is "is there a cached PV that we can use directly?"
* We can if
Expand All @@ -1887,120 +1902,98 @@ scalar.
#define SvPOK_or_cached_IV(sv) \
(((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) || ((SvFLAGS(sv) & (SVf_IOK|SVp_POK|SVs_GMG)) == (SVf_IOK|SVp_POK)))

#define SvPV_flags(sv, len, flags) \
(SvPOK_or_cached_IV(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &len, flags))
#define SvPV_flags_const(sv, len, flags) \
(SvPOK_or_cached_IV(sv) \
? ((len = SvCUR(sv)), SvPVX_const(sv)) : \
(const char*) sv_2pv_flags(sv, &len, (flags|SV_CONST_RETURN)))
#define SvPV_flags_const_nolen(sv, flags) \
(SvPOK_or_cached_IV(sv) \
? SvPVX_const(sv) : \
(const char*) sv_2pv_flags(sv, 0, (flags|SV_CONST_RETURN)))
#define SvPV_flags_mutable(sv, len, flags) \
(SvPOK_or_cached_IV(sv) \
? ((len = SvCUR(sv)), SvPVX_mutable(sv)) : \
sv_2pv_flags(sv, &len, (flags|SV_MUTABLE_RETURN)))

#define SvPV_force(sv, len) SvPV_force_flags(sv, len, SV_GMAGIC)
#define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#define SvPV_flags(sv, len, flags) \
Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \
Perl_sv_2pv_flags, FALSE, 0)
#define SvPV_flags_const(sv, len, flags) \
((const char*) Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \
Perl_sv_2pv_flags, FALSE, \
SV_CONST_RETURN))
#define SvPV_flags_const_nolen(sv, flags) \
((const char*) Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVnormal_type_, \
Perl_sv_2pv_flags, FALSE, \
SV_CONST_RETURN))
#define SvPV_flags_mutable(sv, len, flags) \
Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \
Perl_sv_2pv_flags, FALSE, SV_MUTABLE_RETURN)

#define SvPV_nolen(sv) \
Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVnormal_type_, \
Perl_sv_2pv_flags, FALSE, 0)

#define SvPV_nolen_const(sv) SvPV_flags_const_nolen(sv, SV_GMAGIC)

#define SvPV(sv, len) SvPV_flags(sv, len, SV_GMAGIC)
#define SvPV_const(sv, len) SvPV_flags_const(sv, len, SV_GMAGIC)
#define SvPV_mutable(sv, len) SvPV_flags_mutable(sv, len, SV_GMAGIC)

#define SvPV_nomg_nolen(sv) \
Perl_SvPV_helper(aTHX_ sv, NULL, 0, SvPVnormal_type_,Perl_sv_2pv_flags, \
FALSE, 0)
#define SvPV_nomg(sv, len) SvPV_flags(sv, len, 0)
#define SvPV_nomg_const(sv, len) SvPV_flags_const(sv, len, 0)
#define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)

#define SvPV_force_flags(sv, len, flags) \
Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \
Perl_sv_pvn_force_flags, FALSE, 0)
#define SvPV_force_flags_nolen(sv, flags) \
Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVforce_type_, \
Perl_sv_pvn_force_flags, FALSE, 0)
#define SvPV_force_flags_mutable(sv, len, flags) \
Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \
Perl_sv_pvn_force_flags, FALSE, SV_MUTABLE_RETURN)

#define SvPV_force(sv, len) SvPV_force_flags(sv, len, SV_GMAGIC)
#define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#define SvPV_force_mutable(sv, len) SvPV_force_flags_mutable(sv, len, SV_GMAGIC)

#define SvPV_force_nomg(sv, len) SvPV_force_flags(sv, len, 0)
#define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)

#define SvPV_force_flags(sv, len, flags) \
(SvPOK_pure_nogthink(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &len, flags))

#define SvPV_force_flags_nolen(sv, flags) \
(SvPOK_pure_nogthink(sv) \
? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))

#define SvPV_force_flags_mutable(sv, len, flags) \
(SvPOK_pure_nogthink(sv) \
? ((len = SvCUR(sv)), SvPVX_mutable(sv)) \
: sv_pvn_force_flags(sv, &len, flags|SV_MUTABLE_RETURN))

#define SvPV_nolen(sv) \
(SvPOK_or_cached_IV(sv) \
? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))

/* "_nomg" in these defines means no mg_get() */
#define SvPV_nomg_nolen(sv) \
(SvPOK_or_cached_IV(sv) \
? SvPVX(sv) : sv_2pv_flags(sv, 0, 0))

#define SvPV_nolen_const(sv) \
(SvPOK_or_cached_IV(sv) \
? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))

#define SvPV_nomg(sv, len) SvPV_flags(sv, len, 0)
#define SvPV_nomg_const(sv, len) SvPV_flags_const(sv, len, 0)
#define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)

/* ----*/

#define SvPVutf8(sv, len) \
(SvPOK_utf8_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &len))

#define SvPVutf8_or_null(sv, len) \
(SvPOK_utf8_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
? sv_2pvutf8_flags(sv, &len, 0) : ((len = 0), NULL))

#define SvPVutf8_nomg(sv, len) \
(SvPOK_utf8_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8_flags(sv, &len, 0))

#define SvPVutf8_or_null_nomg(sv, len) \
(SvPOK_utf8_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
? sv_2pvutf8_flags(sv, &len, 0) : ((len = 0), NULL))

#define SvPVutf8_force(sv, len) \
(SvPOK_utf8_pure_nogthink(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &len))

#define SvPVutf8_nolen(sv) \
(SvPOK_utf8_nog(sv) \
? SvPVX(sv) : sv_2pvutf8(sv, 0))

/* ----*/

#define SvPVbyte(sv, len) \
(SvPOK_byte_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &len))

#define SvPVbyte_or_null(sv, len) \
(SvPOK_byte_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
? sv_2pvbyte_flags(sv, &len, 0) : ((len = 0), NULL))

#define SvPVbyte_nomg(sv, len) \
(SvPOK_byte_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte_flags(sv, &len, 0))

#define SvPVbyte_or_null_nomg(sv, len) \
(SvPOK_utf8_nog(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
? sv_2pvbyte_flags(sv, &len, 0) : ((len = 0), NULL))

#define SvPVbyte_force(sv, len) \
(SvPOK_byte_pure_nogthink(sv) \
? ((len = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &len))

#define SvPVbyte_nolen(sv) \
(SvPOK_byte_nog(sv) \
? SvPVX(sv) : sv_2pvbyte(sv, 0))


/* define FOOx(): idempotent versions of FOO(). If possible, use a local
* var to evaluate the arg once; failing that, use a global if possible;
* failing that, call a function to do the work
*/
#define SvPV_force_nomg(sv, len) SvPV_force_flags(sv, len, 0)
#define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)

#define SvPVutf8(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \
Perl_sv_2pvutf8_flags, FALSE, 0)
#define SvPVutf8_nomg(sv, len) \
Perl_SvPV_helper(aTHX_ sv, NULL, 0, SvPVutf8_type_, \
Perl_sv_2pvutf8_flags, FALSE, 0)
#define SvPVutf8_nolen(sv) \
Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVutf8_type_, \
Perl_sv_2pvutf8_flags, FALSE, 0)
#define SvPVutf8_or_null(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \
Perl_sv_2pvutf8_flags, TRUE, 0)
#define SvPVutf8_or_null_nomg(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_type_, \
Perl_sv_2pvutf8_flags, TRUE, 0)

#define SvPVbyte(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \
Perl_sv_2pvbyte_flags, FALSE, 0)
#define SvPVbyte_nomg(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \
Perl_sv_2pvbyte_flags, FALSE, 0)
#define SvPVbyte_nolen(sv) \
Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVbyte_type_, \
Perl_sv_2pvbyte_flags, FALSE, 0)
#define SvPVbyte_or_null(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \
Perl_sv_2pvbyte_flags, TRUE, 0)
#define SvPVbyte_or_null_nomg(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \
Perl_sv_2pvbyte_flags, TRUE, 0)

#define SvPVutf8_force(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_pure_type_, \
Perl_sv_pvutf8n_force_wrapper, FALSE, 0)

#define SvPVbyte_force(sv, len) \
Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_pure_type_, \
Perl_sv_pvbyten_force_wrapper, FALSE, 0)

/* define FOOx(): Before FOO(x) was inlined, these were idempotent versions of
* FOO(). */

#define SvPVx_force(sv, len) sv_pvn_force(sv, &len)
#define SvPVutf8x_force(sv, len) sv_pvutf8n_force(sv, &len)
Expand Down
79 changes: 79 additions & 0 deletions sv_inline.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -849,6 +849,85 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
}
#endif

PERL_STATIC_INLINE char *
Perl_SvPV_helper(pTHX_
SV * const sv,
STRLEN * const lp,
const U32 flags,
const PL_SvPVtype type,
char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32),
const bool or_null,
const U32 return_flags
)
{
/* 'type' should be known at compile time, so this is reduced to a single
* conditional at runtime */
if ( (type == SvPVbyte_type_ && SvPOK_byte_nog(sv))
|| (type == SvPVforce_type_ && SvPOK_pure_nogthink(sv))
|| (type == SvPVutf8_type_ && SvPOK_utf8_nog(sv))
|| (type == SvPVnormal_type_ && SvPOK_nog(sv))
|| (type == SvPVutf8_pure_type_ && SvPOK_utf8_pure_nogthink(sv))
|| (type == SvPVbyte_pure_type_ && SvPOK_byte_pure_nogthink(sv))
) {
if (lp) {
*lp = SvCUR(sv);
}

/* Similarly 'return_flags is known at compile time, so this becomes
* branchless */
if (return_flags & SV_MUTABLE_RETURN) {
return SvPVX_mutable(sv);
}
else if(return_flags & SV_CONST_RETURN) {
return (char *) SvPVX_const(sv);
}
else {
return SvPVX(sv);
}
}

if (or_null) { /* This is also known at compile time */
if (flags & SV_GMAGIC) { /* As is this */
SvGETMAGIC(sv);
}

if (! SvOK(sv)) {
if (lp) { /* As is this */
*lp = 0;
}

return NULL;
}
}

/* Can't trivially handle this, call the function */
return non_trivial(aTHX_ sv, lp, (flags|return_flags));
}

PERL_STATIC_INLINE char *
Perl_sv_pvutf8n_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy)
{
/* This is just so can be passed to Perl_SvPV_helper() as a function
* pointer with the same signature as all the other such pointers, and
* having hence an unused parameter */
PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE_WRAPPER;
PERL_UNUSED_ARG(dummy);

return sv_pvutf8n_force(sv, lp);
}

PERL_STATIC_INLINE char *
Perl_sv_pvbyten_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy)
{
/* This is just so can be passed to Perl_SvPV_helper() as a function
* pointer with the same signature as all the other such pointers, and
* having hence an unused parameter */
PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE_WRAPPER;
PERL_UNUSED_ARG(dummy);

return sv_pvbyten_force(sv, lp);
}

/*
* ex: set ts=8 sts=4 sw=4 et:
*/

0 comments on commit 1ef9039

Please sign in to comment.