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.
This commit is contained in:
Father Chrysostomos 2011-11-06 14:04:51 -08:00
parent bc34412328
commit 0abcdfa4c5
3 changed files with 13 additions and 11 deletions

View File

@ -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 */

View File

@ -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;

13
toke.c
View File

@ -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 =