add hfree_next_entry(), hv_free_ent_ret()

Move body of hfreeentries()' central loop into a new function,
hfree_next_entry(); leaving hfreeentries() as a simple loop that calls
hfree_next_entry() until there are no entries left.

This will in future allow sv_clear() to free a hash iteratively rather
than recursively.

Similarly, turn hv_free_ent() into a thin wrapper around a new function,
hv_free_ent_ret(), which doesn't free HeVAL(), but rather just returns the
SV instead.

diff --git a/embed.fnc b/embed.fnc
index 161729e..6c33dc1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1583,9 +1583,14 @@ s        |HV*    |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
                                |NN const char *methpv|const U32 flags
 #endif
 
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+po     |SV*    |hfree_next_entry       |NN HV *hv|NN STRLEN *indexp
+#endif
+
 #if defined(PERL_IN_HV_C)
 s      |void   |hsplit         |NN HV *hv
 s      |void   |hfreeentries   |NN HV *hv
+s      |SV*    |hv_free_ent_ret|NN HV *hv|NULLOK HE *entryK
 sa     |HE*    |new_he
 sanR   |HEK*   |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags
 sn     |void   |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store

diff --git a/embed.h b/embed.h
index 9ff6440..b545bd3 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1286,6 +1286,7 @@
 #define hsplit(a)              S_hsplit(aTHX_ a)
 #define hv_auxinit             S_hv_auxinit
 #define hv_delete_common(a,b,c,d,e,f,g)        S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)
+#define hv_free_ent_ret(a,b)   S_hv_free_ent_ret(aTHX_ a,b)
 #define hv_magic_check         S_hv_magic_check
 #define hv_notallowed(a,b,c,d) S_hv_notallowed(aTHX_ a,b,c,d)
 #define new_he()               S_new_he(aTHX)

diff --git a/hv.c b/hv.c
index 8b186de..0d296a4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1457,16 +1457,17 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
     return hv;
 }
 
-void
-Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+/* like hv_free_ent, but returns the SV rather than freeing it */
+STATIC SV*
+S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry)
 {
     dVAR;
     SV *val;
 
-    PERL_ARGS_ASSERT_HV_FREE_ENT;
+    PERL_ARGS_ASSERT_HV_FREE_ENT_RET;
 
     if (!entry)
-       return;
+       return NULL;
     val = HeVAL(entry);
     if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv))
         mro_method_changed_in(hv);     /* deletion of method from stash */
@@ -1479,6 +1480,21 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     else
        Safefree(HeKEY_hek(entry));
     del_HE(entry);
+    return val;
+}
+
+
+void
+Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+{
+    dVAR;
+    SV *val;
+
+    PERL_ARGS_ASSERT_HV_FREE_ENT;
+
+    if (!entry)
+       return;
+    val = hv_free_ent_ret(hv, entry);
     SvREFCNT_dec(val);
 }
 
@@ -1630,69 +1646,85 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
 STATIC void
 S_hfreeentries(pTHX_ HV *hv)
 {
-    STRLEN i = 0;
-    const bool mpm = PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv);
+    STRLEN index = 0;
+    SV* sv;
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
-    if (!HvARRAY(hv))
+    if (!((XPVHV*)SvANY(hv))->xhv_keys)
        return;
 
-    /* keep looping until all keys are removed. This may take multiple
-     * passes through the array, since destructors may add things back. */
+    while ( ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))) ) {
+       SvREFCNT_dec(sv);
+    }
+}
 
-    while (((XPVHV*)SvANY(hv))->xhv_keys) {
-       struct xpvhv_aux *iter;
-       HE *entry;
-       HE ** array;
-
-       if (SvOOK(hv) && ((iter = HvAUX(hv)))
-           && ((entry = iter->xhv_eiter)) )
-       {
-           /* the iterator may get resurrected after each
-            * destructor call, so check each time */
-           if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
-               HvLAZYDEL_off(hv);
-               hv_free_ent(hv, entry);
-               /* warning: at this point HvARRAY may have been
-                * re-allocated, HvMAX changed etc */
-           }
-           iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
-           iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
-       }
 
-       array = HvARRAY(hv);
-       entry = array[i];
-       if (entry) {
-           /* Detach and free this entry. Note that destructors may be
-            * called which will manipulate this hash, so make sure
-            * its internal structure remains consistent throughout */
-           array[i] = HeNEXT(entry);
-           ((XPVHV*) SvANY(hv))->xhv_keys--;
-
-           if (   mpm && HeVAL(entry) && isGV(HeVAL(entry))
-               && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry)))
-           ) {
-               STRLEN klen;
-               const char * const key = HePV(entry,klen);
-               if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':')
-                || (klen == 1 && key[0] == ':')) {
-                   mro_package_moved(
-                    NULL, GvHV(HeVAL(entry)),
-                    (GV *)HeVAL(entry), 0
-                   );
-               }
-           }
+/* hfree_next_entry()
+ * For use only by S_hfreeentries() and sv_clear().
+ * Delete the next available HE from hv and return the associated SV.
+ * Returns null on empty hash.
+ * indexp is a pointer to the current index into HvARRAY. The index should
+ * initially be set to 0. hfree_next_entry() may update it.  */
+
+SV*
+Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
+{
+    struct xpvhv_aux *iter;
+    HE *entry;
+    HE ** array;
+#ifdef DEBUGGING
+    STRLEN orig_index = *indexp;
+#endif
+
+    PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
+
+    if (!((XPVHV*)SvANY(hv))->xhv_keys)
+       return NULL;
+
+    if (SvOOK(hv) && ((iter = HvAUX(hv)))
+       && ((entry = iter->xhv_eiter)) )
+    {
+       /* the iterator may get resurrected after each
+        * destructor call, so check each time */
+       if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
+           HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
            /* warning: at this point HvARRAY may have been
             * re-allocated, HvMAX changed etc */
-           continue;
        }
-       if (i++ >= HvMAX(hv))
-           i = 0;
-    } /* while */
+       iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
+       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+    }
+
+    array = HvARRAY(hv);
+    assert(array);
+    while ( ! ((entry = array[*indexp])) ) {
+       if ((*indexp)++ >= HvMAX(hv))
+           *indexp = 0;
+       assert(*indexp != orig_index);
+    }
+    array[*indexp] = HeNEXT(entry);
+    ((XPVHV*) SvANY(hv))->xhv_keys--;
+
+    if (   PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv)
+       && HeVAL(entry) && isGV(HeVAL(entry))
+       && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry)))
+    ) {
+       STRLEN klen;
+       const char * const key = HePV(entry,klen);
+       if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':')
+        || (klen == 1 && key[0] == ':')) {
+           mro_package_moved(
+            NULL, GvHV(HeVAL(entry)),
+            (GV *)HeVAL(entry), 0
+           );
+       }
+    }
+    return hv_free_ent_ret(hv, entry);
 }
 
+
 /*
 =for apidoc hv_undef
 

diff --git a/proto.h b/proto.h
index 845658b..7948897 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5322,6 +5322,11 @@ STATIC struct xpvhv_aux* S_hv_auxinit(HV *hv)
        assert(hv)
 
 STATIC SV*     S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
+STATIC SV*     S_hv_free_ent_ret(pTHX_ HV *hv, HE *entryK)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_HV_FREE_ENT_RET       \
+       assert(hv)
+
 STATIC void    S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
                        __attribute__nonnull__(1)
                        __attribute__nonnull__(2)
@@ -5367,6 +5372,14 @@ PERL_CALLCONV void       Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
        assert(sv)
 
 #endif
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+PERL_CALLCONV SV*      Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY      \
+       assert(hv); assert(indexp)
+
+#endif
 #if defined(PERL_IN_LOCALE_C)
 #  if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
 STATIC char*   S_stdize_locale(pTHX_ char* locs)