make pp_leavesublv use S_leavesub_adjust_stacks()

Currently S_leavesub_adjust_stacks() is just used by pp_leavesub.
Rename it to Perl_leave_adjust_stacks(), extend its functionality
slightly, then make pp_leavesublv() use it too.

This means that lvalue sub exit gains the benefit of FREETMPS being done,
and (where mortal copying needs doing) the optimised copying code.
It also means there is now one less version of the "process args on scope
exit" code.

pp_leavesublv() still does a scan of its return args looking for things to
croak() on, but leaves everything else to leave_adjust_stacks().

leave_adjust_stacks() is intended shortly to be used in place of
S_leave_common() too, thus unifying all args-on-scope-exit code.

The changes to leave_adjust_stacks() in this commit (apart from the
renaming and doc changes) are:
* a new arg to indicate what condition to use to decide whether to
  pass or copy the arg;
* a new branch to mortalise and ref count bump an arg

1 files changed, 68 insertions, 93 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index cde30a40fc..ff1fb42313 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2308,13 +2308,9 @@ PP(pp_leaveloop)
 
 PP(pp_leavesublv)
 {
-    dSP;
-    SV **newsp;
-    SV **mark;
     I32 gimme;
     PERL_CONTEXT *cx;
-    bool ref;
-    const char *what = NULL;
+    SV **oldsp;
     OP *retop;
 
     cx = CX_CUR();
@@ -2327,99 +2323,78 @@ PP(pp_leavesublv)
 	return 0;
     }
 
-    newsp = PL_stack_base + cx->blk_oldsp;
     gimme = cx->blk_gimme;
-    TAINT_NOT;
+    oldsp = PL_stack_base + cx->blk_oldsp; /* last arg of previous frame */
 
-    mark = newsp + 1;
+    if (gimme == G_VOID)
+        PL_stack_sp = oldsp;
+    else {
+        U8   lval    = CxLVAL(cx);
+        bool is_lval = (lval && !(lval & OPpENTERSUB_INARGS));
+        const char *what = NULL;
+
+        if (gimme == G_SCALAR) {
+            if (is_lval) {
+                /* check for bad return arg */
+                if (oldsp < PL_stack_sp) {
+                    SV *sv = *PL_stack_sp;
+                    if ((SvPADTMP(sv) || SvREADONLY(sv))) {
+                        what =
+                            SvREADONLY(sv) ? (sv == &PL_sv_undef) ? "undef"
+                            : "a readonly value" : "a temporary";
+                    }
+                    else goto ok;
+                }
+                else {
+                    /* sub:lvalue{} will take us here. */
+                    what = "undef";
+                }
+              croak:
+                Perl_croak(aTHX_
+                          "Can't return %s from lvalue subroutine", what);
+            }
 
-    ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
-    if (gimme == G_SCALAR) {
-	if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
-	    if (MARK <= SP) {
-		if ((SvPADTMP(TOPs) || SvREADONLY(TOPs))) {
-		    what =
-			SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
-			: "a readonly value" : "a temporary";
-		}
-		else goto copy_sv;
-	    }
-	    else {
-		/* sub:lvalue{} will take us here. */
-		what = "undef";
-	    }
-          croak:
-	    Perl_croak(aTHX_
-	              "Can't return %s from lvalue subroutine", what
-	    );
-	}
-	if (MARK <= SP) {
-	      copy_sv:
-		if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-		    if (!SvPADTMP(*SP)) {
-			*MARK = SvREFCNT_inc(*SP);
-			FREETMPS;
-			sv_2mortal(*MARK);
-		    }
-		    else {
-			/* FREETMPS could clobber it */
-			SV *sv = SvREFCNT_inc(*SP);
-			FREETMPS;
-			*MARK = sv_mortalcopy(sv);
-			SvREFCNT_dec(sv);
-		    }
-		}
-		else
-		    *MARK =
-		      SvPADTMP(*SP)
-		       ? sv_mortalcopy(*SP)
-		       : !SvTEMP(*SP)
-		          ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
-		          : *SP;
-	}
-	else {
-	    MEXTEND(MARK, 0);
-	    *MARK = &PL_sv_undef;
-	}
-        SP = MARK;
+          ok:
+            leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
 
-	if (CxLVAL(cx) & OPpDEREF) {
-	    SvGETMAGIC(TOPs);
-	    if (!SvOK(TOPs)) {
-		TOPs = vivify_ref(TOPs, CxLVAL(cx) & OPpDEREF);
-	    }
-	}
-    }
-    else if (gimme == G_ARRAY) {
-	assert (!(CxLVAL(cx) & OPpDEREF));
-	if (ref || !CxLVAL(cx))
-	    for (; MARK <= SP; MARK++)
-		*MARK =
-		       SvFLAGS(*MARK) & SVs_PADTMP
-		           ? sv_mortalcopy(*MARK)
-		     : SvTEMP(*MARK)
-		           ? *MARK
-		           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
-	else for (; MARK <= SP; MARK++) {
-            /* the PL_sv_undef exception is to allow things like this to
-             * work, where PL_sv_undef acts as 'skip' placeholder on the
-             * LHS of list assigns:
-             *    sub foo :lvalue { undef }
-             *    ($a, undef, foo(), $b) = 1..4;
-             */
-	    if (*MARK != &PL_sv_undef
-		    && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
-	    ) {
-		    /* Might be flattened array after $#array =  */
-                    what = SvREADONLY(*MARK)
-                            ? "a readonly value" : "a temporary";
-                    goto croak;
-	    }
-	    else if (!SvTEMP(*MARK))
-		*MARK = sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
-	}
+            if (lval & OPpDEREF) {
+                /* lval_sub()->{...} and similar */
+                dSP;
+                SvGETMAGIC(TOPs);
+                if (!SvOK(TOPs)) {
+                    TOPs = vivify_ref(TOPs, CxLVAL(cx) & OPpDEREF);
+                }
+                PUTBACK;
+            }
+        }
+        else {
+            assert(gimme == G_ARRAY);
+            assert (!(lval & OPpDEREF));
+
+            if (is_lval) {
+                /* scan for bad return args */
+                SV **p;
+                for (p = PL_stack_sp; p > oldsp; p--) {
+                    SV *sv = *p;
+                    /* the PL_sv_undef exception is to allow things like
+                     * this to work, where PL_sv_undef acts as 'skip'
+                     * placeholder on the LHS of list assigns:
+                     *    sub foo :lvalue { undef }
+                     *    ($a, undef, foo(), $b) = 1..4;
+                     */
+                    if (sv != &PL_sv_undef && (SvPADTMP(sv) || SvREADONLY(sv)))
+                    {
+                        /* Might be flattened array after $#array =  */
+                        what = SvREADONLY(sv)
+                                ? "a readonly value" : "a temporary";
+                        goto croak;
+                    }
+                }
+            }
+
+            leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
+        }
     }
-    PUTBACK;
 
     CX_LEAVE_SCOPE(cx);
     POPSUB(cx);	/* Stack values are safe: release CV and @_ ... */