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 = ();
    }

diff --git a/av.c b/av.c
index 882be18..0fe2024 100644 (file)
--- 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 338b17e..de06148 100644 (file)
--- 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);
+    }
 }
 
 /*