Avoid redundant copies in string evals

Perl_lex_start copies the string passed to it unconditionally.
Sometimes pp_entereval makes a copy before passing the string
to lex_start.  So in those cases we can pass a flag to avoid a
redundant copy.

3 files changed, 13 insertions, 11 deletions

diff --git a/parser.h b/parser.h
index 9167e6c07f..3531631e62 100644
--- a/parser.h
+++ b/parser.h
@@ -119,8 +119,10 @@ typedef struct yy_parser {
 # define LEX_START_SAME_FILTER	0x00000001
 # define LEX_IGNORE_UTF8_HINTS	0x00000002
 # define LEX_EVALBYTES		0x00000004
+# define LEX_START_COPIED	0x00000008
 # define LEX_START_FLAGS \
-	(LEX_START_SAME_FILTER|LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
+	(LEX_START_SAME_FILTER|LEX_START_COPIED \
+	|LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
 #endif
 
 /* flags for parser API */
diff --git a/pp_ctl.c b/pp_ctl.c
index 380caf1b37..abd93ea81b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4125,7 +4125,7 @@ PP(pp_entereval)
     char *tmpbuf = tbuf;
     STRLEN len;
     CV* runcv;
-    U32 seq;
+    U32 seq, lex_flags = 0;
     HV *saved_hh = NULL;
     const bool bytes = PL_op->op_private & OPpEVAL_BYTES;
 
@@ -4148,6 +4148,7 @@ PP(pp_entereval)
 	const char * const p = SvPV_const(sv, len);
 
 	sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
+	lex_flags |= LEX_START_COPIED;
 
 	if (bytes && SvUTF8(sv))
 	    SvPVbyte_force(sv, len);
@@ -4157,15 +4158,17 @@ PP(pp_entereval)
 	STRLEN len;
 	sv = newSVsv(sv);
 	SvPVbyte_force(sv,len);
+	lex_flags |= LEX_START_COPIED;
     }
 
     TAINT_IF(SvTAINTED(sv));
     TAINT_PROPER("eval");
 
     ENTER_with_name("eval");
-    lex_start(sv, NULL, PL_op->op_private & OPpEVAL_UNICODE
+    lex_start(sv, NULL, lex_flags | (PL_op->op_private & OPpEVAL_UNICODE
 			   ? LEX_IGNORE_UTF8_HINTS
 			   : bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER
+			)
 	     );
     SAVETMPS;
 
diff --git a/toke.c b/toke.c
index 6e88c8a25c..1431cc377d 100644
--- a/toke.c
+++ b/toke.c
@@ -726,16 +726,13 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 
     if (line) {
 	s = SvPV_const(line, len);
-    } else {
-	len = 0;
-    }
-
-    if (!len) {
-	parser->linestr = newSVpvs("\n;");
-    } else {
-	parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
+	parser->linestr = flags & LEX_START_COPIED
+			    ? SvREFCNT_inc_simple_NN(line)
+			    : newSVpvn_flags(s, len, SvUTF8(line));
 	if (s[len-1] != ';')
 	    sv_catpvs(parser->linestr, "\n;");
+    } else {
+	parser->linestr = newSVpvs("\n;");
     }
     parser->oldoldbufptr =
 	parser->oldbufptr =