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.

diff --git a/sv.c b/sv.c
index 7bc97f3..25776f2 100644 (file)
--- 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 6dfe442..8306b1f 100644 (file)
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -891,6 +891,16 @@
         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;',
+    },