PUSHEVAL: make retop a parameter

Rather than doing cx->blk_eval.retop = NULL in PUSHEVAL, then relying on
the caller to subsequently change it to something more useful, make it an
arg to PUSHEVAL.

diff --git a/cop.h b/cop.h
index eb9e3bd..7934484 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -747,7 +747,7 @@ struct block_eval {
 #define CxOLD_IN_EVAL(cx)      (((cx)->blk_u16) & 0x7F)
 #define CxOLD_OP_TYPE(cx)      (((cx)->blk_u16) >> 7)
 
-#define PUSHEVAL(cx,n)                                                 \
+#define PUSHEVAL(cx, op, n)                                            \
     STMT_START {                                                       \
        assert(!(PL_in_eval & ~0x7F));                                  \
        assert(!(PL_op->op_type & ~0x1FF));                             \
@@ -756,7 +756,7 @@ struct block_eval {
        cx->blk_eval.old_eval_root = PL_eval_root;                      \
        cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL;  \
        cx->blk_eval.cv = NULL; /* set by doeval_compile() as applicable */ \
-       cx->blk_eval.retop = NULL;                                      \
+       cx->blk_eval.retop = op;                                        \
        cx->blk_eval.cur_top_env = PL_top_env;                          \
     } STMT_END
 

diff --git a/embed.fnc b/embed.fnc
index f83432d..7f2f7da 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -272,7 +272,7 @@ p   |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o \
 : Used in perly.y
 ApdR   |OP*    |op_convert_list        |I32 optype|I32 flags|NULLOK OP* o
 : Used in op.c and perl.c
-pM     |PERL_CONTEXT*  |create_eval_scope|U32 flags
+pM     |void   |create_eval_scope|NULLOK OP *retop|U32 flags
 Aprd   |void   |croak_sv       |NN SV *baseex
 : croak()'s first parm can be NULL.  Otherwise, mod_perl breaks.
 Afprd  |void   |croak          |NULLOK const char* pat|...

diff --git a/embed.h b/embed.h
index 5bd0489..c4774d4 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1160,7 +1160,7 @@
 #define closest_cop(a,b,c,d)   Perl_closest_cop(aTHX_ a,b,c,d)
 #define core_prototype(a,b,c,d)        Perl_core_prototype(aTHX_ a,b,c,d)
 #define coresub_op(a,b,c)      Perl_coresub_op(aTHX_ a,b,c)
-#define create_eval_scope(a)   Perl_create_eval_scope(aTHX_ a)
+#define create_eval_scope(a,b) Perl_create_eval_scope(aTHX_ a,b)
 #define croak_no_mem           Perl_croak_no_mem
 #define croak_popstack         Perl_croak_popstack
 #define custom_op_get_field(a,b)       Perl_custom_op_get_field(aTHX_ a,b)

diff --git a/op.c b/op.c
index b924da5..d97ebf4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4345,7 +4345,7 @@ S_fold_constants(pTHX_ OP *o)
     PL_op = curop;
 
     old_cxix = cxstack_ix;
-    create_eval_scope(G_FAKINGEVAL);
+    create_eval_scope(NULL, G_FAKINGEVAL);
 
     /* Verify that we don't need to save it:  */
     assert(PL_curcop == &PL_compiling);

diff --git a/perl.c b/perl.c
index c86daa9..9858f16 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2779,7 +2779,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        myop.op_other = (OP*)&myop;
        (void)POPMARK;
         old_cxix = cxstack_ix;
-       create_eval_scope(flags|G_FAKINGEVAL);
+       create_eval_scope(NULL, flags|G_FAKINGEVAL);
        (void)INCMARK;
 
        JMPENV_PUSH(ret);

diff --git a/pp_ctl.c b/pp_ctl.c
index 7272e83..b1452cd 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4043,8 +4043,7 @@ PP(pp_require)
 
     /* switch to eval mode */
     PUSHBLOCK(cx, CXt_EVAL, gimme, SP, old_savestack_ix);
-    PUSHEVAL(cx, name);
-    cx->blk_eval.retop = PL_op->op_next;
+    PUSHEVAL(cx, PL_op->op_next, name);
 
     SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 0);
@@ -4158,8 +4157,7 @@ PP(pp_entereval)
     runcv = find_runcv(&seq);
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix);
-    PUSHEVAL(cx, 0);
-    cx->blk_eval.retop = PL_op->op_next;
+    PUSHEVAL(cx, PL_op->op_next, 0);
 
     /* prepare to compile string */
 
@@ -4282,14 +4280,14 @@ Perl_delete_eval_scope(pTHX)
 
 /* Common-ish code salvaged from Perl_call_sv and pp_entertry, because it was
    also needed by Perl_fold_constants.  */
-PERL_CONTEXT *
-Perl_create_eval_scope(pTHX_ U32 flags)
+void
+Perl_create_eval_scope(pTHX_ OP *retop, U32 flags)
 {
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
        
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), gimme, PL_stack_sp, PL_savestack_ix);
-    PUSHEVAL(cx, 0);
+    PUSHEVAL(cx, retop, 0);
 
     PL_in_eval = EVAL_INEVAL;
     if (flags & G_KEEPERR)
@@ -4299,13 +4297,11 @@ Perl_create_eval_scope(pTHX_ U32 flags)
     if (flags & G_FAKINGEVAL) {
        PL_eval_root = PL_op; /* Only needed so that goto works right. */
     }
-    return cx;
 }
     
 PP(pp_entertry)
 {
-    PERL_CONTEXT * const cx = create_eval_scope(0);
-    cx->blk_eval.retop = cLOGOP->op_other->op_next;
+    create_eval_scope(cLOGOP->op_other->op_next, 0);
     return DOCATCH(PL_op->op_next);
 }
 

diff --git a/proto.h b/proto.h
index 20fd667..941854e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -540,7 +540,7 @@ PERL_CALLCONV SV *  Perl_core_prototype(pTHX_ SV *sv, const char *name, const int
 PERL_CALLCONV OP *     Perl_coresub_op(pTHX_ SV *const coreargssv, const int code, const int opnum);
 #define PERL_ARGS_ASSERT_CORESUB_OP    \
        assert(coreargssv)
-PERL_CALLCONV PERL_CONTEXT*    Perl_create_eval_scope(pTHX_ U32 flags);
+PERL_CALLCONV void     Perl_create_eval_scope(pTHX_ OP *retop, U32 flags);
 PERL_CALLCONV_NO_RET void      Perl_croak(pTHX_ const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);