pp_return: tail call pp_leavesub

For returns within normal (rvalue) subs, handle the bulk of of the work by falling through into pp_leavesub, rather than repeating most of the code. So pp_return is now just responsible for popping any extra contexts and shifting any return args back down to the base of the stack. Return in lvalue subs, evals etc is unaffected.
Perl · Jun 19, 2015 · 6228a1e · 6228a1e
1 parent d3e5e56
commit 6228a1e
Show file tree

Hide file tree

Showing 2 changed files with 67 additions and 42 deletions.
diff --git a/pp_ctl.c b/pp_ctl.c
@@ -2416,8 +2416,9 @@ PP(pp_return)
     if (cxix < cxstack_ix)
 	dounwind(cxix);
 
-    if (CxMULTICALL(&cxstack[cxix])) {
-	gimme = cxstack[cxix].blk_gimme;
+    cx = &cxstack[cxix];
+    if (CxMULTICALL(cx)) {
+	gimme = cx->blk_gimme;
 	if (gimme == G_VOID)
 	    PL_stack_sp = PL_stack_base;
 	else if (gimme == G_SCALAR) {
@@ -2427,11 +2428,29 @@ PP(pp_return)
 	return 0;
     }
 
+    if (CxTYPE(cx) == CXt_SUB && !CvLVALUE(cx->blk_sub.cv)) {
+        SV **oldsp = PL_stack_base + cx->blk_oldsp;
+        if (oldsp != MARK) {
+            /* shift return args to base of call stack frame */
+            SSize_t nargs = SP - MARK;
+            if (nargs) {
+                if (cx->blk_gimme == G_ARRAY)
+                    Move(MARK + 1, oldsp + 1, nargs, SV**);
+                else if (cx->blk_gimme == G_SCALAR)
+                    oldsp[1] = *SP;
+            }
+            PL_stack_sp  = oldsp + nargs;
+        }
+        /* fall through to a normal sub exit */
+        return Perl_pp_leavesub(aTHX);
+    }
+
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:
 	popsub2 = TRUE;
-	lval = !!CvLVALUE(cx->blk_sub.cv);
+	assert(CvLVALUE(cx->blk_sub.cv));
+	lval = TRUE;
 	retop = cx->blk_sub.retop;
 	cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
 	break;
@@ -2465,45 +2484,15 @@ PP(pp_return)
     TAINT_NOT;
     if (lval) S_return_lvalues(aTHX_ MARK, SP, newsp, gimme, cx, newpm);
     else {
-      if (gimme == G_SCALAR) {
-	if (MARK < SP) {
-	    if (popsub2) {
-		if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-		    if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
-			 && !SvMAGICAL(TOPs)) {
-			*++newsp = SvREFCNT_inc(*SP);
-			FREETMPS;
-			sv_2mortal(*newsp);
-		    }
-		    else {
-			sv = SvREFCNT_inc(*SP);	/* FREETMPS could clobber it */
-			FREETMPS;
-			*++newsp = sv_mortalcopy(sv);
-			SvREFCNT_dec(sv);
-		    }
-		}
-		else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1
-			  && !SvMAGICAL(*SP)) {
-		    *++newsp = *SP;
-		}
-		else
-		    *++newsp = sv_mortalcopy(*SP);
+        if (gimme == G_SCALAR)
+            *++newsp = (MARK < SP) ? sv_mortalcopy(*SP) : &PL_sv_undef;
+        else if (gimme == G_ARRAY) {
+	    while (++MARK <= SP) {
+	        *++newsp = sv_mortalcopy(*MARK);
+	        TAINT_NOT;		/* Each item is independent */
 	    }
-	    else
-		*++newsp = sv_mortalcopy(*SP);
-	}
-	else
-	    *++newsp = &PL_sv_undef;
-      }
-      else if (gimme == G_ARRAY) {
-	while (++MARK <= SP) {
-	    *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1
-			       && !SvGMAGICAL(*MARK)
-			? *MARK : sv_mortalcopy(*MARK);
-	    TAINT_NOT;		/* Each item is independent */
-	}
-      }
-      PL_stack_sp = newsp;
+        }
+        PL_stack_sp = newsp;
     }
 
     LEAVE;

diff --git a/t/op/sub.t b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 39);
+plan(tests => 55);
 
 sub empty_sub {}
 
@@ -295,3 +295,39 @@ inside_predeclared(); # run test
     ::is($@, "outer\n", "RT124156 depth");
     ::is($destroyed, 1, "RT124156 freed cv");
 }
+
+
+# check that return pops extraneous stuff from the stack
+
+sub check_ret {
+    # the extra scopes push contexts and extra SVs on the stack
+    {
+        my @a = map $_ + 20, @_;
+        for ('x') {
+            return if defined $_[0] && $_[0] < 0;
+        }
+        for ('y') {
+            check_ret(1, do { (2,3,4, return @a ? @a[0..$#a] : ()) }, 4.5);
+        }
+    }
+}
+
+is(scalar check_ret(),          undef, "check_ret() scalar");
+is(scalar check_ret(5),         25,    "check_ret(5) scalar");
+is(scalar check_ret(5,6),       26,    "check_ret(5,6) scalar");
+is(scalar check_ret(5,6,7),     27,    "check_ret(5,6,7) scalar");
+is(scalar check_ret(5,6,7,8),   28,    "check_ret(5,6,7,8) scalar");
+is(scalar check_ret(5,6,7,8,9), 29,    "check_ret(5,6,7,8,9) scalar");
+
+is(scalar check_ret(-1),        undef, "check_ret(-1) scalar");
+is(scalar check_ret(-1,5),      undef, "check_ret(-1,5) scalar");
+
+is(join('-', 10, check_ret()),          "10",                "check_ret() list");
+is(join('-', 10, check_ret(5)),         "10-25",             "check_ret(5) list");
+is(join('-', 10, check_ret(5,6)),       "10-25-26",          "check_ret(5,6) list");
+is(join('-', 10, check_ret(5,6,7)),     "10-25-26-27",       "check_ret(5,6,7) list");
+is(join('-', 10, check_ret(5,6,7,8)),   "10-25-26-27-28",    "check_ret(5,6,7,8) list");
+is(join('-', 10, check_ret(5,6,7,8,9)), "10-25-26-27-28-29", "check_ret(5,6,7,8,9) list");
+
+is(join('-', 10, check_ret(-1)),        "10",  "check_ret(-1) list");
+is(join('-', 10, check_ret(-1,5)),      "10",  "check_ret(-1,5) list");