In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/80e5abf23b986e2b06e8cd73a698f2f1cd26d991?hp=e9fb18e45b1f91aa054cc8f7722759bb3d9bdf8e>
- Log ----------------------------------------------------------------- commit 80e5abf23b986e2b06e8cd73a698f2f1cd26d991 Author: David Mitchell <[email protected]> Date: Tue Sep 27 12:59:01 2016 +0100 S_sv_2iuv_common(): optimise single digit strings When converting a POK SV to an IOK SV, short-cut the relatively common case of a string that is only one char long and consists of a single digit, e.g. "0". Thus skipping all the floating-point, infinity, whitespace etc complexity. M sv.c M t/perf/benchmarks commit 032736abefdb7cfe5ccd540348d63d568c9bdc73 Author: David Mitchell <[email protected]> Date: Tue Sep 27 12:11:50 2016 +0100 pp_leaveloop(): rename local vars For internal consistency and for consistency with other pp_leave() functions, rename oldsp to base and mark/MARK to oldsp. Should be no functional difference. M pp_ctl.c ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 12 ++++++------ sv.c | 19 ++++++++++++++++++- t/perf/benchmarks | 11 +++++++++++ 3 files changed, 35 insertions(+), 7 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 0d76286..afc3b4b 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2248,21 +2248,21 @@ PP(pp_leaveloop) { PERL_CONTEXT *cx; U8 gimme; + SV **base; SV **oldsp; - SV **mark; cx = CX_CUR(); assert(CxTYPE_is_LOOP(cx)); - mark = PL_stack_base + cx->blk_oldsp; - oldsp = CxTYPE(cx) == CXt_LOOP_LIST + oldsp = PL_stack_base + cx->blk_oldsp; + base = CxTYPE(cx) == CXt_LOOP_LIST ? PL_stack_base + cx->blk_loop.state_u.stack.basesp - : mark; + : oldsp; gimme = cx->blk_gimme; if (gimme == G_VOID) - PL_stack_sp = oldsp; + PL_stack_sp = base; else - leave_adjust_stacks(MARK, oldsp, gimme, + leave_adjust_stacks(oldsp, base, gimme, PL_op->op_private & OPpLVALUE ? 3 : 1); CX_LEAVE_SCOPE(cx); diff --git a/sv.c b/sv.c index 850c727..088359f 100644 --- a/sv.c +++ b/sv.c @@ -2219,7 +2219,24 @@ S_sv_2iuv_common(pTHX_ SV *const sv) } else if (SvPOKp(sv)) { UV value; - const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); + int numtype; + const char *s = SvPVX_const(sv); + const STRLEN cur = SvCUR(sv); + + /* short-cut for a single digit string like "1" */ + + if (cur == 1) { + char c = *s; + if (isDIGIT(c)) { + if (SvTYPE(sv) < SVt_PVIV) + sv_upgrade(sv, SVt_PVIV); + (void)SvIOK_on(sv); + SvIV_set(sv, (IV)(c - '0')); + return FALSE; + } + } + + numtype = grok_number(s, cur, &value); /* We want to avoid a possible problem when we cache an IV/ a UV which may be later translated to an NV, and the resulting NV is not the same as the direct translation of the initial string diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 6ea1ce8..6c15523 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -812,6 +812,17 @@ setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', code => '$z = $x + $y', }, + 'expr::arith::add_lex_ss' => { + desc => 'add two short strings and assign to a lexical var', + setup => 'my ($x,$y,$z) = ("1", "2", 1);', + code => '$z = $x + $y; $x = "1"; ', + }, + + 'expr::arith::add_lex_ll' => { + desc => 'add two long strings and assign to a lexical var', + setup => 'my ($x,$y,$z) = ("12345", "23456", 1);', + code => '$z = $x + $y; $x = "12345"; ', + }, 'expr::arith::sub_lex_ii' => { desc => 'subtract two integers and assign to a lexical var', -- Perl5 Master Repository
