#define PERL_HASH_INTERNAL_ACCESS
#include "perl.h"
-#define HV_MAX_LENGTH_BEFORE_SPLIT 14
+#define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */
static const char S_strtab_error[]
= "Cannot modify shared string table in hv_%s";
void *
Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
- int flags, int action, SV *val, register U32 hash)
+ int flags, int action, SV *val, U32 hash)
{
dVAR;
XPVHV* xhv;
bool needs_store;
hv_magic_check (hv, &needs_copy, &needs_store);
if (needs_copy) {
- const bool save_taint = PL_tainted;
+ const bool save_taint = TAINT_get; /* Unused var warning under NO_TAINT_SUPPORT */
if (keysv || is_utf8) {
if (!keysv) {
keysv = newSVpvn_utf8(key, klen, TRUE);
}
- if (PL_tainting)
- PL_tainted = SvTAINTED(keysv);
+ if (TAINTING_get)
+ TAINT_set(SvTAINTED(keysv));
keysv = sv_2mortal(newSVsv(keysv));
mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
} else {
}
}
- if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
- PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
- else if (!hash)
- hash = SvSHARED_HASH(keysv);
-
- /* We don't have a pointer to the hv, so we have to replicate the
- flag into every HEK, so that hv_iterkeysv can see it.
- And yes, you do need this even though you are not "storing" because
- you can flip the flags below if doing an lval lookup. (And that
- was put in to give the semantics Andreas was expecting.) */
- if (HvREHASH(hv))
- flags |= HVhek_REHASH;
+ if (!hash) {
+ if (keysv && (SvIsCOW_shared_hash(keysv)))
+ hash = SvSHARED_HASH(keysv);
+ else
+ PERL_HASH(hash, key, klen);
+ }
masked_flags = (flags & HVhek_MASK);
if (masked_flags & HVhek_ENABLEHVKFLAGS)
HvHASKFLAGS_on(hv);
- {
- const HE *counter = HeNEXT(entry);
-
- xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
- if (!counter) { /* initial entry? */
- } else if (xhv->xhv_keys > xhv->xhv_max) {
- /* Use only the old HvUSEDKEYS(hv) > HvMAX(hv) condition to limit
- bucket splits on a rehashed hash, as we're not going to
- split it again, and if someone is lucky (evil) enough to
- get all the keys in one list they could exhaust our memory
- as we repeatedly double the number of buckets on every
- entry. Linear search feels a less worse thing to do. */
- hsplit(hv);
- } else if(!HvREHASH(hv)) {
- U32 n_links = 1;
-
- while ((counter = HeNEXT(counter)))
- n_links++;
-
- if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
- hsplit(hv);
- }
- }
+ xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
+ if ( DO_HSPLIT(xhv) ) {
+ hsplit(hv);
}
if (return_svp) {
HvHASKFLAGS_on(MUTABLE_SV(hv));
}
- if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
- PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
- else if (!hash)
- hash = SvSHARED_HASH(keysv);
+ if (!hash) {
+ if (keysv && (SvIsCOW_shared_hash(keysv)))
+ hash = SvSHARED_HASH(keysv);
+ else
+ PERL_HASH(hash, key, klen);
+ }
masked_flags = (k_flags & HVhek_MASK);
I32 i;
char *a = (char*) HvARRAY(hv);
HE **aep;
- int longest_chain = 0;
- int was_shared;
PERL_ARGS_ASSERT_HSPLIT;
aep = (HE**)a;
for (i=0; i<oldsize; i++,aep++) {
- int left_length = 0;
- int right_length = 0;
HE **oentry = aep;
HE *entry = *aep;
HE **bep;
*oentry = HeNEXT(entry);
HeNEXT(entry) = *bep;
*bep = entry;
- right_length++;
}
else {
oentry = &HeNEXT(entry);
- left_length++;
}
entry = *oentry;
} while (entry);
/* I think we don't actually need to keep track of the longest length,
merely flag if anything is too long. But for the moment while
developing this code I'll track it. */
- if (left_length > longest_chain)
- longest_chain = left_length;
- if (right_length > longest_chain)
- longest_chain = right_length;
}
-
-
- /* Pick your policy for "hashing isn't working" here: */
- if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */
- || HvREHASH(hv)) {
- return;
- }
-
- if (hv == PL_strtab) {
- /* Urg. Someone is doing something nasty to the string table.
- Can't win. */
- return;
- }
-
- /* Awooga. Awooga. Pathological data. */
- /*PerlIO_printf(PerlIO_stderr(), "%p %d of %d with %d/%d buckets\n", (void*)hv,
- longest_chain, HvTOTALKEYS(hv), HvFILL(hv), 1+HvMAX(hv));*/
-
- ++newsize;
- Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
-
- was_shared = HvSHAREKEYS(hv);
-
- HvSHAREKEYS_off(hv);
- HvREHASH_on(hv);
-
- aep = HvARRAY(hv);
-
- for (i=0; i<newsize; i++,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. */
- HE * const next = HeNEXT(entry);
- UV hash;
- HE **bep;
-
- /* Rehash it */
- PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
-
- if (was_shared) {
- /* Unshare it. */
- HEK * const new_hek
- = save_hek_flags(HeKEY(entry), HeKLEN(entry),
- hash, HeKFLAGS(entry));
- unshare_hek (HeKEY_hek(entry));
- HeKEY_hek(entry) = new_hek;
- } else {
- /* Not shared, so simply write the new hash in. */
- HeHASH(entry) = hash;
- }
- /*PerlIO_printf(PerlIO_stderr(), "%d ", HeKFLAGS(entry));*/
- HEK_REHASH_on(HeKEY_hek(entry));
- /*PerlIO_printf(PerlIO_stderr(), "%d\n", HeKFLAGS(entry));*/
-
- /* Copy oentry to the correct new chain. */
- bep = ((HE**)a) + (hash & (I32) xhv->xhv_max);
- HeNEXT(entry) = *bep;
- *bep = entry;
-
- entry = next;
- }
- }
- Safefree (HvARRAY(hv));
- HvARRAY(hv) = (HE **)a;
}
void
/* 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)
+S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry)
{
dVAR;
SV *val;
void
-Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+Perl_hv_free_ent(pTHX_ HV *hv, HE *entry)
{
dVAR;
SV *val;
void
-Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
+Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
{
dVAR;
mg_clear(MUTABLE_SV(hv));
HvHASKFLAGS_off(hv);
- HvREHASH_off(hv);
}
if (SvOOK(hv)) {
if(HvENAME_get(hv))
}
if((meta = aux->xhv_mro_meta)) {
if (meta->mro_linear_all) {
- SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
- meta->mro_linear_all = NULL;
- /* This is just acting as a shortcut pointer. */
- meta->mro_linear_current = NULL;
- } else if (meta->mro_linear_current) {
+ SvREFCNT_dec_NN(meta->mro_linear_all);
+ /* mro_linear_current is just acting as a shortcut pointer,
+ hence the else. */
+ }
+ else
/* Only the current MRO is stored, so this owns the data.
*/
SvREFCNT_dec(meta->mro_linear_current);
- meta->mro_linear_current = NULL;
- }
SvREFCNT_dec(meta->mro_nextmethod);
SvREFCNT_dec(meta->isa);
Safefree(meta);
HvAUX(hv)->xhv_backreferences = 0;
Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
if (SvTYPE(av) == SVt_PVAV)
- SvREFCNT_dec(av);
+ SvREFCNT_dec_NN(av);
}
}
hv_free_ent(hv, oldentry);
}
- /*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
- PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", (void*)hv, (void*)entry);*/
-
iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
return entry;
}
*/
char *
-Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
+Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen)
{
PERL_ARGS_ASSERT_HV_ITERKEY;
*/
SV *
-Perl_hv_iterkeysv(pTHX_ register HE *entry)
+Perl_hv_iterkeysv(pTHX_ HE *entry)
{
PERL_ARGS_ASSERT_HV_ITERKEYSV;
*/
SV *
-Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
+Perl_hv_iterval(pTHX_ HV *hv, HE *entry)
{
PERL_ARGS_ASSERT_HV_ITERVAL;
* len and hash must both be valid for str.
*/
HEK *
-Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
+Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash)
{
bool is_utf8 = FALSE;
int flags = 0;
we should flag that it needs upgrading on keys or each. Also flag
that we need share_hek_flags to free the string. */
if (str != save) {
+ dVAR;
PERL_HASH(hash, str, len);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
}
}
STATIC HEK *
-S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
+S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
{
dVAR;
HE *entry;
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!next) { /* initial entry? */
- } else if (xhv->xhv_keys > xhv->xhv_max /* HvUSEDKEYS(hv) > HvMAX(hv) */) {
- hsplit(PL_strtab);
+ } else if ( DO_HSPLIT(xhv) ) {
+ hsplit(PL_strtab);
}
}
https://perl5.git.perl.org / perl5.git / blobdiff