In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/be98855787c93fb16a7d4974601d4c8cf91ab8cb?hp=0fc44d0a1890e6805511495d35a65829f38c74f7>
- Log ----------------------------------------------------------------- commit be98855787c93fb16a7d4974601d4c8cf91ab8cb Author: David Mitchell <[email protected]> Date: Wed Oct 26 15:59:01 2016 +0100 speed up AV and HV clearing/undeffing av_clear(), av_undef(), hv_clear(), hv_undef() and av_make() all have similar guards along the lines of: ENTER; SAVEFREESV(SvREFCNT_inc_simple_NN(av)); ... do stuff ...; LEAVE; to stop the AV or HV leaking or being prematurely freed while processing its elements (e.g. FETCH() or DESTROY() might do something to it). Introducing an extra scope and calling leave_scope() is expensive. Instead, use a trick I introduced in my recent pp_assign() recoding: add the AV/HV to the temps stack, then at the end of the function, just PL_tmpx_ix-- if nothing else has been pushed on the tmps stack in the meantime, or replace the tmps stack slot with &PL_sv_undef otherwise (which doesn't care how many times its ref count gets decremented). This is efficient, and doesn't artificially extend the life of the SV like sv_2mortal() would. This commit makes this code around 5% faster: my @a; for my $i (1..3_000_000) { @a = (1,2,3); @a = (); } and this code around 3% faster: my %h; for my $i (1..3_000_000) { %h = qw(a 1 b 2); %h = (); } M av.c M hv.c commit e379d8b6255668c15f5454b32dcbfd8b1f462a9f Author: David Mitchell <[email protected]> Date: Wed Oct 26 15:30:19 2016 +0100 t/op/read.t: test with zero-length buffer This test file had: my (@values, @buffers) = ('', ''); which isn't doing what the author probably intended. Instead it's testing twice for the same zero-length value, and not testing at all for a zero length buffer. M t/op/read.t ----------------------------------------------------------------------- Summary of changes: av.c | 56 ++++++++++++++++++++++++++++++++++++++++++++------------ hv.c | 34 +++++++++++++++++++++++++++------- t/op/read.t | 6 ++++-- 3 files changed, 75 insertions(+), 21 deletions(-) diff --git a/av.c b/av.c index 882be183c7..0fe2024646 100644 --- a/av.c +++ b/av.c @@ -409,13 +409,18 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) if (size) { /* "defined" was returning undef for size==0 anyway. */ SV** ary; SSize_t i; + SSize_t orig_ix; + Newx(ary,size,SV*); AvALLOC(av) = ary; AvARRAY(av) = ary; AvMAX(av) = size - 1; AvFILLp(av) = -1; - ENTER; - SAVEFREESV(av); + /* avoid av being leaked if croak when calling magic below */ + EXTEND_MORTAL(1); + PL_tmps_stack[++PL_tmps_ix] = (SV*)av; + orig_ix = PL_tmps_ix; + for (i = 0; i < size; i++) { assert (*strp); @@ -430,8 +435,11 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) SV_DO_COW_SVSETSV|SV_NOSTEAL); strp++; } - SvREFCNT_inc_simple_void_NN(av); - LEAVE; + /* disarm av's leak guard */ + if (LIKELY(PL_tmps_ix == orig_ix)) + PL_tmps_ix--; + else + PL_tmps_stack[orig_ix] = &PL_sv_undef; } return av; } @@ -457,6 +465,7 @@ Perl_av_clear(pTHX_ AV *av) { SSize_t extra; bool real; + SSize_t orig_ix = 0; PERL_ARGS_ASSERT_AV_CLEAR; assert(SvTYPE(av) == SVt_PVAV); @@ -482,11 +491,15 @@ Perl_av_clear(pTHX_ AV *av) if (AvMAX(av) < 0) return; - if ((real = !!AvREAL(av))) { + if ((real = cBOOL(AvREAL(av)))) { SV** const ary = AvARRAY(av); SSize_t index = AvFILLp(av) + 1; - ENTER; - SAVEFREESV(SvREFCNT_inc_simple_NN(av)); + + /* avoid av being freed when calling destructors below */ + EXTEND_MORTAL(1); + PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av); + orig_ix = PL_tmps_ix; + while (index) { SV * const sv = ary[--index]; /* undef the slot before freeing the value, because a @@ -501,7 +514,14 @@ Perl_av_clear(pTHX_ AV *av) AvARRAY(av) = AvALLOC(av); } AvFILLp(av) = -1; - if (real) LEAVE; + if (real) { + /* disarm av's premature free guard */ + if (LIKELY(PL_tmps_ix == orig_ix)) + PL_tmps_ix--; + else + PL_tmps_stack[orig_ix] = &PL_sv_undef; + SvREFCNT_dec_NN(av); + } } /* @@ -522,6 +542,7 @@ void Perl_av_undef(pTHX_ AV *av) { bool real; + SSize_t orig_ix; PERL_ARGS_ASSERT_AV_UNDEF; assert(SvTYPE(av) == SVt_PVAV); @@ -530,10 +551,14 @@ Perl_av_undef(pTHX_ AV *av) if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) av_fill(av, -1); - if ((real = !!AvREAL(av))) { + if ((real = cBOOL(AvREAL(av)))) { SSize_t key = AvFILLp(av) + 1; - ENTER; - SAVEFREESV(SvREFCNT_inc_simple_NN(av)); + + /* avoid av being freed when calling destructors below */ + EXTEND_MORTAL(1); + PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av); + orig_ix = PL_tmps_ix; + while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } @@ -544,7 +569,14 @@ Perl_av_undef(pTHX_ AV *av) AvMAX(av) = AvFILLp(av) = -1; if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av)); - if(real) LEAVE; + if (real) { + /* disarm av's premature free guard */ + if (LIKELY(PL_tmps_ix == orig_ix)) + PL_tmps_ix--; + else + PL_tmps_stack[orig_ix] = &PL_sv_undef; + SvREFCNT_dec_NN(av); + } } /* diff --git a/hv.c b/hv.c index 338b17e317..de06148107 100644 --- a/hv.c +++ b/hv.c @@ -1696,6 +1696,8 @@ void Perl_hv_clear(pTHX_ HV *hv) { dVAR; + SSize_t orig_ix; + XPVHV* xhv; if (!hv) return; @@ -1704,8 +1706,10 @@ Perl_hv_clear(pTHX_ HV *hv) xhv = (XPVHV*)SvANY(hv); - ENTER; - SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); + /* avoid hv being freed when calling destructors below */ + EXTEND_MORTAL(1); + PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv); + orig_ix = PL_tmps_ix; if (SvREADONLY(hv) && HvARRAY(hv) != NULL) { /* restricted hash: convert all keys to placeholders */ STRLEN i; @@ -1743,7 +1747,12 @@ Perl_hv_clear(pTHX_ HV *hv) mro_isa_changed_in(hv); HvEITER_set(hv, NULL); } - LEAVE; + /* disarm hv's premature free guard */ + if (LIKELY(PL_tmps_ix == orig_ix)) + PL_tmps_ix--; + else + PL_tmps_stack[orig_ix] = &PL_sv_undef; + SvREFCNT_dec_NN(hv); } /* @@ -1926,10 +1935,11 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) { XPVHV* xhv; bool save; + SSize_t orig_ix; if (!hv) return; - save = !!SvREFCNT(hv); + save = cBOOL(SvREFCNT(hv)); DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); @@ -1952,8 +1962,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) hv_name_set(hv, NULL, 0, 0); } if (save) { - ENTER; - SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); + /* avoid hv being freed when calling destructors below */ + EXTEND_MORTAL(1); + PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv); + orig_ix = PL_tmps_ix; } hfreeentries(hv); if (SvOOK(hv)) { @@ -2012,7 +2024,15 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) if (SvRMAGICAL(hv)) mg_clear(MUTABLE_SV(hv)); - if (save) LEAVE; + + if (save) { + /* disarm hv's premature free guard */ + if (LIKELY(PL_tmps_ix == orig_ix)) + PL_tmps_ix--; + else + PL_tmps_stack[orig_ix] = &PL_sv_undef; + SvREFCNT_dec_NN(hv); + } } /* diff --git a/t/op/read.t b/t/op/read.t index c5b616a0f3..a4ddc0d80b 100644 --- a/t/op/read.t +++ b/t/op/read.t @@ -7,7 +7,7 @@ BEGIN { } use strict; -plan tests => 2564; +plan tests => 2116; open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || open(FOO,':op:read.t') || die "Can't open op.read"; seek(FOO,4,0) or die "Seek failed: $!"; @@ -33,7 +33,8 @@ my $has_perlio = !eval { my $tmpfile = tempfile(); -my (@values, @buffers) = ('', ''); +my @values = (''); +my @buffers = (''); foreach (65, 161, 253, 9786) { push @values, join "", map {chr $_} $_ .. $_ + 4; @@ -59,6 +60,7 @@ foreach my $value (@values) { print FH $value; close FH; foreach my $offset (@offsets) { + next if !length($initial_buffer) && $offset != 0; foreach my $length (@lengths) { # Will read the lesser of the length of the file and the # read length -- Perl5 Master Repository
