diff --git a/gv.c b/gv.c index 9856e03a2b7a..b640979efed7 100644 --- a/gv.c +++ b/gv.c @@ -669,7 +669,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, get hairy. */ cv = MUTABLE_CV(newSV_type(SVt_PVCV)); GvCV_set(gv,cv); - GvCVGEN(gv) = 0; + assert(GvCVGEN(gv) == 0); CvISXSUB_on(cv); CvXSUB(cv) = core_xsub; PoisonPADLIST(cv); diff --git a/hv.c b/hv.c index 11e8c3eafd6c..7959ec10acfb 100644 --- a/hv.c +++ b/hv.c @@ -3570,7 +3570,7 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) SvPV_set(value, (char *) he->refcounted_he_data + 1); SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len); /* This stops anything trying to free it */ - SvLEN_set(value, 0); + assert(SvLEN(value) == 0); SvPOK_on(value); SvREADONLY_on(value); if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) diff --git a/op.c b/op.c index 890acc37285f..1d01d0f203ce 100644 --- a/op.c +++ b/op.c @@ -12320,7 +12320,7 @@ Perl_newSTUB(pTHX_ GV *gv, bool fake) PERL_ARGS_ASSERT_NEWSTUB; assert(!GvCVu(gv)); GvCV_set(gv, cv); - GvCVGEN(gv) = 0; + assert(GvCVGEN(gv) == 0); if (!fake && GvSTASH(gv) && HvENAME_HEK(GvSTASH(gv))) gv_method_changed(gv); if (SvFAKE(gv)) { diff --git a/pp.c b/pp.c index ed6155f8810b..a754dd64f754 100644 --- a/pp.c +++ b/pp.c @@ -3855,7 +3855,7 @@ PP(pp_index) * the routine that contains the new byte string, and donate it * to temp to ensure it will get free()d */ if (free_little_p) { - little = temp = newSV_type(SVt_NULL); + little = temp = newSV_type(SVt_PV); sv_usepvn(temp, (char *) little_p, llen); little_p = SvPVX_const(little); } diff --git a/pp_ctl.c b/pp_ctl.c index 90853e010029..6516005c8348 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3753,7 +3753,7 @@ S_save_lines(pTHX_ AV *array, SV *sv) sv_setpvn_fresh(tmpstr, s, t - s); /* not breakable until we compile a COP for it */ - SvIV_set(tmpstr, 0); + assert(SvIVX(tmpstr) == 0); SvIOK_on(tmpstr); av_store(array, line++, tmpstr); s = t; diff --git a/regcomp_invlist.c b/regcomp_invlist.c index 658ece56c960..247c0ab56d4e 100644 --- a/regcomp_invlist.c +++ b/regcomp_invlist.c @@ -357,8 +357,8 @@ Perl__new_invlist_C_array(pTHX_ const UV* const list) * of the list proper, so start it just after them */ SvPV_set(invlist, (char *) (list + HEADER_LENGTH)); - SvLEN_set(invlist, 0); /* Means we own the contents, and the system - shouldn't touch it */ + assert(SvLEN(invlist) == 0); /* Means we own the contents, and the system + shouldn't touch it */ *(get_invlist_offset_addr(invlist)) = offset; diff --git a/regexec.c b/regexec.c index be9ec2cf338f..2016903a81a7 100644 --- a/regexec.c +++ b/regexec.c @@ -3863,10 +3863,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, S_cleanup_regmatch_info_aux has executed (registered by SAVEDESTRUCTOR_X below). S_cleanup_regmatch_info_aux modifies magic belonging to this SV. - Not newSVsv, either, as it does not COW. */ - reginfo->sv = newSV_type(SVt_NULL); - SvSetSV_nosteal(reginfo->sv, sv); + reginfo->sv = newSVsv_flags(sv, SV_GMAGIC|SV_NOSTEAL|SV_DO_COW_SVSETSV); SAVEFREESV(reginfo->sv); } diff --git a/sv.c b/sv.c index af145738def1..a60f056665d9 100644 --- a/sv.c +++ b/sv.c @@ -1500,12 +1500,13 @@ Perl_sv_grow_fresh(pTHX_ SV *const sv, STRLEN newlen) if (newlen < PERL_STRLEN_NEW_MIN) newlen = PERL_STRLEN_NEW_MIN; - s = (char*)safemalloc(newlen); - SvPV_set(sv, s); - /* No PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC here, since many strings */ /* will never be grown once set. Let the real sv_grow worry about that. */ SvLEN_set(sv, newlen); + + s = (char*)safemalloc(newlen); + SvPV_set(sv, s); + return s; } @@ -6275,10 +6276,14 @@ Perl_newSV(pTHX_ const STRLEN len) { SV *sv; - if (!len) - new_SV(sv); - else { - sv = newSV_type(SVt_PV); + new_SV(sv); + if (len) { + SvFLAGS(sv) = SVt_PV; + SvANY(sv) = new_XPV(); + + SvCUR_set(sv, 0); + SvLEN_set(sv, 0); + sv_grow_fresh(sv, len + 1); } return sv; @@ -6301,6 +6306,11 @@ Perl_newSVpvz(pTHX_ const STRLEN len) { SV *sv = newSV_type(SVt_PV); sv_grow_fresh(sv, len + 1); + + /* Some ASSUMEs which may help the compiler avoid unnecessary work */ + ASSUME(SvCUR(sv) == 0); + ASSUME(SvFLAGS(sv) == SVt_PV); + ASSUME(!TAINT_get); (void) sv_setpv_freshbuf(sv); return sv; @@ -9143,7 +9153,7 @@ Perl_sv_collxfrm_flags(pTHX_ SV *const sv, STRLEN *const nxp, const I32 flags) static char * S_sv_gets_append_to_utf8(pTHX_ SV *const sv, PerlIO *const fp, SSize_t append) { - SV * const tsv = newSV_type(SVt_NULL); + SV * const tsv = newSV_type(SVt_PV); ENTER; SAVEFREESV(tsv); sv_gets(tsv, fp, 0); @@ -10286,54 +10296,45 @@ SV if C is NULL. SV * Perl_newSVhek(pTHX_ const HEK *const hek) { - if (!hek) { - SV *sv; - - new_SV(sv); - return sv; - } - - if (HEK_LEN(hek) == HEf_SVKEY) { - return newSVsv(*(SV**)HEK_KEY(hek)); - } else { - const int flags = HEK_FLAGS(hek); - if (flags & HVhek_WASUTF8) { - /* Trouble :-) - Andreas would like keys he put in as utf8 to come back as utf8 - */ - STRLEN utf8_len = HEK_LEN(hek); - SV * const sv = newSV_type(SVt_PV); - char *as_utf8 = (char *)bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len); - /* bytes_to_utf8() allocates a new string, which we can repurpose: */ - sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL); - SvUTF8_on (sv); - return sv; - } else if (flags & HVhek_NOTSHARED) { - /* A hash that isn't using shared hash keys has to have - the flag in every key so that we know not to try to call - share_hek_hek on it. */ + SV *sv = newSV_type(SVt_PV); - SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek)); - if (HEK_UTF8(hek)) + if (LIKELY(hek)) { + if (HEK_LEN(hek) != HEf_SVKEY) { + const int flags = HEK_FLAGS(hek); + if (LIKELY(!(flags & (HVhek_WASUTF8|HVhek_NOTSHARED)))) { + /* This will be overwhelmingly the most common case. */ + /* Inline most of newSVpvn_share(), because share_hek_hek() is far + more efficient than sharepvn(). */ + SvFLAGS(sv) = SVt_PV | SVf_POK | SVp_POK | SVf_IsCOW | + (HEK_UTF8(hek) ? SVf_UTF8 : 0); + SvCUR_set(sv, HEK_LEN(hek)); + SvPV_set(sv, (char *)HEK_KEY(share_hek_hek(hek))); + assert(SvLEN(sv) == 0); /* SVt_PV should be initialized with this value */ + return sv; + } else if (flags & HVhek_WASUTF8) { + /* Trouble :-) + Andreas would like keys he put in as utf8 to come back as utf8 + */ + STRLEN utf8_len = HEK_LEN(hek); + char *as_utf8 = (char *)bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len); + /* bytes_to_utf8() allocates a new string, which we can repurpose: */ + sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL); SvUTF8_on (sv); - return sv; - } - /* This will be overwhelmingly the most common case. */ - { - /* Inline most of newSVpvn_share(), because share_hek_hek() is far - more efficient than sharepvn(). */ - SV *sv = newSV_type(SVt_PV); - - SvPV_set(sv, (char *)HEK_KEY(share_hek_hek(hek))); - SvCUR_set(sv, HEK_LEN(hek)); - SvLEN_set(sv, 0); - SvIsCOW_on(sv); - SvPOK_on(sv); - if (HEK_UTF8(hek)) - SvUTF8_on(sv); + return sv; + } else { + assert(flags & HVhek_NOTSHARED); + sv_setpvn_fresh(sv,HEK_KEY(hek),HEK_LEN(hek)); + if (HEK_UTF8(hek)) + SvUTF8_on (sv); + return sv; + } + } else { + /* (HEK_LEN(hek) == HEf_SVKEY) is comparatively more rare nowadays */ + sv_setsv_flags(sv, *(SV**)HEK_KEY(hek), SV_GMAGIC|SV_NOSTEAL); return sv; } } + return sv; } /* @@ -10375,13 +10376,11 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) sv = newSV_type(SVt_PV); /* The logic for this is inlined in S_mro_get_linear_isa_dfs(), so if it changes here, update it there too. */ - SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash)); + SvFLAGS(sv) |= SVf_POK | SVp_POK | SVf_IsCOW | + (is_utf8 ? SVf_UTF8 : 0); SvCUR_set(sv, len); - SvLEN_set(sv, 0); - SvIsCOW_on(sv); - SvPOK_on(sv); - if (is_utf8) - SvUTF8_on(sv); + assert(SvLEN(sv) ==0); + SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash)); return sv; } @@ -10563,9 +10562,7 @@ SV * Perl_newSVbool(pTHX_ bool bool_val) { PERL_ARGS_ASSERT_NEWSVBOOL; - SV *sv = newSVsv(bool_val ? &PL_sv_yes : &PL_sv_no); - - return sv; + return (bool_val ? newSV_true() : newSV_false()); } /* @@ -10579,7 +10576,18 @@ SV * Perl_newSV_true(pTHX) { PERL_ARGS_ASSERT_NEWSV_TRUE; - SV *sv = newSVsv(&PL_sv_yes); + + /* Equivalent to: SV *sv = newSVsv(&PL_sv_yes); */ + SV *sv; + new_SV(sv); + SvFLAGS(sv) = SVt_PVNV|SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK + |SVf_POK|SVp_POK|SVf_IsCOW|SVppv_STATIC; + SvPV_set(sv, (char*)PL_Yes); + SvANY(sv) = new_XPVNV(); + SvCUR_set(sv, 1); + SvLEN_set(sv, 0); + SvIV_set(sv, 1); + SvNV_set(sv, 1); return sv; } @@ -10596,7 +10604,18 @@ SV * Perl_newSV_false(pTHX) { PERL_ARGS_ASSERT_NEWSV_FALSE; - SV *sv = newSVsv(&PL_sv_no); + + /* Equivalent to: SV *sv = newSVsv(&PL_sv_no); */ + SV *sv; + new_SV(sv); + SvFLAGS(sv) = SVt_PVNV|SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK + |SVf_POK|SVp_POK|SVf_IsCOW|SVppv_STATIC; + SvPV_set(sv, (char*)PL_No); + SvANY(sv) = new_XPVNV(); + SvCUR_set(sv, 0); + SvLEN_set(sv, 0); + SvIV_set(sv, 0); + SvNV_set(sv, 0); return sv; } @@ -11175,10 +11194,11 @@ Perl_newSVrv(pTHX_ SV *const rv, const char *const classname) const U32 refcnt = SvREFCNT(rv); SvREFCNT(rv) = 0; sv_clear(rv); - SvFLAGS(rv) = 0; + SvFLAGS(rv) = SVt_IV; SvREFCNT(rv) = refcnt; - sv_upgrade(rv, SVt_IV); + SET_SVANY_FOR_BODYLESS_IV(rv); + SvIV_set(rv, 0); } else if (SvROK(rv)) { SvREFCNT_dec(SvRV(rv)); } else {