- register XPVHV* xhv;
- register I32 i;
- register HE *entry;
- register HE **oentry;
- bool is_utf8 = FALSE;
- const char *keysave = key;
-
- if (!hv)
- return 0;
-
- if (klen < 0) {
- klen = -klen;
- is_utf8 = TRUE;
- }
-
- xhv = (XPVHV*)SvANY(hv);
- if (SvMAGICAL(hv)) {
- bool needs_copy;
- bool needs_store;
- hv_magic_check (hv, &needs_copy, &needs_store);
- if (needs_copy) {
- mg_copy((SV*)hv, val, key, klen);
- if (!xhv->xhv_array /* !HvARRAY */ && !needs_store)
- return 0;
-#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
- key = savepvn(key,klen);
- key = (const char*)strupr((char*)key);
- hash = 0;
- }
-#endif
- }
- }
- if (is_utf8) {
- STRLEN tmplen = klen;
- /* See the note in hv_fetch(). --jhi */
- key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
- klen = tmplen;
- }
-
- if (!hash)
- PERL_HASH(hash, key, klen);
-
- if (!xhv->xhv_array /* !HvARRAY(hv) */)
- Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
- char);
-
- /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
- oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
- i = 1;
-
- for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
- if (HeHASH(entry) != hash) /* strings can't be equal */
- continue;
- if (HeKLEN(entry) != klen)
- continue;
- if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
- continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
- SvREFCNT_dec(HeVAL(entry));
- HeVAL(entry) = val;
- if (key != keysave)
- Safefree(key);
- return &HeVAL(entry);
- }
-
- entry = new_HE();
- if (HvSHAREKEYS(hv))
- HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
- else /* gotta do the real thing */
- HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
- if (key != keysave)
- Safefree(key);
- HeVAL(entry) = val;
- HeNEXT(entry) = *oentry;
- *oentry = entry;
-
- xhv->xhv_keys++; /* HvKEYS(hv)++ */
- if (i) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
- hsplit(hv);
- }
-
- return &HeVAL(entry);
-}
-
-/*
-=for apidoc hv_store_ent
-
-Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash>
-parameter is the precomputed hash value; if it is zero then Perl will
-compute it. The return value is the new hash entry so created. It will be
-NULL if the operation failed or if the value did not need to be actually
-stored within the hash (as in the case of tied hashes). Otherwise the
-contents of the return value can be accessed using the C<He?> macros
-described here. Note that the caller is responsible for suitably
-incrementing the reference count of C<val> before the call, and
-decrementing it if the function returned NULL.
-
-See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
-information on how to use this function on tied hashes.
-
-=cut
-*/
-
-HE *
-Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
-{
- register XPVHV* xhv;
- register char *key;
- STRLEN klen;
- register I32 i;
- register HE *entry;
- register HE **oentry;
- bool is_utf8;
- char *keysave;
-
- if (!hv)
- return 0;
-
- xhv = (XPVHV*)SvANY(hv);
- if (SvMAGICAL(hv)) {
- bool needs_copy;
- bool needs_store;
- hv_magic_check (hv, &needs_copy, &needs_store);
- if (needs_copy) {
- bool save_taint = PL_tainted;
- if (PL_tainting)
- PL_tainted = SvTAINTED(keysv);
- keysv = sv_2mortal(newSVsv(keysv));
- mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
- TAINT_IF(save_taint);
- if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
- return Nullhe;
-#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
- key = SvPV(keysv, klen);
- keysv = sv_2mortal(newSVpvn(key,klen));
- (void)strupr(SvPVX(keysv));
- hash = 0;
- }
-#endif
- }
- }
-
- keysave = key = SvPV(keysv, klen);
- is_utf8 = (SvUTF8(keysv) != 0);
-
- if (is_utf8)
- key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
-
- if (!hash)
- PERL_HASH(hash, key, klen);
-
- if (!xhv->xhv_array /* !HvARRAY(hv) */)
- Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
- char);
-
- /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
- oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
- i = 1;
-
- for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
- if (HeHASH(entry) != hash) /* strings can't be equal */
- continue;
- if (HeKLEN(entry) != klen)
- continue;
- if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
- continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
- SvREFCNT_dec(HeVAL(entry));
- HeVAL(entry) = val;
- if (key != keysave)
- Safefree(key);
- return entry;
- }
-
- entry = new_HE();
- if (HvSHAREKEYS(hv))
- HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
- else /* gotta do the real thing */
- HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash);
- if (key != keysave)
- Safefree(key);
- HeVAL(entry) = val;
- HeNEXT(entry) = *oentry;
- *oentry = entry;
-
- xhv->xhv_keys++; /* HvKEYS(hv)++ */
- if (i) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
- hsplit(hv);
- }
-
- return entry;
-}
-
-/*
-=for apidoc hv_delete
-
-Deletes a key/value pair in the hash. The value SV is removed from the
-hash and returned to the caller. The C<klen> is the length of the key.
-The C<flags> value will normally be zero; if set to G_DISCARD then NULL
-will be returned.
-
-=cut
-*/
-
-SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
-{
- register XPVHV* xhv;
- register I32 i;
- register U32 hash;
- register HE *entry;
- register HE **oentry;
- SV **svp;