This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POPBLOCK: don't set newsp and gimme
authorDavid Mitchell <davem@iabyn.com>
Sat, 10 Oct 2015 21:23:19 +0000 (22:23 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 08:59:40 +0000 (08:59 +0000)
This macro used to set these two vars as a side-effect.
Since we now usually access those values before we call POPBLOCK,
it's wasteful to set them again.

cop.h
pp_ctl.c
pp_sort.c
pp_sys.c

diff --git a/cop.h b/cop.h
index 0798752..d637a6d 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -938,12 +938,10 @@ struct block {
 #define POPBLOCK(cx,pm)                                                        \
        DEBUG_CX("POP");                                                \
        cx = &cxstack[cxstack_ix--],                                    \
-       newsp            = PL_stack_base + cx->blk_oldsp,               \
        PL_curcop        = cx->blk_oldcop,                              \
        PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
        PL_scopestack_ix = cx->blk_oldscopesp,                          \
-       pm               = cx->blk_oldpm,                               \
-       gimme            = cx->blk_gimme;
+       pm               = cx->blk_oldpm;
 
 /* Continue a block elsewhere (NEXT and REDO). */
 #define TOPBLOCK(cx)                                                   \
@@ -1313,6 +1311,9 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
         CvDEPTH(multicall_cv) = cx->blk_sub.olddepth;                   \
         LEAVESUB(multicall_cv);                                        \
        POPBLOCK(cx,PL_curpm);                                          \
+        /* these two set for backcompat by callers */                   \
+        newsp = PL_stack_base + cx->blk_oldsp;                          \
+        gimme = cx->blk_gimme;                                          \
         /* includes partial unrolled POPSUB(): */                       \
        LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);             \
         PL_comppad = cx->blk_sub.prevcomppad;                           \
index 273725b..cb8a007 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1578,7 +1578,6 @@ Perl_die_unwind(pTHX_ SV *msv)
 
     if (in_eval) {
        I32 cxix;
-       I32 gimme;
 
        /*
         * Historically, perl used to set ERRSV ($@) early in the die
@@ -1631,6 +1630,7 @@ Perl_die_unwind(pTHX_ SV *msv)
            SV *namesv;
            PERL_CONTEXT *cx;
            SV **newsp;
+            I32 gimme;
 #ifdef DEBUGGING
            COP *oldcop;
 #endif
@@ -1640,7 +1640,16 @@ Perl_die_unwind(pTHX_ SV *msv)
            if (cxix < cxstack_ix)
                dounwind(cxix);
 
-           POPBLOCK(cx,PL_curpm);
+            cx = &cxstack[cxstack_ix];
+            assert(CxTYPE(cx) == CXt_EVAL);
+            newsp = PL_stack_base + cx->blk_oldsp;
+            gimme = cx->blk_gimme;
+
+           if (gimme == G_SCALAR)
+               *++newsp = &PL_sv_undef;
+           PL_stack_sp = newsp;
+
+
            if (CxTYPE(cx) != CXt_EVAL) {
                STRLEN msglen;
                const char* message = SvPVx_const(exceptsv, msglen);
@@ -1648,6 +1657,8 @@ Perl_die_unwind(pTHX_ SV *msv)
                PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
            }
+
+           POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
 #ifdef DEBUGGING
@@ -1656,10 +1667,6 @@ Perl_die_unwind(pTHX_ SV *msv)
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop = cx->blk_eval.retop;
 
-           if (gimme == G_SCALAR)
-               *++newsp = &PL_sv_undef;
-           PL_stack_sp = newsp;
-
             LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
             PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
 
@@ -2556,9 +2563,7 @@ S_unwind_loop(pTHX_ const char * const opname)
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
-    I32 gimme;
     OP *nextop = NULL;
-    SV **newsp;
     PMOP *newpm;
 
     S_unwind_loop(aTHX_ "last");
@@ -2571,18 +2576,16 @@ PP(pp_last)
         || CxTYPE(cx) == CXt_LOOP_FOR
         || CxTYPE(cx) == CXt_LOOP_PLAIN
     );
-    newsp = PL_stack_base + cx->blk_loop.resetsp;
+    PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp;
     nextop = cx->blk_loop.my_op->op_lastop->op_next;
 
     TAINT_NOT;
-    PL_stack_sp = newsp;
 
     cxstack_ix--;
     /* Stack values are safe: */
     POPLOOP(cx);       /* release loop vars ... */
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
-    PERL_UNUSED_VAR(gimme);
     return nextop;
 }
 
@@ -2812,15 +2815,10 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            if (CvISXSUB(cv)) {
-               SV **newsp;
-               I32 gimme;
                const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
                const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
                SV** mark;
 
-                PERL_UNUSED_VAR(newsp);
-                PERL_UNUSED_VAR(gimme);
-
                 ENTER;
                 SAVETMPS;
                 SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
@@ -3427,7 +3425,6 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
     yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX_ GRAMPROG) : yyparse(GRAMPROG);
 
     if (yystatus || PL_parser->error_count || !PL_eval_root) {
-       SV **newsp;                     /* Used by POPBLOCK. */
        PERL_CONTEXT *cx;
        I32 optype;                     /* Used by POPEVAL. */
        SV *namesv;
@@ -3435,7 +3432,6 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 
        cx = NULL;
        namesv = NULL;
-       PERL_UNUSED_VAR(newsp);
        PERL_UNUSED_VAR(optype);
 
        /* note that if yystatus == 3, then the EVAL CX block has already
@@ -4328,9 +4324,7 @@ PP(pp_leaveeval)
 void
 Perl_delete_eval_scope(pTHX)
 {
-    SV **newsp;
     PMOP *newpm;
-    I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
        
@@ -4339,8 +4333,6 @@ Perl_delete_eval_scope(pTHX)
     PL_curpm = newpm;
     LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
     PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
-    PERL_UNUSED_VAR(newsp);
-    PERL_UNUSED_VAR(gimme);
     PERL_UNUSED_VAR(optype);
 }
 
@@ -5056,11 +5048,8 @@ PP(pp_continue)
     dSP;
     I32 cxix;
     PERL_CONTEXT *cx;
-    I32 gimme;
-    SV **newsp;
     PMOP *newpm;
 
-    PERL_UNUSED_VAR(gimme);
     
     cxix = dopoptowhen(cxstack_ix); 
     if (cxix < 0)   
@@ -5073,7 +5062,7 @@ PP(pp_continue)
     assert(CxTYPE(cx) == CXt_WHEN);
     POPWHEN(cx);
 
-    SP = newsp;
+    SP = PL_stack_base + cx->blk_oldsp;
     PL_curpm = newpm;   /* pop $1 et al */
 
     RETURNOP(cx->blk_givwhen.leave_op->op_next);
index bfd7fa2..fbbf848 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1640,7 +1640,6 @@ PP(pp_sort)
        SV **start;
        if (PL_sortcop) {
            PERL_CONTEXT *cx;
-           SV** newsp;
            const bool oldcatch = CATCH_GET;
             I32 old_savestack_ix = PL_savestack_ix;
 
@@ -1720,7 +1719,7 @@ PP(pp_sort)
                 PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
 
            POPBLOCK(cx,PL_curpm);
-           PL_stack_sp = newsp;
+           PL_stack_sp = PL_stack_base + cx->blk_oldsp;
            POPSTACK;
            CATCH_SET(oldcatch);
        }
index 62287b9..d54eb38 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1444,8 +1444,6 @@ PP(pp_leavewrite)
     IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
-    SV **newsp;
-    I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
     bool is_return = cBOOL(PL_op->op_type == OP_RETURN);
@@ -1525,7 +1523,7 @@ PP(pp_leavewrite)
     POPBLOCK(cx,PL_curpm);
     retop = cx->blk_sub.retop;
     POPFORMAT(cx);
-    SP = newsp; /* ignore retval of formline */
+    SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
 
     if (is_return)
         /* XXX the semantics of doing 'return' in a format aren't documented.
@@ -1556,7 +1554,6 @@ PP(pp_leavewrite)
        }
     }
     PL_formtarget = PL_bodytarget;
-    PERL_UNUSED_VAR(gimme);
     RETURNOP(retop);
 }