savepv(SvPV(sv,n_a)) is common, and creates an unnecessary call to

strlen(). Add savesvpv(sv), which gets the length from the SV,
and returns a copy of its PV.

p4raw-id: //depot/perl@23772

9 files changed, 35 insertions, 10 deletions

diff --git a/embed.fnc b/embed.fnc
index d7336b72df..231dc143e0 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1490,4 +1490,6 @@ Ap	|GV*	|gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type
 Ap	|GV*	|gv_fetchsv|SV *name|I32 flags|I32 sv_type
 dp	|bool	|is_gv_magical_sv|SV *name|U32 flags
 
+Apd	|char*	|savesvpv	|SV* sv
+
 END_EXTERN_C
diff --git a/embed.h b/embed.h
index dacd2512d8..9d22e8d063 100644
--- a/embed.h
+++ b/embed.h
@@ -2283,6 +2283,7 @@
 #ifdef PERL_CORE
 #define is_gv_magical_sv	Perl_is_gv_magical_sv
 #endif
+#define savesvpv		Perl_savesvpv
 #define ck_anoncode		Perl_ck_anoncode
 #define ck_bitop		Perl_ck_bitop
 #define ck_concat		Perl_ck_concat
@@ -4903,6 +4904,7 @@
 #ifdef PERL_CORE
 #define is_gv_magical_sv(a,b)	Perl_is_gv_magical_sv(aTHX_ a,b)
 #endif
+#define savesvpv(a)		Perl_savesvpv(aTHX_ a)
 #define ck_anoncode(a)		Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)		Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)		Perl_ck_concat(aTHX_ a)
diff --git a/global.sym b/global.sym
index cdd5e0530a..6c004bb18d 100644
--- a/global.sym
+++ b/global.sym
@@ -675,3 +675,4 @@ Perl_hv_clear_placeholders
 Perl_hv_scalar
 Perl_gv_fetchpvn_flags
 Perl_gv_fetchsv
+Perl_savesvpv
diff --git a/mg.c b/mg.c
index 255e2082e5..c24bf6de73 100644
--- a/mg.c
+++ b/mg.c
@@ -2118,7 +2118,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	if (PL_inplace)
 	    Safefree(PL_inplace);
 	if (SvOK(sv))
-	    PL_inplace = savepv(SvPV(sv,len));
+	    PL_inplace = savesvpv(sv);
 	else
 	    PL_inplace = Nullch;
 	break;
@@ -2130,7 +2130,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    }
 	    if (SvOK(sv)) {
 		TAINT_PROPER("assigning to $^O");
-		PL_osname = savepv(SvPV(sv,len));
+		PL_osname = savesvpv(sv);
 	    }
 	}
 	else if (strEQ(mg->mg_ptr, "\017PEN")) {
@@ -2206,12 +2206,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '^':
 	Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
-	IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+	IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
 	IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
 	break;
     case '~':
 	Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
-	IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+	IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
 	IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
 	break;
     case '=':
@@ -2269,7 +2269,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '#':
 	if (PL_ofmt)
 	    Safefree(PL_ofmt);
-	PL_ofmt = savepv(SvPV(sv,len));
+	PL_ofmt = savesvpv(sv);
 	break;
     case '[':
 	PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
diff --git a/pp_sys.c b/pp_sys.c
index e125fb93ed..78cf48b945 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1340,7 +1340,7 @@ PP(pp_leavewrite)
 		topgv = gv_fetchsv(topname, FALSE, SVt_PVFM);
 		if ((topgv && GvFORM(topgv)) ||
 		  !gv_fetchpv("top",FALSE,SVt_PVFM))
-		    IoTOP_NAME(io) = savepv(SvPVX(topname));
+		    IoTOP_NAME(io) = savesvpv(topname);
 		else
 		    IoTOP_NAME(io) = savepv("top");
 	    }
diff --git a/proto.h b/proto.h
index 8c998dd352..64a618511a 100644
--- a/proto.h
+++ b/proto.h
@@ -1429,4 +1429,6 @@ PERL_CALLCONV GV*	Perl_gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, I32
 PERL_CALLCONV GV*	Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type);
 PERL_CALLCONV bool	Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags);
 
+PERL_CALLCONV char*	Perl_savesvpv(pTHX_ SV* sv);
+
 END_EXTERN_C
diff --git a/regcomp.c b/regcomp.c
index bcfb2a3d80..6b34346fd9 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -4863,7 +4863,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 		}
 
 		{
-		    char *s = savepv(SvPVX(lv));
+		    char *s = savesvpv(lv);
 		    char *origs = s;
 		
 		    while(*s && *s != '\n') s++;
diff --git a/universal.c b/universal.c
index 525ae4483e..829952a6d0 100644
--- a/universal.c
+++ b/universal.c
@@ -602,7 +602,7 @@ XS(XS_version_qv)
 	    }
 	    else
 	    {
-		version = savepv(SvPV_nolen(ver));
+		version = savesvpv(ver);
 	    }
 	    (void)scan_version(version,vs,TRUE);
 	    Safefree(version);
diff --git a/util.c b/util.c
index e99c6af68d..3598e7b320 100644
--- a/util.c
+++ b/util.c
@@ -819,6 +819,25 @@ Perl_savesharedpv(pTHX_ const char *pv)
     return strcpy(newaddr,pv);
 }
 
+/*
+=for apidoc savesvpv
+
+A version of C<savepv()>/C<savepvn() which gets the string to duplicate from
+the passed in SV using C<SvPV()>
+
+=cut
+*/
+
+char *
+Perl_savesvpv(pTHX_ SV *sv)
+{
+    STRLEN len;
+    const char *pv = SvPV(sv, len);
+    register char *newaddr;
+
+    New(903,newaddr,++len,char);
+    return CopyD(pv,newaddr,len,char);
+}
 
 
 /* the SV for Perl_form() and mess() is not kept in an arena */
@@ -3976,8 +3995,7 @@ Perl_upg_version(pTHX_ SV *ver)
 #endif
     else /* must be a string or something like a string */
     {
-	STRLEN n_a;
-	version = savepv(SvPV(ver,n_a));
+	version = savesvpv(ver);
     }
     (void)scan_version(version, ver, qv);
     Safefree(version);