process xhv_backreferences early in S_hfreeentries

When deleting a stash, make the algorithm
    GvSTASH($_) = NULL for (@xhv_backreferences);
    delete xhv_backreferences;
    free each stash entry;

Previously the algorithm was

    hide xhv_backreferences as ordinary backref magic;
    free each stash entry:
	this may trigger a sv_del_backref() for each GV being freed
    delete @xhv_backreferences

The new method is:

* more efficient: one scan through @xhv_backreferences rather than lots of
calls to sv_del_backref(), removing elements one by one;

* makes the code simpler; the 'hide xhv_backreferences as backref magic'
hack no longer needs to be done

* removes a bug whereby GVs that had a refcnt > 1 (the usual case) were
left with a GvSTASH pointing to the freed stash; it's now NULL instead. I
couldn't think of a test for this.

There are two drawbacks:

* If the GV gets freed at the same time as the stash, the freeing code
sees the GV with a GVSTASH of NULL rather than still pointing to the
stash.

* As far as I can see, the only difference this currently makes is that
mro_method_changed_in() is no longer called by sv_clear(), but since we're
blowing away the whole stash anyway, method resolution doesn't really
bother us any more.

At some point in the future I might set GvSTASH to %__ANON__ rather than
NULL.

diff --git a/embed.fnc b/embed.fnc
index 85beec1..a1e8ecd 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2134,10 +2134,6 @@ Apo      |void   |hv_eiter_set   |NN HV *hv|NULLOK HE *eiter
 Ap     |void   |hv_name_set    |NN HV *hv|NULLOK const char *name|U32 len|U32 flags
 : Used in dump.c and hv.c
 poM    |AV**   |hv_backreferences_p    |NN HV *hv
-#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
-: Only used in sv.c
-poM    |void   |hv_kill_backrefs       |NN HV *hv
-#endif
 Apd    |void   |hv_clear_placeholders  |NN HV *hv
 ApoR   |I32*   |hv_placeholders_p      |NN HV *hv
 ApoR   |I32    |hv_placeholders_get    |NN const HV *hv

diff --git a/embed.h b/embed.h
index d7a62dd..f62a803 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1817,8 +1817,6 @@
 #endif
 #define hv_scalar              Perl_hv_scalar
 #define hv_name_set            Perl_hv_name_set
-#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
-#endif
 #define hv_clear_placeholders  Perl_hv_clear_placeholders
 #ifdef PERL_CORE
 #define magic_scalarpack       Perl_magic_scalarpack
@@ -4269,10 +4267,6 @@
 #define hv_name_set(a,b,c,d)   Perl_hv_name_set(aTHX_ a,b,c,d)
 #ifdef PERL_CORE
 #endif
-#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
-#ifdef PERL_CORE
-#endif
-#endif
 #define hv_clear_placeholders(a)       Perl_hv_clear_placeholders(aTHX_ a)
 #ifdef PERL_CORE
 #define magic_scalarpack(a,b)  Perl_magic_scalarpack(aTHX_ a,b)

diff --git a/hv.c b/hv.c
index 880a46d..f94d6d4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1708,28 +1708,13 @@ S_hfreeentries(pTHX_ HV *hv)
        if (SvOOK(hv)) {
            HE *entry;
             struct mro_meta *meta;
-           struct xpvhv_aux *iter = HvAUX(hv);
-           /* If there are weak references to this HV, we need to avoid
-              freeing them up here.  In particular we need to keep the AV
-              visible as what we're deleting might well have weak references
-              back to this HV, so the for loop below may well trigger
-              the removal of backreferences from this array.  */
-
-           if (iter->xhv_backreferences) {
-               /* So donate them to regular backref magic to keep them safe.
-                  The sv_magic will increase the reference count of the AV,
-                  so we need to drop it first. */
-               SvREFCNT_dec(iter->xhv_backreferences);
-               if (AvFILLp(iter->xhv_backreferences) == -1) {
-                   /* Turns out that the array is empty. Just free it.  */
-                   SvREFCNT_dec(iter->xhv_backreferences);
+           struct xpvhv_aux * const iter = HvAUX(hv);
+           SV *const av = iter->xhv_backreferences;
 
-               } else {
-                   sv_magic(MUTABLE_SV(hv),
-                            MUTABLE_SV(iter->xhv_backreferences),
-                            PERL_MAGIC_backref, NULL, 0);
-               }
-               iter->xhv_backreferences = NULL;
+           if (av) {
+               Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
+               SvREFCNT_dec(av);
+               iter->xhv_backreferences = 0;
            }
 
            entry = iter->xhv_eiter; /* HvEITER(hv) */
@@ -1765,7 +1750,7 @@ S_hfreeentries(pTHX_ HV *hv)
        }
 
        /* make everyone else think the array is empty, so that the destructors
-        * called for freed entries can't recusively mess with us */
+        * called for freed entries can't recursively mess with us */
        HvARRAY(hv) = NULL;
        ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
@@ -2068,24 +2053,6 @@ Perl_hv_backreferences_p(pTHX_ HV *hv) {
     return &(iter->xhv_backreferences);
 }
 
-void
-Perl_hv_kill_backrefs(pTHX_ HV *hv) {
-    AV *av;
-
-    PERL_ARGS_ASSERT_HV_KILL_BACKREFS;
-
-    if (!SvOOK(hv))
-       return;
-
-    av = HvAUX(hv)->xhv_backreferences;
-
-    if (av) {
-       HvAUX(hv)->xhv_backreferences = 0;
-       Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
-       SvREFCNT_dec(av);
-    }
-}
-
 /*
 hv_iternext is implemented as a macro in hv.h
 

diff --git a/proto.h b/proto.h
index 1824377..688a2f0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6459,13 +6459,6 @@ PERL_CALLCONV AV**       Perl_hv_backreferences_p(pTHX_ HV *hv)
 #define PERL_ARGS_ASSERT_HV_BACKREFERENCES_P   \
        assert(hv)
 
-#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
-PERL_CALLCONV void     Perl_hv_kill_backrefs(pTHX_ HV *hv)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_HV_KILL_BACKREFS      \
-       assert(hv)
-
-#endif
 PERL_CALLCONV void     Perl_hv_clear_placeholders(pTHX_ HV *hv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS \

diff --git a/sv.c b/sv.c
index 7ba5ab7..504bc15 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5310,19 +5310,17 @@ Perl_sv_rvweaken(pTHX_ SV *const sv)
 /* A discussion about the backreferences array and its refcount:
  *
  * The AV holding the backreferences is pointed to either as the mg_obj of
- * PERL_MAGIC_backref, or in the specific case of a HV that has the hv_aux
- * structure, from the xhv_backreferences field. (A HV without hv_aux will
- * have the standard magic instead.) The array is created with a refcount
- * of 2. This means that if during global destruction the array gets
- * picked on first to have its refcount decremented by the random zapper,
- * it won't actually be freed, meaning it's still theere for when its
- * parent gets freed.
+ * PERL_MAGIC_backref, or in the specific case of a HV, from the
+ * xhv_backreferences field of the HvAUX structure. The array is created
+ * with a refcount of 2. This means that if during global destruction the
+ * array gets picked on before its parent to have its refcount decremented
+ * by the random zapper, it won't actually be freed, meaning it's still
+ * there for when its parent gets freed.
  * When the parent SV is freed, in the case of magic, the magic is freed,
  * Perl_magic_killbackrefs is called which decrements one refcount, then
  * mg_obj is freed which kills the second count.
- * In the vase of a HV being freed, one ref is removed by
- * Perl_hv_kill_backrefs, the other by Perl_sv_kill_backrefs, which it
- * calls.
+ * In the vase of a HV being freed, one ref is removed by S_hfreeentries,
+ * the other by Perl_sv_kill_backrefs, which it calls.
  */
 
 void
@@ -5338,23 +5336,9 @@ Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv)
 
        av = *avp;
        if (!av) {
-           /* There is no AV in the offical place - try a fixup.  */
-           MAGIC *const mg = mg_find(tsv, PERL_MAGIC_backref);
-
-           if (mg) {
-               /* Aha. They've got it stowed in magic.  Bring it back.  */
-               av = MUTABLE_AV(mg->mg_obj);
-               /* Stop mg_free decreasing the refernce count.  */
-               mg->mg_obj = NULL;
-               /* Stop mg_free even calling the destructor, given that
-                  there's no AV to free up.  */
-               mg->mg_virtual = 0;
-               sv_unmagic(tsv, PERL_MAGIC_backref);
-           } else {
-               av = newAV();
-               AvREAL_off(av);
-               SvREFCNT_inc_simple_void(av); /* see discussion above */
-           }
+           av = newAV();
+           AvREAL_off(av);
+           SvREFCNT_inc_simple_void(av); /* see discussion above */
            *avp = av;
        }
     } else {
@@ -5436,10 +5420,10 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
     PERL_ARGS_ASSERT_SV_KILL_BACKREFS;
     PERL_UNUSED_ARG(sv);
 
-    assert(!svp || !SvIS_FREED(av));
     if (svp) {
        SV *const *const last = svp + AvFILLp(av);
 
+       assert(!SvIS_FREED(av));
        while (svp <= last) {
            if (*svp) {
                SV *const referrer = *svp;
@@ -5465,6 +5449,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
            }
            svp++;
        }
+       AvFILLp(av) = -1;
     }
     SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
     return 0;
@@ -5783,7 +5768,6 @@ Perl_sv_clear(pTHX_ register SV *const sv)
        if (PL_last_swash_hv == (const HV *)sv) {
            PL_last_swash_hv = NULL;
        }
-       Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
        hv_undef(MUTABLE_HV(sv));
        break;
     case SVt_PVAV: