diff --git a/av.c b/av.c index 65c2246c62..335121a951 100644 --- a/av.c +++ b/av.c @@ -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); diff --git a/doop.c b/doop.c index 5a9c0d8f46..ede537723c 100644 --- a/doop.c +++ b/doop.c @@ -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); diff --git a/embed.fnc b/embed.fnc index cb9d68fc7f..90d44b6bd1 100644 --- a/embed.fnc +++ b/embed.fnc @@ -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 diff --git a/embed.h b/embed.h index 57af1f6630..4dcda01741 100644 --- a/embed.h +++ b/embed.h @@ -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) diff --git a/gv.c b/gv.c index a0f729080c..59a03cacbf 100644 --- a/gv.c +++ b/gv.c @@ -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); diff --git a/hv.c b/hv.c index 91be0a6f40..a6d62b50c5 100644 --- a/hv.c +++ b/hv.c @@ -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; } diff --git a/mg.c b/mg.c index 5f3eeae4fe..c470beaec1 100644 --- a/mg.c +++ b/mg.c @@ -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); diff --git a/mro_core.c b/mro_core.c index 947326eb0f..85c40db2b5 100644 --- a/mro_core.c +++ b/mro_core.c @@ -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) diff --git a/pad.c b/pad.c index 5d34240d1a..e0131ac698 100644 --- a/pad.c +++ b/pad.c @@ -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--) { diff --git a/pp.c b/pp.c index d1c39225de..b0c6e42031 100644 --- a/pp.c +++ b/pp.c @@ -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; diff --git a/pp_ctl.c b/pp_ctl.c index 0bf555dc92..2a3d841d56 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -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) { diff --git a/pp_hot.c b/pp_hot.c index ebd4b47e5d..67b255e2e7 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -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); diff --git a/proto.h b/proto.h index 5844ac3c6d..06d2916331 100644 --- a/proto.h +++ b/proto.h @@ -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 \ diff --git a/regcomp.c b/regcomp.c index f5a8aa080d..0051936b48 100644 --- a/regcomp.c +++ b/regcomp.c @@ -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' */ diff --git a/sv_inline.h b/sv_inline.h index 70ebb4ae3b..7288797d41 100644 --- a/sv_inline.h +++ b/sv_inline.h @@ -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()) +and + SV* sv = sv_newmortal(); + sv_upgrade(sv, ) +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: */ diff --git a/universal.c b/universal.c index 9558504317..9c7be3199e 100644 --- a/universal.c +++ b/universal.c @@ -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);