mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

convert CX_PUSHEVAL/POPEVAL to inline fns

Browse Source 
Replace CX_PUSHEVAL() with cx_pusheval() etc.

No functional changes.
This commit is contained in:
David Mitchell 2015-12-30 13:23:47 +00:00
parent 6a7d52ccb6
commit 13febba5a2
8 changed files with 62 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
cop.h
View File

@ -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. */

3
embed.fnc
View File

@ -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:

2
embed.h
View File

@ -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)

38
inline.h
View File

@ -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);
}
/*

2
op.h
View File

@ -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.*/

2
perl.c
View File

@ -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);

22
pp_ctl.c
View File

@ -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);

6
proto.h
View File

@ -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)