From 9fdd7fc4796d89d16dceea42f2af91e4fde296ed Mon Sep 17 00:00:00 2001
From: Richard Leach <richardleach@users.noreply.github.com>
Date: Fri, 8 Jul 2022 14:52:19 +0000
Subject: Implement OP_PADSV_STORE - combined sassign/padsv OP

This commit introduces a new OP to replace simple cases
of OP_SASSIGN and OP_PADSV.

For example, 'my $x = 1' is currently implemented as:

1  <;> nextstate(main 1 -e:1) v:{
2  <$> const(IV 1) s
3  <0> padsv[$x:1,2] sRM*/LVINTRO
4  <2> sassign vKS/2

But now will be turned into:

1  <;> nextstate(main 1 -e:1) v:{
2  <$> const(IV 1) s
3  <1> padsv_store[$x:1,2] vKMS/LVINTRO

This intended to be a transparent performance optimization.
It should be applicable for RHS optrees of varying complexity.
---
 peep.c | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)

(limited to 'peep.c')

diff --git a/peep.c b/peep.c
index 7881a86ce9..32fa401d46 100644
--- a/peep.c
+++ b/peep.c
@@ -3840,6 +3840,58 @@ Perl_rpeep(pTHX_ OP *o)
                     }
                 }
             }
+            OP* rhs = cBINOPx(o)->op_first;
+            OP* lval = cBINOPx(o)->op_last;
+
+            /* Combine a simple SASSIGN OP with a PADSV lvalue child OP
+             * into a single OP. */
+
+            /* This optimization covers arbitrarily complicated RHS OP
+             * trees. Separate optimizations may exist for specific,
+             * single RHS OPs, such as:
+             * "my $foo = undef;" or "my $bar = $other_padsv;" */
+
+            if (!(o->op_private & (OPpASSIGN_BACKWARDS|OPpASSIGN_CV_TO_GV))
+                 && lval && (lval->op_type == OP_PADSV) &&
+                !(lval->op_private & OPpDEREF)
+               ) {
+
+                /* SASSIGN's bitfield flags, such as op_moresib and
+                 * op_slabbed, will be carried over unchanged. */
+                OpTYPE_set(o, OP_PADSV_STORE);
+
+                /* Explicitly craft the new OP's op_flags, carrying
+                 * some bits over from the SASSIGN */
+                o->op_flags = (
+                    OPf_KIDS | OPf_STACKED |
+                    (o->op_flags & (OPf_WANT|OPf_PARENS))
+                );
+
+                /* Reset op_private flags, taking relevant private flags
+                 * from the PADSV */
+                o->op_private = (lval->op_private &
+                                (OPpLVAL_INTRO|OPpPAD_STATE|OPpDEREF));
+
+                /* Steal the targ from the PADSV */
+                o->op_targ = lval->op_targ; lval->op_targ = 0;
+
+                /* Fixup op_next ptrs */
+                /* oldoldop can be arbitrarily deep in the RHS OP tree */
+                oldoldop->op_next = o;
+
+                /* Even when (rhs != oldoldop), rhs might still have a
+                 * relevant op_next ptr to lval. This is definitely true
+                 * when rhs is OP_NULL with a LOGOP kid (e.g. orassign).
+                 * There may be other cases. */
+                if (rhs->op_next == lval)
+                    rhs->op_next = o;
+
+                /* Now null-out the PADSV */
+                op_null(lval);
+
+                /* NULL the previous op ptrs, so rpeep can continue */
+                oldoldop = NULL; oldop = NULL;
+            }
             break;
 
         case OP_AASSIGN: {
-- 
cgit v1.2.1