Optimise substr assignment in void context

In void context we can optimise

    substr($foo, $bar, $baz) = $replacement;

to something like

    substr($foo, $bar, $baz, $replacement);

except that the execution order must be preserved.  So what we actu-
ally do is

    substr($replacement, $foo, $bar, $baz);

with a flag to indicate that the replacement comes first.  This means
we can also optimise assignment to two-argument substr the same way.

Although optimisations are not supposed to change behaviour,
this one does.

• It stops substr assignment from calling get-magic twice, which means
  the optimisation makes things less buggy than usual.
• It causes the uninitialized warning (for an undefined first argu-
  ment) to mention the substr operator, as it did before the previous
  commit, rather than the assignment operator.  I think that sort of
  detail is minor enough.

I had to make the warning about clobbering references apply whenever
substr does a replacement, and not only when used as an lvalue.  So
four-argument substr now emits that warning.  I would consider that a
bug fix, too.

Also, if the numeric arguments to four-argument substr and the
replacement string are undefined, the order of the uninitialized warn-
ings is slightly different, but is consistent regardless of whether
the optimisation is in effect.

I believe this will make 95% of substr assignments run faster.  So
there is less incentive to use what I consider the less readable form
(the four-argument form, which is not self-documenting).

Since I like naïve benchmarks, here are Before and After:

$ time ./miniperl -le 'do{$x="hello"; substr ($x,0,0) = 34;0}for 1..1000000'

real	0m2.391s
user	0m2.381s
sys	0m0.005s
$ time ./miniperl -le 'do{$x="hello"; substr ($x,0,0) = 34;0}for 1..1000000'

real	0m0.936s
user	0m0.927s
sys	0m0.005s

1 files changed, 18 insertions, 0 deletions

diff --git a/op.c b/op.c
index eb3dffe4af..f3088ed545 100644
--- a/op.c
+++ b/op.c
@@ -10300,6 +10300,24 @@ Perl_rpeep(pTHX_ register OP *o)
 	    }
 	    break;
 
+	case OP_SASSIGN:
+	    if (OP_GIMME(o,0) == G_VOID) {
+		OP *right = cBINOP->op_first;
+		if (right) {
+		    OP *left = right->op_sibling;
+		    if (left->op_type == OP_SUBSTR
+			 && (left->op_private & 7) < 4) {
+			op_null(o);
+			cBINOP->op_first = left;
+			right->op_sibling =
+			    cBINOPx(left)->op_first->op_sibling;
+			cBINOPx(left)->op_first->op_sibling = right;
+			left->op_private |= OPpSUBSTR_REPL_FIRST;
+		    }
+		}
+	    }
+	    break;
+
 	case OP_CUSTOM: {
 	    Perl_cpeep_t cpeep = 
 		XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_peep);