In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a68090fe12f676d7c874585fc2727765c009ab06?hp=bdae4172ce49ee233037d3e6af7dbeea521d0562>
- Log ----------------------------------------------------------------- commit a68090fe12f676d7c874585fc2727765c009ab06 Author: David Mitchell <[email protected]> Date: Tue Oct 13 17:02:39 2015 +0100 optimise save/restore of PL_delaymagic. A few places (pp_push, pp_unshift, pp_aassign) have to set PL_delaymagic on entry, and restore it on exit. These are hot pieces of code. Rather than using ENTER/SAVEI16(PL_delaymagic)/LEAVE, add an extra field to the jumpenv struct, and make the JUMPENV_PUSH / POP macros automatically save and restore this var. This means that pp_push etc only need to do a local save: U16 old_delaymagic = PL_delaymagic; PL_delaymagic = DM_DELAY; .... PL_delaymagic = old_delaymagic; and in case of an exception being raised, PL_delaymagic still gets restored. This transfers the cost of saving PL_delaymagic from each call to pp_aassign etc to each time a new run level is invoked. The latter should be much less frequent. Note that prior to this commit, pp_aassign wasn't actually saving and restoring PL_delaymagic; it was just setting it to 0 at the end. So this commit also makes pp_aassign safe against PL_delaymagic re-entrancy like pp_push and pp_unshift already were. M cop.h M intrpvar.h M pp.c M pp_hot.c commit 395391414ee1260c2b34a5f6a353908cc9d48d3f Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Fri Sep 18 17:40:01 2015 +0100 Delay @ISA magic while unshifting pp_unshift() first calls av_unshift(), which prepends the the requisite number of undefs, then calls av_store() for each item. However, unlike pp_push() it was not setting PL_delaymagic around the av_store() loop, so when unshifting onto @ISA, its magic would be triggered while there were still undefs in the array, causig the following spurious warning: $ perl -wE 'package Foo; unshift @ISA, qw(A B)' Use of uninitialized value in unshift at -e line 1. Also fix pp_push() to save and restore PL_delaymagic instead of clearing it, so that e.g. unshifting a tied value with FETCH pushing onto another @ISA doesn't erroneously clear the value from underneath the unshift. M pp.c M t/op/magic.t ----------------------------------------------------------------------- Summary of changes: cop.h | 4 ++++ intrpvar.h | 15 +++++++++++++++ pp.c | 15 +++++++++++++-- pp_hot.c | 5 ++++- t/op/magic.t | 23 ++++++++++++++++++++++- 5 files changed, 58 insertions(+), 4 deletions(-) diff --git a/cop.h b/cop.h index aae9cea7..d36d189 100644 --- a/cop.h +++ b/cop.h @@ -34,6 +34,7 @@ struct jmpenv { Sigjmp_buf je_buf; /* uninit if je_prev is NULL */ int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ + U16 je_old_delaymagic; /* saved PL_delaymagic */ }; typedef struct jmpenv JMPENV; @@ -55,6 +56,7 @@ typedef struct jmpenv JMPENV; PL_start_env.je_prev = NULL; \ PL_start_env.je_ret = -1; \ PL_start_env.je_mustcatch = TRUE; \ + PL_start_env.je_old_delaymagic = 0; \ } STMT_END /* @@ -103,6 +105,7 @@ typedef struct jmpenv JMPENV; cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \ PL_top_env = &cur_env; \ cur_env.je_mustcatch = FALSE; \ + cur_env.je_old_delaymagic = PL_delaymagic; \ (v) = cur_env.je_ret; \ } STMT_END @@ -114,6 +117,7 @@ typedef struct jmpenv JMPENV; Perl_deb(aTHX_ "JUMPENV_POP level=%d at %s:%d\n", \ i, __FILE__, __LINE__);}) \ assert(PL_top_env == &cur_env); \ + PL_delaymagic = cur_env.je_old_delaymagic; \ PL_top_env = cur_env.je_prev; \ } STMT_END diff --git a/intrpvar.h b/intrpvar.h index 79bddeb..7dc4be4 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -76,7 +76,22 @@ PERLVAR(I, curpm, PMOP *) /* what to do \ interps in REs from */ PERLVAR(I, tainting, bool) /* doing taint checks */ PERLVAR(I, tainted, bool) /* using variables controlled by $< */ + +/* PL_delaymagic is currently used for two purposes: to assure simultaneous + * updates in ($<,$>) = ..., and to assure atomic update in push/unshift + * @ISA, It works like this: a few places such as pp_push set the DM_DELAY + * flag; then various places such as av_store() skip mg_set(ary) if this + * flag is set, and various magic vtable methods set flags like + * DM_ARRAY_ISA if they've seen something of that ilk. Finally when + * control returns to pp_push or whatever, it sees if any of those flags + * have been set, and if so finally calls mg_set(). + * + * NB: PL_delaymagic is automatically saved and restored by JUMPENV_PUSH + * / POP. This removes the need to do ENTER/SAVEI16(PL_delaymagic)/LEAVE + * in hot code like pp_push. + */ PERLVAR(I, delaymagic, U16) /* ($<,$>) = ... */ + PERLVAR(I, localizing, U8) /* are we processing a local() list? */ PERLVAR(I, in_eval, U8) /* trap "fatal" errors? */ PERLVAR(I, defgv, GV *) /* the *_ glob */ diff --git a/pp.c b/pp.c index 6a844c2..6e9995a 100644 --- a/pp.c +++ b/pp.c @@ -5443,6 +5443,10 @@ PP(pp_push) /* SPAGAIN; not needed: SP is assigned to immediately below */ } else { + /* PL_delaymagic is restored by JUMPENV_POP on dieing, so we + * only need to save locally, not on the save stack */ + U16 old_delaymagic = PL_delaymagic; + if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify(); PL_delaymagic = DM_DELAY; for (++MARK; MARK <= SP; MARK++) { @@ -5455,8 +5459,7 @@ PP(pp_push) } if (PL_delaymagic & DM_ARRAY_ISA) mg_set(MUTABLE_SV(ary)); - - PL_delaymagic = 0; + PL_delaymagic = old_delaymagic; } SP = ORIGMARK; if (OP_GIMME(PL_op, 0) != G_VOID) { @@ -5496,12 +5499,20 @@ PP(pp_unshift) /* SPAGAIN; not needed: SP is assigned to immediately below */ } else { + /* PL_delaymagic is restored by JUMPENV_POP on dieing, so we + * only need to save locally, not on the save stack */ + U16 old_delaymagic = PL_delaymagic; SSize_t i = 0; + av_unshift(ary, SP - MARK); + PL_delaymagic = DM_DELAY; while (MARK < SP) { SV * const sv = newSVsv(*++MARK); (void)av_store(ary, i++, sv); } + if (PL_delaymagic & DM_ARRAY_ISA) + mg_set(MUTABLE_SV(ary)); + PL_delaymagic = old_delaymagic; } SP = ORIGMARK; if (OP_GIMME(PL_op, 0) != G_VOID) { diff --git a/pp_hot.c b/pp_hot.c index 9ac6066..e866841 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1174,6 +1174,9 @@ PP(pp_aassign) SSize_t i; int magic; U32 lval; + /* PL_delaymagic is restored by JUMPENV_POP on dieing, so we + * only need to save locally, not on the save stack */ + U16 old_delaymagic = PL_delaymagic; #ifdef DEBUGGING bool fake = 0; #endif @@ -1545,7 +1548,7 @@ PP(pp_aassign) PERL_UNUSED_VAR(tmp_egid); #endif } - PL_delaymagic = 0; + PL_delaymagic = old_delaymagic; if (gimme == G_VOID) SP = firstrelem - 1; diff --git a/t/op/magic.t b/t/op/magic.t index 4a8006d..da7532e 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan (tests => 190); + plan (tests => 192); } # Test that defined() returns true for magic variables created on the fly, @@ -681,6 +681,27 @@ $_ = ${^E_NCODING}; pass('can read ${^E_NCODING} without blowing up'); is $_, undef, '${^E_NCODING} is undef'; +{ + my $warned = 0; + local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; }; + unshift @RT12608::A::ISA, qw(RT12608::B RT12608::C); + is $warned, 0, '[perl #126082] unshifting onto @ISA doesn\'t trigger set magic for each item'; +} + +{ + my $warned = 0; + local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; }; + + my $x; tie $x, 'RT12608::F'; + unshift @RT12608::X::ISA, $x, "RT12608::Z"; + is $warned, 0, '[perl #126082] PL_delaymagic correctly/saved restored when pushing/unshifting onto @ISA'; + + package RT12608::F; + use parent 'Tie::Scalar'; + sub TIESCALAR { bless {}; } + sub FETCH { push @RT12608::G::ISA, "RT12608::H"; "RT12608::Y"; } +} + # ^^^^^^^^^ New tests go here ^^^^^^^^^ SKIP: { -- Perl5 Master Repository
