/*
=head1 Hash Manipulation Functions
-A HV structure represents a Perl hash. It consists mainly of an array
-of pointers, each of which points to a linked list of HE structures. The
+A HV structure represents a Perl hash. It consists mainly of an array
+of pointers, each of which points to a linked list of HE structures. The
array is indexed by the hash function of the key, so each linked list
-represents all the hash entries with the same hash value. Each HE contains
+represents all the hash entries with the same hash value. Each HE contains
a pointer to the actual value, plus a pointer to a HEK structure which
holds the key and hash value.
{
const int flags_masked = flags & HVhek_MASK;
char *k;
- register HEK *hek;
+ HEK *hek;
PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
Returns the SV which corresponds to the specified key in the hash.
The absolute value of C<klen> is the length of the key. If C<klen> is
negative the key is assumed to be in UTF-8-encoded Unicode. If
-C<lval> is set then the fetch will be part of a store. Check that the
+C<lval> is set then the fetch will be part of a store. This means that if
+there is no value in the hash associated with the given key, then one is
+created and a pointer to it is returned. The C<SV*> it points to can be
+assigned to. But always check that the
return value is non-null before dereferencing it to an C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
=for apidoc hv_exists_ent
-Returns a boolean indicating whether the specified hash key exists. C<hash>
+Returns a boolean indicating whether
+the specified hash key exists. C<hash>
can be a valid precomputed hash value, or 0 to ask for it to be
computed.
int k_flags, I32 d_flags, U32 hash)
{
dVAR;
- register XPVHV* xhv;
- register HE *entry;
- register HE **oentry;
+ XPVHV* xhv;
+ HE *entry;
+ HE **oentry;
bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
int masked_flags;
mro_changes = 1;
}
- if (d_flags & G_DISCARD) {
- sv = HeVAL(entry);
- HeVAL(entry) = &PL_sv_placeholder;
- if (sv) {
- /* deletion of method from stash */
- if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
- && HvENAME_get(hv))
- mro_method_changed_in(hv);
- SvREFCNT_dec(sv);
- sv = NULL;
- }
- }
- else {
- sv = sv_2mortal(HeVAL(entry));
- HeVAL(entry) = &PL_sv_placeholder;
+ sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
+ HeVAL(entry) = &PL_sv_placeholder;
+ if (sv) {
+ /* deletion of method from stash */
+ if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
+ && HvENAME_get(hv))
+ mro_method_changed_in(hv);
}
/*
HvHASKFLAGS_off(hv);
}
+ if (d_flags & G_DISCARD) {
+ SvREFCNT_dec(sv);
+ sv = NULL;
+ }
+
if (mro_changes == 1) mro_isa_changed_in(hv);
else if (mro_changes == 2)
mro_package_moved(NULL, stash, gv, 1);
S_hsplit(pTHX_ HV *hv)
{
dVAR;
- register XPVHV* const xhv = (XPVHV*)SvANY(hv);
+ XPVHV* const xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
- register I32 newsize = oldsize * 2;
- register I32 i;
+ I32 newsize = oldsize * 2;
+ I32 i;
char *a = (char*) HvARRAY(hv);
- register HE **aep;
+ HE **aep;
int longest_chain = 0;
int was_shared;
int right_length = 0;
HE **oentry = aep;
HE *entry = *aep;
- register HE **bep;
+ HE **bep;
if (!entry) /* non-existent */
continue;
aep = HvARRAY(hv);
for (i=0; i<newsize; i++,aep++) {
- register HE *entry = *aep;
+ HE *entry = *aep;
while (entry) {
/* We're going to trash this HE's next pointer when we chain it
into the new hash below, so store where we go next. */
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
dVAR;
- register XPVHV* xhv = (XPVHV*)SvANY(hv);
+ XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
- register I32 newsize;
- register I32 i;
- register char *a;
- register HE **aep;
+ I32 newsize;
+ I32 i;
+ char *a;
+ HE **aep;
PERL_ARGS_ASSERT_HV_KSPLIT;
if (!entry) /* non-existent */
continue;
do {
- register I32 j = (HeHASH(entry) & newsize);
+ I32 j = (HeHASH(entry) & newsize);
if (j != i) {
j -= i;
HV * const hv = newHV();
STRLEN hv_max;
- if (!ohv || !HvTOTALKEYS(ohv))
+ if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv)))
return hv;
hv_max = HvMAX(ohv);
hv_iterinit(ohv);
while ((entry = hv_iternext_flags(ohv, 0))) {
- SV *const val = HeVAL(entry);
- (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
- SvIMMORTAL(val) ? val : newSVsv(val),
+ SV *val = hv_iterval(ohv,entry);
+ SV * const keysv = HeSVKEY(entry);
+ val = SvIMMORTAL(val) ? val : newSVsv(val);
+ if (keysv)
+ (void)hv_store_ent(hv, keysv, val, 0);
+ else
+ (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val,
HeHASH(entry), HeKFLAGS(entry));
}
HvRITER_set(ohv, riter);
{
HV * const hv = newHV();
- if (ohv && HvTOTALKEYS(ohv)) {
+ if (ohv) {
STRLEN hv_max = HvMAX(ohv);
STRLEN hv_fill = HvFILL(ohv);
HE *entry;
const I32 riter = HvRITER_get(ohv);
HE * const eiter = HvEITER_get(ohv);
+ ENTER;
+ SAVEFREESV(hv);
+
while (hv_max && hv_max + 1 >= hv_fill * 2)
hv_max = hv_max / 2;
HvMAX(hv) = hv_max;
hv_iterinit(ohv);
while ((entry = hv_iternext_flags(ohv, 0))) {
- SV *const sv = newSVsv(HeVAL(entry));
- SV *heksv = newSVhek(HeKEY_hek(entry));
- sv_magic(sv, NULL, PERL_MAGIC_hintselem,
+ SV *const sv = newSVsv(hv_iterval(ohv,entry));
+ SV *heksv = HeSVKEY(entry);
+ if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry));
+ if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem,
(char *)heksv, HEf_SVKEY);
- SvREFCNT_dec(heksv);
- (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
- sv, HeHASH(entry), HeKFLAGS(entry));
+ if (heksv == HeSVKEY(entry))
+ (void)hv_store_ent(hv, heksv, sv, 0);
+ else {
+ (void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry),
+ HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry));
+ SvREFCNT_dec(heksv);
+ }
}
HvRITER_set(ohv, riter);
HvEITER_set(ohv, eiter);
+
+ SvREFCNT_inc_simple_void_NN(hv);
+ LEAVE;
}
hv_magic(hv, NULL, PERL_MAGIC_hints);
return hv;
if (!entry)
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 */
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
Safefree(HeKEY_hek(entry));
=for apidoc hv_clear
Frees the all the elements of a hash, leaving it empty.
-The XS equivalent of %hash = (). See also L</hv_undef>.
+The XS equivalent of C<%hash = ()>. See also L</hv_undef>.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
=cut
*/
Perl_hv_clear(pTHX_ HV *hv)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
if (!hv)
return;
xhv = (XPVHV*)SvANY(hv);
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
STRLEN i;
mro_isa_changed_in(hv);
HvEITER_set(hv, NULL);
}
+ LEAVE;
}
/*
/*
=for apidoc hv_undef
-Undefines the hash. The XS equivalent of undef(%hash).
+Undefines the hash. The XS equivalent of C<undef(%hash)>.
As well as freeing all the elements of the hash (like hv_clear()), this
also frees any auxiliary data and storage associated with the hash.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
+
See also L</hv_clear>.
=cut
Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
const char *name;
+ const bool save = !!SvREFCNT(hv);
if (!hv)
return;
);
hv_name_set(hv, NULL, 0, 0);
}
+ if (save) {
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+ }
hfreeentries(hv);
if (SvOOK(hv)) {
struct xpvhv_aux * const aux = HvAUX(hv);
Safefree(meta);
aux->xhv_mro_meta = NULL;
}
+ SvREFCNT_dec(aux->xhv_super);
if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences)
SvFLAGS(hv) &= ~SVf_OOK;
}
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
HvARRAY(hv) = 0;
}
- HvPLACEHOLDERS_set(hv, 0);
+ /* if we're freeing the HV, the SvMAGIC field has been reused for
+ * other purposes, and so there can't be any placeholder magic */
+ if (SvREFCNT(hv))
+ HvPLACEHOLDERS_set(hv, 0);
if (SvRMAGICAL(hv))
mg_clear(MUTABLE_SV(hv));
+ if (save) LEAVE;
}
/*
+ sizeof(struct xpvhv_aux), char);
}
HvARRAY(hv) = (HE**) array;
- /* SvOOK_on(hv) attacks the IV flags. */
- SvFLAGS(hv) |= SVf_OOK;
+ SvOOK_on(hv);
iter = HvAUX(hv);
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_name_count = 0;
iter->xhv_backreferences = 0;
iter->xhv_mro_meta = NULL;
+ iter->xhv_super = NULL;
return iter;
}
/*
=for apidoc hv_ename_add
-Adds a name to a stash's internal list of effective names. See
+Adds a name to a stash's internal list of effective names. See
C<hv_ename_delete>.
This is called when a stash is assigned to a new location in the symbol
/*
=for apidoc hv_ename_delete
-Removes a name from a stash's internal list of effective names. If this is
+Removes a name from a stash's internal list of effective names. If this is
the name returned by C<HvENAME>, then another name in the list will take
its place (C<HvENAME> will use it).
set the placeholders keys (for restricted hashes) will be returned in addition
to normal keys. By default placeholders are automatically skipped over.
Currently a placeholder is implemented with a value that is
-C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
+C<&PL_sv_placeholder>. Note that the implementation of placeholders and
restricted hashes may change, and the implementation currently is
insufficiently abstracted for any change to be tidy.
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
dVAR;
- register XPVHV* xhv;
- register HE *entry;
+ XPVHV* xhv;
+ HE *entry;
HE *oldentry;
MAGIC* mg;
struct xpvhv_aux *iter;
if (!SvOOK(hv)) {
/* Too many things (well, pp_each at least) merrily assume that you can
- call iv_iternext without calling hv_iterinit, so we'll have to deal
+ call hv_iternext without calling hv_iterinit, so we'll have to deal
with it. */
hv_iterinit(hv);
}
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
+ HeSVKEY_set(entry, NULL);
}
else {
char *k;
/* one HE per MAGICAL hash */
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
+ HvLAZYDEL_on(hv); /* make sure entry gets freed */
Zero(entry, 1, HE);
Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
hek = (HEK*)k;
Safefree(HeKEY_hek(entry));
del_HE(entry);
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+ HvLAZYDEL_off(hv);
return NULL;
}
}
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
HE *entry;
- register HE **oentry;
+ HE **oentry;
bool is_utf8 = FALSE;
int k_flags = 0;
const char * const save = str;
S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
{
dVAR;
- register HE *entry;
+ HE *entry;
const int flags_masked = flags & HVhek_MASK;
const U32 hindex = hash & (I32) HvMAX(PL_strtab);
- register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
+ XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
U8 utf8_flag;
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
- if (flags & ~REFCOUNTED_HE_KEY_UTF8)
+ if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS))
Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf,
(UV)flags);
if (!chain)
memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) &&
utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8)
#endif
- )
+ ) {
+ if (flags & REFCOUNTED_HE_EXISTS)
+ return (chain->refcounted_he_data[0] & HVrhek_typemask)
+ == HVrhek_delete
+ ? NULL : &PL_sv_yes;
return sv_2mortal(refcounted_he_value(chain));
+ }
}
- return &PL_sv_placeholder;
+ return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff