mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Perl_sv_can_can_swipe_pv_buf - extracts swipe test from Perl_sv_setsv_flags

Browse Source 
Perl_sv_setsv_flags contains the canonical logic for determining the best
method for assigning the string value from a source SV to a destination SV:
  * "Swipe" the string buffer from the source SV
  * COW the source SV's string buffer
  * Do a full copy

This commit extracts the "can the swipe the buffer" tests out into a new
macro (`S_SvPV_can_swipe_buf`) within sv.c. It has two users:
  * Perl_sv_setsv_flags - so that the logic remains inline in this hot code
  * Perl_sv_can_can_swipe_pv_buf - a new function

`pp_reverse` will shortly make use of the new function to avoid unnecessary
string copies when doing a reversal in scalar context.
This commit is contained in:
Richard Leach 2025-03-09 14:34:13 +00:00
parent 9c5f1c44fd
commit d002fa41bf
4 changed files with 36 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
embed.fnc
View File

@ -3114,6 +3114,8 @@ Adp |SV * |sv_bless |NN SV * const sv \
Cdmp |bool |sv_2bool |NN SV * const sv
Cdp |bool |sv_2bool_flags |NN SV *sv \
|I32 flags
Cp |bool |sv_can_swipe_pv_buf \
|NN SV *sv
Adp |bool |sv_cat_decode |NN SV *dsv \
|NN SV *encoding \
|NN SV *ssv \

1
embed.h
View File

@ -707,6 +707,7 @@
# define sv_2uv_flags(a,b) Perl_sv_2uv_flags(aTHX_ a,b)
# define sv_backoff Perl_sv_backoff
# define sv_bless(a,b) Perl_sv_bless(aTHX_ a,b)
# define sv_can_swipe_pv_buf(a) Perl_sv_can_swipe_pv_buf(aTHX_ a)
# define sv_cat_decode(a,b,c,d,e,f) Perl_sv_cat_decode(aTHX_ a,b,c,d,e,f)
# define sv_catpv(a,b) Perl_sv_catpv(aTHX_ a,b)
# define sv_catpv_flags(a,b,c) Perl_sv_catpv_flags(aTHX_ a,b,c)

5
proto.h generated
View File

@ -4534,6 +4534,11 @@ Perl_sv_bless(pTHX_ SV * const sv, HV * const stash);
#define PERL_ARGS_ASSERT_SV_BLESS \
assert(sv); assert(stash)
PERL_CALLCONV bool
Perl_sv_can_swipe_pv_buf(pTHX_ SV *sv);
#define PERL_ARGS_ASSERT_SV_CAN_SWIPE_PV_BUF \
assert(sv)
PERL_CALLCONV bool
Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, SV *ssv, int *offset, char *tstr, int tlen);
#define PERL_ARGS_ASSERT_SV_CAT_DECODE \

45
sv.c
View File

@ -4187,6 +4187,33 @@ S_sv_buf_to_rw(pTHX_ SV *sv)
# define sv_buf_to_rw(sv) NOOP
#endif
/* The test in this macro was extracted from Perl_sv_setsv_flags so that it
* could be used elsewhere. */
#define S_SvPV_can_swipe_buf(ssv, sflags, cur, len) \
(( /* Either ... */ \
/* slated for free anyway (and not COW)? */ \
((sflags & (SVs_TEMP|SVf_IsCOW)) == SVs_TEMP) \
/* or a swipable TARG */ \
|| ((sflags & \
(SVs_PADTMP|SVf_READONLY|SVf_PROTECT|SVf_IsCOW))== SVs_PADTMP \
/* whose buffer is worth stealing */ \
&& CHECK_COWBUF_THRESHOLD(cur,len) \
) \
) && !(sflags & SVf_OOK) /* and not involved in OOK hack? */ \
&& (SvREFCNT(ssv) == 1) /* and no other references to it? */ \
&& len /* and really is a string */ \
)
/* Perl_sv_can_swipe_pv_buf was originally created for pp_reverse. */
bool
Perl_sv_can_swipe_pv_buf(pTHX_ SV *sv)
{
PERL_ARGS_ASSERT_SV_CAN_SWIPE_PV_BUF;
assert(sv);
return S_SvPV_can_swipe_buf(sv, SvFLAGS(sv), SvCUR(sv), SvLEN(sv)) ? true : false;
}
void
Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
{
@ -4593,23 +4620,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
and doing it now facilitates the COW check. */
(void)SvPOK_only(dsv);
if (
( /* Either ... */
/* slated for free anyway (and not COW)? */
(sflags & (SVs_TEMP|SVf_IsCOW)) == SVs_TEMP
/* or a swipable TARG */
|| ((sflags &
(SVs_PADTMP|SVf_READONLY|SVf_PROTECT|SVf_IsCOW))
== SVs_PADTMP
/* whose buffer is worth stealing */
&& CHECK_COWBUF_THRESHOLD(cur,len)
)
) &&
!(sflags & SVf_OOK) && /* and not involved in OOK hack? */
(!(flags & SV_NOSTEAL)) &&
/* and we're allowed to steal temps */
SvREFCNT(ssv) == 1 && /* and no other references to it? */
len) /* and really is a string */
if ( !(flags & SV_NOSTEAL) && S_SvPV_can_swipe_buf(ssv, sflags, cur, len) )
{ /* Passes the swipe test. */
if (SvPVX_const(dsv)) /* we know that dtype >= SVt_PV */
SvPV_free(dsv);