This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_given: avoid using savestack for old var
authorDavid Mitchell <davem@iabyn.com>
Fri, 2 Oct 2015 16:28:00 +0000 (17:28 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 08:59:39 +0000 (08:59 +0000)
Add a new field, defsv_save, to struct block_givwhen, and use this
to save the previous $_ in 'when(expr)' rather than saving it on the save
stack.

Also add POPWHEN and POPGIVEN macros. The former is a no-op for now.

cop.h
pp_ctl.c

diff --git a/cop.h b/cop.h
index a01ddda..d455478 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -836,12 +836,23 @@ struct block_loop {
 /* given/when context */
 struct block_givwhen {
        OP *leave_op;
+        SV *defsv_save; /* the original $_ */
 };
 
-#define PUSHGIVEN(cx)                                                  \
+#define PUSHWHEN(cx)                                                   \
        cx->blk_givwhen.leave_op = cLOGOP->op_other;
 
-#define PUSHWHEN PUSHGIVEN
+#define PUSHGIVEN(cx, orig_var)                                         \
+        PUSHWHEN(cx);                                                   \
+        cx->blk_givwhen.defsv_save = orig_var;
+
+#define POPWHEN(cx)                                                     \
+        NOOP;
+
+#define POPGIVEN(cx)                                                    \
+        SvREFCNT_dec(GvSV(PL_defgv));                                   \
+        GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;
+
 
 /* context common to subroutines, evals and loops */
 struct block {
index 713198d..a1e7329 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1528,6 +1528,12 @@ Perl_dounwind(pTHX_ I32 cxix)
        case CXt_LOOP_PLAIN:
            POPLOOP(cx);
            break;
+       case CXt_WHEN:
+           POPWHEN(cx);
+           break;
+       case CXt_GIVEN:
+           POPGIVEN(cx);
+           break;
        case CXt_NULL:
            break;
        case CXt_FORMAT:
@@ -4409,16 +4415,17 @@ PP(pp_entergiven)
     dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
+    SV *origsv = DEFSV;
+    SV *newsv = POPs;
     
     ENTER_with_name("given");
     SAVETMPS;
 
     assert(!PL_op->op_targ); /* used to be set for lexical $_ */
-    SAVE_DEFSV;
-    DEFSV_set(POPs);
+    GvSV(PL_defgv) = SvREFCNT_inc(newsv);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
-    PUSHGIVEN(cx);
+    PUSHGIVEN(cx, origsv);
 
     RETURN;
 }
@@ -4433,6 +4440,7 @@ PP(pp_leavegiven)
     PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);
+    POPGIVEN(cx);
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     SP = (gimme == G_VOID)
@@ -5020,6 +5028,7 @@ PP(pp_leavewhen)
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
+    POPWHEN(cx);
 
     SP = (gimme == G_VOID)
         ? newsp