+=for apidoc refcounted_he_chain_2hv
+
+Generates an returns a C<HV *> by walking up the tree starting at the passed
+in C<struct refcounted_he *>.
+
+=cut
+*/
+HV *
+Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
+{
+ dVAR;
+ HV *hv = newHV();
+ U32 placeholders = 0;
+ /* We could chase the chain once to get an idea of the number of keys,
+ and call ksplit. But for now we'll make a potentially inefficient
+ hash with only 8 entries in its array. */
+ const U32 max = HvMAX(hv);
+
+ if (!HvARRAY(hv)) {
+ char *array;
+ Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(max + 1), char);
+ HvARRAY(hv) = (HE**)array;
+ }
+
+ while (chain) {
+#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) {
+ goto next_please;
+ }
+ }
+ assert (!entry);
+ entry = new_HE();
+
+#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
+
+ switch(chain->refcounted_he_data[0] & HVrhek_typemask) {
+ case HVrhek_undef:
+ value = newSV(0);
+ break;
+ case HVrhek_delete:
+ value = &PL_sv_placeholder;
+ placeholders++;
+ 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;
+ if (!HeNEXT(entry)) {
+ /* initial entry. */
+ HvFILL(hv)++;
+ }
+ *oentry = entry;
+
+ HvTOTALKEYS(hv)++;
+
+ next_please:
+ chain = chain->refcounted_he_next;
+ }
+
+ if (placeholders) {
+ clear_placeholders(hv, placeholders);
+ HvTOTALKEYS(hv) -= placeholders;
+ }
+
+ /* We could check in the loop to see if we encounter any keys with key
+ 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);
+ DEBUG_A(Perl_hv_assert(aTHX_ hv));
+
+ return hv;
+}
+
+/*
+=for apidoc refcounted_he_new
+
+Creates a new C<struct refcounted_he>. Assumes ownership of one reference
+to I<value>. As S<key> is copied into a shared hash key, all references remain
+the property of the caller. The C<struct refcounted_he> is returned with a
+reference count of 1.
+
+=cut
+*/
+
+struct refcounted_he *
+Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
+ SV *const key, SV *const value) {
+ dVAR;
+ struct refcounted_he *he;
+ STRLEN key_len;
+ const char *key_p = SvPV_const(key, key_len);
+ STRLEN value_len = 0;
+ const char *value_p = NULL;
+ char value_type;
+ char flags;
+ STRLEN key_offset;
+ U32 hash;
+ 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;
+
+#ifdef USE_ITHREADS
+ he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ + key_len
+ + key_offset);
+#else
+ he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ + key_offset);
+#endif
+
+
+ he->refcounted_he_next = parent;
+
+ 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
+
+ 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_data[0] = flags;
+ he->refcounted_he_refcnt = 1;
+
+ return he;
+}
+
+/*
+=for apidoc refcounted_he_free
+
+Decrements the reference count of the passed in C<struct refcounted_he *>
+by one. If the reference count reaches zero the structure's memory is freed,
+and C<refcounted_he_free> iterates onto the parent node.
+
+=cut
+*/
+
+void
+Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
+ PERL_UNUSED_CONTEXT;
+
+ while (he) {
+ struct refcounted_he *copy;
+ U32 new_count;
+
+ HINTS_REFCNT_LOCK;
+ new_count = --he->refcounted_he_refcnt;
+ HINTS_REFCNT_UNLOCK;
+
+ if (new_count) {
+ return;
+ }
+
+#ifndef USE_ITHREADS
+ unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
+#endif
+ copy = he;
+ he = he->refcounted_he_next;
+ PerlMemShared_free(copy);
+ }
+}
+
+/*
https://perl5.git.perl.org / perl5.git / blobdiff