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

16 files changed, 82 insertions, 75 deletions

diff --git a/doio.c b/doio.c
index 5e7a5a1cf1..ba096ef88c 100644
--- 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 6ae9239f6b..59aa8075a4 100644
--- 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 88e9993b00..ebcfabb076 100644
--- 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 63e10497ce..f0d8033329 100644
--- 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 48618c0a4a..3cd278c6db 100644
--- 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 f4014a8974..9c57b79b7c 100644
--- 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 8546d4f6df..d9a2eebcd3 100644
--- 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 1202fb10af..d25a55c59c 100644
--- 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 bf8f2fb388..efdb8a46e7 100644
--- 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 0d456bd569..21e6494d2f 100644
--- 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 6aa86455e8..36e5638957 100644
--- 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 6d756132f4..b7fd317248 100644
--- 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 6010e4f7ad..c50eef0b91 100644
--- 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 410e4d6148..08e9acdfa2 100644
--- 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 7bc2b099e8..efd894dbda 100644
--- 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 6c7e338e83..f2039da329 100644
--- 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);