summaryrefslogtreecommitdiff
path: root/av.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2016-10-26 15:59:01 +0100
committerDavid Mitchell <davem@iabyn.com>2016-10-26 16:21:52 +0100
commitbe98855787c93fb16a7d4974601d4c8cf91ab8cb (patch)
tree6366dab91b8d6f33671909b9a7057bc5b363beb7 /av.c
parente379d8b6255668c15f5454b32dcbfd8b1f462a9f (diff)
downloadperl-be98855787c93fb16a7d4974601d4c8cf91ab8cb.tar.gz
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 = (); }
Diffstat (limited to 'av.c')
-rw-r--r--av.c56
1 files changed, 44 insertions, 12 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);
+ }
}
/*