diff options
| -rw-r--r-- | embed.fnc | 5 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | hv.c | 140 | ||||
| -rw-r--r-- | proto.h | 13 |
4 files changed, 105 insertions, 54 deletions
@@ -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 @@ -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) @@ -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 @@ -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) |