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

Perl_sv_setsv_flags - IV/NV & cold code optimisation #22725

Merged
merged 4 commits into from
Dec 16, 2024
Merged

Perl_sv_setsv_flags - IV/NV & cold code optimisation #22725

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
f7fcdd8
Perl_sv_setsv_flags: handle mixed IV and NV fast case
richardleach Oct 23, 2024
003dfa6
Perl_sv_setsv_flags: remove unreachable NULL/IV/NV code
richardleach Oct 23, 2024
84cebbc
Perl_sv_setsv_flags: extract croaks to a cold helper function
richardleach Oct 28, 2024
c0d317f
perldelta entry for Perl_sv_setsv_flags changes
richardleach Nov 6, 2024
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
3 changes: 3 additions & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5811,6 +5811,9 @@ S |void |assert_uft8_cache_coherent \
|STRLEN from_cache \
|STRLEN real \
|NN SV * const sv
S |void |croak_sv_setsv_flags \
|NN SV * const dsv \
|NN SV * const ssv
S |bool |curse |NN SV * const sv \
|const bool check_refcnt
RS |STRLEN |expect_number |NN const char ** const pattern
Expand Down
1 change: 1 addition & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2157,6 +2157,7 @@
# define F0convert S_F0convert
# define anonymise_cv_maybe(a,b) S_anonymise_cv_maybe(aTHX_ a,b)
# define assert_uft8_cache_coherent(a,b,c,d) S_assert_uft8_cache_coherent(aTHX_ a,b,c,d)
# define croak_sv_setsv_flags(a,b) S_croak_sv_setsv_flags(aTHX_ a,b)
# define curse(a,b) S_curse(aTHX_ a,b)
# define expect_number(a) S_expect_number(aTHX_ a)
# define find_array_subscript(a,b) S_find_array_subscript(aTHX_ a,b)
Expand Down
13 changes: 13 additions & 0 deletions pod/perldelta.pod
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -503,6 +503,19 @@ L<C<valid_identifier_pvn()>|perlapi/valid_identifier_pvn> and
L<C<valid_identifier_sv()>|perlapi/valid_identifier_sv> have been added, which
test if a string would be considered by Perl to be a valid identifier name.

=item *

When assigning from an SVt_IV into a SVt_NV (or vice versa), providing that
both are "bodyless" types, Perl_sv_setsv_flags will now just change the
destination type to match the source type. Previously, an SVt_IV would have
been upgraded to a SVt_PVNV to store an NV, and an SVt_NV would have been
upgraded to a SVt_PVIV to store an IV. This change prevents the need to
allocate - and later free - the relevant body struct.

=item *

XXX

=back

=head1 Selected Bug Fixes
Expand Down
5 changes: 5 additions & 0 deletions proto.h
View file
Open in desktop

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

94 changes: 60 additions & 34 deletions sv.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4201,7 +4201,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
STATIC_ASSERT_STMT(SVt_IV == 1);
STATIC_ASSERT_STMT(SVt_NV == 2);
#if NVSIZE <= IVSIZE
if (both_type <= 2) {
if ((stype <= SVt_NV) & (dtype <= SVt_NV)) {
#else
if (both_type <= 1) {
#endif
Expand Down Expand Up @@ -4275,20 +4275,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
SvREFCNT_dec(old_rv);
return;
}

/*
#if NVSIZE <= IVSIZE
both_type = (stype | dtype);
richardleach marked this conversation as resolved.
Show resolved Hide resolved
#endif
*/
if (UNLIKELY(both_type == SVTYPEMASK)) {
if (SvIS_FREED(dsv)) {
Perl_croak(aTHX_ "panic: attempt to copy value %" SVf
" to a freed scalar %p", SVfARG(ssv), (void *)dsv);
}
if (SvIS_FREED(ssv)) {
Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p",
(void*)ssv, (void*)dsv);
}
croak_sv_setsv_flags(dsv, ssv);
NOT_REACHED;
}



SV_CHECK_THINKFIRST_COW_DROP(dsv);
dtype = SvTYPE(dsv); /* THINKFIRST may have changed type */

Expand All @@ -4306,17 +4303,15 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
break;
case SVt_IV:
if (SvIOK(ssv)) {
/* Bodiless-SV code above should have handled these cases */
assert(dtype != SVt_NULL);
#if NVSIZE <= IVSIZE
assert(dtype != SVt_NV);
#endif
switch (dtype) {
case SVt_NULL:
/* For performance, we inline promoting to type SVt_IV. */
/* We're starting from SVt_NULL, so provided that define is
* actual 0, we don't have to unset any SV type flags
* to promote to SVt_IV. */
STATIC_ASSERT_STMT(SVt_NULL == 0);
SET_SVANY_FOR_BODYLESS_IV(dsv);
SvFLAGS(dsv) |= SVt_IV;
break;
#if NVSIZE > IVSIZE
case SVt_NV:
#endif
case SVt_PV:
sv_upgrade(dsv, SVt_PVIV);
break;
Expand All @@ -4337,17 +4332,21 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
}
if (!SvROK(ssv))
goto undef_sstr;
#if NVSIZE > IVSIZE
if (dtype < SVt_PV && dtype != SVt_IV)
sv_upgrade(dsv, SVt_IV);
richardleach marked this conversation as resolved.
Show resolved Hide resolved
#endif
break;

case SVt_NV:
if (LIKELY( SvNOK(ssv) )) {
switch (dtype) {
#if NVSIZE > IVSIZE
case SVt_NULL:
case SVt_IV:
sv_upgrade(dsv, SVt_NV);
break;
#endif
case SVt_PV:
case SVt_PVIV:
sv_upgrade(dsv, SVt_PVNV);
Expand Down Expand Up @@ -4384,14 +4383,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
invlist_clone(ssv, dsv);
return;
default:
{
const char * const type = sv_reftype(ssv,0);
if (PL_op)
/* diag_listed_as: Bizarre copy of %s */
Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Bizarre copy of %s", type);
}
croak_sv_setsv_flags(dsv, ssv);
NOT_REACHED; /* NOTREACHED */

case SVt_REGEXP:
Expand Down Expand Up @@ -4445,12 +4437,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
else if (UNLIKELY(dtype == SVt_PVAV || dtype == SVt_PVHV
|| dtype == SVt_PVFM))
{
const char * const type = sv_reftype(dsv,0);
if (PL_op)
/* diag_listed_as: Cannot copy to %s */
Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Cannot copy to %s", type);
croak_sv_setsv_flags(dsv, ssv);
NOT_REACHED;
} else if (sflags & SVf_ROK) {
if (isGV_with_GP(dsv)
&& SvTYPE(SvRV(ssv)) == SVt_PVGV && isGV_with_GP(SvRV(ssv))) {
Expand Down Expand Up @@ -17730,6 +17718,44 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
GCC_DIAG_RESTORE_STMT;
}

/* This helper function for Perl_sv_setsv_flags is as cold as they come.
richardleach marked this conversation as resolved.
Show resolved Hide resolved
* We should almost never call it and it will definitely croak when we do.
* Therefore it should not matter that it is not close to the main function
* or that we make it redo work that the caller already did.
* The main aim is to keep Perl_sv_setsv_flags as slim as possible and this
* includes keeping the call sites for this function small.
*/
void S_croak_sv_setsv_flags(pTHX_ SV * const dsv, SV * const ssv)
{
OP *op = PL_op;
if (SvIS_FREED(dsv)) {
Perl_croak(aTHX_ "panic: attempt to copy value %" SVf
richardleach marked this conversation as resolved.
Show resolved Hide resolved
" to a freed scalar %p", SVfARG(ssv), (void *)dsv);
}
if (SvIS_FREED(ssv)) {
Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p",
(void*)ssv, (void*)dsv);
}

if (SvTYPE(ssv) > SVt_PVLV)
{
const char * const type = sv_reftype(ssv,0);
if (op)
/* diag_listed_as: Bizarre copy of %s */
Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_DESC(op));
else
Perl_croak(aTHX_ "Bizarre copy of %s", type);
}

const char * const type = sv_reftype(dsv,0);
if (op)
/* diag_listed_as: Cannot copy to %s */
Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_DESC(op));
else
Perl_croak(aTHX_ "Cannot copy to %s", type);

}

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