This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid redundant copies in string evals
authorFather Chrysostomos <sprout@cpan.org>
Sun, 6 Nov 2011 22:04:51 +0000 (14:04 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 6 Nov 2011 22:23:49 +0000 (14:23 -0800)
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.

parser.h
pp_ctl.c
toke.c

index 9167e6c..3531631 100644 (file)
--- 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_SAME_FILTER 0x00000001
 # define LEX_IGNORE_UTF8_HINTS 0x00000002
 # define LEX_EVALBYTES         0x00000004
+# define LEX_START_COPIED      0x00000008
 # define LEX_START_FLAGS \
 # 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 */
 #endif
 
 /* flags for parser API */
index 380caf1..abd93ea 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4125,7 +4125,7 @@ PP(pp_entereval)
     char *tmpbuf = tbuf;
     STRLEN len;
     CV* runcv;
     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;
 
     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));
        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);
 
        if (bytes && SvUTF8(sv))
            SvPVbyte_force(sv, len);
@@ -4157,15 +4158,17 @@ PP(pp_entereval)
        STRLEN len;
        sv = newSVsv(sv);
        SvPVbyte_force(sv,len);
        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");
     }
 
     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
                           ? LEX_IGNORE_UTF8_HINTS
                           : bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER
+                       )
             );
     SAVETMPS;
 
             );
     SAVETMPS;
 
diff --git a/toke.c b/toke.c
index 6e88c8a..1431cc3 100644 (file)
--- 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);
 
     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;");
        if (s[len-1] != ';')
            sv_catpvs(parser->linestr, "\n;");
+    } else {
+       parser->linestr = newSVpvs("\n;");
     }
     parser->oldoldbufptr =
        parser->oldbufptr =
     }
     parser->oldoldbufptr =
        parser->oldbufptr =