In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a0833292cfd2e6c3e7390b655122d7e033b70793?hp=945fff052a1ae1a94b53e9255561aa632a67259d>
- Log ----------------------------------------------------------------- commit a0833292cfd2e6c3e7390b655122d7e033b70793 Author: David Mitchell <[email protected]> Date: Tue Nov 15 08:27:48 2016 +0000 optimise $ref1 = $ref2 better When assigning to a ref, the old referent is mortalised if its refcount is 1, to avoid a premature free on things like $r = $$r or $r = $r->[0]. For the shortcut case where $ref1 and $ref2 are simple refs (no magic etc) it's possible to do the assign then SvREFCNT_dec() the old value without having to mortalise it. Which is faster. Even when it doesn't have to be mortalised (RC > 1) this commit makes it slightly faster as it no longer calls sv_unref_flags(). Conversely, this commit also makes the short-cut integer assign code path infinitesimally slower. M sv.c M t/perf/benchmarks commit 90303eefab11f53890ba7378a38c90ca58b20072 Author: David Mitchell <[email protected]> Date: Tue Nov 15 08:22:48 2016 +0000 perf/benchmarks: tidy scalar assign benchmarks rename them from expr::assign::* to expr::sassign::* so as to more easily distinguish them from expr::aassign::, and move them to the correct place in the file M t/perf/benchmarks ----------------------------------------------------------------------- Summary of changes: sv.c | 10 ++++++-- t/perf/benchmarks | 70 +++++++++++++++++++++++++++++++++---------------------- 2 files changed, 50 insertions(+), 30 deletions(-) diff --git a/sv.c b/sv.c index 7bc97f3..25776f2 100644 --- a/sv.c +++ b/sv.c @@ -4280,12 +4280,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) * special-casing */ U32 sflags; U32 new_dflags; + SV *old_rv = NULL; /* minimal subset of SV_CHECK_THINKFIRST_COW_DROP(dstr) */ if (SvREADONLY(dstr)) Perl_croak_no_modify(); - if (SvROK(dstr)) - sv_unref_flags(dstr, 0); + if (SvROK(dstr)) { + if (SvWEAKREF(dstr)) + sv_unref_flags(dstr, 0); + else + old_rv = SvRV(dstr); + } assert(!SvGMAGICAL(sstr)); assert(!SvGMAGICAL(dstr)); @@ -4315,6 +4320,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) new_dflags = dtype; /* turn off everything except the type */ } SvFLAGS(dstr) = new_dflags; + SvREFCNT_dec(old_rv); return; } diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 5726c98..8306b1f 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -199,34 +199,6 @@ code => '$h{$k1}[$i]{$k2}', }, - - 'expr::assign::scalar_lex_int' => { - desc => 'lexical $x = 1', - setup => 'my $x', - code => '$x = 1', - }, - 'expr::assign::scalar_lex_str' => { - desc => 'lexical $x = "abc"', - setup => 'my $x', - code => '$x = "abc"', - }, - 'expr::assign::scalar_lex_strint' => { - desc => 'lexical $x = 1 where $x was previously a string', - setup => 'my $x = "abc"', - code => '$x = 1', - }, - 'expr::assign::scalar_lex_intstr' => { - desc => 'lexical $x = "abc" where $x was previously an int', - setup => 'my $x = 1;', - code => '$x = "abc"', - }, - 'expr::assign::2list_lex' => { - desc => 'lexical ($x, $y) = (1, 2)', - setup => 'my ($x, $y)', - code => '($x, $y) = (1, 2)', - }, - - 'expr::hash::lex_1const' => { desc => 'lexical $hash{const}', setup => 'my %h = ("foo" => 1)', @@ -716,6 +688,12 @@ code => '($x,$x) = (undef, $x)', }, + 'expr::aassign::2list_lex' => { + desc => 'lexical ($x, $y) = (1, 2)', + setup => 'my ($x, $y)', + code => '($x, $y) = (1, 2)', + }, + # array assign of strings 'expr::aassign::la_3s' => { @@ -890,6 +868,42 @@ + # scalar assign, OP_SASSIGN + + + 'expr::sassign::scalar_lex_int' => { + desc => 'lexical $x = 1', + setup => 'my $x', + code => '$x = 1', + }, + 'expr::sassign::scalar_lex_str' => { + desc => 'lexical $x = "abc"', + setup => 'my $x', + code => '$x = "abc"', + }, + 'expr::sassign::scalar_lex_strint' => { + desc => 'lexical $x = 1 where $x was previously a string', + setup => 'my $x = "abc"', + code => '$x = 1', + }, + 'expr::sassign::scalar_lex_intstr' => { + desc => 'lexical $x = "abc" where $x was previously an int', + setup => 'my $x = 1;', + code => '$x = "abc"', + }, + 'expr::sassign::lex_rv' => { + desc => 'lexical $ref1 = $ref2;', + setup => 'my $r1 = []; my $r = $r1;', + code => '$r = $r1;', + }, + 'expr::sassign::lex_rv1' => { + desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', + setup => 'my $r1 = []; my $r', + code => '$r = []; $r = $r1;', + }, + + + # using a const string as second arg to index triggers using FBM. # the FBM matcher special-cases 1,2-byte strings. # -- Perl5 Master Repository
