This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make pp_return() use leave_adjust_stacks()
authorDavid Mitchell <davem@iabyn.com>
Wed, 16 Dec 2015 14:52:22 +0000 (14:52 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 09:18:34 +0000 (09:18 +0000)
It was using S_leave_common(), but that's shortly to be removed.  It also
required adding an extra arg to leave_adjust_stacks() to indicate where to
shift the return args to. This will also be needed for when we replace the
remaining uses of  S_leave_common() with leave_adjust_stacks().

embed.fnc
embed.h
pp_ctl.c
pp_hot.c
proto.h

index b8c5810..ddc2f32 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2878,6 +2878,7 @@ Ei        |STRLEN |sv_or_pv_pos_u2b|NN SV *sv|NN const char *pv|STRLEN pos \
 EMpPX  |SV*    |_get_encoding
 Xp     |void   |clear_defarray |NN AV* av|bool abandon
 
-ApM    |void   |leave_adjust_stacks|NN SV **base_sp|I32 gimme|int filter
+ApM    |void   |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \
+                |I32 gimme|int filter
 
 : ex: set ts=8 sts=4 sw=4 noet:
diff --git a/embed.h b/embed.h
index ec0f490..f69c975 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define is_utf8_xidcont(a)     Perl_is_utf8_xidcont(aTHX_ a)
 #define is_utf8_xidfirst(a)    Perl_is_utf8_xidfirst(aTHX_ a)
 #define isinfnan               Perl_isinfnan
-#define leave_adjust_stacks(a,b,c)     Perl_leave_adjust_stacks(aTHX_ a,b,c)
+#define leave_adjust_stacks(a,b,c,d)   Perl_leave_adjust_stacks(aTHX_ a,b,c,d)
 #define leave_scope(a)         Perl_leave_scope(aTHX_ a)
 #define lex_bufutf8()          Perl_lex_bufutf8(aTHX)
 #define lex_discard_to(a)      Perl_lex_discard_to(aTHX_ a)
index ff1fb42..69b2446 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2355,7 +2355,7 @@ PP(pp_leavesublv)
             }
 
           ok:
-            leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
+            leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
 
             if (lval & OPpDEREF) {
                 /* lval_sub()->{...} and similar */
@@ -2392,7 +2392,7 @@ PP(pp_leavesublv)
                 }
             }
 
-            leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
+            leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
         }
     }
 
@@ -2451,19 +2451,20 @@ PP(pp_return)
          * We may also need to shift the args down; for example,
          *    for (1,2) { return 3,4 }
          * leaves 1,2,3,4 on the stack. Both these actions can be done by
-         * leave_common().  By calling it with lvalue=TRUE, we just bump
-         * the ref count and mortalise the args that need it.  The "scan
-         * the args and maybe copy them" process will be repeated by
-         * whoever we tail-call (e.g. pp_leaveeval), where any copying etc
-         * will be done. That is to say, in this code path two scans of
-         * the args will be done; the first just shifts and preserves; the
-         * second is the "real" arg processing, based on the type of
-         * return.
+         * leave_adjust_stacks().  By calling it with and lvalue "pass
+         * all" action, we just bump the ref count and mortalise the args
+         * that need it, do a FREETMPS.  The "scan the args and maybe copy
+         * them" process will be repeated by whoever we tail-call (e.g.
+         * pp_leaveeval), where any copying etc will be done. That is to
+         * say, in this code path two scans of the args will be done; the
+         * first just shifts and preserves; the second is the "real" arg
+         * processing, based on the type of return.
          */
         cx = &cxstack[cxix];
         PUTBACK;
-        leave_common(PL_stack_base + cx->blk_oldsp, MARK,
-                            cx->blk_gimme, SVs_TEMP|SVs_PADTMP, TRUE);
+        if (cx->blk_gimme != G_VOID)
+            leave_adjust_stacks(MARK, PL_stack_base + cx->blk_oldsp,
+                                cx->blk_gimme, 3);
         SPAGAIN;
        dounwind(cxix);
         cx = &cxstack[cxix]; /* CX stack may have been realloced */
index 236e237..1da07a3 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3284,8 +3284,10 @@ PP(pp_grepwhile)
 
 /* leave_adjust_stacks():
  *
- * Process a scope's return args (in the range base_sp+1 .. PL_stack_sp),
- * and do the equivalent of a FREEMPS and TAINT_NOT.
+ * Process a scope's return args (in the range from_sp+1 .. PL_stack_sp),
+ * positioning them at to_sp+1 onwards, and do the equivalent of a
+ * FREEMPS and TAINT_NOT.
+ *
  * Not intended to be called in void context.
  *
  * When leaving a sub, eval, do{} or other scope, the things that need
@@ -3341,10 +3343,9 @@ PP(pp_grepwhile)
  */
 
 void
-Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int pass)
+Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, I32 gimme, int pass)
 {
     dSP;
-    SV    **from_sp;   /* where we're copying args from */
     SSize_t tmps_base; /* lowest index into tmps stack that needs freeing now */
     SSize_t nargs;
 
@@ -3353,17 +3354,17 @@ Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int pass)
     TAINT_NOT;
 
     if (gimme == G_ARRAY) {
-        from_sp = base_sp + 1;
-        nargs   = SP - base_sp;
+        nargs = SP - from_sp;
+        from_sp++;
     }
     else {
         assert(gimme == G_SCALAR);
-        if (UNLIKELY(base_sp >= SP)) {
+        if (UNLIKELY(from_sp >= SP)) {
             /* no return args */
-            assert(base_sp == SP);
+            assert(from_sp == SP);
             EXTEND(SP, 1);
             *++SP = &PL_sv_undef;
-            base_sp = SP;
+            to_sp = SP;
             nargs   = 0;
         }
         else {
@@ -3431,7 +3432,7 @@ Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int pass)
             {
                 /* pass through: skip copy for logic or optimisation
                  * reasons; instead mortalise it, except that ... */
-                *++base_sp = sv;
+                *++to_sp = sv;
 
                 if (SvTEMP(sv)) {
                     /* ... since this SV is an SvTEMP , we don't need to
@@ -3495,7 +3496,7 @@ Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int pass)
                 PL_tmps_stack[++PL_tmps_ix] = *tmps_basep;
                 /* put it on the tmps stack early so it gets freed if we die */
                 *tmps_basep++ = newsv;
-                *++base_sp = newsv;
+                *++to_sp = newsv;
 
                 if (SvTYPE(sv) <= SVt_IV) {
                     /* arg must be one of undef, IV/UV, or RV: skip
@@ -3576,7 +3577,7 @@ Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int pass)
         tmps_base = tmps_basep - PL_tmps_stack;
     }
 
-    PL_stack_sp = base_sp;
+    PL_stack_sp = to_sp;
 
     /* unrolled FREETMPS() but using tmps_base-1 rather than PL_tmps_floor */
     while (PL_tmps_ix >= tmps_base) {
@@ -3615,7 +3616,7 @@ PP(pp_leavesub)
     if (gimme == G_VOID)
         PL_stack_sp = oldsp;
     else
-        leave_adjust_stacks(oldsp, gimme, 0);
+        leave_adjust_stacks(oldsp, oldsp, gimme, 0);
 
     CX_LEAVE_SCOPE(cx);
     POPSUB(cx);        /* Stack values are safe: release CV and @_ ... */
diff --git a/proto.h b/proto.h
index 9578a67..faa0335 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1610,9 +1610,9 @@ PERL_CALLCONV I32 Perl_keyword(pTHX_ const char *name, I32 len, bool all_keyword
 PERL_CALLCONV int      Perl_keyword_plugin_standard(pTHX_ char* keyword_ptr, STRLEN keyword_len, OP** op_ptr);
 #define PERL_ARGS_ASSERT_KEYWORD_PLUGIN_STANDARD       \
        assert(keyword_ptr); assert(op_ptr)
-PERL_CALLCONV void     Perl_leave_adjust_stacks(pTHX_ SV **base_sp, I32 gimme, int filter);
+PERL_CALLCONV void     Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, I32 gimme, int filter);
 #define PERL_ARGS_ASSERT_LEAVE_ADJUST_STACKS   \
-       assert(base_sp)
+       assert(from_sp); assert(to_sp)
 PERL_CALLCONV void     Perl_leave_scope(pTHX_ I32 base);
 PERL_CALLCONV bool     Perl_lex_bufutf8(pTHX);
 PERL_CALLCONV void     Perl_lex_discard_to(pTHX_ char* ptr);