Extend newSVpvn_flags() to also call sv_2mortal() if SVs_TEMP is set in

the flags. Move its implementation just ahead of sv_2mortal()'s for
CPU cache locality. Refactor all code that can be to use this.

p4raw-id: //depot/perl@32818

diff --git a/doio.c b/doio.c
index 5e7a5a1..ba096ef 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -176,7 +176,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
-       namesv = sv_2mortal(newSVpvn(oname,len));
+       namesv = newSVpvn_flags(oname, len, SVs_TEMP);
        num_svs = 1;
        svp = &namesv;
        type = NULL;
@@ -399,7 +399,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                }
                else  {
                    if (!num_svs) {
-                       namesv = sv_2mortal(newSVpvn(type,tend - type));
+                       namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                        num_svs = 1;
                        svp = &namesv;
                        type = NULL;
@@ -432,7 +432,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            else {
                if (!num_svs) {
-                   namesv = sv_2mortal(newSVpvn(type,tend - type));
+                   namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                    num_svs = 1;
                    svp = &namesv;
                    type = NULL;
@@ -511,7 +511,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            else {
                if (!num_svs) {
-                   namesv = sv_2mortal(newSVpvn(type,tend - type));
+                   namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                    num_svs = 1;
                    svp = &namesv;
                    type = NULL;

diff --git a/doop.c b/doop.c
index 6ae9239..59aa807 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1217,13 +1217,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
        /* Avoid triggering overloading again by using temporaries.
           Maybe there should be a variant of sv_utf8_upgrade that takes pvn
        */
-       right = sv_2mortal(newSVpvn(rsave, rightlen));
+       right = newSVpvn_flags(rsave, rightlen, SVs_TEMP);
        sv_utf8_upgrade(right);
        rsave = rc = SvPV_nomg_const(right, rightlen);
        right_utf = TRUE;
     }
     else if (!left_utf && right_utf) {
-       left = sv_2mortal(newSVpvn(lsave, leftlen));
+       left = newSVpvn_flags(lsave, leftlen, SVs_TEMP);
        sv_utf8_upgrade(left);
        lsave = lc = SvPV_nomg_const(left, leftlen);
        left_utf = TRUE;

diff --git a/gv.c b/gv.c
index 88e9993..ebcfabb 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2057,8 +2057,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     PUSHs(lr>0? left: right);
     PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
     if (notfound) {
-      PUSHs( sv_2mortal(newSVpvn(AMG_id2name(method + assignshift),
-                                AMG_id2namelen(method + assignshift))));
+      PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift),
+                          AMG_id2namelen(method + assignshift), SVs_TEMP));
     }
     PUSHs((SV*)cv);
     PUTBACK;

diff --git a/hv.c b/hv.c
index 63e1049..f0d8033 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -350,8 +350,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                SV* obj = mg->mg_obj;
 
                if (!keysv) {
-                   keysv = sv_2mortal(newSVpvn_utf8(key, klen,
-                                                    flags & HVhek_UTF8));
+                   keysv = newSVpvn_flags(key, klen, SVs_TEMP |
+                                          ((flags & HVhek_UTF8)
+                                           ? SVf_UTF8 : 0));
                }
                
                mg->mg_obj = keysv;         /* pass key */
@@ -913,7 +914,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #ifdef ENV_IS_CASELESS
                else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                    /* XXX This code isn't UTF8 clean.  */
-                   keysv = sv_2mortal(newSVpvn(key,klen));
+                   keysv = newSVpvn_flags(key, klen, SVs_TEMP);
                    if (k_flags & HVhek_FREEKEY) {
                        Safefree(key);
                    }

diff --git a/mg.c b/mg.c
index 48618c0..3cd278c 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1607,7 +1607,7 @@ S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int
     if (n > 1) {
        if (mg->mg_ptr) {
            if (mg->mg_len >= 0)
-               PUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len)));
+               PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP));
            else if (mg->mg_len == HEf_SVKEY)
                PUSHs((SV*)mg->mg_ptr);
        }
@@ -2305,9 +2305,9 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
            /* Opening for input is more common than opening for output, so
               ensure that hints for input are sooner on linked list.  */
-           tmp = sv_2mortal(out ? newSVpvn(out + 1, start + len - out - 1)
-                            : newSVpvs(""));
-           SvFLAGS(tmp) |= SvUTF8(sv);
+           tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1,
+                                      SVs_TEMP | SvUTF8(sv))
+               : newSVpvn_flags("", 0, SVs_TEMP | SvUTF8(sv));
 
            tmp_he
                = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, 
@@ -2960,7 +2960,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV *key = (mg->mg_len == HEf_SVKEY) ? (SV *)mg->mg_ptr
-       : sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len));
+       : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
 
     /* mg->mg_obj isn't being used.  If needed, it would be possible to store
        an alternative leaf in there, with PL_compiling.cop_hints being used if

diff --git a/mro.c b/mro.c
index f4014a8..9c57b79 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -1049,7 +1049,7 @@ XS(XS_mro_nextcan)
     /* beyond here is just for cache misses, so perf isn't as critical */
 
     stashname_len = subname - fq_subname - 2;
-    stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));
+    stashname = newSVpvn_flags(fq_subname, stashname_len, SVs_TEMP);
 
     linear_av = mro_get_linear_isa_c3(selfstash, 0); /* has ourselves at the top of the list */
 

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 8546d4f..d9a2eeb 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -5173,9 +5173,10 @@ Creates a new SV and copies a string into it.  The reference count for the
 SV is set to 1.  Note that if C<len> is zero, Perl will create a zero length
 string.  You are responsible for ensuring that the source string is at least
 C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
-Currently the only flag bit accepted is SVf_UTF8. If this is set, then it
-will be set on the new SV. C<newSVpvn_utf8()> is a convenience wrapper for
-this function, defined as
+Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>.
+If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before
+returning. If C<SVf_UTF8> is set, then it will be set on the new SV.
+C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
 
     #define newSVpvn_utf8(s, len, u)                   \
        newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)

diff --git a/pp.c b/pp.c
index 1202fb1..d25a55c 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -449,7 +449,7 @@ PP(pp_prototype)
                if (defgv && str[n - 1] == '$')
                    str[n - 1] = '_';
                str[n++] = '\0';
-               ret = sv_2mortal(newSVpvn(str, n - 1));
+               ret = newSVpvn_flags(str, n - 1, SVs_TEMP);
            }
            else if (code)              /* Non-Overridable */
                goto set;
@@ -461,7 +461,7 @@ PP(pp_prototype)
     }
     cv = sv_2cv(TOPs, &stash, &gv, 0);
     if (cv && SvPOK(cv))
-       ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
+       ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP);
   set:
     SETs(ret);
     RETURN;
@@ -3312,7 +3312,8 @@ PP(pp_index)
           Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously)
           will trigger magic and overloading again, as will fbm_instr()
        */
-       big = sv_2mortal(newSVpvn_utf8(big_p, biglen, big_utf8));
+       big = newSVpvn_flags(big_p, biglen,
+                            SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0));
        big_p = SvPVX(big);
     }
     if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
@@ -3324,7 +3325,8 @@ PP(pp_index)
           This is all getting to messy. The API isn't quite clean enough,
           because data access has side effects.
        */
-       little = sv_2mortal(newSVpvn_utf8(little_p, llen, little_utf8));
+       little = newSVpvn_flags(little_p, llen,
+                               SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0));
        little_p = SvPVX(little);
     }
 

diff --git a/pp_hot.c b/pp_hot.c
index bf8f2fb..efdb8a4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -248,7 +248,7 @@ PP(pp_concat)
        /* mg_get(right) may happen here ... */
        rpv = SvPV_const(right, rlen);
        rbyte = !DO_UTF8(right);
-       right = sv_2mortal(newSVpvn(rpv, rlen));
+       right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
        rpv = SvPV_const(right, rlen);  /* no point setting UTF-8 here */
        rcopied = TRUE;
     }
@@ -287,7 +287,7 @@ PP(pp_concat)
            sv_utf8_upgrade_nomg(TARG);
        else {
            if (!rcopied)
-               right = sv_2mortal(newSVpvn(rpv, rlen));
+               right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
            sv_utf8_upgrade_nomg(right);
            rpv = SvPV_const(right, rlen);
        }

diff --git a/pp_pack.c b/pp_pack.c
index 0d456bd..21e6494 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2010,7 +2010,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                SHIFT_VAR(utf8, s, strend, aptr, datumtype);
                DO_BO_UNPACK_PC(aptr);
                /* newSVpvn generates undef if aptr is NULL */
-               PUSHs(sv_2mortal(newSVpvn(aptr, len)));
+               PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP));
            }
            break;
 #ifdef HAS_QUAD
@@ -2511,8 +2511,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                            STRLEN len;
                            const char *const pv = SvPV_const(*beglist, len);
                            SV *const temp
-                               = sv_2mortal(newSVpvn_flags(pv, len,
-                                                           SvUTF8(*beglist)));
+                               = newSVpvn_flags(pv, len,
+                                                SVs_TEMP | SvUTF8(*beglist));
                            *beglist = temp;
                        }
                        count = DO_UTF8(*beglist) ?

diff --git a/pp_sys.c b/pp_sys.c
index 6aa8645..36e5638 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4697,7 +4697,7 @@ PP(pp_ghostent)
        PUSHs(sv_2mortal(newSViv((IV)len)));
 #ifdef h_addr
        for (elem = hent->h_addr_list; elem && *elem; elem++) {
-           XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
+           XPUSHs(newSVpvn_flags(*elem, len, SVs_TEMP));
        }
 #else
        if (hent->h_addr)

diff --git a/regcomp.c b/regcomp.c
index 6d75613..b7fd317 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5249,8 +5249,9 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) {
     }
 
     if ( flags ) {
-        SV* sv_name = sv_2mortal(newSVpvn_utf8(name_start,
-            (int)(RExC_parse - name_start), UTF));
+        SV* sv_name
+           = newSVpvn_flags(name_start, (int)(RExC_parse - name_start),
+                            SVs_TEMP | (UTF ? SVf_UTF8 : 0));
         if ( flags == REG_RSN_RETURN_NAME)
             return sv_name;
         else if (flags==REG_RSN_RETURN_DATA) {
@@ -6742,7 +6743,7 @@ STATIC UV
 S_reg_recode(pTHX_ const char value, SV **encp)
 {
     STRLEN numlen = 1;
-    SV * const sv = sv_2mortal(newSVpvn(&value, numlen));
+    SV * const sv = newSVpvn_flags(&value, numlen, SVs_TEMP);
     const char * const s = *encp ? sv_recode_to_utf8(sv, *encp) : SvPVX(sv);
     const STRLEN newlen = SvCUR(sv);
     UV uv = UNICODE_REPLACEMENT;

diff --git a/sv.c b/sv.c
index 6010e4f..c50eef0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4344,7 +4344,7 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
            if (dutf8 != sutf8) {
                if (dutf8) {
                    /* Not modifying source SV, so taking a temporary copy. */
-                   SV* const csv = sv_2mortal(newSVpvn(spv, slen));
+                   SV* const csv = newSVpvn_flags(spv, slen, SVs_TEMP);
 
                    sv_utf8_upgrade(csv);
                    spv = SvPV_const(csv, slen);
@@ -6042,7 +6042,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
         * invalidate pv1, so we may need to make a copy */
        if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
            pv1 = SvPV_const(sv1, cur1);
-           sv1 = sv_2mortal(newSVpvn_flags(pv1, cur1, SvUTF8(sv2)));
+           sv1 = newSVpvn_flags(pv1, cur1, SVs_TEMP | SvUTF8(sv2));
        }
        pv1 = SvPV_const(sv1, cur1);
     }
@@ -6998,6 +6998,40 @@ Perl_sv_newmortal(pTHX)
     return sv;
 }
 
+
+/*
+=for apidoc newSVpvn_flags
+
+Creates a new SV and copies a string into it.  The reference count for the
+SV is set to 1.  Note that if C<len> is zero, Perl will create a zero length
+string.  You are responsible for ensuring that the source string is at least
+C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
+Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>.
+If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before
+returning. If C<SVf_UTF8> is set, then it will be set on the new SV.
+C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
+
+    #define newSVpvn_utf8(s, len, u)                   \
+       newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+
+=cut
+*/
+
+SV *
+Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
+{
+    dVAR;
+    register SV *sv;
+
+    /* All the flags we don't support must be zero.
+       And we're new code so I'm going to assert this from the start.  */
+    assert(!(flags & ~(SVf_UTF8|SVs_TEMP)));
+    new_SV(sv);
+    sv_setpvn(sv,s,len);
+    SvFLAGS(sv) |= (flags & SVf_UTF8);
+    return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+}
+
 /*
 =for apidoc sv_2mortal
 
@@ -7068,38 +7102,6 @@ Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
 }
 
 /*
-=for apidoc newSVpvn_flags
-
-Creates a new SV and copies a string into it.  The reference count for the
-SV is set to 1.  Note that if C<len> is zero, Perl will create a zero length
-string.  You are responsible for ensuring that the source string is at least
-C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
-Currently the only flag bit accepted is SVf_UTF8. If this is set, then it
-will be set on the new SV. C<newSVpvn_utf8()> is a convenience wrapper for
-this function, defined as
-
-    #define newSVpvn_utf8(s, len, u)                   \
-       newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
-
-=cut
-*/
-
-SV *
-Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
-{
-    dVAR;
-    register SV *sv;
-
-    /* All the flags we don't support must be zero.
-       And we're new code so I'm going to assert this from the start.  */
-    assert(!(flags & ~SVf_UTF8));
-    new_SV(sv);
-    sv_setpvn(sv,s,len);
-    SvFLAGS(sv) |= flags;
-    return sv;
-}
-
-/*
 =for apidoc newSVhek
 
 Creates a new SV from the hash key structure.  It will generate scalars that
@@ -9529,7 +9531,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            }
            else {
                const STRLEN old_elen = elen;
-               SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
+               SV * const nsv = newSVpvn_flags(eptr, elen, SVs_TEMP);
                sv_utf8_upgrade(nsv);
                eptr = SvPVX_const(nsv);
                elen = SvCUR(nsv);
@@ -11782,7 +11784,7 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
        XPUSHs(dsv);
        XPUSHs(ssv);
        XPUSHs(offsv = sv_2mortal(newSViv(*offset)));
-       XPUSHs(sv_2mortal(newSVpvn(tstr, tlen)));
+       XPUSHs(newSVpvn_flags(tstr, tlen, SVs_TEMP));
        PUTBACK;
        call_method("cat_decode", G_SCALAR);
        SPAGAIN;

diff --git a/toke.c b/toke.c
index 410e4d6..08e9acd 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1570,7 +1570,7 @@ S_tokeq(pTHX_ SV *sv)
        goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING ) {
-       pv = sv_2mortal(newSVpvn_flags(SvPVX_const(pv), len, SvUTF8(sv)));
+       pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv));
     }
     while (s < send) {
        if (*s == '\\') {
@@ -10551,9 +10551,9 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv && s)
-       pv = sv_2mortal(newSVpvn(s, len));
+       pv = newSVpvn_flags(s, len, SVs_TEMP);
     if (type && pv)
-       typesv = sv_2mortal(newSVpvn(type, typelen));
+       typesv = newSVpvn_flags(type, typelen, SVs_TEMP);
     else
        typesv = &PL_sv_undef;
 

diff --git a/utf8.c b/utf8.c
index 7bc2b09..efd894d 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1587,8 +1587,8 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     SPAGAIN;
     PUSHMARK(SP);
     EXTEND(SP,5);
-    PUSHs(sv_2mortal(newSVpvn(pkg, pkg_len)));
-    PUSHs(sv_2mortal(newSVpvn(name, name_len)));
+    PUSHs(newSVpvn_flags(pkg, pkg_len, SVs_TEMP));
+    PUSHs(newSVpvn_flags(name, name_len, SVs_TEMP));
     PUSHs(listsv);
     PUSHs(sv_2mortal(newSViv(minbits)));
     PUSHs(sv_2mortal(newSViv(none)));

diff --git a/util.c b/util.c
index 6c7e338..f2039da 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1216,7 +1216,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
        PUSHMARK(SP);
        EXTEND(SP,2);
        PUSHs(SvTIED_obj((SV*)io, mg));
-       PUSHs(sv_2mortal(newSVpvn(message, msglen)));
+       PUSHs(newSVpvn_flags(message, msglen, SVs_TEMP));
        PUTBACK;
        call_method("PRINT", G_SCALAR);