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

Perl_newSV_type_mortal - new inline function introduced and used

Browse Source 
There's no efficient way to create a mortal SV of any type other than
SVt_NULL (via sv_newmortal). The options are either to do:

* SV* sv = sv_newmortal; sv_upgrade(sv, SVt_SOMETYPE);
  but sv_upgrade is needlessly inefficient on new SVs.

* SV* sv = sv_2mortal(newSV_type(SVt_SOMETYPE)
  but this will perform runtime checks to see if (sv) and if (SvIMMORTAL(sv),
  and for a new SV we know that those answers will always be yes and no.

This commit adds a new inline function which is basically a mortalizing
wrapper around the now-inlined newSV_type.
This commit is contained in:
Richard Leach 2022-02-15 01:35:32 +00:00 committed by xenu
parent 8fcb24256a
commit 7ea8b04b5a
16 changed files with 110 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
av.c
View File

@ -267,8 +267,7 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
return NULL;
}
sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
sv = newSV_type_mortal(SVt_PVLV);
mg_copy(MUTABLE_SV(av), sv, 0, key);
if (!tied_magic) /* for regdata, force leavesub to make copies */
SvTEMP_off(sv);

2
doop.c
View File

@ -1176,7 +1176,7 @@ Perl_do_kv(pTHX)
if (gimme == G_SCALAR) {
if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */
SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
SV * const ret = newSV_type_mortal(SVt_PVLV); /* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0);
LvTYPE(ret) = 'k';
LvTARG(ret) = SvREFCNT_inc_simple(keys);

1
embed.fnc
View File

@ -1520,6 +1520,7 @@ ApMbdR |SV* |newSVsv |NULLOK SV *const old
AmdR |SV* |newSVsv_nomg |NULLOK SV *const old
AdpR |SV* |newSVsv_flags |NULLOK SV *const old|I32 flags
ApdiR |SV* |newSV_type |const svtype type
ApdIR |SV* |newSV_type_mortal|const svtype type
ApdR |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first
ApdR |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \
|NULLOK UNOP_AUX_item *aux

1
embed.h
View File

@ -386,6 +386,7 @@
#define newSVOP(a,b,c) Perl_newSVOP(aTHX_ a,b,c)
#define newSVREF(a) Perl_newSVREF(aTHX_ a)
#define newSV_type(a) Perl_newSV_type(aTHX_ a)
#define newSV_type_mortal(a) Perl_newSV_type_mortal(aTHX_ a)
#define newSVhek(a) Perl_newSVhek(aTHX_ a)
#define newSViv(a) Perl_newSViv(aTHX_ a)
#define newSVnv(a) Perl_newSVnv(aTHX_ a)

2
gv.c
View File

@ -3854,7 +3854,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
break;
case G_LIST:
if (flags & AMGf_want_list) {
res = sv_2mortal((SV *)newAV());
res = newSV_type_mortal(SVt_PVAV);
av_extend((AV *)res, nret);
while (nret--)
av_store((AV *)res, nret, POPs);

24
hv.c
View File

@ -200,12 +200,12 @@ static void
S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
const char *msg)
{
SV * const sv = sv_newmortal();
/* Straight to SVt_PVN here, as needed by sv_setpvn_fresh and
* sv_usepvn would otherwise call it */
SV * const sv = newSV_type_mortal(SVt_PV);
PERL_ARGS_ASSERT_HV_NOTALLOWED;
sv_upgrade(sv, SVt_PV); /* Needed by sv_setpvn_fresh and
* sv_usepvn would otherwise call it */
if (!(flags & HVhek_FREEKEY)) {
sv_setpvn_fresh(sv, key, klen);
}
@ -968,6 +968,7 @@ SV *
Perl_hv_scalar(pTHX_ HV *hv)
{
SV *sv;
UV u;
PERL_ARGS_ASSERT_HV_SCALAR;
@ -977,8 +978,21 @@ Perl_hv_scalar(pTHX_ HV *hv)
return magic_scalarpack(hv, mg);
}
sv = sv_newmortal();
sv_setuv(sv, HvUSEDKEYS(hv));
sv = newSV_type_mortal(SVt_IV);
/* Inlined sv_setuv(sv, HvUSEDKEYS(hv)) follows:*/
u = HvUSEDKEYS(hv);
if (u <= (UV)IV_MAX) {
SvIV_set(sv, (IV)u);
(void)SvIOK_only(sv);
SvTAINT(sv);
} else {
SvIV_set(sv, 0);
SvUV_set(sv, u);
(void)SvIOK_only_UV(sv);
SvTAINT(sv);
}
return sv;
}

2
mg.c
View File

@ -877,7 +877,7 @@ Perl_sv_string_from_errnum(pTHX_ int errnum, SV *tgtsv)
{
char const *errstr;
if(!tgtsv)
tgtsv = sv_newmortal();
tgtsv = newSV_type_mortal(SVt_PV);
errstr = my_strerror(errnum);
if(errstr) {
sv_setpv(tgtsv, errstr);

22
mro_core.c
View File

@ -255,7 +255,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
retval = MUTABLE_AV(newSV_type_mortal(SVt_PVAV));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
@ -347,7 +347,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
} else {
/* They have no stash. So create ourselves an ->isa cache
as if we'd copied it from what theirs should be. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
stored = MUTABLE_HV(newSV_type_mortal(SVt_PVHV));
(void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
av_push(retval,
newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
@ -357,7 +357,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
}
} else {
/* We have no parents. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
stored = MUTABLE_HV(newSV_type_mortal(SVt_PVHV));
(void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
}
@ -428,7 +428,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash)
SV **svp;
SV **ovp = AvARRAY(old);
SV * const * const oend = ovp + AvFILLp(old) + 1;
isa = (AV *)sv_2mortal((SV *)newAV());
isa = (AV *)newSV_type_mortal(SVt_PVAV);
av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1);
*AvARRAY(isa) = namesv;
svp = AvARRAY(isa)+1;
@ -570,7 +570,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
if(hv_iterinit(isarev)) {
/* Only create the hash if we need it; i.e., if isarev has
any elements. */
isa_hashes = (HV *)sv_2mortal((SV *)newHV());
isa_hashes = (HV *)newSV_type_mortal(SVt_PVHV);
}
while((iter = hv_iternext(isarev))) {
HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0);
@ -817,7 +817,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
}
else {
SV *aname;
namesv = sv_2mortal((SV *)newAV());
namesv = newSV_type_mortal(SVt_PVAV);
while (name_count--) {
if(memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")){
aname = GvNAMELEN(gv) == 1
@ -854,9 +854,9 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
wrong name. The names must be set on *all* affected stashes before
we do anything else. (And linearisations must be cleared, too.)
*/
stashes = (HV *) sv_2mortal((SV *)newHV());
stashes = (HV *) newSV_type_mortal(SVt_PVHV);
mro_gather_and_rename(
stashes, (HV *) sv_2mortal((SV *)newHV()),
stashes, (HV *) newSV_type_mortal(SVt_PVHV),
stash, oldstash, namesv
);
@ -1119,7 +1119,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
/* Skip the entire loop if the hash is empty. */
if(oldstash && HvTOTALKEYS(oldstash)) {
xhv = (XPVHV*)SvANY(oldstash);
seen = (HV *) sv_2mortal((SV *)newHV());
seen = (HV *) newSV_type_mortal(SVt_PVHV);
/* Iterate through entries in the oldstash, adding them to the
list, meanwhile doing the equivalent of $seen{$key} = 1.
@ -1164,7 +1164,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
SV *aname;
items = AvFILLp((AV *)namesv) + 1;
svp = AvARRAY((AV *)namesv);
subname = sv_2mortal((SV *)newAV());
subname = newSV_type_mortal(SVt_PVAV);
while (items--) {
aname = newSVsv(*svp++);
if (len == 1)
@ -1247,7 +1247,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
SV *aname;
items = AvFILLp((AV *)namesv) + 1;
svp = AvARRAY((AV *)namesv);
subname = sv_2mortal((SV *)newAV());
subname = newSV_type_mortal(SVt_PVAV);
while (items--) {
aname = newSVsv(*svp++);
if (len == 1)

10
pad.c
View File

@ -1252,13 +1252,13 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
}
if (!*out_capture) {
if (namelen != 0 && *namepv == '@')
*out_capture = sv_2mortal(MUTABLE_SV(newAV()));
*out_capture = newSV_type_mortal(SVt_PVAV);
else if (namelen != 0 && *namepv == '%')
*out_capture = sv_2mortal(MUTABLE_SV(newHV()));
*out_capture = newSV_type_mortal(SVt_PVHV);
else if (namelen != 0 && *namepv == '&')
*out_capture = sv_2mortal(newSV_type(SVt_PVCV));
*out_capture = newSV_type_mortal(SVt_PVCV);
else
*out_capture = sv_newmortal();
*out_capture = newSV_type_mortal(SVt_NULL);
}
}
@ -2068,7 +2068,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned,
*/
bool cloned_in_this_pass;
if (!cloned)
cloned = (HV *)sv_2mortal((SV *)newHV());
cloned = (HV *)newSV_type_mortal(SVt_PVHV);
do {
cloned_in_this_pass = FALSE;
for (ix = fpad; ix > 0; ix--) {

12
pp.c
View File

@ -313,7 +313,7 @@ PP(pp_pos)
dSP; dTOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));/* Not TARG RT#67838 */
SV * const ret = newSV_type_mortal(SVt_PVLV);/* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0);
LvTYPE(ret) = '.';
LvTARG(ret) = SvREFCNT_inc_simple(sv);
@ -467,7 +467,7 @@ S_refto(pTHX_ SV *sv)
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
}
rv = sv_newmortal();
rv = newSV_type_mortal(SVt_IV);
sv_setrv_noinc(rv, sv);
return rv;
}
@ -3300,7 +3300,7 @@ PP(pp_substr)
}
if (lvalue && !repl_sv) {
SV * ret;
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
ret = newSV_type_mortal(SVt_PVLV); /* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
LvTYPE(ret) = 'x';
LvTARG(ret) = SvREFCNT_inc_simple(sv);
@ -3432,7 +3432,7 @@ PP(pp_vec)
retuv = errflags ? 0 : do_vecget(src, offset, size);
if (lvalue) { /* it's an lvalue! */
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
ret = newSV_type_mortal(SVt_PVLV); /* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0);
LvTYPE(ret) = 'v';
LvTARG(ret) = SvREFCNT_inc_simple(src);
@ -6830,7 +6830,7 @@ PP(pp_refassign)
PP(pp_lvref)
{
dSP;
SV * const ret = sv_2mortal(newSV_type(SVt_PVMG));
SV * const ret = newSV_type_mortal(SVt_PVMG);
SV * const elem = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
SV * const arg = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
MAGIC * const mg = sv_magicext(ret, arg, PERL_MAGIC_lvref,
@ -6898,7 +6898,7 @@ PP(pp_lvrefslice)
else
S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
}
*MARK = sv_2mortal(newSV_type(SVt_PVMG));
*MARK = newSV_type_mortal(SVt_PVMG);
sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(char *)elemsv,HEf_SVKEY);
}
RETURN;

8
pp_ctl.c
View File

@ -5170,12 +5170,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
const Size_t other_len = av_count(other_av);
if (NULL == seen_this) {
seen_this = newHV();
(void) sv_2mortal(MUTABLE_SV(seen_this));
seen_this = (HV*)newSV_type_mortal(SVt_PVHV);
}
if (NULL == seen_other) {
seen_other = newHV();
(void) sv_2mortal(MUTABLE_SV(seen_other));
seen_other = (HV*)newSV_type_mortal(SVt_PVHV);
}
for(i = 0; i < other_len; ++i) {
SV * const * const this_elem = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
@ -5883,7 +5881,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
don't want to pass it in a second time.
I'm going to use a mortal in case the upstream filter croaks. */
upstream = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv))
? sv_newmortal() : buf_sv;
? newSV_type_mortal(SVt_PV) : buf_sv;
SvUPGRADE(upstream, SVt_PV);
if (filter_has_file) {

10
pp_hot.c
View File

@ -991,7 +991,7 @@ PP(pp_multiconcat)
)
)
{
SV *tmp = sv_newmortal();
SV *tmp = newSV_type_mortal(SVt_PV);
sv_copypv(tmp, left);
SvSETMAGIC(tmp);
left = tmp;
@ -2868,7 +2868,7 @@ PP(pp_qr)
REGEXP * rx = PM_GETRE(pm);
regexp *prog = ReANY(rx);
SV * const pkg = RXp_ENGINE(prog)->qr_package(aTHX_ (rx));
SV * const rv = sv_newmortal();
SV * const rv = newSV_type_mortal(SVt_IV);
CV **cvp;
CV *cv;
@ -3406,8 +3406,7 @@ PP(pp_helem)
if (!defer) {
DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
}
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
lv = newSV_type_mortal(SVt_PVLV);
LvTYPE(lv) = 'y';
sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0);
SvREFCNT_dec_NN(key2); /* sv_magic() increments refcount */
@ -3846,8 +3845,7 @@ PP(pp_multideref)
SV* key2;
if (!defer)
DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
lv = newSV_type_mortal(SVt_PVLV);
LvTYPE(lv) = 'y';
sv_magic(lv, key2 = newSVsv(keysv),
PERL_MAGIC_defelem, NULL, 0);

7
proto.h
View File

@ -2488,6 +2488,13 @@ PERL_STATIC_INLINE SV* Perl_newSV_type(pTHX_ const svtype type)
#define PERL_ARGS_ASSERT_NEWSV_TYPE
#endif
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_FORCE_INLINE SV* Perl_newSV_type_mortal(pTHX_ const svtype type)
__attribute__warn_unused_result__
__attribute__always_inline__;
#define PERL_ARGS_ASSERT_NEWSV_TYPE_MORTAL
#endif
PERL_CALLCONV SV* Perl_newSVavdefelem(pTHX_ AV *av, SSize_t ix, bool extendible)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_NEWSVAVDEFELEM \

4
regcomp.c
View File

@ -16869,8 +16869,8 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist,
* so that everything gets evaluated down to a single operand, which is the
* result */
sv_2mortal((SV *)(stack = newAV()));
sv_2mortal((SV *)(fence_stack = newAV()));
stack = (AV*)newSV_type_mortal(SVt_PVAV);
fence_stack = (AV*)newSV_type_mortal(SVt_PVAV);
while (RExC_parse < RExC_end) {
I32 top_index; /* Index of top-most element in 'stack' */

53
sv_inline.h
View File

@ -1,18 +1,26 @@
/* sv.h
/* sv_inline.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
* Copyright (C) 2022 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* This file contains the newSV_type and newSV_type_mortal functions, as well as
* the various struct and macro definitions they require. In the main, these
* definitions were moved from sv.c, where many of them continue to also be used.
* (In Perl_more_bodies, Perl_sv_upgrade and Perl_sv_clear, for example.) Code
* comments associated with definitions and functions were also copied across
* verbatim.
*
* The rationale for having these as inline functions, rather than in sv.c, is
* that the target type is very often known at compile time, and therefore
* optimum code can be emitted by the compiler, rather than having all calls
* traverse the many branches of Perl_sv_upgrade at runtime.
*/
/* 2022 */
/* BLAH BLAH BLAH */
/* This came from perl.h*/
/* This definition came from perl.h*/
/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
at least on FreeBSD. YMMV, so experiment. */
@ -56,7 +64,7 @@
} STMT_END
/* Perl_more_sv lives in sv.c, we don't want to inline it.
* but the function declaration seems to be needed? */
* but the function declaration seems to be needed. */
SV* Perl_more_sv(pTHX);
/* new_SV(): return a new, empty SV head */
@ -490,6 +498,35 @@ Perl_newSV_type(pTHX_ const svtype type)
return sv;
}
/*
=for apidoc newSV_type_mortal
Creates a new mortal SV, of the type specified. The reference count for the
new SV is set to 1.
This is equivalent to
SV* sv = sv_2mortal(newSV_type(<some type>))
and
SV* sv = sv_newmortal();
sv_upgrade(sv, <some_type>)
but should be more efficient than both of them. (Unless sv_2mortal is inlined
at some point in the future.)
=cut
*/
PERL_STATIC_INLINE SV *
Perl_newSV_type_mortal(pTHX_ const svtype type)
{
SV *sv = newSV_type(type);
SSize_t ix = ++PL_tmps_ix;
if (UNLIKELY(ix >= PL_tmps_max))
ix = Perl_tmps_grow_p(aTHX_ ix);
PL_tmps_stack[ix] = (sv);
SvTEMP_on(sv);
return sv;
}
/*
* ex: set ts=8 sts=4 sw=4 et:
*/

5
universal.c
View File

@ -304,12 +304,11 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
/* create a PV with value "isa", but with a special address
* so that perl knows we're really doing "DOES" instead */
methodname = newSV_type(SVt_PV);
methodname = newSV_type_mortal(SVt_PV);
SvLEN_set(methodname, 0);
SvCUR_set(methodname, strlen(PL_isa_DOES));
SvPVX(methodname) = (char *)PL_isa_DOES; /* discard 'const' qualifier */
SvPOK_on(methodname);
sv_2mortal(methodname);
call_sv(methodname, G_SCALAR | G_METHOD);
SPAGAIN;
@ -1126,7 +1125,7 @@ XS(XS_NamedCapture_TIEHASH)
flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
mark += 2;
}
ST(0) = sv_2mortal(newSV_type(SVt_IV));
ST(0) = newSV_type_mortal(SVt_IV);
sv_setuv(newSVrv(ST(0), package), flag);
}
XSRETURN(1);