pp_given: avoid using savestack for old var

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.

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;
 /* 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;
 
        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 {
 
 /* context common to subroutines, evals and loops */
 struct block {

diff --git a/pp_ctl.c b/pp_ctl.c
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_LOOP_PLAIN:
            POPLOOP(cx);
            break;

+       case CXt_WHEN:
+           POPWHEN(cx);
+           break;
+       case CXt_GIVEN:
+           POPGIVEN(cx);
+           break;

        case CXt_NULL:
            break;
        case CXt_FORMAT:
        case CXt_NULL:
            break;
        case CXt_FORMAT:


@@ -4409,16 +4415,17 @@ PP(pp_entergiven)
     dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     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 $_ */
     
     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);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);

-    PUSHGIVEN(cx);
+    PUSHGIVEN(cx, origsv);

 
     RETURN;
 }
 
     RETURN;
 }


@@ -4433,6 +4440,7 @@ PP(pp_leavegiven)
     PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);
     PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);

+    POPGIVEN(cx);

     assert(CxTYPE(cx) == CXt_GIVEN);
 
     SP = (gimme == G_VOID)
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     SP = (gimme == G_VOID)


@@ -5020,6 +5028,7 @@ PP(pp_leavewhen)
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);

+    POPWHEN(cx);

 
     SP = (gimme == G_VOID)
         ? newsp
 
     SP = (gimme == G_VOID)
         ? newsp