In perl.git, the branch smoke-me/nicholas/redundant-SPAGAIN has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/51cb11852e6113680ca9f0848f045135e0c88104?hp=498b759bd12b378c541fc401200803b8c88c4a9b> - Log ----------------------------------------------------------------- commit 51cb11852e6113680ca9f0848f045135e0c88104 Author: Nicholas Clark <[email protected]> Date: Fri Oct 4 15:33:49 2013 +0200 No need to wrap calls to Perl_load_module() in ENTER/LEAVE As of commit 53a7735b62aee146 (May 2007) Perl_vload_module() wraps its call to Perl_utilize() with ENTER/LEAVE, so there's no longer a need for callers of Perl_load_module() to also wrap with ENTER/LEAVE. M ext/PerlIO-encoding/encoding.xs M op.c commit 59c3b2c46facb363d8e241332f5c21f8ef9645e6 Author: Nicholas Clark <[email protected]> Date: Fri Oct 4 15:15:56 2013 +0200 Perl_load_module() no longer moves the current stack, so no need to save it. M ext/PerlIO-encoding/encoding.xs M ext/Win32CORE/Win32CORE.c M gv.c M toke.c commit de8cfec82bd47cfce1435625294ae2d23994d4ea Author: Nicholas Clark <[email protected]> Date: Fri Oct 4 14:54:00 2013 +0200 S_process_special_blocks() should use a new stack for BEGIN blocks. This avoids the stack moving underneath anything that directly or indirectly calls Perl_load_module(). M op.c commit 2c9589ac49f5241a2312cf568bd2d2bd3fa87eca Author: Nicholas Clark <[email protected]> Date: Fri Oct 4 13:28:58 2013 +0200 Remove redundant SPAGAIN & PUTBACK after PUSHSTACKi(). PUSHSTACKi() calls SWITCHSTACK(), which sets PL_stack_sp and sp like this: sp = PL_stack_sp = PL_stack_base + AvFILLp(t) Hence after PUSHSTACKi() both are identical, so use of SPAGAIN or PUTBACK to assign one to the other is redundant. The use of SPAGAIN in encoding.xs and via.xs was added with commit 24f59afc531955e5 (April 2002) which added the use of PUSHSTACKi(). It feels like cargo-cult. The use of PUTBACK in Perl_amagic_call() predates the introduction of nested stacks and PUSHSTACKi() in commit e336de0d01f30cc4 (April 1998). It dates from perl 5.000, but it's not clear that it was ever needed, as the code in question looked like this, and nothing could have moved the stack between the dSP and PUTBACK: dSP; BINOP myop; SV* res; Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; myop.op_flags = OPf_KNOW|OPf_STACKED; ENTER; SAVESPTR(op); op = (OP *) &myop; PUTBACK; The PUTBACK and SPAGAIN in Perl_require_pv() were added by commit d3acc0f7e5197310 (June 1998) which also added the PUSHSTACKi(). They have both been redundant since they were added. M ext/PerlIO-encoding/encoding.pm M ext/PerlIO-encoding/encoding.xs M ext/PerlIO-via/via.pm M ext/PerlIO-via/via.xs M gv.c M perl.c ----------------------------------------------------------------------- Summary of changes: ext/PerlIO-encoding/encoding.pm | 2 +- ext/PerlIO-encoding/encoding.xs | 13 +------------ ext/PerlIO-via/via.pm | 2 +- ext/PerlIO-via/via.xs | 1 - ext/Win32CORE/Win32CORE.c | 2 +- gv.c | 6 +++--- op.c | 10 +++++----- perl.c | 2 -- toke.c | 2 +- 9 files changed, 13 insertions(+), 27 deletions(-) diff --git a/ext/PerlIO-encoding/encoding.pm b/ext/PerlIO-encoding/encoding.pm index e270819..e3291a5 100644 --- a/ext/PerlIO-encoding/encoding.pm +++ b/ext/PerlIO-encoding/encoding.pm @@ -1,7 +1,7 @@ package PerlIO::encoding; use strict; -our $VERSION = '0.16'; +our $VERSION = '0.17'; our $DEBUG = 0; $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 2d06d82..f522ef1 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -60,7 +60,6 @@ PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) dSP; /* Not 100% sure stack swap is right thing to do during dup ... */ PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; ENTER; SAVETMPS; PUSHMARK(sp); @@ -87,8 +86,6 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * SV *result = Nullsv; PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; - ENTER; SAVETMPS; @@ -239,7 +236,6 @@ PerlIOEncode_fill(pTHX_ PerlIO * f) } } PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; ENTER; SAVETMPS; retry: @@ -413,7 +409,6 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) if (e->inEncodeCall) return 0; /* Write case - encode the buffer and write() to layer below */ PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; ENTER; SAVETMPS; PUSHMARK(sp); @@ -476,7 +471,6 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) re-encode and unread() to layer below */ PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; ENTER; SAVETMPS; str = sv_newmortal(); @@ -650,19 +644,14 @@ BOOT: * is invoked without prior "use Encode". -- dankogai */ PUSHSTACKi(PERLSI_MAGIC); - SPAGAIN; if (!get_cvs(OUR_DEFAULT_FB, 0)) { #if 0 /* This would just be an irritant now loading works */ Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'"); #endif - ENTER; - /* Encode needs a lot of stack - it is likely to move ... */ - PUTBACK; /* The SV is magically freed by load_module */ load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Encode", 6), Nullsv, Nullsv); - SPAGAIN; - LEAVE; + assert(sp == PL_stack_sp); } PUSHMARK(sp); PUTBACK; diff --git a/ext/PerlIO-via/via.pm b/ext/PerlIO-via/via.pm index 601be80..2fa37b1 100644 --- a/ext/PerlIO-via/via.pm +++ b/ext/PerlIO-via/via.pm @@ -1,5 +1,5 @@ package PerlIO::via; -our $VERSION = '0.12'; +our $VERSION = '0.13'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs index 56889bf..21f0629 100644 --- a/ext/PerlIO-via/via.xs +++ b/ext/PerlIO-via/via.xs @@ -79,7 +79,6 @@ PerlIOVia_method(pTHX_ PerlIO * f, const char *method, CV ** save, int flags, SV *arg; PUSHSTACKi(PERLSI_MAGIC); ENTER; - SPAGAIN; PUSHMARK(sp); XPUSHs(s->obj); while ((arg = va_arg(ap, SV *))) { diff --git a/ext/Win32CORE/Win32CORE.c b/ext/Win32CORE/Win32CORE.c index b318fcc..db58514 100644 --- a/ext/Win32CORE/Win32CORE.c +++ b/ext/Win32CORE/Win32CORE.c @@ -32,7 +32,7 @@ XS(w32_CORE_all){ const char *function = (const char *) XSANY.any_ptr; Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), newSVnv(0.27)); SetLastError(err); - SPAGAIN; + assert(sp == PL_stack_sp); PUSHMARK(SP-items); call_pv(function, GIMME_V); } diff --git a/gv.c b/gv.c index 9f0b57e..b28ec81 100644 --- a/gv.c +++ b/gv.c @@ -1254,14 +1254,15 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp so save it. For the moment it's always a single char. */ const char type = varname == '[' ? '$' : '%'; +#ifdef DEBUGGING dSP; +#endif ENTER; SAVEFREESV(namesv); if ( flags & 1 ) save_scalar(gv); - PUSHSTACKi(PERLSI_MAGIC); Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL); - POPSTACK; + assert(sp == PL_stack_sp); stash = gv_stashsv(namesv, 0); if (!stash) Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available", @@ -3172,7 +3173,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) PL_op = (OP *) &myop; if (PERLDB_SUB && PL_curstash != PL_debstash) PL_op->op_private |= OPpENTERSUB_DB; - PUTBACK; Perl_pp_pushmark(aTHX); EXTEND(SP, notfound + 5); diff --git a/op.c b/op.c index 29c9467..025cdb8 100644 --- a/op.c +++ b/op.c @@ -2548,7 +2548,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) PERL_ARGS_ASSERT_APPLY_ATTRS; /* fake up C<use attributes $pkg,$rv,@attrs> */ - ENTER; /* need to protect against side-effects of 'use' */ #define ATTRSMODULE "attributes" #define ATTRSMODULE_PM "attributes.pm" @@ -2562,7 +2561,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) newSVOP(OP_CONST, 0, newRV(target)), dup_attrlist(attrs)))); - LEAVE; } STATIC void @@ -2582,7 +2580,6 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) target->op_type == OP_PADAV); /* Ensure that attributes.pm is loaded. */ - ENTER; /* need to protect against side-effects of 'use' */ /* Don't force the C<use> if we don't need it. */ svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE); if (svp && *svp != &PL_sv_undef) @@ -2590,7 +2587,6 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) else Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs(ATTRSMODULE), NULL); - LEAVE; /* Need package name for method call. */ pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE)); @@ -5366,7 +5362,8 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) * that it has a PL_parser to play with while doing that, and also * that it doesn't mess with any existing parser, by creating a tmp * new parser with lex_start(). This won't actually be used for much, - * since pp_require() will create another parser for the real work. */ + * since pp_require() will create another parser for the real work. + * The ENTER/LEAVE pair protect callers from any side effects of use. */ ENTER; SAVEVPTR(PL_curcop); @@ -7816,8 +7813,10 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, if (*name == 'B') { if (strEQ(name, "BEGIN")) { const I32 oldscope = PL_scopestack_ix; + dSP; if (floor) LEAVE_SCOPE(floor); ENTER; + PUSHSTACKi(PERLSI_REQUIRE); SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); SAVEVPTR(PL_curcop); @@ -7827,6 +7826,7 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, GvCV_set(gv,0); /* cv has been hijacked */ call_list(oldscope, PL_beginav); + POPSTACK; LEAVE; } else diff --git a/perl.c b/perl.c index e9cf22a..45d7e67 100644 --- a/perl.c +++ b/perl.c @@ -3036,10 +3036,8 @@ Perl_require_pv(pTHX_ const char *pv) PERL_ARGS_ASSERT_REQUIRE_PV; PUSHSTACKi(PERLSI_REQUIRE); - PUTBACK; sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0); eval_sv(sv_2mortal(sv), G_DISCARD); - SPAGAIN; POPSTACK; } diff --git a/toke.c b/toke.c index 97205a3..e6ec7f7 100644 --- a/toke.c +++ b/toke.c @@ -9192,7 +9192,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, newSVpvs(":full"), newSVpvs(":short"), NULL); - SPAGAIN; + assert(sp == PL_stack_sp); table = GvHV(PL_hintgv); if (table && (PL_hints & HINT_LOCALIZE_HH) -- Perl5 Master Repository
