From 13febba5a2bae013e49242ccd6e373d7e12d0c78 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Wed, 30 Dec 2015 13:23:47 +0000 Subject: [PATCH] convert CX_PUSHEVAL/POPEVAL to inline fns Replace CX_PUSHEVAL() with cx_pusheval() etc. No functional changes. --- cop.h | 29 ----------------------------- embed.fnc | 3 +++ embed.h | 2 ++ inline.h | 38 ++++++++++++++++++++++++++++++++++++++ op.h | 2 +- perl.c | 2 +- pp_ctl.c | 22 +++++++++++----------- proto.h | 6 ++++++ 8 files changed, 62 insertions(+), 42 deletions(-) diff --git a/cop.h b/cop.h index ac0e8b474e..6e90d89115 100644 --- a/cop.h +++ b/cop.h @@ -643,35 +643,6 @@ struct block_eval { #define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F) #define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) -#define CX_PUSHEVAL(cx, op, n) \ - STMT_START { \ - assert(!(PL_in_eval & ~0x7F)); \ - assert(!(PL_op->op_type & ~0x1FF)); \ - cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); \ - cx->blk_eval.old_namesv = (n); \ - 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 = op; \ - cx->blk_eval.cur_top_env = PL_top_env; \ - } STMT_END - -#define CX_POPEVAL(cx) \ - STMT_START { \ - SV *sv; \ - assert(CxTYPE(cx) == CXt_EVAL); \ - PL_in_eval = CxOLD_IN_EVAL(cx); \ - PL_eval_root = cx->blk_eval.old_eval_root; \ - sv = cx->blk_eval.cur_text; \ - if (sv && SvSCREAM(sv)) { \ - cx->blk_eval.cur_text = NULL; \ - SvREFCNT_dec_NN(sv); \ - } \ - sv = cx->blk_eval.old_namesv; \ - if (sv && !SvTEMP(sv))/* TEMP implies CX_POPEVAL re-entrantly called */ \ - sv_2mortal(sv); \ - } STMT_END - /* loop context */ struct block_loop { LOOP * my_op; /* My op, that contains redo, next and last ops. */ diff --git a/embed.fnc b/embed.fnc index 4ed7de18b7..bd0ae356df 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2892,6 +2892,9 @@ AiM |void |cx_popsub |NN PERL_CONTEXT *cx AiM |void |cx_pushformat |NN PERL_CONTEXT *cx|NN CV *cv \ |NULLOK OP *retop|NULLOK GV *gv AiM |void |cx_popformat |NN PERL_CONTEXT *cx +AiM |void |cx_pusheval |NN PERL_CONTEXT *cx \ + |NULLOK OP *retop|NULLOK SV *namesv +AiM |void |cx_popeval |NN PERL_CONTEXT *cx #endif : ex: set ts=8 sts=4 sw=4 noet: diff --git a/embed.h b/embed.h index 6833eef7ee..a48e96c6ab 100644 --- a/embed.h +++ b/embed.h @@ -779,11 +779,13 @@ #define append_utf8_from_native_byte S_append_utf8_from_native_byte #define av_top_index(a) S_av_top_index(aTHX_ a) #define cx_popblock(a) S_cx_popblock(aTHX_ a) +#define cx_popeval(a) S_cx_popeval(aTHX_ a) #define cx_popformat(a) S_cx_popformat(aTHX_ a) #define cx_popsub(a) S_cx_popsub(aTHX_ a) #define cx_popsub_args(a) S_cx_popsub_args(aTHX_ a) #define cx_popsub_common(a) S_cx_popsub_common(aTHX_ a) #define cx_pushblock(a,b,c,d) S_cx_pushblock(aTHX_ a,b,c,d) +#define cx_pusheval(a,b,c) S_cx_pusheval(aTHX_ a,b,c) #define cx_pushformat(a,b,c,d) S_cx_pushformat(aTHX_ a,b,c,d) #define cx_pushsub(a,b,c,d) S_cx_pushsub(aTHX_ a,b,c,d) #define cx_topblock(a) S_cx_topblock(aTHX_ a) diff --git a/inline.h b/inline.h index 4b6e7bb71d..f71e28e60d 100644 --- a/inline.h +++ b/inline.h @@ -599,6 +599,44 @@ S_cx_popformat(pTHX_ PERL_CONTEXT *cx) } +PERL_STATIC_INLINE void +S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv) +{ + PERL_ARGS_ASSERT_CX_PUSHEVAL; + + cx->blk_eval.retop = retop; + cx->blk_eval.old_namesv = namesv; + 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; /* later set by doeval_compile() */ + cx->blk_eval.cur_top_env = PL_top_env; + + assert(!(PL_in_eval & ~ 0x7F)); + assert(!(PL_op->op_type & ~0x1FF)); + cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); +} + + +PERL_STATIC_INLINE void +S_cx_popeval(pTHX_ PERL_CONTEXT *cx) +{ + SV *sv; + + PERL_ARGS_ASSERT_CX_POPEVAL; + assert(CxTYPE(cx) == CXt_EVAL); + + PL_in_eval = CxOLD_IN_EVAL(cx); + PL_eval_root = cx->blk_eval.old_eval_root; + sv = cx->blk_eval.cur_text; + if (sv && SvSCREAM(sv)) { + cx->blk_eval.cur_text = NULL; + SvREFCNT_dec_NN(sv); + } + + sv = cx->blk_eval.old_namesv; + if (sv && !SvTEMP(sv))/* TEMP implies cx_popeval() re-entrantly called */ + sv_2mortal(sv); +} /* diff --git a/op.h b/op.h index 676dd48ecb..00d9a4c88f 100644 --- a/op.h +++ b/op.h @@ -67,7 +67,7 @@ typedef PERL_BITFIELD16 Optype; U8 op_private; #endif -/* If op_type:9 is changed to :10, also change CX_PUSHEVAL in cop.h. +/* If op_type:9 is changed to :10, also change cx_pusheval() Also, if the type of op_type is ever changed (e.g. to PERL_BITFIELD32) then all the other bit-fields before/after it should change their types too to let VC pack them into the same 4 byte integer.*/ diff --git a/perl.c b/perl.c index de454552b4..4a324c612f 100644 --- a/perl.c +++ b/perl.c @@ -2893,7 +2893,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) myop.op_private = (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING); /* fail now; otherwise we could fail after the JMPENV_PUSH but - * before a CX_PUSHEVAL, which corrupts the stack after a croak */ + * before a cx_pusheval(), which corrupts the stack after a croak */ TAINT_PROPER("eval_sv()"); JMPENV_PUSH(ret); diff --git a/pp_ctl.c b/pp_ctl.c index 6c02bbf51e..8a259d443e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1534,7 +1534,7 @@ Perl_dounwind(pTHX_ I32 cxix) cx_popsub(cx); break; case CXt_EVAL: - CX_POPEVAL(cx); + cx_popeval(cx); break; case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: @@ -1692,7 +1692,7 @@ Perl_die_unwind(pTHX_ SV *msv) PL_stack_sp = oldsp; CX_LEAVE_SCOPE(cx); - CX_POPEVAL(cx); + cx_popeval(cx); cx_popblock(cx); restartjmpenv = cx->blk_eval.cur_top_env; restartop = cx->blk_eval.retop; @@ -3400,7 +3400,7 @@ S_doeval_compile(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) SP = PL_stack_base + POPMARK; /* pop original mark */ cx = CX_CUR(); CX_LEAVE_SCOPE(cx); - CX_POPEVAL(cx); + cx_popeval(cx); cx_popblock(cx); if (in_require) namesv = cx->blk_eval.old_namesv; @@ -4046,7 +4046,7 @@ PP(pp_require) /* switch to eval mode */ cx = cx_pushblock(CXt_EVAL, gimme, SP, old_savestack_ix); - CX_PUSHEVAL(cx, PL_op->op_next, newSVpv(name, 0)); + cx_pusheval(cx, PL_op->op_next, newSVpv(name, 0)); SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 0); @@ -4160,7 +4160,7 @@ PP(pp_entereval) runcv = find_runcv(&seq); cx = cx_pushblock((CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix); - CX_PUSHEVAL(cx, PL_op->op_next, NULL); + cx_pusheval(cx, PL_op->op_next, NULL); /* prepare to compile string */ @@ -4211,7 +4211,7 @@ PP(pp_leaveeval) OP *retop; SV *namesv = NULL; CV *evalcv; - /* grab this value before CX_POPEVAL restores old PL_in_eval */ + /* grab this value before cx_popeval restores old PL_in_eval */ bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR); PERL_ASYNC_CHECK(); @@ -4235,7 +4235,7 @@ PP(pp_leaveeval) else leave_adjust_stacks(oldsp, oldsp, gimme, 0); - /* the CX_POPEVAL does a leavescope, which frees the optree associated + /* the cx_popeval does a leavescope, which frees the optree associated * with eval, which if it frees the nextstate associated with * PL_curcop, sets PL_curcop to NULL. Which can mess up freeing a * regex when running under 'use re Debug' because it needs PL_curcop @@ -4244,7 +4244,7 @@ PP(pp_leaveeval) PL_curcop = cx->blk_oldcop; CX_LEAVE_SCOPE(cx); - CX_POPEVAL(cx); + cx_popeval(cx); cx_popblock(cx); retop = cx->blk_eval.retop; evalcv = cx->blk_eval.cv; @@ -4276,7 +4276,7 @@ Perl_delete_eval_scope(pTHX) cx = CX_CUR(); CX_LEAVE_SCOPE(cx); - CX_POPEVAL(cx); + cx_popeval(cx); cx_popblock(cx); CX_POP(cx); } @@ -4291,7 +4291,7 @@ Perl_create_eval_scope(pTHX_ OP *retop, U32 flags) cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme, PL_stack_sp, PL_savestack_ix); - CX_PUSHEVAL(cx, retop, NULL); + cx_pusheval(cx, retop, NULL); PL_in_eval = EVAL_INEVAL; if (flags & G_KEEPERR) @@ -4328,7 +4328,7 @@ PP(pp_leavetry) else leave_adjust_stacks(oldsp, oldsp, gimme, 1); CX_LEAVE_SCOPE(cx); - CX_POPEVAL(cx); + cx_popeval(cx); cx_popblock(cx); retop = cx->blk_eval.retop; CX_POP(cx); diff --git a/proto.h b/proto.h index a7998424c4..052e766308 100644 --- a/proto.h +++ b/proto.h @@ -3721,6 +3721,9 @@ PERL_STATIC_INLINE SSize_t S_av_top_index(pTHX_ AV *av) PERL_STATIC_INLINE void S_cx_popblock(pTHX_ PERL_CONTEXT *cx); #define PERL_ARGS_ASSERT_CX_POPBLOCK \ assert(cx) +PERL_STATIC_INLINE void S_cx_popeval(pTHX_ PERL_CONTEXT *cx); +#define PERL_ARGS_ASSERT_CX_POPEVAL \ + assert(cx) PERL_STATIC_INLINE void S_cx_popformat(pTHX_ PERL_CONTEXT *cx); #define PERL_ARGS_ASSERT_CX_POPFORMAT \ assert(cx) @@ -3736,6 +3739,9 @@ PERL_STATIC_INLINE void S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx); PERL_STATIC_INLINE PERL_CONTEXT * S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix); #define PERL_ARGS_ASSERT_CX_PUSHBLOCK \ assert(sp) +PERL_STATIC_INLINE void S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv); +#define PERL_ARGS_ASSERT_CX_PUSHEVAL \ + assert(cx) PERL_STATIC_INLINE void S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv); #define PERL_ARGS_ASSERT_CX_PUSHFORMAT \ assert(cx); assert(cv)