In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2fc507dc6e9213ee1f33bcb2741127ffb19ec694?hp=c77ed9ca79ef772961f511a2176824386a19b6d1>
- Log ----------------------------------------------------------------- commit 2fc507dc6e9213ee1f33bcb2741127ffb19ec694 Author: Father Chrysostomos <[email protected]> Date: Thu Sep 18 18:08:06 2014 -0700 Rename S_adjust_stack_on_leave It now does more than that, so use a name that describes when it is called, rather than what it does. M embed.fnc M embed.h M pp_ctl.c M proto.h commit 80dd201b1d988a0f948dec8b25f624b4007aca59 Author: Daniel Dragan <[email protected]> Date: Mon Jun 16 05:53:08 2014 -0400 factor out TAINT_NOT into S_adjust_stack_on_leave All callers of S_adjust_stack_on_leave had TAINT_NOT before the call to S_adjust_stack_on_leave. Factor it into the func to make the callers smallers machine code wise. More things can be factored out into adjust_stack_on_leave from its callers, but this particular change is very easy. M pp_ctl.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- pp_ctl.c | 31 ++++++++++++++++--------------- proto.h | 14 +++++++------- 4 files changed, 25 insertions(+), 24 deletions(-) diff --git a/embed.fnc b/embed.fnc index da38ec1..1214bf7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2041,7 +2041,7 @@ sR |PerlIO *|check_type_and_open|NN SV *name #ifndef PERL_DISABLE_PMC sR |PerlIO *|doopen_pm |NN SV *name #endif -s |SV ** |adjust_stack_on_leave|NN SV **newsp|NN SV **sp|NN SV **mark|I32 gimme \ +s |SV ** |leave_common |NN SV **newsp|NN SV **sp|NN SV **mark|I32 gimme \ |U32 flags|bool lvalue iRn |bool |path_is_searchable|NN const char *name sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen diff --git a/embed.h b/embed.h index 47a2b0f..c658570 100644 --- a/embed.h +++ b/embed.h @@ -1568,7 +1568,6 @@ #define refto(a) S_refto(aTHX_ a) # endif # if defined(PERL_IN_PP_CTL_C) -#define adjust_stack_on_leave(a,b,c,d,e,f) S_adjust_stack_on_leave(aTHX_ a,b,c,d,e,f) #define check_type_and_open(a) S_check_type_and_open(aTHX_ a) #define destroy_matcher(a) S_destroy_matcher(aTHX_ a) #define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c) @@ -1582,6 +1581,7 @@ #define dopoptoloop(a) S_dopoptoloop(aTHX_ a) #define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b) #define dopoptowhen(a) S_dopoptowhen(aTHX_ a) +#define leave_common(a,b,c,d,e,f) S_leave_common(aTHX_ a,b,c,d,e,f) #define make_matcher(a) S_make_matcher(aTHX_ a) #define matcher_matches_sv(a,b) S_matcher_matches_sv(aTHX_ a,b) #define num_overflow S_num_overflow diff --git a/pp_ctl.c b/pp_ctl.c index 95ba848..d5c8d7e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1978,17 +1978,24 @@ PP(pp_dbstate) return NORMAL; } +/* S_leave_common: Common code that many functions in this file use on + scope exit. */ + /* SVs on the stack that have any of the flags passed in are left as is. Other SVs are protected via the mortals stack if lvalue is true, and - copied otherwise. */ + copied otherwise. + + Also, taintedness is cleared. +*/ STATIC SV ** -S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, +S_leave_common(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags, bool lvalue) { bool padtmp = 0; - PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE; + PERL_ARGS_ASSERT_LEAVE_COMMON; + TAINT_NOT; if (flags & SVs_PADTMP) { flags &= ~SVs_PADTMP; padtmp = 1; @@ -2058,8 +2065,7 @@ PP(pp_leave) gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR); - TAINT_NOT; - SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP, + SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP, PL_op->op_private & OPpLVALUE); PL_curpm = newpm; /* Don't pop $1 et al till now */ @@ -2221,8 +2227,7 @@ PP(pp_leaveloop) mark = newsp; newsp = PL_stack_base + cx->blk_loop.resetsp; - TAINT_NOT; - SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0, + SP = leave_common(newsp, SP, MARK, gimme, 0, PL_op->op_private & OPpLVALUE); PUTBACK; @@ -4280,8 +4285,7 @@ PP(pp_leaveeval) retop = cx->blk_eval.retop; evalcv = cx->blk_eval.cv; - TAINT_NOT; - SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp, + SP = leave_common((gimme == G_VOID) ? SP : newsp, SP, newsp, gimme, SVs_TEMP, FALSE); PL_curpm = newpm; /* Don't pop $1 et al till now */ @@ -4378,8 +4382,7 @@ PP(pp_leavetry) POPEVAL(cx); PERL_UNUSED_VAR(optype); - TAINT_NOT; - SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, + SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE); PL_curpm = newpm; /* Don't pop $1 et al till now */ @@ -4425,8 +4428,7 @@ PP(pp_leavegiven) POPBLOCK(cx,newpm); assert(CxTYPE(cx) == CXt_GIVEN); - TAINT_NOT; - SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, + SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE); PL_curpm = newpm; /* Don't pop $1 et al till now */ @@ -4999,8 +5001,7 @@ PP(pp_leavewhen) POPBLOCK(cx,newpm); assert(CxTYPE(cx) == CXt_WHEN); - TAINT_NOT; - SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, + SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE); PL_curpm = newpm; /* pop $1 et al */ diff --git a/proto.h b/proto.h index 4c83158..a0b5c43 100644 --- a/proto.h +++ b/proto.h @@ -6425,13 +6425,6 @@ PERL_CALLCONV GV* Perl_softref2xv(pTHX_ SV *const sv, const char *const what, co #endif #if defined(PERL_IN_PP_CTL_C) -STATIC SV ** S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags, bool lvalue) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_3); -#define PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE \ - assert(newsp); assert(sp); assert(mark) - STATIC PerlIO * S_check_type_and_open(pTHX_ SV *name) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); @@ -6486,6 +6479,13 @@ STATIC I32 S_dopoptosub_at(pTHX_ const PERL_CONTEXT* cxstk, I32 startingblock) STATIC I32 S_dopoptowhen(pTHX_ I32 startingblock) __attribute__warn_unused_result__; +STATIC SV ** S_leave_common(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags, bool lvalue) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); +#define PERL_ARGS_ASSERT_LEAVE_COMMON \ + assert(newsp); assert(sp); assert(mark) + STATIC PMOP* S_make_matcher(pTHX_ REGEXP* re) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); -- Perl5 Master Repository
