Factor stack adjustments on leave in a new static function

This is just a refactoring. There should be no functional changes.

diff --git a/embed.fnc b/embed.fnc
index 41d9cc2..cc55c2a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1742,6 +1742,7 @@ sR        |PerlIO *|check_type_and_open|NN SV *name
 #ifndef PERL_DISABLE_PMC
 sR     |PerlIO *|doopen_pm     |NN SV *name
 #endif
+s      |SV **  |adjust_stack_on_leave|NN SV **newsp|NN SV **sp|NN SV **mark|I32 gimme|U32 flags
 sRn    |bool   |path_is_absolute|NN const char *name
 sR     |I32    |run_user_filter|int idx|NN SV *buf_sv|int maxlen
 sR     |PMOP*  |make_matcher   |NN REGEXP* re

diff --git a/embed.h b/embed.h
index 6dcaa39..dd759a8 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1381,6 +1381,7 @@
 #define refto(a)               S_refto(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_PP_CTL_C)
+#define adjust_stack_on_leave(a,b,c,d,e)       S_adjust_stack_on_leave(aTHX_ a,b,c,d,e)
 #define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
 #define destroy_matcher(a)     S_destroy_matcher(aTHX_ a)
 #define do_smartmatch(a,b)     S_do_smartmatch(aTHX_ a,b)

diff --git a/pp_ctl.c b/pp_ctl.c
index 1057c70..bde4399 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2050,6 +2050,39 @@ PP(pp_dbstate)
        return NORMAL;
 }
 
+STATIC SV **
+S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags)
+{
+    PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE;
+
+    if (gimme == G_SCALAR) {
+       if (MARK < SP)
+           *++newsp = (SvFLAGS(*SP) & flags) ? *SP : sv_mortalcopy(*SP);
+       else {
+           /* MEXTEND() only updates MARK, so reuse it instead of newsp. */
+           MARK = newsp;
+           MEXTEND(MARK, 1);
+           *++MARK = &PL_sv_undef;
+           return MARK;
+       }
+    }
+    else if (gimme == G_ARRAY) {
+       /* in case LEAVE wipes old return values */
+       while (++MARK <= SP) {
+           if (SvFLAGS(*MARK) & flags)
+               *++newsp = *MARK;
+           else {
+               *++newsp = sv_mortalcopy(*MARK);
+               TAINT_NOT;      /* Each item is independent */
+           }
+       }
+       /* When this function was called with MARK == newsp, we reach this
+        * point with SP == newsp. */
+    }
+
+    return newsp;
+}
+
 PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;
@@ -2203,21 +2236,7 @@ PP(pp_leaveloop)
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
     TAINT_NOT;
-    if (gimme == G_VOID)
-       NOOP;
-    else if (gimme == G_SCALAR) {
-       if (mark < SP)
-           *++newsp = sv_mortalcopy(*SP);
-       else
-           *++newsp = &PL_sv_undef;
-    }
-    else {
-       while (mark < SP) {
-           *++newsp = sv_mortalcopy(*++mark);
-           TAINT_NOT;          /* Each item is independent */
-       }
-    }
-    SP = newsp;
+    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0);
     PUTBACK;
 
     POPLOOP(cx);       /* Stack values are safe: release loop vars ... */
@@ -2572,21 +2591,8 @@ PP(pp_last)
     }
 
     TAINT_NOT;
-    if (gimme == G_SCALAR) {
-       if (MARK < SP)
-           *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP))
-                       ? *SP : sv_mortalcopy(*SP);
-       else
-           *++newsp = &PL_sv_undef;
-    }
-    else if (gimme == G_ARRAY) {
-       while (++MARK <= SP) {
-           *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK))
-                       ? *MARK : sv_mortalcopy(*MARK);
-           TAINT_NOT;          /* Each item is independent */
-       }
-    }
-    SP = newsp;
+    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme,
+                               pop2 == CXt_SUB ? SVs_TEMP : 0);
     PUTBACK;
 
     LEAVE;
@@ -4191,7 +4197,6 @@ PP(pp_entereval)
 PP(pp_leaveeval)
 {
     dVAR; dSP;
-    register SV **mark;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
@@ -4208,31 +4213,8 @@ PP(pp_leaveeval)
     retop = cx->blk_eval.retop;
 
     TAINT_NOT;
-    if (gimme == G_VOID)
-       MARK = newsp;
-    else if (gimme == G_SCALAR) {
-       MARK = newsp + 1;
-       if (MARK <= SP) {
-           if (SvFLAGS(TOPs) & SVs_TEMP)
-               *MARK = TOPs;
-           else
-               *MARK = sv_mortalcopy(TOPs);
-       }
-       else {
-           MEXTEND(mark,0);
-           *MARK = &PL_sv_undef;
-       }
-       SP = MARK;
-    }
-    else {
-       /* in case LEAVE wipes old return values */
-       for (mark = newsp + 1; mark <= SP; mark++) {
-           if (!(SvFLAGS(*mark) & SVs_TEMP)) {
-               *mark = sv_mortalcopy(*mark);
-               TAINT_NOT;      /* Each item is independent */
-           }
-       }
-    }
+    SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
+                               gimme, SVs_TEMP);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
 #ifdef DEBUGGING
@@ -4329,33 +4311,7 @@ PP(pp_leavetry)
     PERL_UNUSED_VAR(optype);
 
     TAINT_NOT;
-    if (gimme == G_VOID)
-       SP = newsp;
-    else if (gimme == G_SCALAR) {
-       register SV **mark;
-       MARK = newsp + 1;
-       if (MARK <= SP) {
-           if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
-               *MARK = TOPs;
-           else
-               *MARK = sv_mortalcopy(TOPs);
-       }
-       else {
-           MEXTEND(mark,0);
-           *MARK = &PL_sv_undef;
-       }
-       SP = MARK;
-    }
-    else {
-       /* in case LEAVE wipes old return values */
-       register SV **mark;
-       for (mark = newsp + 1; mark <= SP; mark++) {
-           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
-               *mark = sv_mortalcopy(*mark);
-               TAINT_NOT;      /* Each item is independent */
-           }
-       }
-    }
+    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("eval_scope");
@@ -4393,33 +4349,7 @@ PP(pp_leavegiven)
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     TAINT_NOT;
-    if (gimme == G_VOID)
-       SP = newsp;
-    else if (gimme == G_SCALAR) {
-       register SV **mark;
-       MARK = newsp + 1;
-       if (MARK <= SP) {
-           if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
-               *MARK = TOPs;
-           else
-               *MARK = sv_mortalcopy(TOPs);
-       }
-       else {
-           MEXTEND(mark,0);
-           *MARK = &PL_sv_undef;
-       }
-       SP = MARK;
-    }
-    else {
-       /* in case LEAVE wipes old return values */
-       register SV **mark;
-       for (mark = newsp + 1; mark <= SP; mark++) {
-           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
-               *mark = sv_mortalcopy(*mark);
-               TAINT_NOT;      /* Each item is independent */
-           }
-       }
-    }
+    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("given");

diff --git a/proto.h b/proto.h
index 984fc80..d034326 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5706,6 +5706,13 @@ PERL_CALLCONV GV*        Perl_softref2xv(pTHX_ SV *const sv, const char *const what, co
 
 #endif
 #if defined(PERL_IN_PP_CTL_C)
+STATIC SV **   S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE \
+       assert(newsp); assert(sp); assert(mark)
+
 STATIC PerlIO *        S_check_type_and_open(pTHX_ SV *name)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);