return hv;
}
+/* A rather specialised version of newHVhv for copying %^H, ensuring all the
+ magic stays on it. */
+HV *
+Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
+{
+ HV * const hv = newHV();
+ STRLEN hv_fill;
+
+ if (ohv && (hv_fill = HvFILL(ohv))) {
+ STRLEN hv_max = HvMAX(ohv);
+ HE *entry;
+ const I32 riter = HvRITER_get(ohv);
+ HE * const eiter = HvEITER_get(ohv);
+
+ 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_magic(sv, NULL, PERL_MAGIC_hintselem,
+ (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY);
+ hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
+ sv, HeHASH(entry), HeKFLAGS(entry));
+ }
+ HvRITER_set(ohv, riter);
+ HvEITER_set(ohv, eiter);
+ }
+ hv_magic(hv, NULL, PERL_MAGIC_hints);
+ return hv;
+}
+
void
Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
{
HE *entry;
register HE **oentry;
HE **first;
- bool found = 0;
bool is_utf8 = FALSE;
int k_flags = 0;
const char * const save = str;
if (he) {
const HE *const he_he = &(he->shared_he_he);
for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
- if (entry != he_he)
- continue;
- found = 1;
- break;
+ if (entry == he_he)
+ break;
}
} else {
const int flags_masked = k_flags & HVhek_MASK;
continue;
if (HeKFLAGS(entry) != flags_masked)
continue;
- found = 1;
break;
}
}
- if (found) {
- if (--he->shared_he_he.he_valu.hent_refcount == 0) {
+ if (entry) {
+ if (--entry->he_valu.hent_refcount == 0) {
*oentry = HeNEXT(entry);
if (!*first) {
/* There are now no entries in our slot. */
}
UNLOCK_STRTAB_MUTEX;
- if (!found && ckWARN_d(WARN_INTERNAL))
+ if (!entry && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Attempt to free non-existent shared string '%s'%s"
pTHX__FORMAT,
}
while (chain) {
- const U32 hash = HEK_HASH(chain->refcounted_he_he.hent_hek);
+#ifdef USE_ITHREADS
+ U32 hash = chain->refcounted_he_hash;
+#else
+ U32 hash = HEK_HASH(chain->refcounted_he_hek);
+#endif
HE **oentry = &((HvARRAY(hv))[hash & max]);
HE *entry = *oentry;
+ SV *value;
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) == hash) {
assert (!entry);
entry = new_HE();
- HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_he.hent_hek);
+#ifdef USE_ITHREADS
+ HeKEY_hek(entry)
+ = share_hek_flags(/* A big expression to find the key offset */
+ (((chain->refcounted_he_data[0]
+ & HVrhek_typemask) == HVrhek_PV)
+ ? chain->refcounted_he_val.refcounted_he_u_len
+ + 1 : 0) + 1 + chain->refcounted_he_data,
+ chain->refcounted_he_keylen,
+ chain->refcounted_he_hash,
+ (chain->refcounted_he_data[0]
+ & (HVhek_UTF8|HVhek_WASUTF8)));
+#else
+ HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek);
+#endif
- HeVAL(entry) = chain->refcounted_he_he.he_valu.hent_val;
- if (HeVAL(entry) == &PL_sv_placeholder)
+ switch(chain->refcounted_he_data[0] & HVrhek_typemask) {
+ case HVrhek_undef:
+ value = newSV(0);
+ break;
+ case HVrhek_delete:
+ value = &PL_sv_placeholder;
placeholders++;
- SvREFCNT_inc_void_NN(HeVAL(entry));
+ break;
+ case HVrhek_IV:
+ value = (chain->refcounted_he_data[0] & HVrhek_UV)
+ ? newSVuv(chain->refcounted_he_val.refcounted_he_u_iv)
+ : newSViv(chain->refcounted_he_val.refcounted_he_u_uv);
+ break;
+ case HVrhek_PV:
+ /* Create a string SV that directly points to the bytes in our
+ structure. */
+ value = newSV(0);
+ sv_upgrade(value, SVt_PV);
+ SvPV_set(value, (char *) chain->refcounted_he_data + 1);
+ SvCUR_set(value, chain->refcounted_he_val.refcounted_he_u_len);
+ /* This stops anything trying to free it */
+ SvLEN_set(value, 0);
+ SvPOK_on(value);
+ SvREADONLY_on(value);
+ if (chain->refcounted_he_data[0] & HVrhek_UTF8)
+ SvUTF8_on(value);
+ break;
+ default:
+ Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %x",
+ chain->refcounted_he_data[0]);
+ }
+ HeVAL(entry) = value;
/* Link it into the chain. */
HeNEXT(entry) = *oentry;
HvTOTALKEYS(hv)++;
next_please:
- chain = (struct refcounted_he *) chain->refcounted_he_he.hent_next;
+ chain = chain->refcounted_he_next;
}
if (placeholders) {
flags, but it's probably not worth it, as this per-hash flag is only
really meant as an optimisation for things like Storable. */
HvHASKFLAGS_on(hv);
-#ifdef DEBUGGING
- Perl_hv_assert(aTHX_ hv);
-#endif
+ DEBUG_A(Perl_hv_assert(aTHX_ hv));
return hv;
}
Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
SV *const key, SV *const value) {
struct refcounted_he *he;
+ STRLEN key_len;
+ const char *key_p = SvPV_const(key, key_len);
+ STRLEN value_len = 0;
+ const char *value_p;
+ char value_type;
+ char flags;
+ STRLEN key_offset;
U32 hash;
- STRLEN len;
- const char *p = SvPV_const(key, len);
+ bool is_utf8 = SvUTF8(key);
+
+ if (SvPOK(value)) {
+ value_type = HVrhek_PV;
+ } else if (SvIOK(value)) {
+ value_type = HVrhek_IV;
+ } else if (value == &PL_sv_placeholder) {
+ value_type = HVrhek_delete;
+ } else if (!SvOK(value)) {
+ value_type = HVrhek_undef;
+ } else {
+ value_type = HVrhek_PV;
+ }
+
+ if (value_type == HVrhek_PV) {
+ value_p = SvPV_const(value, value_len);
+ key_offset = value_len + 2;
+ } else {
+ value_len = 0;
+ key_offset = 1;
+ }
+ flags = value_type;
+
+ he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+#ifdef USE_ITHREADS
+ + key_len
+#endif
+ + key_offset);
+
+
+ he->refcounted_he_next = parent;
- PERL_HASH(hash, p, len);
+ if (value_type == HVrhek_PV) {
+ Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char);
+ he->refcounted_he_val.refcounted_he_u_len = value_len;
+ if (SvUTF8(value)) {
+ flags |= HVrhek_UTF8;
+ }
+ } else if (value_type == HVrhek_IV) {
+ if (SvUOK(value)) {
+ he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value);
+ flags |= HVrhek_UV;
+ } else {
+ he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value);
+ }
+ }
+
+ if (is_utf8) {
+ /* Hash keys are always stored normalised to (yes) ISO-8859-1.
+ As we're going to be building hash keys from this value in future,
+ normalise it now. */
+ key_p = (char*)bytes_from_utf8((const U8*)key_p, &key_len, &is_utf8);
+ flags |= is_utf8 ? HVhek_UTF8 : HVhek_WASUTF8;
+ }
+ PERL_HASH(hash, key_p, key_len);
+
+#ifdef USE_ITHREADS
+ he->refcounted_he_hash = hash;
+ he->refcounted_he_keylen = key_len;
+ Copy(key_p, he->refcounted_he_data + key_offset, key_len, char);
+#else
+ he->refcounted_he_hek = share_hek_flags(key_p, key_len, hash, flags);
+#endif
- Newx(he, 1, struct refcounted_he);
+ if (flags & HVhek_WASUTF8) {
+ /* If it was downgraded from UTF-8, then the pointer returned from
+ bytes_from_utf8 is an allocated pointer that we must free. */
+ Safefree(key_p);
+ }
- he->refcounted_he_he.hent_next = (HE *)parent;
- he->refcounted_he_he.he_valu.hent_val = value;
- he->refcounted_he_he.hent_hek
- = share_hek(p, SvUTF8(key) ? -(I32)len : len, hash);
+ he->refcounted_he_data[0] = flags;
he->refcounted_he_refcnt = 1;
return he;
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
while (he) {
struct refcounted_he *copy;
+ U32 new_count;
- if (--he->refcounted_he_refcnt)
+ HINTS_REFCNT_LOCK;
+ new_count = --he->refcounted_he_refcnt;
+ HINTS_REFCNT_UNLOCK;
+
+ if (new_count) {
return;
+ }
- unshare_hek_or_pvn (he->refcounted_he_he.hent_hek, 0, 0, 0);
- SvREFCNT_dec(he->refcounted_he_he.he_valu.hent_val);
+#ifndef USE_ITHREADS
+ unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
+#endif
copy = he;
- he = (struct refcounted_he *) he->refcounted_he_he.hent_next;
- Safefree(copy);
+ he = he->refcounted_he_next;
+ PerlMemShared_free(copy);
}
}
-
-/*
-=for apidoc refcounted_he_dup
-
-Duplicates the C<struct refcounted_he *> for a new thread.
-
-=cut
-*/
-
-#if defined(USE_ITHREADS)
-struct refcounted_he *
-Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he,
- CLONE_PARAMS* param)
-{
- struct refcounted_he *copy;
-
- if (!he)
- return NULL;
-
- /* look for it in the table first */
- copy = (struct refcounted_he *)ptr_table_fetch(PL_ptr_table, he);
- if (copy)
- return copy;
-
- /* create anew and remember what it is */
- Newx(copy, 1, struct refcounted_he);
- ptr_table_store(PL_ptr_table, he, copy);
-
- copy->refcounted_he_he.hent_next
- = (HE *)Perl_refcounted_he_dup(aTHX_
- (struct refcounted_he *)
- he->refcounted_he_he.hent_next,
- param);
- copy->refcounted_he_he.he_valu.hent_val
- = SvREFCNT_inc(sv_dup(he->refcounted_he_he.he_valu.hent_val, param));
- copy->refcounted_he_he.hent_hek
- = hek_dup(he->refcounted_he_he.hent_hek, param);
- copy->refcounted_he_refcnt = he->refcounted_he_refcnt;
- return copy;
-}
-
-/*
-=for apidoc refcounted_he_copy
-
-Copies a chain of C<struct refcounted_he *>. Used by C<pp_entereval>.
-
-=cut
-*/
-
-struct refcounted_he *
-Perl_refcounted_he_copy(pTHX_ const struct refcounted_he * he)
-{
- struct refcounted_he *copy;
- HEK *hek;
- /* This is much easier to express recursively than iteratively. */
- if (!he)
- return NULL;
-
- Newx(copy, 1, struct refcounted_he);
- copy->refcounted_he_he.hent_next
- = (HE *)Perl_refcounted_he_copy(aTHX_
- (struct refcounted_he *)
- he->refcounted_he_he.hent_next);
- copy->refcounted_he_he.he_valu.hent_val
- = newSVsv(he->refcounted_he_he.he_valu.hent_val);
- hek = he->refcounted_he_he.hent_hek;
- copy->refcounted_he_he.hent_hek
- = share_hek(HEK_KEY(hek),
- HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : HEK_LEN(hek),
- HEK_HASH(hek));
- copy->refcounted_he_refcnt = 1;
- return copy;
-}
-#endif
-
/*
=for apidoc hv_assert
projects / p5sagit/p5-mst-13.2.git / blobdiff